In Logical Foundations' chapter on Inductive Propositions, the exercise exp_match_ex1 involves the following definitions:
Inductive reg_exp (T : Type) : Type :=
| EmptySet
| EmptyStr
| Char (t : T)
| App (r1 r2 : reg_exp T)
| Union (r1 r2 : reg_exp T)
| Star (r : reg_exp T).
Arguments EmptySet {T}.
Arguments EmptyStr {T}.
Arguments Char {T} _.
Arguments App {T} _ _.
Arguments Union {T} _ _.
Arguments Star {T} _.
Inductive exp_match {T} : list T -> reg_exp T -> Prop :=
| MEmpty : [] =~ EmptyStr
| MChar x : [x] =~ (Char x)
| MApp s1 re1 s2 re2
(H1 : s1 =~ re1)
(H2 : s2 =~ re2)
: (s1 ++ s2) =~ (App re1 re2)
| MUnionL s1 re1 re2
(H1 : s1 =~ re1)
: s1 =~ (Union re1 re2)
| MUnionR re1 s2 re2
(H2 : s2 =~ re2)
: s2 =~ (Union re1 re2)
| MStar0 re : [] =~ (Star re)
| MStarApp s1 s2 re
(H1 : s1 =~ re)
(H2 : s2 =~ (Star re))
: (s1 ++ s2) =~ (Star re)
where "s =~ re" := (exp_match s re).
I'm stuck trying to prove the following lemma:
Lemma MStar' : forall T (ss : list (list T)) (re : reg_exp T),
(forall s, In s ss -> s =~ re) ->
fold app ss [] =~ Star re.
Proof.
intros. induction ss.
- simpl. apply MStar0.
- simpl. pose proof (H x). assert (Hx: In x (x :: ss)). {
simpl. left. reflexivity.
} pose proof (H0 Hx).
(* stuck *)
Which results in:
T: Type
x: list T
ss: list (list T)
re: reg_exp T
H: forall s : list T, In s (x :: ss) -> s =~ re
IHss: (forall s : list T, In s ss -> s =~ re) -> fold app ss [ ] =~ Star re
H0: In x (x :: ss) -> x =~ re
Hx: In x (x :: ss)
H1: x =~ re
====================================
1/1
x ++ fold app ss [ ] =~ Star re
Initially it looked like trying to proceed by induction on ss would allow me to make progress but I can't find any way to transform the hypothesis forall s : list T, In s (x :: ss) -> s =~ re so that I can prove fold app ss [ ] =~ Star re from the inductive hypothesis (forall s : list T, In s ss -> s =~ re) -> fold app ss [ ] =~ Star re.
I think the thing is that you do not need to apply induction hypothesis yet. Just try to see again on your constructors right when you have situation you've described (so, right on your (* stuck *) step).
Related
When proving the pumping Lemma (https://softwarefoundations.cis.upenn.edu/lf-current/IndProp.html#Pumping.pumping), I get stuck at the MStarApp case:
Lemma pumping : forall T (re : reg_exp T) s,
s =~ re ->
pumping_constant re <= length s ->
exists s1 s2 s3,
s = s1 ++ s2 ++ s3 /\
s2 <> [] /\
length s1 + length s2 <= pumping_constant re /\
forall m, s1 ++ napp m s2 ++ s3 =~ re.
Proof.
intros T re s Hmatch.
induction Hmatch
as [ | x | s1 re1 s2 re2 Hmatch1 IH1 Hmatch2 IH2
| s1 re1 re2 Hmatch IH | re1 s2 re2 Hmatch IH
| re | s1 s2 re Hmatch1 IH1 Hmatch2 IH2 ].
- (* Other cases *)
- (* MStarApp *)
simpl. intros H. exists nil, s1, s2. split.
+ reflexivity.
+ split.
* Admitted.
We have the assumptions that:
T: Type
s1, s2: list T
re: reg_exp T
Hmatch1: s1 =~ re
Hmatch2: s2 =~ Star re
IH1: pumping_constant re <= length s1 ->
exists s2 s3 s4 : list T,
s1 = s2 ++ s3 ++ s4 /\
s3 <> [ ] /\
length s2 + length s3 <= pumping_constant re /\
(forall m : nat, s2 ++ napp m s3 ++ s4 =~ re)
IH2: pumping_constant (Star re) <= length s2 ->
exists s1 s3 s4 : list T,
s2 = s1 ++ s3 ++ s4 /\
s3 <> [ ] /\
length s1 + length s3 <= pumping_constant (Star re) /\
(forall m : nat, s1 ++ napp m s3 ++ s4 =~ Star re)
H: pumping_constant re <= length (s1 ++ s2)
I want to pump on s1, but I don't know how to prove that s1 <> []. Could you help me?
It's a question in software foundation, logic foundation, IndProp.v
Here is some definitions.
Inductive reg_exp (T : Type) : Type :=
| EmptySet
| EmptyStr
| Char (t : T)
| App (r1 r2 : reg_exp T)
| Union (r1 r2 : reg_exp T)
| Star (r : reg_exp T).
Inductive exp_match {T} : list T -> reg_exp T -> Prop :=
| MEmpty : [] =~ EmptyStr
| MChar x : [x] =~ (Char x)
| MApp s1 re1 s2 re2
(H1 : s1 =~ re1)
(H2 : s2 =~ re2)
: (s1 ++ s2) =~ (App re1 re2)
| MUnionL s1 re1 re2
(H1 : s1 =~ re1)
: s1 =~ (Union re1 re2)
| MUnionR re1 s2 re2
(H2 : s2 =~ re2)
: s2 =~ (Union re1 re2)
| MStar0 re : [] =~ (Star re)
| MStarApp s1 s2 re
(H1 : s1 =~ re)
(H2 : s2 =~ (Star re))
: (s1 ++ s2) =~ (Star re)
where "s =~ re" := (exp_match s re).
Definition derives d := forall a re, is_der re a (d a re).
Fixpoint derive (a : ascii) (re : reg_exp ascii) : reg_exp ascii :=
match re with
| EmptySet => EmptySet
| EmptyStr => EmptySet
| Char c => if (eqb a c) then EmptyStr else EmptySet
| App re1 re2 => Union (App (derive a re1) re2) (if match_eps re1
then derive a re2
else EmptySet)
| Union re1 re2 => Union (derive a re1) (derive a re2)
| Star re => App (derive a re) (Star re)
end.
And the Lemma I have to prove is
Lemma derive_corr : derives derive.
I was struck when the re is Star re.
As a:s =~ Star re -> s1 ++ s2 = a :: s /\ s1 =~ re /\ s2 =~ Star re
If s1 <> [], it can be solved easily.
But when s1 == [], it seems come into a endless loop(I have to same thing again on s2). I guess I can make it by recur, but I don't know how to do.
You should probably prove a "better" inversion that the one that the inversion tactic of your hypothesis gives you, something that intuitively says that the left string of MStarApp cannot be forever empty. Proving such stronger inversions is quite usual in this kind of settings.
Here a possibility is to show that if a :: s =~ Star re, then there exists s1 and s2 such that s = s1 ++ s2 /\ a :: s1 =~ re /\ s2 =~ Star re.
Continuing my work on Software Foundations, I've reached the weak_pumping lemma. I managed to get through almost everything, but I can't find a solution for MStarApp case.
Here's the Lemma:
s =~ re ->
pumping_constant re <= length s ->
exists s1 s2 s3,
s = s1 ++ s2 ++ s3 /\
s2 <> [] /\
forall m, s1 ++ napp m s2 ++ s3 =~ re.
(** You are to fill in the proof. Several of the lemmas about
[le] that were in an optional exercise earlier in this chapter
may be useful. *)
Proof.
intros T re s Hmatch.
induction Hmatch
as [ | x | s1 re1 s2 re2 Hmatch1 IH1 Hmatch2 IH2
| s1 re1 re2 Hmatch IH | re1 s2 re2 Hmatch IH
| re | s1 s2 re Hmatch1 IH1 Hmatch2 IH2 ].
I've managed to solve every case, except for the last one. Here's the current state:
1 subgoal (ID 918)
T : Type
s1, s2 : list T
re : reg_exp T
Hmatch1 : s1 =~ re
Hmatch2 : s2 =~ Star re
IH1 : pumping_constant re <= length s1 ->
exists s2 s3 s4 : list T,
s1 = s2 ++ s3 ++ s4 /\
s3 <> [ ] /\ (forall m : nat, s2 ++ napp m s3 ++ s4 =~ re)
IH2 : pumping_constant (Star re) <= length s2 ->
exists s1 s3 s4 : list T,
s2 = s1 ++ s3 ++ s4 /\
s3 <> [ ] /\ (forall m : nat, s1 ++ napp m s3 ++ s4 =~ Star re)
H : pumping_constant (Star re) <= length s1 + length s2
============================
exists s0 s4 s5 : list T,
s1 ++ s2 = s0 ++ s4 ++ s5 /\
s4 <> [ ] /\ (forall m : nat, s0 ++ napp m s4 ++ s5 =~ Star re)
It looks to me that if I can find a way to split H into pumping_constant re <= length s1 \/ pumping_constant (Star re) <= length s2 then I have a way forward (by splitting H into H1 and H2 and applying the relevant IHk to the matching Hk then proceeding with a destruct, three exists, and so on).
But I can't find a lemma that allows me to split H as suggested.
Is there anything else I can do here?
Thanks
Try to destruct s1 and look again on lemma napp_star in one of cases.
This is the 5 star exercise from Software Foundations.
Lemma pumping : forall T (re : #reg_exp T) s,
s =~ re ->
pumping_constant re <= length s ->
exists s1 s2 s3,
s = s1 ++ s2 ++ s3 /\
s2 <> [] /\
forall m, s1 ++ napp m s2 ++ s3 =~ re.
Proof.
intros T re s Hmatch.
induction Hmatch
as [ | x | s1 re1 s2 re2 Hmatch1 IH1 Hmatch2 IH2
| s1 re1 re2 Hmatch IH | re1 s2 re2 Hmatch IH
| re | s1 s2 re Hmatch1 IH1 Hmatch2 IH2 ]; simpl; intros.
- omega.
- omega.
-
1 subgoal
T : Type
s1 : list T
re1 : reg_exp
s2 : list T
re2 : reg_exp
Hmatch1 : s1 =~ re1
Hmatch2 : s2 =~ re2
IH1 : pumping_constant re1 <= length s1 ->
exists s2 s3 s4 : list T,
s1 = s2 ++ s3 ++ s4 /\
s3 <> [ ] /\ (forall m : nat, s2 ++ napp m s3 ++ s4 =~ re1)
IH2 : pumping_constant re2 <= length s2 ->
exists s1 s3 s4 : list T,
s2 = s1 ++ s3 ++ s4 /\
s3 <> [ ] /\ (forall m : nat, s1 ++ napp m s3 ++ s4 =~ re2)
H : pumping_constant re1 + pumping_constant re2 <= length (s1 ++ s2)
______________________________________(1/1)
exists s0 s3 s4 : list T,
s1 ++ s2 = s0 ++ s3 ++ s4 /\
s3 <> [ ] /\ (forall m : nat, s0 ++ napp m s3 ++ s4 =~ App re1 re2)
I've spent too much time trying to split that H only to realize that despite day and a half work on this, many of my assumptions on how inequalities work turned out to be wrong. I had some great ideas last night which now that they've been discarded leave me more confused about this problem than ever. I've only been unlearning algebra in the past two days it seems.
I am going to be very embarrassed if the answer turns out to be that I need to match on the ss or length ss or pumping_constant res because I can't find a way to push through there.
The way this problem is set up highly suggests H should be split somehow in order to do the induction. I am still suspicious of it.
Yes, you need to split the H in order to proceed.
Vague hint: Do Search (_ + _ <= _ + _). and look for a theorem that catches your eyes.
Hint:
Nat.add_le_cases: forall n m p q : nat, n + m <= p + q -> n <= p \/ m <= q
Disclaimer: I fear this post got quite long, however, I feel that in a smaller setup some valuable background information would be lost.
I am currently trying to change my formalisation to use the locally nameless representation by Charguéraud et al [1]. Apparently, this adaption is not as straightforward as I hoped because my definition of expressions contains lists (at least I currently think this is the main problem).
So, I have the following (minimal) definition of expressions.
Require Import Coq.Lists.List.
Require Import Coq.Arith.PeanoNat.
Parameter atom : Set.
Parameter eq_atom_dec : forall x y : atom, {x = y} + {x <> y}.
Definition VarIndex := nat.
Inductive Expr : Type :=
| BVar : VarIndex -> VarIndex -> Expr
| FVar : atom -> Expr
| LetB : list Expr -> Expr -> Expr.
With this definition at hand I can define the opening operation.
Fixpoint open_rec (k: VarIndex) (u: list Expr) (e: Expr) :=
match e with
| BVar i j => if Nat.eq_dec k i then List.nth j u e else e
| FVar x => e
| LetB es e' => LetB (List.map (open_rec (S k) u) es) (open_rec (S k) u e')
end.
Notation "{ k ~> u } t" := (open_rec k u t) (at level 67).
Definition open e u := open_rec 0 u e.
So far so good. Next the property of being "locally closed" is defined inductively as follows.
Inductive lc : Expr -> Prop :=
| lc_var : forall x,
lc (FVar x)
| lc_let : forall (ts: list Expr) es e,
Forall lc es ->
lc (open e ts) ->
lc (LetB es e).
The tutorial now states that we can proof a lemma about the interaction of lc and open, i.e. in a locally closed expressions nothing happens when we substitute a variable.
(* this is a auxiliary lemma that works just fine for me *)
Lemma open_rec_lc_core : forall e (j: VarIndex) v (i: VarIndex) u,
i <> j ->
{j ~> v} e = {i ~> u} ({j ~> v} e) ->
e = {i ~> u} e.
Proof.
Admitted.
Lemma open_rec_lc0 : forall k u e,
lc e ->
e = {k ~> u} e.
Proof.
intros k u e LC.
generalize dependent k.
induction LC; intro k.
- reflexivity.
- simpl.
f_equal.
+ admit.
+ eapply open_rec_lc_core with (j := 0).
* auto.
* eapply IHLC.
Admitted.
As you can see, there is a case that is "admitted" in the proof. The problem here is that I have to proof something about the let-bindings, but everything I have at hand is the following:
H : Forall lc (map (fun e' : Expr => open e' ts) es)
LC : lc (open e ts)
IHLC : forall k : VarIndex, open e ts = {k ~> u} open e ts
What I need is an equivalent hypothesis to IHLC but for es.
My first guess was that I need to modify the induction principle as it is usually done[2] for inductive definitions with lists as arguments.
However, I cannot workout a definition that actually type checks.
Fail Definition lc_ind2 :=
fun (P : Expr -> Prop) (f : forall x : atom, P (FVar x))
(f0 : forall (ts es : list Expr) (e : Expr),
Forall lc (map (fun e' : Expr => open e' ts) es) ->
lc (open e ts) -> P (open e ts) ->
Forall P (map (fun e' => open e' ts ) es) ->
P (LetB es e)) =>
fix F (e : Expr) (l : lc e) {struct l} : P e :=
match l in (lc e0) return (P e0) with
| lc_var x => f x
| lc_let ts es e0 f1 l0 =>
f0 ts es e0 f1 l0 (F (open e0 ts) l0)
((fix F' (es: list Expr) : Forall P es :=
match es with
| nil => Forall_nil P
| cons x xs => Forall_cons x (F x _) (F' xs)
end) (map (fun e' => open e' ts) es))
end.
Instead of _ in the application of Forall_cons I need something of type lc x, but I do not know how to come up with this value.
So, in the end my question is, if someone has an idea which definitions I need to modify in order to work with the LNR.
[1] Tutorial on LNR
[2] Induction principles with list arguments
Okay, so in the end I just inlined the Forall into a local inductive definition that uses lc.
Inductive lc : Expr -> Prop :=
| lc_var : forall x,
lc (FVar x)
| lc_let : forall (ts: list Expr) es e,
Forall_lc es ->
lc (open e ts) ->
lc (LetB es e).
with Forall_lc : list Expr -> Prop :=
| nil_lc : Forall_lc nil
| cons_lc : forall e es, lc e -> Forall_lc es -> Forall_lc (e :: es).
And generated the induction principle I need.
Scheme lc2_ind := Minimality for lc Sort Prop
with lc_Forall_ind := Minimality for Forall_lc Sort Prop.
The same approach was taken here (Chapter 4).
I guess, in the end, the trick is to use mutually recursive definitions instead of trying to apply lc as a parameter to Forall.
Here is a solution that works. I do not understand all the details. For instance, in the first proof, the induction must be done on the Forall hypothesis directly, not on es to respect the guard condition. Also note the use of refine, which lets build a term iteratively, by leaving underscores to yet unknown arguments and completing gradually.
Lemma lc_ind2 : forall P : Expr -> Prop,
(forall x : atom, P (FVar x)) ->
(forall (ts es : list Expr) (e : Expr),
Forall lc es -> Forall P es ->
lc (open e ts) -> P (open e ts) -> P (LetB es e)) ->
forall e : Expr, lc e -> P e.
Proof.
intros. revert e H1.
refine (fix aux e H1 (* {struct H1} *) := match H1 with
| lc_var x => H x
| lc_let ts es e HFor Hlc => H0 ts es e HFor _ Hlc (aux (open e ts) Hlc)
end).
induction HFor.
constructor.
constructor.
apply aux. apply H2. assumption.
Qed.
Lemma Forall_map : forall {A} f (l:list A),
Forall (fun x => x = f x) l ->
l = map f l.
Proof.
intros.
induction H.
reflexivity.
simpl. f_equal; assumption.
Qed.
Lemma open_rec_lc0 : forall k u e,
lc e ->
e = {k ~> u} e.
Proof.
intros k u e H. revert k u.
induction H using lc_ind2; intros.
- reflexivity.
- simpl. f_equal.
+ apply Forall_map. apply Forall_forall. rewrite Forall_forall in H0.
intros. apply H0. assumption.
+ eapply open_rec_lc_core with (j := 0).
* auto.
* eapply IHlc.
Qed.