 (* by Evelyne Contejean *)
(** * Permutation over lists, and finite multisets. *)

Set Implicit Arguments.

From Cyclic_PA.Casteran Require Import decidable_set.
Require Import List.
From Cyclic_PA.Casteran Require Import more_list.
Require Import Multiset.
Require Import Arith.
Require Import Setoid.

Module Type Permut.

Declare Module DS : decidable_set.S.

Definition elt := DS.A.
Definition eq_elt_dec := DS.eq_A_dec.

Fixpoint list_to_multiset (l : list elt) {struct l} : multiset elt :=
  match l with
  | nil => EmptyBag elt
  | h :: tl =>
      munion (SingletonBag _ eq_elt_dec h) (list_to_multiset tl)
  end.

Definition list_permut (l1 l2:list elt) : Prop :=
  meq (list_to_multiset l1) (list_to_multiset l2).

End Permut.

(** ** Definition of permutation over lists. *)
Module Make (DS1 : decidable_set.S) <: Permut with Module DS:= DS1.

Module DS := DS1.
Import DS1.

Definition elt := DS.A.
Definition eq_elt_dec : forall t1 t2 : elt, {t1 = t2} + {t1 <> t2} := DS.eq_A_dec.

Fixpoint list_to_multiset (l : list elt) {struct l} : multiset elt :=
  match l with
  | nil => EmptyBag elt
  | h :: tl =>
      munion (SingletonBag _ eq_elt_dec h) (list_to_multiset tl)
  end.

Definition list_permut (l1 l2:list elt) : Prop :=
  meq (list_to_multiset l1) (list_to_multiset l2).

(** Properties over the multiplicity. *)
Lemma multiplicity_app :
 forall (l1 l2:list elt) (t : elt),
   multiplicity (list_to_multiset (l1 ++ l2)) t =
   multiplicity (list_to_multiset l1) t + multiplicity (list_to_multiset l2) t.
Proof.
induction l1; intros; trivial.
simpl; intros; rewrite (IHl1 l2 t); auto with arith.
Qed.

Lemma out_mult_O :
  forall (t : elt) (l:list elt), ~ In t l -> multiplicity (list_to_multiset l) t = 0.
Proof.
intro t; unfold list_to_multiset; induction l.
intros _; trivial.
intro H; simpl; elim (eq_elt_dec a t).
intro; subst t; absurd (In a (a :: l)); trivial; left; trivial.
intros _; apply IHl;
unfold not; intros; apply H;
simpl; right; assumption.
Qed.

Lemma in_mult_S :
 forall (t : elt) (l : list elt), In t l -> multiplicity (list_to_multiset l) t >= 1.
Proof.
intro t; unfold list_to_multiset; induction l.
contradiction.
simpl; intro H; elim H; clear H.
intro H; subst t; elim (eq_elt_dec a a).
intros _ ; auto with arith.
intro; absurd (a=a); trivial.
elim (eq_elt_dec a t).
intros _ _; auto with arith.
intros; simpl; apply IHl; assumption.
Qed.

(** ** Permutation is a equivalence relation.
Reflexivity. *)
Theorem list_permut_refl :
 forall (l : list elt), list_permut l l.
Proof.
unfold list_permut, meq; intros; trivial.
Qed.

(** Symetry. *)
Theorem list_permut_sym :
 forall l1 l2 : list elt, list_permut l1 l2 -> list_permut l2 l1.
Proof.
unfold list_permut, meq; intros; apply sym_eq; trivial.
Qed.

Hint Immediate list_permut_refl.
Hint Resolve list_permut_sym.

(** Transitivity. *)
Theorem list_permut_trans :
  forall l1 l2 l3 : list elt, list_permut l1 l2 -> list_permut l2 l3 -> list_permut l1 l3.
Proof.
unfold list_permut, meq; intros;
apply trans_eq with (multiplicity (list_to_multiset l2) a); trivial.
Qed.

Add Relation (list elt) list_permut
reflexivity proved by list_permut_refl
symmetry proved by list_permut_sym
transitivity proved by list_permut_trans as LP.

(** Permutation of an empty list. *)
Lemma list_permut_nil :
 forall l, list_permut l nil -> l = nil.
Proof.
intro l; destruct l as [ | e l ]; trivial.
intros Abs; absurd (list_permut (e :: l) nil); trivial.
unfold not; unfold list_permut, meq; intro H;
generalize (H e); simpl; elim (eq_elt_dec e e).
intros _; discriminate.
intro; absurd (e=e); trivial.
Qed.

(** ** Compatibility Properties.
 Permutation is compatible with In. *)
Lemma in_permut_in :
  forall l1 l2 e, In e l1 -> list_permut l1 l2 -> In e l2.
Proof.
unfold list_permut, meq; intros l1 l2 e Inel1 Pl1l2.
elim (In_dec eq_elt_dec e l2).
intros; trivial.
intro notInel2; generalize (Pl1l2 e);
rewrite (out_mult_O e l2 notInel2);
intro M0; generalize (in_mult_S e l1 Inel1);
rewrite M0; unfold ge;
intro Abs; absurd (1<=0); trivial; inversion Abs.
Save in_permut_in.

Add Morphism (In (A :=elt)) : in_morph.
Proof.
intros; split; intros.
apply in_permut_in with x; trivial.
apply in_permut_in with y0; trivial; apply list_permut_sym; trivial.
Qed.

Lemma cons_permut_in :
  forall l1 l2 e, list_permut (e :: l1) l2 -> In e l2.
Proof.
intros l1 l2 e P; setoid_rewrite <- P; left; trivial.
Qed.

(** Permutation is compatible with adding an element. *)
Lemma context_list_permut_cons :
  forall e l1 l2, list_permut l1 l2 -> list_permut (e :: l1) (e :: l2).
Proof.
intros e l1 l2; unfold list_permut, meq; simpl.
intros H a; rewrite (H a); trivial.
Save context_list_permut_cons.

Add Morphism (List.cons (A:=elt)) : add_elt_morph.
Proof.
intros; apply context_list_permut_cons; trivial.
Qed.

Lemma list_permut_add_inside :
forall a l1 l2 l3 l4,
  list_permut (l1 ++ l2) (l3 ++ l4) ->
  list_permut (l1 ++ a :: l2) (l3 ++ a :: l4).
Proof.
intros a l1 l2 l3 l4; unfold list_permut, meq; simpl;
intros H b; generalize (H b); clear H;
repeat rewrite multiplicity_app; simpl;
intro H; rewrite plus_comm; rewrite <- plus_assoc; apply sym_eq;
rewrite plus_comm; rewrite <- plus_assoc;
apply (f_equal (fun n => match eq_elt_dec a b with
                         | left _ => 1
                         | right _ => 0 end + n));
rewrite plus_comm; rewrite <- H; apply plus_comm.
Qed.

Lemma list_permut_add_cons_inside :
forall a l l1 l2,
  list_permut l (l1 ++ l2) ->
  list_permut (a :: l) (l1 ++ a :: l2).
Proof.
intros;
replace (a :: l) with (nil ++ a :: l); trivial;
apply list_permut_add_inside; trivial.
Qed.

(** Permutation is compatible with append. *)
Lemma context_list_permut_app1 :
  forall l l1 l2, list_permut l1 l2 -> list_permut (l ++ l1) (l ++ l2).
Proof.
intros l l1 l2; unfold list_permut, meq; simpl.
intros H a;
rewrite (multiplicity_app l l1);
rewrite (multiplicity_app l l2);
rewrite (H a);
trivial.
Qed.

Lemma context_list_permut_app2 :
  forall l l1 l2, list_permut l1 l2 -> list_permut (l1 ++ l) (l2 ++ l).
Proof.
intros l l1 l2; unfold list_permut, meq; simpl; intros H a;
rewrite (multiplicity_app l1 l);
rewrite (multiplicity_app l2 l);
rewrite (H a);
trivial.
Save context_list_permut_app2.

Add Morphism (List.app (A:=elt)) : app_morph.
Proof.
intros.
apply list_permut_trans with (x ++ y0).
apply context_list_permut_app1; trivial.
apply context_list_permut_app2; trivial.
Qed.

Lemma list_permut_app_app :
 forall l1 l2, list_permut (l1 ++ l2) (l2 ++ l1).
Proof.
intros l1 l2;
unfold list_permut, meq;
intro a; rewrite multiplicity_app; rewrite multiplicity_app;
apply plus_comm.
Qed.

(** Permutation is compatible with removal of common elements *)
Lemma remove_context_list_permut_cons :
  forall e l1 l2, list_permut (e :: l1) (e :: l2) -> list_permut l1 l2.
Proof.
intros e l1 l2; unfold list_permut, meq; simpl; intros H a;
generalize (H a); apply plus_reg_l.
Qed.

Lemma remove_context_list_permut_app2 :
  forall l l1 l2, list_permut (l1 ++ l) (l2 ++ l) -> list_permut l1 l2.
Proof.
intros l l1 l2; unfold list_permut, meq; simpl;
intros H a; generalize (H a);
rewrite (multiplicity_app l1 l);
rewrite (multiplicity_app l2 l);
intros; apply plus_reg_l with (multiplicity (list_to_multiset l) a).
rewrite plus_comm; rewrite H0; rewrite plus_comm.
trivial.
Qed.

Lemma list_permut_remove_hd :
  forall l l1 l2 a,
  list_permut (a :: l) (l1 ++ a :: l2) -> list_permut l (l1 ++ l2).
Proof.
intros l l1 l2 a; unfold list_permut, meq; simpl; intros H a0; generalize (H a0);
rewrite multiplicity_app; rewrite multiplicity_app;
simpl; intro H1;
apply plus_reg_l with (match eq_elt_dec a a0 with left _ => 1 | right _ => 0 end);
rewrite H1; repeat rewrite plus_assoc;
apply (f_equal (fun n => n + multiplicity (list_to_multiset l2) a0));
apply plus_comm.
Qed.

(** Permutation is compatible with length. *)
Lemma list_permut_length :
 forall l1 l2, list_permut l1 l2 -> length l1 = length l2.
Proof.
induction l1; intros l2 H.
rewrite (list_permut_nil (list_permut_sym H)); auto.
elim (In_dec eq_elt_dec a l2).
intro Inal2; generalize (split_list_app_cons eq_elt_dec a l2 Inal2);
destruct (split_list eq_elt_dec l2 a); intro; subst l2.
rewrite list_app_length; simpl;
rewrite (IHl1 _ (list_permut_remove_hd l l0 H));
rewrite list_app_length; auto with arith.
intro notInal2; absurd (In a l2); trivial;
apply in_permut_in with (a :: l1); trivial;
left; trivial.
Qed.

Add Morphism (length (A:=elt)) : length_morph.
Proof.
apply list_permut_length.
Qed.

(** Permutation is compatible with size. *)
Lemma list_permut_size :
  forall size l1 l2, list_permut l1 l2 -> list_size size l1 = list_size size l2.
Proof.
intro size; induction l1.
intros l2 P;
rewrite (list_permut_nil (list_permut_sym P));
trivial.
intros l2 P;
generalize (split_list_app_cons eq_elt_dec _ _ (cons_permut_in P));
destruct (split_list eq_elt_dec l2 a); intro; subst l2;
rewrite list_size_app; simpl;
rewrite (IHl1 _ (list_permut_remove_hd _ _ P));
rewrite list_size_app;
rewrite plus_comm; rewrite <- plus_assoc;
apply (f_equal (fun n => list_size size l + n));
apply plus_comm.
Qed.

Add Morphism (fun size => list_size (A:=elt) size) : list_size_morph.
Proof.
intros x y H x0. unfold Morphisms.pointwise_relation in H. induction x0.
- intros. rewrite (list_permut_nil (list_permut_sym H0)) in *. auto.
- intros. simpl. rewrite H. pose (in_permut_in a (in_eq _ x0) H0). apply In_split in i. destruct i as [l1 [l2 HL]]. rewrite HL in *.
  apply list_permut_remove_hd in H0. rewrite (IHx0 _ H0). rewrite list_size_app. rewrite list_size_app. simpl.
  rewrite (plus_comm (y a) (list_size y l2)). rewrite (plus_assoc (list_size y l1)). rewrite plus_comm. auto.
Qed.

(** Permutation is compatible with map. *)
Lemma list_permut_map :
  forall f l1 l2, list_permut l1 l2 -> list_permut (map f l1) (map f l2).
Proof.
intros f l1; induction l1.
intros l2 P; rewrite (list_permut_nil (list_permut_sym P)); apply list_permut_refl.
intros l2 P;
generalize (split_list_app_cons eq_elt_dec _ _ (cons_permut_in P));
destruct (split_list eq_elt_dec l2 a); intro; subst l2.
rewrite map_app; simpl;
apply list_permut_add_cons_inside; rewrite <- map_app;
apply (IHl1 _ (list_permut_remove_hd l l0 P)).
Qed.

Add Morphism (fun l => fun f : elt -> elt => map f l) : map_morph.
Proof.
intros x. induction x.
- intros. rewrite (list_permut_nil (list_permut_sym H)) in *. auto.
- intros. simpl. rewrite H0. pose (in_permut_in a (in_eq _ x) H). apply In_split in i. destruct i as [l1 [l2 HL]]. rewrite HL in *.
  apply list_permut_remove_hd in H. rewrite (IHx _ H _ _ H0). rewrite map_app. rewrite map_app. simpl. apply list_permut_add_cons_inside. apply list_permut_refl.
Qed.

(** ** Permutation for short lists. *)

Lemma list_permut_length_1:
 forall a b, list_permut (a :: nil) (b :: nil)  -> a = b.
Proof.
intros a b; unfold list_permut, meq; intro P;
generalize (P a); clear P; simpl.
elim (eq_elt_dec a a).
intros _; elim (eq_elt_dec b a).
intros b_eq_a _; apply sym_eq; trivial.
intros _ Abs; simpl in Abs; absurd (1=0); trivial; discriminate.
intro; absurd (a=a); trivial.
Qed.

Lemma list_permut_length_2 :
 forall a1 b1 a2 b2, list_permut (a1 :: b1 :: nil) (a2 :: b2 :: nil) ->
 (a1=a2 /\ b1=b2) \/ (a1=b2 /\ a2=b1).
Proof.
intros a1 b1 a2 b2 P; elim (cons_permut_in P).
intro; subst a2; left; split; trivial.
apply list_permut_length_1; apply remove_context_list_permut_cons with a1; trivial.
intro H; elim H; clear H.
intro; subst b2; right; split; trivial.
apply sym_eq; apply list_permut_length_1;
apply (list_permut_remove_hd (a2 :: nil) nil P).
intro;  contradiction.
Qed.

