Bijection proof and option type - coq

I'm learning Coq and I've stumbled upon an exercise asking to create functions for the option type to/from bool and nat (i.e., bool to/from option X, nat to option nat), and then prove they commute. I can easily prove by induction on bool/nat, but I can't seem to make it work for the option type. The main problem in the bool question that I ran into is that, at some point, the goal is to prove that:
a : nat_iter 1 option Empty_set
============================
Some None = Some a
however, I don't know tell it the only possibility for nat_iter 1 option Empty_set is to be None (I have a lemma proving that, but can't rewrite a).
With the nat one, I don't think there is a bijection between nat and option nat, since I cannot prove that, given fromNat (toNat x) = x, Some 0 = None. Maybe there's a way to define toNat that makes this work.
Definition fromBool (b : bool) : fin 2 :=
match b with
| true => Some None
| false => None
end.
Definition toBool (x : fin 2) : bool :=
match x with
| None => false
| Some _ => true
end.
Lemma bool_fin b :
toBool (fromBool b) = b.
Proof. induction b ; reflexivity. Qed.
Lemma fin_bool x :
fromBool (toBool x) = x.
Proof. induction x ; simpl. Abort.
Definition fromNat (n : nat) : option nat :=
match n with
| 0 => None
| S n => Some (S n)
end.
Definition toNat (n : option nat) : nat :=
match n with
| None => 0
| Some x => x
end.
Lemma nat_option x :
toNat (fromNat x) = x.
Proof. induction x ; reflexivity. Qed.
Lemma option_nat x :
fromNat (toNat x) = x.
Proof. induction x. Abort.
Thanks.

Related

Coq's proof #Coq

I try to solve this proof but I don't find how to it.
I have two subgoals but I don't even know if it's correct.
Here the lemma that I trid to solve with this but I'm stuck :
2 subgoals
a, b : Nat
H : Equal (leB a b) True
______________________________________(1/2)
Equal match b with
| Z => False
| S m' => leB a m'
end (leB a b) / Equal (leB b (S a)) (leB a b)
______________________________________(2/2)
Equal (leB (S a) b) True / Equal (leB b (S a)) True
Inductive Bool : Type :=
True : Bool | False : Bool.
Definition Not(b : Bool) : Bool :=
Bool_rect (fun a => Bool)
False
True
b.
Lemma classic : forall b : Bool, Equal b (Not (Not b)).
Proof.
intro.
induction b.
simpl.
apply refl.
simpl.
apply refl.
Qed.
Definition Equal(T : Type)(x y : T) : Prop :=
forall P : T -> Prop, (P x) -> (P y).
Arguments Equal[T].
(* Avec certaines versions Arguments Equal[T] *)
Lemma refl : forall T : Type, forall x : T, Equal x x.
Proof.
intros.
unfold Equal.
intros.
assumption.
Qed.
Fixpoint leB n m : Bool :=
match n, m with
| Z, _ => True
| _, Z => False
| S n', S m' => leB n' m'
end.
First, don't introduce all variables in the beginning with intros. You will get a too weak induction hypothesis. Just introduce a.
Then in each branch, consider the different cases of b with the destruct tactic. It will simplify your goal and you can see if it is the left or the right side of goal that is true, and use your refl lemma to finish the goal.
The last case require that you use your induction hypothesis, and it is here that it is important that it holds for all b, not just one specific b.
Also, you didn't provide a definition for you Nat type, I guess it is something like this:
Inductive Nat := Z | S (n:Nat).
Here is a proof.
Lemma Linear : forall a b, (Equal (leB a b) True) \/ (Equal (leB b a) True).
Proof.
induction a.
- intros b. destruct b; simpl.
+ left. apply refl.
+ left. apply refl.
- intros b. destruct b; simpl.
+ right. apply refl.
+ destruct (IHa b) as [Hleft | Hright].
++ left. apply Hleft.
++ right. apply Hright.
Qed.
While it may not be as insightful, you can also use tactics that try these steps to get a shorter proof.
induction a; destruct b; firstorder.
will also prove your lemma.

Using well founded induction to define factorial

