How to prove theorems about recursive functions of ListMap in coq? - coq

I'm trying to learn to use the ListMap module in Coq. I'm really not sure about proving properties about the keys or values in a ListMap, when the ListMap is created by a recursive function. I feel like I do not know what tactics to use.
(* Me proving statements about maps to understand how to use maps in Coq *)
Require Import FunInd.
Require Import Coq.Lists.List.
Require Import Coq.FSets.FMapInterface.
Require Import
Coq.FSets.FMapList
Coq.Structures.OrderedTypeEx.
Module Import MNat := FMapList.Make(Nat_as_OT).
Require Import
Coq.FSets.FMapFacts.
Definition NatToNat := MNat.t nat.
Definition NatToNatEmpty : NatToNat := MNat.empty nat.
(* We wish to show that map will have only positive values *)
Function insertNats (n: nat) (mm: NatToNat) {struct n}: NatToNat :=
match n with
| O => mm
| S (next) => insertNats next (MNat.add n n mm)
end.
Definition keys (mm: NatToNat) : list nat :=
List.map fst (elements mm).
(* vvvvv How do I prove this? Intuitively it is true *)
Example keys_nonnegative: forall (n: nat),
forall (k: nat),
List.In k (keys (insertNats n NatToNatEmpty)) -> k >= 0.
Proof.
intros n k in_proof.
induction n.
simpl in in_proof. tauto.
(* ??? NOW WHAT *)
Admitted.
Informally, the argument I would use for the below program is that because n >= 0 because it is a nat, the keys inserted into the map by idMapsGo will also always be non-negative.
I need to induct on n for keys_nonnegative. On the nth step, we add a key n, which will be non-negative (due to being a nat). The base case is trivial.
However, I am unable to convert this intuition into a Coq proof :)

