I am trying to define a function in Coq called interval that given two natural numbers computes the list of all natural numbers between these two. However my definition is not primitive-recursive. Here is my code:
Require Coq.Program.Tactics.
Require Coq.Program.Wf.
Inductive bool : Type :=
| true : bool
| false : bool.
Fixpoint leq_nat (m:nat) (n:nat) : bool :=
match m with
| 0 => true
| S x => match n with
| 0 => false
| S y => leq_nat x y
end
end.
Notation "m <= n" := (leq_nat m n).
Notation "x :: l" := (cons x l) (at level 60, right associativity).
Program Fixpoint intervalo (m:nat) (n:nat) {measure ((S n) - m)}: list nat :=
match m <= n with
| false => nil
| true => m :: (intervalo (S m) n)
end.
Next Obligation.
As you can see I am using well founded recursion on the length of the interval. I define the measure to be this value, i.e S n - m.
I would expect to be asked to proof that forall m, n, true = m <= n -> S n - S m < S n - m
However, the proof obligations that I get do not look like this and are rather confusing. I am asked to prove that:
m : nat
n : nat
intervalo : forall m0 n0 : nat,
match m0 with
| 0 => S n0
| S l => n0 - l
end < match m with
| 0 => S n
| S l => n - l
end -> list nat
Heq_anonymous : true = (m <= n)
============================
n - m < match m with
| 0 => S n
| S l => n - l
end
And that:
============================
well_founded
(Wf.MR lt
(fun recarg : {_ : nat & nat} =>
match projT1 recarg with
| 0 => S (projT2 recarg)
| S l => projT2 recarg - l
end))
Can someone please explain me why Coq asks me to prove this instead of just forall m, n, true = m <= n -> S n - S m < S n - m. In addition, how can I finish this proof? Or how can I make it look more like what I am expecting Coq to ask me to proof?
Thank you.
What confuses you here is that the term S n - m is partially unfolded and that you have an additional hypothesis. If you type:
clear intervalo.
change (match m with
| 0 => S n
| S l => n - l
end) with (S n - m).
change (n - m) with (S n - S m).
then you'll see that the first goal you're asked to prove is indeed a direct consequence of forall m, n, true = m <= n -> S n - S m < S n - m.
The second one is simply stating that your measure is well-founded (once more with some degree of unfolding of S n - m thrown in). I probably have a different version of Coq (version 8.5beta2) because in my case this thing is discharged automatically.
Related
Task: write a function to convert natural numbers to binary numbers.
Inductive bin : Type :=
| Z
| A (n : bin)
| B (n : bin).
(* Division by 2. Returns (quotient, remainder) *)
Fixpoint div2_aux (n accum : nat) : (nat * nat) :=
match n with
| O => (accum, O)
| S O => (accum, S O)
| S (S n') => div2_aux n' (S accum)
end.
Fixpoint nat_to_bin (n: nat) : bin :=
let (q, r) := (div2_aux n 0) in
match q, r with
| O, O => Z
| O, 1 => B Z
| _, O => A (nat_to_bin q)
| _, _ => B (nat_to_bin q)
end.
The 2-nd function gives an error, because it is not structurally recursive:
Recursive call to nat_to_bin has principal argument equal to
"q" instead of a subterm of "n".
What should I do to prove that it always terminates because q is always less then n.
Prove that q is (almost always) less than n:
(* This condition is sufficient, but a "better" one is n <> 0
That makes the actual function slightly more complicated, though *)
Theorem div2_aux_lt {n} (prf : fst (div2_aux n 0) <> 0) : fst (div2_aux n 0) < n.
(* The proof is somewhat involved...
I did it by proving
forall n k, n <> 0 ->
fst (div2_aux n k) < n + k /\ fst (div2_aux (S n) k) < S n + k
by induction on n first *)
Then proceed by well-founded induction on lt:
Require Import Arith.Wf_nat.
Definition nat_to_bin (n : nat) : bin :=
lt_wf_rec (* Recurse down a chain of lts instead of structurally *)
n (fun _ => bin) (* Starting from n and building a bin *)
(fun n rec => (* At each step, we have (n : nat) and (rec : forall m, m < n -> bin) *)
match div2_aux n 0 as qr return (fst qr <> 0 -> fst qr < n) -> _ with (* Take div2_aux_lt as an argument; within the match the (div2_aux_lt n 0) in its type is rewritten in terms of the matched variables *)
| (O, r) => fun _ => if r then Z else B Z (* Commoning up cases for brevity *)
| (S _ as q, r) => (* note: O is "true" and S _ is "false" *)
fun prf => (if r then A else B) (rec q (prf ltac:(discriminate)))
end div2_aux_lt).
I might suggest making div2_aux return nat * bool.
Alternatively, Program Fixpoint supports these kinds of induction, too:
Require Import Program.
(* I don't like the automatic introing in program_simpl and
now/easy can solve some of our obligations. *)
#[local] Obligation Tactic := (now program_simpl) + cbv zeta.
(* {measure n} is short for {measure n lt}, which can replace the
core language {struct arg} when in a Program Fixpoint
(n can be any expression and lt can be any well-founded relation
on the type of that expression) *)
#[program] Fixpoint nat_to_bin (n : nat) {measure n} : bin :=
match div2_aux n 0 with
| (O, O) => Z
| (O, _) => B Z
| (q, O) => A (nat_to_bin q)
| (q, _) => B (nat_to_bin q)
end.
Next Obligation.
intros n _ q [_ mem] prf%(f_equal fst).
simpl in *.
subst.
apply div2_aux_lt.
auto.
Defined.
Next Obligation.
intros n _ q r [mem _] prf%(f_equal fst).
specialize (mem r).
simpl in *.
subst.
apply div2_aux_lt.
auto.
Defined.
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
I've defined vector types on a type A by using functions as fin n -> A. I cannot come up with a way for concatenating the vectors without going through inductive vectors.
The definition of finite sets I am using is
Fixpoint fin (k : nat) : Type :=
match k with
| 0 => False
| S k => option (fin k)
end.
Then I define vectors of size k as functions fin k -> A.
How can I concatenate such vectors?
concat {A : Type} (n m : nat) (v1 : fin n -> A) (v2 : fin m -> A) (i : fin (n + m)) : A
I've tried pattern matching on n, but it doesn't seem to acknowledge then that i is of type fin m then in the 0 case.
I guess this is a well-known definition, but I couldn't find this variant of vectors. Maybe moving from this type to vectors in Coq's library, concatenate there, and then come back, is an option, but I would like to have a more direct approach.
The key is to write a case analysis operator to decide whether the input to the concatenated function is on the n side or the m side:
Fixpoint fin n :=
match n with
| 0 => Empty_set
| S n => option (fin n)
end.
Fixpoint case_fin n m : fin (n + m) -> fin n + fin m :=
match n return fin (n + m) -> fin n + fin m with
| 0 => fun i => inr i
| S n => fun i =>
match i with
| None => inl None
| Some j => match case_fin n m j with
| inl j => inl (Some j)
| inr j => inr j
end
end
end.
Fixpoint concat {A} n m (f : fin n -> A) (g : fin m -> A) (i : fin (n + m)) : A :=
match case_fin n m i with
| inl i => f i
| inr i => g i
end.
We have a function that inserts an element into a specific index of a list.
Fixpoint inject_into {A} (x : A) (l : list A) (n : nat) : option (list A) :=
match n, l with
| 0, _ => Some (x :: l)
| S k, [] => None
| S k, h :: t => let kwa := inject_into x t k
in match kwa with
| None => None
| Some l' => Some (h :: l')
end
end.
The following property of the aforementioned function is of relevance to the problem (proof omitted, straightforward induction on l with n not being fixed):
Theorem inject_correct_index : forall A x (l : list A) n,
n <= length l -> exists l', inject_into x l n = Some l'.
And we have a computational definition of permutations, with iota k being a list of nats [0...k]:
Fixpoint permute {A} (l : list A) : list (list A) :=
match l with
| [] => [[]]
| h :: t => flat_map (
fun x => map (
fun y => match inject_into h x y with
| None => []
| Some permutations => permutations
end
) (iota (length t))) (permute t)
end.
The theorem we're trying to prove:
Theorem num_permutations : forall A (l : list A) k,
length l = k -> length (permute l) = factorial k.
By induction on l we can (eventually) get to following goal: length (permute (a :: l)) = S (length l) * length (permute l). If we now simply cbn, the resulting goal is stated as follows:
length
(flat_map
(fun x : list A =>
map
(fun y : nat =>
match inject_into a x y with
| Some permutations => permutations
| None => []
end) (iota (length l))) (permute l)) =
length (permute l) + length l * length (permute l)
Here I would like to proceed by destruct (inject_into a x y), which is impossible considering x and y are lambda arguments. Please note that we will never get the None branch as a result of the lemma inject_correct_index.
How does one proceed from this proof state? (Please do note that I am not trying to simply complete the proof of the theorem, that's completely irrelevant.)
There is a way to rewrite under binders: the setoid_rewrite tactic (see ยง27.3.1 of the Coq Reference manual).
However, direct rewriting under lambdas is not possible without assuming an axiom as powerful as the axiom of functional extensionality (functional_extensionality).
Otherwise, we could have proved:
(* classical example *)
Goal (fun n => n + 0) = (fun n => n).
Fail setoid_rewrite <- plus_n_O.
Abort.
See here for more detail.
Nevertheless, if you are willing to accept such axiom, then you can use the approach described by Matthieu Sozeau in this Coq Club post to rewrite under lambdas like so:
Require Import Coq.Logic.FunctionalExtensionality.
Require Import Coq.Setoids.Setoid.
Require Import Coq.Classes.Morphisms.
Generalizable All Variables.
Instance pointwise_eq_ext {A B : Type} `(sb : subrelation B RB eq)
: subrelation (pointwise_relation A RB) eq.
Proof. intros f g Hfg. apply functional_extensionality. intro x; apply sb, (Hfg x). Qed.
Goal (fun n => n + 0) = (fun n => n).
setoid_rewrite <- plus_n_O.
reflexivity.
Qed.
I'm new to Coq and have a quick question about the destruct tactic. Suppose I have a count function that counts the number of occurrences of a given natural number in a list of natural numbers:
Fixpoint count (v : nat) (xs : natlist) : nat :=
match xs with
| nil => 0
| h :: t =>
match beq_nat h v with
| true => 1 + count v xs
| false => count v xs
end
end.
I'd like to prove the following theorem:
Theorem count_cons : forall (n y : nat) (xs : natlist),
count n (y :: xs) = count n xs + count n [y].
If I were proving the analogous theorem for n = 0, I could simply destruct y to 0 or S y'. For the general case, what I'd like to do is destruct (beq_nat n y) to true or false, but I can't seem to get that to work--I'm missing some piece of Coq syntax.
Any ideas?
Your code is broken
Fixpoint count (v : nat) (xs : natlist) : nat :=
match xs with
| nil => 0
| h :: t =>
match beq_nat h v with
| true => 1 + count v xs (*will not compile since "count v xs" is not simply recursive*)
| false => count v xs
end
end.
you probably meant
Fixpoint count (v : nat) (xs : natlist) : nat :=
match xs with
| nil => 0
| h :: t =>
match beq_nat h v with
| true => 1 + count v t
| false => count v t
end
end.
Using destruct is then a perfectly good way to get your solution. But, you need to keep a few things in mind
destruct is syntactic, that is it replaces terms that are expressed in your goal/assumptions. So, you normally need something like simpl (works here) or unfold first.
the order of terms matters. destruct (beq_nat n y) is not the same thing as destruct (beq_nat y n). In this case you want the second of those
Generally the problem is destruct is dumb, so you have to do the smarts yourself.
Anyways, start your proof
intros n y xs. simpl. destruct (beq_nat y n).
And all will be good.