coqlogical-foundations

Coq: unary to binary convertion


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.


Solution

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