My task is to implement an instance of equality type for the seq datatype. To do this I need to create a comparison function and a proof that this function is correct:
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat div seq.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Fixpoint eq_seq {T: eqType} (x y: seq T) : bool :=
match x, y with
| [::],[::] => true
| cons x' xs, [::] => false
| [::], cons y' ys => false
| cons x' xs, cons y' ys => (x' == y') && eq_seq xs ys
end.
Arguments eq_seq T x y : simpl nomatch.
Lemma eq_seq_correct : forall T: eqType, Equality.axiom (#eq_seq T).
Proof.
move=> T x. elim: x=> [|x' xs].
- move=> y. case: y=> //=; by constructor.
- move=> IH y. case: y=> [| y' ys].
+ rewrite /(eq_seq (x' :: xs) [::]). constructor. done.
+ move=> /=. case E: (x' == y').
* move: E. case: eqP=> E _ //=. rewrite <- E.
Result:
2 subgoals (ID 290)
T : eqType
x' : T
xs : seq T
IH : forall y : seq T, reflect (xs = y) (eq_seq xs y)
y' : T
ys : seq T
E : x' = y'
============================
reflect (x' :: xs = x' :: ys) (eq_seq xs ys)
subgoal 2 (ID 199) is:
reflect (x' :: xs = y' :: ys) (false && eq_seq xs ys)
How to get rid of x' in both sides of equality: (x' :: xs = x' :: ys)?
I tried case: (x' :: xs = x' :: ys), but it didn't help.
(Just in case you are not aware, this lemma is already proved in the seq library. Look for eqseqP.)
The key step in completing the proof is the iffP lemma:
iffP : forall P Q b, reflect P b -> (P -> Q) -> (Q -> P) -> reflect Q b.
Thus, by calling apply/(iffP (IH ys)), we reduce the current goal to proving that xs = ys -> x' :: xs = x' :: ys and x' :: xs = x' :: ys -> xs = ys. You can discharge both subgoals by applying the congruence tactic.
Related
Theorem rev_cons :
forall X x (l : list X),
x :: l = rev (x :: l) -> l = rev l.
This is just so intuitive to me that it blows my mind that I can't make any headway on it. I start off with an induction on l, solve the base case using reflexivity and immediately get stuck on the other.
What exactly am I missing here?
I don't think it's true. Case in point:
Require Import List.
Axiom rev_cons :
forall X x (l : list X),
x :: l = rev (x :: l) -> l = rev l.
Theorem argh : False.
assert (H := rev_cons _ 1 (2 :: 1 :: nil) eq_refl).
inversion H.
Qed.
I have the following definition
Inductive subseq : list nat -> list nat -> Prop :=
| empty_subseq : subseq [] []
| add_right : forall y xs ys, subseq xs ys -> subseq xs (y::ys)
| add_both : forall x y xs ys, subseq xs ys -> subseq (x::xs) (y::ys)
.
Using this, I wish to prove the following lemma
Lemma del_l_preserves_subseq : forall x xs ys, subseq (x :: xs) ys -> subseq xs ys.
So, I tried looking at the proof of subseq (x :: xs) ys by doing destruct H.
Proof.
intros. induction H.
3 subgoals (ID 209)
x : nat
xs : list nat
============================
subseq xs [ ]
subgoal 2 (ID 216) is:
subseq xs (y :: ys)
subgoal 3 (ID 222) is:
subseq xs (y :: ys)
Why does the first subgoal ask me to prove subseq xs []? Shouldn't the destruct tactic know that the proof cannot be of the form empty_subseq since the type contains x :: xs and not []?
In general how do I prove the lemma that I am trying to prove?
Shouldn't the destruct tactic know that the proof cannot be of the form empty_subseq since the type contains x :: xs and not []?
In fact, destruct doesn't know that much. It just replaces x :: xs and xs with [] and [] in the empty_subseq case. In particular, this frequently leads to lost information in the context. Better alternatives:
Use inversion instead of destruct.
Use remember to ensure both type indices of subseq are variables before destruct. (remember (x :: xs) as xxs in H.) This more explicit goal management also works well with induction.
Li-yao's answer was actually useful. This is a proof of the lemma.
Lemma del_l_preserves_subseq : forall x xs ys, subseq (x :: xs) ys -> subseq xs ys.
Proof.
intros x xs ys.
induction ys as [|y ys'].
- intros. inversion H. (* Inversion will detect that no constructor matches the type of H *)
- intros. inversion H. (* Inversion will automatically discharge the first case *)
+ (* When [subseq (x :: xs) ys'] holds *)
apply IHys' in H2. now apply add_right.
+ (* When [subseq xs ys'] holds *)
now apply add_right.
Qed
I want to declare a function that yeilds the element (b, n) that the b is equal to true.
Require Export List.
Import Coq.Lists.List.ListNotations.
Definition lstest := list (bool * nat).
Fixpoint existbool (l : lstest) : option (bool * nat) :=
match l with
| [] => None
| (b, n) :: l' => if b then Some (b, n) else existbool l'
end.
The function always get the first element satisfyting b = true. I want to express that there exists an element satisfyting b = true and returns the element. How can I define such a function?
In the following function the type of existbool_ex tells you that we output a pair contained in the list with its first element true (assuming we output a Some).
(* These are all from the standard library *)
Locate "{ _ : _ | _ }".
Print sig.
Print In.
Print fst.
(* Defining Property here to shorten code for exist *)
Definition P l (x : bool * nat) := fst x = true /\ In x l.
Fixpoint existbool_ex (l : list (bool * nat)) :
option {x : bool * nat | fst x = true /\ In x l} :=
match l return option {x : bool * nat | P l x} with
| [] => None
| x' :: l' =>
match x' with
| (true,n) as ans =>
Some (exist (P (ans :: l')) ans (conj eq_refl (or_introl eq_refl)))
| (false,n) =>
match existbool_ex l' with
| None => None
| Some (exist _ x a) =>
match a with
| conj Heq Hin =>
Some (exist (P ((false, n) :: l')) x (conj Heq (or_intror Hin)))
end
end
end
end.
(* Note the as pattern got desugared into a let binding. *)
Print existbool_ex.
(* However we have a somewhat sane extraction, (tail recursive) *)
Require Extraction.
Extraction existbool_ex.
You could write a function get_number that requires a proof that the list has a true value somewhere.
Definition has_true (l : lstest):= exists n, In (true, n) l.
get_number is defined with the help of refine which lets us leave 'holes' (written _) in the proof term to fill in later. Here we have two holes; one for the absurd case when the list is [], and one where we construct the proof term for the recursive call.
Fixpoint get_number (l:lstest) (H: has_true l) : nat.
refine (
match l as l' return l' = _ -> nat with
| (true, n)::_ => fun L => n
| (false, _)::l' => fun L => get_number l' _
| [] => fun L => _
end eq_refl).
now exfalso; subst l; inversion H.
now subst l; inversion H; inversion H0;
[congruence | eexists; eauto].
Defined.
The function uses the convoy pattern so that the match statement does not forget the shape of l in the different branches.
If you want to, you can prove rewriting lemmas to make it easier to use.
Lemma get_number_false l m H: exists H', get_number ((false, m)::l) H = get_number l H'.
Proof. eexists; reflexivity. Qed.
Lemma get_number_true l m H: get_number ((true, m)::l) H = m.
Proof. reflexivity. Qed.
Lemma get_number_nil H m: get_number [] H <> m.
Proof. now inversion H. Qed.
Lemma get_number_proof_irrel l H1 H2: get_number l H1 = get_number l H2.
Proof. induction l as [ | [[|] ?] l']; eauto; now inversion H1. Qed.
I try to practice subtypes in Coq, and using ssreflect to simplify things. But I always run into some problem when rewriting subtypes. For example:
Require Import Omega.
From mathcomp Require Import ssreflect ssrfun ssrbool ssrnat eqtype.
(* a type A to build X *)
Inductive A: Set :=
| mkA: nat -> A.
Definition getNat_A (a: A) :=
match a with
| mkA n => n
end.
Inductive X: Set :=
| r1 : A -> X.
(* subtype of X that satisfying some property *)
Definition Instantiated_X (x : X) : bool :=
match x with
| r1 a => (getNat_A a) > 10
end.
Definition iX : Set := {x:X | (Instantiated_X x)}.
(* rewrite constructor of X, stating the fact of elements of A, under certain condition creates element of iX *)
Program Definition r1_rewrite : A -> option iX :=
fun a: A =>
match (Instantiated_X (r1 a)) with
| true => Some (exist _ (r1 a) _)
| false => None
end.
(* try to prove r1_rewrite is surjective *)
Example r1_rewrite_surj:
forall t : iX, exists (a : A),
match (r1_rewrite a) with
| None => True
| Some e => eq t e
end.
Proof.
intros.
destruct t eqn: caseiX.
destruct x eqn: caseX.
exists a.
destruct (r1_rewrite a) eqn: r_res.
- destruct (10 < getNat_A a) eqn: guard.
destruct i0.
destruct x0.
unfold r1_rewrite in r_res.
simpl in r_res.
rewrite <- guard in r_res. (* <- stuck *)
Abort.
I couldn't understand why it is stuck there. The error message saying:
Error: Abstracting over the term "true" leads to a term: ...
which is ill-typed.
I thought Coq would replace every occurrence of (10 < getNat_A a) with true in r_res, which leads to something like:
Some (exist (fun x : X => Instantiated_X x) (r1 a)
(r1_rewrite_obligation_1 a Heq_anonymous) =
Some (exist (fun x : X => Instantiated_X x) (r1 a0) i0)
and by proof irrelevance and r1 injectivity, allows my proof to go through. So, I wonder can I get some pointer about how I can massage r_res in this case so it facilitates rewriting.
edit: remove Eq type class, and its instances to make example more concise
The problem with your proof attempt is that you have to be careful about how you rewrite. Here is a possible solution.
Example r1_rewrite_surj:
forall t : iX, exists (a : A),
match (r1_rewrite a) with
| None => True
| Some e => eq t e
end.
Proof.
move=> [[a] Pa]; exists a; rewrite /r1_rewrite.
move: (erefl _); rewrite {1 3}Pa.
by move=> e; rewrite (eq_irrelevance (r1_rewrite_obligation_1 _ _) Pa).
Qed.
It is a bit tricky to see what is going on here. After the first line, the proof state looks like this:
a : A
Pa : Instantiated_X (r1 a)
============================
match
(if Instantiated_X (r1 a) as b return b = Instantiated_X (r1 a) -> option iX
then
fun H : true = Instantiated_X (r1 a) =>
Some (exist (fun x : X => Instantiated_X x) (r1 a) (r1_rewrite_obligation_1 a H))
else fun _ : false = Instantiated_X (r1 a) => None) (erefl (Instantiated_X (r1 a)))
with
| Some e => exist (fun x : X => Instantiated_X x) (r1 a) Pa = e
| None => True
end
If we try to rewrite with Pa at any of the occurrences below, we will get a type error. For example:
If we try to replace the first occurrence of Instantiated_X (r1 a), Coq will not allow us to apply the result of the if to (erefl (Instantiated_X (r1 a)).
We could solve the above issue by replacing the first, second, and sixth (the one on erefl) occurrences of Instantiated_X (r1 a) with true. This would also not work, as it would make the application of r1_rewrite_obligation_1 ill-typed.
The solution is to generalize over erefl (with the call move: (erefl _)), leading to the following proof state:
forall e : Instantiated_X (r1 a) = Instantiated_X (r1 a),
match
(if Instantiated_X (r1 a) as b return b = Instantiated_X (r1 a) -> option iX
then
fun H : true = Instantiated_X (r1 a) =>
Some (exist (fun x : X => Instantiated_X x) (r1 a) (r1_rewrite_obligation_1 a H))
else fun _ : false = Instantiated_X (r1 a) => None) e
with
| Some e0 => exist (fun x : X => Instantiated_X x) (r1 a) Pa = e0
| None => True
end
It is probably not easy to see, but at this point it is safe to rewrite with Pa to replace the first and third occurrences of Instantiated_X (r1 a), and allow the if to reduce. We can then conclude by appealing to proof irrelevance of boolean equality.
Needless to say, reasoning about typing problems in this way is a nightmare. As ejgallego pointed out, it is much easier in this case to reuse the subtyping machinery of ssreflect. For example:
(* Other definitions remain the same *)
Definition r1_rewrite a : option iX := insub (r1 a).
Example r1_rewrite_surj:
forall t : iX, exists (a : A),
match (r1_rewrite a) with
| None => True
| Some e => eq t e
end.
Proof.
by move=> [[a] Pa]; exists a; rewrite /r1_rewrite insubT.
Qed.
The insub function is a generic version of your r1_rewrite. It checks whether the property defining a subtype holds and, if so, pairs that object with the corresponding proof. The insubT lemma says that insub returns a Some when the property holds.
I'm trying to formulate a problem so that only rewriting will be sufficient
to prove the goal. I want to avoid "clever" uses of Propositions and instead use
bools that can be computed by Coq.
I define a boolean test function member that returns true iff an element is in a list,
and different that returns true iff no element is in both lists.
I want to prove that I can rewrite different into an expression only using member.
Theorem different_member: forall xs ys y,
different xs ys = ((negb (member y ys)) || negb (member y xs)).
(The (negb X || Y) form is the boolean implication).
As a warm-up and reality check I want to prove
Theorem diff_mem:
forall xs ys,
different xs ys = true -> forall y, member y xs = true -> ~ member y ys = true.
The way to proceed is by induction on xs, but I keep messing up on the final step.
Very grateful for some help on both of the theorems! Here is the relevant part of development.
Require Import Arith.
Require Import List.
Require Import Bool.
Import List.ListNotations.
Open Scope list.
Open Scope bool.
Fixpoint member x ys :=
match ys with
| [] => false
| y :: ys' => (beq_nat x y) || (member x ys')
end.
Lemma mem1: forall x, member x [] = false.
Proof. auto. Qed.
Lemma mem2: forall x y l, member x (y::l) = (beq_nat x y) || (member x l).
Proof. auto. Qed.
Fixpoint different xs ys :=
match xs with
| [] => true
| x::xs' => (negb (member x ys)) && (different xs' ys)
end.
Lemma diff1: forall ys, different [] ys = true.
Proof. auto. Qed.
Lemma diff2: forall x xs ys,
different (x::xs) ys = (negb (member x ys)) && (different xs ys).
Proof. auto. Qed.
Theorem diff_mem1: forall xs ys, different xs ys = true -> forall y, member y xs = true -> ~ member y ys = true.
Proof.
Abort.
Theorem different_member:
forall xs ys y, different xs ys =
((negb (member y ys)) || negb (member y xs)).
Proof.
Abort.
EDIT:
Here is a proof of the diff_mem1 theorem. (sleeping on it, and thinking before starting to bang on it in ProofGeneral sometimes helps...). The proof of the other theorem follows the same structure.
However, the question and ultimate goal is still how to solve it entirely with rewrites and hints, so that one could (almost) do induction xs; auto..
Theorem diff_mem1: forall xs ys,
different xs ys = true -> forall y, member y xs = true -> ~ member y ys = true.
Proof.
induction xs as [|a xs]; intros ys Hdiff y Hxs Hys.
- inversion Hxs.
- (* we assume y is a member of ys, and of (a::xs) *)
(* it is also assumed that (a::xs) is different from ys *)
(* consider the cases y=a and y<>a *)
remember (beq_nat y a) as Q; destruct Q.
+ (* this case is absurd since y is a member of both ys and (y::xs) *)
apply eq_sym in HeqQ; apply beq_nat_true in HeqQ.
subst a.
simpl in Hdiff.
rewrite Hys in Hdiff.
inversion Hdiff.
+ (* this case is also absurd since y is a member of both ys and xs *)
simpl in Hdiff, Hxs.
rewrite <- HeqQ in Hxs.
simpl in Hxs.
rewrite Bool.andb_true_iff in Hdiff; destruct Hdiff as [_ Hdiff1].
destruct (IHxs ys Hdiff1 y Hxs Hys).
Qed.
EDIT2:
I will close this as #Arthur gave the correct answer as to why I failed in the initial attempt, but for completeness I want to add a solution along the lines of what I was aiming for.
I wrote an Ltac tactic my_simple_rewrite that does a number of try rewrite with lemma_x in * (about 20 different lemmas, that are only re-written from left to right). They are simple lemmas about bools and the mem1, mem2, diff1, and diff2 from above. To prove the theorem I used it, and only specified the induction variable xs and which bool expressions to do a case analysis on (using a home-made Ltac bool_destruct), and got the following proof.
Theorem different_member:
forall xs ys, different xs ys = true ->
forall y, ((negb (member y ys)) || negb (member y xs)) = true.
Proof.
induction xs as [| a xs]; intros; my_simple_rewrite.
- congruence.
- try
match goal with
| [ HH:_ |- _] => (generalize (IHxs ys HH y); intro IH)
end;
bool_destruct (member a ys);
bool_destruct (member y ys);
bool_destruct (member a xs);
bool_destruct (member y xs);
bool_destruct (beq_nat y a);
my_simple_rewrite;
congruence.
Qed.
The idea is that this can almost be automated. Picking which terms to destruct can be automated, and notice that it tries to instantiate the induction hypotheisis with anything it can throw a stick at - ("if it works, fine! otherwise try the next alternative...").
For future reference, the full development is in https://gist.github.com/larsr/10b6f4817b5117b335cc
The problem with your result is that it doesn't hold. For instance, try
Compute different [2] [1; 2]. (* false *)
Compute (negb (member 1 [2]) || negb (member 1 [1; 2])). (* true *)
This happens because, in order to obtain the converse, we need the right-hand side to be valid for all y. The correct form is:
forall xs ys,
different xs ys = true <->
(forall y, negb (member y xs) || negb (member x xs)).
Nevertheless, you are right that specifying certain results as boolean equations makes them more convenient to use in many situations. This style is heavily used, for instance, in the Ssreflect library, where they write theorems such as:
eqn_leq : forall m n, (m == n) = (m <= n) && (n <= m)
Here, the == and <= operators are booelan functions that test for equality and order on natural numbers. The first one is generic, and works for any type that is declared with a boolean equality function, called eqType in Ssreflect.
Here's a version of your theorem using Ssreflect:
Require Import Ssreflect.ssreflect Ssreflect.ssrfun Ssreflect.ssrbool.
Require Import Ssreflect.ssrnat Ssreflect.eqtype Ssreflect.seq.
Section Different.
Variable T : eqType.
Implicit Types xs ys : seq T.
Fixpoint disjoint xs ys :=
match xs with
| [::] => true
| x :: xs' => (x \notin ys) && disjoint xs' ys
end.
Lemma disjointP xs ys :
reflect (forall x, x \in xs -> x \notin ys)
(disjoint xs ys).
Proof.
elim: xs=> [|x xs IH] /=; first exact: ReflectT.
apply/(iffP andP)=> [[x_nin /IH {IH} IH] x'|xsP].
by rewrite inE=> /orP [/eqP ->|] //; auto.
apply/andP; rewrite xsP /= ?inE ?eqxx //.
apply/IH=> x' x'_in; apply: xsP.
by rewrite inE x'_in orbT.
Qed.
End Different.
I've renamed different to disjoint, and have used the Ssreflect list membership operators \in and \notin, available for lists with elements in any eqType. Note that the statement of disjointP has an implicit conversion from bool to Prop (which maps b to b = true), and that it is stated with the reflect predicate, which you can think of as being like the "if and only if" connective, but relating a Prop to a bool.
Ssreflect makes extensive use of reflect predicate and the view mechanism (the / signs you see on the proof script) to convert between boolean and propositional statements of the same fact. Thus, although we can't state the equivalence with a plain boolean equality, we can keep much of the convenience with the reflect predicate. For instance:
Goal forall n, n \in [:: 1; 2; 3] -> n \notin [:: 4; 5; 6].
Proof. by apply/disjointP. Qed.
What happened here is that Coq used disjointP to convert the above goal to disjoint [:: 1; 2; 3] [:: 4; 5; 6] (the [:: ... ] is just Ssreflect notation for lists), and could find that that goal was true just by computation.