I am trying to write a function for computing natural division in Coq and I am having some trouble defining it since it is not structural recursion.
My code is:
Inductive N : Set :=
| O : N
| S : N -> N.
Inductive Bool : Set :=
| True : Bool
| False : Bool.
Fixpoint sum (m :N) (n : N) : N :=
match m with
| O => n
| S x => S ( sum x n)
end.
Notation "m + n" := (sum m n) (at level 50, left associativity).
Fixpoint mult (m :N) (n : N) : N :=
match m with
| O => O
| S x => n + (mult x n)
end.
Notation "m * n" := (mult m n) (at level 40, left associativity).
Fixpoint pred (m : N) : N :=
match m with
| O => S O
| S x => x
end.
Fixpoint resta (m:N) (n:N) : N :=
match n with
| O => m
| S x => pred (resta m x)
end.
Notation "m - x" := (resta m x) (at level 50, left associativity).
Fixpoint leq_nat (m : N) (n : N) : Bool :=
match m with
| O => True
| S x => match n with
| O => False
| S y => leq_nat x y
end
end.
Notation "m <= n" := (leq_nat m n) (at level 70).
Fixpoint div (m : N) (n : N) : N :=
match n with
| O => O
| S x => match m <= n with
| False => O
| True => pred (div (m-n) n)
end
end.
As you can see, Coq does not like my function div, it says
Error: Cannot guess decreasing argument of fix.
How can I supply in Coq a termination proof for this function? I can prove that if n>O ^ n<=m -> (m-n) < m.
The simplest strategy in this case is probably to use the Program extension together with a measure. You will then have to provide a proof that the arguments used in the recursive call are smaller than the top level ones according to the measure.
Require Coq.Program.Tactics.
Require Coq.Program.Wf.
Fixpoint toNat (m : N) : nat :=
match m with O => 0 | S n => 1 + (toNat n) end.
Program Fixpoint div (m : N) (n : N) {measure (toNat m)}: N :=
match n with
| O => O
| S x => match m <= n with
| False => O
| True => pred (div (m-n) n)
end
end.
Next Obligation.
(* your proof here *)
Although gallais's answer is definitely the way to go in general, I should point out that we can define division on the natural numbers in Coq as a simple fixpoint. Here, I'm using the definition of nat in the standard library for simplicity.
Fixpoint minus (n m : nat) {struct n} : nat :=
match n, m with
| S n', S m' => minus n' m'
| _, _ => n
end.
Definition leq (n m : nat) : bool :=
match minus n m with
| O => true
| _ => false
end.
Fixpoint div (n m : nat) {struct n} : nat :=
match m with
| O => O
| S m' =>
if leq (S m') n then
match n with
| O => O (* Impossible *)
| S n' => S (div (minus n' m') (S m'))
end
else O
end.
Compute div 6 3.
Compute div 7 3.
Compute div 9 3.
The definition of minus is essentially the one from the standard library. Notice on the second branch of that definition we return n. Thanks to this trick, Coq's termination checker can detect that minus n' m' is structurally smaller than S n', which allows us to perform the recursive call to div.
There's actually an even simpler way of doing this, although a bit harder to understand: you can check whether the divisor is smaller and perform the recursive call in a single step.
(* Divide n by m + 1 *)
Fixpoint div'_aux n m {struct n} :=
match minus n m with
| O => O
| S n' => S (div'_aux n' m)
end.
Definition div' n m :=
match m with
| O => O (* Arbitrary *)
| S m' => div'_aux n m'
end.
Compute div' 6 3.
Compute div' 7 3.
Compute div' 9 3.
Once again, because of the form of the minus function, Coq's termination checker knows that n' in the second branch of div'_aux is a valid argument to a recursive call. Notice also that div'_aux is dividing by m + 1.
Of course, this whole thing relies on a clever trick that requires understanding the termination checker in detail. In general, you have to resort to well-founded recursion, as gallais showed.
Related
I have defined a recursive function with fix, and now I want to prove a rewriting equation about it.
The function in question is a bit big, but here is another function that has the same problem.
(Here is an interactive collacoq with it: https://x80.org/collacoq/aweboxoxuy.coq)
Require Import Wf_nat PeanoNat.
Definition test (n: nat): nat.
refine (
let test :=
fix test n (H: Acc lt n) {struct H} :=
if Nat.eq_dec 0 n
then n
else n + test (n-1) _
in
test n (Wf_nat.lt_wf n)).
apply H; auto with arith.
Defined.
(* a unit test to see it works as intended. *)
Check eq_refl (test 4 = 4 + test 3).
I want to prove the following goal
Goal forall n, test (S n) = S n + test n.
Proof.
induction n.
reflexivity.
unfold test.
but when I start working on it, I get a proof term with fix test
Now I just want to unfold this once, but cbv delta evaluates too much.
How can I reduce the fix function definition just once?
Here is the proof obligation
n: nat
IHn: test (S n) = test n + S n
1/1
(fix test (n0 : nat) (H : Acc lt n0) {struct H} : nat :=
match Nat.eq_dec 0 n0 with
| left _ => n0
| right H0 =>
n0 +
test (n0 - 1)
(match H with
| Acc_intro _ H1 => H1
end (n0 - 1)
(Nat.sub_lt n0 1
(Arith_prebase.gt_le_S_stt 0 n0
(Arith_prebase.neq_0_lt_stt n0 H0))
(le_n 1)))
end) (S (S n)) (lt_wf (S (S n))) =
(fix test (n0 : nat) (H : Acc lt n0) {struct H} : nat :=
match Nat.eq_dec 0 n0 with
| left _ => n0
| right H0 =>
n0 +
test (n0 - 1)
(match H with
| Acc_intro _ H1 => H1
end (n0 - 1)
(Nat.sub_lt n0 1
(Arith_prebase.gt_le_S_stt 0 n0
(Arith_prebase.neq_0_lt_stt n0 H0))
(le_n 1)))
end) (S n) (lt_wf (S n)) + S (S n)
Working with function defined by well-foundness is always tricky. One reason is that you are often drown under big terms.
The main problem of your proof is (because of your induction) you are creating (S (S n)) so your function reduces too much by simplification!
As a matter of fact you don't need to prove your lemma by induction.
Let us try to convey some intuition. Your definition looks like.
test n = f n (lt_wf n)
so your function is defined by accessibility with the proof (lt_wf n). What you actually need to prove is that f does not depend on the actual proof.
Lemma f_eq : forall n H1 H2, f n H1 = f n H2.
and you will be able to perform simplification.
Here is a proof of your Lemma
Goal forall n, test (S n) = S n + test n.
Proof.
intros n.
apply f_equal2 with (f := Nat.add); [trivial |].
set (f := ((fix test (k : _) (H : Acc lt k) {struct H} : _ := _))).
set (H := (_ : Acc _ (S n - 1))).
assert (f_eq : forall n H1 H2, f n H1 = f n H2).
- intros n1.
induction n1.
+ intros H1 H2.
dependent inversion H1; dependent inversion H2; simpl; auto.
+ intros H1 H2.
dependent inversion H1; dependent inversion H2.
apply f_equal2 with (f := Nat.add).
* trivial.
* destruct n1; apply IHn1.
- destruct n; apply f_eq.
Qed.
Consider this example:
Inductive T :=
| foo : T
| bar : nat -> T -> T.
Fixpoint evalT (t:T) {struct t} : nat :=
match t with
| foo => 1
| bar n x => evalBar x n
end
with evalBar (x:T) (n:nat) {struct n} : nat :=
match n with
| O => 0
| S n' => (evalT x) + (evalBar x n')
end.
Coq rejects it with an error: Recursive call to evalBar has principal argument equal to "n" instead of "x".
I understand that termination checker got confused by two unrelated inductive types (T and nat). However, it looks like the function I am trying to define will indeed terminate. How can I make Coq accept it?
Another solution is to use a nested fixpoint.
Fixpoint evalT (t:T) {struct t} : nat :=
match t with
| foo => 1
| bar n x => let fix evalBar n {struct n} :=
match n with
| 0 => 0
| S n' => Nat.add (evalT x) (evalBar n')
end
in evalBar n
end.
The important point is to remove the argument x from evalBar. Thus the recursive call to evalT is done on the x from bar n x, not the x given as an argument to evalBar, and thus the termination checker can validate the definition of evalT.
This is the same idea that makes the version with nat_rec proposed in another answer work.
One solution I found is to use nat_rec instead of evalBar:
Fixpoint evalT (t:T) {struct t} : nat :=
match t with
| foo => 1
| bar n x => #nat_rec _ 0 (fun n' t' => (evalT x) + t') n
end.
It works but I wish I could hide nat_rec under evalBar definition to hide details. In my real project, such construct is used several times.
Implementing vector addition in some of the dependently typed languages (such as Idris) is fairly straightforward. As per the example on Wikipedia:
import Data.Vect
%default total
pairAdd : Num a => Vect n a -> Vect n a -> Vect n a
pairAdd Nil Nil = Nil
pairAdd (x :: xs) (y :: ys) = x + y :: pairAdd xs ys
(Note how Idris' totality checker automatically infers that addition of Nil and non-Nil vectors is a logical impossibility.)
I am trying to implement the equivalent functionality in Coq, using a custom vector implementation, albeit very similar to the one provided in the official Coq libraries:
Set Implicit Arguments.
Inductive vector (X : Type) : nat -> Type :=
| vnul : vector X 0
| vcons {n : nat} (h : X) (v : vector X n) : vector X (S n).
Arguments vnul [X].
Fixpoint vpadd {n : nat} (v1 v2 : vector nat n) : vector nat n :=
match v1 with
| vnul => vnul
| vcons _ x1 v1' =>
match v2 with
| vnul => False_rect _ _
| vcons _ x2 v2' => vcons (x1 + x2) (vpadd v1' v2')
end
end.
When Coq attempts to check vpadd, it yields the following error:
Error:
In environment
vpadd : forall n : nat, vector nat n -> vector nat n -> vector nat n
[... other types]
n0 : nat
v1' : vector nat n0
n1 : nat
v2' : vector nat n1
The term "v2'" has type "vector nat n1" while it is expected to have type "vector nat n0".
Note that, I use False_rect to specify the impossible case, otherwise the totality check wouldn't pass. However, for some reason the type checker doesn't manage to unify n0 with n1.
What am I doing wrong?
It's not possible to implement this function so easily in plain Coq: you need to rewrite your function using the convoy pattern. There was a similar question posted a while ago about this. The idea is that you need to make your match return a function in order to propagate the relation between the indices:
Set Implicit Arguments.
Inductive vector (X : Type) : nat -> Type :=
| vnul : vector X 0
| vcons {n : nat} (h : X) (v : vector X n) : vector X (S n).
Arguments vnul [X].
Definition vhd (X : Type) n (v : vector X (S n)) : X :=
match v with
| vcons _ h _ => h
end.
Definition vtl (X : Type) n (v : vector X (S n)) : vector X n :=
match v with
| vcons _ _ tl => tl
end.
Fixpoint vpadd {n : nat} (v1 v2 : vector nat n) : vector nat n :=
match v1 in vector _ n return vector nat n -> vector nat n with
| vnul => fun _ => vnul
| vcons _ x1 v1' => fun v2 => vcons (x1 + vhd v2) (vpadd v1' (vtl v2))
end v2.
I am interested in how would one define f to the n in Coq:
Basically, as an exercise, I would like to write this definition and then confirm that my
algorithm implements this specification. Inductive definition seems appropriate here, but I was not able to make it clean as above. What would be a clean Coq implementation of the above?
With the pow_func function that gallais defined, you can state your specification as lemmas, such as:
Lemma pow_func0: forall (A:Type) (f: A -> A) (x: A), pow_fun f O x = f x.
and
Lemma pow_funcS: forall (n:nat) (A: Type) (f: A->A) (x:A), pow_fun f (S n) x = f (pow_fun f n x).
The proof should be trivial by unfolding the definition
Inductive is used to define types closed under some operations; this is not what you are looking for here. What you want to build is a recursive function iterating over n. This can be done using the Fixpoint keyword:
Fixpoint pow_func {A : Type} (f : A -> A) (n : nat) (a : A) : A :=
match n with
| O => f a
| S n => f (pow_func f n a)
end.
If you want a nicer syntax for this function, you can introduce a Notation:
Notation "f ^ n" := (pow_func f n).
However, note that this is not a well-behaved definition of a notion of power: if you compose f ^ m and f ^ n, you don't get f ^ (m + n) but rather f ^ (1 + m + n). To fix that, you should pick the base case f ^ 0 to be the neutral element for composition id rather than f itself. Which would give you:
Fixpoint pow_func' {A : Type} (f : A -> A) (n : nat) (a : A) : A :=
match n with
| O => a
| S n => f (pow_func' f n a)
end.
I am working with a function that searches through a range of values.
Require Import List.
(* Implementation of ListTest omitted. *)
Definition ListTest (l : list nat) := false.
Definition SearchCountList n :=
(fix f i l := match i with
| 0 => ListTest (rev l)
| S i1 =>
(fix g j l1 := match j with
| 0 => false
| S j1 =>
if f i1 (j :: l1)
then true
else g j1 l1
end) (n + n) (i :: l)
end) n nil
.
I want to be able to reason about this function.
However, I can't seem to get coq's built-in induction principle facilities to work.
Functional Scheme SearchCountList := Induction for SearchCountList Sort Prop.
Error: GRec not handled
It looks like coq is set up for handling mutual recursion, not nested recursion. In this case, I have essentially 2 nested for loops.
However, translating to mutual recursion isn't so easy either:
Definition SearchCountList_Loop :=
fix outer n i l {struct i} :=
match i with
| 0 => ListTest (rev l)
| S i1 => inner n i1 (n + n) (i :: l)
end
with inner n i j l {struct j} :=
match j with
| 0 => false
| S j1 =>
if outer n i (j :: l)
then true
else inner n i j1 l
end
for outer
.
but that yields the error
Recursive call to inner has principal argument equal to
"n + n" instead of "i1".
So, it looks like I would need to use measure to get it to accept the definition directly. It is confused that I reset j sometimes. But, in a nested set up, that makes sense, since i has decreased, and i is the outer loop.
So, is there a standard way of handling nested recursion, as opposed to mutual recursion? Are there easier ways to reason about the cases, not involving making separate induction theorems? Since I haven't found a way to generate it automatically, I guess I'm stuck with writing the induction principle directly.
There's a trick for avoiding mutual recursion in this case: you can compute f i1 inside f and pass the result to g.
Fixpoint g (f_n_i1 : list nat -> bool) (j : nat) (l1 : list nat) : bool :=
match j with
| 0 => false
| S j1 => if f_n_i1 (j :: l1) then true else g f_n_i1 j1 l1
end.
Fixpoint f (n i : nat) (l : list nat) : bool :=
match i with
| 0 => ListTest (rev l)
| S i1 => g (f n i1) (n + n) (i :: l)
end.
Definition SearchCountList (n : nat) : bool := f n n nil.
Are you sure simple induction wouldn't have been enough in the original code? What about well founded induction?