Require Import ZArith Zwf.
Require Import ZArith.Znumtheory.
Require Import Psatz.
Set Implicit Arguments.
Open Scope Z.

Lemma rel_prime_factor_exclusive : forall a b c, a <> 0 -> b <> 0 -> rel_prime a b -> 1 < c -> (c | a) -> ~(c | b).
Proof.
  intros a b c Ha Hb Hrp Hc Hdiv.
  destruct Hdiv as [a' ->].
  intros [b' ->].
  rewrite <- Zgcd_1_rel_prime in Hrp.
  rewrite Z.gcd_mul_mono_r_nonneg in Hrp; auto with *.
  rewrite Z.mul_comm in Hrp.
  destruct (Z.mul_eq_1 _ _ Hrp); subst; auto with *.
Qed.

Lemma root_divide : forall n k, 1 <= k -> (n | n ^ k).
Proof.
  intros.
  replace k with (1 + (k - 1)); auto with *.
  rewrite Z.pow_add_r; auto with *.
  cbn.
  auto with *.
Qed.
Hint Resolve root_divide.

Lemma factor_prod : forall a b c d, (a | b) -> (c | d) -> (a * c | b * d).
Proof.
  intros a b c d [b' -> ] [d' ->].
  exists (b' * d').
  lia.
Qed.

Lemma not_prime_divide_prime :
  forall n, 1 < n -> ~prime n -> exists p, 1 < p < n /\ (p | n) /\ prime p.
Proof.
  intro n.
  induction n using (well_founded_ind (Zwf_well_founded 0)).
  intros Hlt (m & Hrange & Hdiv)%not_prime_divide; auto.
  destruct (prime_dec m) as [Hp | Hnp]; eauto.
  destruct (H m) as (p & Hp); auto with *.
  - unfold Zwf.
    auto with *.
  - exists p.
    intuition.
    eauto using Z.divide_trans.
Qed.

Inductive Factors : Z -> Prop :=
| factors_1 : Factors 1
| factors_prod : forall p m, prime p -> Factors m -> Factors (m * p).
Hint Constructors Factors.

Lemma pos_factors : forall n, 1 <= n -> Factors n.
Proof.
  induction n using (well_founded_ind (Zwf_well_founded 0)).
  intro Hn.
  destruct (Zle_lt_or_eq _ _ Hn) as [Hgt | <-]; auto.
  destruct (prime_dec n) as [Hp | Hnp].
  - rewrite <- Z.mul_1_l.
    auto.
  - apply not_prime_divide_prime in Hnp; auto.
    destruct Hnp as (p & Hrange & [n' ->] & Hp).
    apply factors_prod; auto.
    assert (1 <= n') as Hn'; try nia.
    apply H; auto.
    unfold Zwf.
    nia.
Qed.

Lemma factors_pos : forall n, Factors n -> 1 <= n.
Proof.
  intros.
  induction H; auto with *.
  destruct H.
  apply Z.le_trans with m; auto.
  rewrite <- Z.le_mul_diag_r; auto with *.
Qed.
Hint Resolve factors_pos.

Lemma divide_sq_prime : forall p b, prime p -> 1 <= b -> (p ^ 2 | b ^ 2) -> (p | b).
Proof.
  intros p b Hp Hb Hdiv.
  assert (p | b ^ 2) as Hdiv'. {
    apply Z.divide_trans with (p ^ 2); auto with *.
  }
  clear Hdiv.
  rewrite Z.pow_2_r in Hdiv'.
  apply prime_mult in Hdiv'; tauto.
Qed.

Lemma divide_sq_inv : forall a b, 1 <= a -> 1 <= b -> (a ^ 2 | b ^ 2) -> (a | b).
Proof.
  intros a b Ha Hb.
  revert b Hb.
  induction (pos_factors Ha); auto with *.
  intros b Hb Hdiv.
  destruct (@divide_sq_prime p b) as [k ->]; auto with *.
  - apply Z.divide_trans with ((m * p) ^ 2); auto.
    rewrite Z.pow_mul_l.
    auto with *.
  - apply Z.mul_divide_mono_r.
    apply IHf; auto with *.
    + destruct H.
      nia.
    + repeat rewrite Z.pow_mul_l in Hdiv.
      eapply Z.mul_divide_cancel_r; eauto with *.
      intros He%Z.pow_eq_0; subst; auto with *.
Qed.

Definition Square n := exists m, n = m ^ 2.
Lemma Square_pow_2 : forall n, Square (n ^ 2).
Proof.
  intros.
  exists n.
  reflexivity.
Qed.
Hint Resolve Square_pow_2.

Lemma Square_square : forall n, Square (n * n).
Proof.
  intros.
  exists n.
  lia.
Qed.
Hint Resolve Square_square.

Lemma Square_nonneg_root : forall n, Square n -> exists m, 0 <= m /\ n = m ^ 2.
Proof.
  intros n [m ->].
  destruct (Z.lt_ge_cases m 0); eauto.
  exists (- m).
  split; auto with *.
  lia.
Qed.

Lemma Square_product : forall n m, Square n -> Square m -> Square (n * m).
Proof.
  intros n m [n' ->] [m' ->].
  exists (n' * m').
  lia.
Qed.

Lemma Square_product_inv_r : forall n m, 0 <> n -> Square (n * m) -> Square n -> Square m.
Proof.
  intros n m Hnzn (k & Hnnegk & Hk)%Square_nonneg_root (n' & Hnnegn' & ->)%Square_nonneg_root.
  destruct (Z.eq_dec m 0) as [| Hnzm];subst;[exists 0; lia|].
  assert ((n' | k)) as [k' ->]. {
    apply divide_sq_inv; try nia.
    rewrite <- Hk.
    auto with *.
  }
  exists k'.
  rewrite <- Z.mul_cancel_r with (p := n' ^ 2); auto.
  lia.
Qed.

Lemma Square_product_inv_l : forall n m, 0 <> m -> Square (n * m) -> Square m -> Square n.
Proof.
  intros.
  rewrite Z.mul_comm in *.
  eapply Square_product_inv_r; eauto.
Qed.

Lemma prime_mult_sq_aux : forall p n m, prime p -> ~(p | m) -> (p ^ 2 | n * m) -> (p ^ 2 | n).
Proof.
  intros p.
  intros n m Hp Hnd [k Hk].
  assert (p | n * m) as Hdivpnm. {
    rewrite Hk.
    auto with *.
  }
  apply prime_mult in Hdivpnm; auto.
  destruct Hdivpnm as [[n' ->]|]; try contradiction.
  assert (p | n' * m) as Hdivpn'm. {
    destruct Hp.
    replace (n' * m) with (k * p); auto with *.
    nia.
  }
  apply prime_mult in Hdivpn'm; auto.
  destruct Hdivpn'm as [[n'' ->]|]; try contradiction.
  auto with *.
  exists n''.
  lia.
Qed.

Lemma prime_mult_sq : forall p n m, prime p -> rel_prime n m -> (p ^ 2 | n * m) -> (p ^ 2 | n) \/ (p ^ 2 | m).
Proof.
  intros p n m Hp Hrp Hdiv.
  destruct (Z.eq_dec 0 m); subst; auto with *.
  destruct (Z.eq_dec 0 n); subst; auto with *.

  assert (p | n * m) as [Hpn | Hpm]%prime_mult; auto with *.
  - apply Z.divide_trans with (p ^ 2); auto with *.
  - left.
    apply prime_mult_sq_aux with m; auto.
    apply rel_prime_factor_exclusive with n; auto with *.
    now destruct Hp.
  - right.
    rewrite Z.mul_comm in Hdiv.
    apply rel_prime_sym in Hrp.
    apply prime_mult_sq_aux with n; auto.
    apply rel_prime_factor_exclusive with m; auto with *.
    now destruct Hp.
Qed.

Lemma rel_prime_square_l : forall n m,
    1 <= n -> 1 <= m ->
    rel_prime n m -> Square (n * m) -> Square n.
Proof.
  intros n m Hposn Hposm Hrp (k & Hposk & Hk)%Square_nonneg_root.

  assert (1 <= k) as Hposk'; try nia.
  clear Hposk.
  revert Hk.
  revert n Hposn m Hposm Hrp.
  induction (pos_factors Hposk') as [| p k Hp].
  - exists 1.
    nia.
  - intros n Hposn m Hpsm Hrp Hsq.
    pose proof Hp as [Hppos _].
    assert (p ^ 2 | n * m) as Hdivppnm. {
      rewrite Hsq.
      rewrite Z.pow_mul_l.
      auto with *.
    }
    apply prime_mult_sq in Hdivppnm; auto with *.
    destruct Hdivppnm as [[n' ->] | [m' ->]].
    + apply Square_product; auto.
      apply IHf with (m := m); auto with *.
      * cut (0 <= n'); try nia.
        apply Zmult_le_0_reg_r with (n := p * p); auto with *.
        lia.
      * eapply rel_prime_div; eauto with *.
      * rewrite <- Z.sub_move_0_r.
        apply Zmult_integral_l with (p ^ 2); try lia.
        intros x%Z.pow_eq_0; auto with *.
    + apply IHf with (m := m'); auto with *.
      * cut (0 <= m'); try nia.
        apply Zmult_le_0_reg_r with (n := p * p); auto with *.
        lia.
      * apply rel_prime_sym.
        apply rel_prime_sym in Hrp.
        eapply rel_prime_div; eauto with *.
      * rewrite <- Z.sub_move_0_r.
        apply Zmult_integral_l with (p ^ 2). try lia.
        intros x%Z.pow_eq_0; auto with *.
        lia.
Qed.

Lemma rel_prime_square_r : forall n m,
    1 <= n -> 1 <= m ->
    rel_prime n m -> Square (n * m) -> Square m.
Proof.
  intros.
  apply rel_prime_square_l with (m := n); auto.
  - now apply rel_prime_sym.
  - now rewrite Z.mul_comm.
Qed.

Theorem P1 : forall n,
    0 < n -> Z.gcd (n ^ 2 + 1) (5 * n ^ 2 + 9) = if Z.even n then 1 else 2.
Proof.
  intros n Hpos.
  replace (Z.gcd _ _ ) with (Z.gcd (n * n + 1) 4).
  - rewrite Z.gcd_comm.
    destruct (Z.Even_or_Odd n) as [He | Ho].
    + rewrite (proj2 (Z.even_spec _) He).
      destruct He as [m ->].
      replace (2 * m * (2 * m) + 1) with (1 + m ^ 2 * 4); try lia.
      now rewrite  Z.gcd_add_mult_diag_r.
    + rewrite <- Z.negb_odd.
      rewrite (proj2 (Z.odd_spec _) Ho).
      simpl negb.
      destruct Ho as [m ->].
      replace (_ + _) with (2 * (1 + (m * m +  m) * 2)); try lia.
      replace 4 with (2 * 2); auto.
      rewrite Z.gcd_mul_mono_l.
      now rewrite Z.gcd_add_mult_diag_r.
  - rewrite <- (@Z.gcd_add_mult_diag_r _ 4 5).
    f_equal; lia.
Qed.

Theorem P2 : forall n, 0 < n -> ~Square ((n ^ 2 + 1) * (5 * n ^ 2 + 9)).
Proof.
  intros n Hposn.
  assert (1 <= n ^ 2 + 1) as Hp1; try nia.
  assert (1 <= 5 * n ^ 2 + 9) as Hp2; auto with *.

  pose proof (P1 Hposn) as Hrp.
  destruct (Z.Even_or_Odd n) as [He | Ho].
  - rewrite <- Z.even_spec in He.
    rewrite He in *.
    rewrite Zgcd_1_rel_prime in Hrp.
    intro Hsq.
    pose proof (rel_prime_square_l Hp1 Hp2 Hrp Hsq) as (m & Hnnnegm & Hm)%Square_nonneg_root.
    destruct (Z.le_gt_cases m n); nia.
  - destruct Ho as [m ->].
    replace (Z.even (2 * m + 1)) with (Z.even (1 + 2 * m)) in Hrp;try solve [f_equal; lia].
    rewrite Z.even_add_mul_2 in Hrp.
    remember (2 * m ^ 2 + 2 * m + 1) as X.
    replace ((2 * m + 1) ^ 2 + 1) with (X * 2) in *; try lia.
    remember (10 * m * (m + 1) + 7) as Y.
    replace (5 * (2 * m + 1) ^ 2 + 9) with (Y * 2) in *; try lia.
    rewrite Z.gcd_mul_mono_r_nonneg, Z.mul_id_l, Zgcd_1_rel_prime in Hrp; auto with *.
    intro Hsq.
    absurd (Square Y).
    + intro HsqY.
      cut (Y mod 4 = 3 /\ Y mod 4 = 1); auto with *.
      split.
      * rewrite HeqY.
        rewrite Z.add_mod; try discriminate.
        rewrite <- Z.mul_assoc.
        assert (2 | m * (m + 1)) as [m' Heqm']. {
          destruct (Z.Even_or_Odd m) as [[m' ->] | [m' ->]].
          - exists (m' * (2 * m' + 1)). lia.
          - exists ((2 * m' + 1) * (m' + 1)). lia.
        }
        replace (10 * (m * (m + 1))) with (5 * m' * 4); try lia.
        rewrite Z.mod_mul; auto with *.
      * apply Square_nonneg_root in HsqY.
        destruct HsqY as (Y' & HnnegY' & ->).
        destruct (Z.Even_or_Odd Y') as [[Y'' ->] | [Y'' ->]]; try lia.
        replace (_ ^ 2) with (1 + (Y'' ^ 2 + Y'') * 4); try lia.
        rewrite Z.mod_add; auto with *.
    + apply rel_prime_square_r with X; auto with *.
      apply Square_product_inv_l with 4; auto with *.
      * apply (eq_ind _ _ Hsq).
        lia.
      * now exists 2.
Qed.


Require Import Arith.

(* AVOIR SON COURS SOUS LES YEUX *)
(* AVOIR SON COURS SOUS LES YEUX *)
(* AVOIR SON COURS SOUS LES YEUX *)
(* AVOIR SON COURS SOUS LES YEUX *)
(* AVOIR SON COURS SOUS LES YEUX *)

(**********************************************************************)
(* Un prédicat particulier : =                                        *)
(**********************************************************************)
(* Un prédicat = est déjà défini en Coq. On peut considérer qu'il s'agit de la plus petite relation réflexive *)
(* C'est un inductif avec une seule règle de construction : pour tout x on construit  x=x. *)
(* La règle d'introduction de = est "reflexivity". *)

Lemma egalite : 4=4.
Proof.
reflexivity.
Qed.

(* Lorsqu'on a une ÉGALITÉ x = y dans une hypothèse, disons Heq, on peut remplacer
- dans le but
  + tous les x libres par des y avec
    rewrite -> Heq.
  + tous les y libres par des x avec
    rewrite <- Heq.
- dans une hypothèse, disons H,
  + tous les x libres par des y avec
    rewrite -> Heq in H.
  + tous les y libres par des x avec
    rewrite <- Heq in H.
 *)

Lemma ex_rewrite (x : nat)  : 1 + (x + 3) = 6 -> 1 + (x + 3) = 1 + x + 3  -> 1 + (1 + x + 3) = 1 + 6.
Proof.
intro.
intro.
rewrite <- H.
rewrite -> H0.
reflexivity.
Qed.

(* En Coq des CONSTRUCTEURS DIFFÉRENTS donnent des TERMES DIFFÉRENTS.  *)
(* Si en hypothèse on trouve le prédicat d'égalité avec deux membres différents alors on peut achever la preuve directement avec
"discriminate". *)
Lemma hyp_egal_diff : 3=4 -> False.
Proof.
(* cette formule vient de l'introduction de la flèche *)
intro Habs.
(* on voit que l'hypothèse Habs est une égalité avec deux constructeurs différents, on finit la preuve directement avec "discriminate". *)
discriminate.
Qed.

(**********************************************************************)
(* STRUCTURE DE BASE DES LISTES (FINIES) D'ENTIERS                    *)
(**********************************************************************)

(*On rappelle que les objets de type nat sont définis inductivement de façon similaire à
Inductive entiers : Set :=
  | O : entiers
  | S : entiers -> entiers.
*)

Print nat.

(* On dispose donc d'un principe d'induction nat_ind, construit à peu près comme vu en cours *)
Check nat_ind.
(* Si on omet le "forall P" qui n'est PAS du premier ordre, on se retrouve bien avec deux branches :
   - une branche qui demande de prouver sur le cas de base des nat, c'est-à-dire 0
   - une branche qui demande de prouver sur un nat construit par S à partir d'un nat sur lequel on sait déjà prouevr la propriété
   On peut en déduire la propriété sur tout nat obtenu par 0 et S. *)

(* EN COQ : l'application de la tactique "induction" sur un nom
   d'entier produira donc DEUX sous-buts (il y a bien 2 règles de
   construction des entiers...) :
  - Le sous-but correspondant au cas de bas O,
  - Le sous-but correspondant au cas inductif où l'hypothèse d'induction apparaît
    dans le contexte.

COMME ON SAIT que ça va mettre deux nouvelles choses dans la branche de droite et rien de nouveau dans celle de gauche on peut même nommer directement :
   induction "n" as [ | "m" "Hyp_Ind_m"].
où n est dans le cas de droite l'entier S m avec comme hypothèse d'induction que la propriété est vraie pour m (hypothèse nommée ici Hyp_Ind_m).
 *)

(* On définit les listes de nat *)
Inductive nlist : Set :=
| nnil : nlist
| ncons : nat -> nlist -> nlist.

(* ... avec des notations confortables *)
Infix "::" := ncons.
Notation "[]" := nnil.

(* Vous avez vu la génération des principes d'induction ? *)
Check nlist_ind.
(* C'est tout à fait similaire au cas des nat.
   Si on omet le "forall P" qui n'est PAS du premier ordre, on se retrouve bien avec deux branches :
   - une branche qui demande de prouver sur le cas de base des listes
   - une branche qui demande de prouver sur une liste construite par :: à partir d'une liste sur laquelle on sait déjà prouevr la propriété
   On peut en déduire la propriété sur toute liste obtenue par [] et ::. *)

(******************************************************************************)
(* FONCTIONS NON-RECRUSIVES SUR LES TYPES INDUCTIFS                           *)
(******************************************************************************)

(* Si on n'a pas besoin d'hypothèse d'induction, il est en général suffisant de faire une étude par cas,
   c'est-à-dire un destruct de l'objet étudié *)

Inductive Alphabet : Type :=
| a : Alphabet
| b : Alphabet.

(* Prouvez les correction et complétude de la fonction comp_alphabet de votre TP de LIFLF, c'est-à-dire qu'elle retourne true si et seulement si ses deux paramètres sont égaux
  - on procède par cas sur les deux paramètres
  - on peut être amené à faire des calculs (avec simpl dans le but ou simpl in toto dans l'hypothèse toto. *)
Definition comp_alphabet (x : Alphabet) (y : Alphabet) : bool := (* mettez votre code ici *)
match (x, y) with
| (a,a) => true
| (b, b) => true
| _ => false
end.

Theorem comp_alphabet_ssi (x : Alphabet) (y : Alphabet) : (comp_alphabet x y = true -> x = y) /\ (x = y -> comp_alphabet x y = true).
Proof.
split.
-intro h0.
induction x as [a | b].
induction y as [a | b].
reflexivity.
discriminate.
induction y as [a | b].
discriminate.
reflexivity.
-intro h0.
induction x as [a | b].
induction y as [a | b].
reflexivity.
discriminate.
induction y as [a | b].
discriminate.
reflexivity.
Qed.

(* On rappelle la fonction de comparaison sur les option nat codée en LIFLF *)
Definition comp_option_nat (x y: option nat) : bool :=
match (x, y) with
| (None, None) => true
| (None, Some m) => false
| (Some m, None) => false
| (Some m, Some n) => Nat.eqb m n
end.

(* EN COQ : si on a une hypothèse H : forall x, P(x) on peut la
 spécialiser en une nouvelle hypothèse pour une certaine valeur de x,
 disons n. Pour celà on invoque "pose (H n) as nouveauH".  On crée
 alors une nouvelle hypothèse qui s'appelle nouveauH qui est un cas
 particulier de H, celui où x vaut n : nouveauH : P(n)
*)

(* Montrer que (comp_option_nat x y) retourne true SEULEMENT SI x=y.
   on utilisera le théorème
   beq_nat_true: forall n m : nat, Nat.eqb n  m = true -> n = m
   qu'on spécialisera aux bons paramètres "n_fixe", "m_fixe" avec
   pose (beq_nat_true "n_fixe" "m_fixe") as "nom_de_la_nouvelle_hypothèse".

  ATTENTION : Nat.eqb e1 e2 s'écrit aussi e1 =? e2

*)
Theorem comp_option_nat_seulement_si (x : option nat) (y : option nat) : comp_option_nat x y = true -> x = y.
Proof.
induction x.
-induction y.
+intro h0.
pose (beq_nat_true a0 a1) as h1.
destruct h1.
rewrite <- h0.
reflexivity.
reflexivity.
+intro h0.
discriminate.
-induction y.
+intro h0.
pose (beq_nat_true a0) as h1.
discriminate.
+intro h0.
reflexivity.
Qed.

(******************************************************************************)
(* FONCTIONS RECURSIVES ET INDUCTION SUR LES ENTIER                           *)
(******************************************************************************)

(* Exercice : montrer que la fonction plus appliquée à 0 et un x quelconque retourne x. *)
(* La définition de plus est récursive sur le paramètre de gauche, donc pas de problème ici, c'est juste un calcul (simpl) *)
Lemma plus_Z_l (x : nat) : plus 0 x = x.
Proof.
simpl.
reflexivity.
Qed.

(* Exercice : montrer que la fonction plus appliquée un x quelconque et 0 retourne x. *)
(* Mmmh là il faut travailler par induction sur x... *)
(* on utilise "induction x as..." qui invoque la règle nat_ind. *)
Lemma plus_Z_r (x : nat) : plus x 0 = x.
Proof.
induction x as [ | n].
-reflexivity.
-simpl.
rewrite -> IHn.
reflexivity.
Qed.

(******************************************************************************)
(* FONCTIONS RECURSIVES ET INDUCTION SUR LES LISTES                           *)
(******************************************************************************)

(* Exercice *)
(* Définir "concat" la fonction de concaténation de deux listes l1 et l2 (par récursion sur l1) *)
Fixpoint concat (l1 l2 : nlist) : nlist := (* écrire votre code ici *)
  match l1 with
  | [] => l2
  | n::l11 => n::(concat l11 l2)
  end.

(* On note ++ en notation infix pour la concatenation *)
Infix "++" := concat.

(* VU EN COURS : fonction de longueur des listes                              *)
Fixpoint length (l : nlist) : nat :=
  match l with
  | []     => 0
  | x :: l => S(length l)
  end.

(* Exercice : montrer que la fonction retourne 0 SEULEMENT SI la liste
   est vide *)
Lemma length_zero_seulement_si_vide (l : nlist) : length l = 0 -> l=[].
Proof.
intro h0.
induction l as [ | n l1].
-reflexivity.
-destruct IHl1.
+rewrite <- h0.
discriminate.
+discriminate.
Qed.

(* Exercice : montrer que la fonction appliquée à la concaténation de
deux listes quelconques l1 l2 retourne la somme des applications de
cette fonction à chacune des deux listes.*)
Lemma length_of_concat (l1 : nlist) (l2 : nlist) : length (l1 ++ l2) = length l1 + length l2.
Proof.
induction l1 as [ | l10 H1].
-simpl.
reflexivity.
-simpl.
rewrite -> IHH1.
reflexivity.
Qed.

(* QUANTIFICATION UNIVERSELLE *)
(* Règle d'introduction du quantificateur universel *)
(* La tactique utilisée pour la règle d'introduction de l'universel est intro "nom de la variable générique". *)

(* Prouver que pour tout nat x et toute liste de nat l,
la liste vide n'est pas obtenue par l'ajout de x en tête de l. *)
Lemma nil_neq_cons : forall (x:nat), forall (l:nlist), [] = x :: l -> False.
Proof.
  intro un_element_general.
  intro une_liste_generale.
  intro Habsurde.
    (* poursuivre la preuve *)
  discriminate.
Qed.

(* Exprimer et montrer que pour tout élément x et toutes listes l1 et
l2, ajouter x en tête de la concaténation de l1 et l2 est
la même chose que concaténer l1 avec x en tête et l2. *)
(* pas de difficulté, c'est juste un pas de calcul (simpl). *)

Lemma concat_cons : forall (x:nat), forall (l1:nlist), forall (l2:nlist), concat (x::l1) l2 = x::concat l1 l2 -> True.
Proof.
intro x.
intro l1.
intro l2.
simpl.
reflexivity.
Qed.

(* Eprimer et montrer maintenant que pour toute liste l1, concaténer à l1 la liste vide renvoie exactement la liste l1. *)
(* Comme on a défini concat par récursion sur le premier paramètre, il va falloir une induction... *)
Lemma concat_nil_r : forall (l1:nlist), concat l1 [] = l1 -> True.
Proof.
induction l1 as [ | l10 H1].
-simpl.
reflexivity.
-simpl.
reflexivity.
Qed.


(** Cheat sheet available at
      #https://www-sop.inria.fr/teams/marelle/types18/cheatsheet.pdf#
*)

From mathcomp Require Import all_ssreflect.

Implicit Type p q r : bool.
Implicit Type m n a b c : nat.

(** ***
    Try to prove the following theorems using no
    lemma and minimizing the number of applications of
    the tactic case
*)

(** *** Exercise 1:
*)

Lemma andTb p : true && p = p.
(*D*)Proof. by []. Qed.

(** *** Exercise 2:
*)

Lemma andbT p : p && true = p.
(*D*)Proof. by case: p. Qed.

(** *** Exercise 3:
*)

Lemma orbC p q : p || q = q || p.
(*D*)Proof. by case: p; case: q. Qed.

(** *** Exercise 4:
*)
Goal forall p q,    (p && q) || (   p && ~~ q) ||
                 (~~ p && q) || (~~ p && ~~ q).
(*D*)Proof. by move=> p q; case: p; case: q. Qed.

(** *** Exercise 5 :
*)
Goal forall p q r, (p || q) && r = r && (p || q).
(*D*)Proof. by move=> p q r; case: (p || q); case: r. Qed.

Goal forall n, n < n.+1.
by [].
Qed.

(** *** Exercise 6  :
   - look up what [==>]
*)
(*D*)Locate "==>".
(*D*)Print implb.
Lemma implybE p q : p ==> q = ~~ p || q.
(*D*) Proof. by case: p. Qed.

(** *** Exercise 7  :
    Try to prove using the case tactic and alternatively
    without using the case tactic
*)

Lemma negb_imply p q : ~~ (p ==> q) = p && ~~ q.
(*D*) (* Proof. by case: p. Qed. *)
(*D*) Proof. by rewrite implybE negb_or negbK. Qed.

(** *** Exercise 8  :
    Try to prove using the case tactic and alternatively
    without using the case tactic
*)
Lemma Peirce p q : ((p ==> q) ==> p) ==> p.
(*D*) (* Proof. by case: p; case: q. Qed. *)
(*D*) Proof. by rewrite implybE negb_imply implybE orbK orNb. Qed.

(** *** Exercise 9 :
    - what is [(+)] ?
    - prove this using move and rewrite
*)
Lemma find_me p q :  ~~ p = q -> p (+) q.
(*D*)Locate "(+)".
(*D*)Search _ addb negb.
(*D*)Proof. by move=> np_q; rewrite -np_q addbN negb_add. Qed.

(** ***
    maxn defines the maximum of two numbers
*)

Print maxn.
Search maxn in ssrnat.

(** ***
    We define the maxinum of three number as
    folllow
*)

Definition max3n a b c :=
   if a < b then maxn b c else maxn a c.

(** ***
    Try to prove the following theorem
    (you may use properties of maxn)
*)

(** *** Exercise 10
*)

Lemma max3n3n a : max3n a a a = a.
(*D*) Proof. by rewrite /max3n if_same maxnn. Qed.

(** *** Exercise 11
*)
Lemma max3E a b c : max3n a b c = maxn (maxn a b) c.
(*D*) Proof. by rewrite /max3n /maxn; case: (a < b). Qed.

(** *** Exercise 12
*)
Lemma max3n_213 a b c : max3n a b c = max3n b a c.
(*D*) Proof. by rewrite max3E (maxnC a) -max3E. Qed.

(** *** Exercise 13
*)
Lemma max3n_132 a b c : max3n a b c = max3n a c b.
(*D*) Proof. by rewrite max3E -maxnA (maxnC b) maxnA -max3E. Qed.

(** *** Exercise 14
*)
Lemma max3n_231 a b c : max3n a b c = max3n b c a.
(*D*) Proof. by rewrite max3n_213 max3n_132. Qed.

(** ***
    We define functions that test if 3 natural numbers are
    in increasing (or decreasing) order
*)

Definition order3n (T : Type) (r : rel T) x y z := (r x y) && (r y z).
Definition incr3n := order3n nat (fun x y => x <= y).
Definition decr3n := order3n nat (fun x y => y <= x).

(** *** Exercise 15
*)
Lemma incr3n_decr a b c : incr3n a b c = decr3n c b a.
(*D*) Proof. by rewrite /incr3n /order3n andbC. Qed.

(** *** Exercise 16
*)

Lemma incr3_3n a : incr3n a a a.
(*D*) by rewrite /incr3n /order3n leqnn. Qed.

(** *** Exercise 17
*)

Lemma decr3_3n a : decr3n a a a.
(*D*) by rewrite -incr3n_decr incr3_3n. Qed.

(** *** Exercise 18
*)

Lemma incr3n_leq12 a b c : incr3n a b c -> a <= b.
(*D*) by rewrite /incr3n /order3n; case: (_ <= _). Qed.

(** *** Exercise 19
*)
Lemma incr3n_leq23 a b c : incr3n a b c -> b <= c.
(*D*) by rewrite /incr3n /order3n; case: (_ <= _). Qed.

(** *** Exercise 20
*)
Lemma incr3n_eq a b c : incr3n a b a = (a == b).
(*D*) by rewrite /incr3n /order3n eqn_leq. Qed.


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

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

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

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

Notation "a || b" := (or_b a b).
Notation "a && b" := (and_b a b).
Notation "- a" := (neg_b a).

Check (false && true).

    (* Equivalent à : - simpl. reflexivity. tapé 4 fois (pour chaque pair (a, b))*)
Theorem deMorgan : forall a b, (-a || -b) = -(a && b).
Proof.
    intros a b.
    destruct a; destruct b; (simpl; reflexivity).
Qed.

Theorem doubleNeg : forall n, --n = n.
Proof.
    intro n.
    destruct n.
    - (*cas n = false*) trivial. (*équivalent à simpl. reflexivity. (+ d'autre trucs)*)
    - (* cas n = true*) trivial.
Qed.

Theorem existBool : exists p, p && true = true.
Proof.
   exists true.
   simpl. reflexivity.
Qed.

Theorem idempotence : forall p, p && p = p.
Proof.
  intro p.
  destruct p.
  - trivial.
  - trivial.
Qed.


(* Software Foundations *)
(* Exercice 4 stars, subseq *)

Require Import Coq.Lists.List.
Import ListNotations.

Inductive subseq: (list nat)->(list nat)-> Prop :=
|seq_nil: forall l, subseq [] l
|seq_1: forall n l1 l2, subseq l1 l2 -> subseq l1 (n::l2)
|seq_2: forall n l1 l2, subseq l1 l2 -> subseq (n::l1) (n::l2).

Theorem subseq_refl: forall l, subseq l l.
Proof.
    intros. induction l as [|h t].
    apply seq_nil.
    apply seq_2. apply IHt.
Qed.

Theorem subseq_append: forall l1 l2 l3, subseq l1 l2 -> subseq l1 (l2 ++ l3).
Proof.
    intros. induction H.
    apply seq_nil.
    simpl. apply seq_1. apply IHsubseq.
    simpl. apply seq_2. apply IHsubseq.
Qed.

Theorem subseq_transitive: forall l1 l2 l3, subseq l1 l2 -> subseq l2 l3 -> subseq l1 l3.
Proof.
    intros.
    induction H0.
    inversion H. apply seq_nil.
    apply seq_1. apply IHsubseq. apply H.
Abort.


(* énoncé identique à TD03_nat_Exp.v, avec
  - suppression des entraînements sur les listes et sur nat
  - une correction de get
  - des tests devant fonctionner sur eval
  - renomme, decale, bexp à faire
  *)

(**
Deux objectifs dans ce TD :
- deux structures linéaires qui serviront constamment,
  les listes et les entiers naturels,
  et les pricipes de récurrence associés
- extensions des expressions arithmétiques
*)

(** * Entiers naturels *)

(** En mathématiques, les entiers ne sont plus une notion primitive depuis
    les travaux de Dedekind et Peano au 19e siècle : ils sont obtenus
    à partir de deux constructions élémentaires :
    - l'entier nul, que l'on notera O ;
    - le successeur d'un entier [n] déjà construit, que l'on notera [S n].
    C'est exactement ce que l'on obtient avec le type inductif suivant.
*)

Print nat.

Fact deux : 2 = S (S O).
Proof. (** regarder le but écrit par Coq *) reflexivity. Qed.

(** * Quelques commandes de recherche d'information *)

(** Quelle est la fonction qui est derrière le symbole "+" ? *)
Locate "+".
(**  Print est connu *)
Print Nat.add.
(** Intégration de l'espace de nommage Nat *)
Import Nat.
Locate "+".
(* Quelles fonctions de type [nat -> nat -> nat] sot disponibles ? *)
Search (nat -> nat -> nat).

(** * AST d'expressions arithmétiques, le retour *)

(** On considère des expressions arithmétiques comprenant
    non seulement des opération et des constantes, mais aussi des noms
    de variables.
    Pour simplifier on considère que ces variables s'écriraient "x0", "x1",
    "x2", etc., ce qui permet de les représenter par un simple entier naturel.
    Noter que les constructeurs [Ana] et [Ava] permettent de distinguer
    la constante 2 de la variable x2.
*)

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

(* Définir les expressions aexp correspondant à
  (1 + x2) * 3 et  (x0 * 2) + x3
 *)

Definition aexp_ex1 : aexp := Amu (Apl (Aco 1) (Ava 2)) (Aco 3).
Definition aexp_ex2 : aexp := Apl (Amu (Ava 0) (Aco 2)) (Ava 3).

(** Pour évaluer une expression représentée par un tel AST,
    on considère un *état*, c'est à dire une association entre
    chaque nom de variable et un valeur dans [nat].
    On choisit de représenter un tel état par une liste d'entiers,
    avec comme convention :
    - le premier élément de cette liste est la valeur associée à x0
    - le second élément de cette liste est la valeur associée à x1
    - et ainsi de suite ;
    - pour les noms restants, la valeur associée est 0.
    Par exemple, dans l'état Cons 3 (Cons 0 (Cons 8 Nil)),
    la valeur associée à x0 est 3, la valeur associée à x1 est 0,
    la valeur associée à x2 est 8, et la valeur associée à x3, x4, etc.
    est 0.
 *)

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

Definition s_ex1 : state := Cons 3 (Cons 0 (Cons 8 Nil)).

(* ----------------------------------------------------------------------- *)
(** Définition d'une fonction [get] qui rend la valeur associée à xi dans l'état s *)

Fixpoint get (i: nat) (s: state) : nat :=
  match s with
  | Nil => 0
  | Cons v s' =>
    match i with
    | O => v
    | S i' => get i' s'
    end
  end.

Example get_ex1 : get 2 s_ex1 = 8.
Proof. reflexivity. Qed.

(* ----------------------------------------------------------------------- *)

(** Définir une fonction [eval] qui rend la valeur d'une aexp dans l'état s **)

(** Même si la fonction get ci-dessus a été laissée 'Admitted', elle est
    utilisable dans les questions suivantes.  **)

Fixpoint eval (a: aexp) (s: state) : nat :=
  match a with
  | Aco n => n
  | Ava i => get i s
  | Apl a1 a2 => eval a1 s + eval a2 s
  | Amu a1 a2 => eval a1 s * eval a2 s
  | Amo a1 a2 => eval a1 s - eval a2 s
  end.

Example eval_ex1_ex1 : eval aexp_ex1 s_ex1 = 27.
Proof. reflexivity. Qed.
Example eval_ex2_ex1 : eval aexp_ex2 s_ex1 = 6.
Proof. reflexivity. Qed.

(* ----------------------------------------------------------------------- *)

(** Définir une fonction [renomme] qui prend une aexp [a] et rend [a] où
    les variables correspondant à x0, x1, x2... ont été respectivement
    renommées en x1, x2, x3...  *)

Fixpoint renomme (a: aexp) : aexp :=
  match a with
  | Aco n => Aco n
  | Ava i => Ava (S i)
  | Apl a1 a2 => Apl (renomme a1) (renomme a2)
  | Amu a1 a2 => Amu (renomme a1) (renomme a2)
  | Amo a1 a2 => Amo (renomme a1) (renomme a2)
  end.

(** Définir une fonction [decale] qui prend un état [s] et rend
    l'état dans lequel la valeur de x0 est 0,
    la valeur de x1 est la valeur de x0 dans [s],
    la valeur de x2 est la valeur de x1 dans [s],
    la valeur de x3 est la valeur de x2 dans [s], etc.
    Indication : ce n'est PAS un Fixpoint *)

Definition decale (s : state) : state := Cons 0 s.

    (** Démontrer qu'évaluer une expression renommée dans un environnement
    décalé rend la même chose qu'avant *)

Theorem eval_renomme_decale : forall (a: aexp) (s: state),
eval a s = eval (renomme a) (decale s).
Proof.
  intros a s.
  induction a as [|i|a1 IH1 a2 IH2|a1 IH1 a2 IH2|a1 IH1 a2 IH2].
  - reflexivity.
  - simpl. reflexivity.
  - simpl. rewrite IH1. rewrite IH2. reflexivity.
  - simpl. rewrite IH1. rewrite IH2. reflexivity.
  - simpl. rewrite IH1. rewrite IH2. reflexivity.
Qed.

(* ----------------------------------------------------------------------- *)
(** ** Expressions booléennes *)

(** Définir un type d'AST nommé bexp pour des expressions booléennes
    comprenant :
    - les constantes booléennes Btrue et Bfalse
    - un opérateur booléen unaire Bnot
    - des opérateurs booléens binaires Band et Bor
    - un opérateur de comparaison représentant le test d'égalité
      entre deux expressions arithmétiques
*)

Inductive bexp : Set :=
| Btrue : bexp
| Bfalse : bexp
| Bnot : bexp -> bexp
| Band : bexp -> bexp -> bexp
| Bor : bexp -> bexp -> bexp
| Beq : bexp -> bexp -> bexp.

(** L'environnenent initial de Coq comprend, en plus de [nat],
    un type énuméré nommé [bool à deux valeurs nommées [true] et [false]
    ainsi que des fonctions telles que la disjonction entre deux valeurs
    de type [bool].
    Vous pouvez découvrir tout cela au moyen de la commande "Print bool"
    et de la commande Search indiquée ci-dessus, mais on vous demande de
    reprogrammer les fonctions booléennes par vous-même en utilisant, comme
    pour [coulfeu], match with suivant le schéma :

      match blabla_booléen with
      | true => ...
      | false => ...
      end

    L'opération de comparaison entre deux entiers devra aussi être programmée.

    Définir une fonction d'évaluation sur bexp en s'appuyant sur ces fonctions.
*)

Fixpoint evalb (b: bexp) (s: state) : bool :=
  match b with
    | Btrue => true
    | Bfalse => false
    | Bnot b' => match evalb b' s with
                | true => false
                | false => true
                end
    | Band b1 b2 => match evalb b1 s, evalb b2 s with
                    | true, true => true
                    | _, _ => false
                    end
    | Bor b1 b2 => match evalb b1 s, evalb b2 s with
                    | false, false => false
                    | _, _ => true
                    end
    | Beq b1 b2 => match evalb b1 s , evalb b2 s with
                    | true, true | false, false => true
                    | _, _ => false
                    end
    end.

Definition bexp_ex1 := Bnot ( Btrue ).
Definition bexp_ex2 := Band ( Btrue ) ( Bfalse ).
Definition bexp_ex3 := Bor ( Btrue ) ( Bfalse ).

Example evalb_ex1_ex1 : evalb bexp_ex1 s_ex1 = false.
Proof. reflexivity. Qed.
Example evalb_ex2_ex1 : evalb bexp_ex2 s_ex1 = false.
Proof. reflexivity. Qed.
Example evalb_ex3_ex1 : evalb bexp_ex3 s_ex1 = true.
Proof. reflexivity. Qed.

(* ----------------------------------------------------------------------- *)


Require Import Coq.ZArith.ZArith.
Require Import Coq.micromega.Lia.
Require Import Lists.List.
Local Open Scope Z.

Local Open Scope Z_scope.
Module Z.
  Definition modexp_pos a p m := Pos.iter (fun z => (a * z) mod m) (1 mod m) p.
  Definition modexp a p m
    := match p with
       | 0 => 1 mod m
       | Z.neg _ => 0
       | Z.pos p => modexp_pos a p m
       end.
  Lemma modexp_pos_correct a p m
    : modexp_pos a p m = Z.pow_pos a p mod m.
  Proof.
    cbv [Z.pow_pos modexp_pos].
    erewrite Pos.iter_swap_gen with (f := fun a => a mod m).
    { reflexivity. }
    { cbv beta; intros; now rewrite Zmult_mod_idemp_r. }
  Qed.
  Lemma modexp_correct a p m
    : modexp a p m = a ^ p mod m.
  Proof.
    cbv [modexp Z.pow]; destruct p;
      now rewrite ?modexp_pos_correct, ?Zmod_0_l.
  Qed.
End Z.


(** * ProofObjects: Working with Explicit Evidence in Coq *)

Require Export Logic.

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

(**  We have seen that Coq has mechanisms both for _programming_,
    using inductive data types (like [nat] or [list]) and functions
    over these types, and for _proving_ properties of these programs,
    using inductive propositions (like [ev] or [eq]), implication, and
    universal quantification.  So far, we have treated these mechanisms
    as if they were quite separate, and for many purposes this is
    a good way to think. But we have also seen hints that Coq's programming and
    proving facilities are closely related. For example, the
    keyword [Inductive] is used to declare both data types and
    propositions, and [->] is used both to describe the type of
    functions on data and logical implication. This is not just a
    syntactic accident!  In fact, programs and proofs in Coq are almost
    the same thing.  In this chapter we will study how this works.

    We have already seen the fundamental idea: provability in Coq is
    represented by concrete _evidence_.  When we construct the proof
    of a basic proposition, we are actually building a tree of evidence,
    which can be thought of as a data structure. If the proposition
    is an implication like [A -> B], then its proof will be an
    evidence _transformer_: a recipe for converting evidence for
    A into evidence for B.  So at a fundamental level, proofs are simply
    programs that manipulate evidence.
*)
(**
    Q. If evidence is data, what are propositions themselves?

    A. They are types!

    Look again at the formal definition of the [beautiful] property.  *)

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

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

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

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

(** Now let's look again at a previous proof involving [beautiful]. *)

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

(** Just as with ordinary data values and functions, we can use the [Print]
command to see the _proof object_ that results from this proof script. *)

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

(** In view of this, we might wonder whether we can write such
    an expression ourselves. Indeed, we can: *)

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

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

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

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

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

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

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

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

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

(** At any given moment, Coq has constructed a term with some
    "holes" (indicated by [?1], [?2], and so on), and it knows what
    type of evidence is needed at each hole.  *)

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

(** Tactic proofs are useful and convenient, but they are not
    essential: in principle, we can always construct the required
    evidence by hand, as shown above. Then we can use [Definition]
    (rather than [Theorem]) to give a global name directly to a
    piece of evidence. *)

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

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

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

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

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

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

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

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

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

(* ##################################################### *)
(** ** Quantification, Implications and Functions *)

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

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

    For example, consider this statement: *)

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

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

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

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

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

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

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

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

(** When we view the proposition being proved by [b_plus3] as a function type,
    one aspect of it may seem a little unusual. The second argument's
    type, [beautiful n], mentions the _value_ of the first argument, [n].
    While such _dependent types_ are not commonly found in programming
    languages, even functional ones like ML or Haskell, they can
    be useful there too.

    Notice that both implication ([->]) and quantification ([forall])
    correspond to functions on evidence.  In fact, they are really the
    same thing: [->] is just a shorthand for a degenerate use of
    [forall] where there is no dependency, i.e., no need to give a name
    to the type on the LHS of the arrow. *)

(** For example, consider this proposition: *)

Definition beautiful_plus3 : Prop :=
  forall n, forall (E : beautiful n), beautiful (n+3).

(** A proof term inhabiting this proposition would be a function
    with two arguments: a number [n] and some evidence [E] that [n] is
    beautiful.  But the name [E] for this evidence is not used in the
    rest of the statement of [funny_prop1], so it's a bit silly to
    bother making up a name for it.  We could write it like this
    instead, using the dummy identifier [_] in place of a real
    name: *)

Definition beautiful_plus3' : Prop :=
  forall n, forall (_ : beautiful n), beautiful (n+3).

(** Or, equivalently, we can write it in more familiar notation: *)

Definition beatiful_plus3'' : Prop :=
  forall n, beautiful n -> beautiful (n+3).

(** In general, "[P -> Q]" is just syntactic sugar for
    "[forall (_:P), Q]". *)

(** **** Exercise: 3 stars (b_times2) *)
(** First prove this theorem using tactics. *)

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

(** Now write a corresponding proof object directly. *)

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

(** **** Exercise: 2 stars, optional (gorgeous_plus13_po) *)
(** Give a proof object corresponding to the theorem [gorgeous_plus13] from Prop.v *)

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

(** It is particularly revealing to look at proof objects involving the
logical connectives that we defined with inductive propositions in Logic.v. *)

Theorem and_example :
  (beautiful 0) /\ (beautiful 3).
Proof.
  apply conj.
   (* Case "left". *)  apply b_0.
   (* Case "right". *)  apply b_3.  Qed.

(** Let's take a look at the proof object for the above theorem. *)

Print and_example.
(* ===>  conj (beautiful 0) (beautiful 3) b_0 b_3
            : beautiful 0 /\ beautiful 3 *)

(** Note that the proof is of the form
    conj (beautiful 0) (beautiful 3)
         (...pf of beautiful 3...) (...pf of beautiful 3...)
    as you'd expect, given the type of [conj]. *)

(** **** Exercise: 1 star, optional (case_proof_objects) *)
(** The [Case] tactics were commented out in the proof of
    [and_example] to avoid cluttering the proof object.  What would
    you guess the proof object will look like if we uncomment them?
    Try it and see. *)
(** [] *)

Theorem and_commut : forall P Q : Prop,
  P /\ Q -> Q /\ P.
Proof.
  intros P Q H.
  inversion H as [HP HQ].
  split.
    (* Case "left". *) apply HQ.
    (* Case "right". *) apply HP.  Qed.

(** Once again, we have commented out the [Case] tactics to make the
    proof object for this theorem easier to understand. It is still
    a little complicated, but after performing some simple reduction
    steps, we can see that all that is really happening is taking apart
    a record containing evidence for [P] and [Q] and rebuilding it in the
    opposite order: *)

Print and_commut.
(* ===>
    and_commut =
      fun (P Q : Prop) (H : P /\ Q) =>
        (fun H0 : Q /\ P => H0)
            match H with
            | conj HP HQ => (fun (HP0 : P) (HQ0 : Q) => conj Q P HQ0 HP0) HP HQ
            end
      : forall P Q : Prop, P /\ Q -> Q /\ P *)

(** After simplifying some direct application of [fun] expressions to arguments,
we get: *)

(* ===>
   and_commut =
     fun (P Q : Prop) (H : P /\ Q) =>
     match H with
     | conj HP HQ => conj Q P HQ HP
     end
     : forall P Q : Prop, P /\ Q -> Q /\ P *)

(** **** Exercise: 2 stars, optional (conj_fact) *)
(** Construct a proof object demonstrating the following proposition. *)

Definition conj_fact : forall P Q R, P /\ Q -> Q /\ R -> P /\ R :=
  (* FILL IN HERE *) admit.
(** [] *)

(** **** Exercise: 2 stars, advanced (beautiful_iff_gorgeous) *)

(** We have seen that the families of propositions [beautiful] and
    [gorgeous] actually characterize the same set of numbers.
    Prove that [beautiful n <-> gorgeous n] for all [n].  Just for
    fun, write your proof as an explicit proof object, rather than
    using tactics. (_Hint_: if you make use of previously defined
    theorems, you should only need a single line!) *)

Definition beautiful_iff_gorgeous :
  forall n, beautiful n <-> gorgeous n :=
  (* FILL IN HERE *) admit.
(** [] *)

(** **** Exercise: 2 stars, optional (or_commut'') *)
(** Try to write down an explicit proof object for [or_commut] (without
    using [Print] to peek at the ones we already defined!). *)

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

(** Recall that we model an existential for a property as a pair consisting of
a witness value and a proof that the witness obeys that property.
We can choose to construct the proof explicitly.

For example, consider this existentially quantified proposition: *)

Definition some_nat_is_even : Prop :=
  ex nat ev.

(** To prove this proposition, we need to choose a particular number
    as witness -- say, 4 -- and give some evidence that that number is
    even. *)

Definition snie : some_nat_is_even :=
  ex_intro _ ev 4 (ev_SS 2 (ev_SS 0 ev_0)).

(** **** Exercise: 2 stars (ex_beautiful_Sn) *)
(** Complete the definition of the following proof object: *)

Definition p : ex nat (fun n => beautiful (S n)) :=
(* FILL IN HERE *) admit.
(** [] *)

(* ##################################################### *)
(** ** Giving Explicit Arguments to Lemmas and Hypotheses *)

(** Even when we are using tactic-based proof, it can be very useful to
understand the underlying functional nature of implications and quantification.

For example, it is often convenient to [apply] or [rewrite]
using a lemma or hypothesis with one or more quantifiers or
assumptions already instantiated in order to direct what
happens.  For example: *)

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

Lemma plus_comm_r : forall a b c, c + (b + a) = c + (a + b).
Proof.
   intros a b c.
   (* rewrite plus_comm. *)
      (* rewrites in the first possible spot; not what we want *)
   rewrite (plus_comm b a).  (* directs rewriting to the right spot *)
   reflexivity.  Qed.

(** In this case, giving just one argument would be sufficient. *)

Lemma plus_comm_r' : forall a b c, c + (b + a) = c + (a + b).
Proof.
   intros a b c.
   rewrite (plus_comm b).
   reflexivity.  Qed.

(** Arguments must be given in order, but wildcards (_)
may be used to skip arguments that Coq can infer.  *)

Lemma plus_comm_r'' : forall a b c, c + (b + a) = c + (a + b).
Proof.
  intros a b c.
  rewrite (plus_comm _ a).
  reflexivity. Qed.

(** The author of a lemma can choose to declare easily inferable arguments
to be implicit, just as with functions and constructors.

  The [with] clauses we've already seen is really just a way of
  specifying selected arguments by name rather than position:  *)

Lemma plus_comm_r''' : forall a b c, c + (b + a) = c + (a + b).
Proof.
  intros a b c.
  rewrite plus_comm with (n := b).
  reflexivity. Qed.

(** **** Exercise: 2 stars (trans_eq_example_redux) *)
(** Redo the proof of the following theorem (from MoreCoq.v) using
an [apply] of [trans_eq] but _not_ using a [with] clause. *)

Example trans_eq_example' : forall (a b c d e f : nat),
     [a;b] = [c;d] ->
     [c;d] = [e;f] ->
     [a;b] = [e;f].
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ##################################################### *)
(** ** Programming with Tactics *)

(** If we can build proofs with explicit terms rather than
tactics, you may be wondering if we can build programs using
tactics rather than explicit terms.  Sure! *)

Definition add1 : nat -> nat.
intro n.
Show Proof.
apply S.
Show Proof.
apply n. Defined.

Print add1.
(* ==>
    add1 = fun n : nat => S n
         : nat -> nat
*)

Eval compute in add1 2.
(* ==> 3 : nat *)

(** Notice that we terminate the [Definition] with a [.] rather than with
[:=] followed by a term.  This tells Coq to enter proof scripting mode
to build an object of type [nat -> nat].  Also, we terminate the proof
with [Defined] rather than [Qed]; this makes the definition _transparent_
so that it can be used in computation like a normally-defined function.

This feature is mainly useful for writing functions with dependent types,
which we won't explore much further in this book.
But it does illustrate the uniformity and orthogonality of the basic ideas in Coq. *)

(* $Date: 2013-07-17 16:19:11 -0400 (Wed, 17 Jul 2013) $ *)


Require Import List.
Require Import Nat.

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

(*define insert sort *)

Fixpoint insert (n : nat) (sorted : list nat) : list nat :=
  match sorted with
  | nil => n :: nil
  | m :: t => if n <? m then n :: sorted
                       else m :: (insert n t)
  end.

Example insert1 : insert 5 [4;6] = [4;5;6].
 Proof. reflexivity. Qed.

Example insert2 : insert 7 [2;3;5;7;7;9;8] = [2;3;5;7;7;7;9;8].
 Proof. reflexivity. Qed.

Fixpoint insert_sort (arr : list nat) : list nat :=
  match arr with
  | nil => nil
  | m :: t =>insert m (insert_sort t)
  end.

Check insert_sort [7;5;9;8;3;7;7;2].

Example test_insert_sort1 : insert_sort [7;5;9;8;3;7;7;2] = [2;3;5;7;7;7;8;9].
 Proof. reflexivity. Qed.

Example test_insert_sort2 : insert_sort [] = [].
 Proof. reflexivity. Qed.

Example test_insert_sort3 : insert_sort [5;4;3;2;1;0] = [0;1;2;3;4;5].
 Proof. reflexivity. Qed.

(*define count func*)

Fixpoint count (v : nat) (l : list nat) : nat :=
  match l with
  | nil => O
  | h :: t => if v =? h then S(count v t)
                        else count v t
  end.

Example test_count1: count 1 [1;2;3;1;4;1] = 3.
  Proof. reflexivity. Qed.
Example test_count2: count 6 [1;2;3;1;4;1] = 0.
  Proof. reflexivity. Qed.

(*define is_sorted*)

Fixpoint is_sorted (arr : list nat) : bool :=
  match arr with
  | nil => true
  | h :: t => match t with
               | nil => true
               | k :: g => if h <=? k then is_sorted t
                                      else false
               end
  end.

Example test_is_sorted1: is_sorted [7;5;9;8;3;7;7;2] = false.
  Proof. reflexivity. Qed.

Example test_is_sorted2: is_sorted [2;3;5;7;7;7;8;9] = true.
  Proof. reflexivity. Qed.

Example test_is_sorted3: is_sorted [] = true.
  Proof. reflexivity. Qed.

(*Proof*)

(* nat lemmas *)

Lemma plus_1_neq_0_left : forall n : nat,
  S n =? 0 = false.
Proof.
  intros n. destruct n as [| n'] eqn:E.
  - reflexivity.
  - reflexivity. Qed.

Lemma plus_1_neq_0_right : forall n : nat,
  0 =? S n = false.
Proof.
  intros n. destruct n as [| n'] eqn:E.
  - reflexivity.
  - reflexivity. Qed.

Lemma nat_is_positive_right : forall n : nat,
  0 <? S n = true.
Proof.
  intros n. destruct n as [| n'] eqn:E.
  - reflexivity.
  - reflexivity. Qed.

Lemma nat_is_positive_right2 : forall n : nat,
  0 <=? S n = true.
Proof.
  intros n. destruct n as [| n'] eqn:E.
  - reflexivity.
  - reflexivity. Qed.

Lemma nat_is_not_negative_left : forall n : nat,
  S n <? 0 = false.
Proof.
  intros n. destruct n as [| n'] eqn:E.
  - reflexivity.
  - reflexivity. Qed.

(* comparison lemmas *)

Lemma mon_uneq :
   forall n m : nat, S n <? S m = true -> n <? m = true.
Proof.
intros n m. destruct (n <? m) eqn:E; try auto.
unfold ltb in *. remember (S n) as t. simpl.
rewrite E. auto.
Qed.

Lemma eq_not_less :
  forall n t : nat, n =? t = true -> n <? t = false.
Proof.
intros n. induction n.
  - intros t L. destruct t.
     + reflexivity.
     + rewrite plus_1_neq_0_right in L. discriminate L.
  - intros t L. destruct t.
     + simpl. rewrite plus_1_neq_0_left in L. discriminate L.
     + simpl in L. apply IHn. rewrite -> L. reflexivity.
Qed.

Lemma eq_ref :
  forall n : nat, n =? n = true.
Proof.
  induction n.
  + reflexivity.
  + simpl. rewrite -> IHn. reflexivity.
Qed.

Lemma eq_or_less_ref :
  forall n : nat, n <=? n = true.
Proof.
  induction n.
  + reflexivity.
  + simpl. rewrite -> IHn. reflexivity.
Qed.

Lemma less_is_less_or_eq :
  forall n m : nat, n <? m = true -> (n <=? m) = true.
Proof.
  intros n. induction n.
  - intros m L. destruct m.
     + reflexivity.
     + rewrite nat_is_positive_right2. reflexivity.
  - intros m L. destruct m.
     + simpl. rewrite nat_is_not_negative_left in L. discriminate L.
     + simpl in L. apply IHn. rewrite -> mon_uneq. reflexivity.
       rewrite -> L. reflexivity.
Qed.

Lemma eq_is_less_or_eq :
  forall n m : nat, n =? m = true -> (n <=? m) = true.
Proof.
  intros n. induction n.
  - intros m L. destruct m.
     + reflexivity.
     + rewrite nat_is_positive_right2. reflexivity.
  - intros m L. destruct m.
     + simpl. rewrite plus_1_neq_0_left in L. discriminate L.
     + simpl in L. apply IHn. apply L.
Qed.

Lemma h0:
  forall n m, n =? m = true -> n = m.
Proof.
  intros n.
  induction n.
  - intros m L. destruct m.
    + reflexivity.
    + rewrite plus_1_neq_0_right in L. discriminate.
  - intros m L. destruct m.
    + rewrite plus_1_neq_0_left in L. discriminate.
    + simpl in L.
      assert (H: n = m -> S n = S m). { intro. rewrite <-H. reflexivity. }
      apply H. apply IHn. apply L.
Qed.

Lemma h0b:
  forall n m, n = m -> n =? m = true.
Proof.
  intros n m L.
  rewrite L.
  apply eq_ref.
Qed.

Lemma trans_eq:
  forall n m k, n =? m = true /\ k =? m = true -> n =? k = true.
Proof.
  intros n m k [L1 L2].
  apply h0 in L1. apply h0 in L2.
  rewrite <- L1 in L2. symmetry in L2. apply h0b in L2. apply L2.
Qed.

Lemma leb_n0 : forall n, n <=? 0 = true -> n =? 0 = true.
Proof. destruct n; intro H.
apply eq_ref.
simpl in H. discriminate H.
Qed.

Lemma trans_leb:
  forall n m k, n <=? m = true /\ m <=? k = true -> n <=? k = true.
Proof.
intros n m k. generalize dependent m. generalize dependent n.
induction k; intros n m H; destruct H as [H1 H2].
- apply leb_n0 in H2. apply h0 in H2. rewrite H2 in H1. assumption.
- destruct n.
  + reflexivity.
  + simpl. destruct m.
    * simpl in H1. discriminate.
    * apply IHk with (m := m). simpl in H1, H2. auto.
Qed.

Search _ le "trans".

Lemma l4 :
 forall n k, (n <? k = false /\ n =? k = false) -> k <? n = true.
Proof.
unfold ltb. induction n.
- destruct k; simpl; intro H; destruct H; discriminate.
- destruct k; intro H.
  + reflexivity.
  + apply IHn. destruct H as [H1 H2]. remember (S n) as t in H1.
    simpl in H1, H2. rewrite Heqt in H1. rewrite H1, H2. split; reflexivity.
Qed.

Lemma leb_antisym : forall n m, (n <=? m) = true /\ (m <=? n) = true
 -> (n =? m) = true.
Proof.
induction n, m; try reflexivity; simpl; intro H;
destruct H as [H1 H2]; try discriminate.
apply IHn. split; assumption.
Qed.

Lemma eqn_sym : forall n m, (n =? m) = (m =? n).
Proof. induction n, m; simpl; try reflexivity; apply IHn. Qed.

Lemma eq1:
  forall n m, n <=? m = true /\ n <? m = false -> n =? m = true.

Proof.
intros n m H. destruct H as [H1 H2].
destruct (n =? m) eqn: E1; try reflexivity.
rewrite <- H2. apply l4. split.
- destruct (m <? n) eqn: E2; try reflexivity.
  apply less_is_less_or_eq in E2.
  rewrite <- E1. symmetry. apply leb_antisym.
  split; assumption.
- rewrite <- E1. apply eqn_sym.
Qed.

(* sort_array lemmas *)

Lemma push_in_nonsorted:
  forall l m, is_sorted (l) = false -> is_sorted(m :: l) = false.
Proof.
  intros l n L.
  simpl.
  destruct l as [| t h] eqn:E1.
  - simpl in L. discriminate.
  -  destruct (n <=? t) eqn:E2.
    + apply L.
    + reflexivity.
Qed.

Lemma sublist_of_sorted_is_sorted :
  forall l n, is_sorted (n :: l) = true -> is_sorted l = true.
Proof.
  intros l n L.
  destruct (is_sorted l) as [| t h] eqn:E1.
  - reflexivity.
  - apply push_in_nonsorted with(m:=n) in E1.
    rewrite E1 in L. discriminate.
Qed.

Lemma l0:
 forall n m, n =? m = true -> [n] = [m].
Proof.
  intros n m L.
  rewrite h0 with (n:=n) (m:=m). reflexivity.
  apply L.
Qed.

Lemma h1:
 forall n m, [n] = [m] -> n <=? m = true .
Proof.
  intros n m L.
  rewrite h0 with (n:=n) (m:=m). apply eq_or_less_ref.
  injection L. intros K. apply h0b. apply K.
Qed.

Lemma h3:
 forall t n h k g, t :: n :: h = k :: g -> t =? k = true.
Proof.
 intros t n h k g L.
 injection L. intros H1 H2. apply h0b. apply H2.
Qed.

Lemma h4:
  forall t n k g, t :: n = k :: g -> t =? k = true.
Proof.
 intros t n k g L.
 injection L. intros H1 H2. apply h0b. apply H2.
Qed.

Lemma l2 :
  forall t n h,  n =? t = true -> insert n h = insert t h.
Proof.
  intros t n h L.
  simpl.
  destruct h as [| a l] eqn:E1.
  - simpl. apply l0. apply L.
  - simpl. rewrite h0 with (n:=n) (m:=t).
    destruct (t <=? a) eqn:E2.
    + reflexivity.
    + reflexivity.
    + apply L.
Qed.

(* sorting proof *)

Theorem invariance_of_occurrences :
  forall l n, count n (insert n l) = S (count n l).
Proof.
  intros l.
  induction l as [| t h IHl].
  - intros n. simpl.
    rewrite eq_ref. reflexivity.
  - intros n. simpl. destruct (n =? t) eqn:E1.
      + rewrite eq_not_less. simpl. rewrite E1. rewrite IHl. reflexivity.
        rewrite E1. reflexivity.
      + destruct (n <? t) eqn:E2.
          * simpl. rewrite eq_ref. rewrite E1. reflexivity.
          * simpl. rewrite E1. rewrite IHl. reflexivity.
Qed.

Theorem independence_of_occurrences :
  forall l n m, n =? m = false -> count n (insert m l) = count n l.
Proof.
  intros l.
  induction l as [| t h IHl].
  - intros n m L. simpl.
    rewrite L. reflexivity.
  - intros n m L. simpl. destruct (m =? t) eqn:E1.
      { rewrite eq_not_less. simpl. destruct (n =? t) eqn:E2.
          - rewrite IHl. reflexivity.
            rewrite L. reflexivity.
          - rewrite IHl. reflexivity.
            rewrite L. reflexivity.
          - rewrite E1. reflexivity. }
      { destruct (m <? t) eqn:E3.
          - destruct (n =? t) eqn:E4.
              + simpl. rewrite L. rewrite E4. reflexivity.
              + simpl. rewrite E4. rewrite L. reflexivity.
          - destruct (n =? t) eqn:E4.
              + simpl. rewrite E4. rewrite IHl. reflexivity.
                rewrite L. reflexivity.
              + simpl. rewrite E4. rewrite IHl. reflexivity.
                rewrite L. reflexivity. }
Qed.

Lemma l1 :
 forall t h k g, is_sorted (t :: h) = true /\
   insert t h = k :: g -> t <=? k = true.
Proof.
  intros t h k g [L1 L2].
  simpl in L1. destruct h.
  - simpl in L2.
    destruct g.
    + apply h1. apply L2.
    + discriminate.
  - destruct (t <=? n) eqn:E1.
    + simpl in L2.
      destruct (t <? n) eqn:E2.
      * simpl in L2. apply h3 in L2.
        apply eq_is_less_or_eq in L2.
        apply L2.
      * apply h4 in L2. apply eq_is_less_or_eq. apply trans_eq with (m:=n).
        split. apply eq1. split.
        apply E1. apply E2.
        apply h0 with (n:=n) (m:=k) in L2. rewrite L2. apply eq_ref.
    + discriminate.
Qed.

Lemma l3 :
 forall t h n k g, is_sorted (t :: h) = true /\
   (insert n h = k :: g /\ t <? n = true) -> t <=? k = true.
Proof.
  intros t h n k g [L1 [L2 L3]].
  simpl in L1. destruct h as [|x p].
  - simpl in L2.
    destruct g.
    + apply h1 in L2. apply less_is_less_or_eq in L3.
      apply trans_leb with (m:=n). split.
      apply L3. apply L2.
    + discriminate.
  - destruct (t <=? x) eqn:E1.
    + simpl in L2.
      destruct (n <? x) eqn:E2.
      * apply h3 in L2.
        apply less_is_less_or_eq in L3.
        apply h0 in L2. rewrite <-L2. apply L3.
      * apply h4 in L2. apply h0 in L2.
        rewrite <-L2. apply E1.
    + discriminate.
Qed.

Theorem sorting_preservation :
  forall l n, is_sorted l = true -> is_sorted (insert n l) = true.
Proof.
  intros l.
  induction l as [| t h IHl].
  - intros n L. simpl. reflexivity.
  - intros n L. simpl.
    destruct (n =? t) eqn:E1.
      + rewrite eq_not_less. simpl.
        destruct (insert n h) as [| k g] eqn:E2.
          * reflexivity.
          * destruct (t <=? k) eqn:E3.
            { rewrite <- E2. rewrite IHl.
              reflexivity. apply sublist_of_sorted_is_sorted with (n:=t).
              rewrite L. reflexivity. }
            { rewrite l1 with (t:=t) (h:=h) (k:=k) (g:=g) in E3. discriminate.
              split. apply L.
              rewrite <- l2 with (n:=n). apply E2.
              apply E1. }
          * rewrite E1. reflexivity.
      + destruct (n <? t) eqn:E4.
          * simpl. rewrite less_is_less_or_eq with (n:=n) (m:=t).
            destruct (h) as [| k g] eqn:E5.
            { reflexivity. }
            { destruct (t <=? k) eqn:E6.
              - apply sublist_of_sorted_is_sorted with (n:=t).
                rewrite L. reflexivity.
              - simpl in L. rewrite E6 in L. discriminate L. }
            {rewrite E4. reflexivity. }
          * simpl. destruct (insert n h) as [| k g] eqn:E7.
            { reflexivity. }
            { destruct (t <=? k) eqn:E8.
              - rewrite <- E7. apply IHl.
                apply sublist_of_sorted_is_sorted with (n:=t). apply L.
              - rewrite l3 with (t:=t) (h:=h) (n:=n) (k:=k) (g:=g) in E8. discriminate E8.
                split. apply L.
                split. apply E7.
                apply l4. split. apply E4. apply E1. }
Qed.

Lemma sort_is_sort : forall l, is_sorted (insert_sort l) = true.
Proof.
induction l.
- simpl. reflexivity.
- simpl. apply sorting_preservation. rewrite IHl. reflexivity.
Qed.

(* Check if there are any assumptions still unproved (admitted or otherwise).*)
Print Assumptions sort_is_sort.


(* On introduit les variables propositionnelles avec lesquelles
   on va travailler par la suite *)
Context (P Q R A Z J F M S T: Prop).

(**********************************************************************)
(* Exercice 1 LA FLÈCHE  ***********************)
(* - axiome : assumption
   - introduction de la flèche : intro [nom qu'on donne à l'hypothèse]
   - élimination de la flèche : apply [nom de l'hypothèse utilisée] *)
Theorem exercice_1a: P -> (P -> Q) -> Q.
Proof.
  intro Hp.
  intro Hpq.
  apply Hpq.
  assumption.
Qed.

Theorem exercice_1b: (P -> Q) -> (Q -> R) -> (P -> R).
Proof.
  intro Hpq.
  intro Hqr.
  intro Hp.
  apply Hqr.
  apply Hpq.
  assumption.
Qed.

(* Exercice 2 LE ET  ***********************)
(* Une variante de la question précédente avec /\ *)
(* - décomposition du /\ en hypothèse : destruct [nom de l'hypothèse avec /\]
*)
Theorem exercice_2a: (P -> Q) /\ (Q -> R) -> (P -> R).
Proof.
  intro H.
  intro HP.
  destruct H as [H1 H2].
  apply H2.
  apply H1.
  assumption.
Qed.

(* - introduction du /\ : split *)
(* On obtient bien deux sous-buts *)
Theorem exercice_2b : P -> Q -> P /\ Q.
Proof.
  intro Hp.
  intro Hq.
  split.
  - apply Hp.
  - apply Hq.
Qed.

(* Exercice 3 LE OU  ***********************)
(* introduction du ou :
   - depuis la droite : right
   - depuis la gauche : left

   decomposition du \/ en hypothèse : destruct *)

Theorem exercice_3a: (P \/ Q) -> (Q \/ P).
Proof.
  intro Hpq.
  destruct Hpq.
  - right.
    assumption.
  - left.
    assumption.
Qed.

(* ---------------------------------------------------------------------*)

(* zéro constructeur *)
Print False.
(* un seul constructeur car une seule règle d'intro *)
Print and.
(* deux constructeurs car deux règles d'intro*)
Print or.

(* destruct donne bien un sous but par constructeur *)
(* On remarque que comme False n'a aucun constructeur : le destruct
résoud le but *)
Theorem ex_falso_quodlibet : False ->  P.
Proof.
intros H.
destruct H.
Qed.

(** un peu difficile **)
(* Plus généralement, la tactique exfalso remplace tout but par False. *)
(* Si on peut déduire False des hypothèses, c'est alors gagné ! *)

Theorem ex_falso_quodlibet_Q : (A -> False) -> A -> (P \/ (Q -> Z /\ J) -> F).
Proof.
  intro hafalse.
  intro ha.
  (* ces hypothèses permettent clairement de produire False *)
  (* on simplifie tout puisque le but ne sert plus à rien *)
  exfalso.
  (* et on produit False *)
  apply hafalse.
  assumption.
Qed.

(* À partir de maintenant on peut penser à nommer les hypothèses qui
apparaissent dans les destruct avec "as" et suivant le nombre de sous-buts *)
(* ---------------------------------------------------------------------*)

(* Exercice 4 PREMIÈRE MODÉLISATION  ***********************)
(* Modéliser l'exercice de TD "Zoé va à Paris", prouver que Zoé va à Paris *)
(* - introduction du /\ : split
*)
Theorem zoe_va_a_paris : (A /\ J -> Z) -> (J -> A) -> (J \/ Z) -> Z.
Proof.
  intro Hajz.
  intro Hja.
  intro Hjz.
  destruct Hjz.
  - apply Hajz.
    split.
    + apply Hja. assumption.
    + assumption.
  - assumption.
Qed.

Theorem zoe_va_a_paris' : (A /\ J -> Z) /\ (J -> A) /\ (J \/ Z) -> Z.
Proof.
  intro.
  destruct H.
  destruct H0.
  destruct H1.
  - apply H.
    split.
    + apply H0. assumption.
    + assumption.
  - assumption.
Qed.

(* Exercice 5 LE NOT *************************)

(* - la notation not : unfold not
   - la notation not en hypothèse : unfold not in [nom de l'hypothèse avec ~]
*)
Theorem exercice_5a : (~P \/ ~Q) -> ~(P /\ Q).
Proof.
  intro Hnpnq.
  unfold not in Hnpnq.
  intro.
  destruct Hnpnq.
  - destruct H. apply H0. assumption.
  - destruct H. apply H0. assumption.
Qed.

(* Si on a toto et ~toto dans les hypothèses, alors le but est résolu avec "contradiction." *)

Theorem exercice_5b : P -> ~P -> Q.
Proof.
  intro hp.
  intro hnp.
  contradiction.
Qed.

(**********************************************************************)
(* Exercice 6 LE TIERS-EXCLU *)

(* On introduit la règle de tiers-exclu. *)
Context (Tiers_exclus: forall X: Prop, X \/ ~X).

(* Pour l'utiliser, c'est-à-dire pour avoir deux sous buts, un avec toto en hypothèse, l'autre avec ~toto, on invoquera :
   destruct (Tiers_exclus toto).
*)

(* Deuxième modélisation *)
(* Modéliser l'exercice de TD "Frodon va au Mordor", prouver que Frodon est triste
- Si Frodon ne va pas au Mordor, Sauron prend le pouvoir ; (~M -> S)
- Si Sauron prend le pouvoir, Frodon est triste ; (S -> T)
- Si Frodon va au Mordor, il ne possède pas l'anneau ; (M -> ~A)
- Si Frodon ne possède pas l'anneau, il est triste ; (~A -> T)
*)
Theorem exercice_6b : (~M -> S) -> (S -> T) -> (M -> ~A) -> (~A -> T) -> T.
Proof.
intros H1 H2 H3 H4.
(*
supposons {H1 H2 H3 H4} et prouvons que T
- soit I(M)=1 comme (M -> ~A)=1 alors I(~A)=1
  comme I(~A)=1, comme I(~A -> T)=1 alors I(T)=1
- soit I(M)=0 comme I(~M -> S)=1 alors I(S)=1
  comme I(S)=1, comme I(S -> T)=1 alors I(T)=1
Dans tous les cas T est vrai Qed.
*)
assert (M \/ ~M).
apply (Tiers_exclus M).
destruct H.
- apply H4.
  apply H3.
  assumption.
- apply H2.
  apply H1.
  assumption.
Qed.

(* Quid de ~~P et P ? *)
Theorem exercice_6c: (~~P -> P) /\ (P -> ~~P).
(* Pour l'un des deux sens on aura besoin du tiers-exclu et, en remarquant qu'on peut déduire False des hypothèses, de la simplification "exfalso". *)
Proof.
  split.
  intros.
  - unfold not in H.
    destruct(Tiers_exclus P).
    assumption.
    exfalso.
    unfold not in H0.
    apply H.
    assumption.
  - intros H.
    intros H1.
    unfold not in H1.
    apply H1.
    assumption.
Qed.

Theorem execirce_bonus: (~~~P -> ~P).
Proof.
  intros.
  unfold not in H.
  unfold not.
  intros H1.
  apply H.
  intros.
  apply H0.
  assumption.
Qed.

Definition si_cest_vrai_cest_pas_faux := P -> ~~P.

Theorem scvcpf: si_cest_vrai_cest_pas_faux /\ (~~P -> P).
Proof.
split.
- unfold si_cest_vrai_cest_pas_faux.
  intros H2.
  intros H3.
  apply H3.
  assumption.
- intros H.
  assert (P \/ ~P).
  exact (Tiers_exclus P).
  destruct H0.
  * assumption.
  * exfalso. apply H. assumption.
Qed.


Require Import set.
Require Import Axiom_Skolem.
Require Import belong.
Require Import subset.
Require Import Axiom_Power_Set.
Require Import Axiom_Extensionality.

(* binary relation expression the fact that P(a) = b *)
Definition is_power_set (a b:set) : Prop :=
  forall x:set, x:b <-> subset x a.

Lemma power_set_is_unique : forall a:set, forall b c:set,
  is_power_set a b -> is_power_set a c -> b = c.
Proof.
  intros a b c Hab Hac. apply extensionality.
  unfold subset. intros x Hx. apply Hab in Hx. apply Hac in Hx. exact Hx.
  unfold subset. intros x Hx. apply Hac in Hx. apply Hab in Hx. exact Hx.
Qed.

(* Given a:set, the power set P(a) exists and is unique *)
(* The Skolem axiom allows us to extract an element for it, *)
(* as well as a proof of the fact this element is indeed P(a) *)

Definition power (a:set) : set :=
  proj1_sig(skolem (power_set a) (power_set_is_unique a)).

Notation "'P' ( a )" := (power a) : core_scope.

Proposition power_is_power: forall a:set,
  forall x:set, x:P(a) <-> subset x a.
Proof.
  intros a. exact (proj2_sig (skolem (power_set a) (power_set_is_unique a))).
Qed.

Proposition power_intro: forall a x:set,
  subset x a -> x:P(a).
Proof.
  intros a x H. apply power_is_power. exact H.
Qed.

Proposition power_elim: forall a x:set,
  x:P(a) -> subset x a.
Proof.
  intros a x H. apply power_is_power. exact H.
Qed.