I want to show the following:
match H in (_ = y) return y with
| eq_refl => exist (fun n' : nat => n' < n) x0 l
end = exist (fun n' : nat => n' < n) x0 l
I have in my context:
H : ltn n = ltn n
n : nat
x0 : nat
l : x0 < n
Where
Definition ltn (n : nat) : Type := {n' | n' < n}.
I'm unable to destruct on H, because the resulting term would be ill-typed, but it seems clear the equality holds because the only possible branch from match does not depend on what's being matched.
The problem (as you said) is that Coq cannot destruct H, once it's a variable without "matchings" and the definition equality (that you are using) is based on normalization and string verification, you will not able to operate this. Anyway, without axioms, you can not destruct an equality instance, given that you are implying that all equalities are equals (definitional equals). The implication of considering all equalities as "equals" assumes that your core is extensionally typed. For the sake of compatibility with others type theories (like homotopy type theory), Coq doesn't allow you to mention UIP without as axiom. UIP axiom and K axiom are very related. You can just export the axioms from Coq standard library.
Theorem exact_eq : forall (n' n x0 : nat) (l : x0 < n) (H : {n' | n' < n} = {n' | n' < n}),
match H in (_ = y) return y with
| eq_refl => exist (fun n' : nat => n' < n) x0 l
end = exist (fun n' : nat => n' < n) x0 l.
intros.
(*UIP_refl : forall (H : x = x), H = erefl x*)
by set(#UIP_refl _ _ H); subst.
Qed.
Related
I'm basically trying to prove
Theorem le_unique {x y : nat} (p q : x <= y) : p = q.
without assuming any axioms (e.g. proof irrelevance). In particular, I've tried to get through le_unique by induction and inversion, but it never seems to get far
Theorem le_unique (x y : nat) (p q : x <= y) : p = q.
Proof.
revert p q.
induction x as [ | x rec_x]. (* induction on y similarly fruitless; induction on p, q fails *)
- destruct p as [ | y p].
+ inversion q as [ | ]. (* destruct q fails and inversion q makes no progress *)
admit.
+ admit.
- admit.
Admitted.
In the standard library, this lemma can be found as Peano_dec.le_unique in the module Coq.Arith.Peano_dec.
As for a relatively simple direct proof, I like to go by induction on p itself.
After proving by hand a few induction principles that Coq doesn't automatically generate, and remembering that proofs of equality on nat are unique, the proof is a relatively straightforward induction on p followed by cases on q, giving four cases two of which are absurd.
Below is a complete Coq file proving le_unique.
Import EqNotations.
Require Eqdep_dec PeanoNat.
Lemma nat_uip {x y : nat} (p q : x = y) : p = q.
apply Eqdep_dec.UIP_dec.
exact PeanoNat.Nat.eq_dec.
Qed.
(* Generalize le_ind to prove things about the proof *)
Lemma le_ind_dependent :
forall (n : nat) (P : forall m : nat, n <= m -> Prop),
P n (le_n n) ->
(forall (m : nat) (p : n <= m), P m p -> P (S m) (le_S n m p)) ->
forall (m : nat) (p : n <= m), P m p.
exact (fun n P Hn HS => fix ind m p : P m p := match p with
| le_n _ => Hn | le_S _ m p => HS m p (ind m p) end).
Qed.
(*
Here we give an proof-by-cases principle for <= which keeps both the left
and right hand sides fixed.
*)
Lemma le_case_remember (x y : nat) (P : x <= y -> Prop)
(IHn : forall (e : y = x), P (rew <- e in le_n x))
(IHS : forall y' (q' : x <= y') (e : y = S y'), P (rew <- e in le_S x y' q'))
: forall (p : x <= y), P p.
exact (fun p => match p with le_n _ => IHn | le_S _ y' q' => IHS y' q' end eq_refl).
Qed.
Theorem le_unique {x y : nat} (p q : x <= y) : p = q.
revert q.
induction p as [|y p IHp] using le_ind_dependent;
intro q;
case q as [e|x' q' e] using le_case_remember.
- rewrite (nat_uip e eq_refl).
reflexivity.
- (* x = S x' but x <= x', so S x' <= x', which is a contradiction *)
exfalso.
rewrite e in q'.
exact (PeanoNat.Nat.nle_succ_diag_l _ q').
- (* S y' = x but x <= y', so S y' <= y', which is a contradiction *)
exfalso; clear IHp.
rewrite <- e in p.
exact (PeanoNat.Nat.nle_succ_diag_l _ p).
- injection e as e'.
(* We now get rid of e as equal to (f_equal S e'), and then destruct e'
now that it is an equation between variables. *)
assert (f_equal S e' = e).
+ apply nat_uip.
+ destruct H.
destruct e'.
change (le_S x y p = le_S x y q').
f_equal.
apply IHp.
Qed.
Inspired by Eqdep_dec (and with a lemma from it), I've been able to cook this proof up. The idea is that x <= y can be converted to exists k, y = k + x, and roundtripping through this conversion produces a x <= y that is indeed = to the original.
(* Existing lemmas (e.g. Nat.le_exists_sub) seem unusable (declared opaque) *)
Fixpoint le_to_add {x y : nat} (prf : x <= y) : exists k, y = k + x :=
match prf in _ <= y return exists k, y = k + x with
| le_n _ => ex_intro _ 0 eq_refl
| le_S _ y prf =>
match le_to_add prf with
| ex_intro _ k rec =>
ex_intro
_ (S k)
match rec in _ = z return S y = S z with eq_refl => eq_refl end
end
end.
Fixpoint add_to_le (x k : nat) : x <= k + x :=
match k with
| O => le_n x
| S k => le_S x (k + x) (add_to_le x k)
end.
Theorem rebuild_le
{x y : nat} (prf : x <= y)
: match le_to_add prf return x <= y with
| ex_intro _ k prf =>
match prf in _ = z return x <= z -> x <= y with
| eq_refl => fun p => p
end (add_to_le x k)
end = prf.
Proof.
revert y prf.
fix rec 2. (* induction is not enough *)
destruct prf as [ | y prf].
- reflexivity.
- specialize (rec y prf).
simpl in *.
destruct (le_to_add prf) as [k ->].
subst prf.
reflexivity.
Defined.
Then, any two x <= ys will produce the same k, by injectivity of +. The decidability of = on nat tells us that the produced equalities are also equal. Thus, the x <= ys map to the same exists k, y = k + x, and mapping that equality back tells us the x <= ys were also equal.
Theorem le_unique (x y : nat) (p q : x <= y) : p = q.
Proof.
rewrite <- (rebuild_le p), <- (rebuild_le q).
destruct (le_to_add p) as [k ->], (le_to_add q) as [l prf].
pose proof (f_equal (fun n => n - x) prf) as prf'.
simpl in prf'.
rewrite ?Nat.add_sub in prf'.
subst l.
apply K_dec with (p := prf).
+ decide equality.
+ reflexivity.
Defined.
I'm still hoping there's a better (i.e. shorter) proof available.
I have function (beq_nat_refl) which determines the equality of two natural numbers and gives a boolean. But now I want to prove a lemma stating that a natural number x is less or equal to x.
May I use the above function (beq_nat_refl)?
Theorem beq_nat_refl :
forall n : nat,
true = beq_nat n n.
Theorem leq_nat :
forall x:nat,
x <= x.
That would work if you would define x <= y as x < y || x == y; however this is not the definition, so usually the proof of x <= x tends to be induction [on the computational case] or by applying the base constructor if using a witness.
Here is a straightforward path to proving leq_nat from similar definitions:
Fixpoint leb (n m : nat) : bool :=
match n, m with
| 0 , _ => true
| _ , 0 => false
| S n, S m => leb n m
end.
Lemma leb_nat_refl : forall (n : nat), leb n n = true.
Proof.
induction n; simpl.
+ reflexivity.
+ assumption.
Qed.
Lemma leb_nat_reflect : forall (n : nat), leb n n = true <-> n <= n.
Proof.
induction n; simpl; split; intros.
+ constructor.
+ reflexivity.
+ constructor.
+ apply IHn. constructor.
Qed.
Theorem leq_nat : forall (n : nat), n <= n.
Proof.
intros.
apply leb_nat_reflect.
apply leb_nat_refl.
Qed.
I have a definition of conat which can represent both finite and infinite values, a conversion from nat, a definition of infinity, and a bisimulation relation:
CoInductive conat : Set := O' | S' (n : conat).
Fixpoint toCo (n : nat) : conat := match n with
| O => O'
| S n' => S' (toCo n') end.
CoFixpoint inf : conat := S' inf.
CoInductive bisim : conat -> conat -> Prop :=
| OO : bisim O' O'
| SS : forall n m : conat, bisim n m -> bisim (S' n) (S' m).
Notation "x == y" := (bisim x y) (at level 70).
I want to prove that conat is either finite or infinite (I'm not 100% sure that this is the correct formulation):
(* This is the goal *)
Theorem fin_or_inf : forall n : conat, (exists m : nat, toCo m == n) \/ (n == inf).
I couldn't prove it so far, but I could prove another statement that, if a conat is not finite, it is infinite (again, not 100% sure about the formulation):
(* I have a proof for this *)
Theorem not_fin_then_inf : forall n : conat, ~ (exists m : nat, toCo m == n) -> (n == inf).
I have no idea how to go from not_fin_then_inf to fin_or_inf though.
Is my definition of fin_or_inf correct?
Can I prove fin_or_inf, either using not_fin_then_inf or not using it?
Also, I found that bridging the gap between the two theorems involves decidability of bisimulation (or extension thereof). I think the decidability theorem could be stated as
Lemma bisim_dec : forall n m : conat, n == m \/ ~ (n == m).
Can I prove bisim_dec or any similar statement on bisimulation?
Edit
The original motivation to prove "either finite or infinite" was to prove commutativity and associativity of coplus:
CoFixpoint coplus (n m : conat) := match n with
| O' => m
| S' n' => S' (coplus n' m)
end.
Notation "x ~+ y" := (coplus x y) (at level 50, left associativity).
Theorem coplus_comm : forall n m, n ~+ m == m ~+ n.
Theorem coplus_assoc : forall n m p, n ~+ m ~+ p == n ~+ (m ~+ p).
Going through the same way as nat's + does not work because it requires transitivity of == with a lemma analogous to plus_n_Sm, which makes the cofix call unguarded. Otherwise, I have to destruct both n and m, and then I'm stuck at the goal n ~+ S' m == m ~+ S' n.
If I choose an alternative definition of coplus:
CoFixpoint coplus (n m : conat) := match n, m with
| O', O' => O'
| O', S' m' => S' m'
| S' n', O' => S' n'
| S' n', S' m' => S' (S' (coplus n' m'))
end.
Then coplus_comm is easy, but coplus_assoc becomes near-impossible to prove instead.
Can I indeed prove coplus_comm with the first definition of coplus, or coplus_assoc with the second?
With the following definitions I want to prove lemma without_P
Variable n : nat.
Definition mnnat := {m : nat | m < n}.
Variable f : mnnat -> nat.
Lemma without_P : (exists x : mnnat, True) -> (exists x, forall y, f x <= f y).
Lemma without_P means: if you know (the finite) set mnnat is not empty, then there must exist an element in mnnat, that is the smallest of them all, after mapping f onto mnnat.
We know mnnat is finite, as there are n-1 numbers in it and in the context of the proof of without_P we also know mnnat is not empty, because of the premise (exists x : mnnat, True).
Now mnnat being non-empty and finite "naturally/intuitively" has some smallest element (after applying f on all its elements).
At the moment I am stuck at the point below, where I thought to proceed by induction over n, which is not allowed.
1 subgoal
n : nat
f : mnnat -> nat
x : nat
H' : x < n
______________________________________(1/1)
exists (y : nat) (H0 : y < n),
forall (y0 : nat) (H1 : y0 < n),
f (exist (fun m : nat => m < n) y H0) <= f (exist (fun m : nat => m < n) y0 H1)
My only idea here is to assert the existance of a function f' : nat -> nat like this: exists (f' : nat -> nat), forall (x : nat) (H0: x < n), f' (exist (fun m : nat => m < n) x H0) = f x, after solving this assertion I have proven the lemma by induction over n. How can I prove this assertion?
Is there a way to prove "non-empty, finite sets (after applying f to each element) have a minimum" more directly? My current path seems too hard for my Coq-skills.
Require Import Psatz Arith. (* use lia to solve the linear integer arithmetic. *)
Variable f : nat -> nat.
This below is essentially your goal, modulo packing of the statement into some dependent type. (It doesn't say that mi < n, but you can extend the proof statement to also contain that.)
Goal forall n, exists mi, forall i, i < n -> f mi <= f i.
induction n; intros.
- now exists 0; inversion 1. (* n cant be zero *)
- destruct IHn as [mi IHn]. (* get the smallest pos mi, which is < n *)
(* Is f mi still smallest, or is f n the smallest? *)
(* If f mi < f n then mi is the position of the
smallest value, otherwise n is that position,
so consider those two cases. *)
destruct (lt_dec (f mi) (f n));
[ exists mi | exists n];
intros.
+ destruct (eq_nat_dec i n).
subst; lia.
apply IHn; lia.
+ destruct (eq_nat_dec i n).
subst; lia.
apply le_trans with(f mi).
lia.
apply IHn.
lia.
Qed.
Your problem is an specific instance of a more general result which is proven for example in math-comp. There, you even have a notation for denoting "the minimal x such that it meets P", where P must be a decidable predicate.
Without tweaking your statement too much, we get:
From mathcomp Require Import all_ssreflect.
Variable n : nat.
Variable f : 'I_n.+1 -> nat.
Lemma without_P : exists x, forall y, f x <= f y.
Proof.
have/(_ ord0)[] := arg_minP (P:=xpredT) f erefl => i _ P.
by exists i => ?; apply/P.
Qed.
I found a proof to my assertion (exists (f' : nat -> nat), forall (x : nat) (H0: x < n), f (exist (fun m : nat => m < n) x H0) = f' x). by proving the similar assertion (exists (f' : nat -> nat), forall x : mnnat, f x = f' (proj1_sig x)). with Lemma f'exists. The first assertion then follows almost trivially.
After I proved this assertion I can do a similar proof to user larsr, to prove Lemma without_P.
I used the mod-Function to convert any nat to a nat smaller then n, apart from the base case of n = 0.
Lemma mod_mnnat : forall m,
n > 0 -> m mod n < n.
Proof.
intros.
apply PeanoNat.Nat.mod_upper_bound.
intuition.
Qed.
Lemma mod_mnnat' : forall m,
m < n -> m mod n = m.
Proof.
intros.
apply PeanoNat.Nat.mod_small.
auto.
Qed.
Lemma f_proj1_sig : forall x y,
proj1_sig x = proj1_sig y -> f x = f y.
Proof.
intros.
rewrite (sig_eta x).
rewrite (sig_eta y).
destruct x. destruct y as [y H0].
simpl in *.
subst.
assert (l = H0).
apply proof_irrelevance. (* This was tricky to find.
It means two proofs of the same thing are equal themselves.
This makes (exist a b c) (exist a b d) equal,
if c and d prove the same thing. *)
subst.
intuition.
Qed.
(* Main Lemma *)
Lemma f'exists :
exists (ff : nat -> nat), forall x : mnnat, f x = ff (proj1_sig x).
Proof.
assert (n = 0 \/ n > 0).
induction n.
auto.
intuition.
destruct H.
exists (fun m : nat => m).
intuition. destruct x. assert (l' := l). rewrite H in l'. inversion l'.
unfold mnnat in *.
(* I am using the mod-function to map (m : nat) -> {m | m < n} *)
exists (fun m : nat => f (exist (ltn n) (m mod n) (mod_mnnat m H))).
intros.
destruct x.
simpl.
unfold ltn.
assert (l' := l).
apply mod_mnnat' in l'.
assert (proj1_sig (exist (fun m : nat => m < n) x l) = proj1_sig (exist (fun m : nat => m < n) (x mod n) (mod_mnnat x H))).
simpl. rewrite l'.
auto.
apply f_proj1_sig in H0.
auto.
Qed.
Assume the following:
Inductive bin : Set := Z | O.
Fixpoint fib (n : nat) : list bin :=
match n with
| 0 => [Z]
| S k => match k with
| 0 => [O]
| S k' => fib k' ++ fib k
end
end.
I would like to show:
Theorem fib_first : forall n,
Nat.Even n -> n > 3 -> exists w, fib n = Z :: w.
However, by performing induction on n, I get a really useless inductive
hypothesis fixing n, stating that IH : Nat.Even n -> n > 3 -> exists w : list bin, fib n = Z :: w.
What I would ideally have is the following: IH : forall n : nat, Nat.Even n -> n > 3 -> exists w : list bin, fib n = Z :: w. Naturally I cannot assume the original proposition, but it feels like I need to prove something stronger perhaps?
My idea for the inductive reasoning would be made possible by expanding F n = F n-2 . F n-1, we know F n-2 is even iff F n is even, and since neither of F n-2 or F n-1 is empty, we can show the substring is shorter, therefore sufficient for the inductive hypothesis - how does one express this in Coq?
The trick is to unfold the definition of Nat.Even and do induction on n / 2 instead of n:
Theorem fib_first : forall n,
Nat.Even n -> exists w, fib n = Z :: w.
Proof.
intros n [m ->].
induction m as [|m IH].
- now exists nil.
- rewrite <- mult_n_Sm, plus_comm.
generalize (2 * m) IH. clear m IH. simpl.
intros n [w ->].
simpl. eauto.
Qed.
Note that your n > 3 hypothesis is not actually needed.