I have spent a lot of time on the notion of well founded induction and thought it was time to apply it to a simple case. So I wanted to use it do define the factorial function and came up with:
Definition fac : nat -> nat := Fix LtWellFounded (fun _ => nat) (* 'LtWellFounded' is some proof *)
(fun (n:nat) =>
match n as n' return (forall (m:nat), m < n' -> nat) -> nat with
| 0 => fun _ => 1
| S m => fun (g : forall (k:nat), k < S m -> nat) => S m * g m (le_n (S m))
end).
but then of course immediately arises the question of correctness. And when attempting to
prove that my function coincided everywhere with a usual implementation of fac, I realized things were far from trivial. In fact simply showing that fac 0 = 1:
Lemma fac0 : fac 0 = 1.
Proof.
unfold fac, Fix, Fix_F.
Show.
appears to be difficult. I am left with a goal:
1 subgoal
============================
(fix Fix_F (x : nat) (a : Acc lt x) {struct a} : nat :=
match x as n' return ((forall m : nat, m < n' -> nat) -> nat) with
| 0 => fun _ : forall m : nat, m < 0 -> nat => 1
| S m =>
fun g : forall k : nat, k < S m -> nat => S m * g m (le_n (S m))
end (fun (y : nat) (h : y < x) => Fix_F y (Acc_inv a h))) 0
(LtWellFounded' 0) = 1
and I cannot see how to reduce it further. Can anyone suggest a way foward ?
An application of a fixpoint only reduces when the argument it's recursing on has a constructor at its head. destruct (LtWellFounded' 0) to reveal the constructor, and then this will reduce to 1 = 1. Or, better, make sure LtWellFounded' is transparent (its proof should end with Defined., not Qed.), and then this entire proof is just reflexivity..
Some of the types that you give can actually be inferred by Coq, so you can also write
your fib in a slightly more readable form. Use dec to not forget which if branch your are in, and make the recursive function take a recursor fac as argument. It can be called with smaller arguments. By using refine, you can put in holes (a bit like in Agda), and get a proof obligation later.
Require Import Wf_nat PeanoNat Psatz. (* for lt_wf, =? and lia *)
Definition dec b: {b=true}+{b=false}.
now destruct b; auto.
Defined.
Definition fac : nat -> nat.
refine (Fix lt_wf _
(fun n fac =>
if dec (n =? 0)
then 1
else n * (fac (n - 1) _))).
clear fac. (* otherwise proving fac_S becomes impossible *)
destruct n; [ inversion e | lia].
Defined.
Lemma fac_S n: fac (S n) = (S n) * fac n.
unfold fac at 1; rewrite Fix_eq; fold fac.
now replace (S n - 1) with n by lia.
now intros x f g H; case dec; intros; rewrite ?H.
Defined.
Compute fac 8.
gives
Compute fac 8.
= 40320
: nat

How do I evaluate a nested match in an assumption that depends on a sumbool, given a witness to that sumbool in another assumption in Coq?

