I have this goal
size (flatten (N t1 t2)) = size (N t1 t2)
N is a bin constructor, how can I replace N t1 t2 in both sides by t3 : bin?
My hypothesis are
t1, t2 : bin
IHt1 : size (flatten t1) = size t1
IHt2 : size (flatten t2) = size t2
If I can rewrite size (flatten (N t1 t2)) = size (N t1 t2) as size (flatten t3) = size t3 then I can apply my hypothesis to finish the proof.
Here is the full code
Require Import Nat.
Require Import Arith.
Inductive bin : Type :=
L : bin
| N : bin -> bin -> bin.
Fixpoint flatten_aux (t1 t2 : bin) : bin :=
match t1 with
L => N L t2
| N t'1 t'2 => flatten_aux t'1 (flatten_aux t'2 t2)
end.
Fixpoint flatten (t : bin) : bin :=
match t with
L => L
| N t1 t2 => flatten_aux t1 (flatten t2)
end.
Fixpoint size (t : bin) : nat :=
match t with
L => 1
| N t1 t2 => 1 + size t1 + size t2
end.
Lemma flatten_aux_size :
forall t1 t2, size (flatten_aux t1 t2) =
size t1 + size t2 + 1.
induction t1.
{ intros t2.
simpl.
ring.
}
{ intros t2; simpl.
rewrite IHt1_1.
rewrite IHt1_2.
ring.
}
Qed.
Lemma flatten_size : forall t, size (flatten t) = size t.
induction t.
{ trivial.
}
{ simpl.
(* goal size (flatten (N t1 t2)) = size (N t1 t2) *)
In the end I use this solution
Lemma flatten_size : forall t, size (flatten t) = size t.
induction t.
{ trivial.
}
{ simpl.
rewrite flatten_aux_size.
rewrite <- IHt1.
rewrite <- IHt2.
rewrite Nat.add_comm.
simpl.
reflexivity.
}
Qed.
Why would you have size (flatten t3) = size t3? Your hypotheses are not universally quantified, size (flatten t2) = size t2 holds for that particular t2 (same with t1).
Without more details we cannot help you but I would expect that you rather show how flatten behaves when applied to N t1 t2 in terms of flatten t1 and flatten t2 which would then help you conclude.
you did the right thing using simpl : it partially evaluates size (flatten (N t1 t2)) and size (N t1 t2)
so you can use your induction hypothesis.
Related
I defined a type of s-expressions and it's printing functions.
Inductive sexp : Set :=
K : string -> (list sexp) -> sexp
.
Fixpoint sexpprint (s:sexp) : list string :=
match s with
K n l => ["("%string]++[n]++(concat (map sexpprint l))++[")"%string]
end.
(Yes, I understand it can be just string, not the list of strings, but Coq have small amount of theorems for working with strings, but a big amount for working with lists.)
(* more usual function
Fixpoint sexpprint (s:sexp) :string :=
match s with
K n l => ("(":string)++n++(String.concat "" (map sexpprint l))++")"
end.
*)
And I've got stuck trying to prove this theorem:
Theorem sexpprint_inj s1 s2:
sexpprint s1 = sexpprint s2 -> s1 = s2.
Maybe there are some sources which can help me to plan the theorem's proof? (books/articles/codes) How to prove it?
(Maybe I need a special kind of inductive principle, could you formulate its statement?)
Also I defined depth function, it may somehow help
Fixpoint depth (s:sexp) : nat :=
match s with
K n l =>
(match l with
nil => 0
| _ => S (list_max (map depth l))
end)
end.
Thanks!
p.s. some additional thoughts:
Theorem depth_decr n l s m:
depth (K n l) = m
->
In s l
->
depth s < m
.
Proof.
Admitted.
Theorem step_lem (m:nat) :
(forall s1 s2,
depth s1 < m ->
depth s2 < m ->
sexpprint s1 = sexpprint s2 -> s1 = s2
) ->
(forall s1 s2,
depth s1 = m ->
depth s2 = m ->
sexpprint s1 = sexpprint s2 -> s1 = s2
).
Proof.
intros H s1 s2 Q1 Q2 E.
destruct s1 as [n1 l1], s2 as [n2 l2].
simpl in E.
inversion E as [E1].
apply (app_inv_tail) in H0.
Search "concat".
cut (l1=l2).
intros []; reflexivity.
Search "In".
induction l1, l2.
+ trivial.
+ simpl in H0.
destruct s.
unfold sexpprint in H0.
simpl in H0.
inversion H0.
+ simpl in H0.
destruct a.
unfold sexpprint in H0.
simpl in H0.
inversion H0.
+ admit.
Admitted.
p.p.s. I feel like the main obstacle is performing induction on two lists.
The type sexp is an example of a nested inductive type, where one of the recursive occurrences appears inside of another induction. Such types are hard to work with in Coq, because the induction principles that it generates by default are not useful. However, you can fix this issue by writing down your own induction principle by hand. Here is one possibility:
Require Import Coq.Lists.List Coq.Strings.String.
Import ListNotations.
Unset Elimination Schemes.
Inductive sexp : Type :=
| K : string -> list sexp -> sexp.
Set Elimination Schemes.
Definition tuple (T : sexp -> Type) (es : list sexp) :=
fold_right (fun e R => T e * R)%type unit es.
Definition sexp_rect
(T : sexp -> Type)
(H : forall s es, tuple T es -> T (K s es)) :
forall e, T e :=
fix outer (e : sexp) : T e :=
match e with
| K s es =>
let fix inner (es : list sexp) : tuple T es :=
match es return tuple T es with
| [] => tt
| e :: es => (outer e, inner es)
end in
H s es (inner es)
end.
Definition sexp_ind (T : sexp -> Prop) := sexp_rect T.
With this induction principle, it is now possible to prove your lemma (exercise!), but you will need to generalize its statement a bit.
For a deeper discussion about these nested inductives, you can have a look at CPDT.
I have an inductive definition of the proposition P (or repeats l) that a lists contains repeating elements, and a functional definition of it's negation Q (or no_repeats l).
I want to show that P <-> ~ Q and ~ P <-> Q. I have been able to show three of the four implications, but ~ Q -> P seems to be different, because I'm unable to extract data from ~Q.
Require Import List.
Variable A : Type.
Inductive repeats : list A -> Prop := (* repeats *)
repeats_hd l x : In x l -> repeats (x::l)
| repeats_tl l x : repeats l -> repeats (x::l).
Fixpoint no_repeats (l: list A): Prop :=
match l with nil => True | a::l' => ~ In a l' /\ no_repeats l' end.
Lemma not_no_repeats_repeats: forall l, (~ no_repeats l) -> repeats l.
induction l; simpl. tauto. intros.
After doing induction on l, the second case is
IHl : ~ no_repeats l -> repeats l
H : ~ (~ In a l /\ no_repeats l)
============================
repeats (a :: l)
Is it possible to deduce In a l \/ ~ no_repeats l (which is sufficient) from this?
Your statement implies that equality on A supports double negation elimination:
Require Import List.
Import ListNotations.
Variable A : Type.
Inductive repeats : list A -> Prop := (* repeats *)
repeats_hd l x : In x l -> repeats (x::l)
| repeats_tl l x : repeats l -> repeats (x::l).
Fixpoint no_repeats (l: list A): Prop :=
match l with nil => True | a::l' => ~ In a l' /\ no_repeats l' end.
Hypothesis not_no_repeats_repeats: forall l, (~ no_repeats l) -> repeats l.
Lemma eq_nn_elim (a b : A) : ~ a <> b -> a = b.
Proof.
intros H.
assert (H' : ~ no_repeats [a; b]).
{ simpl. intuition. }
apply not_no_repeats_repeats in H'.
inversion H'; subst.
{ subst. simpl in *. intuition; tauto. }
inversion H1; simpl in *; subst; intuition.
inversion H2.
Qed.
Not every type supports eq_nn_elim, which means that you can only prove not_no_repeats_repeats by placing additional hypotheses on A. It should suffice to assume that A has decidable equality; that is:
Hypothesis eq_dec a b : a = b \/ a <> b.
How to project (with proj1 or proj2) a universally quantified biconditional (iff) such as in the following example?
Parameter T : Set.
Parameter P Q R: T -> Prop.
Parameter H : forall (t : T), P t <-> Q t.
When I try to use proj1 H, it fails with the following error:
Error: The term "H" has type "forall t : T, P t <-> Q t" while it is
expected to have type "?A /\ ?B".
While I would like to get forall (t : T), P t -> Q t.
Edit
Using the suggested solution, I have now two ways to project the biconditional:
Theorem proj1' : (forall t, P t <-> Q t) -> forall t, P t -> Q t.
Proof.
intros H t.
exact (proj1 (H t)).
Qed.
Theorem foo : forall (t1 t2 : T),
(R t1 -> P t1) ->
(R t2 -> P t2) ->
R t1 /\ R t2 -> Q t1 /\ Q t2.
Proof.
intros t1 t2 H1 H2 [H3 H4].
(* Does not solve the goal, as expected. *)
auto using H.
(* Solves the goal, but is unnecessary explicit. *)
(* auto using (proj1 (H t1)), (proj1 (H t2)). *)
(* Solves the goal and instanciations are infered. *)
auto using (proj1' H).
Qed.
Now, a function such as proj1' seems to be quite useful. If it is not offered in the standard library, is it because such situations are actually not happening often enough to justify it, or is it simply an historical accident?
I do realize that a distinct function would be require for two, three, etc. universal quantification (e.g. proj1'' : (forall t u, P t u <-> Q t u) -> forall t u, P t u -> Q t u). But wouldn't functions for up to three or four arguments be enough for most cases?
Related
How does `auto` interract with biconditional (iff)
Since a term of type forall (t : T), P t <-> Q t is a function, you need to apply it to a t of type T to get access to the body, which is a pair of proofs:
Goal (forall t, P t <-> Q t) -> forall t, P t -> Q t.
Proof.
intros H t.
exact (proj1 (H t)).
Qed.
The above is like the following (modulo transparency):
Definition proj1' : (forall t, P t <-> Q t) -> forall t, P t -> Q t :=
fun H t => proj1 (H t).
Respond to Edit
One can suggest many proofs of the foo theorem. I wouldn't use proj1' in any of them:
Theorem foo t1 t2 : (R t1 -> P t1) -> (R t2 -> P t2) ->
P t1 /\ P t2 -> Q t1 /\ Q t2.
Solution 1
apply is one smart tactic, it can handle biconditionals:
Proof. now split; apply H. Qed.
Solution 2
intros can apply lemmas when moving stuff to the context:
Proof. now intros _ _ [H3%H H4%H]. Qed.
It's like SSReflects's by move=> _ _ [/H H3 /H H4].
Solution 3
Coq can use biconditionals to do rewrites if you Require Import Setoid. first:
Proof. now rewrite !H. Qed.
! in front of a term means "rewrite as many times as you can, but at least once".
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.
With a sig type defintion like:
Inductive A: Set := mkA : nat-> A.
Function getId (a: A) : nat := match a with mkA n => n end.
Function filter (a: A) : bool := if (beq_nat (getId a) 0) then true else false.
Coercion is_true : bool >-> Sortclass.
Definition subsetA : Set := { a : A | filter a }.
I try to prove its projection is injective:
Lemma projection_injective :
forall t1 t2: subsetA, proj1_sig t1 = proj1_sig t2 -> t1 = t2.
Proof.
destruct t1.
destruct t2.
simpl.
intros.
rewrite -> H. (* <- stuck here *)
Abort.
At this point, Coq knows:
x : A
i : is_true (filter x)
x0 : A
i0 : is_true (filter x0)
H : x = x0
I tried some rewrite without success. For example, why can't I rewrite of i and H to give Coq a i0? May I ask what did I miss here? Thanks.
At the point where you got stuck, your goal looked roughly like this:
exist x i = exist x0 i0
If the rewrite you typed were to succeed, you would have obtained the following goal:
exist x0 i = exist x0 i0
Here, you can see why Coq is complaining: rewriting would have yielded an ill-typed term. The problem is that the subterm exist x0 i is using i as a term of type filter x0, when it really has type filter x. To convince Coq that this is not a problem, you need to massage your goal a little bit before rewriting:
Lemma projection_injective :
forall t1 t2: subsetA, proj1_sig t1 = proj1_sig t2 -> t1 = t2.
Proof.
destruct t1.
destruct t2.
simpl.
intros.
revert i. (* <- this is new *)
rewrite -> H. (* and now the tactic succeeds *)
intros i.
Abort.
Alternatively, you could use the subst tactic, which tries to remove all redundant variables in the context. Here is a more compact version of the above script:
Lemma projection_injective :
forall t1 t2: subsetA, proj1_sig t1 = proj1_sig t2 -> t1 = t2.
Proof.
intros [x1 i1] [x2 i2]; simpl; intros e.
subst.
Abort.
You might run into another issue afterwards: showing that any two terms of type filter x0 are equal. In general, you would need the axiom of proof irrelevance to be able to show this; however, since filter is defined as an equality between two terms of a type with decidable equality, you can prove this property as a theorem (which the Coq standard library already does for you).
As a side note, the mathcomp library already has a generic lemma that subsumes your property, called val_inj. Just to give you an example, this is how one might use it:
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype.
Inductive A: Set := mkA : nat-> A.
Function getId (a: A) : nat := match a with mkA n => n end.
Function filter (a: A) : bool := if (Nat.eqb (getId a) 0) then true else false.
Definition subsetA : Set := { a : A | filter a }.
Lemma projection_injective :
forall t1 t2: subsetA, proj1_sig t1 = proj1_sig t2 -> t1 = t2.
Proof.
intros t1 t2.
apply val_inj.
Qed.