(** * Prop: Propositions and Evidence *)

Require Export MoreCoq.

(** In previous chapters, we have seen many examples of factual
    claims (_propositions_) and ways of presenting evidence of their
    truth (_proofs_).  In particular, we have worked extensively with
    _equality propositions_ of the form [e1 = e2], with
    implications ([P -> Q]), and with quantified propositions
    ([forall x, P]).

    In this chapter we take a deeper look at the way propositions are
    expressed in Coq and at the structure of the logical evidence that
    we construct when we carry out proofs.

    Some of the concepts in this chapter may seem a bit abstract on a
    first encounter.  We've included a _lot_ of exercises, most of
    which should be quite approachable even if you're still working on
    understanding the details of the text.  Try to work as many of
    them as you can, especially the one-starred exercises.

*)
(* ##################################################### *)
(** * Inductively Defined Propositions *)

(** This chapter will take us on a first tour of the
    propositional (logical) side of Coq.  As a running example, let's
    define a simple property of natural numbers -- we'll call it
    "[beautiful]." *)

(** Informally, a number is [beautiful] if it is [0], [3], [5], or the
    sum of two [beautiful] numbers.

    More pedantically, we can define [beautiful] numbers by giving four
    rules:

       - Rule [b_0]: The number [0] is [beautiful].
       - Rule [b_3]: The number [3] is [beautiful].
       - Rule [b_5]: The number [5] is [beautiful].
       - Rule [b_sum]: If [n] and [m] are both [beautiful], then so is
         their sum. *)

(** We will see many definitions like this one during the rest
    of the course, and 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: *)
(**
                              -----------                               (b_0)
                              beautiful 0

                              ------------                              (b_3)
                              beautiful 3

                              ------------                              (b_5)
                              beautiful 5

                       beautiful n     beautiful m
                       ---------------------------                      (b_sum)
                              beautiful (n+m)
*)

(** 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 [b_sum] says that, if [n] and [m]
    are both [beautiful] numbers, then it follows that [n+m] is
    [beautiful] too.  The rules with no premises above the line are
    called _axioms_.

    These rules _define_ the property [beautiful].  That is, if we
    want to convince someone that some particular number is [beautiful],
    our argument must be based on these rules.  For a simple example,
    suppose we claim that the number [5] is [beautiful].  To support
    this claim, we just need to point out that rule [b_5] says so.
    Or, if we want to claim that [8] is [beautiful], we can support our
    claim by first observing that [3] and [5] are both [beautiful] (by
    rules [b_3] and [b_5]) and then pointing out that their sum, [8],
    is therefore [beautiful] by rule [b_sum].  This argument can be
    expressed graphically with the following _proof tree_: *)
(**
         ----------- (b_3)   ----------- (b_5)
         beautiful 3         beautiful 5
         ------------------------------- (b_sum)
                   beautiful 8
    Of course, there are other ways of using these rules to argue that
    [8] is [beautiful], for instance:
         ----------- (b_5)   ----------- (b_3)
         beautiful 5         beautiful 3
         ------------------------------- (b_sum)
                   beautiful 8
*)

(** **** Exercise: 1 star (varieties_of_beauty) *)
(** How many different ways are there to show that [8] is [beautiful]? *)

(* FILL IN HERE *)
(** [] *)

(** In Coq, we can express the definition of [beautiful] as
    follows: *)

Inductive beautiful : nat -> Prop :=
  b_0   : beautiful 0
| b_3   : beautiful 3
| b_5   : beautiful 5
| b_sum : forall n m, beautiful n -> beautiful m -> beautiful (n+m).

(** The first line declares that [beautiful] is a proposition -- or,
    more formally, a family of propositions "indexed by" natural
    numbers.  (That is, for each number [n], the claim that "[n] is
    [beautiful]" is a proposition.)  Such a family of propositions is
    often called a _property_ of numbers.  Each of the remaining lines
    embodies one of the rules for [beautiful] numbers.

    We can use Coq's tactic scripting facility to assemble proofs that
    particular numbers are [beautiful].  *)

Theorem three_is_beautiful: beautiful 3.
Proof.
   (* This simply follows from the axiom [b_3]. *)
   apply b_3.
Qed.

Theorem eight_is_beautiful: beautiful 8.
Proof.
   (* First we use the rule [b_sum], telling Coq how to
      instantiate [n] and [m]. *)
   apply b_sum with (n:=3) (m:=5).
   (* To solve the subgoals generated by [b_sum], we must provide
      evidence of [beautiful 3] and [beautiful 5]. Fortunately we
      have axioms for both. *)
   apply b_3.
   apply b_5.
Qed.

(* ##################################################### *)
(** * Proof Objects *)

(** Look again at the formal definition of the [beautiful]
    property.  The opening keyword, [Inductive], has been used up to
    this point to declare new types of _data_, such as numbers and
    lists.  Does this interpretation also make sense for the Inductive
    definition of [beautiful]?  That is, can we view evidence of
    beauty as some kind of data structure? Yes, we can!

    The trick is to introduce an alternative pronunciation of "[:]".
    Instead of "has type," we can also say "is a proof of."  For
    example, the second line in the definition of [beautiful] declares
    that [b_0 : beautiful 0].  Instead of "[b_0] has type
    [beautiful 0]," we can say that "[b_0] is a proof of [beautiful 0]."
    Similarly for [b_3] and [b_5]. *)

(** This pun between types and propositions (between [:] as "has type"
    and [:] as "is a proof of" or "is evidence for") is called the
    _Curry-Howard correspondence_.  It proposes a deep connection
    between the world of logic and the world of computation.
<<
                 propositions  ~  types
                 proofs        ~  data values
>>
    Many useful insights follow from this connection.  To begin with, it
    gives us a natural interpretation of the type of [b_sum] constructor: *)

Check b_sum.
(* ===> b_sum : forall n m,
                  beautiful n ->
                  beautiful m ->
                  beautiful (n+m) *)

(** This can be read "[b_sum] is a constructor that takes four
    arguments -- two numbers, [n] and [m], and two values, of types
    [beautiful n] and [beautiful m] -- and yields evidence for the
    proposition [beautiful (n+m)]." *)

(** In view of this, we might wonder whether we can write an
    expression of type [beautiful 8] by applying [b_sum] to
    appropriate arguments.  Indeed, we can: *)

Check (b_sum 3 5 b_3 b_5).
(* ===> beautiful (3 + 5) *)

(** The expression [b_sum 3 5 b_3 b_5] can be thought of as
    instantiating the parameterized constructor [b_sum] with the
    specific arguments [3] [5] and the corresponding proof objects for
    its premises [beautiful 3] and [beautiful 5] (Coq is smart enough
    to figure out that 3+5=8).  Alternatively, we can think of [b_sum]
    as a primitive "evidence constructor" that, when applied to two
    particular numbers, wants to be further applied to evidence that
    those two numbers are beautiful; its type,
[[
    forall n m, beautiful n -> beautiful m -> beautiful (n+m),
    expresses this functionality, in the same way that the polymorphic
    type [forall X, list X] in the previous chapter expressed the fact
    that the constructor [nil] can be thought of as a function from
    types to empty lists with elements of that type. *)

(** This gives us an alternative way to write the proof that [8] is
    beautiful: *)

Theorem eight_is_beautiful': beautiful 8.
Proof.
   apply (b_sum 3 5 b_3 b_5).
Qed.

(** Notice that we're using [apply] here in a new way: instead of just
    supplying the _name_ of a hypothesis or previously proved theorem
    whose type matches the current goal, we are supplying an
    _expression_ that directly builds evidence with the required
    type. *)

(* ##################################################### *)
(** ** Proof Scripts and Proof Objects *)

(** These proof objects lie at the core of how Coq operates.

    When Coq is following a proof script, what is happening internally
    is that it is gradually constructing a proof object -- a term
    whose type is the proposition being proved.  The tactics between
    the [Proof] command and the [Qed] instruct Coq how to build up a
    term of the required type.  To see this process in action, let's
    use the [Show Proof] command to display the current state of the
    proof tree at various points in the following tactic proof. *)

Theorem eight_is_beautiful'': beautiful 8.
Proof.
   Show Proof.
   apply b_sum with (n:=3) (m:=5).
   Show Proof.
   apply b_3.
   Show Proof.
   apply b_5.
   Show Proof.
Qed.

(** At any given moment, Coq has constructed a term with some
    "holes" (indicated by [?1], [?2], and so on), and it knows what
    type of evidence is needed at each hole.  In the [Show Proof]
    output, lines of the form [?1 -> beautiful n] record these
    requirements.  (The [->] here has nothing to do with either
    implication or function types -- it is just an unfortunate choice
    of concrete syntax for the output!)

    Each of the holes corresponds to a subgoal, and the proof is
    finished when there are no more subgoals.  At this point, the
    [Theorem] command gives a name to the evidence we've built and
    stores it in the global context. *)

(** Tactic proofs are useful and convenient, but they are not
    essential: in principle, we can always construct the required
    evidence by hand.  Indeed, we don't even need the [Theorem]
    command: we can instead use [Definition] to directly give a global
    name to a piece of evidence. *)

Definition eight_is_beautiful''' : beautiful 8 :=
  b_sum 3 5 b_3 b_5.

(** All these different ways of building the proof lead to exactly the
    same evidence being saved in the global environment. *)

Print eight_is_beautiful.
(* ===> eight_is_beautiful    = b_sum 3 5 b_3 b_5 : beautiful 8 *)
Print eight_is_beautiful'.
(* ===> eight_is_beautiful'   = b_sum 3 5 b_3 b_5 : beautiful 8 *)
Print eight_is_beautiful''.
(* ===> eight_is_beautiful''  = b_sum 3 5 b_3 b_5 : beautiful 8 *)
Print eight_is_beautiful'''.
(* ===> eight_is_beautiful''' = b_sum 3 5 b_3 b_5 : beautiful 8 *)

(** **** Exercise: 1 star (six_is_beautiful) *)
(** Give a tactic proof and a proof object showing that [6] is [beautiful]. *)

Theorem six_is_beautiful :
  beautiful 6.
Proof.
  (* FILL IN HERE *) Admitted.

Definition six_is_beautiful' : beautiful 6 :=
  (* FILL IN HERE *) admit.
(** [] *)

(** **** Exercise: 1 star (nine_is_beautiful) *)
(** Give a tactic proof and a proof object showing that [9] is [beautiful]. *)

Theorem nine_is_beautiful :
  beautiful 9.
Proof.
  (* FILL IN HERE *) Admitted.

Definition nine_is_beautiful' : beautiful 9 :=
  (* FILL IN HERE *) admit.
(** [] *)

(* ##################################################### *)
(** ** Implications and Functions *)

(** In Coq's computational universe (where we've mostly been living
    until this chapter), there are two sorts of values with arrows in
    their types: _constructors_ introduced by [Inductive]-ly defined
    data types, and _functions_.

    Similarly, in Coq's logical universe, there are two ways of giving
    evidence for an implication: constructors introduced by
    [Inductive]-ly defined propositions, and... functions!

    For example, consider this statement: *)

Theorem b_plus3: forall n, beautiful n -> beautiful (3+n).
Proof.
   intros n H.
   apply b_sum.
   apply b_3.
   apply H.
Qed.

(** What is the proof object corresponding to [b_plus3]?

    We're looking for an expression whose _type_ is [forall n,
    beautiful n -> beautiful (3+n)] -- that is, a _function_ that
    takes two arguments (one number and a piece of evidence) and
    returns a piece of evidence!  Here it is: *)

Definition b_plus3' : forall n, beautiful n -> beautiful (3+n) :=
  fun n => fun H : beautiful n =>
    b_sum 3 n b_3 H.

Check b_plus3'.
(* ===> b_plus3' : forall n, beautiful n -> beautiful (3+n) *)

(** Recall that [fun n => blah] means "the function that, given [n],
    yields [blah]."  Another equivalent way to write this definition is: *)

Definition b_plus3'' (n : nat) (H : beautiful n) : beautiful (3+n) :=
  b_sum 3 n b_3 H.

Check b_plus3''.
(* ===> b_plus3'' : forall n, beautiful n -> beautiful (3+n) *)

(** **** Exercise: 2 stars (b_times2) *)
Theorem b_times2: forall n, beautiful n -> beautiful (2*n).
Proof.
    (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars, optional (b_times2') *)
(** Write a proof object corresponding to [b_times2] above *)

Definition b_times2': forall n, beautiful n -> beautiful (2*n) :=
  (* FILL IN HERE *) admit.

(** **** Exercise: 2 stars (b_timesm) *)
Theorem b_timesm: forall n m, beautiful n -> beautiful (m*n).
Proof.
   (* FILL IN HERE *) Admitted.
(** [] *)

(* ####################################################### *)
(** ** Induction Over Proof Objects *)

(** Since we use the keyword [Induction] to define primitive
    propositions together with their evidence, we might wonder whether
    there are some sort of induction principles associated with these
    definitions.  Indeed there are, and in this section we'll take a
    look at how they can be used.  *)

(** Besides _constructing_ evidence that numbers are beautiful, we can
    also _reason about_ such evidence. *)

(** The fact that we introduced [beautiful] with an [Inductive]
    declaration tells us not only that the constructors [b_0], [b_3],
    [b_5] and [b_sum] are ways to build evidence, but also that these
    two constructors are the _only_ ways to build evidence that
    numbers are beautiful. *)

(** In other words, if someone gives us evidence [E] for the assertion
    [beautiful n], then we know that [E] must have one of four shapes:

      - [E] is [b_0] (and [n] is [O]),
      - [E] is [b_3] (and [n] is [3]),
      - [E] is [b_5] (and [n] is [5]), or
      - [E] is [b_sum n1 n2 E1 E2] (and [n] is [n1+n2], where [E1] is
        evidence that [n1] is beautiful and [E2] is evidence that [n2]
        is beautiful). *)

(** This gives rise to an _induction principle_ for proofs -- i.e., we
    can use the [induction] tactic that we have already seen for
    reasoning about inductively defined _data_ to reason about
    inductively defined _evidence_.

    To illustrate this, let's define another property of numbers: *)

Inductive gorgeous : nat -> Prop :=
  g_0 : gorgeous 0
| g_plus3 : forall n, gorgeous n -> gorgeous (3+n)
| g_plus5 : forall n, gorgeous n -> gorgeous (5+n).

(** **** Exercise: 1 star (gorgeous_tree) *)
(** Write out the definition of [gorgeous] numbers using inference rule
    notation.

(* FILL IN HERE *)
[]
*)

(** It seems intuitively obvious that, although [gorgeous] and
    [beautiful] are presented using slightly different rules, they are
    actually the same property in the sense that they are true of the
    same numbers.  Indeed, we can prove this. *)

Theorem gorgeous__beautiful : forall n,
  gorgeous n -> beautiful n.
Proof.
   intros n H.
   induction H as [|n'|n'].
   Case "g_0".
       apply b_0.
   Case "g_plus3".
       apply b_sum. apply b_3.
       apply IHgorgeous.
   Case "g_plus5".
       apply b_sum. apply b_5. apply IHgorgeous.
Qed.

(** Notice that the argument proceeds by induction on the _evidence_ [H]! *)

(** Let's see what happens if we try to prove this by induction on [n]
   instead of induction on the evidence [H]. *)

Theorem gorgeous__beautiful_FAILED : forall n,
  gorgeous n -> beautiful n.
Proof.
   intros. induction n as [| n'].
   Case "n = 0". apply b_0.
   Case "n = S n'". (* We are stuck! *)
Admitted.

(** The problem here is that doing induction on [n] doesn't yield a
    useful induction hypothesis. Knowing how the property we are
    interested in behaves on the predecessor of [n] doesn't help us
    prove that it holds for [n]. Instead, we would like to be able to
    have induction hypotheses that mention other numbers, such as [n -
    3] and [n - 5]. This is given precisely by the shape of the
    constructors for [gorgeous]. *)

(** **** Exercise: 1 star (gorgeous_plus13) *)
Theorem gorgeous_plus13: forall n,
  gorgeous n -> gorgeous (13+n).
Proof.
   (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional (gorgeous_plus13_po):
Give the proof object for theorem [gorgeous_plus13] above. *)

Definition gorgeous_plus13_po: forall n, gorgeous n -> gorgeous (13+n):=
   (* FILL IN HERE *) admit.
(** [] *)

(** **** Exercise: 2 stars (gorgeous_sum) *)
Theorem gorgeous_sum : forall n m,
  gorgeous n -> gorgeous m -> gorgeous (n + m).
Proof.
 (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars, advanced (beautiful__gorgeous) *)
Theorem beautiful__gorgeous : forall n, beautiful n -> gorgeous n.
Proof.
 (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars, optional (b_times2) *)
(** Prove the [g_times2] theorem below without using [gorgeous__beautiful].
    You might find the following helper lemma useful. *)

Lemma helper_g_times2 : forall x y z, x + (z + y)= z + x + y.
Proof.
   (* FILL IN HERE *) Admitted.

Theorem g_times2: forall n, gorgeous n -> gorgeous (2*n).
Proof.
   intros n H. simpl.
   induction H.
   (* FILL IN HERE *) Admitted.
(** [] *)

(* ####################################################### *)
(** ** From Boolean Functions to Propositions *)

(** In chapter [Basics] we defined a _function_ [evenb] that tests a
    number for evenness, yielding [true] if so.  We can use this
    function to define the _proposition_ that some number [n] is
    even: *)

Definition even (n:nat) : Prop :=
  evenb n = true.

(** That is, we can define "[n] is even" to mean "the function [evenb]
    returns [true] when applied to [n]." *)

(** Another alternative is to define the concept of evenness
    directly.  Instead of going via the [evenb] function ("a number is
    even if a certain computation yields [true]"), we can say what the
    concept of evenness means by giving two different ways of
    presenting _evidence_ that a number is even. *)

Inductive ev : nat -> Prop :=
  | ev_0 : ev O
  | ev_SS : forall n:nat, ev n -> ev (S (S n)).

(** This definition says that there are two ways to give
    evidence that a number [m] is even.  First, [0] is even, and
    [ev_0] is evidence for this.  Second, if [m = S (S n)] for some
    [n] and we can give evidence [e] that [n] is even, then [m] is
    also even, and [ev_SS n e] is the evidence. *)

(** **** Exercise: 1 star (double_even) *)
(** Construct a tactic proof of the following proposition. *)

Theorem double_even : forall n,
  ev (double n).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 4 stars, optional (double_even_pfobj) *)
(** Try to predict what proof object is constructed by the above
    tactic proof.  (Before checking your answer, you'll want to
    strip out any uses of [Case], as these will make the proof
    object look a bit cluttered.) *)
(** [] *)

(** ** Discussion: Computational vs. Inductive Definitions *)

(** We have seen that the proposition "[n] is even" can be
    phrased in two different ways -- indirectly, via a boolean testing
    function [evenb], or directly, by inductively describing what
    constitutes evidence for evenness.  These two ways of defining
    evenness are about equally easy to state and work with.  Which we
    choose is basically a question of taste.

    However, for many other properties of interest, the direct
    inductive definition is preferable, since writing a testing
    function may be awkward or even impossible.

    One such property is [beautiful].  This is a perfectly sensible
    definition of a set of numbers, but we cannot translate its
    definition directly into a Coq Fixpoint (or into a recursive
    function in any other common programming language).  We might be
    able to find a clever way of testing this property using a
    [Fixpoint] (indeed, it is not too hard to find one in this case),
    but in general this could require arbitrarily deep thinking.  In
    fact, if the property we are interested in is uncomputable, then
    we cannot define it as a [Fixpoint] no matter how hard we try,
    because Coq requires that all [Fixpoint]s correspond to
    terminating computations.

    On the other hand, writing an inductive definition of what it
    means to give evidence for the property [beautiful] is
    straightforward. *)

(* ####################################################### *)
(** ** [Inversion] on Evidence *)

(** Besides [induction], we can use the other tactics in our toolkit
    to reason about evidence.  For example, this proof uses [destruct]
    on evidence. *)

Theorem ev_minus2: forall n,
  ev n -> ev (pred (pred n)).
Proof.
  intros n E.
  destruct E as [| n' E'].
  Case "E = ev_0". simpl. apply ev_0.
  Case "E = ev_SS n' E'". simpl. apply E'.  Qed.

(** **** Exercise: 1 star, optional (ev_minus2_n) *)
(** What happens if we try to [destruct] on [n] instead of [E]? *)

(* FILL IN HERE *)
(** [] *)

(** **** Exercise: 1 star (ev__even) *)
(** Here is a proof that the inductive definition of evenness implies
    the computational one. *)

Theorem ev__even : forall n,
  ev n -> even n.
Proof.
  intros n E. induction E as [| n' E'].
  Case "E = ev_0".
    unfold even. reflexivity.
  Case "E = ev_SS n' E'".
    unfold even. apply IHE'.
Qed.

(** Could this proof also be carried out by induction on [n] instead
    of [E]?  If not, why not? *)

(* FILL IN HERE *)
(** [] *)

(** The induction principle for inductively defined propositions does
    not follow quite the same form as that of inductively defined
    sets.  For now, you can take the intuitive view that induction on
    evidence [ev n] is similar to induction on [n], but restricts our
    attention to only those numbers for which evidence [ev n] could be
    generated.  We'll look at the induction principle of [ev] in more
    depth below, to explain what's really going on. *)

(** **** Exercise: 1 star (l_fails) *)
(** The following proof attempt will not succeed.
     Theorem l : forall n,
       ev n.
     Proof.
       intros n. induction n.
         Case "O". simpl. apply ev_0.
         Case "S".
           ...
   Briefly explain why.

(* FILL IN HERE *)
*)
(** [] *)

(** **** Exercise: 2 stars (ev_sum) *)
(** Here's another exercise requiring induction. *)

Theorem ev_sum : forall n m,
   ev n -> ev m -> ev (n+m).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** Another situation where we want to analyze evidence for evenness
    is when proving that, if [n+2] is even, then [n] is. *)

(** Our first idea might be to use [destruct] for this kind of case
    analysis: *)

Theorem SSev_ev_firsttry : forall n,
  ev (S (S n)) -> ev n.
Proof.
  intros n E.
  destruct E as [| n' E'].
  (* Stuck: [destruct] gives us an unprovable subgoal here! *)
Admitted.

(** In the first sub-goal, we've lost the information that [n] is [0].
    We could have used [remember], but then we still need [inversion]
    on both cases. *)

Theorem SSev_ev_secondtry : forall n,
  ev (S (S n)) -> ev n.
Proof.
  intros n E. remember (S (S n)) as n2.
  destruct E as [| n' E'].
  Case "n = 0". inversion Heqn2.
  Case "n = S n'". inversion Heqn2. rewrite <- H0. apply E'.
Qed.

(** There is a much simpler way to do this. We can use
    [inversion] directly on the inductively defined proposition
    [ev (S (S n))]. *)

Theorem SSev__even : forall n,
  ev (S (S n)) -> ev n.
Proof.
  intros n E. inversion E as [| n' E']. apply E'. Qed.

(** This use of [inversion] may seem a bit mysterious at first.
    Until now, we've only used [inversion] on equality
    propositions, to utilize injectivity of constructors or to
    discriminate between different constructors.  But we see here
    that [inversion] can also be applied to analyzing evidence
    for inductively defined propositions.

    Here's how [inversion] works in general.  Suppose the name
    [I] 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 I] generates
    a subgoal in which [I] 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.

    In this particular case, the [inversion] analyzed the construction
    [ev (S (S n))], determined that this could only have been
    constructed using [ev_SS], and generated a new subgoal with the
    arguments of that constructor as new hypotheses.  (It also
    produced an auxiliary equality, which happens to be useless here.)
    We'll begin exploring this more general behavior of inversion in
    what follows. *)

(** **** Exercise: 1 star (inversion_practice) *)
Theorem SSSSev__even : forall n,
  ev (S (S (S (S n)))) -> ev n.
Proof.
  (* FILL IN HERE *) Admitted.

(** The [inversion] tactic can also be used to derive goals by showing
    the absurdity of a hypothesis. *)

Theorem even5_nonsense :
  ev 5 -> 2 + 2 = 9.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** We can generally use [inversion] on inductive propositions.
    This illustrates that in general, we get one case for each
    possible constructor.  Again, we also get some auxiliary
    equalities that are rewritten in the goal but not in the other
    hypotheses. *)

Theorem ev_minus2': forall n,
  ev n -> ev (pred (pred n)).
Proof.
  intros n E. inversion E as [| n' E'].
  Case "E = ev_0". simpl. apply ev_0.
  Case "E = ev_SS n' E'". simpl. apply E'.  Qed.

(** **** Exercise: 3 stars, advanced (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, optional (ev_plus_plus) *)
(** Here's an exercise that just requires applying existing lemmas.  No
    induction or even case analysis is needed, but some of the rewriting
    may be tedious.  You'll want the [replace] tactic used for [plus_swap']
    in Basics.v *)

Theorem ev_plus_plus : forall n m p,
  ev (n+m) -> ev (n+p) -> ev (m+p).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ####################################################### *)
(** ** Building Proof Objects Incrementally (Optional) *)

(** As you probably noticed while solving the exercises earlier in the
    chapter, constructing proof objects is more involved than
    constructing the corresponding tactic proofs. Fortunately, there
    is a bit of syntactic sugar that we've already introduced to help
    in the construction: the [admit] term, which we've sometimes used
    to force Coq into accepting incomplete exercies. As an example,
    let's walk through the process of constructing a proof object
    demonstrating the beauty of [16]. *)

Definition b_16_atmpt_1 : beautiful 16 := admit.

(** Maybe we can use [b_sum] to construct a term of type [beautiful 16]?
    Recall that [b_sum] is of type

    forall n m : nat, beautiful n -> beautiful m -> beautiful (n + m)

    If we can demonstrate the beauty of [5] and [11], we should
    be done. *)

Definition b_16_atmpt_2 : beautiful 16 := b_sum 5 11 admit admit.

(** In the attempt above, we've omitted the proofs of the propositions
    that [5] and [11] are beautiful. But the first of these is already
    axiomatized in [b_5]: *)

Definition b_16_atmpt_3 : beautiful 16 := b_sum 5 11 b_5 admit.

(** What remains is to show that [11] is beautiful. We repeat the
    procedure: *)

Definition b_16_atmpt_4 : beautiful 16 :=
  b_sum 5 11 b_5 (b_sum 5 6 admit admit).

Definition b_16_atmpt_5 : beautiful 16 :=
  b_sum 5 11 b_5 (b_sum 5 6 b_5 admit).

Definition b_16_atmpt_6 : beautiful 16 :=
  b_sum 5 11 b_5 (b_sum 5 6 b_5 (b_sum 3 3 admit admit)).

(** And finally, we can complete the proof object: *)

Definition b_16 : beautiful 16 :=
  b_sum 5 11 b_5 (b_sum 5 6 b_5 (b_sum 3 3 b_3 b_3)).

(** To recap, we've been guided by an informal proof that we have in
    our minds, and we check the high level details before completing
    the intricacies of the proof. The [admit] term allows us to do
    this. *)

(* ####################################################### *)
(** * Additional Exercises *)

(** **** Exercise: 4 stars (palindromes) *)
(** A palindrome is a sequence that reads the same backwards as
    forwards.

    - Define an inductive proposition [pal] on [list X] that
      captures what it means to be a palindrome. (Hint: You'll need
      three cases.  Your definition should be based on the structure
      of the list; just having a single constructor
    c : forall l, l = rev l -> pal l
      may seem obvious, but will not work very well.)

    - Prove that
       forall l, pal (l ++ rev l).
    - Prove that
       forall l, pal l -> l = rev l.
*)

(* FILL IN HERE *)
(** [] *)

(** **** Exercise: 5 stars, optional (palindrome_converse) *)
(** Using your definition of [pal] from the previous exercise, prove
    that
     forall l, l = rev l -> pal l.
*)

(* FILL IN HERE *)
(** [] *)

(** **** Exercise: 4 stars, advanced (subsequence) *)
(** A list is a _subsequence_ of another list if all of the elements
    in the first list occur in the same order in the second list,
    possibly with some extra elements in between. For example,
    [1,2,3]
    is a subsequence of each of the lists
    [1,2,3]
    [1,1,1,2,2,3]
    [1,2,7,3]
    [5,6,1,9,9,2,7,3,8]
    but it is _not_ a subsequence of any of the lists
    [1,2]
    [1,3]
    [5,6,2,1,7,3,8]

    - Define an inductive proposition [subseq] on [list nat] that
      captures what it means to be a subsequence. (Hint: You'll need
      three cases.)

    - Prove that subsequence is reflexive, that is, any list is a
      subsequence of itself.

    - Prove that for any lists [l1], [l2], and [l3], if [l1] is a
      subsequence of [l2], then [l1] is also a subsequence of [l2 ++
      l3].

    - (Optional, harder) Prove that subsequence is transitive -- that
      is, if [l1] is a subsequence of [l2] and [l2] is a subsequence
      of [l3], then [l1] is a subsequence of [l3].  Hint: choose your
      induction carefully!
*)

(* FILL IN HERE *)
(** [] *)

(** **** Exercise: 2 stars, optional (R_provability) *)
(** Suppose we give Coq the following definition:
    Inductive R : nat -> list nat -> Prop :=
      | c1 : R 0 []
      | c2 : forall n l, R n l -> R (S n) (n :: l)
      | c3 : forall n l, R (S n) l -> R n l.
    Which of the following propositions are provable?

    - [R 2 [1,0]]
    - [R 1 [1,2,1,0]]
    - [R 6 [3,2,1,0]]
*)

(** [] *)

(* ##################################################### *)
(* ##################################################### *)
(* ##################################################### *)
(* ##################################################### *)

(* $Date: 2013-01-30 19:12:43 -0500 (Wed, 30 Jan 2013) $ *)


(**
Objectif de ce suppport de TD :
familiarisation avec les AST winstr pour le langage WHILE.
*)

(* ------------------------------------------------------------ *)
(** * Familiarisation avec les AST winstr pour le langage WHILE *)

(** ** Syntaxe abstraite *)
Inductive aexp :=
| Aco : nat -> aexp (* constantes *)
| Ava : nat -> aexp (* variables *)
| Apl : aexp -> aexp -> aexp
| Amu : aexp -> aexp -> aexp
| Amo : aexp -> aexp -> aexp
.

Inductive bexp :=
| Btrue : bexp
| Bfalse : bexp
| Bnot : bexp -> bexp
| Band : bexp -> bexp -> bexp
| Bor : bexp -> bexp -> bexp
| Beq : bexp -> bexp -> bexp (* test égalité de bexp *)
| Beqnat : aexp -> aexp -> bexp (* test égalité d'aexp *)
.

Inductive winstr :=
| Skip   : winstr
| Assign : nat -> aexp -> winstr
| Seq    : winstr -> winstr -> winstr
| If     : bexp -> winstr -> winstr -> winstr
| While  : bexp -> winstr -> winstr
.

(** Le langage IMP : comme WHILE mais sans While *)
Inductive instr :=
| ISkip   : instr
| IAssign : nat -> aexp -> instr
| ISeq    : instr -> instr -> instr
| IIf     : bexp -> instr -> instr -> instr
.

(** Définir les AST des programmes suivants *)
(** x3 := 5 * x2 *)
Definition P1 : instr := IAssign 3 (Amu (Aco 5) (Ava 2)).
(** x2 := x2 + 1 *)
Definition P2 : instr := IAssign 2 (Apl (Ava 2) (Aco 1)).
(** if x1 = x3 then (x2 := x2 + 1; x2 := x2 + 1) else x3 := 5 * x2 *)
Definition P3 : instr := IIf
  (Beqnat (Ava 1) (Ava 3))
  (ISeq
    (IAssign 2 (Apl (Ava 2) (Aco 1)))
    (IAssign 2 (Apl (Ava 2) (Aco 1)))
  )
  (IAssign 3 (Amu (Aco 5) (Ava 2))).

(** ** Sémantique fonctionnelle *)

Inductive state :=
  | Nil : state
  | Cons : nat -> state -> state
.

(** On se donne des notations préalables pour faciliter la présentation *)
Notation "[]" := Nil.
Notation "x :: y" := (Cons x y).

(** L'appel [get i s] rend la valeur associée à xi dans l'état s *)
Fixpoint get (i: nat) (s: state) : nat :=
  match s with
  | []     => 0
  | v :: s' =>
    match i with
    | O => v
    | S i' => get i' s'
    end
  end.

(** *** Sémantique fonctionnelle de aexp*)
Fixpoint evalA (a: aexp) (s: state) : nat :=
  match a with
  | Aco n => n
  | Ava x => get x s
  | Apl a1 a2 =>  evalA a1 s + evalA a2 s
  | Amu a1 a2 =>  evalA a1 s * evalA a2 s
  | Amo a1 a2 =>  evalA a1 s - evalA a2 s
  end.

(** *** Sémantique fonctionnelle de bexp*)
Definition eqboolb b1 b2 : bool :=
  match b1, b2  with
  | true, true   => true
  | false, false => true
  | _ , _        => false
  end.

Fixpoint eqnatb n1 n2 : bool :=
   match n1, n2 with
  | O, O         => true
  | S n1', S n2' => eqnatb n1' n2'
  | _, _         => false
  end.

 Fixpoint evalB (b : bexp) (s : state) : bool :=
  match b with
  | Btrue => true
  | Bfalse => false
  | Bnot b => negb (evalB b s)
  | Band e1 e2 => (evalB e1 s) && (evalB e2 s)
  | Bor e1 e2 => (evalB e1 s) || (evalB e2 s)
  | Beq e1 e2 => eqboolb (evalB e1 s) (evalB e2 s)
  | Beqnat n1 n2 => eqnatb (evalA n1 s) (evalA n2 s)
  end.

(** *** Sémantique fonctionnelle de IMP *)

(** La mise à jour d'une variable [v] par un nouvel entier [n]
    dans un état [s] s'écrit [update s v n'].
    Cette fonction n'échoue jamais et écrit la valeur à sa place même
    si elle n'est pas encore définie dans l'état [s]. *)

(** À définir en TD *)
(** [update i v s] rend l'état dans lequel xi vaut [v],
    les valeurs des autres variables étant celles de [s].
    Attention à bien traiter tous les cas, notament ceux
    où l'état est représenté par une liste vide : tout se passe
    comme si, à la place, on avait une liste comprenant
    suffisamment de 0 (valeur par défaut).
 *)
Fixpoint update (i:nat) (v:nat) (s:state) : state := match i with
| 0 => match s with
  | [] => v :: []
  | _ :: xs => v :: xs
  end
| S n => match s with
  | [] => 0 :: update n v s
  | x :: xs => x :: update n v xs
  end
end.

(** Quelques états pour faire des tests *)
(** S1 est un état dans lequel la variable "x0" vaut 1 et la variable "x1"
    vaut 2 et toutes les autres valent 0 (valeur par défaut) *)

Definition S1 := 1 :: 2 :: Nil.
Definition S2 := 0 :: 3 :: Nil.
Definition S3 := 0 :: 7 :: 5 :: 41 :: Nil.

Definition S4 :=
  let s1 := update 4 1 S1 in
  let s2 := update 3 2 s1 in
  let s3 := update 2 3 s2 in
  let s4 := update 2 3 s3 in
  update 0 5 s4.
Example test_S4 : S4 = 5 :: 2 :: 3 :: 2 :: 1 :: [].
Proof. reflexivity. Qed.

(** Peut s'écrire dans une premier temps avec update laissé "Admitted". *)
Fixpoint evalI (i : instr) (s : state) : state :=
  match i with
  | ISkip       => s
  | IAssign v exp => update v (evalA exp s) s
  | ISeq instr1 instr2 => evalI instr2 (evalI instr1 s)
  | IIf cond i e => if evalB cond s then evalI i s else evalI e s
  end.

(** La pré-commande "Fail" indique que l'on s'attend à un échec *)
(** La présence de [{struct i}] indique que l'argument devant
    décroître structurellement est [i] ;
    Pour [evalI] on aurait pu le préciser aussi mais Coq a su
    reconstruire cette information à partir du corps de la fonction.
*)
Fail Fixpoint evalW (i : winstr) (s : state) {struct i} : state :=
  (** à compléter, en expliquant le diagnostic rendu par Coq *)
  match i with
  | Skip       => s
  | Assign v exp => update v (evalA exp s) s
  | Seq instr1 instr2 => evalW instr2 (evalW instr1 s)
  | If cond i e => if evalB cond s then evalW i s else evalW e s
  | While cond instr => if evalB cond s then evalW (While cond instr) s else s
  end.
  (* Coq n'accepte pas cette définition car il n'arrive pas
     à démontrer qu'elle ne sera pas infiniement récursive.
     En effet, dans le cas du While, l'évalution peut être infinie.
  *)

(** ** Tests *)

Compute P1.
Compute S1.
Compute evalI P1 S1.
Example test1 : evalI P1 S1 = 1 :: 2 :: 0 :: 0 :: [].
Proof. reflexivity. Qed.

Example test2 : evalI P1 S4 = 5 :: 2 :: 3 :: 15 :: 1 :: [].
Proof. reflexivity. Qed.

Example test3 : evalI P3 S1 = 1 :: 2 :: 0 :: 0 :: [].
Proof. reflexivity. Qed.

Example test4 : evalI P3 S4 = 5 :: 2 :: 5 :: 2 :: 1 :: [].
Proof. reflexivity. Qed.


Require Coq.Lists.List.
Require Import Coq.Program.Basics.
Require Export Fiat.Common.Coq__8_4__8_5__Compat.

Section LogicFacts.
  Lemma or_false :
    forall (P: Prop), P \/ False <-> P.
  Proof.
    tauto.
  Qed.

  Lemma false_or :
    forall (P Q: Prop),
      (False <-> P \/ Q) <-> (False <-> P) /\ (False <-> Q).
  Proof.
    tauto.
  Qed.

  Lemma false_or' :
    forall (P Q: Prop),
      (P \/ Q <-> False) <-> (False <-> P) /\ (False <-> Q).
  Proof.
    tauto.
  Qed.

  Lemma equiv_false :
    forall P,
      (False <-> P) <-> (~ P).
  Proof.
    tauto.
  Qed.

  Lemma equiv_false' :
    forall P,
      (P <-> False) <-> (~ P).
  Proof.
    tauto.
  Qed.

  Lemma and_True :
    forall P,
      (P /\ True) <-> P.
  Proof.
    tauto.
  Qed.

  Lemma not_exists_forall :
    forall {A} (P: A -> Prop),
      (~ (exists a, P a)) <-> (forall a, ~ P a).
  Proof.
    firstorder.
  Qed.

  Lemma not_and_implication :
    forall (P Q: Prop),
      ( ~ (P /\ Q) ) <-> (P -> ~ Q).
  Proof.
    firstorder.
  Qed.

  Lemma eq_sym_iff :
    forall {A} x y, @eq A x y <-> @eq A y x.
  Proof.
    split; intros; symmetry; assumption.
  Qed.

  Lemma fold_right_and_True {ls : list Prop}
  : List.fold_right and True ls <-> (forall P, List.In P ls -> P).
  Proof.
    split; induction ls; simpl in *; repeat (subst || intros [] || intro);
    repeat split; try assumption;
    try apply IHls; intros; eauto;
    match goal with
      | [ H : _ |- _ ]
        => apply H; solve [ left; reflexivity | right; assumption ]
    end.
  Qed.

  Lemma fold_right_and_True_map {A} {P : A -> Prop} {ls : list A}
  : List.fold_right and True (List.map P ls) <-> (forall x, List.In x ls -> P x).
  Proof.
    rewrite fold_right_and_True; split; intros H x Hx.
    { apply H, List.in_map, Hx. }
    { apply List.in_map_iff in Hx.
      destruct Hx as [? [? ?]]; subst; eauto. }
  Qed.

  Lemma forall_iff {A B C}
  : (forall x : A, (B x <-> C x)) -> ((forall x, B x) <-> (forall x, C x)).
  Proof.
    intro H; split; intros H' x; apply H, H'.
  Qed.

  Lemma forall_impl {A B C}
  : (forall x : A, (impl (B x) (C x))) -> (impl (forall x, B x) (forall x, C x)).
  Proof.
    intro H; intros H' x; apply H, H'.
  Qed.

  Lemma and_distr_or_r A B C
  : (A /\ (B \/ C)) <-> ((A /\ B) \/ (A /\ C)).
  Proof. tauto. Qed.
  Lemma and_distr_or_l A B C
  : ((B \/ C) /\ A) <-> ((B /\ A) \/ (C /\ A)).
  Proof. tauto. Qed.
  Lemma ex_distr_or A B C
  : (exists x : A, B x \/ C x) <-> ((exists x : A, B x) \/ (exists x : A, C x)).
  Proof.
    repeat ((intros [H0 H1]; revert H0 H1)
            || (intros [H|H]; revert H)
            || split
            || intro);
    first [ do 2 first [ left | esplit ]; eassumption
          | do 2 first [ right | esplit ]; eassumption ].
  Defined.

  Lemma and_TrueP_L {P Q : Prop} (H : P) : P /\ Q <-> Q.
  Proof. tauto. Qed.
  Lemma and_TrueP_R {P Q : Prop} (H : Q) : P /\ Q <-> P.
  Proof. tauto. Qed.
  Lemma impl_distr_or {A B C : Prop}
    : (A \/ B -> C) <-> ((A -> C) /\ (B -> C)).
  Proof. tauto. Qed.
  Lemma forall_distr_and {A B C}
    : (forall x : A, B x /\ C x) <-> ((forall x, B x) /\ (forall x, C x)).
  Proof.
    split; intro H; split; intros; apply H.
  Qed.
  Lemma ex_eq_and {A P} y
    : (exists x : A, y = x /\ P x) <-> P y.
  Proof.
    split; [ intros [? ?] | intro; eexists ];
      intuition try (tauto || congruence).
  Qed.
  Lemma ex_eq'_and {A P} y
    : (exists x : A, x = y /\ P x) <-> P y.
  Proof.
    split; [ intros [? ?] | intro; eexists ];
      intuition try (tauto || congruence).
  Qed.
  Lemma ex_eq_snd_and {A B C} x
    : (exists y : A * B, snd y = x /\ C y) <-> (exists y : A, C (y, x)).
  Proof.
    split; intros [y H]; try destruct y; eexists; repeat intuition (subst; eauto; simpl).
  Qed.
  Lemma ex_eq'_snd_and {A B C} x
    : (exists y : A * B, x = snd y /\ C y) <-> (exists y : A, C (y, x)).
  Proof.
    split; intros [y H]; try destruct y; eexists; repeat intuition (subst; eauto; simpl).
  Qed.
  Lemma ex_eq_fst_and {A B C} x
    : (exists y : A * B, fst y = x /\ C y) <-> (exists y : B, C (x, y)).
  Proof.
    split; intros [y H]; try destruct y; eexists; repeat intuition (subst; eauto; simpl).
  Qed.
  Lemma ex_eq'_fst_and {A B C} x
    : (exists y : A * B, x = fst y /\ C y) <-> (exists y : B, C (x, y)).
  Proof.
    split; intros [y H]; try destruct y; eexists; repeat intuition (subst; eauto; simpl).
  Qed.
  Lemma forall_eq_and {A C} {D : _ -> Prop} x
    : (forall y : A, y = x /\ C y -> D y) <-> (C x -> D x).
  Proof. repeat firstorder subst. Qed.
  Lemma forall_eq'_and {A C} {D : _ -> Prop} x
    : (forall y : A, x = y /\ C y -> D y) <-> (C x -> D x).
  Proof. repeat firstorder subst. Qed.
  Lemma forall_eq_snd_and {A B C} {D : _ -> Prop} x
    : (forall y : A * B, snd y = x /\ C y -> D y) <-> (forall y : A, C (y, x) -> D (y, x)).
  Proof. split; intros H y; try destruct y; repeat firstorder subst. Qed.
  Lemma forall_eq'_snd_and {A B C} {D : _ -> Prop} x
    : (forall y : A * B, x = snd y /\ C y -> D y) <-> (forall y : A, C (y, x) -> D (y, x)).
  Proof. split; intros H y; try destruct y; repeat firstorder subst. Qed.
  Lemma forall_eq_fst_and {A B C} {D : _ -> Prop} x
    : (forall y : A * B, fst y = x /\ C y -> D y) <-> (forall y : B, C (x, y) -> D (x, y)).
  Proof. split; intros H y; try destruct y; repeat firstorder subst. Qed.
  Lemma forall_eq'_fst_and {A B C} {D : _ -> Prop} x
    : (forall y : A * B, x = fst y /\ C y -> D y) <-> (forall y : B, C (x, y) -> D (x, y)).
  Proof. split; intros H y; try destruct y; repeat firstorder subst. Qed.
  Lemma True_iff {P : Prop}
    : P -> (P <-> True).
  Proof. firstorder. Qed.
  Lemma False_iff {P : Prop}
    : ~P -> (P <-> False).
  Proof. firstorder. Qed.
  Lemma nnTrue : ~~True.
  Proof. tauto. Qed.
  Lemma and_False_r {P} : (P /\ False) <-> False.
  Proof. tauto. Qed.
  Lemma and_False_l {P} : (False /\ P) <-> False.
  Proof. tauto. Qed.
  Lemma and_True_r {P} : (P /\ True) <-> P.
  Proof. tauto. Qed.
  Lemma and_True_l {P} : (True /\ P) <-> P.
  Proof. tauto. Qed.
  Lemma or_False_r {P} : (P \/ False) <-> P.
  Proof. tauto. Qed.
  Lemma or_False_l {P} : (False \/ P) <-> P.
  Proof. tauto. Qed.
  Lemma or_True_r {P} : (P \/ True) <-> True.
  Proof. tauto. Qed.
  Lemma or_True_l {P} : (True \/ P) <-> True.
  Proof. tauto. Qed.
  Lemma ex_False {T} : (exists x : T, False) <-> False.
  Proof. firstorder. Qed.
  Lemma forall_True {T} : (forall x : T, True) <-> True.
  Proof. firstorder. Qed.
  Lemma forall_iff_nondep {A B} {C : Prop} (H : exists x : A, B x)
    : (forall x : A, B x -> C) <-> C.
  Proof. firstorder. Qed.
  Lemma False_impl_iff_True {P : Prop}
    : (False -> P) <-> True.
  Proof. firstorder. Qed.
  Lemma ex_True {T} : (exists x : T, True) <-> inhabited T.
  Proof. firstorder. Qed.

  Lemma ex_ind_iff {T P} {Q : _ -> Prop}
    : (forall pf : @ex T P, Q pf) <-> forall (x : T) (y : P x), Q (ex_intro P x y).
  Proof.
    intuition; destruct_all (ex P); auto.
  Qed.

  Lemma pull_forall_iff {A} (P Q : A -> Prop)
    : (forall x : A, (P x <-> Q x))
      -> ((forall x : A, P x) <-> (forall x : A, Q x)).
  Proof. firstorder eauto. Qed.
End LogicFacts.

Create HintDb logic discriminated.
#[global]
Hint Rewrite and_distr_or_l and_distr_or_r @ex_distr_or @impl_distr_or @forall_distr_and @ex_eq'_and @ex_eq_and @ex_eq'_fst_and @ex_eq'_snd_and @ex_eq_fst_and @ex_eq_snd_and @forall_eq'_fst_and @forall_eq'_snd_and @forall_eq_fst_and @forall_eq_snd_and and_assoc (True_iff (eq_refl true)) (False_iff nnTrue) @and_False_r @and_False_l @ex_False @and_True_l @and_True_r @or_False_l @or_False_r @or_True_l @or_True_r @forall_True (True_iff Bool.diff_false_true) (False_iff Bool.diff_false_true) @False_impl_iff_True @ex_True : logic.
Ltac setoid_rewrite_logic_step :=
  first [ rewrite_strat repeat topdown hints logic
        | setoid_rewrite ex_distr_or
        | setoid_rewrite forall_distr_and
        | setoid_rewrite ex_eq'_and
        | setoid_rewrite ex_eq'_fst_and
        | setoid_rewrite ex_eq'_snd_and
        | setoid_rewrite ex_eq_and
        | setoid_rewrite ex_eq_fst_and
        | setoid_rewrite ex_eq_snd_and
        | setoid_rewrite forall_eq'_and
        | setoid_rewrite forall_eq'_fst_and
        | setoid_rewrite forall_eq'_snd_and
        | setoid_rewrite forall_eq_and
        | setoid_rewrite forall_eq_fst_and
        | setoid_rewrite forall_eq_snd_and
        | setoid_rewrite False_impl_iff_True ].
Ltac setoid_rewrite_logic := repeat setoid_rewrite_logic_step.


(**
MUパズル (MU Puzzle) の証明
======

2022_05_14 @suharahiromichi

*)

From mathcomp Require Import all_ssreflect.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

(**
# MUパズルの証明
*)
Section MU_Puzzle.

(**
MUパズルで使用する文字を定義する。
*)
  Inductive MIU :=
  | M
  | I
  | U.

(**
MUパズルの規則による文字列の生成規則を定義する。
*)
  Inductive MU : seq MIU -> Prop :=
  | S_MU  : MU [:: M; I]
  | S_xIU : forall x, MU (x ++ [:: I]) -> MU (x ++ [:: I; U])
  | S_Mxx : forall x, MU ([:: M] ++ x) -> MU ([:: M] ++ x ++ x)
  | S_xUy : forall x y, MU (x ++ [:: I; I; I] ++ y) -> MU (x ++ [:: U] ++ y)
  | S_xy  : forall x y, MU (x ++ [:: U; U] ++ y) -> MU (x ++ y)
  .

(**
文字列の I の数を算える関数 ci を定義する。
*)
  Fixpoint ci (s : seq MIU) : nat :=
    match s with
    | [::] => 0
    | I :: s => (ci s).+1
    | _ :: s => (ci s)
    end.

(**
ci が、文字列の連結(cat)について分配則を満たすことを証明する。
*)
  Lemma ci_cat (x y : seq MIU) : ci (x ++ y) = ci x + ci y.
  Proof.
    elim: x => //.                        (* x = a :: x の場合 *)
    case=> x IHx //=.                     (* a による場合分けする。 *)
    rewrite addSn.
    by rewrite IHx.
  Qed.

(**
補題の証明で使用するモジュラスについての補題を証明しておく。
これは一般に成立するわけではなく、
``3 %| 2 * n`` の2と3が互いに素だからである。
*)
  Lemma l_mod_2n_eq (n : nat) : (3 %| n + n) = (3 %| n).
  Proof.
    rewrite addnn -mul2n.
    by apply: Gauss_dvdr.
  Qed.

(**
補題を証明する。

``MU s`` に対する帰納法を適用する。
解りやすさのために、一律に対偶を適用する。
*)
  Lemma miu_inv (s : seq MIU) : MU s -> ~~ (3 %| ci s).
  Proof.
    elim=> //= [x | x | x y | x y] _;
           apply: contraTT; rewrite 2!negbK.

    (* 3 %| ci (x ++ [:: I; U]) -> 3 %| ci (x ++ [:: I]) *)
    - have -> : x ++ [:: I; U] = (x ++ [:: I]) ++ [:: U]
        by rewrite -catA cat1s.
      by rewrite ci_cat //= addn0.

    (* 3 %| ci (x ++ x) -> 3 %| ci x *)
    - by rewrite ci_cat l_mod_2n_eq.

    (* 3 %| ci (x ++ U :: y) -> 3 %| ci (x ++ [:: I, I, I & y]) *)
    - have -> : x ++ (U :: y) = x ++ [:: U] ++ y by done.
      rewrite 2!ci_cat /= add0n.
      have -> : x ++ (I :: I :: I :: y) = x ++ [:: I; I; I] ++ y by done.
      rewrite 2!ci_cat /=.
      have -> : ci x + (3 + ci y) = ci x + ci y + 3
        by rewrite -addnACl [ci y + ci x]addnC.
      by move=> H; rewrite dvdn_addl.

    (* 3 %| ci (x ++ y) -> 3 %| ci (x ++ [:: U, U & y]) *)
    - have -> : x ++ (U :: U :: y) = x ++ [:: U; U] ++ y by done.
      by rewrite 3!ci_cat /= add0n.
  Qed.

(**
補題を適用して背理法を適用すると、

``3 %| ci [:: M; U]``

を証明すればよい。これは計算すれば、

``3 %| 0``

であり、成立することは自明である。
*)
  Theorem mu : ~ MU [:: M; U].
  Proof.
    move/miu_inv/negP.
    by apply.
  Qed.

End MU_Puzzle.

(**

# 参考

[1] MUパズル https://www.principia-m.com/doc/0/

[1] MUパズル https://zenn.dev/hatsugai/articles/dacd6c19bbd210

 *)

(* END *)


Require Import Reals Interval.Tactic.

Open Scope R_scope.

Notation pow2 := (Raux.bpow Zaux.radix2).

(*
Example taken from:
William J. Cody Jr. and William Waite
Software Manual for the Elementary Functions
*)

Goal forall x : R, Rabs x <= 35/100 ->
  let p := fun t => 1 * pow2 (-2) + t * (1116769 * pow2 (-28)) in
  let q := fun t => 1 * pow2 (-1) + t * (13418331 * pow2 (-28)) in
  let r := 2 * (x * p (x^2) / (q (x^2) - x * p (x^2)) + 1 * pow2 (-1)) in
  Rabs ((r - exp x) / exp x) <= 17 * pow2 (-34).
Proof.
intros x Hx p q r.
unfold r, p, q.
interval with (i_prec 40, i_bisect x, i_taylor x, i_degree 3).
Qed.