How to use apply to "extract" a implication in Coq - logic

I'll illustrate using an example.
H : R -> P -> Q
H0 : R
Subgoal:
(Q -> P) \ / (P -> Q)
so my question is how do I extract out (P->Q). I have R already, but when I do
'apply H in H0', it evaluates everything and gives me Q.

You can do any of:
specialize (H H0).
to replace H with H: P -> Q, or:
pose proof (H H0) as H1
to introduce H1: P -> Q
You can also go forward:
right. exact (H H0).

Related

How to build a proof of correctness in coq for elements_tr

I want to build a proof of correctness for elements_tr...
It is actually related to some sort of reimplementation of BSTs with int keys.
Elements_tr is defined as follows:
Fixpoint elements_aux {V : Type} (t : tree V)
(acc : list (key * V)) : list (key * V) :=
match t with
| E => acc
| T l k v r => elements_aux l ((k, v) :: elements_aux r acc)
end.
Definition elements_tr {V : Type} (t : tree V) : list (key * V) :=
elements_aux t [].
However I am unable to build such proof as I continuously get false = true...
What Am I doing wrong?
Corollary elements_tr_correct :
forall (V : Type) (k : key) (v d : V) (t : tree V),
BST t ->
In (k, v) (elements_tr t) ->
bound k t = true /\ lookup d k t = v.
Proof.
intros.
split.
induction t.
- unfold elements_tr.
unfold elements. simpl.
admit.
- admit.
- admit.
Admitted.
Bellow is the full code to run...
From Coq Require Import String.
From Coq Require Export Arith.
From Coq Require Export Lia.
Notation "a >=? b" := (Nat.leb b a) (at level 70) : nat_scope.
Notation "a >? b" := (Nat.ltb b a) (at level 70) : nat_scope.
From Coq Require Export Lists.List.
Export ListNotations.
Definition key := nat.
Inductive tree (V : Type) : Type :=
| E
| T (l : tree V) (k : key) (v : V) (r : tree V).
Arguments E {V}.
Arguments T {V}.
Definition ex_tree : tree string :=
(T (T E 2 "two" E) 4 "four" (T E 5 "five" E))%string.
Definition empty_tree {V : Type} : tree V := E.
Fixpoint bound {V : Type} (x : key) (t : tree V) :=
match t with
| E => false
| T l y v r => if x <? y then bound x l
else if x >? y then bound x r
else true
end.
Fixpoint lookup {V : Type} (d : V) (x : key) (t : tree V) : V :=
match t with
| E => d
| T l y v r => if x <? y then lookup d x l
else if x >? y then lookup d x r
else v
end.
Fixpoint insert {V : Type} (x : key) (v : V) (t : tree V) : tree V :=
match t with
| E => T E x v E
| T l y v' r => if x <? y then T (insert x v l) y v' r
else if x >? y then T l y v' (insert x v r)
else T l x v r
end.
Fixpoint ForallT {V : Type} (P: key -> V -> Prop) (t: tree V) : Prop :=
match t with
| E => True
| T l k v r => P k v /\ ForallT P l /\ ForallT P r
end.
Inductive BST {V : Type} : tree V -> Prop :=
| BST_E : BST E
| BST_T : forall l x v r,
ForallT (fun y _ => y < x) l ->
ForallT (fun y _ => y > x) r ->
BST l ->
BST r ->
BST (T l x v r).
Hint Constructors BST.
Ltac inv H := inversion H; clear H; subst.
Inductive reflect (P : Prop) : bool -> Set :=
| ReflectT : P -> reflect P true
| ReflectF : ~ P -> reflect P false.
Theorem iff_reflect : forall P b, (P <-> b = true) -> reflect P b.
Proof.
intros P b H. destruct b.
- apply ReflectT. rewrite H. reflexivity.
- apply ReflectF. rewrite H. intros H'. inversion H'.
Qed.
Lemma eqb_reflect : forall x y, reflect (x = y) (x =? y).
Proof.
intros x y. apply iff_reflect. symmetry.
apply Nat.eqb_eq.
Qed.
Lemma ltb_reflect : forall x y, reflect (x < y) (x <? y).
Proof.
intros x y. apply iff_reflect. symmetry.
apply Nat.ltb_lt.
Qed.
Lemma leb_reflect : forall x y, reflect (x <= y) (x <=? y).
Proof.
intros x y. apply iff_reflect. symmetry.
apply Nat.leb_le.
Qed.
Hint Resolve ltb_reflect leb_reflect eqb_reflect : bdestruct.
Ltac bdestruct X :=
let H := fresh in let e := fresh "e" in
evar (e: Prop);
assert (H: reflect e X); subst e;
[eauto with bdestruct
| destruct H as [H|H];
[ | try first [apply not_lt in H | apply not_le in H]]].
Lemma ForallT_insert : forall (V : Type) (P : key -> V -> Prop) (t : tree V),
ForallT P t -> forall (k : key) (v : V),
P k v -> ForallT P (insert k v t).
Proof.
intros V P t.
induction t; intros H k' v' Pkv.
- simpl. auto.
- simpl in *.
destruct H as [H1 [H2 H3]].
bdestruct (k >? k').
+ simpl. repeat split.
* assumption.
* apply (IHt1 H2 k' v' Pkv).
* assumption.
+ bdestruct (k' >? k).
++ simpl. repeat split.
* assumption.
* assumption.
* apply (IHt2 H3 k' v' Pkv).
++ simpl. repeat split.
* assumption.
* assumption.
* assumption.
Qed.
Fixpoint elements {V : Type} (t : tree V) : list (key * V) :=
match t with
| E => []
| T l k v r => elements l ++ [(k, v)] ++ elements r
end.
Fixpoint elements_aux {V : Type} (t : tree V)
(acc : list (key * V)) : list (key * V) :=
match t with
| E => acc
| T l k v r => elements_aux l ((k, v) :: elements_aux r acc)
end.
Definition elements_tr {V : Type} (t : tree V) : list (key * V) :=
elements_aux t [].
Corollary elements_tr_correct :
forall (V : Type) (k : key) (v d : V) (t : tree V),
BST t ->
In (k, v) (elements_tr t) ->
bound k t = true /\ lookup d k t = v.
Proof.
intros.
split.
induction t.
- unfold elements_tr.
unfold elements. simpl.
admit.
- admit.
- admit.
Admitted.

Proposition Logic : CNF Conversion

I'm trying to solve a simple exercise in which I have to convert a propositional sentence in CNF :
This is the sentence :
P => (Q <=> R)
According to the resolution rule the first thing I did is to eliminate the <=> symbol in this way :
P => (Q <=> R) ---> P => (Q V R) /\ (R V Q)
Then I removed the => symbol :
P => (Q V R) /\ (R V Q) ------> ¬P V (Q V R) /\ (R V Q)
So my solution is : (¬P V Q V R) /\ (¬P V R V Q)
While the right one is : (¬P V ¬Q V R) /\ (¬P V ¬R V Q)
Can anyone help me to understand where I get wrong ?
StackOverflow is intended for programming questions, which rules this question off-topic. But since I've already typed that much let me add that your first step ...
P => (Q <=> R) ---> P => (Q V R) ^ (R V Q)
is incorrect.
You know that Q<=>R means by definition (Q=>R)^(R=>Q), right? So replacing that is the first step. Then you can use the equivalences (Q=>R) ---> (~QvR) and (R=>Q) ---> (~RvQ).
Putting that together you should get ...
P => (Q <=> R) ---> P => (~Q V R) ^ (~R V Q)
I think you can work out the rest.

Logical Equivalence: Show that R OR P implies R OR Q is equivalent to NOT R implies (P implies Q)?

I'm practicing logical equivalence and I've come across a question that I'm struggling to answer:
Show that (R or P -> R or Q) is equivalent to (not R -> (P -> Q)).
I've examined the truth tables of both implications but the question states that I should use equivalence laws to show that the implications are equivalent.
If anyone could help me out, I would appreciate it.
Thank you.
Intuitive
A formal proof (included below) which only allows one to follow the steps one by one is less useful than a proof that helps us understand why both expressions are equivalent. Consider the first expression:
(R or P) -> (R or Q)
and think about its meaning...
The expression is trivial when R=true, isn't it? Therefore the only information it encloses is that when R=false, P -> (R or Q). But when R=false, (R or Q) = Q. So, the precise meaning of the expression is that when R=false, P -> Q. In other words, not R -> (P -> Q).
Formal
(R or P) -> (R or Q) = not (R or P) or (R or Q) ;X -> Y = not X or Y
= (not R and not P) or (R or Q) ;not (X or Y) = not X or not Y
= ((not R and not P) or R) or Q ;X or (Y or Z) = (X or Y) or Z
= ((not R or R) and (not P or R)) or Q ;(X and Y) or Z = (X or Z) and (Y or Z)
= (not P or R) or Q ;(not X or X) = true
= (R or not P) or Q
= R or (not P or Q)
= R or (P -> Q)
= not (not R) or (P -> Q)
= not R -> (P -> Q) ;not X or Y = X -> Y

Propositional logic [closed]

Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 7 years ago.
Improve this question
I am trying to get from (p→q) and (qr→s) to (pr→s), which is the same as ((not p) or q) and (not(q and r) or s) to (not(p and r) or s)
Theorem:
p → q
= ¬p ∨ q -- 1
(q ∧ r) → s
= ¬(q ∧ r) ∨ s
= ¬q ∨ ¬r ∨ s -- 2
¬p ∨ ¬r ∨ s -- from 1 and 2, q and ¬q cancel
= ¬(p ∧ r) ∨ s
= (p ∧ r) → s
Qed.
Using Coq, we can prove this theorem as follows:
Coq < Theorem prop : forall p q r s : Prop, (p -> q) /\ (q /\ r -> s) -> p /\ r -> s.
1 subgoal
============================
forall p q r s : Prop, (p -> q) /\ (q /\ r -> s) -> p /\ r -> s
prop < intros.
1 subgoal
p : Prop
q : Prop
r : Prop
s : Prop
H : (p -> q) /\ (q /\ r -> s)
H0 : p /\ r
============================
s
prop < destruct H.
1 subgoal
p : Prop
q : Prop
r : Prop
s : Prop
H : p -> q
H1 : q /\ r -> s
H0 : p /\ r
============================
s
prop < destruct H0.
1 subgoal
p : Prop
q : Prop
r : Prop
s : Prop
H : p -> q
H1 : q /\ r -> s
H0 : p
H2 : r
============================
s
prop < apply H1.
1 subgoal
p : Prop
q : Prop
r : Prop
s : Prop
H : p -> q
H1 : q /\ r -> s
H0 : p
H2 : r
============================
q /\ r
prop < split.
2 subgoals
p : Prop
q : Prop
r : Prop
s : Prop
H : p -> q
H1 : q /\ r -> s
H0 : p
H2 : r
============================
q
subgoal 2 is:
r
prop < exact (H H0).
1 subgoal
p : Prop
q : Prop
r : Prop
s : Prop
H : p -> q
H1 : q /\ r -> s
H0 : p
H2 : r
============================
r
prop < exact H2.
No more subgoals.
prop < Qed.
intros.
destruct H.
destruct H0.
apply H1.
split.
exact (H H0).
exact H2.
prop is defined
Hope that helps.

Existential quantifier in coq impredicative logic (System F)

I was trying to code into Coq logical connectives encoded in lambda calculus with type à la System F. Here is the bunch of code I wrote (standard things, I think)
Definition True := forall X: Prop, X -> X.
Lemma I: True.
Proof.
unfold True. intros. apply H.
Qed.
Section s.
Variables A B: Prop.
(* conjunction *)
Definition and := forall X: Prop, (A -> B -> X) -> X.
Infix "/\" := and.
Lemma and_intro: A -> B -> A/\B.
Proof.
intros HA HB. split.
apply HA.
apply HB.
Qed.
Lemma and_elim_l: A/\B -> A.
Proof.
intros H. destruct H as [HA HB]. apply HA.
Qed.
Lemma and_elim_r: A/\B -> B.
Proof.
intros H. destruct H as [HA HB]. apply HB.
Qed.
(* disjunction *)
Definition or := forall X:Prop, (A -> X) -> (B -> X) -> X.
Infix "\/" := or.
Lemma or_intro_l: A -> A\/B.
intros HA. left. apply HA.
Qed.
Lemma or_elim: forall C:Prop, A \/ B -> (A -> C) -> (B -> C) -> C.
Proof.
intros C HOR HAC HBC. destruct HOR.
apply (HAC H).
apply (HBC H).
Qed.
(* falsity *)
Definition False := forall Y:Prop, Y.
Lemma false_elim: False -> A.
Proof.
unfold False. intros. apply (H A).
Qed.
End s.
Basically, I wrote down the elimination and introduction laws for conjunction, disjunction, true and false. I am not sure of having done thing correctly, but I think that things should work that way. Now I would like to define the existential quantification, but I have no idea of how to proceed. Does anyone have a suggestion?
Existential quantification is just a generalization of conjunction, where the type of the second component of the pair depends on the value of the first component. When there's no dependency they're equivalent:
Goal forall P1 P2 : Prop, (exists _ : P1, P2) <-> P1 /\ P2.
Proof. split. intros [H1 H2]. eauto. intros [H1 H2]. eauto. Qed.
Coq'Art has a section on impredicativity starting at page 130.
Definition ex (T1 : Type) (P1 : T1 -> Prop) : Prop :=
forall P2 : Prop, (forall x1, P1 x1 -> P2) -> P2.
Notation "'exists' x1 .. x2 , P1" :=
(ex (fun x1 => .. (ex (fun x2 => P1)) ..))
(at level 200, x1 binder, right associativity,
format "'[' 'exists' '/ ' x1 .. x2 , '/ ' P1 ']'") : type_scope.
The problem with impredicative definitions (unless I'm mistaken) is that there's no dependent elimination. It's possible prove
forall (A : Type) (P : A -> Prop) (Q : Prop),
(forall x : A, P x -> Q) -> (exists x, P x) -> Q,
but not
forall (A : Type) (P : A -> Prop) (Q : (exists x, P x) -> Prop),
(forall (x : A) (H : P x), Q (ex_intro P x H)) ->
forall H : exists x, P x, Q H

Resources