(** * Conceptual Foundations *)

Require Coq.Arith.EqNat.

Section ConceptualFoundations.

(** ** Thought Experiment

    Consider a proposition [is_my_favorite_number]. *)

Variable is_my_favorite_number : nat -> Prop.

(** Let's assume that [3] is my favorite number. *)

Variable three_is_my_favorite_number : is_my_favorite_number 3.

(** Now we'll prove a simple fact about my favorite number. *)

Fact one_plus_my_favorite_number_is_four :
  forall n,
  is_my_favorite_number n ->
  1 + n = 4.
Proof.
  intros n H.
  Fail inversion H.
  Abort.

(** Oops. Something went wrong. Intuitively, using [inversion] on [H]
    should yield a hypothesis of type [n = 3]. However, the [inversion]
    tactic fails with "Error: The type of H is not inductive." We are
    forced to [Abort] the proof.

    Why did this happen? The error indicates it has something to do with
    induction.

    Let's try another proof to better understand the issue. *)

Fact zero_is_not_my_favorite_number :
  ~(is_my_favorite_number 0).
Proof.
  intros H.
  Fail inversion H.
  Abort.

(** Interesting. We cannot prove that zero is not my favorite number,
    and we know it has something to do with induction.

    The root of the problem is that we can prove the following: *)

Fact three_implies_is_my_favorite_number :
  forall n,
  n = 3 ->
  is_my_favorite_number n.
Proof.
  intros. subst n.
  apply three_is_my_favorite_number.
  Qed.

(** But we cannot prove its inverse: *)

Fact is_my_favorite_number_implies_three :
  forall n,
  is_my_favorite_number n ->
  n = 3.
Proof.
  intros.
  Fail inversion H.
  Abort.

(** Let's try again with an inductive definition of
    [is_my_favorite_number]. *)

Inductive is_my_favorite_number_inductive : nat -> Prop :=
  | three_is_my_favorite_number_inductive : is_my_favorite_number_inductive 3.

(** And let's try those same proofs again. *)

Fact one_plus_my_favorite_number_is_four' :
  forall n,
  is_my_favorite_number_inductive n ->
  1 + n = 4.
Proof.
  intros n H.
  inversion H.
  reflexivity.
  Qed.

Fact zero_is_not_my_favorite_number' :
  ~(is_my_favorite_number_inductive 0).
Proof.
  intros H.
  inversion H.
  Qed.

(** The proofs succeed. But why?

    The key is that our inductive definition says more than just [3] is
    my favorite number. It also says that [3] is the _ONLY_ number that
    is my favorite number. In other words, no other number satisfies the
    [is_my_favorite_number_inductive] proposition.

    In more mathematical terms, the only inhabitants of the proof type
    [is_my_favorite_number_inductive n] are those listed in the
    inductive definition. In this case, the only inhabitant of the proof
    type is [three_is_my_favorite_number_inductive]. Note that
    [three_is_my_favorite_number_inductive] is literally a proof of
    [is_my_favorite_number_inductive 3].

    We are able to use the [inversion] tactic on an inductive definition
    because the inductive definition enumerates _ALL_ the proofs which
    inhabit the proof type. Therefore, we can do case analysis by
    looking at each possible inhabitant one at a time.

    Note that we can achieve a similar effect without induction by
    defining cases when [is_my_favorite_number] is [False]. *)

Variable no_number_besides_three_is_my_favorite_number:
  forall n,
  n <> 3 -> ~(is_my_favorite_number n).

Fact one_plus_my_favorite_number_is_four'' :
  forall n,
  is_my_favorite_number n ->
  1 + n = 4.
Proof.
  intros n H.
  destruct (EqNat.beq_nat n 3) eqn:H0.
  - apply EqNat.beq_nat_true_iff in H0. subst n. reflexivity.
  - apply EqNat.beq_nat_false_iff in H0.
    apply no_number_besides_three_is_my_favorite_number in H0.
    apply H0 in H. inversion H.
  Qed.

Fact zero_is_not_my_favorite_number'' :
  ~(is_my_favorite_number 0).
Proof.
  apply no_number_besides_three_is_my_favorite_number.
  intros H. inversion H.
  Qed.

(** Without induction, the proofs are more convoluted.

    Note that inductive definitions also have other advantages besides
    simpler proofs. Namely, Coq auto generates induction rules for
    inductive definitions.

    ** Inductive Definitions, Concrete Classes

    Conceptually, an inductive definition fully defines and constrains
    all inhabitants of its type. After an inductive definition is
    established, we cannot define any additional inhabitants of the
    type. This has important consequences for modelling object oriented
    software in Coq.

    Consider what happens when we use an inductive definition to define
    the behavior of a class. The inductive definition says everything
    that the class does. Furthermore, it says that the class does not do
    anything else. The latter restriction means that we cannot implement
    _any_ variant or additional behavior in a subclass. Therefore,
    inductive definitions are not suitable for abstract classes and
    interfaces. They are only suitable for concrete classes. To put it
    another way: once we have an inductive definition of a class, we
    have explicitly defined all members of the class. No additional
    members (subclasses) can be added after that point.

    It is important to note that by defining class behavior inductively,
    we are relieved of the burden of stating what the class does _not_
    do. This is just like the example above: to use the non-inductive
    definition of [is_my_favorite_number] we had to define all cases
    where [is_my_favorite_number] is [False]. With the inductive
    definition, we did not need to enumerate the [False] cases; the
    inductive definition takes care of that for us. If we apply this
    concept to class definitions, this is good news. There are
    infinitely many things that a class does _not_ do, so it's a good
    thing that we don't have to enumerate them.

    Consider further that enumerating both [True] and [False] cases is
    inherently error-prone and dangerous. What if we accidentally
    introduce some overlap between the [True] and [False] cases? Then
    we have an inconsistency, and the principle of explosion applies.

    ** Regular Definitions, Abstract Classes

    Contrast an inductive definition with a regular definition. When we
    define a type with a regular definition, we do not know how many
    inhabitants the type has. In fact, the inhabitants of the type may
    be uncountable. We can define inhabitants later, and verify that
    they satisfy the definition.

    This means regular definitions are suitable for defining the
    behavior of abstract classes and interfaces. We define certain
    constraints, certain propositions that must be satisified by the
    class. We define _some_ of the things that the class must do. But
    unlike the inductive definition, we allow the class to have variant
    behavior. As long as our constraints are still met, the class can do
    whatever else it wants. This enables subclassing.

    Unlike an inductive definition, a regular definition allows us to
    enumerate both [True] and [False] cases. This opens the door for us
    to introduce inconsistencies. But in this case, we do not get "ex
    falso quodlibet." Instead, we get a logically inconsistent abstract
    specification which cannot be inhabited by any concrete class.

    The flexibility of a regular definition is both a blessing and a
    curse. As long as our constraints are met, a subclass can do
    whatever else it wants. This means a subclass could set all
    variables to null in every object presently in memory, as long as
    our specification does not specifically preclude it.

    Aside: To make another analogy, inductive definitions and regular
    definitions are like two different ways to interpret the law: the
    _inductive_ man says "If the law does not explicitly allow it, then
    it is illegal," while the _regular_ man says "If the law does not
    explicitly forbid it, then it is perfectly legal." It's the
    difference between a blacklist (regular definition) and a whitelist
    (inductive definition).

    ** Consequences

    What are the consequences for software modelling? Should our
    abstract specifications preclude all undesired behavior? No. There
    are infinitely many things that a class should _not_ do, so we
    cannot hope to enumerate them. Furthermore, when we define an
    abstract specification, we cannot possibly envision all variant
    implementations of that specification, so we cannot clearly define
    what is "undesired behavior." Consider for example, an abstract
    specification for a function that is expected to be side-effect
    free. One way to express this is to specify that the function
    terminates in the same state that it started in. But this precludes
    a subclass from, for example, logging the function call to an
    external log. Certainly it is not acceptable for an abstract
    specification to preclude this.

    So, abstract specifications cannot preclude all undesired behavior.
    This leads to an important question: can we prove properties of a
    class that is client to an abstract class and guarantee that those
    properties will hold for any implementation of the abstract class?
    And the answer is: in some cases we can, but in the general case
    we cannot. Consider for example an IteratorConcatenator class that
    takes two abstract Iterators and iterates over one, then the
    other. Can we prove that the IteratorConcatenator behaves as
    expected for any abstract Iterator? No, we cannot. Here is a counter
    example: if we pass in the same Iterator twice, the expected
    behavior fails. Even if we add in an extra precondition that says
    "the two Iterators are not the same object," then we can break
    the behavior by passing in two objects which are wrappers around
    the same internal Iterator object. The list of possible failure
    conditions is infinite. However, we can prove that the
    IteratorConcatenator behaves as expected for a specific set of
    concrete Iterators. In other words, we can prove that
    IteratorConcatenator behaves as expected for a single, fully-defined
    state.

    Therefore, while there are some properties we can verify over a
    range of states, in the general case we can only verify the behavior
    of a class in a particular, fully-defined state. This means in order
    to verify behavior, we have to select concrete classes for all
    abstractions, instantiate all the needed objects, configure all
    client-supplier dependencies (dependency injection), and then we can
    prove properties of the resulting state. Indeed this fact will shape
    much of our verification efforts.

    But how useful is the method if we can only verify against specific
    states? There are several advantages over traditional testing.

    - We can rigorously prove that an object in a particular state
      conforms to an entire abstract specification. This is something
      that is impossible to do in traditional testing.
    - We can reuse abstract specifications to verify multiple classes.
    - We can make stronger assertions about the behavior of our
      software. For example, we can verify that a function terminates in
      the same state that it was called in. We can verify that a
      particular program does not leak memory. These things are
      impossible to do in traditional testing.
    - Finally, sometimes we are not restricted to a fully fixed state.
      Sometimes we can prove properties over a range of states.

    These limitations apply also to the input to our program: sometimes
    we can prove a property for any input, but in the general case we
    can prove a property only for a specific input. Bear in mind that to
    prove a property for any input, we have to do case analysis on the
    input. Such case analysis is only possible if we can define the
    input inductively.

    In conclusion, some properties can be proven over a range of states,
    but in the general case, we can only prove a property for a specific
    state. In other words, we cannot prove that a class always conforms
    to an abstract specification, but we can prove that _there exists_ a
    state in which the class conforms to the abstract specification. *)

End ConceptualFoundations.


Require Import Nat Arith.

Inductive Nat : Type := succ : Nat -> Nat |  zero : Nat.

Inductive Lst : Type := nil : Lst | cons : Nat -> Lst -> Lst.

Inductive Tree : Type := node : Nat -> Tree -> Tree -> Tree |  leaf : Tree.

Inductive Pair : Type := mkpair : Nat -> Nat -> Pair
with ZLst : Type := zcons : Pair -> ZLst -> ZLst |  znil : ZLst.

Fixpoint append (append_arg0 : Lst) (append_arg1 : Lst) : Lst
           := match append_arg0, append_arg1 with
              | nil, x => x
              | cons x y, z => cons x (append y z)
              end.

Fixpoint rev (rev_arg0 : Lst) : Lst
           := match rev_arg0 with
              | nil => nil
              | cons x y => append (rev y) (cons x nil)
              end.

Fixpoint qreva (qreva_arg0 : Lst) (qreva_arg1 : Lst) : Lst
           := match qreva_arg0, qreva_arg1 with
              | nil, x => x
              | cons z x, y => qreva x (cons z y)
              end.

Lemma append_assoc : forall (x y z : Lst), append (append x y) z = append x (append y z).
Proof.
  intros.
  induction x.
  - reflexivity.
  - simpl. rewrite IHx. reflexivity.
Qed.

Lemma qreva_rev : forall (x y : Lst), qreva x y = append (rev x) y.
Proof.
  induction x.
  - reflexivity.
  - intros. simpl. rewrite IHx. rewrite append_assoc. simpl. reflexivity.
Qed.

Theorem theorem0 : forall (x : Lst) (y : Lst), eq (qreva (qreva x y) nil) (append (rev y) x).
Proof.
  induction x.
  - intros. simpl. rewrite qreva_rev. reflexivity.
  - intros. simpl. rewrite IHx. simpl. rewrite append_assoc. simpl. reflexivity.
Qed.


(* ========================================================================== *]
 PROVING THINGS WE KNOW
[* ========================================================================== *)
Require Import Nat List Lia.

(* -------------------------------------------------------------------------- *]
 Let's prove things we consider true in our everyday programming life.

 We start by defining some common functions for lists.
[* -------------------------------------------------------------------------- *)

(* Calculate length of list. *)
Fixpoint length {A} (lst : list A) :=
    match lst with
    | nil => 0
    | x :: xs => 1 + length xs
    end.

(* Concatenate two lists. *)
Fixpoint concat {A} (lst1 lst2 : list A) :=
    match lst1 with
    | nil => lst2
    | x :: xs => x :: (concat xs lst2)
    end.

(* Reverse a list. *)
Fixpoint reverse {A} (lst : list A) :=
    match lst with
    | nil => nil
    | x :: xs => concat (reverse xs) (x :: nil)
    end.

(* Apply function on all elements of list. *)
Fixpoint map {A B} (f : A -> B) (lst : list A) :=
    match lst with
    | nil => nil
    | x :: xs => f x :: map f xs
    end.

(* Compose two functions into a single one. *)
Definition compose {A B C} (f : B -> C) (g : A -> B) :=
    fun x => f (g x).

(* -------------------------------------------------------------------------- *]
 Most often we need properties that describe how different functions interact.
[* -------------------------------------------------------------------------- *)

Lemma length_concat {A} (lst1 lst2 : list A):
    length (concat lst1 lst2) = length lst1 + length lst2.
Proof.
    admit.
Qed.

Lemma length_map {A B} (lst : list A) (f : A -> B):
    length (map f lst) = length lst.
Proof.
    admit.
Qed.

Lemma map_compose {A B C} (lst : list A) (f : B -> C) (g : A -> B):
    map f (map g lst) = map (compose f g) lst.
Proof.
    admit.
Qed.

(* -------------------------------------------------------------------------- *]
 Sometimes we need to prove some auxiliary lemmas.
[* -------------------------------------------------------------------------- *)

(* These two seem obvious but must be shown. *)
Lemma concat_nil {A} (lst1 : list A):
    concat lst1 nil = lst1.
Proof.
    admit.
Qed.

Lemma concat_assoc {A} (lst1 lst2 lst3 : list A):
    concat (concat lst1 lst2) lst3 = concat lst1 (concat lst2 lst3).
Proof.
    admit.
Qed.

(* This is what we actually want. *)
Lemma reverse_concat {A} (lst1 lst2 : list A):
    reverse (concat lst1 lst2) = concat (reverse lst2) (reverse lst1).
Proof.
    admit.
Qed.

(* -------------------------------------------------------------------------- *]
 Induction needs to be performed at a general enough level in order to complete
 the following proof. If we try to first introduce all hypotheses, we get an
 induction hypothesis that is too weak.
[* -------------------------------------------------------------------------- *)

Fixpoint get_el {A} n (lst : list A) :=
    match lst, n with
    | nil, _ => None
    | x :: xs, 0 => Some x
    | x :: xs, S m => get_el m xs
    end.

Lemma get_fails {A} n (lst : list A) :
    length lst < n -> get_el n lst = None.
Proof.
    admit.
Qed.

(* -------------------------------------------------------------------------- *]
 By defining an inductive data type, Coq already know precisely what the
 appropriate induction principle is.
[* -------------------------------------------------------------------------- *)

Inductive tree {A} :=
| Empty : tree
| Node : tree -> A -> tree -> tree
.

Fixpoint mirror {A} (t : @tree A) :=
    match t with
    | Empty => Empty
    | Node l_t x r_t => Node (mirror r_t) x (mirror l_t)
    end.

Fixpoint height {A} (t : @tree A) :=
    match t with
    | Empty => 0
    | Node l_t x r_t => 1 + max (height l_t) (height r_t)
    end.

Lemma height_mirror {A} (t : @tree A) :
    height (mirror t) = height t.
Proof.
    admit.
Qed.

Lemma mirror_mirror {A} (t : @tree A) :
    mirror (mirror t) = t.
Proof.
    admit.
Qed.


(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)

Require Import Arith Euclid Omega.

Require Import utils.

Set Implicit Arguments.

Local Infix "div" := (nat_divides) (at level 70).

Section Floyd_cycle_finding_algo.

  Variables (X : Type) (eqdec : forall x y : X, { x = y } + { x <> y }).

  Variables (f : X -> X) (x0 : X) (Hx0 : exists τ, 0 < τ /\ f↑τ x0 = f↑(2*τ) x0).

  (** the sequence starting at x leads to a cycle *)

  Let ends_in_cycle x := exists λ μ, 0 < μ /\ f↑λ x = f↑(λ+μ) x.

  (** the tortoise and the hare will meet *)

  Let tortoise_meets_hare x := exists τ, 0 < τ /\ f↑τ x = f↑(2*τ) x.

  (** x is a loop of f *)

  Definition iter_in_cycle x := exists k, 0 < k /\ x = f↑k x.

  (** k is a period of the loop when starting from x *)

  Definition iter_is_period x k := 0 < k /\ exists l, f↑l x = f↑(k+l) x.

  Ltac iter_in_cycle_tac :=
    match goal with
      | H: f↑?n ?x = f↑(?a+?n) ?x |- iter_in_cycle (f↑?n ?x) => exists a; split; auto; finish with H
      | H: ?x = f↑?a ?x           |- iter_in_cycle ?x        => exists a; split; auto; finish with H
      end.

  Ltac iter_is_period_tac :=
    match goal with
      | H: f↑?n ?x = f↑(?a+?n) ?x   |- iter_is_period ?x ?a => split; auto; try omega; exists n; finish with H
      | H: f↑?n ?x = f↑?a (f↑?n ?x) |- iter_is_period ?x ?a => split; auto; try omega; exists n; finish with H
    end.

  Hint Extern 4 (iter_in_cycle _)    => iter_in_cycle_tac.
  Hint Extern 4 (iter_is_period _ _) => iter_is_period_tac.

  Fact iter_in_cycle_period x l k :
         iter_in_cycle (f↑l x)
      -> iter_is_period x k
      -> f↑l x = f↑(l+k) x.
  Proof.
    intros (p & Hp1 & Hp2) (Hk1 & m & Hm).
    rewrite <- iter_plus in Hp2.
    rewrite plus_comm; revert Hm Hp2; apply iter_xchg; auto.
  Qed.

  Section compute_meeting_point.

    Inductive bar_th x y : Prop :=
      | in_bar_th_0 : x = y                  -> bar_th x y
      | in_bar_th_1 : bar_th (f x) (f (f y)) -> bar_th x y.

    Let bar_th_meet : forall x y, bar_th x y -> { c | exists k, c = f↑k x /\ c = f↑(2*k) y }.
    Proof.
      refine(fix loop x y H {struct H} :=
           match eqdec x y with
               | left E  => exist _ x _
               | right C => match loop (f x) (f (f y)) _ with
                              | exist _ c Hc => exist _ c _
                            end
           end).
      * exists 0; subst; simpl; split; trivial.
      * destruct H; auto; contradict C; trivial.
      * destruct Hc as (k & H1 & H2).
        exists (S k).
        rewrite H1 at 1; rewrite H2.
        split; eq iter.
    Qed.

    Let bar_th_fx0_ffx0 : bar_th (f x0) (f (f x0)).
    Proof.
      destruct Hx0 as (k & H3 & H4).
      apply in_bar_th_0 in H4.
      revert k H3 H4; apply nat_rev_ind.
      intros ? H; apply in_bar_th_1; finish with H.
    Qed.

    Definition floyd_meeting_pt : { c | exists τ, 0 < τ /\ c = f↑τ x0 /\ c = f↑(2*τ) x0 }.
    Proof.
      refine (match bar_th_meet bar_th_fx0_ffx0 with
                | exist _ c Hc => exist _ c _
              end).
      destruct Hc as (k & H1 & H2).
      exists (S k); split; try omega.
      rewrite H1 at 1; rewrite H2.
      split; eq iter.
    Defined.

  End compute_meeting_point.

  Section compute_index.

    Inductive bar_in i x y : Prop :=
      | in_bar_in_0 : x = y                    -> bar_in i x y
      | in_bar_in_1 : bar_in (S i) (f x) (f y) -> bar_in i x y.

    Let iter_bar_in n x y : bar_in n (f↑n x) (f↑n y) -> bar_in 0 x y.
    Proof.
      generalize n (le_O_n n); apply nat_rev_ind.
      constructor 2; auto.
    Qed.

    Let bar_in_inv : forall i x y, bar_in i x y -> least_le (fun n => i <= n /\ f↑(n-i) x = f↑(n-i) y).
    Proof.
      refine (fix loop i x y H { struct H } :=
            match eqdec x y with
              | left  E => exist _ i _
              | right N => match loop (S i) (f x) (f y) _ with
                             | exist _ n Hn => exist _ n _
                           end
            end).
      * split; subst; auto.
        intros ? []; auto.
      * destruct H; auto; destruct N; auto.
      * destruct Hn as ((H1 & H2) & H3); split.
        - split; try omega; finish with H2.
        - intros k (H4 & H5).
          destruct (eq_nat_dec i k).
          + subst; destruct N.
            repeat rewrite minus_diag in H5; auto.
          + apply H3.
            split; try omega.
            finish with H5.
    Qed.

    Variable (c : X) (Hc : exists τ, 0 < τ /\ c = f↑τ x0 /\ c = f↑(2*τ) x0).

    Let bar_in_0_x0_c : bar_in 0 x0 c.
    Proof.
      destruct Hc as (n & _ & Hn1 & Hn2).
      rewrite Hn1.
      apply iter_bar_in with n, in_bar_in_0.
      rewrite <- Hn1 at 1; finish with Hn2.
    Qed.

    Definition floyd_index : least_le (fun l => iter_in_cycle (f↑l x0)).
    Proof.
      refine (match bar_in_inv bar_in_0_x0_c with
                | exist _ n Hn => exist _ n _
              end).
      destruct Hn as ((H0 & H1) & H2).
      destruct Hc as (m & H3 & H4 & H5).
      repeat rewrite <- minus_n_O in H1.
      split.

      exists m; split; auto.
      rewrite H1, <- iter_plus, plus_comm, iter_plus; f_equal.
      rewrite H4 at 2; finish with H5.

      intros k (p & H6 & H7).
      apply H2.
      split; try omega.
      repeat rewrite <- minus_n_O.
      rewrite <- iter_plus in H7.
      generalize (iter_loop_gen _ _ _ _ H7 0); clear H7; simpl; intros H7.
      rewrite H4 in H5; replace (2*m) with (m+m) in H5 by omega.
      generalize (iter_loop_gen _ _ _ _ H5 0); clear H5; simpl; intros H5.
      rewrite H4.
      rewrite H7 with (j := m).
      rewrite H5 with (j := p-1), <- iter_plus.
      f_equal.
      replace p with (p-1+1) at 1 by omega.
      rewrite Nat.mul_add_distr_l, mult_comm; omega.
    Defined.

  End compute_index.

  Section compute_period.

    Variable (c : X) (Hx : exists k, 0 < k /\ c = f↑k c).

    Inductive bar_pe i y : Prop :=
      | in_bar_pe_0 : c = y              -> bar_pe i y
      | in_bar_pe_1 : bar_pe (S i) (f y) -> bar_pe i y.

    Let iter_bar_pe n y : 0 < n -> bar_pe n (f↑n y) -> bar_pe 1 (f y).
    Proof.
      generalize n; apply nat_rev_ind.
      constructor 2; auto.
    Qed.

    Let bar_pe_inv : forall i y, bar_pe i y -> least_le (fun n => i <= n /\ c = f↑(n-i) y).
    Proof.
      refine (fix loop i y H { struct H } :=
            match eqdec c y with
              | left  E => exist _ i _
              | right N => match loop (S i) (f y) _ with
                             | exist _ n Hn => exist _ n _
                           end
            end).
      * split.
        split; try omega; rewrite minus_diag; auto.
        intros ? []; auto.
      * destruct H; auto; destruct N; auto.
      * destruct Hn as ((H0 & H1) & H2); split.
        split; try omega; finish with H1.
        intros k (H3 & H4).
        destruct (eq_nat_dec k i).
        subst k; rewrite minus_diag in H4; destruct N; auto.
        apply H2; split.
        omega.
        finish with H4.
    Qed.

    Let bar_pe_c_fc : bar_pe 1 (f c).
    Proof.
      destruct Hx as (n & H1 & H2).
      apply iter_bar_pe with n; auto.
      apply in_bar_pe_0; auto.
    Qed.

    Definition floyd_period : least_div (fun n => 0 < n /\ c = f↑n c).
    Proof.
      refine (match bar_pe_inv bar_pe_c_fc with
                | exist _ n Hn => exist _ n _
              end).

      destruct Hn as ((H0 & H1) & H2).
      split.
      split; try omega; finish with H1.
      intros [|k] (H3 & H4); try omega.
      destruct eucl_dev with (n := n) (m := S k) as [ q [|r] H5 H6 ]; try omega.
      exists q; omega.

      rewrite H6 in H4.
      replace (q*n+ S r)
        with  (S r+(q*n+0)) in H4 by omega.
      rewrite <- iter_loop_gen in H4.
      2: finish with H1.
      replace (S r + 0)
         with ((S r-1)+1) in H4 by omega.
      rewrite iter_plus in H4.
      generalize (H2 _ (conj (Nat.lt_0_succ _) H4)).
      intro; omega.
    Defined.

  End compute_period.

  (** The output of the cycle finding algorithm is a pair i (for index) and p (for period) such that
        1/ 0 < p
        2/ f↑i x is a fixpoint of f↑p (ie f↑i x belongs to a p-loop)
        3/ f↑i x is first belonging to a loop (ie the entry point of the loop)
        4/ p divides any period
    *)

  Let cycle_spec λ μ :=     0 < μ
                         /\ f↑λ x0 = f↑(λ+μ) x0
                         /\ forall i j, i < j -> f↑i x0 = f↑j x0 -> λ <= i /\ μ div (j-i).

  Definition floyd_find_cycle : { λ : nat & { μ | cycle_spec λ μ } }.
  Proof.
    refine (
      match floyd_meeting_pt with exist _ c Hc =>
        match floyd_index Hc with exist _ l Hl =>
          match @floyd_period c _ with exist _ m Hm =>
            existT _ l (exist _ m _)
          end
        end
      end); destruct Hc as (k & H1 & H2 & H3);
            destruct Hl as (Hl1 & Hl2).

    - exists k; split; auto.
      rewrite H2 at 2; finish with H3.

    - destruct Hm as ((Hm0 & Hm1) & Hm2).
      split; [ | split ].
      * auto.
      * apply iter_in_cycle_period; subst c; auto.
      * intros i j H4 H5; split.
        + apply Hl2.
          exists (j-i); split; try omega.
          finish with H5.
        + apply Hm2; split; try omega.
          rewrite H2, <- iter_plus, plus_comm.
          apply iter_in_cycle_period.
          exists k; rewrite <- H2 at 1.
          split; auto; finish with H3.
          split; try omega.
          exists i; finish with H5.
  Defined.

End Floyd_cycle_finding_algo.

Check floyd_find_cycle.
Print Assumptions floyd_find_cycle.
Recursive Extraction floyd_find_cycle.


(* Implementation and correctness proof for insertion sort.
  Andrew W. Appel, January 2010. *)

Require Import Permutation.
Require Import SfLib.

Notation "[ ]" := nil.
Notation "[ x , .. , y ]" := (cons x .. (cons y nil) ..).

Theorem ble_nat_i: forall n m, n <= m -> ble_nat n m = true.
Proof.
induction n as [|n']; intros; simpl; auto.
destruct m.
elimtype False.
omega.
apply IHn'.
omega.
Qed.

Theorem false_ble_nat_i:  forall n m, n > m -> ble_nat n m = false.
Proof.
intros.
remember (ble_nat n m) as p; destruct p; auto.
symmetry in Heqp; apply ble_nat_true in Heqp; elimtype False; omega.
Qed.

Theorem false_ble_nat_e: forall n m, ble_nat n m = false -> n > m.
Proof.
intros.
assert (n <= m \/ n > m) by omega.
destruct H0; auto.
apply ble_nat_i in H0.
rewrite H0 in H.
inversion H.
Qed.

(* PART I.   Prove correctness of functional program for insertion sort  *)

Fixpoint insert (i:nat) (l: list nat) :=
  match l with
  | nil => i::nil
  | h::t => if ble_nat i h then i::h::t else h :: insert i t
 end.

Fixpoint sort (l: list nat) : list nat :=
  match l with
  | nil => nil
  | h::t => insert h (sort t)
end.

Example sort_pi: sort [3,1,4,1,5,9,2,6,5,3,5] = [1,1,2,3,3,4,5,5,5,6,9].
Proof.
simpl.
reflexivity.
Qed.

(** **** Exercise: 3 stars (sort_perm) *)

(* Prove an auxiliary lemma insert_perm, useful for proving sort_perm.
  You may want to get into the proof of sort_perm first, to see what you'll need.  *)
Lemma insert_perm: True.
Proof.
(* FILL IN HERE *) Admitted.

(* Now prove the main theorem. *)
Theorem sort_perm: forall l, Permutation l (sort l).
Proof.
(* FILL IN HERE *) Admitted.

(** [] *)

(** **** Exercise: 3 stars (sort_sorted) *)
(* Define an inductive predicate "sorted" that tells whether a list of nats is in nondecreasing order.
   Then prove that "sort" produces a sorted list.
*)
Inductive sorted: list nat -> Prop :=
 (* FILL IN HERE *)
.

(* You may want to first prove an auxiliary lemma about inserting an element
   into a sorted list.  *)
Theorem sort_sorted: forall l, sorted (sort l).
Proof.
(* FILL IN HERE *) Admitted.

(** [] *)


(* -*- coq-prog-args: ("-emacs-U" "-R" "../monads" "); compile-command: "./makedoc.sh" -*- *)
(* begin hide *)
Set Implicit Arguments.
Unset Strict Implicit.

Require Export MyPrelude.
(* end hide *)
(** printing epsilon $\varepsilon$ *)(** printing cdot $\cdot$ *)
(** We first introduce the monoid laws we just described.
   We will use the section mechanism of Coq extensively in the following.
   Sections permit to write a bunch of definitions which are parameterized by some variables,
   e.g. for types and operations.
   When closing a section, every definition inside it is quantified over the variables it used.
   *)

Section Monoid_Laws.

  (** The carrier [m] type may be any type. *)

  Variable m : Type.

  (** The identity element [mempty] and the operation [mappend]. *)

  Variables (mempty : m) (mappend : m -> m -> m).

  (** We define fancy notations for the element and operation. *)

  Notation epsilon := mempty.
  Infix "cdot" := mappend (right associativity, at level 20).

  (** We now state the properties. *)

  Definition monoid_id_l_t : Prop := forall x, epsilon cdot x = x.
  Definition monoid_id_r_t := forall x, x cdot epsilon = x.
  Definition monoid_assoc_t := forall x y z, (x cdot y) cdot z = x cdot y cdot z.
End Monoid_Laws.

(** Every variable in [Monoid_Laws] has been discharged by now, so we must apply each definition
   to particular [mempty] and [mappend] objects.
   We can finally define the dependent record which represents monoids on [m]:
   %\label{def:monoid}%
*)

Record monoid (m : Type) : Type := mkMonoid
  { mempty : m ; mappend : m -> m -> m
  ; monoid_id_l : monoid_id_l_t mempty mappend
  ; monoid_id_r : monoid_id_r_t mempty mappend
  ; monoid_assoc : monoid_assoc_t mappend }.

(* begin hide *)
(* Notation " x 'cdot' y " := (monoid_append _ x y) (right associativity, at level 20). *)
(* Notation " 'varepsilon' " := (monoid_empty _) (no associativity, at level 20). *)
Hint Unfold  monoid_id_l_t  monoid_id_r_t  monoid_assoc_t.

Require Import Plus.

Ltac monoid_tac_in H := repeat rewrite monoid_id_r in H ; repeat rewrite monoid_id_l in H ; repeat rewrite monoid_assoc in H.

Ltac monoid_tac := repeat rewrite monoid_id_r ; repeat rewrite monoid_id_l ; repeat rewrite monoid_assoc.
(* end hide *)


(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Unset Positivity Checking.
Unset Guard Checking.

Inductive nat : Set :=
| O : nat
| S : nat -> nat.

Inductive natural : Set :=
| Zero : natural
| Succ : natural -> natural.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) {struct plus_arg0}
  : natural :=
  match plus_arg0 with
  | Zero => plus_arg1
  | Succ n => Succ (plus n plus_arg1)
  end.

Fixpoint mult (mult_arg0 : natural) (mult_arg1 : natural) {struct mult_arg0}
  : natural :=
  match mult_arg0 with
  | Zero => Zero
  | Succ n => plus (mult n mult_arg1) mult_arg1
  end.

Definition synth (lf3 : natural) (x : natural) : natural :=
  plus lf3 (mult lf3 x).


Require Import Nat Arith.

Inductive Nat : Type := succ : Nat -> Nat |  zero : Nat.

Inductive Lst : Type := cons : Nat -> Lst -> Lst |  nil : Lst.

Inductive Tree : Type := node : Nat -> Tree -> Tree -> Tree |  leaf : Tree.

Inductive Pair : Type := mkpair : Nat -> Nat -> Pair
with ZLst : Type := zcons : Pair -> ZLst -> ZLst |  znil : ZLst.

Fixpoint drop (drop_arg0 : Nat) (drop_arg1 : Lst) : Lst
           := match drop_arg0, drop_arg1 with
              | x, nil => nil
              | zero, x => x
              | succ x, cons y z => drop x z
              end.

(* No helper lemma needed. *)
Theorem theorem0 : forall (v : Nat) (w : Nat) (x : Nat) (y : Nat) (z : Lst),
  eq (drop (succ v) (drop (succ w) (cons x (cons y z)))) (drop (succ v) (drop w (cons x z))).
Proof.
intros. assert (forall n x l, drop (succ n) (cons x l) = drop n l).
  - intros. reflexivity.
  - rewrite H. induction w.
    + rewrite H. rewrite H. reflexivity.
    + reflexivity.
Qed.


Check mult_n_O.
(* ===> forall n : nat, 0 = n * 0 *)

Check mult_n_Sm.
(* ===> forall n m : nat, n * m + n = n * S m *)

Theorem mult_n_1 : forall p : nat,
  p * 1 = p.
Proof.
  intros p.
  rewrite <- mult_n_Sm.
  rewrite <-  mult_n_O.
  simpl.
  reflexivity.
Qed.


Require Import QArith.
Require Import JoinSemiLattice.
Require Import PreorderEquiv.
Require Import MathClasses.interfaces.canonical_names.

Section Rationals.

Instance q_le : Le Q := Qle.
Instance q_equiv : Equiv Q := Qeq.
Instance q_lt : Lt Q := Qlt.
Instance q_zero : Zero Q := 0#1.
Instance q_plus : Plus Q := Qplus.
Instance q_mult : Mult Q := Qmult.

Instance q_Preorder : Preorder q_le :=
  MkPreorder
    Q
    Qle
    Qle_refl
    Qle_trans.

Definition Qmax (x y :Q) : Q :=
  match x ?= y with
  | Gt => x
  | Lt => y
  end.

Instance q_join : Join Q := Qmax.

Lemma Qmax_l : forall x y, x ≤ x ⊔ y.
Proof.
  intros.
  unfold join, q_join, Qmax.
  destruct (x ?= y) eqn:?.
  - rewrite <- Qeq_alt in Heqc.
    rewrite Heqc.
    apply le_refl.
  - rewrite <- Qlt_alt in Heqc.
    apply Qlt_le_weak. assumption.
  - apply le_refl.
Qed.

Lemma Qmax_r : forall x y, y ≤ x ⊔ y.
Proof.
  intros.
  unfold join, q_join, Qmax.
  destruct (x ?= y) eqn:?.
  - apply le_refl.
  - apply le_refl.
  - rewrite <- Qgt_alt in Heqc.
    apply Qlt_le_weak. assumption.
Qed.

Lemma Qmax_univ : forall x y z, x ≤ z -> y ≤ z -> x ⊔ y ≤ z.
Proof.
  intros.
  unfold join, q_join, Qmax.
  destruct (x ?= y) eqn:?.
  - rewrite <- Qeq_alt in Heqc. assumption.
  - assumption.
  - assumption.
Qed.

Instance q_JSL : JoinSemiLattice q_le :=
  MkJSL
    Q
    q_le
    q_Preorder
    Qmax
    Qmax_l
    Qmax_r
    Qmax_univ.

End Rationals.


From algebra Require Import preamble semigroup monoid.
From HB Require Import structures.
From Coq Require Import ZArith Lia.

HB.mixin Record monoid_is_group G of Monoid G :=
 { opp : G -> G;
   subrr : forall x, add x (opp x) = zero;
   addNr : forall x, add (opp x) x = zero }.

HB.factory Record is_group G :=
 { zero : G;
   add : G -> G -> G;
   opp : G -> G;
   addrA : associative add;
   add0r : left_id zero add;
   subrr : forall x, add x (opp x) = zero;
   addNr : forall x, add (opp x) x = zero }.

HB.builders Context G of is_group G.
  Let addr0 : forall x, add x zero = x.
  Proof. by move=> x; rewrite -(addNr x) addrA subrr add0r. Qed.
  HB.instance Definition _ := is_monoid.Build G zero add addrA add0r addr0.
  HB.instance Definition _ := monoid_is_group.Build G opp subrr addNr.
HB.end.

HB.structure Definition Group := {G of is_group G}.

HB.mixin Record is_abgroup G of Group G :=
  { addC : commutative (add : G -> G -> G) }.

HB.structure Definition AbGroup := {G of is_abgroup G &}.

Definition Z_is_group : monoid_is_group Z.
Proof.
  build.
  - by apply: Z.opp.
  - abstract by move=> ?; rewrite /add /zero //=; lia.
  - abstract by move=> ?; rewrite /add /zero //=; lia.
Defined.

HB.instance Definition _ := Z_is_group.
HB.instance Definition _ := is_abgroup.Build Z Z.add_comm.

HB.mixin Record submonoid_is_subgroup (G : Group.type) S of Submonoid G S :=
  { has_opp : forall u : G, S u -> S (opp u) }.

HB.factory Record is_subgroup (G : Group.type) (S : G -> Prop) :=
  { has_zero : S zero;
    has_add : forall u v : G, S u -> S v -> S (add u v);
    has_opp : forall u : G, S u -> S (opp u) }.

HB.structure Definition Subgroup (G : Group.type) := {S of submonoid_is_subgroup G S &}.

HB.builders Context G S of is_subgroup G S.
  HB.instance Definition _ := is_subsemigroup.Build G S has_add.
  HB.instance Definition _ := subsemigroup_is_submonoid.Build G S has_zero.
HB.end.

Section Subgroup.
  Context (G : Group.type) (S : Subgroup.type G).

  Definition opp' : {x : G | S x} -> {x : G | S x}.
  Proof. by move=> u; esplit; apply: has_opp; apply: pi2 u. Defined.

  Fact subrr' : forall x, add x (opp' x) = zero.
  Proof.
    move=> u.
    apply: sigE=> //=.
    by rewrite subrr.
  Qed.

  Fact addNr' : forall x, add (opp' x) x = zero.
  Proof.
    move=> u.
    apply: sigE=> //=.
    by rewrite addNr.
  Qed.

  HB.instance Definition _ := monoid_is_group.Build {x : G | S x} opp' subrr' addNr'.
End Subgroup.


Inductive ev : nat -> Prop :=
| ev_0 : ev 0
| ev_SS (n : nat) (H : ev n) : ev (S (S n)).

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).

Definition lt (n m:nat) := le (S n) m.

Notation "m < n" := (lt m n).

Inductive CE : nat -> nat -> Prop :=
  | CE_0: CE 0 2
  | CE_SSnm (n m : nat) (H : CE n m ): CE (S (S n)) (S (S m)).

Example test_CE : CE 4 6.
Proof.
  apply CE_SSnm.
  apply CE_SSnm.
  apply CE_0.
Qed.

Theorem CE_SS : forall n m, CE (S (S n)) (S (S m)) -> CE n m.
Proof.
  intros n m H.
  inversion H.
  apply H2.
Qed.

Theorem ev_sum : forall n m, ev n -> ev m -> ev (n + m).
Proof.
  intros n m H1 H2.
  induction H1.
  - simpl.
    apply H2.
  - apply ev_SS.
    apply IHev.
Qed.

Lemma le_trans : forall m n o, m <= n -> n <= o -> m <= o.
Proof.
  intros m n o H1 H2.
  induction H2.
  - apply H1.
  - apply le_S.
    apply IHle.
    apply H1.
Qed.


Inductive natlist : Type :=
  | nil : natlist
  | cons : nat -> natlist -> natlist.

Notation "x :: l" := (cons x l) (at level 60, right associativity).
Notation "[ ]" := nil.
Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..).

Fixpoint append(m n :natlist) : natlist :=
match m with
|[] => n
|a :: b => a::(append b n)
end.

Notation "x ++ y" := (append x y)(at level 60, right associativity).

Fixpoint snoc(m:natlist)(n:nat) :natlist:=
match m with
|[] => [n]
|a::b => a:: (snoc b n)
end.

Fixpoint reverse(n:natlist) : natlist :=
match n with
|[] => []
|a::b => snoc(reverse b) a
end.

Theorem associative_L3 : forall n o p : natlist, n++(o++p) = (n++o)++p.
Proof.
intros n o p.
induction n.
simpl. reflexivity.
simpl. rewrite -> IHn.
reflexivity.
Qed.

Theorem appendList : forall (list : natlist) (n : nat), snoc list n = list ++ [n].
Proof.
  intros.
    induction list as [| x xs].
    simpl.
    reflexivity.
    simpl.
    rewrite -> IHxs.
    reflexivity.
Qed.

Theorem appendEmptyList : forall list : natlist, list ++ [] = list.
Proof.
  intros.
    induction list as [| x xs].
    simpl.
    reflexivity.
    simpl.
    rewrite -> IHxs.
    reflexivity.
Qed.

Theorem reverseDistributive : forall l1 l2 : natlist, reverse (l1 ++ l2 ) = (reverse l2 ) ++ (reverse l1 ).
Proof.
intros l1 l2.
induction l1.
simpl. rewrite appendEmptyList.
simpl. reflexivity.
simpl. rewrite IHl1.
simpl. rewrite appendList.
simpl. rewrite appendList.
simpl. rewrite associative_L3.
reflexivity.
Qed.

Eval compute in( reverse [1;2;3;4;5;6]).
Eval compute in( reverseDistributive [1;2;3;4;5;6] [7;8;9]).