You want to look at elements_in_iff and elements_mapsto_iff from Coq.FSets.FMapFacts.
Useful properties on keys:
Here are two useful properties on your definition of keys that might help you simplify your proofs. The code is taken from my own project Aniceto that includes helper properties on maps.
Definition keys {elt:Type} (m:t elt) : list key := fst (split (elements m)).
Fixpoint split_alt {A:Type} {B:Type} (l:list (A*B) %type) : (list A * list B) % type:=
match l with
| nil => (nil, nil)
| (x, y) :: l => (x :: (fst (split_alt l)), y :: (snd (split_alt l)))
end.
Lemma split_alt_spec:
forall {A:Type} {B:Type} (l:list (A*B) %type),
split l = split_alt l.
Proof.
intros.
induction l.
- auto.
- simpl. intuition.
rewrite IHl.
remember (split_alt l) as l'.
destruct l' as (lhs, rhs).
auto.
Qed.
Lemma in_fst_split:
forall {A:Type} {B:Type} (l:list (A*B)%type) (lhs:A),
List.In lhs (fst (split l)) ->
exists rhs, List.In (lhs, rhs) l.
Proof.
intros.
induction l.
{ inversion H. (* absurd *) }
destruct a.
rewrite split_alt_spec in H.
simpl in H.
destruct H.
+ subst.
eauto using in_eq.
+ rewrite <- split_alt_spec in H.
apply IHl in H; clear IHl.
destruct H as (r, Hin).
eauto using in_cons.
Qed.
Lemma in_elements_to_in:
forall {elt:Type} k e (m: t elt),
List.In (k, e) (elements m) ->
In k m.
Proof.
intros.
rewrite elements_in_iff.
exists e.
apply InA_altdef.
apply Exists_exists.
exists (k,e).
intuition.
unfold eq_key_elt.
intuition.
Qed.
Lemma keys_spec_1:
forall {elt:Type} (m:t elt) (k:key),
List.In k (keys m) -> In k m.
Proof.
intros.
unfold keys in *.
apply in_fst_split in H.
destruct H as (e, H).
apply in_elements_to_in with (e0:=e).
assumption.
Qed.
Lemma keys_spec_2:
forall {elt:Type} (m:t elt) (k:key),
In k m ->
exists k', E.eq k k' /\ List.In k' (keys m).
Proof.
intros.
unfold keys in *.
destruct H as (e, H).
apply maps_to_impl_in_elements in H.
destruct H as (k', (Heq, Hin)).
apply in_split_l in Hin.
exists k'.
intuition.
Qed.

Related

Theorem that finding in a list works properly

I am proving theorem about finding in a list. I got stuck at proving that if you actually found something then it is true. What kind of lemmas or strategy may help for proving such kind of theorems? I mean it looks like induction on the list is not enough in this case. But still the theorem is surely true.
(*FIND P = OPTION_MAP (SND :num # α -> α ) ∘ INDEX_FIND (0 :num) P*)
Require Import List.
Require Import Nat.
Fixpoint INDEX_FIND {a:Type} (i:nat) (P:a->bool) (l:list a) :=
match l with
| nil => None
| (h::t) => if P h then Some (i,h) else INDEX_FIND (S i) P t
end.
Definition FIND {a:Type} (P:a->bool) (l:list a)
:= (option_map snd) (INDEX_FIND 0 P l).
Theorem find_prop {a:Type} P l (x:a):
(FIND P l) = Some x
->
(P x)=true.
Proof.
unfold FIND.
unfold option_map.
induction l.
+ simpl.
intro H. inversion H.
+ simpl.
destruct (P a0).
- admit.
- admit.
Admitted.
(this is a translation of definition from HOL4 which also lacks such kind of theorem)
HOL version of the theorem:
Theorem find_prop:
FIND (P:α->bool) (l:α list) = SOME x ⇒ P x
Proof
cheat
QED
It looks like what you are missing is an equation relating P a0 and its destructed value. This can be obtained with the variant of destruct documented there destruct (P a0) eqn:H.
You may want to try to strengthen the property before proving your theorem. Using the SSReflect proof language, you can try the following route.
Lemma index_find_prop {a:Type} P (x:a) l :
forall i j, (INDEX_FIND i P l) = Some (j, x) -> P x = true.
Proof.
elim: l => [//=|x' l' IH i j].
rewrite /INDEX_FIND.
case Px': (P x').
- by case=> _ <-.
- exact: IH.
Qed.
Lemma opt_snd_inv A B X x :
option_map (#snd A B) X = Some x -> exists j, X = Some (j, x).
Proof.
case: X => ab; last by [].
rewrite (surjective_pairing ab) /=.
case=> <-.
by exists ab.1.
Qed.
Theorem find_prop {a:Type} P l (x:a):
(FIND P l) = Some x -> (P x)=true.
Proof.
rewrite /FIND => /(#opt_snd_inv _ _ (INDEX_FIND 0 P l) x) [j].
exact: index_find_prop.
Qed.
I'm confident there are shorter proofs ;)

How to prove that terms of a first-order language are well-founded?

Currently, I've started working on proving theorems about first-order logic in Coq(VerifiedMathFoundations). I've proved deduction theorem, but then I got stuck with lemma 1 for theorem of correctness. So I've formulated one elegant piece of the lemma compactly and I invite the community to look at it. That is an incomplete the proof of well-foundness of the terms. How to get rid of the pair of "admit"s properly?
(* PUBLIC DOMAIN *)
Require Export Coq.Vectors.Vector.
Require Export Coq.Lists.List.
Require Import Bool.Bool.
Require Import Logic.FunctionalExtensionality.
Require Import Coq.Program.Wf.
Definition SetVars := nat.
Definition FuncSymb := nat.
Definition PredSymb := nat.
Record FSV := {
fs : FuncSymb;
fsv : nat;
}.
Record PSV := MPSV{
ps : PredSymb;
psv : nat;
}.
Inductive Terms : Type :=
| FVC :> SetVars -> Terms
| FSC (f:FSV) : (Vector.t Terms (fsv f)) -> Terms.
Definition rela : forall (x y:Terms), Prop.
Proof.
fix rela 2.
intros x y.
destruct y as [s|f t].
+ exact False.
+ refine (or _ _).
exact (Vector.In x t).
simple refine (#Vector.fold_left Terms Prop _ False (fsv f) t).
intros Q e.
exact (or Q (rela x e)).
Defined.
Definition snglV {A} (a:A) := Vector.cons A a 0 (Vector.nil A).
Definition wfr : #well_founded Terms rela.
Proof.
clear.
unfold well_founded.
assert (H : forall (n:Terms) (a:Terms), (rela a n) -> Acc rela a).
{ fix iHn 1.
destruct n.
+ simpl. intros a b; destruct b.
+ simpl. intros a Q. destruct Q as [L|R].
* admit. (* smth like apply Acc_intro. intros m Hm. apply (iHn a). exact Hm. *)
* admit. (* like in /Arith/Wf_nat.v *)
}
intros a.
simple refine (H _ _ _).
exact (FSC (Build_FSV 0 1) (snglV a)).
simpl.
apply or_introl.
constructor.
Defined.
It is also available here: pastebin.
Update: At least transitivity is needed for well-foundness. I also started a proof, but didn't finished.
Fixpoint Tra (a b c:Terms) (Hc : rela c b) (Hb : rela b a) {struct a}: rela c a.
Proof.
destruct a.
+ simpl in * |- *.
exact Hb.
+ simpl in * |- *.
destruct Hb.
- apply or_intror.
revert f t H .
fix RECU 1.
intros f t H.
(* ... *)
Admitted.
You can do it by defining a height function on Terms, and showing that decreasing rela implies decreasing heights:
Require Export Coq.Vectors.Vector.
Require Export Coq.Lists.List.
Require Import Bool.Bool.
Require Import Logic.FunctionalExtensionality.
Require Import Coq.Program.Wf.
Definition SetVars := nat.
Definition FuncSymb := nat.
Definition PredSymb := nat.
Record FSV := {
fs : FuncSymb;
fsv : nat;
}.
Record PSV := MPSV{
ps : PredSymb;
psv : nat;
}.
Unset Elimination Schemes.
Inductive Terms : Type :=
| FVC :> SetVars -> Terms
| FSC (f:FSV) : (Vector.t Terms (fsv f)) -> Terms.
Set Elimination Schemes.
Definition Terms_rect (T : Terms -> Type)
(H_FVC : forall sv, T (FVC sv))
(H_FSC : forall f v, (forall n, T (Vector.nth v n)) -> T (FSC f v)) :=
fix loopt (t : Terms) : T t :=
match t with
| FVC sv => H_FVC sv
| FSC f v =>
let fix loopv s (v : Vector.t Terms s) : forall n, T (Vector.nth v n) :=
match v with
| #Vector.nil _ => Fin.case0 _
| #Vector.cons _ t _ v => fun n => Fin.caseS' n (fun n => T (Vector.nth (Vector.cons _ t _ v) n))
(loopt t)
(loopv _ v)
end in
H_FSC f v (loopv _ v)
end.
Definition Terms_ind := Terms_rect.
Fixpoint height (t : Terms) : nat :=
match t with
| FVC _ => 0
| FSC f v => S (Vector.fold_right (fun t acc => Nat.max acc (height t)) v 0)
end.
Definition rela : forall (x y:Terms), Prop.
Proof.
fix rela 2.
intros x y.
destruct y as [s|f t].
+ exact False.
+ refine (or _ _).
exact (Vector.In x t).
simple refine (#Vector.fold_left Terms Prop _ False (fsv f) t).
intros Q e.
exact (or Q (rela x e)).
Defined.
Require Import Lia.
Definition wfr : #well_founded Terms rela.
Proof.
apply (Wf_nat.well_founded_lt_compat _ height).
intros t1 t2. induction t2 as [sv2|f2 v2 IH]; simpl; try easy.
intros [t_v|t_sub]; apply Lt.le_lt_n_Sm.
{ clear IH. induction t_v; simpl; lia. }
revert v2 IH t_sub; generalize (fsv f2); clear f2.
intros k v2 IH t_sub.
enough (H : exists n, rela t1 (Vector.nth v2 n)).
{ destruct H as [n H]. apply IH in H. clear IH t_sub.
transitivity (height (Vector.nth v2 n)); try lia; clear H.
induction v2 as [|t2 m v2 IHv2].
- inversion n.
- apply (Fin.caseS' n); clear n; simpl; try lia.
intros n. specialize (IHv2 n). lia. }
clear IH.
assert (H : Vector.fold_right (fun t Q => Q \/ rela t1 t) v2 False).
{ revert t_sub; generalize False.
induction v2 as [|t2 n v2]; simpl in *; trivial.
intros P H; specialize (IHv2 _ H); clear H.
induction v2 as [|t2' n v2 IHv2']; simpl in *; tauto. }
clear t_sub.
induction v2 as [|t2 k v2 IH]; simpl in *; try easy.
destruct H as [H|H].
- apply IH in H.
destruct H as [n Hn].
now exists (Fin.FS n).
- now exists Fin.F1.
Qed.
(Note the use of the custom induction principle, which is needed because of the nested inductives.)
This style of development, however, is too complicated. Avoiding certain pitfalls would greatly simplify it:
The Coq standard vector library is too hard to use. The issue here is exacerbated because of the nested inductives. It would probably be better to use plain lists and have a separate well-formedness predicate on terms.
Defining a relation such as rela in proof mode makes it harder to read. Consider, for instance, the following simpler alternative:
Fixpoint rela x y :=
match y with
| FVC _ => False
| FSC f v =>
Vector.In x v \/
Vector.fold_right (fun z P => rela x z \/ P) v False
end.
Folding left has a poor reduction behavior, because it forces us to generalize over the accumulator argument to get the induction to go through. This is why in my proof I had to switch to a fold_right.

How to do induction on the length of a list in Coq?

When reasoning on paper, I often use arguments by induction on the length of some list. I want to formalized these arguments in Coq, but there doesn't seem to be any built in way to do induction on the length of a list.
How should I perform such an induction?
More concretely, I am trying to prove this theorem. On paper, I proved it by induction on the length of w. My goal is to formalize this proof in Coq.
There are many general patterns of induction like this one that can be covered
by the existing library on well founded induction. In this case, you can prove
any property P by induction on length of lists by using well_founded_induction, wf_inverse_image, and PeanoNat.Nat.lt_wf_0, as in the following comand:
induction l using (well_founded_induction
(wf_inverse_image _ nat _ (#length _)
PeanoNat.Nat.lt_wf_0)).
if you are working with lists of type T and proving a goal P l, this generates an
hypothesis of the form
H : forall y : list T, length y < length l -> P y
This will apply to any other datatype (like trees for instance) as long as you can map that other datatype to nat using any size function from that datatype to nat instead of length.
Note that you need to add Require Import Wellfounded. at the head of your development for this to work.
Here is how to prove a general list-length induction principle.
Require Import List Omega.
Section list_length_ind.
Variable A : Type.
Variable P : list A -> Prop.
Hypothesis H : forall xs, (forall l, length l < length xs -> P l) -> P xs.
Theorem list_length_ind : forall xs, P xs.
Proof.
assert (forall xs l : list A, length l <= length xs -> P l) as H_ind.
{ induction xs; intros l Hlen; apply H; intros l0 H0.
- inversion Hlen. omega.
- apply IHxs. simpl in Hlen. omega.
}
intros xs.
apply H_ind with (xs := xs).
omega.
Qed.
End list_length_ind.
You can use it like this
Theorem foo : forall l : list nat, ...
Proof.
induction l using list_length_ind.
...
That said, your concrete example example does not necessarily need induction on the length. You just need a sufficiently general induction hypothesis.
Import ListNotations.
(* ... some definitions elided here ... *)
Definition flip_state (s : state) :=
match s with
| A => B
| B => A
end.
Definition delta (s : state) (n : input) : state :=
match n with
| zero => s
| one => flip_state s
end.
(* ...some more definitions elided here ...*)
Theorem automata221: forall (w : list input),
extend_delta A w = B <-> Nat.odd (one_num w) = true.
Proof.
assert (forall w s, extend_delta s w = if Nat.odd (one_num w) then flip_state s else s).
{ induction w as [|i w]; intros s; simpl.
- reflexivity.
- rewrite IHw.
destruct i; simpl.
+ reflexivity.
+ rewrite <- Nat.negb_even, Nat.odd_succ.
destruct (Nat.even (one_num w)), s; reflexivity.
}
intros w.
rewrite H; simpl.
destruct (Nat.odd (one_num w)); intuition congruence.
Qed.
In case like this, it is often faster to generalize your lemma directly:
From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.
Section SO.
Variable T : Type.
Implicit Types (s : seq T) (P : seq T -> Prop).
Lemma test P s : P s.
Proof.
move: {2}(size _) (leqnn (size s)) => ss; elim: ss s => [|ss ihss] s hs.
Just introduce a fresh nat for the size of the list, and regular induction will work.

induction hypothesis for even numbers

I am trying to write an induction hypothesis specifically for proving properties of even numbers. I formulated and proved the following:
Theorem ind_hyp_on_evens:
forall (p : nat -> Prop),
(p 0 -> (forall n, p n -> p (S (S n))) ->
forall n, p (n + n)).
Proof.
intros p P0 P1.
intro n.
assert(p (n + n) /\ p (S (S (n + n)))).
induction n as [| n'].
split. unfold plus. assumption.
unfold plus.
apply (P1 0).
assumption.
destruct IHn' as [A B].
split.
rewrite <- plus_Snm_nSm.
rewrite -> ? plus_Sn_m.
assumption.
rewrite <- plus_Snm_nSm.
rewrite -> ? plus_Sn_m.
apply (P1 (S (S (n' + n')))).
assumption.
destruct H as [H1 H2].
assumption. Qed.
Despite the fact that it's proved, any attempt to use it results in the error message: "Error: Not the right number of induction arguments."
Can someone please tell me what is the problem with the induction hypothesis, or otherwise, how to apply it??
Thanks,
Mayer
I believe induction assumes that any induction principle that will be used has the
fixed form
forall ... (P : SomeType -> Type) ..., (* or ->Set or ->Prop *)
... ->
forall (v : SomeType), P v
Your ind_hyp_on_evens matches only P (plus n n) which seems to confuse induction.
If you have a suitable goal, say forall n, is_even (n+n), you can manually do the
steps that induction normally does and extend that to handle the special form.
intro n0; (* temp. var *)
pattern (n0 + n0); (* restructure as (fun x => (is_even x)) (n0+n0) *)
refine (ind_hyp_on_evens _ _ _ n0); (* apply ind. scheme *)
clear n0; [| intros n IHn ]. (* clear temp., do one 'intros' per branch *)
I don't know if it's possible to pack that up as a general helper tactic for any induction scheme, packing these steps up as a per-scheme Ltac tactic should work however.
You could consider writing an inductive predicate that describes even numbers (code not tested):
Inductive even : nat -> Prop :=
| evenO : even O
| evenSSn : forall n, even n -> even (S (S n))
.
Coq will generate the induction principle automatically.
You would have to prove that even n holds before being able to perform induction on the "evenness" of n.

Help with a Coq proof for SubSequences

I have the defined inductive types:
Inductive InL (A:Type) (y:A) : list A -> Prop :=
| InHead : forall xs:list A, InL y (cons y xs)
| InTail : forall (x:A) (xs:list A), InL y xs -> InL y (cons x xs).
Inductive SubSeq (A:Type) : list A -> list A -> Prop :=
| SubNil : forall l:list A, SubSeq nil l
| SubCons1 : forall (x:A) (l1 l2:list A), SubSeq l1 l2 -> SubSeq l1 (x::l2)
| SubCons2 : forall (x:A) (l1 l2:list A), SubSeq l1 l2 -> SubSeq (x::l1) (x::l2).
Now I have to prove a series of properties of that inductive type, but I keep getting stuck.
Lemma proof1: forall (A:Type) (x:A) (l1 l2:list A), SubSeq l1 l2 -> InL x l1 -> InL x l2.
Proof.
intros.
induction l1.
induction l2.
exact H0.
Qed.
Can some one help me advance.
In fact, it is easier to do an induction on the SubSet judgment directly.
However, you need to be as general as possible, so here is my advice:
Lemma proof1: forall (A:Type) (x:A) (l1 l2:list A),
SubSeq l1 l2 -> InL x l1 -> InL x l2.
(* first introduce your hypothesis, but put back x and In foo
inside the goal, so that your induction hypothesis are correct*)
intros.
revert x H0. induction H; intros.
(* x In [] is not possible, so inversion will kill the subgoal *)
inversion H0.
(* here it is straitforward: just combine the correct hypothesis *)
apply InTail; apply IHSubSeq; trivial.
(* x0 in x::l1 has to possible sources: x0 == x or x0 in l1 *)
inversion H0; subst; clear H0.
apply InHead.
apply InTail; apply IHSubSeq; trivial.
Qed.
"inversion" is a tactic that checks an inductive term and gives you all the possible way to build such a term !!without any induction hypothesis!!
It only gives you the constructive premices.
You could have done it directly by induction on l1 then l2, but you would have to construct by hand the correct instance of inversion because your induction hypothesis would have been really weak.
Hope it helps,
V.