1

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 ?

Sven Williamson
  • 1,094
  • 1
  • 10
  • 19

2 Answers2

2

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..

HTNW
  • 27,182
  • 1
  • 32
  • 60
  • FWIW, the module `Wf_nat` has `lt_wf : well_founed lt` and it is transparent, so using `lt_wf` instead of `LtWellFounded` solves the problem. – Anton Trunov Apr 06 '20 at 08:22
  • Thanks very much guys, and for the tips too... (head argument of ```fix``` point, ```Defined``` vs ```Qed```, ```lt_wf``` already exists) – Sven Williamson Apr 06 '20 at 08:48
1

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
larsr
  • 5,447
  • 19
  • 38