Geek Answers Handbook

How to get Coq to evaluate a specific redex (or - why does it refuse in this case?)

When I try to prove the recursive function theorem (see below), I end up with the reducible expression

(fix picksome L H := match A with .... end) L1 H1 = RHS

I would like to expand the expression match, but Coq refuses. Execution simplsimply extends the right side into an unreadable mess. Why can't Coq complete the proof with simpl; reflexivity, and how should Coq be instructed to accurately extend redex and complete the proof?

A function is a recursive function pickthat takes list natand takes the first nat, called a, discards the following elements afrom the list and returns to the remaining list. I.e

pick [2;3;4;0;1;3])=[2; 0; 1]

The theorem I'm trying to prove is that the function "does nothing" in lists that contains only zeros. Here is the development that leads to the problem:

Require Import Arith.
Require Import List.
Import ListNotations.

Fixpoint drop {T} n (l:list T) :=
  match n,l with
    | S n', cons _ l' => drop n' l'
    | O, _ => l
    | _, _ => nil
  end.

The first lemma:

Lemma drop_lemma_le : forall {T} n (l:list T), length (drop n l) <= (length l).
Proof.
  intros; generalize n; induction l; intros; destruct n0; try reflexivity;
  apply le_S; apply IHl.
Defined.

The second lemma:

Lemma picksome_term: forall l l' (a :nat),
       l = a::l' -> Acc lt (length l) ->  Acc lt (length (drop a l')).
Proof.
  intros; apply H0; rewrite H; simpl; apply le_lt_n_Sm; apply drop_lemma_le.
Defined.

A few more definitions:

Fixpoint picksome (l:list nat) (H : Acc lt (length l)) {struct H}: list nat :=
  match l as m return l=m -> _ with
    | nil       => fun _  => nil
    | cons a l' => fun Hl =>
                     cons a (picksome (drop a l')
                                      (picksome_term _ _ _ Hl H))
  end
    (eq_refl _).

Definition pick (l:list nat) : list nat := picksome l (lt_wf (length l)).

Inductive zerolist : list nat -> Prop :=
| znil : zerolist nil
| hzlist : forall l, zerolist l -> zerolist (O::l).

Now we can prove our theorem if we have the lemma H:

Theorem pickzero': (forall k, pick (0::k) = 0::pick k) ->
                forall l, zerolist l -> pick l = l.
Proof.
  intros H l H0; induction H0; [ | rewrite H; rewrite IHzerolist]; reflexivity.
Qed.

(* but trying to prove the lemma *)
Lemma pickzero_lemma : forall k, pick (0::k) = 0::pick k.
  induction k; try reflexivity.
  unfold pick at 1.
  unfold picksome.

This is the goal and context:

a : nat
k : list nat
IHk : pick (0 :: k) = 0 :: pick k
============================
 (fix picksome (l : list nat) (H : Acc lt (length l)) {struct H} :
    list nat :=
    match l as m return (l = m -> list nat) with
    | [] => fun _ : l = [] => []
    | a0 :: l' =>
        fun Hl : l = a0 :: l' =>
        a0 :: picksome (drop a0 l') (picksome_term l l' a0 Hl H)
    end eq_refl) (0 :: a :: k) (lt_wf (length (0 :: a :: k))) =
 0 :: pick (a :: k)
+4
source share
2 answers

@Vinz explained why Coq doesn't reduce beta redex with fix. Here is the relevant excerpt from the CDPT :

, . , , "" . Coq , .

, - .

:

Definition lt_list {A} (xs ys : list A) := length xs < length ys.

Definition lt_list_wf {A : Type} : well_founded (@lt_list A) :=
  well_founded_ltof (list A) (@length A).

Lemma lt_list_wf_ind {A} (P : list A -> Prop) :
  (forall ys, (forall xs, length xs < length ys -> P xs) -> P ys) ->
  forall l, P l.
Proof. intros ? l; elim (lt_list_wf l); auto with arith. Qed.

, lt_list_wf_ind , P ys , P , P .

, - picksome:

Lemma picksome_helper l : forall acc acc',
  picksome l acc = picksome l acc'.
Proof.
  induction l as [l IH] using lt_list_wf_ind; intros acc acc'.
  destruct l; destruct acc, acc'; [trivial |].
  simpl. f_equal.
  apply IH.
  simpl; rewrite Nat.lt_succ_r.
  apply drop_lemma_le.
Qed.

- Acc, pick_zero:

Lemma pick_zero k : pick (0::k) = 0::pick k.
Proof.
  unfold pick.
  destruct (lt_wf (length (0 :: k))).
  simpl (picksome (0 :: k) _).
  f_equal.
  apply picksome_helper.
Qed.
+1

Coq : , "" . , length (1 :: nil) , l = 1 :: nil, length l . l 1 :: nil, .

picksome H, . simpl, , "". simpl (fix picksome ...) (drop a1 l'0) (nat_ind <big term>), Coq picksome.

EDIT: , :

Lemma picksome_unfold : 
  forall (hd:nat) (tl:list nat) (H:Acc lt (length (hd::tl))), picksome (hd::tl) H = 
    cons hd (picksome (drop hd tl) (picksome_term (hd::tl) tl hd (eq_refl (hd::tl)) H)).

( , H). , pickzero_lemma, , . , .

+2

More articles:


All Articles