(**
Objectif de ce suppport de TD :
initiation aux relations ou prédicats définis inductivement,
pour préparer la définition des sémantiques relationnelles.
*)

(* Les exercices sont faciles, progressifs, et sont prévus
   pour une durée d'environ 1/2h).
*)

(* ------------------------------------------------------------ *)
(** * Relations ou prédicats définis inductivement *)

(** ** Prédicats à 1 argument sur un type énuméré  *)

(** Commençons par un prédicat très simple qui indique comment
    sélectionner quelques valeurs dans un type énuméré. *)

Inductive coul : Set :=
| violet : coul
| indigo : coul
| bleu : coul
| vert : coul
| jaune : coul
| orange : coul
| rouge : coul
.

(** Rappel : on ne peut PAS définir un autre type qui partage des
    constructeurs avec un type déjà défini. *)
Fail Inductive coulfeu : Set :=
| vert : coulfeu
| orange : coulfeu
| rouge : coulfeu
.

Definition ATTENTION_QUESTION_EN_COMMENTAIRE_1 : bool := true.
(**
Pourquoi interdire à un constructeur d'être dans des types inductifs différents ?
 *)
(* Pour éviter les ambiguités de type quand on écrit "vert" (par exemple)
 *)

(** Mais on peut définir un prédicat sur coul qui est démontrable
    pour vert orange et rouge (et seulement pour ces derniers). *)

Inductive estCoulfeu : coul -> Prop :=
| Fver : estCoulfeu vert
| Fora : estCoulfeu orange
| Frou : estCoulfeu rouge
.

(** Par exemple on peut démontrer que vert satisfait ce prédicat. *)
Example exemple_feu_vert : estCoulfeu vert.
Proof.
  apply Fver.
Qed.

(** Certains feux de circulation ne présentent que les deux couleurs
    vert et rouge. *)

Inductive feu2couls : coul -> Prop :=
| F2ver : feu2couls vert
| F2rou : feu2couls rouge
.

(** On veut démontrer que le second prédicat implique le premier. *)