(** ** Link with AC syntactic decomposition.*)
Lemma ac_syntactic_aux :
 forall (l1 l2 l3 l4 : list elt),
 list_permut (l1 ++ l2) (l3 ++ l4) ->
 (exists u1, exists u2, exists u3, exists u4,
 list_permut l1 (u1 ++ u2) /\
 list_permut l2 (u3 ++ u4) /\
 list_permut l3 (u1 ++ u3) /\
 list_permut l4 (u2 ++ u4)).
Proof.
induction l1.
intros l2 l3 l4 P;
exists (nil : list elt); exists (nil : list elt); exists l3; exists l4;
simpl; intuition.

intros l2 l3 l4 P; rewrite <- app_comm_cons in P;
elim (in_app_or l3 l4 a (cons_permut_in P)); intro In_a;
generalize (split_list_app_cons eq_elt_dec a _ In_a).
destruct (split_list eq_elt_dec l3 a); intro; subst l3;
rewrite app_ass in P; rewrite <- app_comm_cons in P;
generalize (list_permut_remove_hd _ _ P); clear P;
intro P; rewrite <- app_ass in P;
elim (IHl1 l2 (l ++ l0) l4 P); clear IHl1 P;
intros u1 H; elim H; clear H;
intros u2 H; elim H; clear H;
intros u3 H; elim H; clear H;
intros u4 P; elim P; clear P;
intros P1 P; elim P; clear P;
intros P2 P; elim P; clear P;
intros P3 P4;
exists (a :: u1); exists u2; exists u3; exists u4; intuition; simpl; trivial.
(* setoid_rewrite <- P1. *)
apply context_list_permut_cons; trivial.
apply list_permut_sym; apply list_permut_add_cons_inside;
apply list_permut_sym; trivial.

destruct (split_list eq_elt_dec l4 a); intro; subst l4;
rewrite <- app_ass in P;
generalize (list_permut_remove_hd _ _ P); clear P;
intro P; rewrite app_ass in P;
elim (IHl1 l2 l3 (l ++ l0) P); clear IHl1 P;
intros u1 H; elim H; clear H;
intros u2 H; elim H; clear H;
intros u3 H; elim H; clear H;
intros u4 P; elim P; clear P;
intros P1 P; elim P; clear P;
intros P2 P; elim P; clear P;
intros P3 P4;
exists u1; exists (a :: u2); exists u3; exists u4; intuition; simpl; trivial.
apply list_permut_add_cons_inside; trivial.
apply list_permut_sym; apply list_permut_add_cons_inside;
apply list_permut_sym; trivial.
Qed.

Lemma ac_syntactic :
 forall (l1 l2 l3 l4 : list elt),
 list_permut (l2 ++ l1) (l4 ++ l3) ->
 (exists u1, exists u2, exists u3, exists u4,
 list_permut l1 (u1 ++ u2) /\
 list_permut l2 (u3 ++ u4) /\
 list_permut l3 (u1 ++ u3) /\
 list_permut l4 (u2 ++ u4)).
Proof.
intros l1 l2 l3 l4 P; apply ac_syntactic_aux.
apply list_permut_trans with (l2 ++ l1).
apply list_permut_app_app.
apply list_permut_trans with (l4 ++ l3); trivial.
apply list_permut_app_app.
Qed.

