Lecture 3: Natural Numbers

In this lecture, we build the natural numbers from scratch. We define:

a data type for natural numbers.
addition and multiplication functions.
the less-than-or-equal-to relation.
the Fibonacci function.
an iterative version of the Fibonacci function.

Our goal is to prove the correctness of the iterative version of the Fibonacci function. This involves properties of addition, multiplication, and the less-than-or-equal-to relation. We also need to prove the strong induction principle. With these tools, we can prove the correctness of the iterative version of the Fibonacci function.

Definition of natural numbers using inductive data type

Inductive nat :=
  | O : nat
  | S : nat -> nat.

Define some natural numbers

Definition zero := O.
Definition one := S O.
Definition two := S (S O).
Definition three := S (S (S O)).

Recursive definition of addition

Fixpoint add n m :=
  match n with
  | O => m
  | S n' => S (add n' m)
  end.

Compute 2 + 3

Compute (add two three).= S (S (S (S (S O))))
: nat

Coq can partially evaluate functions

Compute (fun x => add two x).= fun x : nat => S (S x)
: nat -> nat

It's not magic: it only applies reduction rules for function application and match on constructors

Compute (fun x => add x two).= fun x : nat =>
  (fix Ffix (x0 x1 : nat) {struct x0} : nat :=
     match x0 with
     | O => x1
     | S x2 => S (Ffix x2 x1)
     end) x (S (S O))
: nat -> nat

Check computes the type of a term

Check add.add
     : nat -> nat -> nat
Check two.two
     : nat
Check O.O
     : nat
Check S.S
     : nat -> nat
Check nat.nat
     : Set
Check (add two).add two
     : nat -> nat

We prove simple lemmas about addition by partial evaluation

Lemma add_0_n n : add O n = n.n: nat
add O n = n
Proof.n: nat
add O n = n
  simpl.  (* Simplify the goal by partial evaluation *)n: nat
n = n
  reflexivity.  (* Prove equality by reflexivity *)
Qed.

Lemma add_Sn_m n m : add (S n) m = S (add n m).n, m: nat
add (S n) m = S (add n m)
Proof.n, m: nat
add (S n) m = S (add n m)
  simpl.n, m: nat
S (add n m) = S (add n m)
  reflexivity.
Qed.

We prove that add is associative:

Lemma add_assoc a b c : add (add a b) c = add a (add b c).a, b, c: nat
add (add a b) c = add a (add b c)
Proof.a, b, c: nat
add (add a b) c = add a (add b c)
  induction a.b, c: nat
add (add O b) c = add O (add b c)
a, b, c: nat
IHa: add (add a b) c = add a (add b c)
add (add (S a) b) c = add (S a) (add b c)
  -b, c: nat
add (add O b) c = add O (add b c) simpl. (* Base case *)b, c: nat
add b c = add b c
    reflexivity.
  -a, b, c: nat
IHa: add (add a b) c = add a (add b c)
add (add (S a) b) c = add (S a) (add b c) simpl. (* Inductive case *)a, b, c: nat
IHa: add (add a b) c = add a (add b c)
S (add (add a b) c) = S (add a (add b c))
    rewrite IHa. (* Use the induction hypothesis *)a, b, c: nat
IHa: add (add a b) c = add a (add b c)
S (add a (add b c)) = S (add a (add b c)) 
    reflexivity.
Qed.

Proving that add is commutative is harder! Let's build up to it. We first need to prove a lemma about adding O on the right:

Lemma add_n_0 n : add n O = n.n: nat
add n O = n
Proof.n: nat
add n O = n
  simpl. (* Does nothing: partial evaluation not smart enough *)n: nat
add n O = n
  induction n. (* We have to do induction instead of simpl *)add O O = O
n: nat
IHn: add n O = n
add (S n) O = S n
  -add O O = O simpl.O = O
    reflexivity.
  -n: nat
IHn: add n O = n
add (S n) O = S n simpl.n: nat
IHn: add n O = n
S (add n O) = S n
    rewrite IHn.n: nat
IHn: add n O = n
S n = S n
    reflexivity.
Qed.

An inductive proof about S m on the right:

Lemma add_n_Sm n m : add n (S m) = S (add n m).n, m: nat
add n (S m) = S (add n m)
Proof.n, m: nat
add n (S m) = S (add n m)
  induction n.m: nat
add O (S m) = S (add O m)
n, m: nat
IHn: add n (S m) = S (add n m)
add (S n) (S m) = S (add (S n) m)
  -m: nat
add O (S m) = S (add O m) simpl.m: nat
S m = S m
    reflexivity.
  -n, m: nat
IHn: add n (S m) = S (add n m)
add (S n) (S m) = S (add (S n) m) simpl.n, m: nat
IHn: add n (S m) = S (add n m)
S (add n (S m)) = S (S (add n m))
    rewrite IHn.n, m: nat
IHn: add n (S m) = S (add n m)
S (S (add n m)) = S (S (add n m))
    reflexivity.
Qed.

Let's define an alternative version of addition that matches on m instead of n:

Fixpoint add' n m :=
  match m with
  | O => n
  | S m' => S (add' n m')
  end.

We prove that the two definitions of addition are equivalent:

Lemma add_add' n m : add n m = add' n m.n, m: nat
add n m = add' n m
Proof.n, m: nat
add n m = add' n m
  induction m.n: nat