I have a proof state similar to what is shown below (I've simplified it some to focus on the essence of the problem I'm having). I'm almost certain that a contradiction exists in my assumptions. However, assumption H consists of a nested match that depends on the result of the expression "eq_nat_dec n n'". (I arrived at the left-hand-side of H by simplifying another function that is in terms of eq_nat_dec).
The good news is that i have an assumption (n0) that ensures that the "right" branch of the inner-most match should fire, which also ensures that the "inright" branch of the outer match should fire, resulting in the value "bad" ("good" and "bad" are two constructors of the same Inductive type, thus an assumption of good = bad would provide the necessary contradiction).
The bad news is that I don't know how to "inform" the inner match in assumption H about the assumption n0. I've tried using subst, and inversion on H, but the nested matches remain.
In conclusion: How do I force H to take the right branches of its matches using the information in n0?
n, n' : nat
H :
match
match eq_nat_dec n n' with
| left _ => inleft _
| right _ => inright _
end
with
| inleft _ => _
| inright _ => bad
end = good
n0 : n <> n'
============================
False
The only solution I know is to destruct eq_nat_dec n n' and proves that the left branch is contradictory because of n <> n'. It would give something like:
destruct (eq_nat_dec n n'); [contradiction | discriminate].
Indeed, as the previous answer said, destruct + congruence will work fine.
You could try to introduce a lemma:
Lemma eqn_rwN {x y : nat} (h : x <> y) : Nat.eq_dec x y = right h.
Proof.
destruct (Nat.eq_dec _ _); try congruence.
apply f_equal.
(* Use Eqdep_dec.eq_proofs_unicity? *)
Admitted.
so that you could rewrite the comparison, as this unicity of identity proofs should be provable given that nat has decidable equality:
Lemma u2
(n n' : nat)
(H : match (match Nat.eq_dec n n' with
| left x => inleft x
| right y => inright y
end)
with
| inleft x => true
| inright _ => false
end = true)
(hnn : n <> n') : False.
Proof. rewrite (eqn_rwN hnn) in H. congruence. Qed.
Other Coq libraries such as mathcomp take a different approach and put equality in bool, thus you can directly rewrite:
From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat.
Lemma u3 (n n' : nat)
(H : (if n == n' then true else false) = true)
(hnn : n != n') : False.
Proof. by rewrite (negbTE hnn) in H. Qed.
IMVHO this turns out to be more convenient if you are verifying algorithms.

Implementing safe element retrieval by index from list in Coq

I'm trying to demonstrate the difference in code generation between Coq Extraction mechanism and MAlonzo compiler in Agda. I came up with this simple example in Agda:
data Nat : Set where
zero : Nat
succ : Nat → Nat
data List (A : Set) : Set where
nil : List A
cons : A → List A → List A
length : ∀ {A} → List A → Nat
length nil = zero
length (cons _ xs) = succ (length xs)
data Fin : Nat → Set where
finzero : ∀ {n} → Fin (succ n)
finsucc : ∀ {n} → Fin n → Fin (succ n)
elemAt : ∀ {A} (xs : List A) → Fin (length xs) → A
elemAt nil ()
elemAt (cons x _) finzero = x
elemAt (cons _ xs) (finsucc n) = elemAt xs n
Direct translation to Coq (with absurd pattern emulation) yields:
Inductive Nat : Set :=
| zero : Nat
| succ : Nat -> Nat.
Inductive List (A : Type) : Type :=
| nil : List A
| cons : A -> List A -> List A.
Fixpoint length (A : Type) (xs : List A) {struct xs} : Nat :=
match xs with
| nil => zero
| cons _ xs' => succ (length _ xs')
end.
Inductive Fin : Nat -> Set :=
| finzero : forall n : Nat, Fin (succ n)
| finsucc : forall n : Nat, Fin n -> Fin (succ n).
Lemma finofzero : forall f : Fin zero, False.
Proof. intros a; inversion a. Qed.
Fixpoint elemAt (A : Type) (xs : List A) (n : Fin (length _ xs)) : A :=
match xs, n with
| nil, _ => match finofzero n with end
| cons x _, finzero _ => x
| cons _ xs', finsucc m n' => elemAt _ xs' n' (* fails *)
end.
But the last case in elemAt fails with:
File "./Main.v", line 26, characters 46-48:
Error:
In environment
elemAt : forall (A : Type) (xs : List A), Fin (length A xs) -> A
A : Type
xs : List A
n : Fin (length A xs)
a : A
xs' : List A
n0 : Fin (length A (cons A a xs'))
m : Nat
n' : Fin m
The term "n'" has type "Fin m" while it is expected to have type
"Fin (length A xs')".
It seems that Coq does not infer succ m = length A (cons A a xs'). What should I
tell Coq so it would use this information? Or am I doing something completely senseless?
Doing pattern matching is the equivalent of using the destruct tactic.
You won't be able to prove finofzero directly using destruct.
The inversion tactic automatically generates some equations before doing what destruct does.
Then it tries to do what discriminate does. The result is really messy.
Print finofzero.
To prove something like fin zero -> P you should change it to fin n -> n = zero -> P first.
To prove something like list nat -> P (more usually forall l : list nat, P l) you don't need to change it to list A -> A = nat -> P, because list's only argument is a parameter in its definition.
To prove something like S n <= 0 -> False you should change it to S n1 <= n2 -> n2 = 0 -> False first, because the first argument of <= is a parameter while the second one isn't.
In a goal f x = f y -> P (f y), to rewrite with the hypothesis you first need to change the goal to f x = z -> f y = z -> P z, and only then will you be able to rewrite with the hypothesis using induction, because the first argument of = (actually the second) is a parameter in the definition of =.
Try defining <= without parameters to see how the induction principle changes.
In general, before using induction on a predicate you should make sure it's arguments are variables. Otherwise information might be lost.
Conjecture zero_succ : forall n1, zero = succ n1 -> False.
Conjecture succ_succ : forall n1 n2, succ n1 = succ n2 -> n1 = n2.
Lemma finofzero : forall n1, Fin n1 -> n1 = zero -> False.
Proof.
intros n1 f1.
destruct f1.
intros e1.
eapply zero_succ.
eapply eq_sym.
eapply e1.
admit.
Qed.
(* Use the Show Proof command to see how the tactics manipulate the proof term. *)
Definition elemAt' : forall (A : Type) (xs : List A) (n : Nat), Fin n -> n = length A xs -> A.
Proof.
fix elemAt 2.
intros A xs.
destruct xs as [| x xs'].
intros n f e.
destruct (finofzero f e).
destruct 1.
intros e.
eapply x.
intros e.
eapply elemAt.
eapply H.
eapply succ_succ.
eapply e.
Defined.
Print elemAt'.
Definition elemAt : forall (A : Type) (xs : List A), Fin (length A xs) -> A :=
fun A xs f => elemAt' A xs (length A xs) f eq_refl.
CPDT has more about this.
Maybe things would be clearer if at the end of a proof Coq performed eta reduction and beta/zeta reduction (wherever variables occur at most once in scope).
I think your problem is similar to Dependent pattern matching in coq . Coq's match does not infer much, so you have to help it by providing the equality by hand.

Dependent pattern matching in coq

The following code (which is of course not a complete proof) tries to do pattern matching on a dependent product:
Record fail : Set :=
mkFail {
i : nat ;
f : forall x, x < i -> nat
}.
Definition failomat : forall (m : nat) (f : forall x, x < m -> nat), nat.
Proof.
intros.
apply 0.
Qed.
Function fail_hard_omat fl : nat := failomat (i fl) (f fl).
Definition failhard fl : fail_hard_omat fl = 0.
refine ((fun fl =>
match fl with
| mkFail 0 _ => _
| mkFail (S n) _ => _
end) fl).
The error I get when trying to execute this is
Toplevel input, characters 0-125:
Error: Illegal application (Type Error):
The term "mkFail" of type
"forall i : nat, (forall x : nat, x < i -> nat) -> fail"
cannot be applied to the terms
"i" : "nat"
"f0" : "forall x : nat, x < i0 -> nat"
The 2nd term has type "forall x : nat, x < i0 -> nat"
which should be coercible to "forall x : nat, x < i -> nat".
It seems that the substitution somehow does not reach the inner type parameters.
After playing with the Program command I managed to build a refine that might suites you, but I don't understand everything I did. The main idea is to help Coq with the substitution by introducing intermediate equalities that will serve as brige within the substitution
refine ((fun fl =>
match fl as fl0 return (fl0 = fl -> fail_hard_omat fl0 = 0) with
| mkFail n bar =>
match n as n0 return (forall foo: (forall x:nat, x < n0 -> nat),
mkFail n0 foo = fl -> fail_hard_omat (mkFail n0 foo) = 0) with
| O => _
| S p => _
end bar
end (eq_refl fl) ) fl).
Anyway, I don't know what your purpose here is, but I advise never write dependent match "by hand" and rely on Coq's tactics. In your case, if you define your Definition failomat with Defined. instead of Qed, you will be able to unfold it and you won't need dependent matching.
Hope it helps,
V.
Note: both occurences of bar can be replaced by an underscore.
Another, slightly less involved, alternative is to use nat and fail's induction combinators.
Print nat_rect.
Print fail_rect.
Definition failhard : forall fl, fail_hard_omat fl = 0.
Proof.
refine (fail_rect _ _). (* Performs induction (projection) on fl. *)
refine (nat_rect _ _ _). (* Performs induction on fl's first component. *)
Show Proof.