(** * Coinduction: Infinite Data and Proofs *) (* modified version of Pierce's CIS670, Homework assignments 6 and 7 *) (* This material builds on: - sections 7.1 from the tutorial by Giménez and Castéran - sections 5.1-5.2 from the CPDT book by Adam Chlipala *) Require Import Bool. Require Import List. Require Import CpdtTactics. Set Implicit Arguments. (* ------------------------------------------------------------ *) (** ** Computing with Infinite Data *) (** The most basic type of infinite data is infinite lists, usually known as _streams_ *) CoInductive stream (A : Type) : Type := | Cons : A -> stream A -> stream A. (** If we want _both_ finite and infinite lists, then we can also keep the cons *) CoInductive llist (A: Type) : Type := | LNil : llist A | LCons : A -> llist A -> llist A. (** Exercise (easy): define the coinductive types representing the following 3 infinite data structures: *) (* 1. infinite binary trees *) (* 2. infinitely branching infinite trees (i.e. infinitely wide and infinitely deep) *) (* 3. finitely and infinitely branching infinite trees (i.e. finitely or infinitely wide and infinitely deep *) (** Pattern matching on coinductive values works as usual *) Definition head (A:Type) (s : stream A) := match s with | Cons a s' => a end. Definition tail (A : Type)(s : stream A) := match s with | Cons a s' => s' end. (* Exercise (easy): Using the functions head and tail, define a recursive function which takes the n-th element of an infinite stream. *) (* Infinite objects are defined using the CoFixpoint command *) CoFixpoint repeat (A : Type) (a : A) : stream A := Cons a (repeat a). (** Note: whereas recursive definitions (fixpoints) were necessary to _use_ values of recursive inductive types effectively, we need co-recursive definitions (co-fixpoints) to _build_ (infinite) values of co-inductive types *) (** Every CoFixpoint has to return a coinductive type (in the same way every Fixpoint has to take and break up an inductive argument). *) (* CoFixpoint to_bool (x : stream nat) : bool := to_bool x. Error: Recursive definition of to_bool is ill-formed. In environment to_bool : stream nat -> bool x : stream nat The codomain is "bool" which should be a coinductive type. Recursive definition is: "fun x : stream nat => to_bool x". *) (** Co-inductive values can be arguments to recursive functions. However, there also needs to be an inductive argument in order to convince Coq that the function is terminating. We can use this to write a function that computes the finite approximation of a stream: *) Fixpoint approx A (n : nat) (s : stream A) {struct n} : list A := match n with | O => nil | S n' => match s with | Cons h t => h :: approx n' t end end. Definition ones := repeat 1. Eval simpl in approx 10 ones. (** We can of course also define [ones] directly, without using [iterate] *) CoFixpoint ones' : stream nat := Cons 1 ones'. Eval simpl in approx 10 ones'. (** In order to prevent non-termination, co-fixpoints are evaluated lazily. They are unfolded _only_ when they appear as the argument of a match expression. We can check this using Eval. *) Eval simpl in (repeat 4). Eval simpl in (head (repeat 4)). (** Here are three useful co-recursive functions on streams: *) CoFixpoint iterate (A : Type) (f : A -> A) (a : A) : stream A := Cons a (iterate f (f a)). CoFixpoint map (A B : Type) (f : A -> B) (s : stream A) : stream B := match s with | Cons a tl => Cons (f a) (map f tl) end. CoFixpoint interleave (A : Type) (s1 s2 : stream A) : stream A := match s1, s2 with | Cons n1 s1', Cons n2 s2' => Cons n1 (Cons n2 (interleave s1' s2')) end. (** Using [iterate] we can define the stream of natural numbers: *) Definition nats : stream nat := iterate S 0. Eval simpl in approx 10 nats. (* We can of course also define nats more directly: *) CoFixpoint nats_from_n (n : nat) : stream nat := Cons n (nats_from_n (S n)). Definition nats' := nats_from_n 0. Eval simpl in approx 10 nats. (** We can define a stream that alternates between [true] and [false] using a mutual co-fixpoint (there are simpler ways, though). *) CoFixpoint trues_falses : stream bool := Cons true falses_trues with falses_trues : stream bool := Cons false trues_falses. (* Exercise (easy): Find two more ways for constructing the stream which infinitely alternates the values true and false. *) (* Not every co-fixpoint is accepted by Coq, though: there are important restrictions that are dual to the restrictions on the use of inductive types. Fixpoints _consume_ values of inductive types, with restrictions on which _arguments_ may be passed in recursive calls. Dually, co-fixpoints _produce_ values of co-inductive types, with restrictions on what may be done with the _results_ of co-recursive calls. *) (* Coq enforces that every co-recursive call must be guarded by a constructor; that is, every co-recursive call must be a direct argument to a constructor of the co-inductive type we are generating. For instance, the following co-fixpoint does not pass Coq's guardedness condition: CoFixpoint looper : stream nat := looper. << Error: Recursive definition of looper is ill-formed. In environment looper : stream nat unguarded recursive call in "looper" >> *) (* It is a good thing that this guardedness condition is enforced. If the definition of [looper] were accepted, our [approx] function would run forever when passed [looper], and we would have fallen into inconsistency. *) (* Many other standard functions on lazy data structures (like [map], [iterate] and [iterate] above) can be implemented easily in Coq. Some, others like [filter], cannot be implemented. (Why?) *) (* ------------------------------------------------------------ *) (** ** Finite Proofs about Infinite Objects *) (* We saw that we can define recursive functions on infinite (or potentially infinite) objects -- e.g., approx. We can also use the standard Inductive machinery to define (some) useful properties of potentially infinite objects. *) Inductive finite A : llist A -> Prop := | fin_LNil : finite (LNil A) | fin_LCons : forall l x, finite l -> finite (LCons x l). (* What about defining a similar predicate [infinite]? *) (* ------------------------------------------------------------ *) (** ** Infinite Proofs *) (** Suppose that we wanted to prove formally that the streams [nats] and [nats'] from above are equivalent. The naive way to do this is to state it as the following equality: *) Theorem nats_eq : nats = nats'. Abort. (** However, faced with the initial subgoal, it is not at all clear how this theorem can be proved. In fact, it is unprovable. The [eq] predicate that we use is fundamentally limited to equalities that can be demonstrated by finite arguments. All we can prove this way is that any finite approximation of [nats] and [nats'] are equal. *) (* First try: *) Lemma approx_nats_eq : forall k, approx k nats = approx k nats'. Proof. induction k; intros. reflexivity. simpl. Abort. (** For this we need to work we need to first generalize the induction hypothesis and consider increasing streams of naturals starting at any natural number. *) Lemma approx_nats_eq_helper : forall k n, approx k (iterate S n) = approx k (nats_from_n n). Proof. induction k; crush. Qed. Lemma approx_nats_eq : forall k, approx k nats = approx k nats'. Proof. intros. eapply approx_nats_eq_helper. Qed. (** In order to deal with interesting properties of infinite objects, it is necessary to construct infinite proofs. What we need for that is a _co-inductive proposition_. That is, we want to define a proposition whose _proofs_ may be infinite (subject to the guardedness condition, of course). *) CoInductive stream_eq (A : Type) : stream A -> stream A -> Prop := | Stream_eq : forall (h : A) t1 t2, stream_eq t1 t2 -> stream_eq (Cons h t1) (Cons h t2). (** We say that two streams are equal if and only if they have the same heads and their tails are equal. We use normal finite/syntactic equality for the heads, and we refer to our new equality (co-)recursively for the tails. *) (** In order to construct infinite proof terms we need to use a co-fixpoint, in the same way as we did for constructing infinite program terms. While in programming mode we used [CoFixpoint]; in tactic mode we can use the related [cofix] tactic for building co-fixpoints. *) (** Before attacking the slightly harder problem of proving [nats] and [nats'] in the [stream_eq] relation, we first try to prove that [ones] and [ones'] are in [stream_eq]. We start by doing this directly using the [cofix] tactic. *) Theorem ones_eq : stream_eq ones ones'. cofix. assumption. (* "proof completed" *) (* Qed. --> Unguarded recursive call in "ones_eq" *) (** The same guardedness condition applies to our co-inductive proofs as to our co-inductive data structures. We should be grateful that this proof is rejected, because, if it were not, the same proof structure could be used to prove any co-inductive theorem vacuously, by direct appeal to itself! *) (** Looking at the proof term Coq generates from the proof script above, we see that the problem is that we are violating the guardedness condition. *) Show Proof. (** (cofix ones_eq : stream_eq ones ones' := ones_eq) *) (** During our proofs, Coq can help us check whether we have yet gone wrong in this way. We can run the command [Guarded] in any context to see if it is possible to finish the proof in a way that will yield a properly guarded proof term. Running [Guarded] here gives us the same error message that we got when we tried to run [Qed]. In larger proofs, [Guarded] can be helpful in detecting problems _before_ we think we are ready to run [Qed]. *) Restart. (** We need to start the co-induction by applying [stream_eq]'s constructor. To do that, we need to know that both arguments to the predicate are [Cons]es. Informally, this is trivial, but [simpl] is not able to help us, because co-fixpoint have to be evaluated lazily. *) cofix. simpl. (* does nothing *) Abort. (** It turns out that the simplest way to get off the ground with this proof is a commonly used hack. First, we need to define an identity function that seems pointless on first glance. *) Definition id_force A (s : stream A) : stream A := match s with | Cons h t => Cons h t end. (** Next, we need to prove a theorem that seems equally pointless. *) Theorem id_force_eq : forall A (s : stream A), s = id_force s. Proof. destruct s; reflexivity. Qed. (** But, miraculously, this theorem turns out to be just what we needed. *) Theorem ones_eq : stream_eq ones ones'. cofix. (** We can use the theorem to rewrite the two streams. *) rewrite (id_force_eq ones). rewrite (id_force_eq ones'). (** Now [simpl] is able to reduce the streams. *) simpl. (** Why did this silly-looking trick help? The answer has to do with the constraints placed on Coq's evaluation rules by the need for termination. The [cofix]-related restriction that foiled our first attempt at using [simpl] is dual to a restriction for [fix]. In particular, an application of an anonymous [fix] only reduces when the top-level structure of the recursive argument is known. Otherwise, we would be unfolding the recursive definition ad infinitum. Fixpoints only reduce when enough is known about the _definitions_ of their arguments. Dually, co-fixpoints only reduce when enough is known about _how their results will be used_. In particular, a [cofix] is only expanded when it is the discriminee of a [match]. Rewriting with our superficially silly lemma wrapped new [match]es around the two [cofix]es, triggering reduction. If [cofix]es reduced haphazardly, it would be easy to run into infinite loops in evaluation, since we are, after all, building infinite objects. *) (** Since we have exposed the [Cons] structure of each stream, we can apply the constructor of [stream_eq]. *) constructor. assumption. Qed. (** The example above shows that one can construct infinite proofs by directly using [cofix], but there are two important problems with this. First, it's hard to keep guardedness in mind when building large proofs. Second, using [cofix] directly interacts very badly with Coq's standard automation machinery. If we try to prove [ones_eq] with automation we get an invalid proof. *) Theorem ones_eq' : stream_eq ones ones'. cofix. Proof. cofix; auto. (** [[ Guarded. ]] *) Abort. (** The standard [auto] machinery sees that our goal matches an assumption and so applies that assumption, even though this violates guardedness. One usually starts a proof like this by [destruct]ing some parameter and running a custom tactic to figure out the first proof rule to apply for each case. Alternatively, there are tricks that can be played with "hiding" the co-inductive hypothesis. *) (** However, we can devise a more principled solution to this problem by looking at how the dual version of the problem is generally solved for induction. It's equally hard to build inductive proofs directly using [fix], but one almost never does that. Instead one uses [fix] to proving general _induction principles_, and then simply applies those principles. *) (** It turns out that we can usually do the same with _co-induction principles_. Coq will not generate co-induction principles for us though, so we need to define them by hand using co-fixpoints. *) Section stream_eq_coind1. Variable A : Type. Variable R : stream A -> stream A -> Prop. (* This is mechanically extracted from the definition of stream_eq *) Hypothesis H : forall s1 s2, R s1 s2 -> exists h, exists t1, exists t2, s1 = Cons h t1 /\ s2 = Cons h t2 /\ R t1 t2. Theorem stream_eq_coind1 : forall s1 s2 : stream A, R s1 s2 -> stream_eq s1 s2. Proof. cofix. intros s1 s2 H0. apply H in H0. destruct H0 as [h [t1 [t2 [H1 [H2 HR]]]]]. subst. apply Stream_eq. apply stream_eq_coind1. assumption. Qed. End stream_eq_coind1. (** We can now return to the proof of [ones_eq] *) Theorem ones_eq' : stream_eq ones ones'. Proof. apply stream_eq_coind1 with (R := fun s1 s2 => s1 = ones /\ s2 = ones'); [clear | tauto]. (* We'll return later on how to mechanically construct the R from the statement of the theorem we're trying to prove. In this case what we do here corresponds to the [remember] we do before inducting on compound terms. *) intros s1 s2 [? ?]. subst. repeat esplit. rewrite (id_force_eq ones) at 1. simpl. reflexivity. rewrite (id_force_eq ones') at 1. simpl. reflexivity. Qed. (** The previous coinduction principle works, but it can be further simplified to reach a more standard formulation (commonly called Park's principle) that's easier to use in automated proofs. *) Section stream_eq_coind. Variable A : Type. Variable R : stream A -> stream A -> Prop. (* We use head and tail instead of existential quantification *) Hypothesis H1 : forall s1 s2, R s1 s2 -> head s1 = head s2. Hypothesis H2 : forall s1 s2, R s1 s2 -> R (tail s1) (tail s2). (* We show that H1 /\ H2 is in equivalent the same as the previous H using existential quantification *) Lemma equiv : forall s1 s2, R s1 s2 -> ((exists h, exists t1, exists t2, s1 = Cons h t1 /\ s2 = Cons h t2 /\ R t1 t2) <-> (head s1 = head s2 /\ R (tail s1) (tail s2))). Proof. clear; split; intros. destruct H0 as [h [t1 [t2 [H1 [H2 H3]]]]]. subst. simpl. eauto. destruct H0 as [H1 H2]. exists (head s1). exists (tail s1). exists (tail s2). destruct s1; destruct s2; simpl in *; subst; intuition. Qed. (* The proof of the coinduction principle is different; e.g. we don't need to use the id_force_eq trick *) Theorem stream_eq_coind : forall s1 s2 : stream A, R s1 s2 -> stream_eq s1 s2. Proof. cofix. intros s1 s2 H0. destruct s1. destruct s2. pose proof (H1 H0). simpl in *. subst. pose proof (H2 H0). simpl in *. apply Stream_eq. apply stream_eq_coind. assumption. Qed. (* Note: we didn't need to use the *) End stream_eq_coind. (** We return again to the proof of [ones_eq] *) Theorem ones_eq'' : stream_eq ones ones'. Proof. apply stream_eq_coind with (R := fun s1 s2 => s1 = ones /\ s2 = ones'); crush. Qed. (** This principle is better in terms of automation. Let's try to use it to prove that [nats] and [nats'] are in [stream_eq].*) Lemma nats_eq : stream_eq nats nats'. Proof. apply stream_eq_coind with (R := fun s1 s2 => s1 = nats /\ s2 = nats'); crush. (* At this point we get two goals that are wrong: [iterate S 1 = nats] and [nats_from_n 1 = nats'] The co-induction hypothesis is not general enough! *) Abort. (** In the same way we had to strengthen the inductive hypothesis in [approx_nats_eq_helper], here we have to strengthen the co-inductive hypothesis *) Lemma nats_eq_helper : forall n, stream_eq (iterate S n) (nats_from_n n). Proof. intro n. apply stream_eq_coind with (R := fun s1 s2 => exists n, s1 = iterate S n /\ s2 = nats_from_n n); [crush | clear | eauto]. intros ? ? [n [? ?]]. exists (S n); crush. Qed. Theorem nats_eq : stream_eq nats nats'. Proof. apply nats_eq_helper. Qed. (** Recipe for constructing the "bisimulation" relation You have a goal of the form: forall x1, ..., xn, H1 -> ... -> Hm -> P t1 ... tl Where P is a coinductively defined predicate for which you've already defined a coinduction principle P_coind. In order to call P_coind you need to provide a predicate R. Here is a receipe to build R. ** Step 1 (remember) Replace any argument tj that's not a variable from xs with a fresh variable yj, universally quantify over yj at the top and add an additional hypothesis Hj : yj = tk. Repeat this until the goal looks like this: forall x1, ..., xn, H1' -> ... -> Hm' -> P y1 ... yl ** Step 2 (linearize) If a certain y appears twice in the proposition replace one of the occurrences with a fresh variable y' and add an equality of the form y = y' as a hypothesis. [You don't really need to change your goal to this, just construct this proposition in your mind.] [This step corresponds to "remember"-ing compound terms before applying induction ] ** Step 3 (conjunction + existentials) Construct the conjunction of all premises H1' /\ ... /\ Hm', and existentially quantify over all xs that are not ys: exists x1', exists x2', ... exists xn', H1' /\ ... /\ Hm' ** Step 4 (add a lambda on top) Chose R to be (fun y1 ... yl => exists x1', exists x2', ... exists xn', H1' /\ ... /\ Hm') and you're done. *) (* Exercise (medium): prove that ...*) Theorem map_iterate : forall (A:Type) (f:A->A) (x:A), stream_eq (iterate f (f x)) (map f (iterate f x)). Proof. Admitted.