add n O = add' n O
n, m: nat
IHm: add n m = add' n m
add n (S m) = add' n (S m)
  -n: nat
add n O = add' n O simpl.n: nat
add n O = n
    (* We could use rewrite & reflexivity here, *)
    (* but apply does it in one step *)
    apply add_n_0. 
  -n, m: nat
IHm: add n m = add' n m
add n (S m) = add' n (S m) simpl.n, m: nat
IHm: add n m = add' n m
add n (S m) = S (add' n m)
    rewrite add_n_Sm.n, m: nat
IHm: add n m = add' n m
S (add n m) = S (add' n m)
    rewrite IHm.n, m: nat
IHm: add n m = add' n m
S (add' n m) = S (add' n m)
    reflexivity.
Qed.

We can also prove commutativity of addition by induction:

Lemma add_comm n m : add n m = add m n.n, m: nat
add n m = add m n
Proof.n, m: nat
add n m = add m n
  induction n.m: nat
add O m = add m O
n, m: nat
IHn: add n m = add m n
add (S n) m = add m (S n)
  -m: nat
add O m = add m O simpl.m: nat
m = add m O 
    rewrite add_n_0.m: nat
m = m 
    reflexivity.
  -n, m: nat
IHn: add n m = add m n
add (S n) m = add m (S n) simpl.n, m: nat
IHn: add n m = add m n
S (add n m) = add m (S n) 
    rewrite add_n_Sm.n, m: nat
IHn: add n m = add m n
S (add n m) = S (add m n) 
    rewrite IHn.n, m: nat
IHn: add n m = add m n
S (add m n) = S (add m n) 
    reflexivity.
Qed.

Discrimination and injectivity of constructors

We can prove that if the sum of two numbers is zero, then both numbers must be zero:

Lemma add_0_inv n m : add n m = O -> n = O /\ m = O.n, m: nat
add n m = O -> n = O /\ m = O
Proof.n, m: nat
add n m = O -> n = O /\ m = O
  intros H. (* Introduce the hypothesis H : add n m = O *)n, m: nat
H: add n m = O
n = O /\ m = O
  destruct n. (* Destruct is like induction without the IH *)m: nat
H: add O m = O
O = O /\ m = O
n, m: nat
H: add (S n) m = O
S n = O /\ m = O
  -m: nat
H: add O m = O
O = O /\ m = O split. (* Split the n = O /\ m = O goal into two subgoals *)m: nat
H: add O m = O
O = O
m: nat
H: add O m = O
m = O
    +m: nat
H: add O m = O
O = O reflexivity.
    +m: nat
H: add O m = O
m = O simpl in H.m: nat
H: m = O
m = O
      apply H.
  -n, m: nat
H: add (S n) m = O
S n = O /\ m = O simpl in H.n, m: nat
H: S (add n m) = O
S n = O /\ m = O
    (* Now H is a contradiction: S and O can't be equal *)
    (* Discriminate proves the goal by contradiction *)
    discriminate. 
Qed.

The discriminate tactic is not necessary! We can prove the goal without using discriminate. To do that, we first define an alternative equality for natural numbers:

Definition nat_eq n m :=
  match n with
  | O => m = O
  | S n' =>
    match m with
    | O => False
    | S m' => n' = m'
    end
  end.

We then prove that nat_eq implies equality:

Lemma nat_eq_eq n m : nat_eq n m -> n = m.n, m: nat
nat_eq n m -> n = m
Proof.n, m: nat
nat_eq n m -> n = m
  intros H.n, m: nat
H: nat_eq n m
n = m
  destruct n.m: nat
H: nat_eq O m
O = m
n, m: nat
H: nat_eq (S n) m
S n = m
  -m: nat
H: nat_eq O m
O = m simpl in H.m: nat
H: m = O
O = m
    rewrite H.m: nat
H: m = O
O = O
    reflexivity.
  -n, m: nat
H: nat_eq (S n) m
S n = m simpl in H.n, m: nat
H: match m with
| O => False
| S m' => n = m'
end
S n = m
    destruct m.n: nat
H: False
S n = O
n, m: nat
H: n = m
S n = S m
    +n: nat
H: False
S n = O destruct H.
    +n, m: nat
H: n = m
S n = S m rewrite H.n, m: nat
H: n = m
S m = S m
      reflexivity. 
Qed.

Now we can finally prove that S n is not equal to O, without using discriminate:

Lemma S_not_O n : S n = O -> False.n: nat
S n = O -> False
Proof.n: nat
S n = O -> False
  intros H.n: nat
H: S n = O
False
  assert (H' : nat_eq (S n) O).n: nat
H: S n = O
nat_eq (S n) O
n: nat
H: S n = O
H': nat_eq (S n) O
False
  -n: nat
H: S n = O
nat_eq (S n) O rewrite H.n: nat
H: S n = O
nat_eq O O 
    simpl.n: nat
H: S n = O
O = O 
    constructor.
  -n: nat
H: S n = O
H': nat_eq (S n) O
False simpl in H'.n: nat
H: S n = O
H': False
False 
  apply H'.
Qed.

We can use the same definition of nat_eq to prove injectivity of S:

Lemma S_inj n m : S n = S m -> n = m.n, m: nat
S n = S m -> n = m
Proof.n, m: nat
S n = S m -> n = m
  intros H.n, m: nat
H: S n = S m
n = m
  assert (H' : nat_eq (S n) (S m)).n, m: nat
H: S n = S m
nat_eq (S n) (S m)
n, m: nat
H: S n = S m
H': nat_eq (S n) (S m)
n = m
  -n, m: nat
H: S n = S m
nat_eq (S n) (S m) rewrite H.n, m: nat
H: S n = S m
nat_eq (S m) (S m) 
    simpl.n, m: nat
H: S n = S m
m = m 
    constructor.
  -n, m: nat
H: S n = S m
H': nat_eq (S n) (S m)
n = m simpl in H'.n, m: nat
H: S n = S m
H': n = m
n = m 
    apply H'.
Qed.

We can also use the injection tactic:

Lemma S_inj' n m : S n = S m -> n = m.n, m: nat
S n = S m -> n = m
Proof.n, m: nat
S n = S m -> n = m
  intros H.n, m: nat
H: S n = S m
n = m
  injection H as H'.n, m: nat
H': n = m
n = m
  apply H'.
Qed.

Using the injectivity of S, we can prove that n is not equal to its successor:

Lemma S_n_not_n n : S n = n -> False.n: nat
S n = n -> False
Proof.n: nat
S n = n -> False
  induction n.S O = O -> False
n: nat
IHn: S n = n -> False
S (S n) = S n -> False
  -S O = O -> False apply S_not_O.
  -n: nat
IHn: S n = n -> False
S (S n) = S n -> False intros H.n: nat
IHn: S n = n -> False
H: S (S n) = S n
False 
    apply IHn.n: nat
IHn: S n = n -> False
H: S (S n) = S n
S n = n
    apply S_inj in H.n: nat
IHn: S n = n -> False
H: S n = n
S n = n
    apply H.
Qed.

Multiplication

We define multiplication:

Fixpoint mul n m :=
  match n with
  | O => O
  | S n' => add m (mul n' m)
  end.

Coq allows us to use operator notation:

Infix "+" := add.
Infix "*" := mul.

Some examples:

Compute (two + three).= S (S (S (S (S O))))
: nat
Compute (two * three).= S (S (S (S (S (S O)))))
: nat

Some lemmas about multiplication:

Lemma mul_n_0 n : n * zero = zero.n: nat
n * zero = zero
Proof.n: nat
n * zero = zero
  induction n.O * zero = zero
n: nat
IHn: n * zero = zero
S n * zero = zero
  -O * zero = zero simpl.O = zero reflexivity.
  -n: nat
IHn: n * zero = zero
S n * zero = zero simpl.n: nat
IHn: n * zero = zero
n * zero = zero rewrite IHn.n: nat
IHn: n * zero = zero
zero = zero reflexivity.
Qed.

Lemma mul_n_1 n : n * one = n.n: nat
n * one = n
Proof.n: nat
n * one = n
  induction n.O * one = O
n: nat
IHn: n * one = n
S n * one = S n
  -O * one = O simpl.O = O reflexivity.
  -n: nat
IHn: n * one = n
S n * one = S n simpl.n: nat
IHn: n * one = n
S (n * one) = S n rewrite IHn.n: nat
IHn: n * one = n
S n = S n reflexivity.
Qed.

Lemma mul_1_n n : one * n = n.n: nat
one * n = n
Proof.n: nat
one * n = n
  simpl.n: nat
n + O = n
  rewrite add_n_0.n: nat
n = n
  reflexivity.
Qed.

Lemma mul_add_l n m k : (n + m) * k = n * k + m * k.n, m, k: nat
(n + m) * k = n * k + m * k
Proof.n, m, k: nat
(n + m) * k = n * k + m * k
  induction n.m, k: nat
(O + m) * k = O * k + m * k
n, m, k: nat
IHn: (n + m) * k = n * k + m * k
(S n + m) * k = S n * k + m * k
  -m, k: nat
(O + m) * k = O * k + m * k simpl.m, k: nat
m * k = m * k reflexivity.
  -n, m, k: nat
IHn: (n + m) * k = n * k + m * k
(S n + m) * k = S n * k + m * k simpl.n, m, k: nat
IHn: (n + m) * k = n * k + m * k
k + (n + m) * k = k + n * k + m * k rewrite IHn.n, m, k: nat
IHn: (n + m) * k = n * k + m * k
k + (n * k + m * k) = k + n * k + m * k rewrite add_assoc.n, m, k: nat
IHn: (n + m) * k = n * k + m * k
k + (n * k + m * k) = k + (n * k + m * k) reflexivity.
Qed.

Lemma mul_add_r n m k : n * (m + k) = n * m + n * k.n, m, k: nat
n * (m + k) = n * m + n * k
Proof.n, m, k: nat
n * (m + k) = n * m + n * k
  induction n.m, k: nat
O * (m + k) = O * m + O * k
n, m, k: nat
IHn: n * (m + k) = n * m + n * k
S n * (m + k) = S n * m + S n * k
  -m, k: nat
O * (m + k) = O * m + O * k simpl.m, k: nat
O = O reflexivity.
  -n, m, k: nat
IHn: n * (m + k) = n * m + n * k
S n * (m + k) = S n * m + S n * k simpl.n, m, k: nat
IHn: n * (m + k) = n * m + n * k
m + k + n * (m + k) = m + n * m + (k + n * k) rewrite IHn.n, m, k: nat
IHn: n * (m + k) = n * m + n * k
m + k + (n * m + n * k) = m + n * m + (k + n * k)
    rewrite <-!add_assoc. (* Rewrite backwards repeatedly *)n, m, k: nat
IHn: n * (m + k) = n * m + n * k
m + k + n * m + n * k = m + n * m + k + n * k
    f_equal. (* Convenient for simplifying f x = f y to x = y *)n, m, k: nat
IHn: n * (m + k) = n * m + n * k
m + k + n * m = m + n * m + k 
    rewrite !add_assoc.n, m, k: nat
IHn: n * (m + k) = n * m + n * k
m + (k + n * m) = m + (n * m + k) 
    f_equal.n, m, k: nat
IHn: n * (m + k) = n * m + n * k
k + n * m = n * m + k
    apply add_comm.
Qed.

Less-than-or-equal-to

We define le x y as a function, and define the notation x <= y to be le x y.

Fixpoint le n m :=
  match n with
  | O => True
  | S n' =>
    match m with
    | O => False
    | S m' => le n' m'
    end
  end.

Notation "n <= m" := (le n m).

Lemma le_refl n : n <= n.n: nat
n <= n
Proof.n: nat
n <= n
  induction n.O <= O
n: nat
IHn: n <= n
S n <= S n
  -O <= O simpl.True constructor.
  -n: nat
IHn: n <= n
S n <= S n simpl.n: nat
IHn: n <= n
n <= n apply IHn.
Qed.

Lemma le_trans n m k : n <= m -> m <= k -> n <= k.n, m, k: nat
n <= m -> m <= k -> n <= k
Proof.n, m, k: nat
n <= m -> m <= k -> n <= k
  revert m k.n: nat
forall m k : nat, n <= m -> m <= k -> n <= k
  induction n.forall m k : nat, O <= m -> m <= k -> O <= k
n: nat
IHn: forall m k : nat, n <= m -> m <= k -> n <= k
forall m k : nat, S n <= m -> m <= k -> S n <= k
  -forall m k : nat, O <= m -> m <= k -> O <= k intros m k Hnm Hmk.m, k: nat
Hnm: O <= m
Hmk: m <= k
O <= k simpl.m, k: nat
Hnm: O <= m
Hmk: m <= k
True constructor.
  -n: nat
IHn: forall m k : nat, n <= m -> m <= k -> n <= k
forall m k : nat, S n <= m -> m <= k -> S n <= k intros m k Hnm Hmk.n: nat
IHn: forall m k : nat, n <= m -> m <= k -> n <= k
m, k: nat
Hnm: S n <= m
Hmk: m <= k
S n <= k simpl in *.n: nat
IHn: forall m k : nat, n <= m -> m <= k -> n <= k
m, k: nat
Hnm: match m with
| O => False
| S m' => n <= m'
end
Hmk: m <= k
match k with
| O => False
| S m' => n <= m'
end
    destruct m.n: nat
IHn: forall m k : nat, n <= m -> m <= k -> n <= k
k: nat
Hnm: False
Hmk: O <= k
match k with
| O => False
| S m' => n <= m'
end
n: nat
IHn: forall m k : nat, n <= m -> m <= k -> n <= k
m, k: nat
Hnm: n <= m
Hmk: S m <= k
match k with
| O => False
| S m' => n <= m'
end {n: nat
IHn: forall m k : nat, n <= m -> m <= k -> n <= k
k: nat
Hnm: False
Hmk: O <= k
match k with
| O => False
| S m' => n <= m'
end destruct Hnm. }n: nat
IHn: forall m k : nat, n <= m -> m <= k -> n <= k
m, k: nat
Hnm: n <= m
Hmk: S m <= k
match k with
| O => False
| S m' => n <= m'
end
    destruct k.n: nat
IHn: forall m k : nat, n <= m -> m <= k -> n <= k
m: nat
Hnm: n <= m
Hmk: S m <= O
False
n: nat
IHn: forall m k : nat, n <= m -> m <= k -> n <= k
m, k: nat
Hnm: n <= m
Hmk: S m <= S k
n <= k {n: nat
IHn: forall m k : nat, n <= m -> m <= k -> n <= k
m: nat
Hnm: n <= m
Hmk: S m <= O
False destruct Hmk. }n: nat
IHn: forall m k : nat, n <= m -> m <= k -> n <= k
m, k: nat
Hnm: n <= m
Hmk: S m <= S k
n <= k
    simpl in Hmk.n: nat
IHn: forall m k : nat, n <= m -> m <= k -> n <= k
m, k: nat
Hnm: n <= m
Hmk: m <= k
n <= k
    apply (IHn m k).n: nat
IHn: forall m k : nat, n <= m -> m <= k -> n <= k
m, k: nat
Hnm: n <= m
Hmk: m <= k
n <= m
n: nat
IHn: forall m k : nat, n <= m -> m <= k -> n <= k
m, k: nat
Hnm: n <= m
Hmk: m <= k
m <= k
    +n: nat
IHn: forall m k : nat, n <= m -> m <= k -> n <= k
m, k: nat
Hnm: n <= m
Hmk: m <= k
n <= m apply Hnm.
    +n: nat
IHn: forall m k : nat, n <= m -> m <= k -> n <= k
m, k: nat
Hnm: n <= m
Hmk: m <= k
m <= k apply Hmk.
Qed.

Define strict inequality:

Definition lt n m := S n <= m. (* n < m iff n+1 <= m, for nat *)
Notation "n < m" := (lt n m).

Strong induction

Lemma strong_induction n (P : nat -> Prop) : 
  (forall n, (forall m, m < n -> P m) -> P n) -> P n.n: nat
P: nat -> Prop
(forall n : nat, (forall m : nat, m < n -> P m) -> P n) ->
P n
Proof.n: nat
P: nat -> Prop
(forall n : nat, (forall m : nat, m < n -> P m) -> P n) ->
P n
  intros H.n: nat
P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
P n
  apply H.n: nat
P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
forall m : nat, m < n -> P m
  induction n.P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
forall m : nat, m < O -> P m
n: nat
P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
IHn: forall m : nat, m < n -> P m
forall m : nat, m < S n -> P m
  -P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
forall m : nat, m < O -> P m intros m Hm.P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
m: nat
Hm: m < O
P m
    unfold "<" in Hm.P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
m: nat
Hm: S m <= O
P m
    simpl in Hm.P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
m: nat
Hm: False
P m
    destruct Hm.
  -n: nat
P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
IHn: forall m : nat, m < n -> P m
forall m : nat, m < S n -> P m intros m Hm.n: nat
P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
IHn: forall m : nat, m < n -> P m
m: nat
Hm: m < S n
P m
    unfold "<" in Hm.n: nat
P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
IHn: forall m : nat, m < n -> P m
m: nat
Hm: S m <= S n
P m
    simpl in Hm.n: nat
P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
IHn: forall m : nat, m < n -> P m
m: nat
Hm: m <= n
P m
    eapply H.n: nat
P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
IHn: forall m : nat, m < n -> P m
m: nat
Hm: m <= n
forall m0 : nat, m0 < m -> P m0
    intros k Hk.n: nat
P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
IHn: forall m : nat, m < n -> P m
m: nat
Hm: m <= n
k: nat
Hk: k < m
P k
    apply IHn.n: nat
P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
IHn: forall m : nat, m < n -> P m
m: nat
Hm: m <= n
k: nat
Hk: k < m
k < n
    apply (le_trans (S k) m n).n: nat
P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
IHn: forall m : nat, m < n -> P m
m: nat
Hm: m <= n
k: nat
Hk: k < m
S k <= m
n: nat
P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
IHn: forall m : nat, m < n -> P m
m: nat
Hm: m <= n
k: nat
Hk: k < m
m <= n
    +n: nat
P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
IHn: forall m : nat, m < n -> P m
m: nat
Hm: m <= n
k: nat
Hk: k < m
S k <= m apply Hk.
    +n: nat
P: nat -> Prop
H: forall n : nat,
(forall m : nat, m < n -> P m) -> P n
IHn: forall m : nat, m < n -> P m
m: nat
Hm: m <= n
k: nat
Hk: k < m
m <= n apply Hm.
Qed.

Fibonacci

Let's define the Fibonacci function:

Fixpoint fib n :=
  match n with
  | O => O
  | S n' =>
    match n' with
    | O => S O
    | S n'' => fib n' + fib n''
    end
  end.

Compute (fib (two * three)).= S (S (S (S (S (S (S (S O)))))))
: nat

An iterative version of Fibonacci:

Fixpoint fib_iter n a b :=
  match n with
  | O => a
  | S m => fib_iter m b (a + b)
  end.

Definition fib' n := fib_iter n zero one.

Compute (fib' (two * three)).= S (S (S (S (S (S (S (S O)))))))
: nat
Compute (fib (two * three)).= S (S (S (S (S (S (S (S O)))))))
: nat

Compute (fib (two + two)).= S (S (S O))
: nat
Compute (fib' (two + two)).= S (S (S O))
: nat

Exercise: Correctness of iterative Fibonacci

Lemma fib'_correct n : fib' n = fib n.n: nat
fib' n = fib n
Proof.n: nat
fib' n = fib n
Admitted.

Try it yourself before looking at the solution below!

Solution 1:

Lemma fib_iter_add n a a' b b' : 
  fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'.n, a, a', b, b': nat
fib_iter n (a + a') (b + b') =
fib_iter n a b + fib_iter n a' b'
Proof.n, a, a', b, b': nat
fib_iter n (a + a') (b + b') =
fib_iter n a b + fib_iter n a' b'
  revert a a' b b'.n: nat
forall a a' b b' : nat,
fib_iter n (a + a') (b + b') =
fib_iter n a b + fib_iter n a' b'
  induction n.forall a a' b b' : nat,
fib_iter O (a + a') (b + b') =
fib_iter O a b + fib_iter O a' b'
n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
forall a a' b b' : nat,
fib_iter (S n) (a + a') (b + b') =
fib_iter (S n) a b + fib_iter (S n) a' b'
  -forall a a' b b' : nat,
fib_iter O (a + a') (b + b') =
fib_iter O a b + fib_iter O a' b' simpl.forall a a' : nat, nat -> nat -> a + a' = a + a' reflexivity.
  -n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
forall a a' b b' : nat,
fib_iter (S n) (a + a') (b + b') =
fib_iter (S n) a b + fib_iter (S n) a' b' intros a a' b b'.n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
a, a', b, b': nat
fib_iter (S n) (a + a') (b + b') =
fib_iter (S n) a b + fib_iter (S n) a' b'
    simpl.n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
a, a', b, b': nat
fib_iter n (b + b') (a + a' + (b + b')) =
fib_iter n b (a + b) + fib_iter n b' (a' + b')
    rewrite <-IHn.n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
a, a', b, b': nat
fib_iter n (b + b') (a + a' + (b + b')) =
fib_iter n (b + b') (a + b + (a' + b'))
    f_equal.n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
a, a', b, b': nat
a + a' + (b + b') = a + b + (a' + b')
    assert (a + a' + (b + b') = a + (a' + b) + b') as ->.n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
a, a', b, b': nat
a + a' + (b + b') = a + (a' + b) + b'
n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
a, a', b, b': nat
a + (a' + b) + b' = a + b + (a' + b')
    {n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
a, a', b, b': nat
a + a' + (b + b') = a + (a' + b) + b' rewrite !add_assoc.n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
a, a', b, b': nat
a + (a' + (b + b')) = a + (a' + (b + b')) reflexivity. }n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
a, a', b, b': nat
a + (a' + b) + b' = a + b + (a' + b')
    assert (a + b + (a' + b') = a + (b + a') + b') as ->.n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
a, a', b, b': nat
a + b + (a' + b') = a + (b + a') + b'
n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
a, a', b, b': nat
a + (a' + b) + b' = a + (b + a') + b'
    {n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
a, a', b, b': nat
a + b + (a' + b') = a + (b + a') + b' rewrite !add_assoc.n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
a, a', b, b': nat
a + (b + (a' + b')) = a + (b + (a' + b')) reflexivity. }n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
a, a', b, b': nat
a + (a' + b) + b' = a + (b + a') + b'
    f_equal.n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
a, a', b, b': nat
a + (a' + b) = a + (b + a') f_equal.n: nat
IHn: forall a a' b b' : nat,
fib_iter n (a + a') (b + b') = fib_iter n a b + fib_iter n a' b'
a, a', b, b': nat
a' + b = b + a'
    apply add_comm.
Qed.

Fixpoint fib_rec n a b :=
  match n with
  | O => a
  | S m => 
    match m with
    | O => b
    | S k => fib_rec m a b + fib_rec k a b
    end
  end.

Lemma le_S n : n <= S n.n: nat
n <= S n
Proof.n: nat
n <= S n
  induction n.O <= S O
n: nat
IHn: n <= S n
S n <= S (S n)
  -O <= S O simpl.True constructor.
  -n: nat
IHn: n <= S n
S n <= S (S n) simpl.n: nat
IHn: n <= S n
n <= S n apply IHn.
Qed.

Lemma fib_iter_fib_rec n a b : fib_iter n a b = fib_rec n a b.n, a, b: nat
fib_iter n a b = fib_rec n a b
Proof.n, a, b: nat
fib_iter n a b = fib_rec n a b
  revert a b.n: nat
forall a b : nat, fib_iter n a b = fib_rec n a b
  induction n as [n IH] using strong_induction.n: nat
IH: forall m : nat,
m < n ->
forall a b : nat, fib_iter m a b = fib_rec m a b
forall a b : nat, fib_iter n a b = fib_rec n a b
  intros a b.n: nat
IH: forall m : nat,
m < n ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
fib_iter n a b = fib_rec n a b
  destruct n.IH: forall m : nat,
m < O ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
fib_iter O a b = fib_rec O a b
n: nat
IH: forall m : nat,
m < S n ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
fib_iter (S n) a b = fib_rec (S n) a b {IH: forall m : nat,
m < O ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
fib_iter O a b = fib_rec O a b reflexivity. }n: nat
IH: forall m : nat,
m < S n ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
fib_iter (S n) a b = fib_rec (S n) a b
  simpl.n: nat
IH: forall m : nat,
m < S n ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
fib_iter n b (a + b) =
match n with
| O => b
| S k => fib_rec n a b + fib_rec k a b
end
  destruct n.IH: forall m : nat,
m < S O ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
fib_iter O b (a + b) = b
n: nat
IH: forall m : nat,
m < S (S n) ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
fib_iter (S n) b (a + b) =
fib_rec (S n) a b + fib_rec n a b {IH: forall m : nat,
m < S O ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
fib_iter O b (a + b) = b simpl.IH: forall m : nat,
m < S O ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
b = b reflexivity. }n: nat
IH: forall m : nat,
m < S (S n) ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
fib_iter (S n) b (a + b) =
fib_rec (S n) a b + fib_rec n a b
  rewrite <-!IH.n: nat
IH: forall m : nat,
m < S (S n) ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
fib_iter (S n) b (a + b) =
fib_iter (S n) a b + fib_iter n a b
n: nat
IH: forall m : nat,
m < S (S n) ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
n < S (S n)
n: nat
IH: forall m : nat,
m < S (S n) ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
S n < S (S n)
  -n: nat
IH: forall m : nat,
m < S (S n) ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
fib_iter (S n) b (a + b) =
fib_iter (S n) a b + fib_iter n a b simpl.n: nat
IH: forall m : nat,
m < S (S n) ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
fib_iter n (a + b) (b + (a + b)) =
fib_iter n b (a + b) + fib_iter n a b rewrite fib_iter_add.n: nat
IH: forall m : nat,
m < S (S n) ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
fib_iter n a b + fib_iter n b (a + b) =
fib_iter n b (a + b) + fib_iter n a b
    apply add_comm.
  -n: nat
IH: forall m : nat,
m < S (S n) ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
n < S (S n) unfold "<".n: nat
IH: forall m : nat,
m < S (S n) ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
S n <= S (S n) simpl.n: nat
IH: forall m : nat,
m < S (S n) ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
n <= S n apply le_S.
  -n: nat
IH: forall m : nat,
m < S (S n) ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
S n < S (S n) unfold "<".n: nat
IH: forall m : nat,
m < S (S n) ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
S (S n) <= S (S n) simpl.n: nat
IH: forall m : nat,
m < S (S n) ->
forall a b : nat, fib_iter m a b = fib_rec m a b
a, b: nat
n <= n apply le_refl.
Qed.

Lemma fib_fib_rec n : fib n = fib_rec n zero one.n: nat
fib n = fib_rec n zero one
Proof.n: nat
fib n = fib_rec n zero one
  induction n using strong_induction.n: nat
H: forall m : nat,
m < n -> fib m = fib_rec m zero one
fib n = fib_rec n zero one
  destruct n.H: forall m : nat,
m < O -> fib m = fib_rec m zero one
fib O = fib_rec O zero one
n: nat
H: forall m : nat,
m < S n -> fib m = fib_rec m zero one
fib (S n) = fib_rec (S n) zero one {H: forall m : nat,
m < O -> fib m = fib_rec m zero one
fib O = fib_rec O zero one reflexivity. }n: nat
H: forall m : nat,
m < S n -> fib m = fib_rec m zero one
fib (S n) = fib_rec (S n) zero one
  simpl.n: nat
H: forall m : nat,
m < S n -> fib m = fib_rec m zero one
match n with
| O => S O
| S n'' => fib n + fib n''
end =
match n with
| O => one
| S k => fib_rec n zero one + fib_rec k zero one
end 
  destruct n.H: forall m : nat,
m < S O -> fib m = fib_rec m zero one
S O = one
n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_rec m zero one
fib (S n) + fib n =
fib_rec (S n) zero one + fib_rec n zero one {H: forall m : nat,
m < S O -> fib m = fib_rec m zero one
S O = one reflexivity. }n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_rec m zero one
fib (S n) + fib n =
fib_rec (S n) zero one + fib_rec n zero one
  rewrite !H.n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_rec m zero one
fib_rec (S n) zero one + fib_rec n zero one =
fib_rec (S n) zero one + fib_rec n zero one
n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_rec m zero one
n < S (S n)
n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_rec m zero one
S n < S (S n)
  -n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_rec m zero one
fib_rec (S n) zero one + fib_rec n zero one =
fib_rec (S n) zero one + fib_rec n zero one reflexivity.
  -n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_rec m zero one
n < S (S n) unfold "<".n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_rec m zero one
S n <= S (S n) simpl.n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_rec m zero one
n <= S n apply le_S.
  -n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_rec m zero one
S n < S (S n) unfold "<".n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_rec m zero one
S (S n) <= S (S n) simpl.n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_rec m zero one
n <= n apply le_refl.
Qed.

Lemma fib'_correct_1 n : fib n = fib' n.n: nat
fib n = fib' n
Proof.n: nat
fib n = fib' n
  rewrite fib_fib_rec.n: nat
fib_rec n zero one = fib' n unfold fib'.n: nat
fib_rec n zero one = fib_iter n zero one
  rewrite fib_iter_fib_rec.n: nat
fib_rec n zero one = fib_rec n zero one
  reflexivity.
Qed.

Solution 2:

Lemma fib_iter_lin n a b : 
  fib_iter n a b = a * fib_iter n one zero + b * fib_iter n zero one.n, a, b: nat
fib_iter n a b =
a * fib_iter n one zero + b * fib_iter n zero one
Proof.n, a, b: nat
fib_iter n a b =
a * fib_iter n one zero + b * fib_iter n zero one
  revert a b.n: nat
forall a b : nat,
fib_iter n a b =
a * fib_iter n one zero + b * fib_iter n zero one
  induction n.forall a b : nat,
fib_iter O a b =
a * fib_iter O one zero + b * fib_iter O zero one
n: nat
IHn: forall a b : nat,
fib_iter n a b = a * fib_iter n one zero + b * fib_iter n zero one
forall a b : nat,
fib_iter (S n) a b =
a * fib_iter (S n) one zero +
b * fib_iter (S n) zero one
  -forall a b : nat,
fib_iter O a b =
a * fib_iter O one zero + b * fib_iter O zero one intros a b.a, b: nat
fib_iter O a b =
a * fib_iter O one zero + b * fib_iter O zero one simpl.a, b: nat
a = a * one + b * zero rewrite mul_n_0, mul_n_1, add_n_0.a, b: nat
a = a reflexivity.
  -n: nat
IHn: forall a b : nat,
fib_iter n a b = a * fib_iter n one zero + b * fib_iter n zero one
forall a b : nat,
fib_iter (S n) a b =
a * fib_iter (S n) one zero +
b * fib_iter (S n) zero one intros a b.n: nat
IHn: forall a b : nat,
fib_iter n a b = a * fib_iter n one zero + b * fib_iter n zero one
a, b: nat
fib_iter (S n) a b =
a * fib_iter (S n) one zero +
b * fib_iter (S n) zero one simpl.n: nat
IHn: forall a b : nat,
fib_iter n a b = a * fib_iter n one zero + b * fib_iter n zero one
a, b: nat
fib_iter n b (a + b) =
a * fib_iter n zero (S zero) + b * fib_iter n one one
    rewrite IHn.n: nat
IHn: forall a b : nat,
fib_iter n a b = a * fib_iter n one zero + b * fib_iter n zero one
a, b: nat
b * fib_iter n one zero +
(a + b) * fib_iter n zero one =
a * fib_iter n zero (S zero) + b * fib_iter n one one rewrite (IHn one one).n: nat
IHn: forall a b : nat,
fib_iter n a b = a * fib_iter n one zero + b * fib_iter n zero one
a, b: nat
b * fib_iter n one zero +
(a + b) * fib_iter n zero one =
a * fib_iter n zero (S zero) +
b *
(one * fib_iter n one zero + one * fib_iter n zero one)
    rewrite !mul_1_n.n: nat
IHn: forall a b : nat,
fib_iter n a b = a * fib_iter n one zero + b * fib_iter n zero one
a, b: nat
b * fib_iter n one zero +
(a + b) * fib_iter n zero one =
a * fib_iter n zero (S zero) +
b * (fib_iter n one zero + fib_iter n zero one)
    rewrite !mul_add_l, !mul_add_r.n: nat
IHn: forall a b : nat,
fib_iter n a b = a * fib_iter n one zero + b * fib_iter n zero one
a, b: nat
b * fib_iter n one zero +
(a * fib_iter n zero one + b * fib_iter n zero one) =
a * fib_iter n zero (S zero) +
(b * fib_iter n one zero + b * fib_iter n zero one)
    rewrite <-!add_assoc.n: nat
IHn: forall a b : nat,
fib_iter n a b = a * fib_iter n one zero + b * fib_iter n zero one
a, b: nat
b * fib_iter n one zero + a * fib_iter n zero one +
b * fib_iter n zero one =
a * fib_iter n zero (S zero) + b * fib_iter n one zero +
b * fib_iter n zero one f_equal.n: nat
IHn: forall a b : nat,
fib_iter n a b = a * fib_iter n one zero + b * fib_iter n zero one
a, b: nat
b * fib_iter n one zero + a * fib_iter n zero one =
a * fib_iter n zero (S zero) + b * fib_iter n one zero
    apply add_comm.
Qed.

Lemma fib'_correct_2 n : fib n = fib' n.n: nat
fib n = fib' n
Proof.n: nat
fib n = fib' n
  unfold fib'.n: nat
fib n = fib_iter n zero one
  induction n using strong_induction.n: nat
H: forall m : nat,
m < n -> fib m = fib_iter m zero one
fib n = fib_iter n zero one
  destruct n.H: forall m : nat,
m < O -> fib m = fib_iter m zero one
fib O = fib_iter O zero one
n: nat
H: forall m : nat,
m < S n -> fib m = fib_iter m zero one
fib (S n) = fib_iter (S n) zero one {H: forall m : nat,
m < O -> fib m = fib_iter m zero one
fib O = fib_iter O zero one reflexivity. }n: nat
H: forall m : nat,
m < S n -> fib m = fib_iter m zero one
fib (S n) = fib_iter (S n) zero one
  simpl.n: nat
H: forall m : nat,
m < S n -> fib m = fib_iter m zero one
match n with
| O => S O
| S n'' => fib n + fib n''
end = fib_iter n one one
  destruct n.H: forall m : nat,
m < S O -> fib m = fib_iter m zero one
S O = fib_iter O one one
n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_iter m zero one
fib (S n) + fib n = fib_iter (S n) one one {H: forall m : nat,
m < S O -> fib m = fib_iter m zero one
S O = fib_iter O one one reflexivity. }n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_iter m zero one
fib (S n) + fib n = fib_iter (S n) one one
  rewrite fib_iter_lin.n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_iter m zero one
fib (S n) + fib n =
one * fib_iter (S n) one zero +
one * fib_iter (S n) zero one
  rewrite !H.n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_iter m zero one
fib_iter (S n) zero one + fib_iter n zero one =
one * fib_iter (S n) one zero +
one * fib_iter (S n) zero one
n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_iter m zero one
n < S (S n)
n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_iter m zero one
S n < S (S n)
  -n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_iter m zero one
fib_iter (S n) zero one + fib_iter n zero one =
one * fib_iter (S n) one zero +
one * fib_iter (S n) zero one simpl.n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_iter m zero one
fib_iter n one one + fib_iter n zero one =
fib_iter n zero (S zero) + O +
(fib_iter n one one + O) rewrite !add_n_0.n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_iter m zero one
fib_iter n one one + fib_iter n zero one =
fib_iter n zero (S zero) + fib_iter n one one apply add_comm.
  -n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_iter m zero one
n < S (S n) unfold "<".n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_iter m zero one
S n <= S (S n) simpl.n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_iter m zero one
n <= S n apply le_S.
  -n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_iter m zero one
S n < S (S n) unfold "<".n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_iter m zero one
S (S n) <= S (S n) simpl.n: nat
H: forall m : nat,
m < S (S n) -> fib m = fib_iter m zero one
n <= n apply le_refl.
Qed.