Lemma feu2couls_estCoulfeu : forall c, feu2couls c -> estCoulfeu c.
Proof.
  intro c.
  (** On essaie d'abord un raisonnement par cas sur [c].*)
  destruct c.
  (** Beaucoup de cas inutiles (et qui requièrent une technique spéciale).
      Donc on essaye une meilleure stratégie. *)
  Undo 1.
  (** Introduction de l'hypothèse sur [c]. *)
  intro f2c.
  (** Il suffit de raisonner par cas sur les deux façons
      dont [f2c] peut être construite *)
  refine (match f2c with F2ver => _ | F2rou => _ end).
  clear.
  (** Même chose en utilisant la tactique destruct sur l'HYPOTHÈSE [f2c] *)
  Undo 2.
  destruct f2c as [ (*F2ver*) | (*F2rou*) ].
  - apply Fver.
  - refine Frou.
Qed.

(** Exercice *)

(** Sur le modèle du prédicat estCoulfeu, définir un autre prédicat nommé boivr,
    qui sélectionne les couleurs bleu, orange, indigo, vert et rouge. *)

(* Inductive boivr à compléter *)

Inductive boivr : coul -> Prop :=
  | Bbleu : boivr bleu
  | Borange : boivr orange
  | Bindigo : boivr indigo
  | Bvert : boivr vert
  | Brouge : boivr rouge
  .

(** Démontrer ensuite : *)

Lemma estCoulfeu_boivr : forall c, estCoulfeu c -> boivr c.
Proof.
  intros.
  destruct H.
  - apply Bvert.
  - apply Borange.
  - apply Brouge.
Qed.

(** ** Relations à 2 arguments sur un type énuméré *)

(** Les relations inductives permettent de représenter des fonction partielles
    i.e., qui ne sont pas définies partout. Voici un exemple où coulsuiv
    est définie pour vert, orange et rouge, mais pas pour les autres couleurs
    prévues dans coul. *)

Inductive coulsuiv : coul -> coul -> Prop :=
| CSv : coulsuiv vert orange
| CSo : coulsuiv orange rouge
| CSr : coulsuiv rouge vert
.

(** Exercice (même technique qu'auparavant) *)

Lemma coulsuiv_estCoulfeu : forall c1 c2, coulsuiv c1 c2 -> estCoulfeu c1.
Proof.
  intros.
  destruct H.
  - apply Fver.
  - apply Fora.
  - apply Frou.
Qed.

(** ** Prédicat even sur nat *)

(** De même que les types inductifs de données peuvent être récursifs,
    par exemple nat ou aexp, les prédicats inductifs peuvent être
    récursifs. C'est le cas de even, présenté au CM4. *)

Inductive even : nat -> Prop :=
| E0 : even 0
| E2 : forall n, even n -> even (S (S n))
.

(** Exercice : démontrer que 6 est pair. *)

Example ev10 : even 10.
Proof.
  refine (E2 8 _).
  apply (E2 6).
  apply E2.
  apply E2.
  apply E2.
  apply E0.
Qed.

Print ev10.

Definition ATTENTION_QUESTION_EN_COMMENTAIRE_2 : bool := true.
(** Exercice :
    - quel est le type et la signification de E2 4 ?
    - quel est le type et la signification de E2 5 ?
*)
(*
  E2 4 : Prop, proposition "4 est pair"
  E2 5 : Prop, proposition "5 est pair"
 *)

(** Entiers atteignables en ajoutant des 2 ou des 7 en partant de 0. *)
Inductive p2p7 : nat -> Prop :=
| PP0 : p2p7 0
| PP2 : forall n, p2p7 n -> p2p7 (2 + n)
| PP7 : forall n, p2p7 n -> p2p7 (7 + n)
.

(** Exercice : démontrer de 3 façons que 11 est atteignable par p2p7. *)
Example p2p7_11_methode1 : p2p7 11.
Proof.
  apply PP7.
  apply PP2.
  apply PP2.
  apply PP0.
Qed.

Example p2p7_11_methode2 : p2p7 11.
Proof.
  apply PP2.
  apply PP2.
  apply PP7.
  apply PP0.
Qed.

Example p2p7_11_methode23 : p2p7 11.
Proof.
  apply PP2.
  apply PP7.
  apply PP2.
  apply PP0.
Qed.

Print p2p7_11_methode2.

(** Démontrer que tout entier pair satisfait p2p7. *)

Theorem even_p2p7 : forall n, even n -> p2p7 n.
Proof.
  intros n en.
  (** Comme il y a une infinité d'entiers pairs, une preuve par cas
      ne suffit pas. On procède par récurrence structurelle sur les
      façons de démontrer [even n], autrement les formes possibles
      d'arbres de preuve pour [en].
      On a deux cas, celui où [en] est [E0], et celui où [en]
      est de la forme [E2 n' en'], avec [en' : even n'] ;
      dans ce dernier cas, on a droit à une hypothèse de récurrence
      sur en', assurant que [n'] satisfait p2p7.
  *)
  induction en as [ (*E0*) | (*E2*) n' evn' Hrec_evn'].
  - apply PP0.
  - (** Facultatif : mise sous une forme clairement adaptée à p2p7 *)
    change (p2p7 (2 + n')).
    (** Utilisation du constructeur approprié de p2p7 *)
    apply PP2.
    (** Utilisation de l'hypothèse de récurrence *)
    apply Hrec_evn'.
Qed.

(** Il est instructif de démontrer le même théorème par une
    fonction récursive. *)

Fixpoint fct_even_p2p7 n (en : even n) : p2p7 n :=
  match en with
  | E0 => PP0
  | E2 n' evn' => PP2 n' (fct_even_p2p7 n' evn')
  end.

(** On peut transformer un arbre de preuve de [even 4]
    en un arbre de preuve de [p2p7 4] *)
Compute fct_even_p2p7 4 (E2 2 (E2 0 E0)).

(** La somme de deux entiers pairs est paire *)
Lemma even_plus : forall n m, even n -> even m -> even (n + m).
Proof.
  intros n m evn evm.
  induction evn.
  - apply evm.
  - apply E2. apply IHevn.
Qed.

(** Exercice facultatif :
    en donner une preuve sous forme de fonction. *)

Require Import Arith.

Fixpoint fct_even_plus n m (evn : even n) (evm : even m) : even (n + m) :=
  match evn with
    | E0 => evm
    | E2 n' Ihn' => E2 (n' + m) (fct_even_plus n' m Ihn' evm)
  end.

(* Les multiples de 4 sont pairs *)
Inductive mul4 : nat -> Prop :=
| M4_0 : mul4 0
| M4_4 : forall n, mul4 n -> mul4 (S (S (S (S n))))
.

Lemma mul4_even : forall n, mul4 n -> even n.
Proof.
  intros n m4n.
  (** Terminer par récurrence structurelle sur [m4n] *)
  induction m4n.
  - apply E0.
  - apply E2. apply E2. exact IHm4n.
Qed.


(*******    Mathematical Components    *******)
From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

(* Part One  : Basics for Formal Mathematics *)
(* Chapter 1 : Functions and Computation     *)
Definition f (n : nat) : nat := n + 1.
Print f.
Eval compute in f 3.

Definition g (n m : nat) : nat := n + m * 2.
Definition h (n : nat) : nat -> nat := fun m => n + m * 2.
Print g.
Print h.

Definition repeat_twice (g : nat -> nat) : nat -> nat :=
  fun x => g (g x).
Eval compute in repeat_twice f 98.

Inductive bool := true | false.
Definition twoVthree (b : bool) := if b is true then 2 else 3.
Eval compute in twoVthree true.
Eval compute in twoVthree false.

Inductive nat := O | S (n : nat).

Definition predn n := if n is p.+1 then p else n.
Eval compute in predn 5.
Definition pred5 n := if n is u.+1.+1.+1.+1.+1 then u else 0.
Eval compute in pred5 11.

Definition three_patterns n :=
  match n with
    u.+1.+1.+1.+1.+1 => u
  | v.+1 => v
  | 0 => n
  end.
Eval compute in three_patterns 7.

Definition same_bool b1 b2 :=
  match b1, b2 with
    true, true => true
  | false, false => true
  | _, _ => false
  end.

Fixpoint addn n m :=
  match n with
    0 => m
  | p.+1 => (addn p m).+1
  end.

About cons.
Check 1 :: 2 :: 3 :: nil.

Definition head T (x0 : T) (s : seq T) :=
  if s is x :: _ then x else x0.

Fixpoint size A (s : seq A) :=
  if s is _ :: tl then (size tl).+1 else 0.

Fixpoint map A B (f : A -> B) s :=
  if s is e :: tl then f e :: map f tl else nil.

Notation "[ ’seq’ E | i <- s ]" := (map (fun i => E) s).
Eval compute in [seq i.+1 | i <- [:: 1; 2]].

Inductive option A := None | Some (a : A).

Print foldr.
Print iota.
Notation "\sum_ ( m <= i < n ) F" :=
  (foldr (fun i a => F + a) 0 (iota m (n-m))).
Eval compute in \sum_( 1 <= i < 3 ) (i * 2 - 1).
Eval compute in \sum_( 1 <= i < 5 ) i.

(* Exercise 1 The triple data type *)

(* Exercise 2 Addition with iteration *)
(* Exercise 3 Multiplication with iteration *)
(* Exercise 4 Find the n-th element *)
(* Exercise 5 List reversal *)
(* ** Exercise 7 All words of size n *)

(* Chapter 2 : First Steps in Formal Proofs *)
Section Chap2.
From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Check 3 = 3.
Check 3 = 4.

Locate "=".
About eq.

Lemma negbK b : ~~ (~~ b) = b.
Proof.
elim b.
by[].
by[].
(* by case b. *)
Qed.

Lemma leqn0 n : (n <= 0) = (n == 0).
Proof.
move: n.
elim.
by[].
move => k h.
by[].
(* by case: => [|k]. *)
Qed.

(* Exercise 8 Truth tables *)
(* Exercise 9 Rewriting *)
(* * Exercise 10 Induction *)
(* ** Exercise 11 Multiple induction *)

End Chap2.
(* Chapter 3 : Type Theory *)
Check ex.
Check or_ind.

Inductive True : Prop := I.
Inductive False : Prop := .
Print not.

Definition not (A : Prop) := A -> False.
Definition exfalso (P : Prop) (f : False) : P :=
  match f with end. (* no constructors, no branches *)

(* Chapter 4 : First Steps in Formal Proofs *)
Definition bool_Prop_equiv (P : Prop) (b : bool) :=
  b = true <-> P. (* Reflection views *)
Lemma test_bool_Prop_equiv b P : bool_Prop_equiv P b -> P \/ ~ P.
Proof.
case b.
case.
move => hlr hrl.
left.
apply: hlr.
reflexivity.
case.
move => hlr hrl.
right.
move => hP.
move: (hrl hP).
by[].
Qed.

(* Exercise 12 reflect *)
(* Exercise 13 eqnP *)
(* Exercise 14 Injectivity to nat *)
(* Exercise 15 Characterization of max *)

(* Part Two  : Formalization Techniques *)
(* Chapter 5 : Implicit Parameters *)
Definition id A (a : A) : A := a.
Check (id _ 3).
Arguments id {A} a.
Check (id 3).
Check (@id _ 3).

Check (fun x => @id nat x).

Lemma example q : prime q -> 0 < q.
Proof.
move => pr_q.
(* prime_gt1 : forall p : Datatypes.nat, prime p -> 1 < p *)
have q_gt1 := (@prime_gt1 _ pr_q).
(* ltnW : forall m n : Datatypes.nat, m < n -> m <= n  *)
exact (ltnW q_gt1).
Qed.

(* Chapter 6 : Sub-Types *)
(* Chapter 7. Organizing Theories *)
(* Chapter 8 : Natural numbers *)
Example Gauss n : \sum_(0 <= i < n.+1) i = (n * n.+1) %/ 2.
Proof.
(* big_nat1 :
forall (R : Type) (idx : R) (op : Monoid.law idx) (n : nat) (F : nat -> R),
\big[op/idx]_(n <= i < n.+1) F i = F n *)
elim: n =>[|n IHn]; first by apply: big_nat1.
(* big_nat_recr :
forall (R : Type) (idx : R) (op : Monoid.law idx) (n m : nat) (F : nat -> R),
m <= n ->
\big[op/idx]_(m <= i < n.+1) F i = op (\big[op/idx]_(m <= i < n) F i) (F n) *)
(* addnC : commutative addn *)
(* divnMDl : forall q m d : nat, 0 < d -> (q * d + m) %/ d = q + m %/ d *)
rewrite big_nat_recr //= IHn addnC -divnMDl //.
(* mulnS : forall m n : nat, m * n.+1 = m + m * n *)
rewrite mulnS.
(* muln1 : right_id 1 muln *)
rewrite muln1.
(* addnA : associative addn *)
rewrite -addnA.
(* mulSn : forall m n : nat, m.+1 * n = n + m * n *)
rewrite -mulSn.
rewrite -mulnS.
reflexivity.
Qed.

(* Part Three : Synopsis *)


From LF Require Export Basics.

Theorem add_0_r : forall n : nat,
    n + 0 = n.
Proof.
    intros n.
    induction n as [| n' IHn'].
    - reflexivity.
    - simpl.
      rewrite -> IHn'.
      reflexivity.
Qed.

Theorem minus_n_n: forall n : nat,
    minus n n = 0.
Proof.
    intros n.
    induction n as [| n' IHn'].
    - reflexivity.
    - simpl.
      rewrite -> IHn'.
      reflexivity.
Qed.

Theorem mult_n_0: forall n : nat,
  n * 0 = 0.
Proof.
    intros n.
    induction n as [| n' IHn'].
    - reflexivity.
    - simpl.
      rewrite -> IHn'.
      reflexivity.
Qed.

Theorem plus_n_Sm: forall n m : nat,
  S (n + m) = n + S m.
Proof.
    intros n m.
    induction n as [| n' IHn'].
    - simpl.
      reflexivity.
    - simpl.
      rewrite -> IHn'.
      reflexivity.
Qed.

Theorem add_comm: forall n m : nat,
  n + m = m + n.
Proof.
    intros n m.
    induction n as [| n' IHn'].
    rewrite -> add_0_r.
    - simpl.
      reflexivity.
    - simpl.
      rewrite -> IHn'.
      rewrite -> plus_n_Sm.
      reflexivity.
Qed.

Theorem add_assoc: forall n m p : nat,
    (n + m) + p = n + (m + p).
Proof.
    intros n m p.
    induction n as [| n' IHn'].
    - simpl.
      reflexivity.
    - simpl.
      rewrite -> IHn'.
      reflexivity.
Qed.

Fixpoint double (n : nat) : nat :=
    match n with
    | O => O
    | S n' => S (S (double n'))
    end.

Lemma double_plus : forall n : nat,
  double n = n + n.
Proof.
  induction n as [| n' IHn'].
  - simpl.
    reflexivity.
  - simpl.
    rewrite <- plus_n_Sm.
    rewrite <- IHn'.
    reflexivity.
Qed.

Theorem eqb_refl : forall n : nat,
  (n ?= n) = true.
Proof.
  intros n.
  induction n as [| n' IHn'].
  - simpl. reflexivity.
  - simpl.
    rewrite -> IHn'.
    reflexivity.
  Qed.

Theorem even_S : forall n : nat,
  (even (S n)) = (negb (even n)).
Proof.
  intros n.
  induction n as [| m IHm].
  - simpl. reflexivity.
  - assert (H1 : even (S (S m)) = even m).
    { simpl. reflexivity. }
    rewrite -> H1.
    rewrite -> IHm.
    rewrite -> negb_involution.
    reflexivity.
  Qed.

Theorem mult_0_plus' : forall n m : nat,
  (n + 0 + 0) * m = n * m.
Proof.
  intros n m.
  assert (H: n + 0 + 0 = n).
    { rewrite add_comm. simpl. rewrite add_comm. reflexivity. }
  rewrite -> H.
  reflexivity.
  Qed.

Theorem plus_rearrange : forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  assert (H: n + m = m + n).
    { rewrite -> add_comm. reflexivity. }
  rewrite -> H.
  reflexivity.
  Qed.

(*Exercise 3 : multiplicative commutative.*)
Theorem add_shuffle3 : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  intros n m p.
  assert (H1: n + (m + p) = n + m + p).
    { rewrite -> add_assoc. reflexivity. }
  rewrite -> H1.
  assert (H2: n + m = m + n).
    { rewrite -> add_comm. reflexivity. }
  rewrite -> H2.
  rewrite -> add_assoc.
  reflexivity.
  Qed.

Theorem mult_n_Sm : forall n m : nat,
  n * S m = n + n * m.
Proof.
  intros n m.
  induction n as [| n' IHn'].
  - reflexivity.
  - simpl.
    rewrite -> IHn'.
    rewrite -> add_shuffle3.
    reflexivity.
  Qed.

Theorem mult_comm : forall n m : nat,
  n * m = m * n.
Proof.
  intros n m.
  induction n as [| n' IHn'].
  - simpl.
    rewrite -> mult_n_0.
    reflexivity.
  - simpl.
    rewrite -> mult_n_Sm.
    rewrite -> IHn'.
    reflexivity.
  Qed.

Theorem plus_leb_compat_l : forall n m p: nat,
  n <=? m = true ->
    (p + n) <=? (p + m) = true.
Proof.
  intros n m p H1.
  induction p as [| p' IHp'].
  - simpl.
    rewrite -> H1.
    reflexivity.
  - simpl.
    rewrite -> IHp'.
    reflexivity.
  Qed.

Theorem mult_1_l : forall n : nat,
  1 * n = n.
Proof.
  intros n.
  simpl.
  rewrite -> add_0_r.
  reflexivity.
  Qed.

Theorem mult_plus_distr_r : forall n m p : nat,
  (n + m) * p = n * p + m * p.
Proof.
  intros n m p.
  induction n as [| n' IHn'].
  - reflexivity.
  - simpl.
    rewrite -> IHn'.
    rewrite -> add_assoc.
    reflexivity.
  Qed.

Theorem mult_assoc : forall n m p : nat,
  n * (m * p) = (n * m) * p.
Proof.
  intros n m p.
  induction n as [| n' IHn'].
  - reflexivity.
  - simpl.
    rewrite -> mult_plus_distr_r.
    rewrite -> IHn'.
    reflexivity.
  Qed.

(*Exercise: 2 stars, standard, optional (add_shuffle3')*)
Theorem add_shuffle3' : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  intros n m p.
  rewrite <- add_assoc.
  rewrite <- add_assoc.
  replace (n + m) with (m + n).
  - reflexivity.
  - rewrite -> add_comm.
    reflexivity.
  Qed.

(*Exercise: 3 stars, standard, especially useful (binary_commute)*)
Theorem bin_to_nat_pres_incr : forall b : bin,
  bin_to_nat (increase b) = 1 + bin_to_nat b.
Proof.
  intros b.
  induction b as [|b' IHb' | b'' IHb''].
  - (* Case b = Z *)
    reflexivity.
  - (* Case b = (B0 b') *)
    reflexivity.
  - (* Case b = (B1 b'') *)
    simpl.
    repeat rewrite -> add_0_r.
    simpl.
    rewrite -> IHb''.
    rewrite -> add_shuffle3.
    repeat rewrite <- add_assoc.
    reflexivity.
  Qed.

(* Exercise: 3 stars, standard (nat_bin_nat) *)
Fixpoint nat_to_bin (n : nat) : bin :=
  match n with
  | O => Z
  | S n' => increase (nat_to_bin n')
  end.

Theorem nat_bin_nat : forall n : nat,
  bin_to_nat (nat_to_bin n) = n.
Proof.
  intros n.
  induction n as [|n' IHn'].
  - (* Case n = O *)
    reflexivity.
  - (* Case n = S n' *)
    simpl.
    rewrite -> bin_to_nat_pres_incr.
    rewrite -> IHn'.
    reflexivity.
  Qed.

Theorem double_increase : forall n : nat,
  double (S n) = S (S (double n)).
Proof.
  intros n.
  reflexivity.
  Qed.

Definition double_bin (b : bin) : bin :=
  match b with
  | Z => Z
  | _ => (B0 b)
  end.

Example test_double_bin_5:
  (bin_to_nat (double_bin (B1 (B0 (B1 Z))))) = 10.
Proof.
  reflexivity.
  Qed.

Example double_bin_zero:
  (double_bin Z) = Z.
Proof.
  reflexivity.
  Qed.

Lemma double_increase_bin : forall b : bin,
  double_bin (increase b) = increase (increase (double_bin b)).
Proof.
  intros b.
  destruct b eqn:Eqb.
  - (* Case b = Z *)
    reflexivity.
  - (* Case b = (B0 b')*)
    reflexivity.
  - (* Case b = (B1 b') *)
    reflexivity.
  Qed.

(* Exercise: 4 stars, advanced (bin_nat_bin) *)
(* Trying to elimiating the redundant leading zeros in a bin expression with
   the normalize function.
     The root cause that (nat_to_bin (bin_to_nat b)) != b is that there are
   infinity valid representation for Z (i.e. Z). For example
   (B0 Z), (B0 (B0 Z)), (B0 (B0 (B0 Z))) ...... are all representing 0. *)
Fixpoint normalize (b : bin) : bin :=
  match b with
  | Z => Z
  | B0 n' => (double_bin (normalize n'))
  | B1 n' => (B1 (normalize n'))
  end.

Compute (normalize (B1 (B0 (B0 (B0 Z))))).

Lemma double_eq_n_plus_n : forall n : nat,
  (double n) = n + n.
Proof.
  intros n.
  induction n as [| n' IHn'].
  - (* Case n = O *)
    reflexivity.
  - (* Case n = S n' *)
    simpl.
    rewrite <- plus_n_Sm.
    rewrite -> IHn'.
    reflexivity.
  Qed.

Theorem nat_to_bin_double : forall n : nat,
  (nat_to_bin (double n)) = (double_bin (nat_to_bin n)).
Proof.
  intros n.
  induction n as [| n' IHn'].
  - (* Case n = O *)
    reflexivity.
  - (* Case n = S n' *)
    rewrite -> double_increase.
    simpl.
    rewrite -> double_increase_bin.
    rewrite -> IHn'.
    reflexivity.
  Qed.

Theorem increase_double_bin : forall b : bin,
  (increase (double_bin b)) = (B1 b).
Proof.
  intros b.
  destruct b eqn:Eqb.
  - (* Case b = Z *)
    reflexivity.
  - (* Case b = (B0 b') *)
    reflexivity.
  - (* Case b = (B1 b'') *)
    reflexivity.
  Qed.

Theorem bin_nat_bin : forall b : bin,
  (nat_to_bin (bin_to_nat b)) = (normalize b).
Proof.
  intros b.
  induction b as [| b' IHb'| b'' IHb''].
  - (* Case b = Z *)
    reflexivity.
  - (* Case b = (B0 b') *)
    simpl.
    rewrite -> add_0_r.
    rewrite <- double_eq_n_plus_n.
    rewrite -> nat_to_bin_double.
    rewrite -> IHb'.
    reflexivity.
  - (* Case b = (B1 b'') *)
    simpl.
    rewrite -> add_0_r.
    rewrite <- double_eq_n_plus_n.
    rewrite -> nat_to_bin_double.
    rewrite -> IHb''.
    rewrite -> increase_double_bin.
    reflexivity.
  Qed.


(** Discrete Fourier transformation can be used to compute big number's
    multiplication. FFT is a well-known efficient algorithm to calculate
    discrete fourier transformation. Your should learn how this algorithm works
    and prove its correctness in Coq. You need to either define this algorithm
    using complex numbers (you may find some library in Coq's standard library
    or other Coq's user's contribution) or via an abstract ring with some extra
    properties.

    You only need to define this algorithm as a Coq function or a Coq relation
    (small step description of this algorithm). You do not need to implement it
    in a programming language like C. You do not need to verify its
    implementation in any programming language. *)

(* 2021-05-07 20:39 *)
From Coq Require Import Reals ssreflect.
Require Import PL.Rcompute PL.Ccompute PL.Inequalities.
Require Import Coq.Lists.List.

Local Open Scope C_scope.
Delimit Scope C_scope with C.

Notation "[ ]" := nil (format "[ ]") : list_scope.
Notation "[ x ]" := (cons x nil) : list_scope.
Notation "[ x ; y ; .. ; z ]" := (cons x (cons y .. (cons z nil) ..)) : list_scope.
Infix "::" := cons (at level 60, right associativity) : list_scope.
Infix "++" := app (right associativity, at level 60) : list_scope.

(** The function below computes the kth element of Discrete Fourier Transform of a list of complex numbers
by DEFINITION, not FFT. *)
Fixpoint Fourier (X : list C) (n : R) (k len : nat) : C :=
  match X with
    | nil => (0%R , 0%R)
    | (x :: X')%list => x * (exp_complex (-2 * PI * n * (INR k) * / (INR len))) + (Fourier X' (n + 1) k len)
  end.

(**  Now define the algorithm of FFT. First define some useful functions.*)
(** Selecting the elements of even/odd indices out of a list. Used in FFT.*)
Fixpoint EvenList (l:list C) : list C :=
    match l with
       | nil => nil
       | (x :: l' )%list=> x :: OddList l'
    end
  with OddList (l:list C) : list C :=
    match l with
       | nil => nil
       | (_ :: l' )%list=> EvenList l'
      end.

(** Pointwise operation on two complex lists. Used in FFT.*)
Fixpoint ListOp (l1: list C) (l2: list C) (Op: C->C->C) (default: list C): list C :=
  match l1, l2 with
     | nil, nil => nil
     | (x1 :: l1' ), (x2 :: l2') => (Op x1 x2) :: ListOp l1' l2' Op default
     | nil, _ => default
     | _, nil => default
  end.

(** Generating the phase factor used in FFT.*)
Fixpoint PhaseGen (n:nat) (m: nat): list C :=
  match n with
    | O => []
    | S n' => PhaseGen n' m ++ [(exp_complex (- 2 * PI * (INR n') / (INR m)))]
  end.
Definition Phase (N: nat): list C:= PhaseGen N (2*N).

(** Checking the length of list X.*)
Definition lenX_pow_2_n_1 (X : list C) : Prop :=
  exists N, Datatypes.length X = Init.Nat.pow 2 N.
(* equal of nat *)
Definition lenX_pow_2_n_2 (X : list C) : Prop :=
  exists N, Z.of_nat (Datatypes.length X) = Z.pow 2 N.
(* equal of Z *)

(** This function describes the algorithm of FFT. The length of list x must be 2^M. *)
Fixpoint FFT (x:list C) (M:nat): list C :=
  match M with
  | O => x
  | S M' => ListOp (FFT (EvenList x) M') (ListOp (Phase (2^M')) (FFT (OddList x) M') Cmult []) Cplus []
                  ++ ListOp (FFT (EvenList x) M') (ListOp (Phase (2^M')) (FFT (OddList x) M') Cmult []) Cminus []
  end.

(**  Below are some useful intermediate results for the proof. These come from the derivation of the algorithm of FFT.*)

(** This is the even term of the Fourier transform *)
Fixpoint Fourier_even (X : list C) (n : R) (k len : nat) : C :=
  match X with
    | nil => (0%R , 0%R)
    | (x :: X')%list => x * (exp_complex (-2 * PI * 2 * n * (INR k) * / (2 * (INR len) ))) + (Fourier_even X' (n + 1) k len)
  end.

(** This is the odd term of the Fourier transform *)
Fixpoint Fourier_odd (X : list C) (n : R) (k len : nat) : C :=
  match X with
    | nil => (0%R , 0%R)
    | (x :: X')%list => x * (exp_complex (-2 * PI * (2 * n + 1) * (INR k) * / (2 * (INR len) ))) + (Fourier_odd X' (n + 1) k len)
  end.

Lemma Fourier_nMinus1: forall (X : list C) (n : R) (k len : nat),
  len <> 0%nat -> Fourier X (n + 1) k len = exp_complex (-2 * PI * (INR k) * / (INR len)) * Fourier X n k len.
Proof.
  intros.
  revert n; induction X.
  {
  intros.
  simpl.
  pose proof exp_mult_0_1 (-2 * PI * INR k * / INR len).
  rewrite H0.
  reflexivity.
  }
  intros.
  specialize (IHX (n + 1)%R).
  simpl.
  pose proof Cmult_plus_distr_l (exp_complex (-2 * PI * INR k * / INR len)) (a * exp_complex (-2 * PI * n * INR k * / INR len)) (Fourier X (n + 1) k len).
  rewrite H0.
  clear H0 H.
  rewrite <- IHX.
  assert (exp_complex (-2 * PI * INR k * / INR len) *
(a * exp_complex (-2 * PI * n * INR k * / INR len)) = a * exp_complex (-2 * PI * (n + 1) * INR k * / INR len)).
  {
  pose proof Cmult_assoc_r (exp_complex (-2 * PI * INR k * / INR len)) a (exp_complex (-2 * PI * n * INR k * / INR len)).
  rewrite <- H.
  pose proof Cmult_comm (exp_complex (-2 * PI * INR k * / INR len)) a.
  rewrite H0.
  assert (exp_complex (-2 * PI * INR k * / INR len) *
exp_complex (-2 * PI * n * INR k * / INR len) = exp_complex (-2 * PI * (n + 1) * INR k * / INR len)).
  {
  clear.
  pose proof exp_mult (-2 * PI * INR k * / INR len) (-2 * PI * n * INR k * / INR len).
  pose proof UseByFourier_nMinus1_1 (-2 * PI)%R (INR k * / INR len) n.
  rewrite H.
  pose proof Rmult_assoc (-2 * PI)%R (INR k) (/ INR len).
  rewrite <- H1 in H0.
  pose proof Rmult_assoc (-2 * PI * n) (INR k) (/ INR len).
  rewrite <- H2 in H0.
  rewrite H0.
  pose proof Rmult_assoc (-2 * PI * (n + 1)) (INR k) (/ INR len).
  rewrite <- H3.
  reflexivity.
  }
  pose proof Cmult_assoc_r a (exp_complex (-2 * PI * INR k * / INR len)) (exp_complex (-2 * PI * n * INR k * / INR len)).
  rewrite H1 in H2.
  exact H2.
  }
  rewrite H.
  reflexivity.
Qed.

Lemma Fourier_even_nMinus1: forall (X : list C) (n : R) (k len : nat),
  len <> 0%nat -> Fourier_even X (n + 1) k len = exp_complex (-2 * PI * (INR k) * / (INR len)) * Fourier_even X n k len.
Proof.
  intros.
  revert n; induction X.
  {
  intros.
  simpl.
  pose proof exp_mult_0_1 (-2 * PI * INR k * / INR len).
  rewrite H0.
  reflexivity.
  }
  intros.
  specialize (IHX (n + 1)%R).
  simpl.
  pose proof Cmult_plus_distr_l (exp_complex (-2 * PI * INR k * / INR len)) (a * exp_complex (-2 * PI * 2 * n * INR k * / (2 * INR len))) (Fourier_even X (n + 1) k len).
  rewrite H0.
  clear H0.
  rewrite <- IHX.
  assert (exp_complex (-2 * PI * INR k * / INR len) *
(a * exp_complex (-2 * PI * 2 * n * INR k * / (2 * INR len))) = a * exp_complex (-2 * PI * 2 * (n + 1) * INR k * / (2 * INR len))).
  {
  pose proof Cmult_assoc_r (exp_complex (-2 * PI * INR k * / INR len)) a (exp_complex (-2 * PI * 2 * n * INR k * / (2 * INR len))).
  rewrite <- H0.
  pose proof Cmult_comm (exp_complex (-2 * PI * INR k * / INR len)) a.
  rewrite H1.
  assert (exp_complex (-2 * PI * INR k * / INR len) *
exp_complex (-2 * PI * 2 * n * INR k * / (2 * INR len)) = exp_complex (-2 * PI * 2 * (n + 1) * INR k * / (2 * INR len))).
  {
  pose proof not_0_INR.
  specialize (H2 len H).
  pose proof UseByFourier_even_nMinus1_1 (-2 * PI)%R (INR k) (INR len).
  specialize (H3 H2).
  rewrite H3.
  clear.
  pose proof exp_mult (-2 * PI * 2 * INR k * / (2 * INR len)) (-2 * PI * 2 * n * INR k * / (2 * INR len)).
  pose proof UseByFourier_nMinus1_1 (-2 * PI * 2)%R (INR k * / (2 * INR len)) n.
  rewrite H.
  pose proof Rmult_assoc (-2 * PI * 2)%R (INR k) (/ (2 * INR len)).
  rewrite <- H1 in H0.
  pose proof Rmult_assoc (-2 * PI * 2 * n) (INR k) (/ (2 * INR len)).
  rewrite <- H2 in H0.
  rewrite H0.
  pose proof Rmult_assoc (-2 * PI * 2 * (n + 1)) (INR k) (/ (2 * INR len)).
  rewrite <- H3.
  reflexivity.
  }
  pose proof Cmult_assoc_r a (exp_complex (-2 * PI * INR k * / INR len)) (exp_complex (-2 * PI * 2 * n * INR k * / (2 * INR len))).
  rewrite H2 in H3.
  exact H3.
  }
  rewrite H0.
  reflexivity.
Qed.

Lemma Fourier_odd_nMinus1: forall (X : list C) (n : R) (k len : nat),
  len <> 0%nat -> Fourier_odd X (n + 1) k len = exp_complex (-2 * PI * (INR k) * / (INR len)) * Fourier_odd X n k len.
Proof.
  intros.
  revert n; induction X.
  {
  intros.
  simpl.
  pose proof exp_mult_0_1 (-2 * PI * INR k * / INR len).
  rewrite H0.
  reflexivity.
  }
  intros.
  specialize (IHX (n + 1)%R).
  simpl.
  pose proof Cmult_plus_distr_l (exp_complex (-2 * PI * INR k * / INR len)) (a * exp_complex (-2 * PI * (2 * n + 1) * INR k * / (2 * INR len))) (Fourier_odd X (n + 1) k len).
  rewrite H0.
  clear H0.
  rewrite <- IHX.
  assert (exp_complex (-2 * PI * INR k * / INR len) *
(a * exp_complex (-2 * PI * (2 * n + 1) * INR k * / (2 * INR len))) = a * exp_complex (-2 * PI * (2 * (n + 1) + 1) * INR k * / (2 * INR len))).
  {
  pose proof Cmult_assoc_r (exp_complex (-2 * PI * INR k * / INR len)) a (exp_complex (-2 * PI * (2 * n + 1) * INR k * / (2 * INR len))).
  rewrite <- H0.
  pose proof Cmult_comm (exp_complex (-2 * PI * INR k * / INR len)) a.
  rewrite H1.
  assert (exp_complex (-2 * PI * INR k * / INR len) *
exp_complex (-2 * PI * (2 * n + 1) * INR k * / (2 * INR len)) = exp_complex (-2 * PI * (2 * (n + 1) + 1) * INR k * / (2 * INR len))).
  {
  pose proof not_0_INR.
  specialize (H2 len H).
  pose proof UseByFourier_odd_nMinus1_1 (-2 * PI)%R (INR k) n (INR len).
  specialize (H3 H2).
  pose proof exp_mult (-2 * PI * INR k * / INR len) (-2 * PI * (2 * n + 1) * INR k * / (2 * INR len)).
  rewrite H4 H3.
  reflexivity.
  }
  clear IHX H0 H1.
  pose proof Cmult_eq_compat_l.
  specialize (H0 a (exp_complex (-2 * PI * INR k * / INR len) *
     exp_complex (-2 * PI * (2 * n + 1) * INR k * / (2 * INR len))) (exp_complex (-2 * PI * (2 * (n + 1) + 1) * INR k * / (2 * INR len))) H2).
  pose proof Cmult_assoc_r a (exp_complex (-2 * PI * INR k * / INR len)) (exp_complex (-2 * PI * (2 * n + 1) * INR k * / (2 * INR len))).
  rewrite <- H1 in H0.
  rewrite H0.
  reflexivity.
  }
  rewrite H0.
  reflexivity.
Qed.

(* Fourier_split2_1 *)
Lemma Fourier_split2_1: forall (X : list C) (k len : nat),
  len <> 0%nat -> Fourier_even X 0 k len = Fourier X 0 k len.
Proof.
  intros.
  induction X.
  {
  simpl.
  reflexivity.
  }
  simpl.
  pose proof compute_1 (-2 * PI * 2) (INR k) (2 * (INR len)).
  rewrite H0.
  pose proof compute_1 (-2 * PI) (INR k) (INR len).
  rewrite H1.
  clear H0 H1.
  pose proof Rplus_0_l 1.
  rewrite H0.
  pose proof Fourier_even_nMinus1 X 0 k len.
  specialize (H1 H).
  rewrite H0 in H1.
  rewrite H1.
  pose proof Fourier_nMinus1 X 0 k len.
  specialize (H2 H).
  rewrite H0 in H2.
  rewrite H2.
  rewrite IHX.
  reflexivity.
Qed.

(* Fourier_split2_2 *)
Lemma Fourier_split2_2: forall (X : list C) (k len : nat),
  len <> 0%nat -> Fourier_odd X 0 k len = (exp_complex (-2 * PI * (INR k ) * / (2 * INR len) )) * Fourier X 0 k len.
Proof.
  intros.
  induction X.
  {
  simpl.
  pose proof exp_mult_0_1 (-2 * PI * (INR k) * / (2 * INR len)).
  rewrite H0.
  reflexivity.
  }
  simpl.
  pose proof compute_1 (-2 * PI) (INR k) (INR len).
  rewrite H0.
  pose proof Rmult_0_r 2.
  rewrite H1.
  pose proof Rplus_0_l 1.
  rewrite H2.
  pose proof Rmult_1_r (-2 * PI).
  rewrite H3.
  clear H0 H1 H2 H3.
  pose proof Fourier_odd_nMinus1 X 0 k len.
  specialize (H0 H).
  rewrite IHX in H0.
  pose proof Rplus_0_l 1.
  rewrite H1 in H0.
  rewrite H0.
  pose proof Fourier_nMinus1 X 0 k len.
  specialize (H2 H).
  rewrite H1 in H2.
  rewrite H2.
  pose proof exp_0_mult_r a.
  rewrite H3.
  clear.
  pose proof Cmult_plus_distr_l (exp_complex (-2 * PI * (INR k) * / (2 * (INR len)))) a (exp_complex (-2 * PI * (INR k) * / (INR len)) * Fourier X 0 k len).
  rewrite H; clear.
  pose proof Cmult_comm a (exp_complex (-2 * PI * (INR k) * / (2 * (INR len)))).
  rewrite H; clear.
  pose proof Cmult_assoc_r (exp_complex (-2 * PI * (INR k) * / (2 * (INR len)))) (exp_complex (-2 * PI * (INR k) * / (INR len))) (Fourier X 0 k len).
  rewrite <- H; clear.
  pose proof Cmult_assoc_r (exp_complex (-2 * PI * (INR k) * / (INR len))) (exp_complex (-2 * PI * (INR k) * / (2 * (INR len)))) (Fourier X 0 k len).
  rewrite <- H; clear.
  pose proof Cmult_comm (exp_complex (-2 * PI * (INR k) * / (INR len))) (exp_complex (-2 * PI * (INR k) * / (2 * (INR len)))).
  rewrite H; clear.
  reflexivity.
Qed.

(** Split Fourier transform into odd and even when k < N / 2*)
Lemma Fourier_split1: forall (X : list C) (k len : nat),
  len <> 0%nat -> Fourier X 0 k (2 * len) = Fourier_even (EvenList X) 0 k len + Fourier_odd (OddList X) 0 k len.
Proof.
  intros.
  induction X.
  {
  simpl.
  unfold Cplus.
  simpl.
  pose proof Rplus_0_l 0.
  rewrite H0.
  reflexivity.
  }
  {
  simpl.
  pose proof compute_1 (-2 * PI)%R (INR k) (INR (2 * len)).
  pose proof compute_1 (-2 * PI * 2)%R (INR k) (2 * (INR len)).
  rewrite H0 H1.
  clear H0 H1.
  pose proof Rplus_0_l 1.
  rewrite H0; clear H0.
  pose proof Fourier_nMinus1 X 0 k (2 * len).
  assert (2 <> 0)%nat.
  congruence.
  pose proof Nat.neq_mul_0 2 len.
  destruct H2; clear H3.
  assert (2 <> 0 /\ len <> 0).
  split; [exact H1 | exact H].
  specialize (H2 H3).
  specialize (H0 H2).
  clear H1 H2 H3.
  pose proof Rplus_0_l 1.
  rewrite H1 in H0; clear H1.
  assert (Fourier X 1 k (2 * len) = Fourier_even (OddList X) 1 k len + Fourier_odd (EvenList X) 0 k len).
  2: {
  rewrite H1.
  pose proof Cplus_assoc_r (a * exp_complex 0) (Fourier_even (OddList X) 1 k len) (Fourier_odd (EvenList X) 0 k len).
  rewrite H2.
  reflexivity.
  }
  rewrite H0; clear H0.
  pose proof Fourier_even_nMinus1 (OddList X) 0 k len.
  specialize (H0 H).
  pose proof Fourier_split2_1 (OddList X) k len.
  specialize (H1 H).
  rewrite H1 in H0; clear H1.
  pose proof Fourier_split2_2 (EvenList X) k len.
  specialize (H1 H).
  pose proof Fourier_split2_1 (EvenList X) k len.
  specialize (H2 H).
  rewrite H2 in IHX; clear H2.
  pose proof Fourier_split2_2 (OddList X) k len.
  specialize (H2 H).
  rewrite H2 in IHX; clear H2.
  pose proof Rplus_0_l 1.
  rewrite H2 in H0.
  clear H2.
  rewrite IHX; clear IHX.
  pose proof Cmult_plus_distr_l (exp_complex (-2 * PI * (INR k) * / (INR (2 * len)))) (Fourier (EvenList X) 0 k len) (exp_complex (-2 * PI * (INR k) * / (2 * (INR len))) * Fourier (OddList X) 0 k len).
  rewrite H2; clear H2.
  assert (2 * INR len = INR (2 * len))%R.
  {
  clear.
  pose proof mult_INR 2 len.
  rewrite H.
  assert (2 = INR 2)%R.
  constructor.
  rewrite H0.
  reflexivity.
  }
  rewrite H2 in H1.
  rewrite <- H1; clear H1.
  pose proof Cmult_assoc_r (exp_complex (-2 * PI * (INR k) * / (INR (2 * len)))) (exp_complex (-2 * PI * (INR k) * / (INR (2 * len)))) (Fourier (OddList X) 0 k len).
  rewrite H2.
  rewrite <- H1; clear H1.
  assert (exp_complex (-2 * PI * (INR k) * / (INR (2 * len))) * exp_complex (-2 * PI * (INR k) * / (INR (2 * len))) = exp_complex (-2 * PI * (INR k) * / (INR len))).
  {
  pose proof exp_mult (-2 * PI * (INR k) * / (INR (2 * len))) (-2 * PI * (INR k) * / (INR (2 * len))).
  pose proof UseByFourier_split1_1 (-2 * PI * (INR k)) (INR len).
  pose proof not_INR len 0.
  simpl in H4.
  specialize (H4 H).
  specialize (H3 H4).
  rewrite H2 in H3.
  rewrite H3 in H1.
  apply H1.
  }
  rewrite H1.
  rewrite <- H0.
  apply Cplus_comm.
  }
Qed.

(** Split Fourier transform into odd and even when k > N / 2*)
Lemma Fourier_split3_1: forall (X : list C) (k len : nat),
  len <> 0 -> len <= k -> Fourier_even X 0 k len = Fourier X 0 (k - len) len.
Proof.
  intros.
  induction X.
  {
  simpl.
  reflexivity.
  }
  simpl.
  pose proof compute_1 (-2 * PI * 2)%R (INR k) (2 * INR len).
  pose proof compute_1 (-2 * PI)%R (INR (k - len)) (INR len).
  rewrite H1 H2; clear H1 H2.
  pose proof Fourier_nMinus1 X 0 (k - len) len.
  pose proof Fourier_even_nMinus1 X 0 k len.
  pose proof Rplus_0_l 1.
  rewrite H3.
  rewrite H3 in H1 H2; clear H3.
  specialize (H1 H).
  specialize (H2 H).
  rewrite H1 H2 IHX; clear H1 H2.
  pose proof Use_by_kMinuslen_1 k len.
  specialize (H1 H H0).
  rewrite H1.
  reflexivity.
Qed.

Lemma Fourier_split3_2: forall (X : list C) (k len : nat),
  len <> 0 -> len <= k -> Fourier_odd X 0 k len = (exp_complex (-2 * PI * (INR k) * / (2 * INR len)) ) * Fourier X 0 (k - len) len.
Proof.
  intros.
  induction X.
  {
  simpl.
  pose proof exp_mult_0_1 (-2 * PI * INR k * / (2 * INR len)).
  rewrite H1.
  reflexivity.
  }
  simpl.
  pose proof Rplus_0_l 1.
  rewrite H1.
  assert (2 * 0 + 1 = 1)%R.
  ring.
  rewrite H2; clear H2.
  pose proof Rmult_1_r (-2 * PI)%R.
  rewrite H2; clear H2.
  pose proof compute_1 (-2 * PI)%R (INR (k - len)) (INR len).
  rewrite H2; clear H2.
  pose proof exp_0_mult_r a.
  rewrite H2; clear H2.
  pose proof Cmult_plus_distr_l (exp_complex (-2 * PI * INR k * / (2 * INR len))) a (Fourier X 1 (k - len) len).
  rewrite H2; clear H2.
  pose proof Cmult_comm (exp_complex (-2 * PI * INR k * / (2 * INR len))) a.
  rewrite H2; clear H2.
  pose proof Fourier_nMinus1 X 0 (k - len) len.
  pose proof Fourier_odd_nMinus1 X 0 k len.
  specialize (H2 H).
  specialize (H3 H).
  rewrite H1 in H2 H3; clear H1.
  rewrite H2 H3 IHX; clear H2 H3 IHX.
  pose proof Cmult_assoc_r (exp_complex (-2 * PI * INR k * / INR len)) (exp_complex (-2 * PI * INR k * / (2 * INR len))) (Fourier X 0 (k - len) len).
  pose proof Cmult_assoc_r (exp_complex (-2 * PI * INR k * / (2 * INR len))) (exp_complex (-2 * PI * INR (k - len) * / INR len)) (Fourier X 0 (k - len) len).
  rewrite <- H1; clear H1.
  rewrite <- H2; clear H2.
  pose proof Use_by_kMinuslen_1 k len.
  specialize (H1 H H0).
  rewrite H1.
  pose proof Cmult_comm (exp_complex (-2 * PI * INR k * / (2 * INR len))) (exp_complex (-2 * PI * INR k * / INR len)).
  rewrite H2.
  reflexivity.
Qed.

Lemma FstHalf: forall (X: list C) (k: nat) (len: nat),
  len <> 0 -> Fourier X 0 k (2 * len) = Fourier (EvenList X) 0 k len + (exp_complex (-2 * PI * (INR k) * / (2 * INR len) )) * Fourier (OddList X) 0 k len.
Proof.
  intros.
  pose proof Fourier_split1 X k len.
  specialize (H0 H).
  pose proof Fourier_split2_1 (EvenList X) k len.
  specialize (H1 H).
  pose proof Fourier_split2_2 (OddList X) k len.
  specialize (H2 H).
  rewrite <- H2.
  rewrite <- H1.
  rewrite <- H0.
  reflexivity.
Qed.

Lemma SndHalf: forall (X: list C) (k: nat) (len: nat),
  len <> 0 -> len <= k ->  Fourier X 0 k (2 * len) = Fourier (EvenList X) 0 (k - len) len - (exp_complex (-2 * PI * (INR (k - len)) * / (2 * INR len) )) * Fourier (OddList X) 0 (k - len) len.
Proof.
  intros.
  pose proof Fourier_split1 X k len.
  specialize (H1 H).
  pose proof Fourier_split3_1 (EvenList X) k len.
  specialize (H2 H H0).
  pose proof Fourier_split3_2 (OddList X) k len.
  specialize (H3 H H0).
  pose proof Use_by_kMinuslen_2 k len.
  specialize (H4 H H0).
  rewrite H4; clear H4.
  pose proof Use_By_SndHalf (Fourier (EvenList X) 0 (k - len) len) (exp_complex (-2 * PI * INR k * / (2 * INR len))) (Fourier (OddList X) 0 (k - len) len).
  rewrite H4; clear H4.
  rewrite <- H3.
  rewrite <- H2.
  rewrite <- H1.
  reflexivity.
Qed.

Lemma ListOpLength:forall (l1 l2 : list C)(Op : C->C->C) (default: list C),
length l1 = length l2 -> length (ListOp l1 l2 Op default) = length l1.
Proof.
  induction l1, l2; intros.
  + reflexivity.
  + discriminate H.
  + discriminate H.
  + intros. simpl.
    simpl in H.
    rewrite <- Nat.compare_eq_iff.
    rewrite Nat.compare_succ.
    rewrite Nat.compare_eq_iff.
    rewrite <- Nat.compare_eq_iff in H.
    rewrite Nat.compare_succ in H.
    simpl in H.
    apply Nat.compare_eq_iff in H.
    apply IHl1. exact H.
Qed.

Lemma EOListLength: forall (n: nat)(x: list C),
length x = (2 * n)%nat  -> length (EvenList x) = n /\ length (OddList x) = n.
Proof.
  induction n.
  + intros; simpl.
    induction x. { simpl; split; reflexivity. }
    discriminate H.
  + intros.
    induction x; [ discriminate H | ].
    induction x.
    ++ simpl in H.
      rewrite <- Nat.compare_eq_iff in H;
      rewrite Nat.compare_succ in H;
      apply Nat.compare_eq_iff in H.
      pose proof Nat.eq_add_0 n (S(n + 0)).
      destruct H0.
      assert ((n + S (n + 0))%nat = 0). rewrite <- H. reflexivity.
      specialize (H0 H2). destruct H0. rewrite plus_0_r in H3.
      discriminate H3.
    ++ simpl. clear IHx IHx0.
      simpl in H.
      rewrite <- Nat.compare_eq_iff in H;
      rewrite Nat.compare_succ in H;
      apply Nat.compare_eq_iff in H.
      rewrite plus_comm in H.  rewrite plus_0_r in H.
      rewrite <- Nat.compare_eq_iff in H;
      rewrite Nat.compare_succ in H;
      apply Nat.compare_eq_iff in H. fold Nat.add in H.
      specialize (IHn x).
      assert ((n + n)%nat = (2 * n)%nat). { simpl.  rewrite plus_0_r. reflexivity. }
      rewrite H0 in H. pose proof IHn H. destruct H1.
      split; rewrite <- Nat.compare_eq_iff ;
      rewrite Nat.compare_succ ;
      apply Nat.compare_eq_iff .
      exact H1. exact H2.
Qed.

Lemma FFTSplit: forall (x:list C)(M: nat)(a: list C)(b: list C),
(length a = 2^M /\ length b = 2^M /\
forall (k: nat), (k <= 2^M - 1) -> Fourier x 0 k (length x) = nth k a (0%R, 0%R)
                        /\ Fourier x 0 (k + 2^M) (length x) = nth k b (0%R, 0%R)) ->
forall (k: nat), (k <= 2^(S M) - 1) -> Fourier x 0 k (length x) = nth k (a++b) (0%R, 0%R).
Proof.
  intros.
  destruct H.
  destruct H1.
  pose proof le_or_lt k  (2 ^ M - 1).
  destruct H3.
  + pose proof H2 _ H3.
    pose proof ineq2 _ _ H3.
    rewrite <- H in H5.
    pose proof app_nth1 a b (0%R, 0%R) H5.
    rewrite H6.
    destruct H4. exact H4.
  +
    pose proof ineq3 _ _ H3.
    assert (k >= 2 ^ M).

    {unfold ">=". exact H4. }
    rewrite <- H in H5.
    pose proof app_nth2 a b (0%R, 0%R) H5.
    rewrite H6.
    pose proof ineq4 _ _ H0.
    pose proof H2 (k - 2 ^ M)%nat H7.
    rewrite H.
    destruct H8.
    rewrite plus_comm in H9. rewrite <- le_plus_minus in H9.
    exact H9. exact H4.
Qed.

Lemma nthListOp: forall (l1: list C) (l2: list C) (Op: C->C->C) (default: list C) (default0: C) (k: nat),
length l1 = length l2 ->
default0 = Op default0 default0 ->
nth k (ListOp l1 l2 Op default) default0 = Op (nth k l1 default0) (nth k l2 default0).
Proof.
  induction l1, l2. intros.
  + intros. simpl. induction k; exact H0.
  + intros. simpl in H. discriminate H.
  + intros. simpl in H. discriminate H.
  + intros. induction k.
    ++ simpl. reflexivity.
    ++ simpl. apply IHl1. simpl in H.
          rewrite <- Nat.compare_eq_iff in H;
          rewrite Nat.compare_succ in H;
          apply Nat.compare_eq_iff in H.
          exact H. exact H0.
Qed.

(** Some equalities about lengths*)
Lemma PhaseGenLength: forall (n m: nat),
length (PhaseGen n m) = n.
Proof.
  intros.
  induction n.
  + reflexivity.
  + simpl. rewrite app_length. simpl.
    rewrite plus_comm. simpl.
    rewrite <- Nat.compare_eq_iff;
    rewrite Nat.compare_succ;
    rewrite Nat.compare_eq_iff.
    exact IHn.
Qed.

Lemma PhaseLength: forall (N: nat),
length (Phase N) = N.
Proof.
  unfold Phase.
  intros.
  apply PhaseGenLength.
Qed.

Lemma FFTLength: forall(M: nat)(x: list C),
length x = 2 ^ M -> length (FFT x M) = 2 ^ M.
Proof.
  induction M.
  + simpl. intros. exact H.
  + intros. simpl. rewrite app_length.
    pose proof PhaseLength (2 ^ M).
    pose proof IHM (OddList x).
    pose proof IHM (EvenList x).
    pose proof EOListLength (2^M) x.
    assert(length x = (2 * 2 ^ M)%nat  ).
    { simpl. simpl in H. rewrite H. reflexivity. }
    specialize (H3 H4); clear H4.
    destruct H3.
    specialize (H1 H4); clear H4.
    specialize (H2 H3); clear H3.
    rewrite <- H0 in H1, H2.
    pose proof ListOpLength (Phase (2 ^ M)) (FFT (OddList x) M) Cmult [].
    pose proof ListOpLength (Phase (2 ^ M)) (FFT (EvenList x) M) Cmult [].
    assert (length (Phase (2 ^ M)) = length (FFT (OddList x) M) ). rewrite H1; reflexivity.
    assert (length (Phase (2 ^ M)) = length (FFT (EvenList x) M) ). rewrite H2; reflexivity.
    specialize (H3 H5); specialize(H4 H6).
    rewrite <- H1 in H3; rewrite <- H2 in H4.
    pose proof ListOpLength (FFT (EvenList x) M) (ListOp (Phase (2 ^ M)) (FFT (OddList x) M) Cmult []) Cplus [].
    pose proof ListOpLength (FFT (EvenList x) M) (ListOp (Phase (2 ^ M)) (FFT (OddList x) M) Cmult []) Cminus [].
    rewrite H3 in H7, H8. rewrite <- H5, H6 in H7, H8.
    assert (length (FFT (EvenList x) M) = length (FFT (EvenList x) M) ). reflexivity.
    specialize (H7 H9). rewrite H7.
    specialize (H8 H9). rewrite H8.
    rewrite H2 H0. rewrite plus_0_r. reflexivity.
Qed.

Lemma Length1: forall (M: nat)(x: list C),
length x = 2 ^ (S M) ->
length (FFT (EvenList x) M)  = 2 ^ M /\ length (FFT (OddList x) M) = 2 ^ M.
Proof.
    intros.
    pose proof EOListLength (2^M) x.
    assert( length x = (2 * 2 ^ M)%nat  ).
    { simpl. simpl in H. rewrite H. reflexivity. }
    specialize (H0 H1); clear H1.
    destruct H0.
    pose proof FFTLength M (EvenList x) H0.
    pose proof FFTLength M (OddList x) H1.
    split. exact H2. exact H3.
Qed.

Lemma Length2: forall (M: nat)(x: list C),
length x = 2 ^ (S M) -> length (Phase (2 ^ M)) = 2 ^ M.
Proof.
  intros.
  pose proof PhaseLength (2 ^ M).
  exact H0.
Qed.

Lemma Length3: forall (M: nat)(x: list C)(Op : C -> C -> C),
length x = 2 ^ (S M) ->
length (ListOp (Phase (2 ^ M)) (FFT (OddList x) M) Op []) = 2 ^ M.
Proof.
  intros.
  pose proof Length2 _ _ H.
  pose proof Length1 _ _ H.
  destruct H1.
  pose proof ListOpLength (Phase (2 ^ M)) (FFT (OddList x) M) Op [].
  rewrite H0 H2 in H3.
  assert (2 ^ M = 2 ^ M). reflexivity.
  specialize (H3 H4).
  exact H3.
Qed.

Lemma Length4: forall (M: nat)(x: list C)(Op : C -> C -> C),
length x = 2 ^ (S M) ->
length
  (ListOp (FFT (EvenList x) M) (ListOp (Phase (2 ^ M)) (FFT (OddList x) M) Cmult []) Op []) =
2 ^ M.
Proof.
  intros.
  pose proof Length2 _ _ H.
  pose proof Length1 _ _ H.
  pose proof Length3 _ _ Cmult H.
  destruct H1.
  pose proof ListOpLength (FFT (EvenList x) M) (ListOp (Phase (2 ^ M)) (FFT (OddList x) M) Cmult []) Op [].
  assert (length (FFT (EvenList x) M) =
  length (ListOp (Phase (2 ^ M)) (FFT (OddList x) M) Cmult [])). rewrite H2 H1. reflexivity.
  specialize (H4 H5).
  rewrite H4. rewrite H1. reflexivity.
Qed.

Lemma PhaseGen_k: forall(n k m: nat),
k < n -> nth k (PhaseGen n m) (0%R, 0%R) = exp_complex (-2 * PI * INR k * / INR (m)).
Proof.
  induction n.
  + intros. pose proof lt_n_0 k. contradiction.
  + intros. pose proof lt_n_Sm_le k n. specialize (H0 H).
      pose proof le_lt_or_eq k n. specialize(H1 H0). destruct H1.
      ++ specialize (IHn k m H1). simpl.
            pose proof PhaseGenLength n m.
            rewrite <- H2 in H1.
            pose proof app_nth1 (PhaseGen n m) ([exp_complex (-2 * PI*INR n  / INR m)]) (0%R, 0%R) H1.
            rewrite H3. exact IHn.
      ++ simpl. pose proof PhaseGenLength n m. rewrite <- H2 in H1.
            pose proof le_refl k.
            assert (k >= length (PhaseGen n m)).
            { unfold ">=". rewrite <- H1. exact H3. }
            pose proof app_nth2 (PhaseGen n m) ([exp_complex (-  2 * PI * INR n/ INR m)]) (0%R, 0%R) H4.
            rewrite H5. rewrite <- H1. rewrite minus_diag. simpl.
            rewrite H1. rewrite H2. reflexivity.
Qed.

Lemma Phase_k: forall(k : nat) (M: nat),
k < 2 ^ M -> nth k (Phase (2 ^ M)) (0%R, 0%R) = exp_complex (-2 * PI * INR k * / (INR (2 * 2 ^ M))).
Proof.
  intros.
  unfold Phase.
  apply PhaseGen_k.
  exact H.
Qed.

(**  This is our ultimate goal.*)
Definition FFTCorrect : forall (M:nat) (x:list C) (k:nat),
  (length x = 2 ^ M /\ k <= 2 ^ M - 1) ->
  Fourier x 0 k (length x) = nth k (FFT x M) (0%R, 0%R).
Proof.
  induction M.
  + intros. simpl. simpl in H.
    destruct H. rewrite H. destruct x.
    ++ unfold Fourier. destruct k; simpl; reflexivity.
    ++ destruct x.
          2:{simpl in H. discriminate H. }
          simpl.
          pose proof compute_1 (-2*PI) (INR k) 1%R .
          rewrite H1. rewrite expcomplex_0.
          destruct k. destruct c. unfold Cmult, Cplus. simpl. repeat rewrite Rmult_0_r.
          repeat rewrite Rmult_1_r. repeat rewrite Rplus_0_r. repeat rewrite Rminus_0_r.
          repeat rewrite Rplus_0_l. reflexivity.
          simpl in H0. apply le_n_0_eq in H0. discriminate H0.
  + intros. destruct H. simpl. revert H0. apply FFTSplit. split.
    ++ simpl. rewrite Length4. exact H. pose proof minus_n_O M. reflexivity.
    ++ split. rewrite Length4. exact H. pose proof minus_n_O M. simpl. reflexivity.
          split.
    +++ repeat rewrite nthListOp.
          { pose proof Length1 _ _ H. pose proof Length3 _ _ Cmult H. destruct H1. rewrite H2 H1. reflexivity. }
          { rewrite Cplus_0_r. reflexivity. }
          { pose proof Length1 _ _ H. pose proof Length2 _ _ H. destruct H1. rewrite H2 H3. reflexivity. }
          { rewrite Cmult_0_r. reflexivity. }
          assert (M = (S M - 1)%nat). { simpl. rewrite <- minus_n_O. reflexivity. } rewrite H1 in H0. clear H1.
          pose proof ineq5 (S M - 1).
          pose proof FstHalf x k0 (2^(S M - 1)) H1.
          clear H1.
          rewrite H. simpl; rewrite Nat.add_0_r.
          simpl in H2; rewrite Nat.sub_0_r in H2. rewrite Nat.add_0_r in H2.
          pose proof IHM (EvenList x) k0. pose proof IHM (OddList x) k0.
          pose proof EOListLength _ _ H. fold Nat.pow in H4. destruct H4.
          simpl in H0; rewrite Nat.sub_0_r in H0.
          assert(Fourier (EvenList x) 0 k0 (length (EvenList x)) = nth k0 (FFT (EvenList x) M) (0%R, 0%R)).
          apply H1. split. exact H4. exact H0.
          assert(Fourier (OddList x) 0 k0 (length (OddList x)) = nth k0 (FFT (OddList x) M) (0%R, 0%R)).
          apply H3. split. exact H5. exact H0.
          pose proof ineq2 k0 M H0.
          pose proof Phase_k k0 M.
          pose proof H9 H8.
          rewrite H10. rewrite H2. rewrite <- H6. rewrite <- H7. rewrite H4 H5. rewrite eq0.
          reflexivity.
    +++ repeat rewrite nthListOp.
          { pose proof Length1 _ _ H. pose proof Length3 _ _ Cmult H. destruct H1. rewrite H2 H1. reflexivity. }
          { unfold Cminus. rewrite Cplus_0_l. unfold Copp. simpl. assert(0%R = (-0)%R). ring. rewrite <- H1. reflexivity. }
          { pose proof Length1 _ _ H. pose proof Length2 _ _ H. destruct H1. rewrite H2 H3. reflexivity. }
          { rewrite Cmult_0_r. reflexivity. }
          pose proof ineq k0 M.
          pose proof SndHalf x (k0 + 2 ^ (S M - 1)) (2^(S M - 1)) .
          rewrite H. simpl in H1; rewrite Nat.sub_0_r in H1; rewrite plus_comm in H1.
          simpl in H2; rewrite Nat.sub_0_r in H2; rewrite Nat.add_0_r in H2.
          rewrite plus_comm in H2. rewrite minus_plus in H2.
          pose proof IHM (EvenList x) k0. pose proof IHM (OddList x) k0.
          pose proof EOListLength _ _ H. fold Nat.pow in H5. destruct H5.
          simpl in H0.
          assert(Fourier (EvenList x) 0 k0 (length (EvenList x)) = nth k0 (FFT (EvenList x) M) (0%R, 0%R)).
          apply H3. split. exact H5. exact H0.
          assert(Fourier (OddList x) 0 k0 (length (OddList x)) = nth k0 (FFT (OddList x) M) (0%R, 0%R)).
          apply H4. split. exact H6. exact H0.
          pose proof Phase_k k0 M.
          pose proof ineq5 M.
          pose proof ineq6 k0 M.
          pose proof H2 H10 H11.
          rewrite H5 in H7; rewrite H6 in H8; rewrite H7 H8 in H12; rewrite H9.
          apply ineq2. exact H0.
          simpl; rewrite Nat.add_0_r. rewrite plus_comm.
          rewrite H12. rewrite eq0. simpl. rewrite Nat.add_0_r.
          reflexivity.
Qed.


Compute S O.

Fixpoint add (m: nat) (n: nat) : nat :=
  match m with
    | S m' => S (add m' n)
    | O => n
  end.

Theorem plus_O_n: forall n:nat,
    n = 0 + n.
Proof.
  reflexivity.
Qed.

Theorem plus_n_O: forall n:nat,
    n = n + 0.
Proof.
  intros. induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite <- IHn'. reflexivity.
Qed.

Fixpoint minus (m: nat) (n: nat) : nat :=
  match m, n with
      | S m', S n' => (minus m' n')
      | S m', O => S m'
      | O, _ => O
  end.

Compute (minus 4 1).

Theorem minus_n_n : forall n,
    minus n n = 0.
Proof.
  intros. induction n as [| n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite <- IHn'. reflexivity.
Qed.

Fixpoint mult (m:nat) (n:nat) : nat :=
  match m with
   | O => O
   | S m' => (mult m' n) + n
  end.

Theorem mult_0_r : forall n:nat,
    (mult n 0) = 0.
Proof.
  intros. induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite -> IHn'. simpl. reflexivity.
Qed.

Theorem plus_n_Sm : forall n m : nat,
    S (n + m) = n + (S m).
Proof.
  intros. induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite -> IHn'. reflexivity.
Qed.

Theorem plus_comm : forall n m : nat,
    n + m = m + n.
Proof.
  intros. induction n as [| n' IHn'].
  - simpl. rewrite <- plus_n_O. reflexivity.
  - simpl. rewrite -> IHn'. rewrite -> plus_n_Sm. reflexivity.
Qed.

Theorem plus_assoc : forall n m p : nat,
    n + (m + p) = (n + m) + p.
Proof.
  intros. induction n as [| n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite -> IHn'. reflexivity.
Qed.

Fixpoint double (m:nat) : nat :=
  match m with
    | O => O
    | S m' => S (S (double m'))
    end.

Compute (double 0).

Lemma double_plus : forall n, double n = n + n.
Proof.
  intros. induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite -> IHn'. rewrite -> plus_n_Sm. reflexivity.
Qed.

Fixpoint evenb (m:nat) : bool :=
  match m with
  | (S (S m')) => (evenb m')
  | O => true
  | S m' => false
  end.

Compute (evenb 3).

Theorem evenb_S : forall n : nat,
    evenb (S n) = negb (evenb n).
Proof.
  intros. induction n as [| n' IHn'].
  - reflexivity.
  - rewrite -> IHn'. simpl.
    assert (H: forall b,  b = negb (negb b)).
    { destruct b eqn:E.
      + reflexivity.
      + reflexivity.
    }
    rewrite <- H. reflexivity.
Qed.

(* Theorem plus_rearrange_firsttry : forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  assert (H: m + n = n + m).

  { rewrite -> plus_comm. simpl.}
    rewrite -> H. reflexivity.
Qed. *)

Theorem plus_swap : forall n m p : nat,
    n + (m + p) = m + (n + p).
Proof.
  intros. induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite -> IHn'. rewrite -> plus_n_Sm. reflexivity.
Qed.

Theorem S_plus_1 : forall n : nat, S n = n + 1.
Proof.
  intros. induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite <- IHn'. reflexivity.
Qed.

Theorem n_opposite : forall m n : nat, m + n = m + n -> m = m.
Proof.
  intros. reflexivity.
Qed.

Theorem n_mult_1_sumk : forall n k,
    n * (1 + k) = n + n * k.
Proof.
  intros. simpl. induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite -> IHn'. rewrite -> plus_assoc. rewrite -> plus_assoc.
    assert (H : k + n' = n' + k).
    { rewrite -> plus_comm. reflexivity. }
    rewrite H. reflexivity.
Qed.

Theorem mult_0_n : forall n,
    0 = n * 0.
Proof.
  intros. induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite <- IHn'. reflexivity.
Qed.

Theorem mult_comm : forall m n,
    m * n = n * m.
Proof.
  intros. induction n as [| n' IHn'].
  - rewrite <- mult_0_n. reflexivity.
  - simpl. rewrite n_mult_1_sumk. rewrite IHn'. reflexivity.
Qed.

Fixpoint eqb (m : nat) (n : nat) : bool :=
  match m, n with
  | S m', S n' => (eqb m' n')
  | O, O => true
  | _, _ => false
  end.

Fixpoint leb (m : nat) (n : nat) : bool :=
  match m, n with
  | O, O => true
  | S m', S n' => (leb m' n')
  | O, S n' => true
  | _, _ => false
  end.

Theorem leb_refl : forall n : nat,
  true = (leb n n).
Proof.
  intros. induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite IHn'. reflexivity.
Qed.

Theorem plus_n_0 : forall n : nat,
    0 + n = n.
Proof.
  intros. destruct n as [| n'] eqn: E.
  - reflexivity.
  - reflexivity.
Qed.

Theorem zero_nbeq_S : forall n : nat,
    (eqb 0 (S n)) = false.
Proof.
  reflexivity.
Qed.

Theorem andb_false_r : forall b : bool,
    andb b false = false.
Proof.
  intros. destruct b.
  - reflexivity.
  - reflexivity.
Qed.

Theorem plus_ble_compat_1 : forall n m p : nat,
    leb n m = true -> leb (p + n) (p + m) = true.
Proof.
  intros. induction p as [| p' IHp'].
  - simpl. rewrite H. reflexivity.
  - simpl. rewrite IHp'. reflexivity.
Qed.

Theorem S_nbeq_0 : forall n : nat,
    (eqb (S n) O) = false.
Proof.
  intros. reflexivity.
Qed.

Theorem mult_1_1 : forall n : nat, 1 * n = n.
Proof.
  intros. simpl. rewrite <- plus_n_O. reflexivity.
Qed.

Definition notb (b : bool) : bool :=
  match b with
   | true => false
   | false => true
  end.

Definition orb (b1 : bool) (b2 : bool) : bool :=
  match b1 with
  | true => true
  | false => b2
  end.

Theorem all3_spec : forall b c : bool,
    orb (andb b c)
        (orb (negb b)
             (negb c))
    = true.
Proof.
  destruct b.
  - destruct c.
    + reflexivity.
    + reflexivity.
  - destruct c.
    + reflexivity.
    + reflexivity.
Qed.

Theorem mult_plus_distr_r : forall n m p : nat,
    (n + m) * p = (n * p) + (m * p).
Proof.
  intros. induction n as [| n' IHn'].
  - destruct m as [| m'] eqn:E.
    + reflexivity.
    + reflexivity.
  - destruct m as [| m'] eqn:E.
    + simpl. rewrite IHn'. rewrite -> plus_assoc. reflexivity.
    + simpl. rewrite IHn'. simpl. rewrite plus_assoc. reflexivity.
Qed.

Theorem mult_assoc : forall n m p : nat,
    n * (m * p) = (n * m) * p.
Proof.
  intros. induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite mult_plus_distr_r. rewrite IHn'. reflexivity.
Qed.

Theorem eqb_refl : forall n : nat,
    true = eqb n n.
Proof.
  intros. induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite IHn'. reflexivity.
Qed.

Theorem plus_swap' : forall n m p : nat,
    n + (m + p) = m + (n + p).
Proof.
  intros. rewrite plus_assoc. rewrite plus_assoc.
  replace (n + m) with (m + n).
  reflexivity.
  rewrite plus_comm. reflexivity.
Qed.


(* Projeto LC1*)
(* Alunos: Vincius Lima Passos (200028545) / Marcelo Junqueira Ferreira (200023624) / Davi de Moura Amaral (200016750) *)

Require Import PeanoNat List.
Open Scope nat_scope.

(* Definições*)

Fixpoint insere (n:nat) (l: list nat) :=
  match l with
  | nil => n :: nil (* lista unitária *)
  | h :: tl => if n <=? h then (n :: l) (* inserção de n na primeira posição *)
             else (h :: (insere n tl)) (* inserção de n na cauda da lista *)
  end.

Fixpoint num_oc n l  :=
  match l with
    | nil => 0
    | h :: tl =>
      if n =? h then S(num_oc n tl) else  num_oc n tl
  end.

Lemma num_oc_S: forall n l1 l2, num_oc n (l1 ++ n :: l2) = S (num_oc n (l1 ++ l2)).
Proof.
  induction l1.
  - intro l2.
    simpl.
    rewrite Nat.eqb_refl; reflexivity.
  - intro l2.
    simpl.
    destruct (n =? a); rewrite IHl1; reflexivity.
Qed.

Lemma num_oc_neq: forall n a l1 l2, n =? a = false -> num_oc n (l1 ++ a :: l2) = num_oc n (l1 ++ l2).
Proof.
  induction l1.
  - intros l2 H.
    simpl.
    rewrite H.
    reflexivity.
  - intros l2 Hfalse.
    simpl.
    destruct (n =? a0) eqn:H.
    + apply (IHl1 l2) in Hfalse.
      rewrite Hfalse; reflexivity.
    + apply (IHl1 l2) in Hfalse.
      assumption.
Qed.

Lemma num_oc_app: forall l1 l2 n, num_oc n (l1 ++ l2) = num_oc n (l2 ++ l1).
Proof.
  induction l1.
  - intros l2 n.
    simpl.
    rewrite app_nil_r.
    reflexivity.
  - intros l2 n.
    simpl.
    destruct (n =? a) eqn:H.
    + apply Nat.eqb_eq in H; subst.
      rewrite num_oc_S.
      rewrite IHl1.
      reflexivity.
    + rewrite num_oc_neq.
      * rewrite IHl1.
        reflexivity.
      * assumption.
Qed.

(*permutation*)
Definition permutation l l' := forall n:nat, num_oc n l = num_oc n l'.

Lemma permutation_refl: forall l, permutation l l.
Proof.
  intro l.
  unfold permutation.
  intro x.
  reflexivity.
Qed.

(* Questão 2 ----- *)
Lemma permutation_nil: forall l, permutation nil l -> l = nil.
Proof.
  intro l.
  case l.
  - intro H.
    reflexivity.
  - intros n l' H.
    unfold permutation in H.
    specialize (H n).
    simpl in H.
    rewrite Nat.eqb_refl in H.
    inversion H.
Qed.

Lemma permutation_sym: forall l l', permutation l l' -> permutation l' l.
Proof.
  intros l l' H.
  unfold permutation in *.
  intro n.
  apply eq_sym.
  apply H.
Qed.

Lemma permutation_trans: forall l1 l2 l3, permutation l1 l2 -> permutation l2 l3 -> permutation l1 l3.
Proof.
  intros.
  induction l1.
  -apply permutation_nil in H.
   rewrite H in H0.
   assumption.
  -unfold permutation in *.
   simpl in *.
   intros n.
   assert (H := H n).
   destruct (n =? a) in *.
   + rewrite H.
     apply H0.
   + rewrite H.
     apply H0.
Qed.

Lemma permutation_hd: forall l l' x, permutation l l' -> permutation (x :: l) (x :: l').
Proof.
  intros l l' x H.
  unfold permutation in *.
  intro x'.
  destruct (x'=?x) eqn:H'.
  -simpl.
    rewrite H'.
    rewrite H.
    reflexivity.
  -simpl.
    rewrite H'.
    rewrite H.
    reflexivity.
Qed.

Lemma permutation_hd_back: forall l l' x, permutation (x::l) (x::l') -> permutation l l'.
Proof.
  intros l l' x H.
  unfold permutation in *.
  intro x'.
  specialize (H x').
  simpl in H.
  destruct (x' =? x)eqn: J.
  +  apply eq_add_S in H.
    assumption.
  + assumption.
Qed.

Lemma permutation_2head: forall l x y, permutation ( x::y::l)(y::x::l).
Proof.
  intros l x y.
  unfold permutation.
  intro x0.
  simpl.
  destruct (x0 =? x) eqn:H.
  +destruct(x0 =? y) eqn:J.
    -reflexivity.
    -reflexivity.
  +destruct(x0 =? y) eqn:J.
    -reflexivity.
    -reflexivity.
Qed.

Lemma permutation_insere: forall l l' x, permutation l l' -> permutation (x :: l) (insere x l').
Proof.
  intros l l' x H.
  simpl.
  generalize dependent x.
  generalize dependent l.
  induction l'.
  - intros l H x.
    apply permutation_sym in H.
    apply permutation_nil in H.
    rewrite H.
    simpl.
    apply permutation_refl.
  - intros l H x.
    apply permutation_trans with (x :: a :: l').
    +apply permutation_hd.
      assumption.
    +simpl.
      destruct (x <=? a) eqn:J.
      *apply permutation_refl.
      *apply permutation_trans with (a :: x :: l').
        ** unfold permutation in *.
           apply permutation_2head.
        **apply permutation_hd.
           apply IHl'.
           apply permutation_refl.
Qed.

(*perm*)
Inductive perm: list nat -> list nat -> Prop :=
| perm_refl: forall l, perm l l
| perm_hd: forall x l l', perm l l' -> perm (x::l) (x::l')
| perm_swap: forall x y l l', perm l l' -> perm (x::y::l) (y::x::l')
| perm_trans: forall l1 l2 l3, perm l1 l2 -> perm l2 l3 -> perm l1 l3.

Lemma perm_app_cons: forall l1 l2 a, perm (a :: l1 ++ l2) (l1 ++ a :: l2).
Proof.
  induction l1.
  - intros l2 a.
    simpl.
    apply perm_refl.
  - intros l2 a'.
    simpl.
    apply perm_trans with (a :: a' :: l1 ++ l2).
    + apply perm_swap.
      apply perm_refl.
    + apply perm_hd.
      apply IHl1.
Qed.

Lemma perm_insere: forall l x, perm (x :: l) (insere x l).
 Proof.
   induction l.
   - intro x.
     simpl.
     apply perm_refl.
   - intro x.
     simpl.
     destruct (x <=? a).
     + apply perm_refl.
     + apply perm_trans with (a :: x :: l).
       * apply perm_swap.
         apply perm_refl.
       * apply perm_hd.
         apply IHl.
Qed.

(** Questão 1 *)

Lemma perm_to_permutation: forall l l', perm l l' -> permutation l l'.
Proof.
  induction 1.
   -apply permutation_refl.
   -apply permutation_hd. apply IHperm.
   -apply permutation_trans with (y::x::l).
     +apply permutation_2head.
     +apply permutation_hd. apply permutation_hd. apply IHperm.
   -apply permutation_trans with l2.
     +assumption.
     +assumption.
Qed.

Lemma permutation_cons: forall n l l', permutation (n :: l) (n :: l') <-> permutation l l'.
Proof.
  intros n l l'; split.
  - intro H.
    unfold permutation in *.
    intro n'.
    assert (H' := H n').
    clear H.
    simpl in *.
    destruct (n' =? n).
    + inversion H'.
      reflexivity.
    + inversion H'.
      reflexivity.
  - intro H.
    unfold permutation in *.
    intro n'.
    simpl.
    destruct (n' =? n).
    + assert (H := H n').
      rewrite H.
      reflexivity.
    + apply H.
Qed.

Lemma permutation_comm_app: forall l1 l2, permutation (l1 ++ l2) (l2 ++ l1).
Proof.
  intros l1 l2.
  unfold permutation.
  apply num_oc_app.
Qed.

Lemma permutation_cons_num_oc: forall n l l', permutation (n :: l) l' -> exists x, num_oc  n l' = S x.
Proof.
  intros.
  unfold permutation in H.
  assert (Hn := H n).
  rewrite <- Hn.
  simpl.
  rewrite Nat.eqb_refl.
  exists (num_oc n l).
  reflexivity.
Qed.

(** Questão 3 *)

Lemma num_occ_cons: forall l x n, num_oc x l = S n -> exists l1 l2, l = l1 ++ x :: l2 /\ num_oc x (l1 ++ l2) = n.
Proof.
  induction l.
  -intros.
    simpl in H.
    inversion H.
  -intros.
    simpl in H.
    destruct (x =? a) eqn: H1.
    +specialize (IHl x n).
      apply Nat.eqb_eq in H1.
      rewrite H1.
      exists nil.
      exists l.
      simpl.
      rewrite H1 in H.
      apply eq_add_S in H.
      split.
      *reflexivity.
      *assumption.
    +apply IHl in H.
      destruct H.
      destruct H.
      destruct H.
      rewrite H.
      exists (a :: x0).
      exists x1.
      split.
      *reflexivity.
      *simpl.
        rewrite H1.
        assumption.
      Qed.

(** Questão 4 *)

Lemma permutation_app_cons: forall l1 l2 a, permutation (a :: l1 ++ l2) (l1 ++ a :: l2).
Proof.
  intros.
  apply permutation_trans with (a :: l2 ++ l1). apply permutation_hd. apply permutation_comm_app.
  unfold permutation.
  intros.
  apply num_oc_app with (l1:=(a::l2)).
Qed.

Lemma permutation_to_perm: forall l l', permutation l l' -> perm l l'.
Proof.
  intro l.
  elim l.
  +intros.
    apply permutation_nil in H. rewrite H.
    apply perm_refl.
  +intros.
    assert (H0' := H0); apply permutation_cons_num_oc in H0'.
    destruct H0'.
    apply num_occ_cons in H1.
    destruct H1. destruct H1. destruct H1. rewrite H1.
    apply perm_trans with (a :: x0 ++ x1).
    - apply perm_hd. apply H. apply permutation_hd_back with (x:=a).
      apply permutation_trans with l'.
      -- assumption.
      -- rewrite H1. apply permutation_sym. apply permutation_app_cons.
    - apply perm_app_cons.
Qed.

Theorem perm_equiv: forall l l', perm l l' <-> permutation l l'.
Proof.
  intros l l'.
  split.
  - apply perm_to_permutation.
  - apply permutation_to_perm.
Qed.


(* ========================================================================== *]
 COQ AS A REGULAR PROGRAMMING LANGUAGE
[* ========================================================================== *)

(* We import the librariy for working with natural numbers and lists. *)
Require Import Nat List.

(* -------------------------------------------------------------------------- *]
 To define values use the `Definition` keyword. When defining things use the
 `:=` symbol.

 Statements in Coq are ended with `.` (a bit similar to `;` in most languages.
[* -------------------------------------------------------------------------- *)
Definition twelve := 12.
Definition sum_four_and_four := 4 + 4.

(* You can also use `Example` instead of `Definition` for readability. *)
Example let_statement_example :=
    let a := 2 in
    let b := 3 in
    a * b - 2.

(* -------------------------------------------------------------------------- *]
 A simple way to display defined values is to use `Print`.
[* -------------------------------------------------------------------------- *)

Print twelve.
Print let_statement_example.

(* -------------------------------------------------------------------------- *]
 Coq does not evaluate unless specifically asked to. One way to do this is to
 use the `Compute` statement.
[* -------------------------------------------------------------------------- *)

Compute let_statement_example.

(* -------------------------------------------------------------------------- *]
 Defining functions uses the same commands, with the added notation for
 defining anonymous functions `fun ??? => ???`.
[* -------------------------------------------------------------------------- *)

Definition sum_three x y z := x + y + z.
Definition sum_three_anon := fun x y z => x + y + z.

(* -------------------------------------------------------------------------- *]
 At the start of the file we also imported the module `List` for using lists.
 The empty list is `nil` and for the constructor `cons x xs` we also have the
 sugared syntax `x :: xs`.
[* -------------------------------------------------------------------------- *)

Example list_of_ones := 1 :: 1 :: 1 :: nil.
Example raw_list_of_twos := cons 2 (cons 2 (cons 2 nil)).

(* -------------------------------------------------------------------------- *]
 We can extract data with `match` statements, where we list the patterns for
 all constructors. The `match` statement needs to be ended with the `end`
 keyword.
[* -------------------------------------------------------------------------- *)

Definition starts_with_0 lst :=
    match lst with
    | nil => false
    | 0 :: _ => true
    | _ :: _ => true
    end.

(* -------------------------------------------------------------------------- *]
 To use recursive functions we need to use `Fixpoint` instead of `Definition`.

 WARNING: Coq is VERY careful when it comes to recursion and requires to know
 that it will always terminate!
[* -------------------------------------------------------------------------- *)

Fixpoint sum_elements lst :=
    match lst with
    | nil => 0
    | x :: xs => x + sum_elements xs
    end.

(* Coq does not know how to prove that the following function terminates. *)
(*
Fixpoint double_n_times x n :=
    if n =? 0 then x else double_n_times (2*x) (n-1).
*)

(*

NOTE: `=?` is a comparison that returns a `bool`. The symbol `=` is used as
equality in propositions when proving properties.

The definition with conditionals does not work, because Coq cannot
automatically detect that the recursion will terminate.

We can instead use the match statement for natural numbers. Natural numbers are
defined with the Peano axioms, so a natural number is either 0 or a successor
`S` of a natural number.
*)

Fixpoint double_n_times x n :=
    match n with
    | 0 => x
    | S m => double_n_times (2*x) m
    end.

(* -------------------------------------------------------------------------- *]
 When defining custom types, we slowly move into the new and exciting Coq
 territory. First we (re)define the familiar `option` type.
[* -------------------------------------------------------------------------- *)

Inductive option (A : Type) :=
    | None : option A
    | Some (x : A) : option A
    .

(* Why does this not work? *)
(* Example some_one := Some 1. *)

(* Let us look at a more 'raw' definition of `option`, where we explicitly
treat it as a function that returns a type. *)
(*
Inductive option : Type -> Type :=
    | None (A : Type) : option A
    | Some (A : Type) : A -> option A
    .
*)

(* With this notation it is clearer that we must specify the type of the
constructor as well. *)
(* Example some_one := Some nat 1. *)

(* -------------------------------------------------------------------------- *]
 Supplying types directly is often cumbersome, so let us take a peek at some
 of the mechanisms that can help with that.
[* -------------------------------------------------------------------------- *)

(* We can use `_` instead of an argument and Coq will try to figure it out. *)
Example some_one := Some _ 1.

(* We can also mark arguments as implicit by using `{}` or `[]` (there is a
difference but we dont have a month to learn what the difference is). *)

Inductive opt {A : Type} :=
    | Non : opt
    | Som (x : A) : opt
    .

Example som_one := Som 1.

(* When we wish to directly supply type information, we do that by prefixing
 the type with `@`. *)

(* Coq is confused on what type of `option` this is... *)
(* Example non : opt := Non. *)

(* So we tell it. *)
Example non : @opt nat := Non.
Example also_non := @Non nat.

(* -------------------------------------------------------------------------- *]
 PRACTICE: (re)define a type for lists (use `Cons` and `Nil` for constructors).
 Then write an example (do not forget to supply types if explicit!).
[* -------------------------------------------------------------------------- *)


(* ###################################################################### *)
(** * Arithmetic Proofs *)

(** (We use [admit] and [Admitted] to hide solutions from exercises.) *)

Axiom admit : forall {T}, T.

Module Nat.

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

Check (S (S O)).

Fixpoint plus (n m : nat) : nat :=
  match n with
  | O => m
  | S n' => S (plus n' m)
  end.

Fixpoint mult (n m : nat) : nat :=
  match n with
  | O => O
  | S n' => plus m (mult n' m)
  end.

Notation "x + y" := (plus x y) (at level 50, left associativity).

Notation "x * y" := (mult x y) (at level 40, left associativity).

(** Exercise: Define exponentiation *)

Fixpoint exp (n m : nat) : nat :=
(* ADMIT *)
  match m with
  | O => S O
  | S m' => m' * exp n m'
  end.
(* /ADMIT *)

Notation "x ^ y" := (exp x y) (at level 30, right associativity).

(* Let's show that O is a left and right identity for addition. *)

Lemma plus_0_l: forall n : nat, O + n = n.
Proof.
  intros n.
  simpl.
  reflexivity.
Qed.

(* EX1 (plus_O_r) *)
Lemma plus_O_r: forall n : nat, n + O = n.
Proof.
(* ADMITTED *)
  intros n.
  induction n.
  + reflexivity.
  + simpl.
    rewrite IHn.
    reflexivity.
Qed.
(* /ADMITTED *)

(* EX1 (n_plus_S_m) *)
Theorem n_plus_S_m: forall n m, n + S m = S (n + m).
Proof.
(* ADMITTED *)
  intros n m.
  induction n as [| n' IH].
  + simpl.
    reflexivity.
  + simpl.
    rewrite IH.
    reflexivity.
Qed.
(* /ADMITTED *)

Theorem plus_assoc: forall m n o, m + (n + o) = (m + n) + o.
Proof.
  intros m n o.
  induction m as [| m' IH]. (* m is the right choice here, since [plus] is defined
                               by recursion on the first argument. *)
  + simpl.
    reflexivity.
  + simpl.
    rewrite IH.
    reflexivity.
Qed.

(* EX2 (plus_comm) *)
(* Show that plus is commutative. *)

Theorem plus_comm: forall n m, n + m = m + n.
Proof.
(* ADMITTED *)
  intros n m.
  induction n as [|n' IH].
  + simpl.
    rewrite plus_O_r.
    reflexivity.
  + simpl.
    rewrite IH.
    rewrite n_plus_S_m.
    reflexivity.
Qed.
(* /ADMITTED *)

(** Additional exercises: Show that mult has an identity
    [S O], a annihilator [O] and associative, commutative and
    distributive properties. *)

(** The next function tests whether a number [m] is equal to [n]. *)

Fixpoint beq_nat (m n : nat) : bool :=
  match m, n with
  | O, O => true
  | S m', S n' => beq_nat m' n'
  | _, _ => false
  end.

Lemma beq_nat_refl : forall n, beq_nat n n = true.
Proof.
  intros n.
  induction n as [|n IH].
  - reflexivity.
  - simpl. apply IH.
Qed.

(* EX2 (beq_nat_true). *)
(* Show the reverse direction. Remember to ensure a sufficiently general
   induction hypothesis *)
Lemma beq_nat_true :
  forall m n, beq_nat m n = true -> m = n.
Proof.
(* ADMITTED *)
  intros m n. revert n.
  induction m as [|m IH].
  - intros n. destruct n as [|n].
    + reflexivity.
    + simpl. intros H. discriminate.
  - intros n. destruct n as [|n].
    + simpl. intros H. discriminate.
    + simpl. intros H.
      rewrite (IH n). (* Note that we specify an argument to the hypothesis *)
      * reflexivity.
      * apply H.
Qed.
(* /ADMITTED *)

Definition pred (n : nat) :=
  match n with
  | O => O
  | S n => n
  end.

Fixpoint minus (m n : nat) : nat :=
  match m, n with
  | O, _ => m
  | _, O => m
  | S m', S n' => minus m' n'
  end.

Notation "x - y" := (minus x y) (at level 50, left associativity).

(** The next function tests whether a number [m] is less than or equal
    to [n]. *)

Fixpoint ble_nat (m n : nat) : bool :=
  match m, n with
  | O, _ => true
  | _, O => false
  | S n', S m' => ble_nat n' m'
  end.

(* Exercises: Show that ble_nat is reflexive, transitive and antisymmetric. *)

(** The simple definition of div fails due to Coq's termination checker,
    so we go with the more complicated one below. *)

Fail Fixpoint div (m n: nat) : nat :=
  match n with
  | O => O
  | S n' => if ble_nat n m then S (div (m - n) n) else O
  end.

Fixpoint div (m n: nat) : nat :=
  match n with
  | O => O
  | S n' => match m with
            | O => O
            | S m' => S (div (S m' - S n') (S n'))
            end
  end.

(** Here, Coq is able to figure out that [S m' - S n'] is a valid
    recursive argument because [minus] only returns results that are
    syntatic sub-terms of [m]. Unfortunately, this criterion is pretty
    fragile: replacing [m] by [O] or [S m'] in the above definition of
    [minus] causes this definition of [div] to break; try it!.

    This kind of rewriting doesn't always work, alas. We can make Coq
    accept less obvious recursive definitions by providing an
    explicit, separate proof that they always terminate, or by
    supplying an extra argument that gives an upper bound on how many
    recursive calls can be performed. We won't cover this feature here
    but you can find more about recursive definitions in Coq on the Internet. *)

Notation "x / y" := (div x y) (at level 40, left associativity).

(* EX2 (n_div_n) *)
(* Show that n / n = 1, for all n > 0.
   You will need a lemma. *)

(* SOLUTION *)
Lemma n_minus_n : forall n, n - n = O.
Proof.
  intros n.
  induction n as [|n IH].
  + reflexivity.
  + simpl.
    apply IH.
Qed.
(* /SOLUTION *)

Lemma n_div_n: forall n, ble_nat (S O) n = true -> n / n = (S O).
Proof.
(* ADMITTED *)
  intros n H.
  induction n.
  + simpl in H.
    discriminate.
  + simpl in *.
    rewrite n_minus_n.
    simpl.
    reflexivity.
Qed.
(* /ADMITTED *)

(* EX2 (factorial). *)
(* The simplest version of factorial also fails.
   Try to write a strictly decreasing factorial function. *)
Fixpoint factorial (n : nat) : nat :=
(* ADMIT *)
  match n with
  | O => S O
  | S n => S n * factorial n
  end.
(* /ADMIT *)

(** Well done!
    We know that 2^n <= fact(n) <= n^n for all n>0.
    For a challenge, try to prove both. *)

End Nat.

(** As mentioned previously, [nat] is already defined in Coq's
    standard library. Coq provides special, arabic-numeral syntax for
    [nat], which is translated in terms of the [O] and [S]
    constructors. For instance, [3] is just special syntax for [S (S
    (S O))]. Similarly: *)

Compute (S (S O)).
Compute (S (S O) + S O).

(* Additionally nat has 'less than' and 'greater than' defined as Props in
   addition to bool, using the standard syntax [x < y]. Check out the Coq
   standard library for more. *)


Theorem plus_assoc : forall n m p:nat, n+(m+p)=(n+m)+p.
Proof. intros n m p. induction n. reflexivity. simpl. rewrite -> IHn. reflexivity. Qed.
Theorem mult_0_r : forall n:nat, n*0=0.
Proof. intros n. induction n. reflexivity. simpl. rewrite IHn. reflexivity. Qed.
Theorem plus_0_r : forall n:nat, n+0=n.
Proof. intros n. induction n. reflexivity. simpl. rewrite IHn. reflexivity. Qed.
Theorem plus_comm : forall n m:nat, n+m=m+n.
Proof. intros n m. induction n. simpl. rewrite plus_0_r. reflexivity. simpl. rewrite IHn. rewrite plus_n_Sm. reflexivity. Qed.
Theorem mult_suc_r : forall n m:nat, n*(S m)=n+n*m.
Proof. induction n. reflexivity. simpl. intros m. rewrite IHn.
rewrite plus_assoc. assert (H1:m+n=n+m). rewrite plus_comm. reflexivity.
rewrite H1. rewrite plus_assoc. reflexivity. Qed.
Theorem mult_plus_distr_r : forall n m p : nat,
  (n + m) * p = (n * p) + (m * p).
Proof. induction p. rewrite mult_0_r. rewrite mult_0_r. rewrite mult_0_r. reflexivity.
rewrite mult_suc_r. rewrite mult_suc_r. rewrite mult_suc_r. rewrite IHp.
rewrite plus_assoc. rewrite plus_assoc.
assert (H0:m+n*p=n*p+m). rewrite plus_comm. reflexivity.
assert (H1:n+m+n*p=n+n*p+m). rewrite <- plus_assoc.
rewrite <- plus_assoc. rewrite H0. reflexivity.
rewrite H1. reflexivity. Qed.

Inductive bin : Type :=
 | O
 | D (b : bin)
 | P (b : bin).

(*Inductive bin' : Type :=
  | stop
  | tick (foo : bin').*)

Fixpoint incr_bin (b:bin) : bin :=
  match b with
  | O => P O
  | D b' => P b'
  | P b' => D (incr_bin b')
  end.

Fixpoint bin_to_nat (b:bin) : nat :=
  match b with
  | O => 0
  | D b' => (bin_to_nat b') * 2
  | P b' => (bin_to_nat b') * 2 + 1
  end.

Compute bin_to_nat (P (D (P O))).

Theorem incr_comm : forall b:bin, bin_to_nat(incr_bin b)=(bin_to_nat b)+1.
Proof. induction b. reflexivity. reflexivity. simpl. rewrite IHb.
rewrite mult_plus_distr_r. assert (H1:1*2=1+1). reflexivity. rewrite H1.
rewrite plus_assoc. reflexivity. Qed.

Fixpoint evenb (n:nat): bool :=
  match n with
  | 0 => true
  | S 0 => false
  | S (S n') => evenb n'
  end.

Fixpoint halve_nat (n:nat) : nat :=
  match n with
  | 0 => 0
  | S n' =>
    match n' with
    | 0 => 0
    | S n'' => S (halve_nat n'')
    end
  end.

Compute halve_nat 102.

Fixpoint nat_to_bin (n:nat) : bin :=
  match n with
  | 0 => O
  | S n' => incr_bin(nat_to_bin n')
  end.

Compute nat_to_bin 16.

Theorem S_plus : forall n:nat, S n = n+1.
Proof. intros n. induction n. reflexivity. assert (H1:S(S n)=S(n+1)). rewrite IHn. reflexivity.
rewrite H1. simpl. reflexivity. Qed.
Theorem nat_bin_nat : forall n:nat, bin_to_nat (nat_to_bin n) = n.
Proof. induction n. reflexivity. simpl. rewrite incr_comm. rewrite IHn.
rewrite <- S_plus. reflexivity. Qed.

Compute nat_to_bin (bin_to_nat (P (P (D O)))).

Definition norm_bin (b:bin) : bin := nat_to_bin (bin_to_nat b).


(*|
#################################
Explain a simple operation in Coq
#################################

:Link: https://stackoverflow.com/q/24177371
|*)

(*|
Question
********

I have the following code, Here ``O`` is the charater ``O`` not zero
``0``
|*)

Module Playground1.

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

Definition pred (n : nat) : nat :=
  match n with
  | O => O
  | S n' => n'
  end.

End Playground1.

Definition minustwo (n : nat) : nat :=
  match n with
  | O => O
  | S O => O
  | S (S n') => n'
  end.

Check (S (S (S (S O)))).
Eval compute in (minustwo 4).

(*|
I just want to know how it evaluates to ``2``? I mean how it is
actually checking with a numeral and subtracting? I am not subtracting
anything here, still it is working? I want to know what is the basic
idea here? When I call ``minustwo 4`` how Coq know it is a numeral and
how it is returning the result? How the matching is working here?
|*)

(*|
Answer
******

It is quite easy with Coq to follow step by step what is going on. But
before we can do that, we need to know what your program looks like to
Coq without all the syntactic sugar. To do that, type the following in
your program:
|*)

Set Printing All.

(*| If you now print ``minustwo``, you will see that |*)

Print minustwo. (* .unfold *)

(*|
your pattern match is actually broken up into two pattern matches.

Not let us see step by step how Coq evaluates ``minustwo 4``. To do
so, create the following theorem:
|*)

Goal (minustwo 4 = 2).

(*|
We don't care that much about the theorem itself, we care more about
the fact that it contains the term ``minustwo 4``. We can now simplify
the expression step by step (you should run this in an ide to actually
see what is going on).

First, we unfold the definition of ``minustwo``, using a tactic called
``cbv delta``.
|*)

  cbv delta. (* unfold the definition of minustwo *)

(*| We can now call the function, using the tactic ``cbv beta``. |*)

  cbv beta. (* do the function call *)

(*| We can now do the pattern match with |*)

  cbv iota; cbv beta. (* pattern match *)

(*|
And because Coq broke up the match into two, we get to do it again
|*)

  cbv iota; cbv beta. (* pattern match *)

(*| And that is why ``minustwo 4`` is ``2`` |*)

  reflexivity.
Qed.


Inductive day : Type :=
  | monday : day
  | tuesday : day
  | wednesday : day
  | thursday : day
  | friday : day
  | saturday : day
  | sunday : day.

Definition next_weekday (d:day) : day :=
  match d with
    | monday => tuesday
    | tuesday => wednesday
    | wednesday => thursday
    | thursday => friday
    | friday => monday
    | saturday => monday
    | sunday => monday
  end.

Eval compute in (next_weekday friday).
Eval compute in (next_weekday (next_weekday saturday)).

Example test_next_weekday:
  (next_weekday (next_weekday saturday)) = tuesday.
Proof. simpl. reflexivity. Qed.

Inductive bool : Type :=
  | true : bool
  | false : bool.

Definition negb (b:bool) : bool :=
  match b with
    | true => false
    | false => true
  end.

Definition andb (b1:bool) (b2:bool) :=
  match b1 with
    | true => b2
    | false => false
  end.

Definition orb (b1:bool) (b2:bool) :=
  match b1 with
    | true => true
    | false => b2
  end.

Example test_orb1: (orb true false) = true.
Proof. reflexivity. Qed.
Example test_orb2: (orb false false) = false.
Proof. reflexivity. Qed.
Example test_orb3: (orb false true) = true.
Proof. reflexivity. Qed.
Example test_orb4: (orb true true) = true.
Proof. reflexivity. Qed.

Definition nandb (b1:bool) (b2:bool) : bool :=
  match b1 with
    | true => negb b2
    | false => true
  end.

Example test_nandb1: (nandb true false) = true.
Proof. reflexivity. Qed.
Example test_nandb2: (nandb false false) = true.
Proof. reflexivity. Qed.
Example test_nandb3: (nandb false true) = true.
Proof. reflexivity. Qed.
Example test_nandb4: (nandb true true) = false.
Proof. reflexivity. Qed.

Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool :=
  match b1 with
    | true => andb b2 b3
    | false => false
  end.

Example test_andb31: (andb3 true true true) = true.
Proof. reflexivity. Qed.
Example test_andb32: (andb3 false true true) = false.
Proof. reflexivity. Qed.
Example test_andb33: (andb3 true false true) = false.
Proof. reflexivity. Qed.
Example test_andb34: (andb3 true true false) = false.
Proof. reflexivity. Qed.

Check true.
Check (negb true).
Check negb.

Module Playground1.

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

  Definition pred (n:nat) : nat :=
    match n with
      | O => O
      | S n' => n'
    end.

End Playground1.

Definition minustwo (n:nat) : nat :=
  match n with
    | O => O
    | S O => O
    | S (S n') => n'
  end.
Check (S (S (S (S O)))).
Eval compute in (minustwo 4).
Check S.
Check pred.
Check minustwo.

Fixpoint evenb (n:nat) : bool :=
  match n with
    | O => true
    | S O => false
    | S (S n') => evenb n'
  end.
Definition oddb (n:nat) : bool := negb (evenb n).
Example test_oddb1: (oddb (S O)) = true.
Proof. reflexivity. Qed.
Example test_oddb2: (oddb (S (S (S (S O))))) = false.
Proof. reflexivity. Qed.

Module Playground2.
  Fixpoint plus (n:nat) (m:nat) : nat :=
    match n with
      | O => m
      | (S n') => S (plus n' m)
    end.

  Eval compute in (plus (S (S (S O))) (S (S O))).

  Fixpoint mult (n m : nat) : nat :=
    match n with
      | O => O
      | S n' => plus m (mult n' m)
    end.

  Example test_mult1: (mult 3 3) = 9.
  Proof. reflexivity. Qed.

  Fixpoint minus (n m : nat) : nat :=
    match n, m with
      | O , _ => O
      | S _ , O => n
      | S n' , S m' => minus n' m'
    end.
End Playground2.

Fixpoint exp (base power : nat) : nat :=
  match power with
    | O => S O
    | S p => mult base (exp base p)
  end.

Fixpoint factorial (n:nat) : nat :=
  match n with
    | O => S O
    | S n' => mult n (factorial n')
  end.

Example test_factorial1: (factorial 3) = 6.
Proof. reflexivity. Qed.
Example test_factorial2: (factorial 5) = (mult 10 12).
Proof. reflexivity. Qed.

Theorem plus_0_n: forall n : nat, 0 + n = n.
Proof. intros n. reflexivity. Qed.

Theorem plus_1_1 : forall n : nat, 1 + n = S n.
Proof. intros n. reflexivity. Qed.

Fixpoint beq_nat (n m : nat) : bool :=
  match n with
    | O => match m with
             | O => true
             | S m' => false
           end
    | S n' => match m with
                | O => false
                | S m' => beq_nat n' m'
              end
  end.

Fixpoint ble_nat (n m : nat) : bool :=
  match n with
    | O => true
    | S n' =>
      match m with
        | O => false
        | S m' => ble_nat n' m'
      end
  end.

Example test_ble_nat1: (ble_nat 2 2) = true.
Proof. reflexivity. Qed.
Example test_ble_nat2: (ble_nat 2 4) = true.
Proof. reflexivity. Qed.
Example test_ble_nat3: (ble_nat 4 2) = false.
Proof. reflexivity. Qed.

Definition blt_nat (n m : nat) : bool :=
  andb (negb (beq_nat n m)) (ble_nat n m).
Example test_blt_nat1: (blt_nat 2 2) = false.
Proof. reflexivity. Qed.
Example test_blt_nat2: (blt_nat 2 4) = true.
Proof. reflexivity. Qed.
Example test_blt_nat3: (blt_nat 4 2) = false.
Proof. reflexivity. Qed.

Theorem plus_O_n: forall n : nat, 0 + n = n.
Proof.
  intros n.
  reflexivity.
Qed.

Theorem plus_1_l: forall n : nat, 1 + n = S n.
Proof.
  intros n.
  reflexivity.
Qed.

Theorem mult_0_l: forall n : nat, 0 * n = 0.
Proof.
    intros n.
    reflexivity.
Qed.

Theorem plus_id_example :
  forall (n m : nat),
    n = m -> n + n = m + m.
Proof.
  intros n m.
  intros H.
  rewrite <- H.
  reflexivity.
Qed.

Theorem plus_id_exercise :
  forall n m o : nat,
    n = m -> m = o -> n + m = m + o.
Proof.
  intros n m o.
  intros H.
  rewrite -> H.
  intros H'.
  rewrite -> H'.
  reflexivity.
Qed.

Theorem mult_0_plus :
  forall n m : nat,
    (0 + n) * m = n * m.
Proof.
  intros n m.
  rewrite -> plus_0_n.
  reflexivity.
Qed.

Theorem mult_S_1 :
  forall n m : nat,
    m = S n -> m * (1 + n) = m * m.
Proof.
  intros n m.
  intros H.
  rewrite -> plus_1_l.
  rewrite -> H.
  reflexivity.
Qed.

Theorem plus_1_neg_0 :
  forall n : nat,
    beq_nat (n + 1) 0 = false.
Proof.
  intros n.
  destruct n as [ | n'].
  reflexivity.
  reflexivity.
Qed.

Theorem negb_involutive :
  forall b : bool,
    negb (negb b) = b.
Proof.
  intros b.
  destruct b.
  reflexivity.
  reflexivity.
Qed.

Theorem zero_negb_plus_1 :
  forall n : nat,
    beq_nat 0 (n + 1) = false.
Proof.
  intros n.
  destruct n as [ | n'].
  reflexivity.
  reflexivity.
Qed.

Theorem identity_fn_applied_twice :
  forall (f : bool -> bool),
    (forall x : bool, f x = x) -> (forall b : bool, f (f b) = b).
Proof.
  intros f.
  intros H.
  intros b.
  rewrite -> H.
  rewrite -> H.
  reflexivity.
Qed.

Theorem negation_fn_applied_twice :
  forall (f : bool -> bool),
    (forall x : bool, f x = negb x) -> (forall b : bool, f (f b) = b).
Proof.
  intros f.
  intros H.
  intros b.
  rewrite -> H.
  rewrite -> H.
  rewrite -> negb_involutive.
  reflexivity.
Qed.

Theorem andb_eq_orb :
  forall (b c : bool),
    (andb b c = orb b c) -> b = c.
Proof.
  intros b c.
  destruct b.
  destruct c.
  reflexivity.
  simpl.
  intros H.
  rewrite -> H.
  reflexivity.
  simpl.
  intros H.
  rewrite -> H.
  reflexivity.
Qed.

Inductive bin : Type :=
  | Zero : bin
  | Odd : bin -> bin
  | Even : bin -> bin.

Definition inc_bin (n : bin) : bin :=
  match n with
    | Zero => Odd Zero
    | Odd _ => Even n
    | Even _ => Odd n
  end.

Example inc_bin1: inc_bin Zero = Odd Zero.
Proof. reflexivity. Qed.
Example inc_bin2: inc_bin (inc_bin Zero) = Even (Odd Zero).
Proof. reflexivity. Qed.
Example inc_bin4: inc_bin (inc_bin (inc_bin Zero)) = Odd (Even (Odd Zero)).
Proof. reflexivity. Qed.
Example inc_bin5: inc_bin (Even (Odd Zero)) = Odd (Even (Odd Zero)).
Proof. reflexivity. Qed.

Fixpoint bin_to_nat (n : bin) : nat :=
  match n with
    | Zero => O
    | Odd n' => S (bin_to_nat n')
    | Even n' => S (bin_to_nat n')
  end.

Example bin_to_nat1: bin_to_nat Zero = 0.
Proof. reflexivity. Qed.
Example bin_to_nat2: bin_to_nat (Odd Zero) = 1.
Proof. reflexivity. Qed.
Example bin_to_nat5: bin_to_nat (Odd (Even (Odd (Even (Odd Zero))))) = 5.
Proof. reflexivity. Qed.