Lemma list_permut_dec : forall l1 l2, {list_permut l1 l2}+{~list_permut l1 l2}.
Proof.
intro l1; induction l1 as [ | e1 l1].
destruct l2 as [ | e2 l2].
left; apply list_permut_refl.
right; intro P; assert (H := list_permut_length P); discriminate.
intro l2; destruct (In_dec eq_elt_dec e1 l2) as [e1_in_l2 | e1_not_in_l2].
generalize (split_list_app_cons eq_elt_dec _ _ e1_in_l2); clear e1_in_l2;
destruct (split_list eq_elt_dec l2 e1) as [l2' l2'']; intro; subst.
destruct (IHl1 (l2' ++ l2'')) as [P | nP].
left; apply list_permut_add_cons_inside; trivial.
right; intro P; apply nP; apply list_permut_remove_hd with e1; trivial.
right; intro P; apply e1_not_in_l2; apply in_permut_in with (e1 :: l1); trivial;
left; trivial.
Qed.

End Make.

(* With section instead of module, and then polymorph use
Section LP.
Variable elt : Set.
Parameter eq_elt_dec : forall t1 t2 : elt, {t1 = t2} + {t1 <> t2}.
...
End LP.

Add Relation list list_permut
reflexivity proved by list_permut_refl
symmetry proved by list_permut_sym
transitivity proved by list_permut_trans as LP_poly.

Add Morphism In with signature  eq ==> list_permut ==> iff as in_morph_poly.
Proof.
intros; split; intros.
apply in_permut_in with x1; trivial.
apply in_permut_in with x2; trivial; apply list_permut_sym; trivial.
Qed.

Goal forall (a b:nat), list_permut (a::b::nil) (b::a::nil) ->
In a (b :: a :: nil).
intros a b P.
setoid_rewrite <- P.
left; trivial.
Qed.
*)

(*
Extract Constant eq_element_dec => eq.
Extract Constant o_element_dec => le.
Extract Constant element => int.
Extraction split_list.
Extraction partition.
Extraction NoInline partition.
Extraction quicksort.
*)


(* week_38c_mystery_functions.v *)
(* dIFP 2014-2015, Q1, Week 38 *)
(* Olivier Danvy <danvy@cs.au.dk> *)

(* ********** *)

(* Are the following specifications unique?
   What are then the corresponding functions?

   Spend the rest of your dIFP weekly time
   to answer these questions
   for the specifications below.
   (* At least 7 specifications would be nice. *)
*)

(* ********** *)
Require Import Arith List.
Require Import unfold_tactic.

(* Helper stuff *)

Lemma unfold_plus_bc :
  forall j : nat,
    plus 0 j = j.
Proof.
  unfold_tactic plus.
Qed.

Lemma unfold_plus_ic :
  forall i' j : nat,
    plus (S i') j = S (plus i' j).
Proof.
  unfold_tactic plus.
Qed.

(* Helper for later *)
Proposition plus_1_S :
  forall n : nat,
    S n = plus 1 n.
Proof.
  intro n.
  induction n as [ | n' IHn'].

  (* Base case: *)
    rewrite -> (plus_0_r 1).
    reflexivity.

  (* Inductive case: *)
    rewrite -> (unfold_plus_ic 0 (S n')).
    rewrite -> (plus_0_l (S n')).
    reflexivity.
Qed.

Proposition plus_S_1 :
  forall n : nat,
    S n = plus n 1.
Proof.
  intro.
  induction n as [ | n' IHn'].

  (* Base case: *)
    rewrite -> (plus_0_l 1).
    reflexivity.

  (* Inductive case: *)
    rewrite -> (unfold_plus_ic n' 1).
    rewrite -> (IHn').
    reflexivity.
Qed.

Lemma unfold_mult_bc :
  forall y : nat,
    0 * y = 0.
(* left-hand side in the base case
   =
   the corresponding conditional branch *)
Proof.
  unfold_tactic mult.
Qed.

Lemma unfold_mult_ic :
  forall x' y : nat,
    (S x') * y = y + (x' * y).
(* left-hand side in the inductive case
   =
   the corresponding conditional branch *)
Proof.
  unfold_tactic mult.
Qed.

Lemma nat_ind2 :
  forall P : nat -> Prop,
    P 0 ->
    P 1 ->
    (forall i : nat,
      P i -> P (S i) -> P (S (S i))) ->
    forall n : nat,
      P n.
Proof.
  intros P H_P0 H_P1 H_PSS n.
  assert(consecutive :
           forall x : nat,
             P x /\ P (S x)).
    intro x.
    induction x as [ | x' [IHx' IHSx']].
      split.
        exact H_P0.
      exact H_P1.

      split.
        exact IHSx'.
      exact (H_PSS x' IHx' IHSx').

      destruct (consecutive n) as [ly _].

      exact ly.
Qed.

Definition specification_of_the_mystery_function_0 (f : nat -> nat) :=
  (f 0 = 1)
  /\
  (forall i j : nat,
    f (S (i + j)) = f i + f j).

Proposition there_is_only_one_mystery_function_0 :
  forall f g : nat -> nat,
    specification_of_the_mystery_function_0 f ->
    specification_of_the_mystery_function_0 g ->
    forall n : nat,
      f n = g n.
Proof.
  intros f g.
  unfold specification_of_the_mystery_function_0.
  intros [H_mys_bc1 H_mys_ic1].
  intros [H_mys_bc2 H_mys_ic2].
  intro n.
  induction n as [ | n' IHn'].
  (* Base case: *)
    rewrite -> (H_mys_bc1).
    rewrite -> (H_mys_bc2).
    reflexivity.

  (* Inductive case: *)
    rewrite <- (plus_0_r n').
    rewrite -> (H_mys_ic1 n' 0).
    rewrite -> (H_mys_ic2 n' 0).
    rewrite -> (H_mys_bc1).
    rewrite -> (H_mys_bc2).
    rewrite -> (IHn').
    reflexivity.
Qed.

Theorem and_the_mystery_function_0_is_dot_dot_dot :
  specification_of_the_mystery_function_0 S.
Proof.

  unfold specification_of_the_mystery_function_0.
  split.
    reflexivity.

    intros i j.
    rewrite -> (plus_1_S).
    rewrite -> (plus_S_1).
    rewrite -> (plus_1_S).
    rewrite -> (plus_assoc 1 i j).
    Check(plus_1_S).
    rewrite <- (plus_1_S i).
    rewrite <- (plus_assoc (S i) j 1).
    rewrite <- (plus_S_1 j).
    reflexivity.
Qed.

(* ********** *)

Definition specification_of_the_mystery_function_1 (f : nat -> nat) :=
  (f 0 = 0)
  /\
  (forall i j : nat,
    f (i + S j) = f i + S (f j)).

Proposition there_is_only_one_mystery_function_1 :
  forall f g : nat -> nat,
    specification_of_the_mystery_function_1 f ->
    specification_of_the_mystery_function_1 g ->
    forall n : nat,
      f n = g n.
Proof.
  intros f g.
  unfold specification_of_the_mystery_function_1.
  intros [H_f_bc H_f_ic].
  intros [H_g_bc H_g_ic].
  intro n.
  induction n as [ | n' IHn'].

  (* Base case: *)
    rewrite -> (H_f_bc).
    rewrite -> (H_g_bc).
    reflexivity.

  (* Inductive case: *)
    rewrite <- (plus_0_l (S n')).
    rewrite -> (H_f_ic).
    rewrite -> (H_g_ic).
    rewrite -> (H_f_bc).
    rewrite -> (H_g_bc).
    rewrite (IHn').
    reflexivity.
Qed.

Theorem and_the_mystery_function_1_is_id :
  specification_of_the_mystery_function_1 id.
Proof.
  unfold specification_of_the_mystery_function_1.
  split.

    reflexivity.

    intros i j.
    unfold id.
    reflexivity.
Qed.

(* ********** *)

Definition specification_of_the_mystery_function_2 (f : nat -> nat) :=
  (f 0 = 0)
  /\
  (forall i j : nat,
    f (S (i + j)) = S (f i) + S (f j)).

Proposition there_is_only_one_mystery_function_2 :
  forall f g : nat -> nat,
    specification_of_the_mystery_function_2 f ->
    specification_of_the_mystery_function_2 g ->
    forall n : nat,
      f n = g n.
Proof.
  intros f g.
  unfold specification_of_the_mystery_function_2.
  intros [H_f_bc H_f_ic].
  intros [H_g_bc H_g_ic].
  intro n.
  induction n as [ | n' IHn'].

  (* Base case: *)

    rewrite -> (H_f_bc).
    rewrite -> (H_g_bc).
    reflexivity.

  (* Inductive case: *)
    Check(plus_n_Sm).
    rewrite <- (plus_0_l (S n')).
    rewrite <- (plus_n_Sm 0 n').
    rewrite -> (H_f_ic).
    rewrite -> (H_g_ic).
    rewrite -> (H_f_bc).
    rewrite -> (H_g_bc).
    rewrite -> (IHn').
    reflexivity.
Qed.

Theorem and_the_mystery_function_2_is_mult_2 :
  specification_of_the_mystery_function_2 (mult 2).
Proof.
  unfold specification_of_the_mystery_function_2.
  split.

    rewrite -> (mult_0_r 2).
    reflexivity.

    intros i j.
    rewrite -> (plus_n_Sm i j).
    rewrite <- (plus_0_r j).
    rewrite -> (plus_n_Sm j 0).
    rewrite -> (plus_assoc i j 1).
    rewrite -> (plus_0_r j).
    rewrite <- (plus_0_r (2*i)).
    rewrite -> (plus_n_Sm (2*i) 0).
    rewrite <- (plus_0_r (2*j)).
    rewrite -> (plus_n_Sm (2*j) 0).
    rewrite <- (plus_assoc i j 1).
    rewrite -> (plus_comm j 1).
    rewrite -> (plus_assoc i 1 j).
    rewrite -> (mult_plus_distr_l 2 (i+1) j).
    rewrite -> (mult_plus_distr_l 2 i 1).
    rewrite -> (plus_comm (2*j) 1).
    rewrite -> (plus_assoc (2*i+1) 1 (2*j)).
    rewrite -> (mult_1_r 2).
    Check(plus_assoc).
    rewrite <- (plus_assoc (2*i) 1 1).
    rewrite <- (plus_1_S 1).
    reflexivity.
Qed.

(* ********** *)

Definition specification_of_the_mystery_function_3 (f : nat -> nat) :=
  (f 0 = 1)
  /\
  (forall i j : nat,
    f (S (i + j)) = S (f i) + S (f j)).

Proposition there_is_only_one_mystery_function_3 :
  forall f g : nat -> nat,
    specification_of_the_mystery_function_3 f ->
    specification_of_the_mystery_function_3 g ->
    forall n : nat,
      f n = g n.
Proof.
  intros f g.
  unfold specification_of_the_mystery_function_3.
  intros [H_f_bc H_f_ic].
  intros [H_g_bc H_g_ic].
  intro n.
  induction n as [ | n' IHn'].

  (* Base case: *)

    rewrite -> (H_f_bc).
    rewrite -> (H_g_bc).
    reflexivity.

  (* Inductive case: *)

    rewrite <- (plus_0_l (S n')).
    rewrite <- (plus_n_Sm 0 n').
    rewrite -> (H_f_ic).
    rewrite -> (H_g_ic).
    rewrite -> (H_f_bc).
    rewrite -> (H_g_bc).
    rewrite -> (IHn').
    reflexivity.
Qed.

Theorem and_the_mystery_function_3_is_mult_3_plus_1 :
  specification_of_the_mystery_function_3 (fun x => (3*x +1)).
Proof.
  unfold specification_of_the_mystery_function_3.
  split.

    rewrite -> (mult_0_r).
    rewrite -> (plus_0_l).
    reflexivity.

    intros i j.
    rewrite -> (plus_S_1 (i + j)).
    rewrite -> (mult_plus_distr_l).
    rewrite -> (mult_plus_distr_l).
    rewrite -> (plus_S_1 (3*i + 1)).
    rewrite -> (plus_1_S (3*j + 1)).
    rewrite <- (plus_assoc (3*i) 1 1).
    rewrite <- (plus_1_S 1).
    rewrite -> (mult_1_r 3).
    rewrite <- (plus_assoc (3*i + 3*j) 3 1).
    rewrite <- (plus_S_1 3).
    rewrite -> (plus_comm (3*j) 1).
    rewrite -> (plus_assoc 1 1 (3*j)).
    rewrite <- (plus_S_1 1).
    rewrite -> (plus_assoc (3*i + 2) 2 (3 * j)).
    rewrite <- (plus_assoc (3*i) 2 2).
    rewrite <- (plus_n_Sm 2 1).
    rewrite <- (plus_n_Sm 2 0).
    rewrite -> (plus_0_r 2).
    rewrite <- (plus_assoc (3*i) 4 (3*j)).
    rewrite -> (plus_comm 4 (3*j)).
    rewrite -> (plus_assoc (3*i) (3*j) 4).
    reflexivity.
Qed.

(* ********** *)

Definition specification_of_the_mystery_function_4 (f : nat -> nat) :=
  (f 0 = 0)
  /\
  (forall i j : nat,
    f (i + j) = f i + f j).

Proposition there_is_only_one_mystery_function_4 :
  forall f g : nat -> nat,
    specification_of_the_mystery_function_4 f ->
    specification_of_the_mystery_function_4 g ->
    forall n : nat,
      f n = g n.
Proof.
  intros f g.
  unfold specification_of_the_mystery_function_4.
  intros [H_f_bc H_f_ic].
  intros [H_g_bc H_g_ic].
  intro n.
  induction n as [ | n' IHn'].

  (* Base case: *)

    rewrite -> (H_f_bc).
    rewrite -> (H_g_bc).
    reflexivity.

  (* Inductive case: *)

    rewrite -> (plus_1_S n').
    rewrite -> (H_f_ic).
    rewrite -> (H_g_ic).
    rewrite -> (plus_1_S 0).
Abort.

Theorem possible_mystery_function_4_is_plus_0 :
  specification_of_the_mystery_function_4 (plus 0).
Proof.
  unfold specification_of_the_mystery_function_4.
  split.
    rewrite -> (plus_0_l).
    reflexivity.

    intros i j.
    rewrite ->3 (plus_0_l).
    reflexivity.
Qed.

Theorem another_possibility_for_mystery_function_4_is_mult_1 :
  specification_of_the_mystery_function_4 (mult 1).
Proof.
  unfold specification_of_the_mystery_function_4.
  split.
    rewrite -> (mult_0_r).
    reflexivity.

    intros i j.
    rewrite ->3 (mult_1_l).
    reflexivity.
Qed.

Theorem and_the_mystery_function_4_is_mult_id :
  specification_of_the_mystery_function_4 id.
Proof.
  unfold specification_of_the_mystery_function_4.
  split.

    unfold id.
    reflexivity.

    intros i j.
    unfold id.
    reflexivity.
Qed.

(* ********** *)

Lemma binomial_2 :
  forall x y : nat,
    (x + y) * (x + y) = (x * x) + 2 * x * y + (y * y).
Proof.
  intros x y.

  rewrite -> mult_plus_distr_r.
  rewrite -> mult_plus_distr_l.
  rewrite -> mult_plus_distr_l.
  rewrite -> (mult_comm y x).
  symmetry.

  rewrite -> (unfold_mult_ic 1 x).
  rewrite -> (unfold_mult_ic 0 x).
  rewrite -> unfold_mult_bc.
  rewrite -> plus_0_r.
  rewrite -> mult_plus_distr_r.
  rewrite -> plus_assoc.
  rewrite -> plus_assoc.
  reflexivity.
Qed.

Definition specification_of_the_mystery_function_5 (f : nat -> nat) :=
  (f 0 = 0)
  /\
  (forall i : nat,
    f (S i) = S (2 * i + f i)).

Proposition there_is_only_one_mystery_function_5 :
  forall f g : nat -> nat,
    specification_of_the_mystery_function_5 f ->
    specification_of_the_mystery_function_5 g ->
    forall n : nat,
      f n = g n.
Proof.
  intros f g.
  unfold specification_of_the_mystery_function_5.
  intros [H_f_bc H_f_ic].
  intros [H_g_bc H_g_ic].
  intro n.
  induction n as [ | n' IHn'].

  (* Base case: *)

    rewrite -> (H_f_bc).
    rewrite -> (H_g_bc).
    reflexivity.

  (* Inductive case: *)

    rewrite -> (H_f_ic).
    rewrite -> (H_g_ic).
    rewrite (IHn').
    reflexivity.
Qed.

Theorem and_the_mystery_function_5_is_square :
  specification_of_the_mystery_function_5 (fun x => x * x).
Proof.
  unfold specification_of_the_mystery_function_5.
  split.
    rewrite -> (mult_0_r).
    reflexivity.

    intro i.
    rewrite -> (plus_1_S).
    rewrite -> (plus_1_S (2*i + i*i)).
    rewrite -> (plus_assoc 1 (2*i) (i*i)).
    rewrite <- (mult_1_r (2*i)).
    rewrite <- (mult_assoc 2 i 1).
    rewrite -> (mult_comm i 1).
    rewrite -> (mult_assoc 2 1 i).
    rewrite -> (binomial_2).
    rewrite <- (mult_1_l 1) at 5.
    reflexivity.
Qed.

(* ********** *)

Definition specification_of_the_mystery_function_6 (f : nat -> nat) :=
  (forall i j : nat,
    f (i + j) = f i + 2 * i * j + f j).

Proposition there_is_only_one_mystery_function_6 :
  forall f g : nat -> nat,
    specification_of_the_mystery_function_6 f ->
    specification_of_the_mystery_function_6 g ->
    forall n : nat,
      f n = g n.
Proof.
  intros f g.
  unfold specification_of_the_mystery_function_6.
  intros H_f H_g.
  intro n.
  induction n as [ | n' IHn'].

  (* Base case: *)

    rewrite <- (plus_0_l 0).
    rewrite -> (H_f).
    rewrite -> (H_g).
Abort.

Theorem and_the_mystery_function_6_is_power :
  specification_of_the_mystery_function_6 (fun x => x*x).
Proof.
  unfold specification_of_the_mystery_function_6.
  intros i j.
  apply (binomial_2).
Qed.

Lemma rewriting_in_short_form_v1 :
  forall a b c d : nat,
    a + b + c + d = a + d + b + c.
Proof.
  intros a b c d.
  rewrite <- (plus_assoc a d b).
  rewrite -> (plus_comm d b).
  rewrite <- (plus_assoc a (b + d) c).
  rewrite -> (plus_comm b d).
  rewrite <- (plus_assoc d b c).
  rewrite -> (plus_comm d (b + c)).
  rewrite -> (plus_assoc a (b + c) d).
  rewrite -> (plus_assoc a b c).
  reflexivity.
Qed.

Theorem and_the_mystery_function_6_could_also_be :
  specification_of_the_mystery_function_6 (fun x => x*x + 2*x).
Proof.
  unfold specification_of_the_mystery_function_6.
  intros i j.
  rewrite -> (binomial_2).
  rewrite -> (mult_plus_distr_l).
  rewrite -> (plus_comm (2*i) (2*j)).
  rewrite <- (plus_assoc (i*i) (2*i) (2*i*j)).
  rewrite -> (plus_comm (2*i) (2*i*j)).
  rewrite -> (plus_assoc (i*i) (2*i*j) (2*i)).
  rewrite ->2 (plus_assoc).
  rewrite -> (rewriting_in_short_form_v1 (i*i + 2*i*j) (j*j) (2*j) (2*i)).
  reflexivity.
Qed.

(* ********** *)

Fixpoint exp (x n : nat)  :=
  match n with
      | 0 => 1
      | S n' => mult x (exp x n')
end.

Lemma unfold_exp_bc :
  forall x : nat,
    exp x 0 = 1.
Proof.
  unfold_tactic exp.
Qed.

Lemma unfold_exp_ic :
  forall (x n : nat),
    exp x (S n) = mult x (exp x n).
Proof.
  unfold_tactic exp.
Qed.

Definition specification_of_the_mystery_function_7 (f : nat -> nat) :=
  (f 0 = 1)
  /\
  (forall i j : nat,
    f (S (i + j)) = 2 * f i * f j).

Proposition there_is_only_one_mystery_function_7 :
  forall f g : nat -> nat,
    specification_of_the_mystery_function_7 f ->
    specification_of_the_mystery_function_7 g ->
    forall n : nat,
      f n = g n.
Proof.
  intros f g.
  unfold specification_of_the_mystery_function_7.
  intros [H_f_bc H_f_ic].
  intros [H_g_bc H_g_ic].
  intro n.
  induction n as [ | n' IHn'].

  (* Base case: *)

    rewrite -> (H_f_bc).
    rewrite -> (H_g_bc).
    reflexivity.

  (* Inductive case: *)

    rewrite <- (plus_0_l (S n')).
    rewrite <- (plus_n_Sm 0 n').
    rewrite -> (H_f_ic).
    rewrite -> (H_g_ic).
    rewrite -> (IHn').
    rewrite -> (H_f_bc).
    rewrite -> (H_g_bc).
    reflexivity.
Qed.

Lemma exp_is_distributive :
  forall (x n m : nat),
    mult (exp x n) (exp x m) = exp x (n+m).
Proof.
  intros x n m.
  induction n as [ | n' IHn'].

  (*Base case: *)

    rewrite -> (unfold_exp_bc).
    rewrite -> (plus_0_l m).
    rewrite -> (mult_1_l).
    reflexivity.

  (* Inductive case: *)

    rewrite -> (unfold_exp_ic).
    rewrite -> (plus_1_S).
    rewrite <- (plus_assoc 1 n' m).
    rewrite <- (plus_1_S (n' +m)).
    rewrite -> (unfold_exp_ic).
    rewrite <- (IHn').
    rewrite -> (mult_assoc x (exp x n') (exp x m)).
    reflexivity.
Qed.

Theorem and_the_mystery_function_7_is_power_of_2 :
  specification_of_the_mystery_function_7 (exp 2).
Proof.
  unfold specification_of_the_mystery_function_7.
  split.

    rewrite -> (unfold_exp_bc).
    reflexivity.

    intros i j.
    rewrite -> (unfold_exp_ic).
    rewrite <- (mult_assoc 2 (exp 2 i) (exp 2 j)).
    rewrite -> (exp_is_distributive).
    reflexivity.
Qed.

(* ********** *)

Definition specification_of_the_mystery_function_power_8 (f : nat -> nat) :=
  (f 0 = 2)
  /\
  (forall i j : nat,
    f (S (i + j)) = f i * f j).

Proposition there_is_only_one_mystery_function_power_8 :
  forall f g : nat -> nat,
    specification_of_the_mystery_function_power_8 f ->
    specification_of_the_mystery_function_power_8 g ->
    forall n : nat,
      f n = g n.
Proof.
  intros f g.
  unfold specification_of_the_mystery_function_power_8.
  intros [H_f_bc H_f_ic].
  intros [H_g_bc H_g_ic].
  intro n.
  induction n as [ | n' IHn'].

  (* Base case: *)

    rewrite -> (H_f_bc).
    rewrite -> (H_g_bc).
    reflexivity.

  (* Inductive case: *)

    rewrite <- (plus_0_l (S n')).
    rewrite <- (plus_n_Sm 0 n').
    rewrite -> (H_f_ic).
    rewrite -> (H_g_ic).
    rewrite -> (H_f_bc).
    rewrite -> (H_g_bc).
    rewrite -> (IHn').
    reflexivity.
Qed.

Theorem and_the_mystery_function_8_is_mult_2_power_of_2 :
  specification_of_the_mystery_function_power_8 (fun x => mult 2 (exp 2 x)).
Proof.
  unfold specification_of_the_mystery_function_power_8.
  split.

    rewrite -> (unfold_exp_bc).
    rewrite -> (mult_1_r).
    reflexivity.

    intros i j.
    rewrite -> (unfold_exp_ic).
    rewrite -> (mult_assoc 2 2 (exp 2 (i + j))).
    rewrite <- (exp_is_distributive).
    rewrite -> (mult_assoc).
    rewrite -> (mult_assoc).
    rewrite -> (mult_comm (2 * 2) (exp 2 i)).
    rewrite -> (mult_comm 2 (exp 2 i)).
    rewrite -> (mult_assoc).
    reflexivity.
Qed.

(* ********** *)

Definition specification_of_the_mystery_function_9 (f : nat -> nat) :=
  (f 0 = 0)
  /\
  (f 1 = 1)
  /\
  (f 2 = 1)
  /\
  (forall p q : nat,
    f (S (p + q)) = f (S p) * f (S q) + f p * f q).

Proposition there_is_only_one_mystery_function_9 :
  forall f g : nat -> nat,
    specification_of_the_mystery_function_9 f ->
    specification_of_the_mystery_function_9 g ->
    forall n : nat,
      f n = g n.
Proof.
  intros f g.
  unfold specification_of_the_mystery_function_9.
  intros [H_f_bc0 [H_f_bc1 [H_f_bc2 H_f_ic]]]
         [H_g_bc0 [H_g_bc1 [H_g_bc2 H_g_ic]]].
  intro n.
  induction n as [ | | n' IH_n' IH_Sn'] using nat_ind2.

  (* Base case 1: *)
    rewrite -> H_f_bc0.
    rewrite -> H_g_bc0.
    reflexivity.

  (* Base case 2: *)
    rewrite -> H_f_bc1.
    rewrite -> H_g_bc1.
    reflexivity.

  (* Inductive case: *)
    rewrite -> (plus_1_S n').
    rewrite -> (H_f_ic 1 n').
    rewrite -> (H_g_ic 1 n').
    rewrite -> IH_n'.
    rewrite -> (H_f_bc2).
    rewrite -> (H_g_bc2).
    rewrite -> IH_Sn'.
    rewrite -> (H_f_bc1).
    rewrite -> (H_g_bc1).
    reflexivity.
Qed.

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

Lemma unfold_fib_ds_base_case_0 :
  fib_ds 0 = 0.
Proof.
  unfold_tactic fib_ds.
Qed.

Lemma unfold_fib_ds_base_case_1 :
  fib_ds 1 = 1.
Proof.
  unfold_tactic fib_ds.
Qed.

Lemma shorthand_rewrite_with_fib :
  forall a b c d : nat,
    (a + b) * c + a* d = a*(c + d) + b*c.
Proof.
  intros a b c d .
  rewrite -> (mult_plus_distr_r).
  rewrite <- (plus_assoc (a*c) (b*c) (a*d)).
  rewrite -> (plus_comm (b*c) (a*d)).
  rewrite -> (plus_assoc (a*c) (a*d) (b*c)).
  Check(mult_plus_distr_l).
  rewrite <- (mult_plus_distr_l a c d).
  reflexivity.
Qed.

Lemma unfold_fib_ds_induction_case :
  forall n'' : nat,
    fib_ds (S (S n'')) = fib_ds (S n'') + fib_ds n''.
Proof.
  unfold_tactic fib_ds.
Qed.

Theorem and_the_mystery_function_9_is_fib :
  specification_of_the_mystery_function_9 (fib_ds).
Proof.
  unfold specification_of_the_mystery_function_9.
  split.

    rewrite -> (unfold_fib_ds_base_case_0).
    reflexivity.

    split.

      rewrite -> (unfold_fib_ds_base_case_1).
      reflexivity.

      split.

        rewrite -> (unfold_fib_ds_induction_case).
        rewrite -> (unfold_fib_ds_base_case_1).
        rewrite -> (unfold_fib_ds_base_case_0).
        rewrite -> (plus_0_r).
        reflexivity.

        intros p q.
        revert p. (* To strengthen my hypothesis *)
        induction q as [ | q' IHq'].

        (* Base case *)
          intro p.
          rewrite -> (plus_0_r).
          rewrite -> (unfold_fib_ds_base_case_0).
          rewrite -> (unfold_fib_ds_base_case_1).
          rewrite -> (mult_0_r).
          rewrite -> (mult_1_r).
          rewrite -> (plus_0_r).
          reflexivity.

        (* Inductive case: *)

          intro p.
          rewrite -> (plus_1_S q') at 1.
          rewrite -> (plus_assoc p 1 q').
          rewrite <- (plus_S_1 p).
          rewrite -> (IHq' (S p)).
          rewrite ->2 (unfold_fib_ds_induction_case).
          rewrite -> (shorthand_rewrite_with_fib (fib_ds (S p)) (fib_ds p) (fib_ds (S q')) (fib_ds q')).
          reflexivity.
Qed.

(* ********** *)

Require Import Bool.

Definition specification_of_the_mystery_function_power_10 (f : nat -> bool) :=
  (f 0 = true)
  /\
  (f 1 = false)
  /\
  (forall i j : nat,
     f (i + j) = eqb (f i) (f j)).

Proposition there_is_only_one_mystery_function_power_10 :
  forall f g : nat -> bool,
    specification_of_the_mystery_function_power_10 f ->
    specification_of_the_mystery_function_power_10 g ->
    forall n : nat,
      f n = g n.
Proof.
  intros f g.
  unfold specification_of_the_mystery_function_power_10.
  intros [H_f_bc0 [H_f_bc1 H_f_ic]].
  intros [H_g_bc0 [H_g_bc1 H_g_ic]].
  intro n.
  induction n as [ | n' IHn'].

  (* Base case. *)
    rewrite -> (H_f_bc0).
    rewrite -> (H_g_bc0).
    reflexivity.

  (* Inductive case: *)
    rewrite -> (plus_1_S n').
    rewrite -> (H_f_ic).
    rewrite -> (H_f_bc1).
    rewrite -> (IHn').
    rewrite -> (H_g_ic).
    rewrite -> (H_g_bc1).
    reflexivity.
Qed.

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

Lemma unfold_evenp_bc0 :
  evenp 0 = true.
Proof.
  unfold_tactic evenp.
Qed.

Lemma unfold_evenp_bc1 :
  evenp 1 = false.
Proof.
  unfold_tactic evenp.
Qed.

Lemma unfold_evenp_ic :
  forall n'' : nat,
    evenp (S (S n'')) = evenp n''.
Proof.
  unfold_tactic evenp.
Qed.

Lemma about_mystery_evenp_v2 :
    forall x : nat,
      evenp (S x) = negb (evenp x).
Proof.
  intro x.
  induction x as [ | x' IHx'].

  rewrite -> (unfold_evenp_bc0).
  rewrite -> (unfold_evenp_bc1).
  unfold negb.
  reflexivity.

  rewrite -> (unfold_evenp_ic).
  rewrite -> (IHx').
  rewrite -> (negb_involutive).
  reflexivity.
Qed.

Lemma eqb_if_both_even_or_odd :
  forall x y : nat,
    eqb (evenp x) (evenp y) = eqb (evenp (S x)) (evenp (S y)).
Proof.
  intro x.
  induction x as [ | x' IHx'].

  (* Base case: *)

    intros [ | y'].
      rewrite -> (unfold_evenp_bc0).
      rewrite -> (unfold_evenp_bc1).
      unfold eqb.
      reflexivity.

    rewrite -> (unfold_evenp_bc1).
    rewrite -> (unfold_evenp_bc0).
    rewrite -> (unfold_evenp_ic).
    rewrite -> (about_mystery_evenp_v2 y').
    destruct (evenp y') eqn:H_y.
      unfold negb.
      unfold eqb.
      reflexivity.

    unfold negb.
    unfold eqb.
    reflexivity.

  (* Inductive case: *)

    rewrite -> (unfold_evenp_ic).
    rewrite -> (about_mystery_evenp_v2).
    intros [ | y'].

      rewrite -> (unfold_evenp_bc0).
      rewrite -> (IHx' 1).
      rewrite -> (unfold_evenp_ic).
      rewrite -> (unfold_evenp_bc0).
      rewrite -> (about_mystery_evenp_v2).
      reflexivity.

    rewrite <- (about_mystery_evenp_v2).
    rewrite <- (IHx' y').
    rewrite -> (unfold_evenp_ic).
    reflexivity.
Qed.

Theorem fun_theorem_about_evenp :
  forall x y : nat,
    evenp (x + y) = eqb (evenp x) (evenp y).
Proof.
  intro x.
  induction x as [ | x' IHx'].

  (* Base case: *)

  intro y.
  rewrite -> (plus_0_l).
  rewrite -> (unfold_evenp_bc0).
  unfold eqb.
  destruct (evenp y) eqn:H_y.
    reflexivity.
  reflexivity.

  intros [ | y'].
  rewrite -> (unfold_evenp_bc0).
  rewrite -> (plus_0_r).
  unfold eqb.
  destruct (evenp (S x')) eqn:H_Sx'.
    reflexivity.
  reflexivity.
  rewrite -> (plus_S_1 x').
  rewrite <- (plus_assoc x' 1 (S y')).
  rewrite <- (plus_1_S (S y')).
  rewrite (IHx' (S (S y'))).
  rewrite <- (plus_S_1 x').
  rewrite -> (unfold_evenp_ic).
  rewrite -> (eqb_if_both_even_or_odd).
  reflexivity.
Qed.

Theorem and_the_mystery_function_10_is_is_evenp :
  specification_of_the_mystery_function_power_10 evenp.
Proof.
  unfold specification_of_the_mystery_function_power_10.
  split.
  rewrite -> (unfold_evenp_bc0).
  reflexivity.
  split.
  rewrite -> (unfold_evenp_bc1).
  reflexivity.

  apply (fun_theorem_about_evenp).
Qed.

Definition specification_of_the_mystery_function_11 (f : nat -> nat * nat) :=
  (f 0 = (1, 0))
  /\
  (forall n' : nat,
    f (S n') = let (x, y) := f n'
               in (x + y, x)).

Fixpoint fib_co_acc (n : nat) : nat * nat :=
  match n with
    | O => (1, 0)
    | S n' => let (x, y) := fib_co_acc n'
              in (x + y, x)
  end.

Lemma unfold_fib_co_acc_base_case :
  fib_co_acc 0 = (1, 0).
Proof.
  unfold_tactic fib_co_acc.
Qed.

Lemma unfold_fib_co_acc_induction_case :
  forall n' : nat,
    fib_co_acc (S n') = let (x, y) := fib_co_acc n'
                        in (x + y, x).
Proof.
  unfold_tactic fib_co_acc.
Qed.

Proposition there_is_only_one_mystery_function_11 :
  forall f g : nat -> nat * nat,
    specification_of_the_mystery_function_11 f ->
    specification_of_the_mystery_function_11 g ->
    forall n : nat,
      f n = g n.
Proof.
  intros f g.
  unfold specification_of_the_mystery_function_11.
  intros [H_f_bc H_f_ic].
  intros [H_g_bc H_g_ic].
  intro n.
  induction n as [ | n' IHn'].

  (* Base case: *)
    rewrite -> (H_f_bc).
    rewrite -> (H_g_bc).
    reflexivity.

  (* Inductive case: *)
    rewrite -> (H_f_ic).
    rewrite -> (H_g_ic).
    rewrite -> (IHn').
    reflexivity.
Qed.

Theorem and_the_mystery_function_11_is_power_fibonacci_accumulator :
  specification_of_the_mystery_function_11 fib_co_acc.
Proof.
  unfold specification_of_the_mystery_function_11.
  split.
    rewrite -> (unfold_fib_co_acc_base_case).
    reflexivity.

    intro n'.
    rewrite -> (unfold_fib_co_acc_induction_case).
    reflexivity.
Qed.

(* ********** *)

Fixpoint fac_co_acc (n : nat) : nat * nat :=
  match n with
    | 0 => (0, 1)
    | S n' => let (x,y) := fac_co_acc n'
              in (S x, y * S x)
end.

Compute fac_co_acc 3.

 Fixpoint split (A : Type) (ls : list A) : list A * list A :=
    match ls with
      | nil => (nil, nil)
      | h :: nil => (h :: nil, nil)
      | h1 :: h2 :: ls' =>
        let (ls1, ls2) := split A ls' in
          (h1 :: ls1, h2 :: ls2)
    end.

Check split.
Compute split nat (1 :: 2 :: 3 :: 4 :: nil).

Fixpoint fac (x : nat) :=
  match x with
    | 0 => 1
    | S x' => mult (S x') (fac x')
  end.

Definition fac_co_help (x : nat) : nat * nat :=
  (x, fac x).

Definition specification_of_the_mystery_function_12 (f : nat -> nat * nat) :=
  (f 0 = (0, 1))
  /\
  (forall n' : nat,
    f (S n') = let (x, y) := f n'
               in (S x, y * S x)).

Proposition there_is_only_one_mystery_function_12 :
  forall f g : nat -> nat * nat,
    specification_of_the_mystery_function_12 f ->
    specification_of_the_mystery_function_12 g ->
    forall n : nat,
      f n = g n.
Proof.
  intros f g.
  unfold specification_of_the_mystery_function_12.
  intros [H_f_bc H_f_ic].
  intros [H_g_bc H_g_ic].
  intro n.

  induction n as [ | n' IHn'].

  (* Base case: *)
    rewrite -> (H_f_bc).
    rewrite -> (H_g_bc).
    reflexivity.

  (* Inductive case: *)
    rewrite -> (H_f_ic).
    rewrite -> (H_g_ic).
    rewrite -> (IHn').
    reflexivity.
Qed.

Lemma unfold_fac_co_acc_base_case :
  fac_co_acc 0 = (0, 1).
Proof.
  unfold_tactic fac_co_acc.
Qed.

Lemma unfold_fac_co_acc_induction_case :
  forall n' : nat,
    fac_co_acc (S n') = let (x, y) := fac_co_acc n'
                        in (S x, y * S x).
Proof.
  unfold_tactic fac_co_acc.
Qed.

Lemma unfold_fac_co_help_base_case :
  fac_co_help 0 = (0,1).
Proof.
  unfold_tactic fac_co_help.
Qed.

Lemma unfold_fac_co_help_induction_case :
  forall n' : nat,
    fac_co_help (S n') = (S n', (S n') * fac n').
Proof.
  unfold_tactic fac_co_help.
Qed.

Theorem and_the_mystery_function_12_is_tuple_index_and_factorial :
  specification_of_the_mystery_function_12 fac_co_acc.
Proof.
  unfold specification_of_the_mystery_function_12.
  split.
    rewrite -> (unfold_fac_co_acc_base_case).
    reflexivity.

    intro n'.
    rewrite -> (unfold_fac_co_acc_induction_case).
    reflexivity.
Qed.

Theorem we_could_also_call_it_fac_co_help :
  specification_of_the_mystery_function_12 fac_co_help.
Proof.
  unfold specification_of_the_mystery_function_12.
  split.
    rewrite -> (unfold_fac_co_help_base_case).
    reflexivity.

    intro n'.
    rewrite -> (unfold_fac_co_help_induction_case).
    unfold fac_co_help.
    rewrite -> (mult_comm).
    reflexivity.
Qed.

(* end of week_38c_mystery_functions.v *)


(** 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 (lf1 : natural) (y : natural) (x : natural) : natural :=
  plus y (mult (Succ y) x).


(**************************************************************************)
(*  This is part of ATBR, it is distributed under the terms of the        *)
(*         GNU Lesser General Public License version 3                    *)
(*              (see file LICENSE for more details)                       *)
(*                                                                        *)
(*       Copyright 2009-2011: Thomas Braibant, Damien Pous.               *)
(**************************************************************************)

(** Properties of matrices over a semiring (in particular, they form a semiring)  *)

Require Import Common.
Require Import Classes.
Require Import Graph.
Require Import Monoid.
Require Import SemiLattice.
Require Import SemiRing.
Require Import MxGraph.
Require Import MxSemiLattice.
Require Import BoolView.

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

Transparent equal.

Section Defs.

  Context `{ISR: IdemSemiRing}.
  Variable A: T.
  Notation MX n m := (MX_ A n m).
  Notation mx_equal n m := (mx_equal_ A n m) (only parsing).

  Definition mx_dot n m p (M: MX n m) (N: MX m p): MX n p :=
    box n p (fun i j => sum 0 m (fun k => !M i k * !N k j)).
  Definition mx_one n: MX n n :=
    box n n (fun i j => if eq_nat_bool i j then 1 else 0).

  Global Instance mx_Monoid_Ops: Monoid_Ops (mx_Graph A) := {
    dot := mx_dot;
    one := mx_one }.

  Definition mx_bool n m (f: nat -> nat -> bool): MX n m :=
    box n m (fun i j => xif (f i j) 1 0).

  Lemma mx_dot_assoc n m p o (M: MX n m) (N: MX m p) (P: MX p o): M*(N*P) == (M*N)*P.
  Proof.
    intros i j Hi Hj. simpl.
    transitivity (sum 0 m (fun k => sum 0 p (fun k' => !M i k * !N k k' * !P k' j))).
     apply sum_compat; intros.
     rewrite sum_distr_right; auto with algebra.

     rewrite sum_inversion.
     apply sum_compat; intros.
     rewrite sum_distr_left; auto with algebra.
  Qed.

  Lemma mx_dot_neutral_left n m (M: MX n m): 1 * M == M.
  Proof.
    intros i j Hi Hj. simpl.
    rewrite (sum_cut_nth i)  by auto with arith; simpl.
    transitivity (0 + !M i j + 0); [|semiring_reflexivity].
    repeat apply plus_compat; try (apply sum_zero; intros);
      nat_analyse; semiring_reflexivity.
  Qed.

  Lemma mx_dot_neutral_right n m (M: MX m n): M * 1 == M.
  Proof.
    intros i j Hi Hj. simpl.
    rewrite (sum_cut_nth j) by auto with arith; simpl.
    transitivity (0 + !M i j + 0); [|semiring_reflexivity].
    repeat apply plus_compat; try (apply sum_zero; intros);
      nat_analyse; semiring_reflexivity.
  Qed.

  Global Program Instance mx_Monoid: Monoid (mx_Graph A) := {
    dot_assoc := mx_dot_assoc;
    dot_neutral_left := mx_dot_neutral_left;
    dot_neutral_right := mx_dot_neutral_right
  }.
  Obligation 1. repeat intro. simpl. auto with compat. Qed.

  Global Instance mx_SemiRing: IdemSemiRing (mx_Graph A).
  Proof.
    constructor; repeat intro; simpl.
    exact mx_Monoid.
    apply mx_SemiLattice.
    apply sum_zero; auto with algebra.
    apply sum_zero; auto with algebra.
    rewrite <- sum_cut_fun; auto with algebra.
    rewrite <- sum_cut_fun; auto with algebra.
  Qed.

End Defs.

Notation mx_dot_ A := (@dot (mx_Graph A) (mx_Monoid_Ops A)) (only parsing).
Notation mx_one_ A := (@one (mx_Graph A) (mx_Monoid_Ops A)) (only parsing).

(*begintests
Section tac_tests.
  Context `{ISR: IdemSemiRing}.
  Variable A: T.
  Notation MX n m := (MX_ A n m).
  Variable x y z: X A A.
  Variables n m p: nat.
  Variables M N P : MX n m.
  Variables Q R : MX m p.

  Goal x*(z+y+z) == x*z+x*y.
    semiring_reflexivity.
  Qed.

  Goal x*(z+y+z) <== x*z+x*y.
    semiring_reflexivity.
  Qed.

  Goal x+y == z -> y+z+x == z.
    intro H.
    ac_rewrite H.
    apply plus_idem.
  Qed.

  Goal M+(N+M*1) == N+M.
    semiring_reflexivity.
  Qed.

  Goal M*Q+(N+M*1)*Q <== (N+M)*Q.
    semiring_reflexivity.
  Qed.

  Goal N+M == P -> N+P+M == P.
    intro H.
    ac_rewrite H.
    apply plus_idem.
  Qed.

  Goal M*0 == N*Q.
    rewrite dot_ann_right.
  Abort.

  Goal M*0+0*N == 0+0.
    autorewrite with simpl.
    reflexivity.
  Qed.

End tac_tests.
endtests*)

Section Props1.

  Context `{M: Monoid}.
  Variable A: T.
  Notation MX n m := (MX_ A n m).
  Notation mx_equal n m := (mx_equal_ A n m) (only parsing).

  Definition dot_scal_right n m (M: MX n m) (v: X A A): MX n m :=
    box n m (fun i j => !M i j * v).

  Definition dot_scal_left n m (v: X A A) (M: MX n m): MX n m :=
    box n m (fun i j => v * !M i j).

  Global Instance dot_scal_right_compat n m:
  Proper (mx_equal n m ==> equal A A  ==> mx_equal n m) (@dot_scal_right n m).
  Proof. repeat intro. simpl. auto with compat. Qed.

  Global Instance dot_scal_left_compat n m:
  Proper (equal A A ==> mx_equal n m ==> mx_equal n m) (@dot_scal_left n m).
  Proof. repeat intro. simpl. auto with compat. Qed.

End Props1.

Infix "'*" := dot_scal_left (at level 40): A_scope.
Infix "*'" := dot_scal_right (at level 40): A_scope.

Global Hint Extern 2 (mx_equal_ _ _ _ _ _) => apply dot_scal_left_compat: compat algebra.
Global Hint Extern 2 (mx_equal_ _ _ _ _ _) => apply dot_scal_right_compat: compat algebra.

Section Props2.

  Context `{ISR: IdemSemiRing}.
  Variable A: T.
  Notation MX n m := (MX_ A n m).
  Notation mx_equal n m := (mx_equal_ A n m) (only parsing).

  Lemma mx_blocks_dot n m n' m' p p': forall
    (a : MX n  m )
    (b : MX n  m')
    (c : MX n' m )
    (d : MX n' m')
    (a': MX m  p )
    (b': MX m  p')
    (c': MX m' p )
    (d': MX m' p'),
    mx_blocks a  b  c  d * mx_blocks a' b' c' d'
    == mx_blocks
    (a * a' + b * c')
    (a * b' + b * d')
    (c * a' + d * c')
    (c * b' + d * d').
  Proof.
    simpl. intros. destruct_blocks.

    rewrite (plus_comm m), sum_cut.
    apply plus_compat.
    apply sum_compat; intros.
    destruct_blocks. reflexivity. lia_false.
    rewrite (plus_comm m), sum_shift.
    apply sum_compat; intros.
    destruct_blocks. reflexivity.

    rewrite (plus_comm m), sum_cut.
    apply plus_compat.
    apply sum_compat; intros.
    destruct_blocks. reflexivity. lia_false.
    rewrite (plus_comm m), sum_shift.
    apply sum_compat; intros.
    destruct_blocks. reflexivity.

    rewrite (plus_comm m), sum_cut.
    apply plus_compat.
    apply sum_compat; intros.
    destruct_blocks. reflexivity. lia_false.
    rewrite (plus_comm m), sum_shift.
    apply sum_compat; intros.
    destruct_blocks. reflexivity.

    rewrite (plus_comm m), sum_cut.
    apply plus_compat.
    apply sum_compat; intros.
    destruct_blocks. reflexivity. lia_false.
    rewrite (plus_comm m), sum_shift.
    apply sum_compat; intros.
    destruct_blocks. reflexivity.
  Qed.

  Lemma mx_blocks_one x n :
    1 == @mx_blocks _ A x x n n 1 0 0 1.
  Proof.
    simpl. intros. destruct_blocks; nat_analyse; reflexivity.
  Qed.

  Lemma dot_scal_left_is_dot n (M: MX 1 n) x:
    x '* M == mx_of_scal x * M.
  Proof.
    mx_intros i j Hi Hj.  simpl. auto with algebra.
  Qed.

  Lemma dot_scal_left_one n m (M: MX n m): 1 '* M == M.
  Proof.
    repeat intro; simpl. trivial with algebra.
  Qed.

  Lemma dot_scal_left_zero n m x: x '* (0: MX n m) == 0.
    repeat intro; simpl. trivial with algebra.
  Qed.

  Lemma dot_scal_left_dot n m p (M: MX n m) (P: MX m p) x:
    (x '* M) * P == x '* (M * P).
  Proof.
    repeat intro; simpl.
    rewrite sum_distr_right. apply sum_compat. intros. auto with algebra.
  Qed.

  Lemma dot_scal_left_blocks n m p q
    (N: MX n p)
    (M: MX n q)
    (P: MX m p)
    (Q: MX m q) x:
    x '* mx_blocks N M P Q
    == mx_blocks (x '* N) (x '* M) (x '* P) (x '* Q).
  Proof.
    repeat intro; simpl. destruct_blocks; reflexivity.
  Qed.

  Lemma dot_scal_right_is_dot n x (M: MX 1 n):
    x '* M == mx_of_scal x * M.
  Proof.
    mx_intros i j Hi Hj.  simpl. auto with algebra.
  Qed.

  Lemma dot_scal_right_one n m (M: MX n m): M *' 1 == M.
  Proof.
    repeat intro; simpl. trivial with algebra.
  Qed.

  Lemma dot_scal_right_zero n m x: (0: MX n m) *' x == 0.
    repeat intro; simpl. trivial with algebra.
  Qed.

  Lemma dot_scal_right_dot n m p (M: MX n m) (P: MX m p) x:
    M * (P *' x) == (M * P) *' x.
  Proof.
    repeat intro; simpl.
    rewrite sum_distr_left. apply sum_compat. intros. auto with algebra.
  Qed.

  Lemma dot_scal_right_blocks n m p q
    (N: MX n p)
    (M: MX n q)
    (P: MX m p)
    (Q: MX m q) x:
    mx_blocks N M P Q *' x
    == mx_blocks (N *' x) (M *' x) (P *' x) (Q *' x).
  Proof.
    simpl. intros. destruct_blocks; reflexivity.
  Qed.

  Lemma mx_of_scal_dot: forall a b: X A A,
                        mx_of_scal a * mx_of_scal b == mx_of_scal (a*b).
  Proof.
    repeat intro; simpl. trivial with algebra.
  Qed.

  Lemma mx_of_scal_one: 1 == mx_of_scal (one A).
  Proof.
    intros; mx_intros i j Hi Hj. reflexivity.
  Qed.

  Lemma mx_to_scal_dot: forall a b: MX 1 1,
                        mx_to_scal a * mx_to_scal b == mx_to_scal (a*b).
  Proof.
    unfold mx_to_scal.
    simpl. intros. auto with algebra.
  Qed.

  Lemma mx_to_scal_one: one A == mx_to_scal 1.
  Proof. reflexivity. Qed.

  Lemma mx_point_dot n m o i j k: forall a b: X A A, j < m ->
    mx_point n m i j a * mx_point m o j k b == mx_point n o i k (a*b).
  Proof.
    repeat intro; simpl.
    rewrite (sum_cut_nth j) by assumption.
    rewrite 2sum_zero; intros.
     nat_analyse; simpl; semiring_reflexivity.
     nat_analyse; simpl; trivial with algebra.
     nat_analyse; simpl; trivial with algebra.
  Qed.

  Lemma mx_point_dot_zero n m o i j j' k: forall a b: X A A, j<>j' ->
    mx_point n m i j a * mx_point m o j' k b == 0.
  Proof.
    repeat intro; simpl.
    apply sum_zero. intros.
    nat_analyse; simpl; trivial with algebra.
  Qed.

  Lemma mx_point_one_left n m p i j: forall M: MX m p, j < m ->
    mx_point n m i j 1 * M == box n p (fun s t =>  xif (eq_nat_bool i s) (!M j t) 0).
  Proof.
    intros.
    unfold mx_point.
    mx_intros s t Hs Ht. simpl.
    rewrite (sum_cut_nth j) by auto.
    rewrite 2 sum_zero; intros; nat_analyse; simpl; semiring_reflexivity.
  Qed.

  Lemma mx_point_center n m p q i j (M: MX n m) (N: MX p q):
    i < m -> j < p ->
    M * mx_point m p i j 1 * N == box n q (fun s t => !M s i * !N j t).
  Proof.
    intros Hi Hj x y Hx Hy. simpl.
    setoid_rewrite sum_distr_left.

    rewrite (sum_cut_nth j);auto.
    rewrite sum_zero.
    rewrite (sum_cut_nth i).

    setoid_rewrite sum_zero; intros; simpl; nat_analyse; simpl; try semiring_reflexivity.
    rewrite sum_zero. reflexivity.
    intros. bool_simpl; simpl. semiring_reflexivity.
    auto.
    intros. rewrite sum_zero. reflexivity.
    intros. nat_analyse; simpl; semiring_reflexivity.
  Qed.

End Props2.


Require Import HoTT.

(*Strangely, I cannot find any proofs of nat being associative*)
Local Open Scope nat_scope.
Definition plus_assoc : forall j k l : nat, (j + k) + l = j + (k + l).
  intros j k l.
  induction j.
  - exact idpath.
  - exact (ap S IHj).
Defined.

(*Cancellation in nat*)
Open Scope nat_scope.
(* Subtraction of natural numbers. *)
  (* Is given by [m,n => -m + n] *)
(* This is the same as the already defined [minus], but the below lemma is much easier to prove *)
Fixpoint nat_minus (m n : nat) : nat :=
  match m with
      |0 => n (*-0 + m := m*)
      |m.+1 => match n with
                  |0 => 0 (*-(m+1)+0 = 0*)
                  |n.+1 => nat_minus m n (*- m+1 + n+1= -m + n*)
              end
  end.

(* Just to show that this is the same as the old minus. *)
Lemma nat_minus_is_minus (m n : nat) : nat_minus m n = minus n m.
Proof.
  revert n.
  induction m.
  - induction n; reflexivity.
  - induction n.
    + reflexivity.
    + simpl. apply IHm.
Defined.

Definition nat_plus_minus (m n : nat) : nat_minus m (m + n) = n.
Proof.
  induction m.
  - reflexivity.
  - exact IHm.
Defined.

Definition nat_plus_cancelL (l m n : nat) : l + m = l + n -> m = n.
Proof.
  intro p.
  refine ((nat_plus_minus l m)^ @ _ @ nat_plus_minus l n).
  apply (ap (nat_minus l) p).
Defined.

(* Definition not_leq_is_gt (i j : nat) : not (i <= j) <~> i > j. *)
(* Proof. *)
(*   unfold not. unfold leq. unfold gt. *)
(*   simpl. *)
(*   induction i. simpl. *)

(* Definition split_nat (i : nat) : *)
(*   nat <~> {j : nat & j <= i} + {j : nat & j > i}. *)
(* Proof. *)
(*   srapply @equiv_adjointify. *)
(*   - intro k. induction k. *)
(*     (* k = 0 *) *)
(*     + apply inl. *)
(*       exists 0. *)
(*       apply leq0n. *)
(*     (* k+1 *) *)
(*     +  *)

Close Scope nat_scope.

(* Comparing not_leq to gt *)
Section Inequalities.
  Local Open Scope nat.
  (* For two natural numbers, one is either less than or equal the other, or it is greater. *)
  Definition leq_or_gt (i j : nat) : (i <= j) + (i > j).
  Proof.
    revert j. induction i; intro j.
    (* 0 <= j *)
    - exact (inl tt).
    - destruct j.
      (* 0 < i+1 *)
      + exact (inr tt).
      (* (i < j+1) + (j.+1 < i + 1) <-> (i <= j) + (j < i) *)
      + apply IHi.
  Defined.

  Definition leq_succ (n : nat) : n <= n.+1.
  Proof.
    induction n.
    - reflexivity.
    - apply IHn.
  Defined.

  (* Lemma leq_refl_code (i j : nat) : i =n j -> i <= j. *)
  (* Proof. *)
  (*   intro H. *)
  (*   destruct (path_nat H). apply leq_refl. *)
  (* Qed. *)

  Definition neq_succ (n : nat) : not (n =n n.+1).
  Proof.
    induction n.
    - exact idmap.
    - exact IHn.
  Defined.

  Definition leq0 {n : nat} : n <= 0 -> n =n 0.
  Proof.
    induction n; exact idmap.
  Defined.

  (* if both i<=j and j<=i, then they are equal *)
  Definition leq_geq_to_eq (i j : nat) : (i <= j) -> (j <= i) -> i =n j.
  Proof.
    revert i.
    induction j; intros i i_leq_j j_leq_i.
    - exact (leq0 i_leq_j).
    - destruct i.
      + intros. destruct j_leq_i.
      + simpl. intros.
        apply (IHj _ i_leq_j j_leq_i).
  Defined.

  (* If i <= n, then i < n or i = n+1 *)
  Definition lt_or_eq (i n : nat) : i <= n -> (i < n) + (i = n).
  Proof.
    intro i_leq_n.
    destruct (leq_or_gt n i) as [n_leq_i | n_gt_i].
    - apply inr. apply path_nat. exact (leq_geq_to_eq _  _ i_leq_n n_leq_i).
    - exact (inl n_gt_i).
  Defined.

  Definition lt_or_eq_or_gt (i n : nat) :
    (i < n) + (i = n) + (i > n).
  Proof.
    destruct (leq_or_gt i n) as [leq | gt].
    - apply inl. apply (lt_or_eq i n leq).
    - exact (inr gt).
  Defined.

  (* Definition leq_to_lt_plus_eq (i j : nat) : i <= j -> (i < j) + (i = j). *)
  (* Proof. *)
  (*   intro i_leq_j. *)
  (*   destruct (dec (i = j)). *)
  (*   - exact (inr p). *)
  (*   - apply inl. *)
  (*     induction j. *)
  (*     + simpl. rewrite (path_nat (leq0 i i_leq_j)) in n. apply n. reflexivity. *)
  (*     + destruct i. exact tt. *)
  (*       srapply (@leq_transd i.+2 j j.+1). *)
  (*       * apply IHj. *)
  (*         admit. *)

  (*       simpl. *)

  (*       i. *)
  (*     + simpl. *)

  (*   destruct j. *)
  (*   apply inr. apply path_nat. apply (leq0  i (i_leq_j)). *)
  (*   destruct i. *)
  (*   - simpl. *)

  (*   apply inl. change (i < j.+1) with (i <= j). *)
  (*   apply (leq_transd *)

  (* Definition nlt_n0 (n : nat) : ~(n < 0) := idmap. *)

  Definition gt_to_notleq (i j : nat) : j > i -> ~(j <= i).
  Proof.
    intro i_lt_j.
    intro j_leq_i.
    apply (neq_succ i).
    apply (leq_antisymd (leq_succ i)).
    apply (leq_transd i_lt_j j_leq_i).
    (* set (Si_leq_i := leq_transd i_lt_j j_leq_i). *)
    (* set (Si_eq_i := leq_antisymd (leq_succ i) Si_leq_i). *)
    (* apply (neq_succ i Si_eq_i). *)
    (* induction i. *)
    (* exact Si_eq_i. *)
  Defined.

  Definition not_i_lt_i (i : nat) : ~(i < i).
  Proof.
    unfold not.
    induction i.
    - exact idmap.
    - exact IHi.
  Defined.

  (* Lemma notleq_to_gt (i j : nat) : ~(j <= i) -> j > i. *)
  (* Proof. *)
  (*   intro j_nleq_i. *)
  (*   induction j. *)
  (*   - apply j_nleq_i. *)
  (*     apply leq0n. *)
  (*   - change (i < j.+1) with (i <= j). *)
  (*     destruct (dec (i =n j)). *)
  (*     (* i = j *) *)
  (*     + destruct (path_nat t). apply leq_refl. *)
  (*     +  *)

  (*     induction i. *)
  (*     + exact tt. *)
  (*     +  *)

  (*   induction i, j. *)
  (*   - apply j_nleq_i. exact tt. *)
  (*   - exact tt. *)
  (*   - simpl. simpl in IHi. simpl in j_nleq_i. apply IHi. exact j_nleq_i. *)
  (*   - change (i.+1 < j.+1) with (i < j). *)
  (*     change (j < i.+1) with (j <= i) in j_nleq_i. *)
  (*     change (i < j.+1) with (i <= j) in IHi. *)

  (*   destruct (dec (~ (j <= i))). *)
  (*   - set (f := j_nleq_i t). destruct f. *)
  (*   -  *)

  (* If i <= j, then j is the sum of i and some natural number *)
  Definition leq_to_sum {i j : nat} : i <= j -> {k : nat | j = i + k}%nat.
  Proof.
    revert j. induction i; intro j.
    - intro.
      exists j. reflexivity.
    - destruct j.
      + intros [].
      + simpl. change (i < j.+1) with (i <= j).
        intro i_leq_j.
        apply (functor_sigma (A := nat) idmap (fun _ => ap S)).
        apply (IHi j i_leq_j).
        (* exists (IHi j i_leq_j).1. *)
        (* apply (ap S). *)
      (* apply (IHi j i_leq_j).2. *)
  Defined.

  (* If j > i, then j is a successor *)
  Definition gt_is_succ {i j : nat} : i < j -> {k : nat | j = k.+1}.
  Proof.
    intro i_lt_j.
    destruct (leq_to_sum i_lt_j) as [k H].
    exact (i+k; H)%nat.
  Defined.

End Inequalities.


From LF Require Export basics.

Theorem plus_n_O : forall n : nat,
  n = n + 0.
Proof.
  induction n.
  - reflexivity.
  - simpl. rewrite <- IHn.
    reflexivity.
Qed.

Theorem minus_n_n : forall n : nat,
  minus n n = 0.
Proof.
  induction n.
  - reflexivity.
  - simpl.
    apply IHn.
Qed.

Theorem mult_0_r : forall n : nat,
  n * 0 = 0.
Proof.
  induction n.
  - reflexivity.
  - simpl. apply IHn.
Qed.

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

Theorem plus_comm : forall n m : nat,
  n + m = m + n.
Proof.
  intros.
  induction n.
  - 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.
  - 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.
  - reflexivity.
  - simpl. rewrite -> IHn. rewrite <- plus_n_Sm. reflexivity.
Qed.

Theorem evenb_S : forall n : nat,
  evenb (S n) = negb (evenb n).
Proof.
  induction n.
  - reflexivity.
  - rewrite -> IHn. simpl. rewrite -> negb_involutive. reflexivity.
Qed.

Theorem mult_0_plus' : forall n m : nat,
  (0 + n) * m = n * m.
Proof.
  intros.
  reflexivity.
Qed.

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

Theorem plus_swap : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  intros n m p.
  rewrite -> plus_assoc. rewrite -> plus_assoc.
  assert (H: n + m = m + n).
  { apply plus_comm. }
  rewrite -> H. reflexivity.
Qed.

Theorem mult_comm : forall m n : nat,
  m * n = n * m.
Proof.
  intros m n.
  induction m.
  - rewrite <- mult_n_O. reflexivity.
  - rewrite <- mult_n_Sm.
    simpl. rewrite -> IHm.
    rewrite -> plus_comm. reflexivity.
Qed.

Check leb.

Theorem leb_refl : forall n : nat,
  true = (n <=? n).
Proof.
  intros n.
  induction n.
  - reflexivity.
  - simpl. apply IHn.
Qed.

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

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

Theorem plus_ble_compat_l : forall n m p : nat,
  n <=? m = true ->
  (p + n) <=? (p + m) = true.
Proof.
  intros.
  induction p.
  - simpl. apply H.
  - simpl. apply IHp.
Qed.

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

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

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

Theorem mult_plus_distr_r : forall n m p : nat,
  (n + m) * p = (n * p) + (m * p).
Proof.
  intros.
  induction p.
  - rewrite <- mult_n_O. rewrite <- mult_n_O.
    rewrite <- mult_n_O. reflexivity.
  - rewrite <- mult_n_Sm. rewrite <- mult_n_Sm.
    rewrite <- mult_n_Sm. rewrite -> IHp.
    rewrite -> plus_swap. rewrite <- plus_assoc.
    rewrite -> plus_swap. rewrite -> plus_assoc.
    reflexivity.
Qed.

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

Theorem eqb_refl : forall n : nat,
  true = (n =? n).
Proof.
  intros n.
  induction n.
  - reflexivity.
  - apply IHn.
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.
  apply plus_comm.
Qed.

Theorem succ_succ : forall n : nat,
  S n + S n = S (S (n + n)).
Proof.
  induction n.
  - reflexivity.
  - rewrite -> IHn.
    simpl. rewrite <- plus_n_Sm.
    rewrite <- plus_n_Sm. reflexivity.
Qed.

Theorem bin_to_nat_pres_incr : forall b : bin,
  bin_to_nat (incr b) =  S (bin_to_nat b).
Proof.
  intros.
  induction b.
  - reflexivity.
  - reflexivity.
  - simpl. rewrite -> IHb.
    rewrite <- plus_n_O. rewrite <- plus_n_O.
    rewrite -> succ_succ. reflexivity.
Qed.

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

Theorem nat_bin_nat : forall n : nat,
  bin_to_nat (nat_to_bin n) = n.
Proof.
  induction n.
  - reflexivity.
  - simpl. rewrite -> bin_to_nat_pres_incr.
    rewrite -> IHn. reflexivity.
Qed.

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

Fixpoint normalize (b : bin) : bin :=
  match b with
  | Z => Z
  | B0 b' => double_bin (normalize b')
  | B1 b' => incr (double_bin (normalize b'))
  end.

Lemma double_inc : forall b : bin,
  incr (incr (double_bin b)) = double_bin (incr b).
Proof.
  destruct b.
  - reflexivity.
  - reflexivity.
  - reflexivity.
Qed.

Lemma nat_to_bin_double : forall n : nat,
  nat_to_bin (double n) = double_bin (nat_to_bin n).
Proof.
  induction n.
  - reflexivity.
  - simpl. rewrite -> IHn.
    rewrite -> double_inc. reflexivity.
Qed.

Theorem bin_nat_bin : forall b : bin,
  nat_to_bin (bin_to_nat b) = normalize b.
Proof.
  induction b.
  - reflexivity.
  - simpl. rewrite <- plus_n_O.
    rewrite <- double_plus. rewrite -> nat_to_bin_double.
    rewrite -> IHb. reflexivity.
  - simpl. rewrite <- plus_n_O.
    rewrite <- double_plus. rewrite -> nat_to_bin_double.
    rewrite -> IHb. reflexivity.
Qed.


Require Import SetoidClass SetoidCat.

Instance natS : Setoid nat :=
  {
    equiv := eq
  }
.

Definition plusS : natS ~> natS ~~> natS := injF2 plus _.

Definition minS := injF2 min _.

Lemma nat_int : forall n n' , n < S n' -> ~ n' < n.
Proof.
  double induction n n'.
  intros. intro. inversion H0.
  intros. intro. inversion H0. inversion H1.
  intros. intro. inversion H0. inversion H3.
  intros. intro. apply H0 with (n':=n0). apply le_S_n. auto. apply le_S_n. auto.
Qed.

Open Scope nat_scope.
Lemma plus_symmetry : forall a b, a+b = b+a.
Proof.
  induction a. intros. simpl. apply plus_n_O.
  intros. simpl. rewrite <- plus_n_Sm. f_equal. apply IHa.
Qed.

Definition ltS : natS ~> natS ~~> iff_setoid := injF2 lt _.


Require Import Omega.

Lemma size_induction X (f : X -> nat) (p : X -> Prop) :
  (forall x, (forall y, f y < f x -> p y) -> p x) ->
  forall x, p x.

Proof.
  intros step x. apply step.
  assert (G: forall n y, f y < n -> p y).
  { intros n. induction n.
    - intros y B. exfalso. omega.
    - intros y B. apply step. intros z C. apply IHn. omega.
  }
  apply G.
Qed.


Section Integers.
  Inductive Int : Set :=
  | zero : Int
  | succ : Int -> Int
  | opp : Int -> Int.

  Declare Scope Int_scope.
  Bind Scope Int_scope with Int.
  Open Scope Int_scope.
  Notation "- n" := (opp n) : Int_scope.

  Axiom opp_zero : opp zero = zero.

  Axiom opp_opp : forall n, - - n = n.

  Lemma equiv_implies_equiv_succ :
    forall (n m : Int), n=m -> (succ n) = (succ m).
  Proof.
    intros.
    apply f_equal with (f:= fun t => succ t) in H.
    apply H.
  Qed.

  Lemma equiv_succ_implies_equiv :
    forall (n m : Int), (succ n) = (succ m) -> n = m.
  Proof.
    intros. inversion H. reflexivity.
  Qed.

  Fixpoint add (n m : Int) : Int :=
  match n with
  | zero => m
  | succ n' => succ (add n' m)
  | opp n' => - (add n' (- m))
  end.

  Infix "+" := add (at level 50, left associativity) : Int_scope.
  Notation "n - m" := (add n (opp m)) : Int_scope.

  Lemma add_zero_l : forall (n : Int), zero + n = n.
  Proof.
    trivial.
  Qed.

  Lemma add_zero_r : forall (n : Int), n + zero = n.
  Proof.
    intros. induction n; simpl.
    - reflexivity.
    - rewrite IHn. reflexivity.
    - rewrite opp_zero. rewrite IHn. reflexivity.
  Qed.

  Lemma opp_distr : forall (n m : Int), opp (n + m) = (opp n) + (opp m).
  Proof.
    intros. induction n; simpl; repeat rewrite opp_opp; try reflexivity.
  Qed.

  Lemma add_succ_l : forall n m, succ n + m = succ (n + m).
  Proof.
    intros. simpl. reflexivity.
  Qed.

  Lemma add_succ_r : forall n m, n + succ m = succ (n + m).
  Proof.
    intros. induction m; simpl.
    - rewrite add_zero_r.
  Qed.

  Theorem add_associativity :
    forall (i j k : Int), i + (j + k) = (i + j) + k.
  Proof.
    intros. induction k; simpl.
    - repeat rewrite add_zero_r. reflexivity.
    - simpl.

  Theorem add_associativity :
    forall (i j k : Int), i + (j + k) = (i + j) + k.
  Proof.
    intros. induction i.
    simpl. reflexivity.
    simpl. rewrite <- IHi. reflexivity.
    simpl. rewrite <- IHi. reflexivity.
    induction j. induction k.
    all: repeat rewrite add_zero; simpl; try reflexivity.
    repeat rewrite opp_distr, opp_opp. replace (succ (j + k)) with (succ j + k).
    apply f_equal with (f := fun t => i + i + t).
  Qed.

  Lemma add_succ_zero : forall (n : Int), succ n = n + succ zero.
  Proof.
    intro. induction n. trivial.
    symmetry. apply f_equal with (f := fun t => succ t) in IHn as IH2.
    simpl. rewrite <- IH2. reflexivity.
    apply f_equal with (f := fun t => pred t) in IHn as IH2.
    simpl. rewrite <- IH2. rewrite pred_succ_equiv. apply succ_pred_equiv.
    rewrite <- opp_pred. rewrite <- opp_opp. rewrite opp_distr. rewrite opp_opp.
    apply f_equal with (f := fun t => opp t). rewrite opp_succ. rewrite opp_zero.
    replace (pred n) with (pred (n + zero)).
    apply f_equal with (f := fun t => opp t) in IHn as IH2.
    rewrite opp_distr, opp_succ, opp_succ, opp_zero in IH2.
    replace (n + pred zero) with (n + n -n + pred zero).
    rewrite <- IH2.

  Lemma add_succ : forall (n m : Int), succ (n + m) = n + (succ m).
  Proof.
    intros. induction n.
    simpl. reflexivity.
    simpl. rewrite <- IHn. reflexivity.
    simpl. rewrite <- IHn.
    rewrite succ_pred_equiv. rewrite pred_succ_equiv. reflexivity.
    induction n. induction m. repeat rewrite add_zero in IHn.
    all:

  Theorem add_commutativity : forall (n m : Int), n + m = m + n.
  Proof.
    intros.
    induction n.
    simpl. symmetry. apply add_zero.
    simpl. rewrite IHn. apply add_succ.
    simpl. rewrite IHn. apply add_pred.
  Qed.

  Theorem add_closure : forall (n m : Int), exists (x : Int), n + m = x.
  Proof.
    intros. now exists (n + m).
  Qed.

  Qed.

  Lemma add_pred : forall (n m : Int), pred (n + m) = n + (pred m).
  Proof.
    intros. induction n.
    simpl. reflexivity.
    simpl. rewrite <- IHn.
    rewrite succ_pred_equiv. rewrite pred_succ_equiv. reflexivity.
    simpl. rewrite <- IHn. reflexivity.
  Qed.

  Lemma equiv_implies_add_equiv :
    forall (i j k : Int), i = j -> (i + k) = (j + k).
  Proof.
    intros. apply f_equal with (f := fun t => t + k). apply H.
  Qed.

  Lemma add_equiv_implies_equiv :
    forall (i j k : Int), (i + k) = (j + k) -> i = j.
  Proof.
    intros. induction k.
    rewrite add_zero in H. apply H.
    repeat rewrite <- add_succ in H. apply equiv_succ_implies_equiv in H.
    apply IHk. apply H.
    apply IHk. rewrite <- add_pred in H.
    symmetry. rewrite <- add_pred in H.
    apply f_equal with (f := fun t => succ t) in H.
    rewrite succ_pred_equiv in H.
    symmetry. rewrite succ_pred_equiv in H.
    apply H.
  Qed.

  Lemma add_permutes : forall (i j k : Int), i + j + k = j + k + i.
  Proof.
    intros.
    rewrite <- add_commutativity. rewrite add_associativity.
    symmetry. rewrite <- add_associativity. rewrite add_commutativity.
    reflexivity.
  Qed.

  Fixpoint subtract (n m : Int) : Int :=
  match n, m with
  | _, zero => n
  | _, succ m' => pred (subtract n m')
  | _, pred m' => succ (subtract n m')
  end.

  Infix "-" := subtract (at level 50, left associativity).

  Theorem subtract_anticommutativity : forall (n m : Int), n - m = (zero - m) + n.
  Proof.
    intros. induction m. simpl. reflexivity.
    simpl. symmetry. rewrite <- IHm. reflexivity.
    simpl. symmetry. rewrite <- IHm. reflexivity.
  Qed.

  Theorem add_negative : forall (n m : Int), n + (zero - m) = n - m.
  Proof.
    intros. induction m. simpl. apply add_zero.
    simpl. rewrite <- IHm. rewrite add_pred. reflexivity.
    simpl. rewrite <- IHm. rewrite add_succ. reflexivity.
  Qed.

  Theorem subtract_add : forall (i j k : Int), i - (j + k) = (i - j) - k.
  Proof.
    intros. induction k. simpl. rewrite add_zero. reflexivity.
    simpl. rewrite <- add_succ. simpl.
    apply f_equal with (f := fun t => pred t). apply IHk.
    simpl. rewrite <- add_pred. simpl.
    apply f_equal with (f := fun t => succ t). apply IHk.
  Qed.

  Theorem add_subtract : forall (i j k : Int), i + (j - k) = (i + j) - k.
  Proof.
    intros. induction i. simpl. reflexivity.
    simpl. rewrite IHi. apply f_equal with (f := fun t => pred t).

  Fixpoint sign (n : Int) : Int :=
  match n with
  | zero => zero
  | pred zero => pred zero
  |

  Fixpoint multiply (n m : Int) : Int :=
  match n with
  | zero => zero
  | succ n' => (multiply n' m) + m
  | pred n' => (multiply n' m) - m
  end.

  Infix "*" := multiply (at level 40, left associativity).

  Lemma multiply_zero : forall (n : Nat), n * zero = zero.
  Proof.
    intros. induction n.
    simpl. reflexivity.
    simpl. apply IHn.
  Qed.

  Lemma multiply_succ : forall (n m : Nat), n * (succ m) = n + n * m.
  Proof.
    intros. induction n.
    simpl. reflexivity.
    simpl. rewrite IHn. apply equiv_implies_equiv_succ.
    repeat rewrite add_associativity. apply equiv_implies_add_equiv.
    apply add_commutativity.
  Qed.

  Lemma add_multiply : forall (i j k : Nat), i * (j + k) = i*j + i*k.
  Proof.
    intros. induction i.
    simpl. reflexivity.
    simpl. rewrite IHi. repeat rewrite add_associativity.
    apply equiv_implies_add_equiv. rewrite add_permutes.
    symmetry. rewrite add_permutes. apply equiv_implies_add_equiv.
    rewrite add_commutativity. reflexivity.
  Qed.

  Theorem multiply_commutativity : forall (n m : Nat), n * m = m * n.
  Proof.
    intros. induction n.
    rewrite multiply_zero. simpl. reflexivity.
    rewrite multiply_succ. simpl.
    rewrite add_commutativity. symmetry. rewrite add_commutativity.
    apply equiv_implies_add_equiv. symmetry. apply IHn.
  Qed.

  Theorem multiply_associativity :
    forall (i j k : Nat), i * (j * k) = (i * j) * k.
  Proof.
    intros. induction i. simpl. reflexivity.
    simpl. symmetry. rewrite multiply_commutativity.
    rewrite add_multiply. rewrite multiply_commutativity.
    rewrite add_commutativity. symmetry. rewrite add_commutativity.
    apply equiv_implies_add_equiv. rewrite IHi.
    symmetry. apply multiply_commutativity.
  Qed.

  Theorem multiply_closure : forall (n m : Nat), exists x, x = n * m.
  Proof.
    intros. now exists (n * m).
  Qed.

  Lemma multiply_permutes : forall (i j k : Nat), i * j * k = j * k * i.
  Proof.
    intros. symmetry. rewrite multiply_commutativity.
    apply multiply_associativity.
  Qed.


(****************************************************************************

          IEEE754  :  Rpow

          Laurent Thery

  *****************************************************************************
  Definition of an exponential function over relative numbers *)
Require Export Omega.
Require Export Digit.
(* We have already an exponential over natural number,
   we prove some basic properties for this function *)

Theorem pow_O : forall e : R, (e ^ 0)%R = 1%R.
simpl in |- *; auto with real.
Qed.

Theorem pow_1 : forall e : R, (e ^ 1)%R = e.
simpl in |- *; auto with real.
Qed.

Theorem pow_NR0 : forall (e : R) (n : nat), e <> 0%R -> (e ^ n)%R <> 0%R.
intros e n; elim n; simpl in |- *; auto with real.
Qed.

Theorem pow_add :
 forall (e : R) (n m : nat), (e ^ (n + m))%R = (e ^ n * e ^ m)%R.
intros e n; elim n; simpl in |- *; auto with real.
intros n0 H' m; rewrite H'; auto with real.
Qed.
Hint Resolve pow_O pow_1 pow_NR0 pow_add: real.

Theorem pow_RN_plus :
 forall (e : R) (n m : nat),
 e <> 0%R -> (e ^ n)%R = (e ^ (n + m) * / e ^ m)%R.
intros e n; elim n; simpl in |- *; auto with real.
intros n0 H' m H'0.
rewrite Rmult_assoc; rewrite <- H'; auto.
Qed.

Theorem pow_lt : forall (e : R) (n : nat), (0 < e)%R -> (0 < e ^ n)%R.
intros e n; elim n; simpl in |- *; auto with real.
intros n0 H' H'0; replace 0%R with (e * 0)%R; auto with real.
Qed.
Hint Resolve pow_lt: real.

Theorem Rlt_pow_R1 :
 forall (e : R) (n : nat), (1 < e)%R -> 0 < n -> (1 < e ^ n)%R.
intros e n; elim n; simpl in |- *; auto with real.
intros H' H'0; Contradict H'0; auto with arith.
intros n0; case n0.
simpl in |- *; rewrite Rmult_1_r; auto.
intros n1 H' H'0 H'1.
replace 1%R with (1 * 1)%R; auto with real.
apply Rlt_trans with (r2 := (e * 1)%R); auto with real.
apply Rmult_lt_compat_l; auto with real.
apply Rlt_trans with (r2 := 1%R); auto with real.
apply H'; auto with arith.
Qed.
Hint Resolve Rlt_pow_R1: real.

Theorem Rlt_pow :
 forall (e : R) (n m : nat), (1 < e)%R -> n < m -> (e ^ n < e ^ m)%R.
intros e n m H' H'0; replace m with (m - n + n).
rewrite pow_add.
pattern (e ^ n)%R at 1 in |- *; replace (e ^ n)%R with (1 * e ^ n)%R;
 auto with real.
apply Rminus_lt.
repeat rewrite (fun x : R => Rmult_comm x (e ^ n));
 rewrite <- Rmult_minus_distr_l.
replace 0%R with (e ^ n * 0)%R; auto with real.
apply Rmult_lt_compat_l; auto with real.
apply pow_lt; auto with real.
apply Rlt_trans with (r2 := 1%R); auto with real.
apply Rlt_minus; auto with real.
apply Rlt_pow_R1; auto with arith.
apply plus_lt_reg_l with (p := n); auto with arith.
rewrite le_plus_minus_r; auto with arith; rewrite <- plus_n_O; auto.
rewrite plus_comm; auto with arith.
Qed.
Hint Resolve Rlt_pow: real.

Theorem pow_R1 :
 forall (r : R) (n : nat), (r ^ n)%R = 1%R -> Rabs r = 1%R \/ n = 0.
intros r n H'.
case (Req_dec (Rabs r) 1); auto; intros H'1.
case (Rdichotomy _ _ H'1); intros H'2.
generalize H'; case n; auto.
intros n0 H'0.
cut (r <> 0%R); [ intros Eq1 | idtac ].
2: Contradict H'0; auto with arith.
2: simpl in |- *; rewrite H'0; rewrite Rmult_0_l; auto with real.
cut (Rabs r <> 0%R); [ intros Eq2 | apply Rabs_no_R0 ]; auto.
absurd (Rabs (/ r) ^ 0 < Rabs (/ r) ^ S n0)%R; auto.
replace (Rabs (/ r) ^ S n0)%R with 1%R.
simpl in |- *; apply Rlt_irrefl; auto.
rewrite Rabs_Rinv; auto.
rewrite <- Rinv_pow; auto.
rewrite RPow_abs; auto.
rewrite H'0; rewrite Rabs_right; auto with real.
apply Rlt_pow; auto with arith.
rewrite Rabs_Rinv; auto.
apply Rmult_lt_reg_l with (r := Rabs r).
case (Rabs_pos r); auto.
intros H'3; case Eq2; auto.
rewrite Rmult_1_r; rewrite Rinv_r; auto with real.
generalize H'; case n; auto.
intros n0 H'0.
cut (r <> 0%R); [ intros Eq1 | auto with real ].
2: Contradict H'0; simpl in |- *; rewrite H'0; rewrite Rmult_0_l;
    auto with real.
cut (Rabs r <> 0%R); [ intros Eq2 | apply Rabs_no_R0 ]; auto.
absurd (Rabs r ^ 0 < Rabs r ^ S n0)%R; auto with real arith.
repeat rewrite RPow_abs; rewrite H'0; simpl in |- *; auto with real.
Qed.

Theorem Zpower_NR0 :
 forall (e : Z) (n : nat), (0 <= e)%Z -> (0 <= Zpower_nat e n)%Z.
intros e n; elim n; unfold Zpower_nat in |- *; simpl in |- *;
 auto with zarith.
Qed.

Theorem Zpower_NR1 :
 forall (e : Z) (n : nat), (1 <= e)%Z -> (1 <= Zpower_nat e n)%Z.
intros e n; elim n; unfold Zpower_nat in |- *; simpl in |- *;
 auto with zarith.
Qed.
Hint Resolve Zpower_NR0 Zpower_NR1: zarith.
(* To define exponential over relative number, we simply do
   a case analysis on the sign of the number *)

(*Definition powerRZ :=
   [e : R] [n : Z]  Cases n of
                      ZERO => R1
                     | (POS p) => (pow e (convert p))
                     | (NEG p) => (Rinv (pow e (convert p)))
                    end.*)
(* we now prove some basic properties of our exponential *)

Theorem powerRZ_O : forall e : R, powerRZ e 0 = 1%R.
simpl in |- *; auto.
Qed.

Theorem powerRZ_1 : forall e : R, powerRZ e (Zsucc 0) = e.
simpl in |- *; auto with real.
Qed.

Theorem powerRZ_NOR : forall (e : R) (z : Z), e <> 0%R -> powerRZ e z <> 0%R.
intros e z; case z; simpl in |- *; auto with real.
Qed.
Hint Resolve powerRZ_O powerRZ_1 powerRZ_NOR: real.

Theorem powerRZ_add :
 forall (e : R) (n m : Z),
 e <> 0%R -> powerRZ e (n + m) = (powerRZ e n * powerRZ e m)%R.
intros e n m; case n; case m; simpl in |- *; auto with real.
intros n1 m1; rewrite nat_of_P_plus_morphism; auto with real.
intros n1 m1. rewrite Z.pos_sub_spec; unfold Pos.compare.
CaseEq (Pcompare m1 n1 Datatypes.Eq); simpl in |- *; auto with real.
intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real.
intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real.
rewrite (pow_RN_plus e (nat_of_P n1 - nat_of_P m1) (nat_of_P m1));
 auto with real.
rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
rewrite Rinv_mult_distr; auto with real.
rewrite Rinv_involutive; auto with real.
apply lt_le_weak.
apply nat_of_P_lt_Lt_compare_morphism; auto.
apply ZC2; auto.
intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real.
rewrite (pow_RN_plus e (nat_of_P m1 - nat_of_P n1) (nat_of_P n1));
 auto with real.
rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
apply lt_le_weak.
change (nat_of_P m1 > nat_of_P n1) in |- *.
apply nat_of_P_gt_Gt_compare_morphism; auto.
intros n1 m1. rewrite Z.pos_sub_spec; unfold Pos.compare.
CaseEq (Pcompare n1 m1 Datatypes.Eq); simpl in |- *; auto with real.
intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real.
intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real.
rewrite (pow_RN_plus e (nat_of_P m1 - nat_of_P n1) (nat_of_P n1));
 auto with real.
rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
rewrite Rinv_mult_distr; auto with real.
apply lt_le_weak.
apply nat_of_P_lt_Lt_compare_morphism; auto.
apply ZC2; auto.
intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real.
rewrite (pow_RN_plus e (nat_of_P n1 - nat_of_P m1) (nat_of_P m1));
 auto with real.
rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
apply lt_le_weak.
change (nat_of_P n1 > nat_of_P m1) in |- *.
apply nat_of_P_gt_Gt_compare_morphism; auto.
intros n1 m1; rewrite nat_of_P_plus_morphism; auto with real.
intros H'; rewrite pow_add; auto with real.
apply Rinv_mult_distr; auto.
apply pow_NR0; auto.
apply pow_NR0; auto.
Qed.
Hint Resolve powerRZ_O powerRZ_1 powerRZ_NOR powerRZ_add: real.

Theorem powerRZ_Zopp :
 forall (e : R) (z : Z), e <> 0%R -> powerRZ e (- z) = (/ powerRZ e z)%R.
intros e z H; case z; simpl in |- *; auto with real.
intros p; apply sym_eq; apply Rinv_involutive.
apply pow_nonzero; auto.
Qed.

Theorem powerRZ_Zs :
 forall (e : R) (n : Z),
 e <> 0%R -> powerRZ e (Zsucc n) = (e * powerRZ e n)%R.
intros e n H'0.
replace (Zsucc n) with (n + Zsucc 0)%Z.
rewrite powerRZ_add; auto.
rewrite powerRZ_1.
rewrite Rmult_comm; auto.
auto with zarith.
Qed.
(* Conversion theorem between relative numbers and reals *)

Theorem Zpower_nat_Z_powerRZ :
 forall (n : Z) (m : nat),
 IZR (Zpower_nat n m) = powerRZ (IZR n) (Z_of_nat m).
intros n m; elim m; simpl in |- *; auto with real.
intros m1 H'; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; simpl in |- *.
replace (Zpower_nat n (S m1)) with (n * Zpower_nat n m1)%Z.
rewrite Rmult_IZR; auto with real.
rewrite H'; simpl in |- *.
case m1; simpl in |- *; auto with real.
intros m2; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto.
unfold Zpower_nat in |- *; auto.
Qed.

Theorem powerRZ_lt : forall (e : R) (z : Z), (0 < e)%R -> (0 < powerRZ e z)%R.
intros e z; case z; simpl in |- *; auto with real.
Qed.
Hint Resolve powerRZ_lt: real.

Theorem powerRZ_le :
 forall (e : R) (z : Z), (0 < e)%R -> (0 <= powerRZ e z)%R.
intros e z H'; apply Rlt_le; auto with real.
Qed.
Hint Resolve powerRZ_le: real.

Theorem Rlt_powerRZ :
 forall (e : R) (n m : Z),
 (1 < e)%R -> (n < m)%Z -> (powerRZ e n < powerRZ e m)%R.
intros e n m; case n; case m; simpl in |- *;
 try (unfold Zlt in |- *; intros; discriminate); auto with real.
intros p p0 H' H'0; apply Rlt_pow; auto with real.
apply nat_of_P_lt_Lt_compare_morphism; auto.
intros p H' H'0; replace 1%R with (/ 1)%R; auto with real.
intros p p0 H' H'0; apply Rlt_trans with (r2 := 1%R).
replace 1%R with (/ 1)%R; auto with real.
apply Rlt_pow_R1; auto with real.
intros p p0 H' H'0; apply Rinv_1_lt_contravar; auto with real.
apply Rlt_pow; auto with real.
apply nat_of_P_lt_Lt_compare_morphism; rewrite ZC4; auto.
Qed.
Hint Resolve Rlt_powerRZ: real.

Theorem Rpow_R1 :
 forall (r : R) (z : Z),
 r <> 0%R -> powerRZ r z = 1%R -> Rabs r = 1%R \/ z = 0%Z.
intros r z; case z; simpl in |- *; auto; intros p H' H'1; left.
case (pow_R1 _ _ H'1); auto.
intros H'0; Contradict H'0; auto with zarith; apply convert_not_O.
rewrite Rinv_pow in H'1; auto.
case (pow_R1 _ _ H'1); auto.
intros H'0.
rewrite <- H'0.
apply Rmult_eq_reg_l with (r := 1%R); auto with real.
pattern 1%R at 1 in |- *; rewrite <- H'0; auto with real.
pattern (Rabs (/ r)) at 1 in |- *; rewrite Rabs_Rinv; try rewrite Rinv_l;
 auto with real.
rewrite H'0; auto with real.
apply Rabs_no_R0; auto.
intros H'0; Contradict H'0; auto with zarith; apply convert_not_O.
Qed.

Theorem Rpow_eq_inv :
 forall (r : R) (p q : Z),
 r <> 0%R -> Rabs r <> 1%R -> powerRZ r p = powerRZ r q -> p = q.
intros r p q H' H'0 H'1.
cut (powerRZ r (p - q) = 1%R); [ intros Eq0 | idtac ].
case (Rpow_R1 _ _ H' Eq0); auto with zarith.
intros H'2; case H'0; auto.
apply Rmult_eq_reg_l with (r := powerRZ r q); auto with real.
rewrite <- powerRZ_add; auto.
replace (q + (p - q))%Z with p; auto with zarith.
rewrite <- H'1; rewrite Rmult_1_r; auto with arith.
Qed.

Theorem Zpower_nat_powerRZ_absolu :
 forall n m : Z,
 (0 <= m)%Z -> IZR (Zpower_nat n (Zabs_nat m)) = powerRZ (IZR n) m.
intros n m; case m; simpl in |- *; auto with zarith.
intros p H'; elim (nat_of_P p); simpl in |- *; auto with zarith.
intros n0 H'0; rewrite <- H'0; simpl in |- *; auto with zarith.
rewrite <- Rmult_IZR; auto.
intros p H'; Contradict H'; auto with zarith.
Qed.

Theorem powerRZ_R1 : forall n : Z, powerRZ 1 n = 1%R.
intros n; case n; simpl in |- *; auto.
intros p; elim (nat_of_P p); simpl in |- *; auto; intros n0 H'; rewrite H';
 ring.
intros p; elim (nat_of_P p); simpl in |- *.
exact Rinv_1.
intros n1 H'; rewrite Rinv_mult_distr; try rewrite Rinv_1; try rewrite H';
 auto with real.
Qed.

Theorem Rle_powerRZ :
 forall (e : R) (n m : Z),
 (1 <= e)%R -> (n <= m)%Z -> (powerRZ e n <= powerRZ e m)%R.
intros e n m H' H'0.
case H'; intros E1.
case (Zle_lt_or_eq _ _ H'0); intros E2.
apply Rlt_le; auto with real.
rewrite <- E2; auto with real.
repeat rewrite <- E1; repeat rewrite powerRZ_R1; auto with real.
Qed.

Theorem Zlt_powerRZ :
 forall (e : R) (n m : Z),
 (1 <= e)%R -> (powerRZ e n < powerRZ e m)%R -> (n < m)%Z.
intros e n m H' H'0.
case (Zle_or_lt m n); auto; intros Z1.
Contradict H'0.
apply Rle_not_lt.
apply Rle_powerRZ; auto.
Qed.

Theorem Zle_powerRZ :
 forall (e : R) (n m : Z),
 (1 < e)%R -> (powerRZ e n <= powerRZ e m)%R -> (n <= m)%Z.
intros e n m H' H'0.
case (Zle_or_lt n m); auto; intros Z1.
absurd (powerRZ e n <= powerRZ e m)%R; auto.
apply Rlt_not_le.
apply Rlt_powerRZ; auto.
Qed.

Theorem Rinv_powerRZ :
 forall (e : R) (n : Z), e <> 0%R -> (/ powerRZ e n)%R = powerRZ e (- n).
intros e n H.
apply Rmult_eq_reg_l with (powerRZ e n); auto with real zarith.
rewrite Rinv_r; auto with real zarith.
rewrite <- powerRZ_add; auto with real zarith.
ring_simplify (n + - n)%Z; simpl in |- *; auto.
Qed.


(********************************************************************)
(*                                                                  *)
(*  The Why3 Verification Platform   /   The Why3 Development Team  *)
(*  Copyright 2010-2018   --   Inria - CNRS - Paris-Sud University  *)
(*                                                                  *)
(*  This software is distributed under the terms of the GNU Lesser  *)
(*  General Public License version 2.1, with the special exception  *)
(*  on linking described in file LICENSE.                           *)
(*                                                                  *)
(********************************************************************)

(* This file is generated by Why3's Coq-realize driver *)
(* Beware! Only edit allowed sections below    *)
Require Import BuiltIn.
Require Reals.Rtrigo_def.
Require Reals.Rpower.
Require Reals.R_sqrt.
Require BuiltIn.
Require real.Real.
Require real.Square.
Require real.ExpLog.

Import Rpower.

(* Why3 comment *)
(* pow is replaced with (Reals.Rpower.Rpower x x1) by the coq driver *)

(* Why3 goal *)
Lemma Pow_def :
forall (x:R) (y:R),
 (0%R < x)%R ->
 ((Reals.Rpower.Rpower x y) = (Reals.Rtrigo_def.exp (y * (Reals.Rpower.ln x))%R)).
Proof.
easy.
Qed.

(* Why3 goal *)
Lemma Pow_pos :
forall (x:R) (y:R), (0%R < x)%R -> (0%R < (Reals.Rpower.Rpower x y))%R.
Proof.
intros x y h1.
apply Exp_prop.exp_pos.
Qed.

(* Why3 goal *)
Lemma Pow_plus :
forall (x:R) (y:R) (z:R),
 (0%R < z)%R ->
 ((Reals.Rpower.Rpower z (x + y)%R) = ((Reals.Rpower.Rpower z x) * (Reals.Rpower.Rpower z y))%R).
Proof.
intros x y z h1.
now apply Rpower_plus.
Qed.

(* Why3 goal *)
Lemma Pow_mult :
forall (x:R) (y:R) (z:R),
 (0%R < x)%R ->
 ((Reals.Rpower.Rpower (Reals.Rpower.Rpower x y) z) = (Reals.Rpower.Rpower x (y * z)%R)).
Proof.
intros x y z h1.
now apply Rpower_mult.
Qed.

(* Why3 goal *)
Lemma Pow_x_zero :
forall (x:R), (0%R < x)%R -> ((Reals.Rpower.Rpower x 0%R) = 1%R).
Proof.
intros x h1.
now apply Rpower_O.
Qed.

(* Why3 goal *)
Lemma Pow_x_one :
forall (x:R), (0%R < x)%R -> ((Reals.Rpower.Rpower x 1%R) = x).
Proof.
intros x h1.
now apply Rpower_1.
Qed.

(* Why3 goal *)
Lemma Pow_one_y :
forall (y:R), ((Reals.Rpower.Rpower 1%R y) = 1%R).
Proof.
intros y.
unfold Rpower.
rewrite ln_1.
rewrite Rmult_0_r.
now apply  Rtrigo_def.exp_0.
Qed.

(* Why3 goal *)
Lemma Pow_x_two :
forall (x:R),
 (0%R < x)%R -> ((Reals.Rpower.Rpower x 2%R) = (Reals.RIneq.Rsqr x)).
Proof.
intros x h1.
rewrite (Rpower_pow 2) by easy.
simpl.
now rewrite Rmult_1_r.
Qed.

(* Why3 goal *)
Lemma Pow_half :
forall (x:R),
 (0%R < x)%R -> ((Reals.Rpower.Rpower x (05 / 10)%R) = (Reals.R_sqrt.sqrt x)).
Proof.
intros x h1.
replace (5 / 10)%R with (/ 2)%R by field.
now apply Rpower_sqrt.
Qed.


(** 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 (lf2 : natural) (z : natural) (x : natural) : natural :=
  plus z (plus lf2 (mult z x)).


Theorem plus_n_n_injective : forall n m,
  n + n = m + m ->
  n = m.
Proof.
  intros n. induction n as [| n'].
  - destruct m.
    -- intro H. reflexivity.
    -- simpl. intro H2. inversion H2.
  - destruct m as [|m'].
    -- intros H2. inversion H2.
    -- intro H. Search (S _ = S _). apply eq_S.
    apply IHn'. simpl in H. inversion H.
    rewrite <- plus_n_Sm in H1.
    rewrite <- plus_n_Sm in H1.
    inversion H1. reflexivity.
Qed.