(** * IndProp: Inductively Defined Propositions *) Set Warnings "-notation-overridden,-parsing". From DMFP Require Export Logic. (* ################################################################# *) (** * Overview *) (** In the [Logic] chapter, we looked at several ways of writing propositions, including conjunction, disjunction, and quantifiers. In this chapter, we bring a new tool into the mix: _inductive definitions_. There were originally two chapters on inductive propositions: this chapter ([IndProp]) and [IndProp2]. But in the interests of covering other, important material, we've condensed the two into one file. The optional exercises here are especially worthwhile. We'll continue our implementation of [natset]s, too, proving that they actually represent sets. *) (** Recall that we have seen two ways of stating that a number [n] is even: We can say (1) [evenb n = true], or (2) [exists k, n = double k]. Yet another possibility is to say that [n] is even if we can establish its evenness from the following rules: - Rule [ev_0]: The number [0] is even. - Rule [ev_SS]: If [n] is even, then [S (S n)] is even. *) (** To illustrate how this definition of evenness works, let's imagine using it to show that [4] is even. By rule [ev_SS], it suffices to show that [2] is even. This, in turn, is again guaranteed by rule [ev_SS], as long as we can show that [0] is even. But this last fact follows directly from the [ev_0] rule. *) (** We will see many definitions like this one during the rest of the course. For purposes of informal discussions, it is helpful to have a lightweight notation that makes them easy to read and write. _Inference rules_ are one such notation: ------------ (ev_0) ev 0 ev n -------------- (ev_SS) ev (S (S n)) *) (** Each of the textual rules above is reformatted here as an inference rule; the intended reading is that, if the _premises_ above the line all hold, then the _conclusion_ below the line follows. For example, the rule [ev_SS] says that, if [n] satisfies [ev], then [S (S n)] also does. If a rule has no premises above the line, then its conclusion holds unconditionally. We can represent a proof using these rules by combining rule applications into a _proof tree_. Here's how we might transcribe the above proof that [4] is even: ------ (ev_0) ev 0 ------ (ev_SS) ev 2 ------ (ev_SS) ev 4 *) (** Why call this a "tree" (rather than a "stack", for example)? Because, in general, inference rules can have multiple premises. We will see examples of this below. *) (** Putting all of this together, we can translate the definition of evenness into a formal Coq definition using an [Inductive] declaration, where each constructor corresponds to an inference rule: *) Inductive ev : nat -> Prop := | ev_0 : ev 0 | ev_SS (n : nat) (H : ev n) : ev (S (S n)). (** This definition is different in one crucial respect from previous uses of [Inductive]: its result is not a [Type], but rather a function from [nat] to [Prop] -- that is, a property of numbers. Note that we've already seen other inductive definitions that result in functions, such as [list], whose type is [Type -> Type]. What is new here is that, because the [nat] argument of [ev] appears _unnamed_, to the _right_ of the colon, it is allowed to take different values in the types of different constructors: [0] in the type of [ev_0] and [S (S n)] in the type of [ev_SS]. In contrast, the definition of [list] names the [X] parameter _globally_, to the _left_ of the colon, forcing the result of [nil] and [cons] to be the same ([list X]). Had we tried to bring [nat] to the left in defining [ev], we would have seen an error: *) Fail Inductive wrong_ev (n : nat) : Prop := | wrong_ev_0 : wrong_ev 0 | wrong_ev_SS : (H : wrong_ev n) : wrong_ev (S (S n)). (* ===> Error: A parameter of an inductive type n is not allowed to be used as a bound variable in the type of its constructor. *) (** ("Parameter" here is Coq jargon for an argument on the left of the colon in an [Inductive] definition; "index" is used to refer to arguments on the right of the colon.) *) (** We can think of the definition of [ev] as defining a Coq property [ev : nat -> Prop], together with primitive theorems [ev_0 : ev 0] and [ev_SS : forall n, ev n -> ev (S (S n))]. *) (** Such "constructor theorems" have the same status as proven theorems. In particular, we can use Coq's [apply] tactic with the rule names to prove [ev] for particular numbers... *) Theorem ev_4 : ev 4. Proof. apply ev_SS. apply ev_SS. apply ev_0. Qed. (** ... or we can use function application syntax: *) Theorem ev_4' : ev 4. Proof. apply (ev_SS 2 (ev_SS 0 ev_0)). Qed. (** We can also prove theorems that have hypotheses involving [ev]. *) Theorem ev_plus4 : forall n, ev n -> ev (4 + n). Proof. intros n. simpl. intros Hn. apply ev_SS. apply ev_SS. apply Hn. Qed. (** More generally, we can show that any number multiplied by 2 is even: *) (** **** Exercise: 1 star, standard (ev_double) *) Theorem ev_double : forall n, ev (double n). Proof. (* FILL IN HERE *) Admitted. (** [] *) (* ################################################################# *) (** * Using Evidence in Proofs *) (** Besides _constructing_ evidence that numbers are even, we can also _reason about_ such evidence. Introducing [ev] with an [Inductive] declaration tells Coq not only that the constructors [ev_0] and [ev_SS] are valid ways to build evidence that some number is even, but also that these two constructors are the _only_ ways to build evidence that numbers are even (in the sense of [ev]). *) (** In other words, if someone gives us evidence [E] for the assertion [ev n], then we know that [E] must have one of two shapes: - [E] is [ev_0] (and [n] is [O]), or - [E] is [ev_SS n' E'] (and [n] is [S (S n')], where [E'] is evidence for [ev n']). *) (** This suggests that it should be possible to analyze a hypothesis of the form [ev n] much as we do inductively defined data structures; in particular, it should be possible to argue by _induction_ and _case analysis_ on such evidence. Let's look at a few examples to see what this means in practice. *) (* ================================================================= *) (** ** Inversion on Evidence *) (** Suppose we are proving some fact involving a number [n], and we are given [ev n] as a hypothesis. We already know how to perform case analysis on [n] using the [inversion] tactic, generating separate subgoals for the case where [n = O] and the case where [n = S n'] for some [n']. But for some proofs we may instead want to analyze the evidence that [ev n] _directly_. By the definition of [ev], there are two cases to consider: - If the evidence is of the form [ev_0], we know that [n = 0]. - Otherwise, the evidence must have the form [ev_SS n' E'], where [n = S (S n')] and [E'] is evidence for [ev n']. *) Theorem ev_inversion : forall (n : nat), ev n -> (n = 0) \/ (exists n', n = S (S n') /\ ev n'). Proof. intros n E. destruct E as [ | n' E']. - (* E = ev_0 : ev 0 *) left. reflexivity. - (* E = ev_SS n' E' : ev (S (S n')) *) right. exists n'. split. reflexivity. apply E'. Qed. (** The following theorem can easily be proved using [destruct] on evidence. *) Theorem ev_minus2 : forall n, ev n -> ev (pred (pred n)). Proof. intros n E. inversion E as [| n' E']. - (* E = ev_0 *) simpl. apply ev_0. - (* E = ev_SS n' E' *) simpl. apply E'. Qed. (** However, this variation cannot easily be handled with just [destruct]. *) Theorem evSS_ev : forall n, ev (S (S n)) -> ev n. (** Intuitively, we know that evidence for the hypothesis cannot consist just of the [ev_0] constructor, since [O] and [S] are different constructors of the type [nat]; hence, [ev_SS] is the only case that applies. Unfortunately, [destruct] is not smart enough to realize this, and it still generates two subgoals. Even worse, in doing so, it keeps the final goal unchanged, failing to provide any useful information for completing the proof. *) Proof. intros n E. destruct E as [| n' E']. - (* E = ev_0. *) (* We must prove that [n] is even from no assumptions! *) Abort. (** What happened, exactly? Calling [destruct] has the effect of replacing all occurrences of the property argument by the values that correspond to each constructor. This is enough in the case of [ev_minus2] because that argument [n] is mentioned directly in the final goal. However, it doesn't help in the case of [evSS_ev] since the term that gets replaced ([S (S n)]) is not mentioned anywhere. *) (** But the proof is straightforward using our inversion lemma. *) Theorem evSS_ev : forall n, ev (S (S n)) -> ev n. Proof. intros n H. apply ev_inversion in H. destruct H. - discriminate H. - destruct H as [n' [Hnm Hev]]. injection Hnm as Heq. rewrite Heq. apply Hev. Qed. (** Note how both proofs produce two subgoals, which correspond to the two ways of proving [ev]. The first subgoal is a contradiction that is discharged with [discriminate]. The second subgoal makes use of [injection] and [rewrite]. Coq provides a handy tactic called [inversion] that factors out that common pattern. The [inversion] tactic can detect (1) that the first case ([n = 0]) does not apply and (2) that the [n'] that appears in the [ev_SS] case must be the same as [n]. It has an "[as]" variant similar to [destruct], allowing us to assign names rather than have Coq choose them. *) Theorem evSS_ev' : forall n, ev (S (S n)) -> ev n. Proof. intros n E. inversion E as [| n' E' EQ]. (* We are in the [E = ev_SS n' E'] case now. *) apply E'. Qed. (** The [inversion] tactic can apply the principle of explosion to "obviously contradictory" hypotheses involving inductively defined properties, something that takes a bit more work using our inversion lemma. For example: *) Theorem one_not_even : ~ ev 1. Proof. intros H. apply ev_inversion in H. destruct H as [ | [m [Hm _]]]. - discriminate H. - discriminate Hm. Qed. Theorem one_not_even' : ~ ev 1. Proof. intros H. inversion H. Qed. (** **** Exercise: 1 star, standard (SSSSev__even) Prove the following result using [inversion]. *) Theorem SSSSev__even : forall n, ev (S (S (S (S n)))) -> ev n. Proof. (* FILL IN HERE *) Admitted. (** [] *) (** **** Exercise: 1 star, standard (ev5_nonsense) Prove the following result using [inversion]. *) Theorem ev5_nonsense : ev 5 -> 2 + 2 = 9. Proof. (* FILL IN HERE *) Admitted. (** [] *) (** The [inversion] tactic does quite a bit of work. For example, when applied to an equality assumption, it does the work of both [discriminate] and [injection]. In addition, it carries out the [intros] and [rewrite]s that are typically necessary in the case of [injection]. It can also be applied, more generally, to analyze evidence for inductively defined propositions. As examples, we'll use it to reprove some theorems from chapter [Tactics]. (Here we are being a bit lazy by omitting the [as] clause from [inversion], thereby asking Coq to choose names for the variables and hypotheses that it introduces.) *) Theorem inversion_ex1 : forall (n m o : nat), [n; m] = [o; o] -> [n] = [m]. Proof. intros n m o H. inversion H. reflexivity. Qed. Theorem inversion_ex2 : forall (n : nat), S n = O -> 2 + 2 = 5. Proof. intros n contra. inversion contra. Qed. (** Here's how [inversion] works in general. Suppose the name [H] refers to an assumption [P] in the current context, where [P] has been defined by an [Inductive] declaration. Then, for each of the constructors of [P], [inversion H] generates a subgoal in which [H] has been replaced by the exact, specific conditions under which this constructor could have been used to prove [P]. Some of these subgoals will be self-contradictory; [inversion] throws these away. The ones that are left represent the cases that must be proved to establish the original goal. For those, [inversion] adds all equations into the proof context that must hold of the arguments given to [P] (e.g., [S (S n') = n] in the proof of [evSS_ev]). *) (** The [ev_double] exercise above shows that our new notion of evenness is implied by the two earlier ones (since, by [even_bool_prop] in chapter [Logic], we already know that those are equivalent to each other). To show that all three coincide, we just need the following lemma: *) Lemma ev_even_firsttry : forall n, ev n -> exists k, n = double k. Proof. (* WORKED IN CLASS *) (** We could try to proceed by case analysis or induction on [n]. But since [ev] is mentioned in a premise, this strategy would probably lead to a dead end, as in the previous section. Thus, it seems better to first try inversion on the evidence for [ev]. Indeed, the first case can be solved trivially. *) intros n E. inversion E as [| n' E']. - (* E = ev_0 *) exists 0. reflexivity. - (* E = ev_SS n' E' *) simpl. (** Unfortunately, the second case is harder. We need to show [exists k, S (S n') = double k], but the only available assumption is [E'], which states that [ev n'] holds. Since this isn't directly useful, it seems that we are stuck and that performing case analysis on [E] was a waste of time. If we look more closely at our second goal, however, we can see that something interesting happened: By performing case analysis on [E], we were able to reduce the original result to an similar one that involves a _different_ piece of evidence for [ev]: [E']. More formally, we can finish our proof by showing that exists k', n' = double k', which is the same as the original statement, but with [n'] instead of [n]. Indeed, it is not difficult to convince Coq that this intermediate result suffices. *) assert (I : (exists k', n' = double k') -> (exists k, S (S n') = double k)). { intros [k' Hk']. rewrite Hk'. exists (S k'). reflexivity. } apply I. (* reduce the original goal to the new one *) (* However, at this point we can go no further. *) Abort. (* ================================================================= *) (** ** Induction on Evidence *) (** If this looks familiar, it is no coincidence: We've encountered similar problems in the [Induction] chapter, when trying to use case analysis to prove results that required induction. And once again the solution is... induction! The behavior of [induction] on evidence is the same as its behavior on data: It causes Coq to generate one subgoal for each constructor that could have used to build that evidence, while providing an induction hypotheses for each recursive occurrence of the property in question. *) (** Let's try our current lemma again: *) Lemma ev_even : forall n, ev n -> exists k, n = double k. Proof. intros n E. induction E as [|n' E' IH]. - (* E = ev_0 *) exists 0. reflexivity. - (* E = ev_SS n' E' with IH : exists k', n' = double k' *) destruct IH as [k' Hk']. rewrite Hk'. exists (S k'). reflexivity. Qed. (** Here, we can see that Coq produced an [IH] that corresponds to [E'], the single recursive occurrence of [ev] in its own definition. Since [E'] mentions [n'], the induction hypothesis talks about [n'], as opposed to [n] or some other number. *) (** The equivalence between the second and third definitions of evenness now follows. *) Theorem ev_even_iff : forall n, ev n <-> exists k, n = double k. Proof. intros n. split. - (* -> *) apply ev_even. - (* <- *) intros [k Hk]. rewrite Hk. apply ev_double. Qed. (** As we will see in later chapters, induction on evidence is a recurring technique across many areas. *) (** The following exercises provide simple examples of this technique, to help you familiarize yourself with it. *) (** **** Exercise: 2 stars, standard (ev_sum) *) Theorem ev_sum : forall n m, ev n -> ev m -> ev (n + m). Proof. (* FILL IN HERE *) Admitted. (** [] *) (** **** Exercise: 4 stars, advanced, optional (ev'_ev) In general, there may be multiple ways of defining a property inductively. For example, here's a (slightly contrived) alternative definition for [ev]: *) Inductive ev' : nat -> Prop := | ev'_0 : ev' 0 | ev'_2 : ev' 2 | ev'_sum n m (Hn : ev' n) (Hm : ev' m) : ev' (n + m). (** Prove that this definition is logically equivalent to the old one. (You may want to look at the previous theorem when you get to the induction step.) *) Theorem ev'_ev : forall n, ev' n <-> ev n. Proof. (* FILL IN HERE *) Admitted. (** [] *) (** **** Exercise: 3 stars, advanced, recommended (ev_ev__ev) Finding the appropriate thing to do induction on is a bit tricky here: *) Theorem ev_ev__ev : forall n m, ev (n+m) -> ev n -> ev m. Proof. (* FILL IN HERE *) Admitted. (** [] *) (** **** Exercise: 3 stars, standard, optional (ev_plus_plus) This exercise just requires applying existing lemmas. No induction or even case analysis is needed, though some of the rewriting may be tedious. *) Theorem ev_plus_plus : forall n m p, ev (n+m) -> ev (n+p) -> ev (m+p). Proof. (* FILL IN HERE *) Admitted. (** [] *) (* ################################################################# *) (** * Inductive Relations *) (** A proposition parameterized by a number (such as [ev]) can be thought of as a _property_ -- i.e., it defines a subset of [nat], namely those numbers for which the proposition is provable. In the same way, a two-argument proposition can be thought of as a _relation_ -- i.e., it defines a set of pairs for which the proposition is provable. *) Module Playground. (** One useful example is the "less than or equal to" relation on numbers. *) (** The following definition should be fairly intuitive. It says that there are two ways to give evidence that one number is less than or equal to another: either observe that they are the same number, or give evidence that the first is less than or equal to the predecessor of the second. *) Inductive le : nat -> nat -> Prop := | le_n (n : nat) : le n n | le_S (n m : nat) (H : le n m) : le n (S m). Notation "m <= n" := (le m n). (** Proofs of facts about [<=] using the constructors [le_n] and [le_S] follow the same patterns as proofs about properties, like [ev] above. We can [apply] the constructors to prove [<=] goals (e.g., to show that [3<=3] or [3<=6]), and we can use tactics like [inversion] to extract information from [<=] hypotheses in the context (e.g., to prove that [(2 <= 1) -> 2+2=5].) *) (** Here are some sanity checks on the definition. (Notice that, although these are the same kind of simple "unit tests" as we gave for the testing functions we wrote in the first few lectures, we must construct their proofs explicitly -- [simpl] and [reflexivity] don't do the job, because the proofs aren't just a matter of simplifying computations.) *) Theorem test_le1 : 3 <= 3. Proof. (* WORKED IN CLASS *) apply le_n. Qed. Theorem test_le2 : 3 <= 6. Proof. (* WORKED IN CLASS *) apply le_S. apply le_S. apply le_S. apply le_n. Qed. Theorem test_le3 : (2 <= 1) -> 2 + 2 = 5. Proof. (* WORKED IN CLASS *) intros H. inversion H. inversion H2. Qed. (** The "strictly less than" relation [n < m] can now be defined in terms of [le]. *) End Playground. Definition lt (n m:nat) := le (S n) m. Notation "m < n" := (lt m n). (** Here are a few more simple relations on numbers: *) Inductive square_of : nat -> nat -> Prop := | sq n : square_of n (n * n). Inductive next_nat : nat -> nat -> Prop := | nn n : next_nat n (S n). Inductive next_ev : nat -> nat -> Prop := | ne_1 n (H: ev (S n)) : next_ev n (S n) | ne_2 n (H: ev (S (S n))) : next_ev n (S (S n)). (** **** Exercise: 2 stars, standard (total_relation) Define (in Coq) an inductive binary relation [total_relation] that holds between every pair of natural numbers. *) (* FILL IN HERE *) (* Do not modify the following line: *) Definition manual_grade_for_total_relation : option (nat*string) := None. (** [] *) (** **** Exercise: 2 stars, standard, optional (empty_relation) Define (in Coq) an inductive binary relation [empty_relation] (on numbers) that never holds. *) (* FILL IN HERE *) (* Do not modify the following line: *) Definition manual_grade_for_empty_relation : option (nat*string) := None. (** [] *) (** **** Exercise: 3 stars, standard, optional (le_exercises) Here are a number of facts about the [<=] and [<] relations that we are going to need later in the course. The proofs make good practice exercises. *) Lemma le_trans : forall m n o, m <= n -> n <= o -> m <= o. Proof. (* FILL IN HERE *) Admitted. Theorem O_le_n : forall n, 0 <= n. Proof. (* FILL IN HERE *) Admitted. Theorem n_le_m__Sn_le_Sm : forall n m, n <= m -> S n <= S m. Proof. (* FILL IN HERE *) Admitted. Theorem Sn_le_Sm__n_le_m : forall n m, S n <= S m -> n <= m. Proof. (* FILL IN HERE *) Admitted. Lemma leb_spec : forall (n m : nat), leb n m = true \/ (leb n m = false /\ leb m n = true). Proof. (* FILL IN HERE *) Admitted. Theorem leb_complete : forall n m, leb n m = true -> n <= m. Proof. (* FILL IN HERE *) Admitted. Theorem le_plus_l : forall a b, a <= a + b. Proof. (* FILL IN HERE *) Admitted. Theorem plus_lt : forall n1 n2 m, n1 + n2 < m -> n1 < m /\ n2 < m. Proof. unfold lt. (* FILL IN HERE *) Admitted. Lemma minus_Sn_m: forall n m : nat, m <= n -> S (n - m) = S n - m. Proof. (* FILL IN HERE *) Admitted. Theorem lt_S : forall n m, n < m -> n < S m. Proof. (* FILL IN HERE *) Admitted. (** Hint: The next one may be easiest to prove by induction on [m]. *) Theorem leb_correct : forall n m, n <= m -> leb n m = true. Proof. (* FILL IN HERE *) Admitted. (** Hint: This theorem can easily be proved without using [induction]. *) Theorem leb_true_trans : forall n m o, leb n m = true -> leb m o = true -> leb n o = true. Proof. (* FILL IN HERE *) Admitted. (** [] *) (** **** Exercise: 2 stars, standard, optional (leb_iff) *) Theorem leb_iff : forall n m, leb n m = true <-> n <= m. Proof. (* FILL IN HERE *) Admitted. (** [] *) Module R. (** We can define three-place relations, four-place relations, etc., in just the same way as binary relations. For example, consider the following three-place relation on numbers: *) Inductive R : nat -> nat -> nat -> Prop := | c1 : R 0 0 0 | c2 m n o (H : R m n o) : R (S m) n (S o) | c3 m n o (H : R m n o) : R m (S n) (S o) | c4 m n o (H : R (S m) (S n) (S (S o))) : R m n o | c5 m n o (H : R m n o) : R n m o. (** **** Exercise: 3 stars, standard (R_fact) *) (** The relation [R] above actually encodes a familiar function. Figure out which function; then state and prove this equivalence in Coq? (Only do this problem after yo've done the corresponding problem about [R] in the informal work.) *) Definition fR : nat -> nat -> nat (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted. Theorem R_equiv_fR : forall m n o, R m n o <-> fR m n = o. Proof. (* FILL IN HERE *) Admitted. (* Do not modify the following line: *) Definition manual_grade_for_R_fact : option (nat*string) := None. (** [] *) End R. (* ################################################################# *) (** * Reasoning about minima *) (** As practice with [<=], we'll prove some properties about [min3] and [argmin3]. We'll need these properties in [IndProp2], when we'll show that some edit functions are 'better' than others. *) (** **** Exercise: 2 stars, standard (min3_min) *) Lemma min3_min : forall n1 n2 n3, min3 n1 n2 n3 <= n1 /\ min3 n1 n2 n3 <= n2 /\ min3 n1 n2 n3 <= n3. Proof. (* FILL IN HERE *) Admitted. (** [] *) (** **** Exercise: 3 stars, standard (min3_leb) *) Lemma min3_leb : forall n1 n2 n3 m, n1 <= m \/ n2 <= m \/ n3 <= m -> min3 n1 n2 n3 <= m. Proof. (* FILL IN HERE *) Admitted. Lemma argmin3_min : forall {A:Type} cost (o1 o2 o3:A), cost (argmin3 cost o1 o2 o3) <= cost o1 /\ cost (argmin3 cost o1 o2 o3) <= cost o2 /\ cost (argmin3 cost o1 o2 o3) <= cost o3. Proof. (* FILL IN HERE *) Admitted. Lemma argmin3_leb : forall {A:Type} cost (o1 o2 o3:A) other, cost o1 <= cost other \/ cost o2 <= cost other \/ cost o3 <= cost other -> cost (argmin3 cost o1 o2 o3) <= cost other. Proof. (* FILL IN HERE *) Admitted. (** [] *) (* ################################################################# *) (** * Aside: Strong Induction *) (** So far, we've worked with a conventional induction principle on naturals: *) Definition weak_induction_principle : Prop := forall P : nat -> Prop, P 0 -> (forall n : nat, P n -> P (S n)) -> forall n : nat, P n. (** That is, to prove [P n] for any [n], we need to show that: - [P 0] holds (the _base case_), and - if [P n'] holds, then [P (S n')] holds (the _inductive case_). But there are other ways of doing induction on the naturals! The most common alternative is what's called _strong induction_ or _course of values_ induction. *) Definition strong_induction_principle : Prop := forall P : nat -> Prop, (forall n : nat, (forall m : nat, m < n -> P m) -> P n) -> forall n : nat, P n. (** That is, to prove [P n] for any [n], we: - assume that [P m] holds for all [m < n], and then - show that [P n] holds. This principle of induction is called "strong" induction because we get a stronger inductive hypothesis. In the "weak" induction we've been doing, our IH is that [P n'], which we use to prove [P (S n')]. In "strong" induction, to prove [P (S n')], our IH is that [P m] for _every_ [m < (S n')]. Metaphorically speaking, in weak induction we build a tower of proof just using the floor beneath us: to build the [S n]th floor, we assume that the [n]th floor is on solid ground. In strong induction, we build a tower of proof using _all_ of the floors beneath us: to build the [n]th floor, we can rely on the [m]th floor for [m < n]. *) (** Suppose we define a function [pow : nat -> nat -> nat] as follows: pow(m,0) = 1 pow(m,n) = if n is even then pow(m*m,n/2) else m * pow(m,n-1) We use strong induction to prove that the informal function [pow] defined above behaves the same as [exp] from Basics.v. Fixpoint exp (base power : nat) : nat := match power with | O => S O | S p => mult base (exp base p) end. We'll assume that [exp (m*m) ((S n')/2)], is equal to [exp m (S n')]. - _Theorem_: forall [m] and [n], [pow(m,n) = exp base power]. _Proof_: By strong induction on [n], leaving [m] general. Our IH is that for all [n' < n], we have [pow(m, n') = exp m n']; we must show [pow(m, n) = exp m n]. We go by cases on [n]. - If [n=0], then we have [exp m 0 = 1] and [pow(m,0) = 1] by definition. - If [n = S n'], then we have [exp m (S n') = m * exp m n']. We go by cases on the parity of [n]. + If [n] is even, then we have [pow(m, n) = pow(m*m, n/2)]. But by the IH on [n/2 < n], [pow(m*m, n/2)] is equal to [exp (m*m) (n/2)], which is itself equal to [exp m n]. + If [n] is odd, then we have [pow(m, S n') = m * pow(m, n')]; by the IH on [n' < n], we know that [pow(m, n') = exp(m, n')], and we are done. _Qed_. A few things to note about this proof: - We get the IH immediately! - We manually do a case analysis as the first step of our proof. - When [n=0], our IH is useless: there is no [n' < 0]! - Whenever we apply the IH, we have to show we're applying it to a smaller number. *) (** Strong induction is at least as strong as weak induction: we can prove the principle of weak induction using the principle of strong induction. Do NOT use the [induction] tactic: instead we _apply_ the strong induction principle. *) (** **** Exercise: 2 stars, standard (strong_induction__weak_induction) *) Lemma strong_induction__weak_induction : strong_induction_principle -> weak_induction_principle. Proof. unfold weak_induction_principle. intros Hstrong P Hbase Hind. apply Hstrong. (* FILL IN HERE *) Admitted. (** [] *) (** What may come as a surprise is that the weak induction principle is as strong as the strong induction principle: we can use it to prove the strong induction principle! Here we'll use the [induction] tactic in order to apply weak induction. Notice that we actually prove a more general property and then specialize it. Your job is to round out some of the detail. *) (** **** Exercise: 3 stars, standard, recommended (strong_induction) *) Lemma strong_induction : strong_induction_principle. Proof. unfold strong_induction_principle. intros P IHstrong n. assert (forall k, k <= n -> P k). { induction n as [|n' IHn']. - (* FILL IN HERE *) admit. - (* FILL IN HERE *) admit. } (* FILL IN HERE *) Admitted. (** [] *) (* ################################################################# *) (** * Case study: properties of set operations *) (** We've already proved a number of properties about our [natset] operations in [Logic], characterizing each operation in an "if and only if" logical description. There's an important set of properties that we haven't proved: that we maintain the [natset] invariant that each element appears at most once! *) (** Before we begin, we'll insert our own definitions of some operations you defined back in [Poly]. *) Fixpoint is_setlike (l : natset) : bool := match l with | [] => true | x :: l' => negb (member x l') && is_setlike l' end. Fixpoint intersection (l1 l2 : natset) : natset := match l1 with | [] => [] | x::l1' => if member x l2 then x::intersection l1' l2 else intersection l1' l2 end. Fixpoint subset (l1 l2 : natset) : bool := match l1 with | [] => true | x::l1' => member x l2 && subset l1' l2 end. (** We can characterize those [natset]s which are [setlike] using an inductive predicate. *) Inductive setlike : natset -> Prop := | setlike_nil : setlike [] | setlike_cons (x:nat) (l:natset) (Hin: ~ In x l) (H: setlike l) : setlike (x :: l). (** **** Exercise: 2 stars, standard (setlike_egs) Let's get a feel for the [setlike] predicate. It's always important to have positive examples---things that should satisfy the property, like [setlike_eg1]---as well as negative examples---things that should _not_ satisfy the property, like [setlike_eg2]. *) Example setlike_eg1 : setlike [1;2;3;4]. Proof. (* FILL IN HERE *) Admitted. Example setlike_eg2 : ~ setlike [1;2;3;4;1]. Proof. (* FILL IN HERE *) Admitted. (** [] *) (** **** Exercise: 2 stars, standard (is_setlike__setlike) We should, as always, double check our ideas. We have a [setlike] predicate on sets defined inductively and an [is_setlike] function defined recursively. Do these notions coincide? *) Lemma is_setlike__setlike : forall l, is_setlike l = true <-> setlike l. Proof. (* FILL IN HERE *) Admitted. (** [] *) (** **** Exercise: 2 stars, standard (insert_preserves_setlike) *) Lemma insert_preserves_setlike : forall x l, setlike l -> setlike (insert x l). Proof. (* FILL IN HERE *) Admitted. (** [] *) (** **** Exercise: 2 stars, standard (union_preserves_setlike) *) Lemma union_preserves_setlike : forall l1 l2, setlike l1 -> setlike l2 -> setlike (union l1 l2). Proof. (* FILL IN HERE *) Admitted. (** [] *) (** **** Exercise: 3 stars, standard, optional (remove_preserves_setlike) *) Lemma remove_preserves_setlike : forall x l, setlike l -> setlike (remove x l). Proof. (* FILL IN HERE *) Admitted. (** [] *) (** **** Exercise: 2 stars, standard, optional (intersection_preserves_setlike) *) Lemma intersection_preserves_setlike : forall l1 l2, setlike l1 -> setlike l2 -> setlike (intersection l1 l2). Proof. (* FILL IN HERE *) Admitted. (** [] *) (** **** Exercise: 4 stars, standard, optional (union_intersection_dist) The [setlike] predicate isn't just useful for checking that we've implemented our operations correctly---sometimes we need to use [setlike] in proofs! Prove that [intersection] _distributes_ over [union]. (You may be more familiar with distributivity from arithmetic: [x * (y + z) = (x * y) + (x * z)].) *) Lemma union_intersection_dist : forall l1 l2 l3, setlike l1 -> setlike l2 -> setlike l3 -> intersection (union l1 l2) l3 = union (intersection l1 l3) (intersection l2 l3). Proof. (* FILL IN HERE *) Admitted. (** [] *) (* ################################################################# *) (** * Case study: optimality for Levenshtein edit distance *) (** We've proven that our various edit-finding algorithms are correct. But which is best (for our notion of [edit])? Levenshtein edit distance is _optimal_: it always produces the lowest cost edits possible. Now that we have a notion like [<=], we can prove that! *) (** **** Exercise: 2 stars, standard (naive_sub_worse) As a warm up, let's show that [sub_edit] is better than [naive_sub_edit]. The intuition here is that [sub_edit] and [naive_sub_edit] are more or less identical, except [sub_edit] sometimes produces a [copy] edit while [naive_sub_edit] always produces [substitute]. Since [cost copy = 0] and [cost (substitute b) = 1], using [sub_edit] should never be worse than [naive_sub_edit]. *) Lemma naive_sub_worse : forall src tgt, total_cost (sub_edit src tgt) <= total_cost (naive_sub_edit src tgt). Proof. (* FILL IN HERE *) Admitted. (** [] *) (** **** Exercise: 2 stars, standard (add_empty_optimal) For any edits from the empty strand to a given [tgt] strand, [add_edit] is optimal. Why? Well, you need to build the whole strand! Hint: the proof should go by induction on [edits]. You'll need to do some case analysis on the _other_ edit and on [tgt]. *) Lemma add_empty_optimal : forall (tgt : strand) (edits : list edit), valid_edit [] tgt edits -> total_cost (add_edit tgt) <= total_cost edits. Proof. (* FILL IN HERE *) Admitted. (** [] *) (** **** Exercise: 2 stars, standard, optional (delete_empty_optimal) Similarly, [delete_edit] is optimal when editing a strand to empty. *) Lemma delete_empty_optimal : forall (src : strand) (edits : list edit), valid_edit src [] edits -> total_cost (delete_edit src) <= total_cost edits. Proof. (* FILL IN HERE *) Admitted. (** [] *) (** **** Exercise: 3 stars, standard (levenshtein_optimal) Prove that [levenshtein] is optimal. The following lemma will be helpful. *) Lemma levenshtein_refl_copy : forall (src : strand), levenshtein src src = copy_edit src. Proof. induction src as [|b src' IH]. - reflexivity. - simpl. rewrite eq_base_refl. rewrite IH. assert (total_cost (copy :: copy_edit src') = 0) by apply copy_cost_0. unfold argmin3. rewrite H. simpl. reflexivity. Qed. (** We've given you the structure of this (fairly challenging!) proof. Try not to be intimidated by the large formulae you might be given. Go slow and read everything. If you get confused, use a whiteboard. *) Lemma levenshtein_optimal : forall (src tgt : strand) (edits : list edit), valid_edit src tgt edits -> total_cost (levenshtein src tgt) <= total_cost edits. Proof. induction src as [|b1 src' IH1]. - intros [|b2 tgt'] edits; unfold valid_edit; intros Hvalid. + (* FILL IN HERE *) admit. + (* FILL IN HERE *) admit. - induction tgt as [|b2 tgt' IH2]; unfold valid_edit; intros [|edit edits'] H. + (* FILL IN HERE *) admit. + (* FILL IN HERE *) admit. + (* FILL IN HERE *) admit. + simpl. destruct edit as [| | b3 | b3]; simpl in H. * replace (cost copy + total_cost edits') with (total_cost (copy :: edits')) by reflexivity. (* [replace e1 with e2 by tactic] is a handy way of saying: [assert (e1 = e2) as H. { tactic } rewrite H.] Feel free to use the [replace] tactic if you like it---it's a handy way of controlling rewriting/simplification. *) apply argmin3_leb. left. (* FILL IN HERE *) admit. * replace (cost delete + total_cost edits') with (total_cost (delete :: edits')) by reflexivity. apply argmin3_leb. right. left. (* FILL IN HERE *) admit. * replace (cost (add b3) + total_cost edits') with (total_cost (add b3 :: edits')) by reflexivity. apply argmin3_leb. (* FILL IN HERE *) admit. * replace (cost (substitute b3) + total_cost edits') with (total_cost (substitute b3 :: edits')) by reflexivity. apply argmin3_leb. (* FILL IN HERE *) admit. (* FILL IN HERE *) Admitted. (** [] *) (** $Date: 2017-11-15 11:12:04 -0800 (Wed, 15 Nov 2017) $ *) (* Mon Apr 20 15:58:33 PDT 2020 *)