Two proofs at the end of chapter 3 in the LEAN tutorial that I still struggle with (and hence prevent me from going further with reading the manual) are the following:
theorem T11 : ¬(p ↔ ¬p) := sorry
for which my attempt to prove the right implication stopped at this point:
theorem T11R : ¬(p → ¬p) :=
begin
assume hyp : p → ¬ p,
cases (em p) with hp hnp,
exact (hyp hp) hp,
exact sorry
end
as obviously I don't know yet how to make use of ¬p. Not sure how to show the left implication either. The other one is this:
theorem T2R : ((p ∨ q) → r) → (p → r) ∧ (q → r) :=
begin
intros porqr, sorry
end
which I'm supposedly using (as the right implication) to show the following:
theorem T2 : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
begin
have goR : ((p ∨ q) → r) → (p → r) ∧ (q → r), from T2R p q r,
have goL : (p → r) ∧ (q → r) → ((p ∨ q) → r), from T2L p q r,
exact iff.intro (goR) (goL)
end
Here I got the left-side going:
theorem T2L : (p → r) ∧ (q → r) → ((p ∨ q) → r) :=
begin
intros prqr,
assume porq : p ∨ q,
exact or.elim porq prqr.left prqr.right
end
theorem T11R is not true, for example if p is false then p → ¬ p is true.
¬(p ↔ ¬p) is not equivalent to (¬ (p → ¬ p)) ∧ ¬ (¬ p → p); it's equivalent to ¬ ((p → ¬ p) ∧ (¬ p → p)), which is different.
For theorem T2R if you use the split tactic, it will give you two goals, one for each side of the and. You can use the left and right tactics to turn the goal p ∨ q into either p or q. The theorems or.inl and or.inr can be used to prove an or as well.
Here's a proof of T2R
theorem T2R : ((p ∨ q) → r) → (p → r) ∧ (q → r) :=
begin
intros porqr,
split,
{ assume hp : p,
apply porqr,
left,
exact hp },
{ assume hq : q,
apply porqr,
right,
exact hq },
end
Related
Is functional extensionality provable for John Major's equality (possibly relying on safe axioms)?
Goal forall A (P:A->Type) (Q:A->Type)
(f:forall a, P a) (g:forall a, Q a),
(forall a, JMeq (f a) (g a)) -> JMeq f g.
If not, is it safe to assume it as an axiom?
It's provable from usual function extensionality.
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Logic.JMeq.
Theorem jmeq_funext
A (P : A -> Type) (Q : A -> Type)
(f : forall a, P a)(g : forall a, Q a)
(h : forall a, JMeq (f a) (g a)) : JMeq f g.
Proof.
assert (pq_eq : P = Q).
apply functional_extensionality.
exact (fun a => match (h a) with JMeq_refl => eq_refl end).
induction pq_eq.
assert (fg_eq : f = g).
apply functional_extensionality_dep.
exact (fun a => JMeq_rect (fun ga => f a = ga) eq_refl (h a)).
induction fg_eq.
exact JMeq_refl.
Qed.
I am new at lean - prover and I am trying to solve the examples on the online tutorial.
I am stuck at this example and I need to prove that "false implies q" or something like that.
My code is :
variables p q : Prop
example : ¬ p → (p → q) :=
assume h : ¬ p,
assume hp : p,
--have hnpq : ¬ p ∨ q, from or.inl h,
have hf : false, from h hp,
--show q, from hf
sorry
I do not think that defining hnpq can help because this proof is part of the (¬ p ∨ q) → (p → q).
In set theory I think that false implies everything.
Any suggestions or thoughts?
In Coq, I showed the associativity of append on vectors using:
Require Import Coq.Vectors.VectorDef Omega.
Program Definition t_app_assoc v p q r (a : t v p) (b : t v q) (c : t v r) :=
append (append a b) c = append a (append b c).
Next Obligation. omega. Qed.
I now want to apply this equality in a proof. Below is the easiest goal that I would expect to be provable with t_app_assoc. Of course it can be proven by simpl - this is just an example.
Goal (append (append (nil nat) (nil _)) (nil _)
= append (nil _) (append (nil _) (nil _))).
apply t_app_assoc.
This apply fails with:
Error: Unable to unify "Prop" with
"append (append (nil nat) (nil nat)) (nil nat) =
append (nil nat) (append (nil nat) (nil nat))".
How can I apply t_app_assoc? Or is there a better way to define it? I thought I needed a Program Definition, because simply using a Lemma leads to a type error because t v (p + (q + r)) and t v (p + q + r) are not the same to Coq.
Prologue
I guess what you want to to is to prove that the vector concatenation is associative and then use that fact as a lemma.
But t_app_assoc as you define it has the following type:
t_app_assoc
: forall (v : Type) (p q r : nat), t v p -> t v q -> t v r -> Prop
You basically want to use : instead of := as follows.
From Coq Require Import Vector Arith.
Import VectorNotations.
Import EqNotations. (* rew notation, see below *)
Section Append.
Variable A : Type.
Variable p q r : nat.
Variables (a : t A p) (b : t A q) (c : t A r).
Fail Lemma t_app_assoc :
append (append a b) c = append a (append b c).
Unfortunately, we cannot even state a lemma like this using the usual homogeneous equality.
The left-hand side has the following type:
Check append (append a b) c : t A (p + q + r).
whereas the right-hand side is of type
Check append a (append b c) : t A (p + (q + r)).
Since t A (p + q + r) is not the same as t A (p + (q + r)) we cannot use = to state the above lemma.
Let me describe some ways of working around this issue:
rew notation
Lemma t_app_assoc_rew :
append (append a b) c = rew (plus_assoc _ _ _) in
append a (append b c).
Admitted.
Here we just use the law of associativity of addition for natural numbers to cast the type of RHS to t A (p + q + r).
To make it work one needs to Import EqNotations. before.
cast function
This is a common problem, so the authors of the Vector library decided to provide a cast function with the following type:
cast :
forall (A : Type) (m : nat),
Vector.t A m -> forall n : nat, m = n -> Vector.t A n
Let me show how one can use it to prove the law of associativity for vectors. But let's prove the following auxiliary lemma first:
Lemma uncast {X n} {v : Vector.t X n} e :
cast v e = v.
Proof. induction v as [|??? IH]; simpl; rewrite ?IH; reflexivity. Qed.
Now we are all set:
Lemma t_app_assoc_cast (a : t A p) (b : t A q) (c : t A r) :
append (append a b) c = cast (append a (append b c)) (plus_assoc _ _ _).
Proof.
generalize (Nat.add_assoc p q r).
induction a as [|h p' a' IH]; intros e.
- now rewrite uncast.
- simpl; f_equal. apply IH.
Qed.
Heterogeneous equality (a.k.a. John Major equality)
Lemma t_app_assoc_jmeq :
append (append a b) c ~= append a (append b c).
Admitted.
End Append.
If you compare the definition of the homogeneous equality
Inductive eq (A : Type) (x : A) : A -> Prop :=
eq_refl : x = x.
and the definition of heterogeneous equality
Inductive JMeq (A : Type) (x : A) : forall B : Type, B -> Prop :=
JMeq_refl : x ~= x.
you will see that with JMeq the LHS and RHS don't have to be of the same type and this is why the statement of t_app_assoc_jmeq looks a bit simpler than the previous ones.
Other approaches to vectors
See e.g. this question
and this one;
I also find this answer
very useful too.
I have a list with a known value and want to induct on it, keeping track of what the original list was, and referring to it by element. That is, I need to refer to it by l[i] with varying i instead of just having (a :: l).
I tried to make an induction principle to allow me to do that. Here is a program with all of the unnecessary Theorems replaced with Admitted, using a simplified example. The objective is to prove allLE_countDown using countDown_nth, and have list_nth_rect in a convenient form. (The theorem is easy to prove directly without any of those.)
Require Import Arith.
Require Import List.
Definition countDown1 := fix f a i := match i with
| 0 => nil
| S i0 => (a + i0) :: f a i0
end.
(* countDown from a number to another, excluding greatest. *)
Definition countDown a b := countDown1 b (a - b).
Theorem countDown_nth a b i d (boundi : i < length (countDown a b))
: nth i (countDown a b) d = a - i - 1.
Admitted.
Definition allLE := fix f l m := match l with
| nil => true
| a :: l0 => if Nat.leb a m then f l0 m else false
end.
Definition drop {A} := fix f (l : list A) n := match n with
| 0 => l
| S a => match l with
| nil => nil
| _ :: l2 => f l2 a
end
end.
Theorem list_nth_rect_aux {A : Type} (P : list A -> list A -> nat -> Type)
(Pnil : forall l, P l nil (length l))
(Pcons : forall i s l d (boundi : i < length l), P l s (S i) -> P l ((nth i l d) :: s) i)
l s i (size : length l = i + length s) (sub : s = drop l i) : P l s i.
Admitted.
Theorem list_nth_rect {A : Type} (P : list A -> list A -> nat -> Type)
(Pnil : forall l, P l nil (length l))
(Pcons : forall i s l d (boundi : i < length l), P l s (S i) -> P l ((nth i l d) :: s) i)
l s (leqs : l = s): P l s 0.
Admitted.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as l.
refine (list_nth_rect (fun l s _ => l = countDown a b -> allLE s a = true) _ _ l l eq_refl Heql);
intros; subst; [ apply eq_refl | ].
rewrite countDown_nth; [ | apply boundi ].
pose proof (Nat.le_sub_l a (i + 1)).
rewrite Nat.sub_add_distr in H0.
apply leb_correct in H0.
simpl; rewrite H0; clear H0.
apply (H eq_refl).
Qed.
So, I have list_nth_rect and was able to use it with refine to prove the theorem by referring to the nth element, as desired. However, I had to construct the Proposition P myself. Normally, you'd like to use induction.
This requires distinguishing which elements are the original list l vs. the sublist s that is inducted on. So, I can use remember.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as s.
remember s as l.
rewrite Heql.
This puts me at
a, b : nat
s, l : list nat
Heql : l = s
Heqs : l = countDown a b
============================
allLE s a = true
However, I can't seem to pass the equality as I just did above. When I try
induction l, s, Heql using list_nth_rect.
I get the error
Error: Abstracting over the terms "l", "s" and "0" leads to a term
fun (l0 : list ?X133#{__:=a; __:=b; __:=s; __:=l; __:=Heql; __:=Heqs})
(s0 : list ?X133#{__:=a; __:=b; __:=s; __:=l0; __:=Heql; __:=Heqs})
(_ : nat) =>
(fun (l1 l2 : list nat) (_ : l1 = l2) =>
l1 = countDown a b -> allLE l2 a = true) l0 s0 Heql
which is ill-typed.
Reason is: Illegal application:
The term
"fun (l l0 : list nat) (_ : l = l0) =>
l = countDown a b -> allLE l0 a = true" of type
"forall l l0 : list nat, l = l0 -> Prop"
cannot be applied to the terms
"l0" : "list nat"
"s0" : "list nat"
"Heql" : "l = s"
The 3rd term has type "l = s" which should be coercible to
"l0 = s0".
So, how can I change the induction principle
such that it works with the induction tactic?
It looks like it's getting confused between
the outer variables and the ones inside the
function. But, I don't have a way to talk
about the inner variables that aren't in scope.
It's very strange, since invoking it with
refine works without issues.
I know for match, there's as clauses, but
I can't figure out how to apply that here.
Or, is there a way to make list_nth_rect use
P l l 0 and still indicate which variables correspond to l and s?
First, you can prove this result much more easily by reusing more basic ones. Here's a version based on definitions of the ssreflect library:
From mathcomp
Require Import ssreflect ssrfun ssrbool ssrnat eqtype seq.
Definition countDown n m := rev (iota m (n - m)).
Lemma allLE_countDown n m : all (fun k => k <= n) (countDown n m).
Proof.
rewrite /countDown all_rev; apply/allP=> k; rewrite mem_iota.
have [mn|/ltnW] := leqP m n.
by rewrite subnKC //; case/andP => _; apply/leqW.
by rewrite -subn_eq0 => /eqP ->; rewrite addn0 ltnNge andbN.
Qed.
Here, iota n m is the list of m elements that counts starting from n, and all is a generic version of your allLE. Similar functions and results exist in the standard library.
Back to your original question, it is true that sometimes we need to induct on a list while remembering the entire list we started with. I don't know if there is a way to get what you want with the standard induction tactic; I didn't even know that it had a multi-argument variant. When I want to prove P l using this strategy, I usually proceed as follows:
Find a predicate Q : nat -> Prop such that Q (length l) implies P l. Typically, Q n will have the form n <= length l -> R (take n l) (drop n l), where R : list A -> list A -> Prop.
Prove Q n for all n by induction.
I do not know if this answers your question, but induction seems to accept with clauses. Thus, you can write the following.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as s.
remember s as l.
rewrite Heql.
induction l, s, Heql using list_nth_rect
with (P:=fun l s _ => l = countDown a b -> allLE s a = true).
But the benefit is quite limited w.r.t. the refine version, since you need to specify manually the predicate.
Now, here is how I would have proved such a result using objects from the standard library.
Require Import List. Import ListNotations.
Require Import Omega.
Definition countDown1 := fix f a i := match i with
| 0 => nil
| S i0 => (a + i0) :: f a i0
end.
(* countDown from a number to another, excluding greatest. *)
Definition countDown a b := countDown1 b (a - b).
Theorem countDown1_nth a i k d (boundi : k < i) :
nth k (countDown1 a i) d = a + i -k - 1.
Proof.
revert k boundi.
induction i; intros.
- inversion boundi.
- simpl. destruct k.
+ omega.
+ rewrite IHi; omega.
Qed.
Lemma countDown1_length a i : length (countDown1 a i) = i.
Proof.
induction i.
- reflexivity.
- simpl. rewrite IHi. reflexivity.
Qed.
Theorem countDown_nth a b i d (boundi : i < length (countDown a b))
: nth i (countDown a b) d = a - i - 1.
Proof.
unfold countDown in *.
rewrite countDown1_length in boundi.
rewrite countDown1_nth.
replace (b+(a-b)) with a by omega. reflexivity. assumption.
Qed.
Theorem allLE_countDown a b : Forall (ge a) (countDown a b).
Proof.
apply Forall_forall. intros.
apply In_nth with (d:=0) in H.
destruct H as (n & H & H0).
rewrite countDown_nth in H0 by assumption. omega.
Qed.
EDIT:
You can state an helper lemma to make an even more concise proof.
Lemma Forall_nth : forall {A} (P:A->Prop) l,
(forall d i, i < length l -> P (nth i l d)) ->
Forall P l.
Proof.
intros. apply Forall_forall.
intros. apply In_nth with (d:=x) in H0.
destruct H0 as (n & H0 & H1).
rewrite <- H1. apply H. assumption.
Qed.
Theorem allLE_countDown a b : Forall (ge a) (countDown a b).
Proof.
apply Forall_nth.
intros. rewrite countDown_nth. omega. assumption.
Qed.
The issue is that, for better or for worse, induction seems to assume that its arguments are independent. The solution, then, is to let induction automatically infer l and s from Heql:
Theorem list_nth_rect {A : Type} {l s : list A} (P : list A -> list A -> nat -> Type)
(Pnil : P l nil (length l))
(Pcons : forall i s d (boundi : i < length l), P l s (S i) -> P l ((nth i l d) :: s) i)
(leqs : l = s): P l s 0.
Admitted.
Theorem allLE_countDown a b : allLE (countDown a b) a = true.
remember (countDown a b) as s.
remember s as l.
rewrite Heql.
induction Heql using list_nth_rect;
intros; subst; [ apply eq_refl | ].
rewrite countDown_nth; [ | apply boundi ].
pose proof (Nat.le_sub_l a (i + 1)).
rewrite Nat.sub_add_distr in H.
apply leb_correct in H.
simpl; rewrite H; clear H.
assumption.
Qed.
I had to change around the type of list_nth_rect a bit; I hope I haven't made it false.
I am trying to prove something simple:
open import Data.List
open import Data.Nat
open import Data.Bool
open import Data.Bool.Properties
open import Relation.Binary.PropositionalEquality
open import Data.Unit
repeat : ∀ {a} {A : Set a} → ℕ → A → List A
repeat zero x = []
repeat (suc n) x = x ∷ repeat n x
filter-repeat : ∀ {a} {A : Set a} → (p : A → Bool) → (x : A) → T (p x) → ∀ n →
filter p (repeat n x) ≡ repeat n x
I thought proving filter-repeat is going to be easy by pattern matching on p x:
filter-repeat p x prf zero = refl
filter-repeat p x prf (suc n) with p x
filter-repeat p x () (suc n) | false
filter-repeat p x prf (suc n) | true = cong (_∷_ x) (filter-repeat p x prf n)
However this complains that prf : ⊤ is not of type T (p x). So I thought, OK, this seems like a familiar problem, let's whip out inspect:
filter-repeat p x prf zero = refl
filter-repeat p x prf (suc n) with p x | inspect p x
filter-repeat p x () (suc n) | false | _
filter-repeat p x tt (suc n) | true | [ eq ] rewrite eq = cong (_∷_ x) (filter-repeat p x {!!} n)
but despite the rewrite, the type of the hole is still T (p x) instead of T true. Why is that? How do I reduce its type to T true so I can fill it with tt?
Workaround
I was able to work around it by using T-≡:
open import Function.Equality using (_⟨$⟩_)
open import Function.Equivalence
filter-repeat : ∀ {a} {A : Set a} → (p : A → Bool) → (x : A) → T (p x) → ∀ n →
filter p (repeat n x) ≡ repeat n x
filter-repeat p x prf zero = refl
filter-repeat p x prf (suc n) with p x | inspect p x
filter-repeat p x () (suc n) | false | _
filter-repeat p x tt (suc n) | true | [ eq ] = cong (_∷_ x) (filter-repeat p x (Equivalence.from T-≡ ⟨$⟩ eq) n)
but I would still like to understand why the inspect-based solution doesn't work.
As András Kovács says the inductive case requires prf to be of type T (p x) while you've already changed it to just ⊤ by pattern matching on p x. One simple solution is just to call filter-repeat recursively before pattern matching on p x:
open import Data.Empty
filter-repeat : ∀ {a} {A : Set a} → (p : A → Bool) → (x : A) → T (p x) → ∀ n →
filter p (repeat n x) ≡ repeat n x
filter-repeat p x prf 0 = refl
filter-repeat p x prf (suc n) with filter-repeat p x prf n | p x
... | r | true = cong (x ∷_) r
... | r | false = ⊥-elim prf
It also can sometimes be useful to use the protect pattern:
data Protect {a} {A : Set a} : A → Set where
protect : ∀ x → Protect x
filter-repeat : ∀ {a} {A : Set a} → (p : A → Bool) → (x : A) → T (p x) → ∀ n →
filter p (repeat n x) ≡ repeat n x
filter-repeat p x q 0 = refl
filter-repeat p x q (suc n) with protect q | p x | inspect p x
... | _ | true | [ _ ] = cong (x ∷_) (filter-repeat p x q n)
... | _ | false | [ r ] = ⊥-elim (subst T r q)
protect q saves the type of q from being rewritten, but it also means that in the false case the type of q is still T (p x) rather than ⊥, hence the additional inspect.
Another variant of the same idea is
module _ {a} {A : Set a} (p : A → Bool) (x : A) (prf : T (p x)) where
filter-repeat : ∀ n → filter p (repeat n x) ≡ repeat n x
filter-repeat 0 = refl
filter-repeat (suc n) with p x | inspect p x
... | true | [ r ] = cong (x ∷_) (filter-repeat n)
... | false | [ r ] = ⊥-elim (subst T r prf)
module _ ... (prf : T (p x)) where prevents the type of prf from being rewritten as well.
Dependent pattern matching only affects the goal and the context at the exact point of their use. Matching on p xrewrites the current context and reduces the type of prf to ⊤ in the true branch.
However, when you do the recursive filter-repeat call, you once again supply x as argument there, and T (p x) in filter-repeat depends on that x, not the old one in the outer context, even though they're definitionally equal. We could've passed something other than x, hypothetically, so no assumption can be made about it before the filter-repeat call.
x can be made invariant in the context by factoring it out from the induction:
open import Data.Empty
filter-repeat : ∀ {a} {A : Set a} → (p : A → Bool) → (x : A) → T (p x) → ∀ n →
filter p (repeat n x) ≡ repeat n x
filter-repeat p x prf = go where
go : ∀ n → filter p (repeat n x) ≡ repeat n x
go zero = refl
go (suc n) with p x | inspect p x
go (suc n) | true | [ eq ] = cong (_∷_ x) (go n)
go (suc n) | false | [ eq ] = ⊥-elim (subst T eq prf)