(**********************  TD n°6  ***************************)
(* Ce TD porte sur la sémantique naturelle codée en Coq    *)
(* du petit langage impératif WHILE déjà vu précédemment.  *)
(* On va l'utiliser pour faire des dérivations, montrer    *)
(* des propriétés, étudier des extensions.                 *)
(***********************************************************)

(* On importe les bibliothèques de Coq utiles pour le TD   *)

Require Import Bool Arith List.
Import List.ListNotations.

(** * On choisit de définir ici un état comme une liste d'entiers naturels.
      On utilise ici le type list de la bibliothèque standard de Coq.
      Ce type est polymorphe. On le spécialise pour des éléments de type nat. *)

Check list.
Check list nat.

Print list.

Check 0::1::3::nil.

(* Ici on observe que la notation des listes façon ocaml est gérée par Coq. *)

Check [0;1;3].

Remark List_Notation: [0;1;3] = 0::1::3::nil.
Proof.
  reflexivity.
Qed.

(** * On reprend ici les AST définis aux séances précédentes *)

(** ** Syntaxe des expressions arithétiques *)

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

(** ** Syntaxe des expressions booléennes *)

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

(** ** Syntaxe du langage impératif WHILE *)

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

(** ** Quelques listes/états pour faire des tests *)
(** Ci-dessous, S1 est un état dans lequel la variable numéro 0
    vaut 1, la variable numéro 1 vaut 2, et toutes les autres
    valent 0' (valeur par défaut).                                      *)
(** Plus généralement, une variable (Ava i) étant représentée par le
    numéro i, sa valeur dans un état S est la valeur en ieme position
    de la liste qui représente cet état S. *)

Definition state := list nat.

Definition S1 := [1; 2].
Definition S2 := [0; 3].
Definition S3 := [0; 7; 5; 41].

(** * Sémantique *)
(** On reprend les sémantiques fonctionnelles
    des expressions artihmétiques et booléennes      *)

(** La fonction get x s rend la valeur de x dans s. *)
(** Elle rend 0 par défaut, par exemple si la variable
    n'est pas définie/initialisée    *)

Fixpoint get (x:nat) (s:state) : nat :=
match x,s with
| 0   , v::_      => v
| S x1, _::l1 => get x1 l1
| _   , _         => 0
end.

(** Exemples *)

Compute (get 0 S3).
Compute (get 1 S3).
Compute (get 2 S3).
Compute (get 3 S3).
Compute (get 4 S3).

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

Fixpoint update (s:state) (v:nat) (n:nat): state :=
  match v,s with
  | 0   , a :: l1 => n :: l1
  | 0   , nil     => n :: nil
  | S v1, a :: l1 => a :: (update l1 v1 n)
  | S v1, nil     => 0 :: (update nil v1 n)
  end.

Definition S4 := update (update (update (update (update S1 4 1) 3 2) 2 3) 1 4) 0 5.

Compute S1.
Compute S4.

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

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

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

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

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

(** Pour définir plus facilement des expressions de test on prédéfinit
    des constantes entières ... *)

Definition N0 := Aco 0.
Definition N1 := Aco 1.
Definition N2 := Aco 2.
Definition N3 := Aco 3.
Definition N4 := Aco 4.

(** ...  et des variables *)

Definition X := Ava 1.
Definition Y := Ava 2.
Definition Z := Ava 3.

(** Quelques expressions arithmétiques pour tester *)

(** exp1 = x + 3 *)
Definition E1 := Apl X N3.

(** exp2 = y - 1 *)
Definition E2 := Amo Y N1.

(** exp3 = (x + y) * 2 *)
Definition E3 := Amu (Apl X Y) N2.

Compute (evalA E1 S1).
Compute (evalA E1 S2).
Compute (evalA E2 S1).
Compute (evalA E2 S2).
Compute (evalA E3 S1).
Compute (evalA E3 S2).

(** Quelques expressions booléennes pour tester *)

(** B1 :=  exp1 = 4 *)
Definition B1 := Beqnat E1 N4.

(** B2 := not ( bexp1 /\ (exp1 = 7) *)
Definition B2 := Bnot (Band B1 (Beqnat X N2)).

Compute (evalB B1 S1).
Compute (evalB B1 S2).
Compute (evalB B2 S1).
Compute (evalB B2 S2).

(** Corrigé du travail effectué en TD5 *)

Fail Fixpoint evalW (i : winstr) (s : state) {struct i} : state :=
  match i with
  | Skip       => s
  | Assign x e => update s x (evalA e s)
  | Seq i1 i2  => let s1 := evalW i1 s in evalW i2 s1
               (*   (evalW i2 (evalW i1 s) *)
  | If e i1 i2 => match evalB e s with
                  | true  => evalW i1 s
                  | false => evalW i2 s
                  end
  | (While e i1) as i => match evalB e s with
                  | true  =>
                    let s1 := evalW i1 s in evalW (While e i1) s1
               (*   let s1 := evalW i1 s in evalW i s1                *)
                  | false => s
                  end
  end.

(** ** Version relationnelle, appelée "sémantique naturelle" *)

(** Vu dans le CM précédent.
    La sémantique naturelle (ou sémantique opérationnelle à grands pas)
    du langage WHILE est donnée sous la forme d'un prédicat inductif. *)

Inductive SN: winstr -> state -> state -> Prop :=
| SN_Skip        : forall s,
                   SN Skip s s
| SN_Assign      : forall x a s,
                   SN (Assign x a) s (update s x (evalA a s))
| SN_Seq         : forall i1 i2 s s1 s2,
                   SN i1 s s1 -> SN i2 s1 s2 -> SN (Seq i1 i2) s s2
| SN_If_true     : forall b i1 i2 s s1,
                   (evalB b s = true)  ->  SN i1 s s1 -> SN (If b i1 i2) s s1
| SN_If_false    : forall b i1 i2 s s2,
                   (evalB b s = false) ->  SN i2 s s2 -> SN (If b i1 i2) s s2
| SN_While_false : forall b i s,
                   (evalB b s = false) ->  SN (While b i) s s
| SN_While_true  : forall b i s s1 s2,
                   (evalB b s = true)  ->  SN i s s1 -> SN (While b i) s1 s2 ->
                   SN (While b i) s s2
.

(** On code dans WHILE un programme P1 correspondant à
    while not (i=0) do {i:=i-1;x:=1+x} *)
Definition Il := 0.
Definition Ir := Ava Il.
Definition Xl := 1.
Definition Xr := Ava Xl.

Definition corps_boucle := Seq (Assign Il (Amo Ir N1)) (Assign Xl (Apl N1 Xr)).
Definition P1 := While (Bnot (Beqnat Ir N0)) corps_boucle.

(** On montre que P1 transforme l'état S1 en l'état S2  *)

Theorem reduction1 : SN P1 S1 S2.
(** Regarder les états courants tout au long de la preuve *)
Proof.
  cbv [P1]. cbv [S1]. cbv [S2].
  (** Ou de façon équivalente :
  unfold P1. unfold S1. unfold S2. *)

  (** Ce but devrait être prouvé par l'une des deux dernières règles de SN,
      qui portent sur le cas While.
      On peut deviner laquelle de tête, ou demander de l'aide ainsi : *)
  Compute (evalB (Bnot (Beqnat Ir N0)) [1; 2]).
  (** Ce sera donc avec SN_While_true.
      On peut essayer d'avancer avec 'apply SN_While_true.'  ... mais ça échoue.
      Ici Coq ne peut pas deviner ce que sera l'état intermédiaire s1. *)
  Fail apply SN_While_true.
  (** Une stratégie possible serait d'indiquer directement l'état
      intermédiaire avec la variante 'apply ... with (s1:= ...)'.
      Il faut deviner les paramètres corrects ce qui n'est pas toujours facile.
      Dans notre cas cela serait : *)
  apply SN_While_true with (s1:=[0;3]).
  (** On va donc proposer une autre stratégie· *)
  Undo 1.
  (** Une première possibilité est avec refine, déjà connu :
      ici on indique un joker '_' pour chacun des HUIT arguments ;
      [b], [i], [s] et [s2] se trouvent déterminés par la forme du but,
      [s1] sera déterminé par la preuve de [SN s i s s1] et ne donne donc
      pas lieu à un sous-but. Il restera à prouver :
      [evalB b s = true], [SN i s s1] et [SN (While b i) s1 s2].  *)
  refine (SN_While_true _ _ _ _ _ _ _ _).
  (** On obtient le même effet avec la tactique [eapply], plus commode. *)
  Undo 1.
  eapply SN_While_true.
  - reflexivity.
  - cbv [corps_boucle].
    (** Un nouvel état intermédiaire est à deviner *)
    eapply SN_Seq.
    + apply SN_Assign.
    (* En appliquant cette règle nous avons fixé la valeur de l'état d'arrivée *)
    + (* L'état de départ vient du cas précédent ;
         comme les états sont connus on peut simplifier. *)
      cbn [evalA Ir Il N1 get minus update].
      (** Ou, plus rapidement *)
      Undo 1.
      cbn.
      apply SN_Assign.
  - cbn.
    (** SN_While_true ou SN_While_false ? *)
    Compute (evalB (Bnot (Beqnat Ir N0)) [0; 3]).
    apply SN_While_false.
    cbn.
    reflexivity.
Qed.

(** À FAIRE (NIVEAU 1) : présenter reduction1 sous forme d'arbre *)
Definition AFAIRE_dessin_reduction1 : unit.
Admitted.

(** Une autre présentation de ce script, structurée par accolades.
    Cela permet de gérer l'indentation autrement
    (surtout utile quand le corps de boucle s'exécute plusieurs fois. *)
Theorem reduction1_accolades : SN P1 S1 S2.
Proof.
  cbv [P1]. cbv [S1]. cbv [S2].
  eapply SN_While_true.
  { cbn. reflexivity. }
  { cbv [corps_boucle].
    eapply SN_Seq.
    + apply SN_Assign.
    + cbn. apply SN_Assign. }
  cbn.
  Compute (evalB (Bnot (Beqnat Ir N0)) [0; 3]).
  apply SN_While_false.
  cbn. reflexivity.
Qed.

(** Exercice d'entraînement *)

Theorem entrainement_P1 : SN P1 [2; 5] [0; 7].
Proof.
  eapply SN_While_true.
  - cbn [evalB]. cbv [Ir Il N0]. cbn [evalA negb eqnatb get]. reflexivity.
  - eapply SN_Seq.
    + eapply SN_Assign.
    + eapply SN_Assign.
  - cbv [Il Xl Ir N1 Xr]. cbn [update evalA get "+" "-"].
    eapply SN_While_true.
    + reflexivity.
    + cbv [corps_boucle]. eapply SN_Seq.
      * eapply SN_Assign.
      * eapply SN_Assign.
    + cbv [Il Xl Ir N1 Xr]. cbn [update evalA get "+" "-"].
      eapply SN_While_false. reflexivity.
Qed.

(** On veut montrer maintenant que P1 rend toujours un état où
    i vaut 0 et x voit sa valeur augmenter de la valeur initiale de i. *)

(** Rappel : En Coq les entiers naturels sont définis par un type inductif
    comprenant les constructeurs O pour zéro et S pour le successeur. *)

Print nat.

(** Les lemmes suivants de la bibliothèque Coq peuvent être utiles
    - Lemma minus_n_O : forall n, n = n - 0.
    - Lemma plus_n_Sm : forall n m, S (n + m) = n + S m. *)

Theorem reduction2 : forall x y, SN P1 [x;y] [0;x+y].
Proof.
  cbv[P1 Ir Il N1 Xr Xl]; intros x.
  induction x as [ | x Hrec_x];
    intros; cbn [evalA];cbn [evalB].
    - eapply SN_While_false. reflexivity.
    - eapply SN_While_true.
      + reflexivity.
      + eapply SN_Seq.
        * eapply SN_Assign.
        * eapply SN_Assign.
      + cbv [Il Xl Ir N1 Xr]. cbn [evalA update get "-" "+"].
        rewrite Nat.sub_0_r. rewrite plus_n_Sm. apply Hrec_x.
  (** complétez ici NIVEAU 2 *)
Qed.

(** *** Calcul du carré avec des additions *)
(** On code dans While un programme Pcarre correspondant à
    while not (i=n) do {i:= 1+i; x:= y+x ; y:= 2+y} *)
(* (* *déjà définis *)
Definition Il := 0.
Definition Ir := Ava Il.
Definition Xl := 1.
Definition Xr := Ava Xl.*)
Definition Yl := 2.
Definition Yr := Ava Yl.

Definition incrI := Assign Il (Apl N1 Ir).
Definition incrX := Assign Xl (Apl Yr Xr).
Definition incrY := Assign Yl (Apl N2 Yr).
Definition corps_carre := Seq incrI (Seq incrX incrY).
Definition Pcarre_2 := While (Bnot (Beqnat Ir (Aco 2))) corps_carre.
Definition Pcarre n := While (Bnot (Beqnat Ir (Aco n))) corps_carre.

Theorem reduction_Pcarre_2 : SN (Pcarre_2) [0;0;1] [2;4;5].
Proof.
  eapply SN_While_true.
  { reflexivity. }
  { cbv [corps_carre]. eapply SN_Seq.
    { cbv [incrI]. eapply SN_Assign. }
    { cbv [incrX incrY]. eapply SN_Seq; eapply SN_Assign.
    }
  }
  cbn. eapply SN_While_true.
  { reflexivity. }
  { cbv [corps_carre]. eapply SN_Seq.
    { cbv [incrI]. eapply SN_Assign. }
    { cbv [incrX incrY]. eapply SN_Seq; eapply SN_Assign. }
  }
  cbn.
  eapply SN_While_false. reflexivity.
Qed.

(** Énoncer et démontrer que Pcarre n permet de calculer le carré de n *)
(* Complétez ici NIVEAU 4
   (pas de technique nouvelle, mais demande de la créativité *)
Theorem reduction_pcarre : forall n, SN (Pcarre n) [0; 0; 1] [n; n * n; 2 * n + 1].
Proof.
  intro n.
  induction n.
  - eapply SN_While_false. cbn. reflexivity.
  - eapply SN_While_true.
    * cbn. reflexivity.
    * cbv. eapply SN_Seq.
      + eapply SN_Assign.
      + eapply SN_Seq; cbn; eapply SN_Assign.
    * cbn. eapply SN_While_true.
      +
Qed.

(** Sur le même modèle, trouver un programme Pcube n'utilisant que des
    additions, énoncer et démontrer qu'il est correct. *)
(* Complétez ici NIVEAU 6
   (pas de technique nouvelle, mais demande de la créativité *)

(* -------------------------------------------------------------------------- *)
(** ** Preuve par récurrence structurelle dans un prédicat inductif *)

(** Transformation simple de programme :
   -  if true  then X else Y ---> X
   -  if false then X else Y ---> Y  *)
Fixpoint simpl_test_Btrue_Bfalse (i: winstr) : winstr :=
  match i with
  | Skip => Skip
  | Assign v a => i
  | Seq w1 w2 => Seq (simpl_test_Btrue_Bfalse w1)
                     (simpl_test_Btrue_Bfalse w2)
  | If Btrue i1 i2 => simpl_test_Btrue_Bfalse i1
  | If Bfalse i1 i2 => simpl_test_Btrue_Bfalse i2
  | If cond i1 i2 => If cond (simpl_test_Btrue_Bfalse i1) (simpl_test_Btrue_Bfalse i2)
  | While cond i1 => While cond (simpl_test_Btrue_Bfalse i1)
  end.

(** Comme indiqué ci-dessus on va procéder par récurrence structurelle sur
     les arbres de preuve de [SN i s s'] *)
Theorem simpl_test_Btrue_Bfalse_correct :
  forall i s s', SN i s s' -> SN (simpl_test_Btrue_Bfalse i) s s'.
Proof.
  (** On essaie d'abord une récurrence sur i.
      Même avec prudence, de la façon la plus générale possible
      (les états [s] et [s'], ainsi que l'hypothèse [SN i s s'] sont
      introduits APRÈS [induction i]), on verra que les buts ne sont
      pas comme souhaité *)
  intro i.
  induction i as [ | | | | ]; (** sans nommer les composantes pour alléger *)
    intros s s' sn (** les introductions sont effectuées systématiquement
                         sur chaque sous-but *).
  (** On observe que l'hypothèse [sn] devrait entraîner [s = s'],
      mais on ne l'a pas obtenu directement ;
      tous les autres sous-buts souffrent de problèmes analogues. *)
  Undo 2.
  (** Il est bien plus opportun de raisonner par récurrence sur [sn] car
      on aura naturellement non seulement la décomposition de [i] mais en plus
      les contraintes dictées par la définition de SN *)
  intros i s s' sn.
  induction sn as  [ (* SN_Skip *) s
                   | (* SN_Assign *) x s a
                   | (* SN_Seq *) i1 i2 s s1 s' sn1 hrec_sn1 sn2 hrec_sn2
                   | (* SN_If_true *) cond i1 i2 s s' e sn hrec_sn
                   | (* SN_If_false *) cond i1 i2 s s' e sn hrec_sn
                   | (* SN_While_false *) (* complétez ici NIVEAU 1 *)
                   | (* SN_While_true *) (* complétez ici NIVEAU 1 *)
                   ]; cbn [simpl_test_Btrue_Bfalse].

 (** La preuve qui suit est un peu fastidieuse, on verra plus tard
     des moyens de la fabriquer plus intelligemment. *)
 (** Certains buts contiendront en une hypothèse se convertissant en
     [false = true] (plus visible en utilisant [cbn in ...].
     On pourra se souvenir d'une technique vue auparavant (égalités contagieuses).
  *)
(** complétez ici
     - nombreux sous-buts NIVEAU 2
     - quelques sous-buts NIVEAU 3, utiliser admit si besoin *)
Admitted.

(* -------------------------------------------------------------------------- *)
(** Une autre transformation simple (facultatif, pour l'entraînement)
  -  if (Bnot b) then X else Y ---> if b then Y else X  *)

Fixpoint simpl_test_echange (i: winstr) : winstr.
  (** complétez ici NIVEAU 1 *)
Admitted.

Lemma negb_negb : forall b, b = negb (negb b).
Proof.
  (** complétez ici NIVEAU 1 *)
Admitted.

Lemma Bnot_negb : forall {B s b}, evalB (Bnot B) s = b -> evalB B s = negb b.
Proof.
 (** complétez ici NIVEAU 1 *)
Admitted.

(** Suivre le même principe que pour simpl_test_Btrue_Bfalse_correct. *)
Theorem simpl_test_echange_correct :
  forall i s s', SN i s s' -> SN (simpl_test_echange i) s s'.
Proof.
  (** complétez ici
     - nombreux sous-buts NIVEAU 2
     - quelques sous-buts NIVEAU 3, utiliser admit si besoin *)
Admitted.

(* -------------------------------------------------------------------------- *)
(** ** Interlude sur l'inversion *)

(** Dans l'exercice qui suit, on aura un but comprenant
    une hypothèse de la forme [SN i s s2],
    où [i] est lui-même de la forme [Seq i1 i2]    (1).
    Sans la condition (1), il serait naturel de procéder par
    cas sur [i], ce qui donnerait lieu aux 7 cas ;
    mais avec la condition (1), on voit que seul un cas
    est pertinent, correpondant à SN_Seq.
    Cette technique de preuve est dite "par inversion".
    On va se ramener à une situation plus simple au moyen du
    prédicat auxiliaire suivant, qui isole le cas intéressant de SN.
 *)

Inductive SN1_Seq i1 i2 s s2 : Prop :=
| SN1_Seq_intro : forall s1,
                  SN i1 s s1 -> SN i2 s1 s2 -> SN1_Seq i1 i2 s s2
.

(** On peut alors démontrer la conséquence suivante d'une hypothèse
    respectant la condition (1) ci-dessus *)

Lemma inv_Seq' : forall {i1 i2 s s2}, SN (Seq i1 i2) s s2 -> SN1_Seq i1 i2 s s2.
Proof.
  intros i1 i2 s s2 sn.
  (** Ici in utilise une tactique magique de Coq. *)
  inversion sn.
  (** Puis une autre, pour nettoyer les égalités. *)
  subst.
  apply (SN1_Seq_intro _ _ _ _ _ H1 H4).
Qed.

(** Mode d'emploi. Devant ce but :

 H18 : SN (Seq i1 i2) s s2
 =========================
 conclusion

Au lieu d'un
  destruct H18
qui donne 7 cas, on observe que
[inv_Seq' H18]   est de type   [SN1_Seq i1 i2 s s2]
et donc on peut de manière plus adéquate utiliser
  destruct (inv_Seq' H18) as [s1 sn1 sn2]
qui ne prévoit qu'un cas, celui qui est pertinent.
*)

(** Voici une preuve par "petites inversions" du même théorème,
    qui n'utilise que les connaissances élémentaires déjà acquises,
    en particulier un programme à la "ouf_ouf" (voir coq3_B_A_BA_ouf.v
    dans les supports de CM).
    Il n'est pas indispensable de la comprendre avant de l'utiliser.
    EXERCICES FACULTATIFS :
    1) expliquer le fonctionnement cette preuve.
    2) dans les scripts à suivre, utiliser SN_inv
       au lieu de inv_Seq
       (intérêt : cela pourra être généralisé).
 *)
Inductive SN1_trivial (s s1 : state) : Prop := Triv : SN1_trivial s s1.

Definition dispatch (i: winstr) : state -> state -> Prop :=
  match i with
  | Seq i1 i2 => SN1_Seq i1 i2
  | _ => SN1_trivial
  end.

Definition SN_inv {i s s2} (sn : SN i s s2) : dispatch i s s2 :=
  match sn with
  | SN_Seq i1 i2 s s1 s2 sn1 sn2 =>
    SN1_Seq_intro _ _ _ _ s1 sn1 sn2
  | _ => Triv _ _
  end.

Lemma inv_Seq : forall {i1 i2 s s2}, SN (Seq i1 i2) s s2 -> SN1_Seq i1 i2 s s2.
Proof.
  intros * sn. apply (SN_inv sn).
Qed.

(** *** Illustration *)
(** Une autre manière d'exprimer la sémantique de WHILE ;
    on prouvera que SN et SN' sont équivalentes. *)
Inductive SN': winstr -> state -> state -> Prop :=
| SN'_Skip        : forall s,
                    SN' Skip s s
| SN'_Assign      : forall x a s,
                    SN' (Assign x a) s (update s x (evalA a s))
| SN'_Seq         : forall i1 i2 s s1 s2,
                    SN' i1 s s1 -> SN' i2 s1 s2 -> SN' (Seq i1 i2) s s2
| SN'_If_true     : forall b i1 i2 s s1,
                    (evalB b s = true)  ->  SN' i1 s s1 -> SN' (If b i1 i2) s s1
| SN'_If_false    : forall b i1 i2 s s2,
                    (evalB b s = false) ->  SN' i2 s s2 -> SN' (If b i1 i2) s s2
| SN'_While_false : forall b i s,
                    (evalB b s = false) ->  SN' (While b i) s s
| SN'_While_true  : forall b i s s1,
                    (evalB b s = true)  ->  SN' (Seq i (While b i)) s s1 ->
                    SN' (While b i) s s1
.

(** La direction suivante ne pose pas de nouvelle difficulté *)
Lemma SN_SN' : forall i s s1, SN i s s1 -> SN' i s s1.
Proof.
  intros i s s1 sn.
  induction sn as  [ (* SN_Skip *) s
                   | (* SN_Assign *) x s a
                   | (* SN_Seq *) i1 i2 s s1 s' sn1 hrec_sn1 sn2 hrec_sn2
                   | (* SN_If_true *) cond i1 i2 s s' e sn hrec_sn
                   | (* SN_If_false *) cond i1 i2 s s' e sn hrec_sn
                   | (* SN_While_false *) (* complétez ici NIVEAU 1 *)
                   | (* SN_While_true *)  (* complétez ici NIVEAU 1 *)
                   ].
  - admit (** complétez ici NIVEAU 1 *).
  - admit (** complétez ici NIVEAU 1 *).
  - admit (** complétez ici NIVEAU 1 *).
  - admit (** complétez ici NIVEAU 1 *).
  - admit (** complétez ici NIVEAU 1 *).
  - admit (** complétez ici NIVEAU 1 *).
  - (** Le sous-but le plus intéressant, où les formulations diffèrent entre
        SN' et SN *)
    apply SN'_While_true.
    + admit (** complétez ici NIVEAU 1 *).
    + eapply SN'_Seq.
      -- admit (** complétez ici NIVEAU 2 *).
      -- admit (** complétez ici NIVEAU 2 *).
Admitted.

(** Pour la réciproque le script est semblable SAUF au dernier sous-but,
    qui précisément demande une inversion. *)
Lemma SN'_SN : forall i s s1, SN' i s s1 -> SN i s s1.
Proof.
  intros i s s1 sn'.
  induction sn' as [ (* SN_Skip *) s
                   | (* SN_Assign *) x s a
                   | (* SN_Seq *) i1 i2 s s1 s' sn1 hrec_sn1 sn2 hrec_sn2
                   | (* SN_If_true *) cond i1 i2 s s' e sn hrec_sn
                   | (* SN_If_false *) cond i1 i2 s s' e sn hrec_sn
                   | (* SN_While_false *) cond i s e
                   | (* SN_While_true *)
                     cond i s s' e sn hrec_sn
                   ].
  - admit (** complétez ici NIVEAU 1 *).
  - admit (** complétez ici NIVEAU 1 *).
  - admit (** complétez ici NIVEAU 1 *).
  - admit (** complétez ici NIVEAU 1 *).
  - admit (** complétez ici NIVEAU 1 *).
  - admit (** complétez ici NIVEAU 1 *).
  - (** NIVEAU 4 *)
    (** Ici il faut exploiter l'hypothèse
        hrec_sn : SN (Seq i (While cond i)) s s'
        On observe que cette hypothèse est de la forme SN (Seq i1 i2) s s'
        qui est un cas particulier de SN i s s' ;
        cependant un destruct de hrec_sn oublierait que l'on est
        dans ce cas particulier *)
    destruct hrec_sn as [ | | | | | | ].
    + (** Le but obtenu ici correspond au cas où
          [Seq i (While cond i)] serait en même temps [Skip]
          un cas qui est hors propos. *)
      Undo 1.
    Undo 1.
    (** Cela est résolu en utilisant
        conséquence de hrec_sn indiquée par inv_Seq.
        Voir le mode d'emploi indiqué ci-dessus.
     *)
    destruct (inv_Seq hrec_sn) as [s1 sn1 sn2].
    (** On termine en utilisant ici SN_While_true *)
    + eapply SN_While_true.
      -- apply e.
      -- apply sn1.
      -- apply sn2.
Admitted.

(* -------------------------------------------------------------------------- *)
(** ** Le langage REPEAT *)
(** On considère maintenant un langage impératif sans la commande While,
    mais comportant une autre instruction de boucle
                       'repeat i until b
    qui exécute i puis sort si b est vrai, et sinon recommence.
 *)

(** Voici la syntaxe du langage REPEAT
    (on redéfinit un nouveau type avec de nouveaux constructeurs.    *)

Inductive rinstr :=
| RSkip   : rinstr
| RAssign : nat -> aexp -> rinstr
| RSeq    : rinstr -> rinstr -> rinstr
| RIf     : bexp -> rinstr -> rinstr -> rinstr
| Repeat  : rinstr -> bexp -> rinstr.

(** Définir la sémantique naturelle du langage REPEAT *)

Inductive SNr: rinstr -> state -> state -> Prop :=
| SNr_Skip        : forall s,
                    SNr RSkip s s
| SNr_Assign      : forall x e s,
                    SNr (RAssign x e) s (update s x (evalA e s))
| SNr_Seq         : forall i1 i2 s s1 s2,
                    SNr i1 s s1 -> SNr i2 s1 s2 -> SNr (RSeq i1 i2) s s2
| SNr_If_true     : forall b i1 i2 s s1,
                    evalB b s = true -> SNr i1 s s1 -> SNr (RIf b i1 i2) s s1
| SNr_If_false    : forall b i1 i2 s s2,
                    evalB b s = false -> SNr i2 s s2 -> SNr (RIf b i1 i2) s s2
| SNr_Repeat_true : (** complétez ici NIVEAU 2 *)
| SNr_Repeat_false: (** complétez ici NIVEAU 2 *)
.

(** On code dans REPEAT un programme P2 correspondant à
    repeat {i:=i-1;x:=1+x} until i=0 *)

Definition corps_boucleR : rinstr. Admitted.
Definition P2 := Repeat corps_boucleR (Beqnat Ir N0).

Lemma P2_test : SNr P2 [2; 5] [0; 7].
Proof.
Admitted.

(** À FAIRE : présenter P2_test sous forme d'arbre *)
Definition AFAIRE_dessin_P2_test : unit.
Admitted.

(** *** Preuves sur SNr *)
(** On va maintenant montrer que : 'Repeat i until b'
    peut être traduit  par       : 'i; while (not b) do i'     *)

(** Ecrire une fonction qui traduit toute expression rinstr en winstr en
    remplaçant les Repeat par l'expression équivalente ci-dessus
 *)

Fixpoint repeat_while (i:rinstr) : winstr :=
    match i with
    | RSkip        => Skip
    | RAssign v a  => Assign v a
    | RSeq i1 i2   =>
      (** complétez ici NIVEAU 2 *)
    end.

(** Avant d'aborder la preuve suivante, il est recommandé de tester
    sur un petit programme REPEAT qu'après transformation son exécution
    à partir d'un état initial concret donne bien le même état final.
*)

(** Montrer que cette transformation préserve la sémantique c-a-d : *)

Theorem repeat_while_correct : forall i s1 s2, SNr i s1 s2 -> SN (repeat_while i) s1 s2.
Proof.
  intros i s1 s2 sn.
            (* complétez ici NIVEAU 3 *)
Admitted.

(* -------------------------------------------------------------------------- *)
(** Transformation inverse *)
Fixpoint while_repeat (i:winstr) : rinstr :=
    match i with
    | Skip        => RSkip
    | Assign v a  => RAssign v a
    | Seq i1 i2   =>
      (* complétez ici NIVEAU 3 *)
    end.

(** Avant d'aborder la preuve suivante, il est recommandé de tester
    sur un petit programme WHILE qu'après transformation son exécution
    à partir d'un état initial concret donne bien le même état final.
*)

(** Montrer que cette transformation préserve la sémantique *)
(** La preuve suivante requiert quelques techniques supplémentaires,
    à considérer seulement après la semaine 7 *)

Theorem while_repeat_correct :
  forall i s1 s2, SN i s1 s2 -> SNr (while_repeat i) s1 s2.
Proof.
  intros i s_1 s_2 sn.
            (** complétez ici NIVEAU 4 *)
Admitted.

(* -------------------------------------------------------------------------- *)
(** ** Le langage WHILE-REPEAT *)
(** Remarque : on pourrait également considérer un langage WHILE_REPEAT
    comprenant à la fois l'instruction While et l'instruction Repeat
 *)


Require Import Logic.Axiom.Dec.

(* A proposition is weakly decidable                                            *)
Definition Wec (A:Prop) : Prop := A \/ ~A.

(* a predicate is weakly decidable                                              *)
Definition pWec (a:Type) (p:a -> Prop) : Prop := forall (x:a), Wec (p x).

Arguments pWec {a}.

(* Two-fold weakly decidable predicates                                         *)
Definition pWec2 (a b:Type) (p:a -> b -> Prop) :=
    forall (x:a) (y:b), Wec (p x y).

Arguments pWec2 {a} {b}.

Lemma pWec2Wec : forall (a b:Type) (p:a -> b -> Prop) (x:a),
    pWec2 p -> pWec (p x).
Proof.
    intros a b p x H1 y. apply H1.
Defined.

Lemma DecWec : forall (A:Prop), Dec A -> Wec A.
Proof.
    intros A [H1|H1].
    - left. assumption.
    - right. assumption.
Defined.

Lemma pDecWec : forall (a:Type) (p:a -> Prop), pDec p -> pWec p.
Proof.
    intros a p H1 x. apply DecWec. apply H1.
Defined.

Lemma andWec : forall (A B:Prop), Wec A -> Wec B -> Wec (A /\ B).
Proof.
    intros A B [H1|H1] [H2|H2].
    - left. split; assumption.
    - right. intros [H3 H4]. apply H2 in H4. contradiction.
    - right. intros [H3 H4]. apply H1 in H3. contradiction.
    - right. intros [H3 H4]. apply H1 in H3. contradiction.
Defined.


Require Import Coq.Reals.Reals.

Open Scope R.

Theorem HamkinsQverheard9thGradeProblem : forall x:R, x > 0 -> (x + (1/x)) >= 2.
intros.
unfold Rdiv.
rewrite Rmult_1_l.
rewrite <- (Rmult_1_l (x + / x)).
rewrite <- (Rmult_1_l 2).
rewrite Rmult_plus_distr_l.
rewrite <- (Rinv_r x).
rewrite (Rmult_comm x (/ x)).
repeat rewrite (Rmult_assoc (/ x)).
rewrite <- (Rmult_plus_distr_l (/ x)).
apply Rmult_ge_compat_l.
apply (Rgt_ge _ _ (Rlt_gt _ _ (Rinv_0_lt_compat x (Rlt_gt _ _ H)))).
repeat rewrite <- Rinv_r_sym.
repeat rewrite <- Rinv_l_sym.
all: try apply (Rgt_not_eq _ _ H).
fold (Rsqr x).
rewrite (Rmult_comm x 2).
apply Rminus_ge.
rewrite <- Rsqr_1.
rewrite Rplus_comm.
rewrite <- (Rmult_1_r x) at 2.
rewrite (Rmult_comm x 1).
rewrite <- (Rmult_assoc 2 1 x).
rewrite <- Rsqr_minus.
apply Rle_ge.
apply Rle_0_sqr.
Optimize Proof.
Defined.

Print HamkinsQverheard9thGradeProblem.

(*
fun (x : R) (H : x > 0) =>
eq_ind_r (fun r : R => x + r >= 2)
  (eq_ind (1 * (x + / x)) (fun r : R => r >= 2)
     (eq_ind (1 * 2) (fun r : R => 1 * (x + / x) >= r)
        (eq_ind_r (fun r : R => r >= 1 * 2)
           (eq_ind (x * / x) (fun r : R => r * x + r * / x >= r * 2)
              (eq_ind_r (fun r : R => r * x + r * / x >= r * 2)
                 (eq_ind_r (fun r : R => r + / x * x * / x >= / x * x * 2)
                    (eq_ind_r (fun r : R => / x * (x * x) + r >= / x * x * 2)
                       (eq_ind_r (fun r : R => / x * (x * x) + / x * (x * / x) >= r)
                          (eq_ind (/ x * (x * x + x * / x)) (fun r : R => r >= / x * (x * 2))
                             (Rmult_ge_compat_l (/ x) (x * x + x * / x)
                                (x * 2)
                                (Rgt_ge (/ x) 0
                                   (Rlt_gt 0 (/ x) (Rinv_0_lt_compat x (Rlt_gt 0 x H))))
                                (eq_ind 1 (fun r : R => x * x + r >= x * 2)
                                   (eq_ind_r (fun r : R => x² + 1 >= r)
                                      (Rminus_ge (x² + 1) (2 * x)
                                         (eq_ind 1² (fun r : R => x² + r - 2 * x >= 0)
                                            (eq_ind_r (fun r : R => r - 2 * x >= 0)
                                               ((fun lemma : x * 1 = x =>
                                                 Morphisms.reflexive_proper Rge
                                                   (1² + x² - 2 * x)
                                                   (1² + x² - 2 * (x * 1))
                                                   (Morphisms.Reflexive_partial_app_morphism
                                                      (Morphisms.reflexive_proper Rminus)
                                                      (Morphisms.eq_proper_proxy (1² + x²))
                                                      (2 * x) (2 * (x * 1))
                                                      (Morphisms.Reflexive_partial_app_morphism
                                                         (Morphisms.reflexive_proper Rmult)
                                                         (Morphisms.eq_proper_proxy 2) x
                                                         (x * 1)
                                                         (RelationClasses.symmetry lemma))) 0
                                                   0 (Morphisms.eq_proper_proxy 0))
                                                  (Rmult_1_r x)
                                                  (eq_ind_r
                                                     (fun r : R => 1² + x² - 2 * r >= 0)
                                                     (eq_ind (2 * 1 * x)
                                                        (fun r : R => 1² + x² - r >= 0)
                                                        (eq_ind (1 - x)²
                                                           (fun r : R => r >= 0)
                                                           (Rle_ge 0
                                                              (1 - x)²
                                                              (Rle_0_sqr (1 - x)))
                                                           (1² + x² - 2 * 1 * x)
                                                           (Rsqr_minus 1 x))
                                                        (2 * (1 * x))
                                                        (Rmult_assoc 2 1 x))
                                                     (Rmult_comm x 1)))
                                               (Rplus_comm x² 1²)) 1 Rsqr_1))
                                      (Rmult_comm x 2)) (x * / x)
                                   (Rinv_r_sym x (Rgt_not_eq x 0 H))))
                             (/ x * (x * x) + / x * (x * / x))
                             (Rmult_plus_distr_l (/ x) (x * x) (x * / x)))
                          (Rmult_assoc (/ x) x 2)) (Rmult_assoc (/ x) x (/ x)))
                    (Rmult_assoc (/ x) x x)) (Rmult_comm x (/ x))) 1
              (Rinv_r x (Rgt_not_eq x 0 H))) (Rmult_plus_distr_l 1 x (/ x))) 2
        (Rmult_1_l 2)) (x + / x) (Rmult_1_l (x + / x))) (Rmult_1_l (/ x))
*)


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


From mathcomp Require Import ssreflect ssrbool eqtype ssrnat seq fintype.
Require Import prosa.util.tactics.

(** This file introduces a function called [search_arg] that allows finding the
    argument within a given range for which a function is minimal w.r.t. to a
    given order while satisfying a given predicate, along with lemmas
    establishing the basic properties of [search_arg].

    Note that while this is quite similar to [arg min ...] / [arg max ...] in
    [ssreflect] ([fintype]), this function is subtly different in that it possibly
    returns None and that it does not require the last element in the given
    range to satisfy the predicate. In contrast, [ssreflect]'s notion of
    extremum in [fintype] uses the upper bound of the search space as the
    default value, which is rather unnatural when searching through a schedule.
*)

Section ArgSearch.

  (* Given a function [f] that maps the naturals to elements of type [T]... *)
  Context {T : Type}.
  Variable f: nat -> T.

  (* ... a predicate [P] on [T] ... *)
  Variable P: pred T.

  (* ... and an order [R] on [T] ... *)
  Variable R: rel T.

  (* ... we define the procedure [search_arg] to iterate a given search space
     [a, b), while checking each element whether [f] satisfies [P] at that
     point and returning the extremum as defined by [R]. *)
  Fixpoint search_arg (a b : nat) : option nat :=
    if a < b then
      match b with
      | 0 => None
      | S b' => match search_arg a b' with
                | None => if P (f b') then Some b' else None
                | Some x => if P (f b') && R (f b') (f x) then Some b' else Some x
                end
      end
    else None.

  (** In the following, we establish basic properties of [search_arg]. *)

  (* To begin, we observe that the search yields [None] iff predicate [P] does
     not hold for any of the points in the search interval. *)
  Lemma search_arg_none:
    forall a b,
      search_arg a b = None <-> forall x, a <= x < b -> ~~ P (f x).
  Proof.
    split.
    { (* if *)
      elim: b => [ _ | b' HYP]; first by move=> _ /andP [_ FALSE] //.
      rewrite /search_arg  -/search_arg.
      case: (boolP (a < b'.+1)) => [a_lt_b | not_a_lt_b' TRIV].
      - move: HYP. case: (search_arg a b') => [y | HYP NIL x].
        + case: (P (f b') && R (f b') (f y)) => //.
        + move=> /andP[a_le_x x_lt_b'].
          move: x_lt_b'.
          rewrite ltnS leq_eqVlt => /orP [/eqP EQ|LT].
          * rewrite EQ.
            move: NIL. case: (P (f b')) => //.
          * feed HYP => //.
            apply: (HYP x).
            by apply /andP; split.
      - move=> x /andP [a_le_x b_lt_b'].
        exfalso.
        move: not_a_lt_b'. rewrite -leqNgt ltnNge => /negP b'_lt_a.
        by move: (leq_ltn_trans a_le_x b_lt_b').
    }
    { (* only if *)
      rewrite /search_arg.
      elim: b  => [//|b'].
      rewrite -/search_arg => IND  NOT_SAT.
      have ->: search_arg a b' = None.
      {
        apply IND => x /andP [a_le_x x_lt_n].
        apply: (NOT_SAT x).
        apply /andP; split => //.
        by rewrite ltnS; apply ltnW.
      }
      case: (boolP (a < b'.+1)) => [a_lt_b | //].
      apply ifF.
      apply negbTE.
      apply (NOT_SAT b').
        by apply /andP; split.
    }
  Qed.

  (* Conversely, if we know that [f] satisfies [P] for at least one point in
     the search space, then [search_arg] yields some point. *)
  Lemma search_arg_not_none:
    forall a b,
      (exists x, (a <= x < b) /\ P (f x)) ->
      exists y, search_arg a b = Some y.
  Proof.
    move=> a b H_exists.
    destruct (search_arg a b) eqn:SEARCH; first by exists n.
    move: SEARCH. rewrite search_arg_none => NOT_exists.
    exfalso.
    move: H_exists => [x [RANGE Pfx]].
    by move: (NOT_exists x RANGE) => /negP not_Pfx.
  Qed.

  (* Since [search_arg] considers only points at which [f] satisfies [P], if it
     returns a point, then that point satisfies [P]. *)
  Lemma search_arg_pred:
    forall a b x,
      search_arg a b = Some x -> P (f x).
  Proof.
    move=> a b x.
    elim: b => [| n IND]; first by rewrite /search_arg // ifN.
    rewrite /search_arg -/search_arg.
    destruct (a < n.+1) eqn:a_lt_Sn; last by trivial.
    move: a_lt_Sn. rewrite ltnS => a_lt_Sn.
    destruct (search_arg a n) as [q|] eqn:REC;
      destruct (P (f n)) eqn:Pfn => //=;
      [elim: (R (f n) (f q)) => // |];
      by move=> x_is; injection x_is => <-.
  Qed.

  (* Since [search_arg] considers only points within a given range, if it
     returns a point, then that point lies within the given range. *)
  Lemma search_arg_in_range:
    forall a b x,
      search_arg a b = Some x -> a <= x < b.
  Proof.
    move=> a b x.
    elim: b => [| n IND]; first by rewrite /search_arg // ifN.
    rewrite /search_arg -/search_arg.
    destruct (a < n.+1) eqn:a_lt_Sn; last by trivial.
    move: a_lt_Sn. rewrite ltnS => a_lt_Sn.
    destruct (search_arg a n) as [q|] eqn:REC;
      elim: (P (f n)) => //=.
    - elim: (R (f n) (f q)) => //= x_is;
        first by injection x_is => <-; apply /andP; split.
      move: (IND x_is) => /andP [a_le_x x_lt_n].
      apply /andP; split => //.
      by rewrite ltnS ltnW.
    - move => x_is.
      move: (IND x_is) => /andP [a_le_x x_lt_n].
      apply /andP; split => //.
      by rewrite ltnS ltnW.
    - move => x_is.
      by injection x_is => <-; apply /andP; split.
  Qed.

  (* Let us assume that [R] is a reflexive and transitive total order... *)
  Hypothesis R_reflexive: reflexive R.
  Hypothesis R_transitive: transitive R.
  Hypothesis R_total: total R.

  (* ...then [search_arg] yields an extremum w.r.t. to [a, b), that is, if
     [search_arg] yields a point x, then [R (f x) (f y)] holds for any [y] in the
     search range [a, b) that satisfies [P]. *)
  Lemma search_arg_extremum:
    forall a b x,
      search_arg a b = Some x ->
      forall y,
        a <= y < b ->
        P (f y) ->
        R (f x) (f y).
  Proof.
    move=> a b x SEARCH.
    elim: b x SEARCH => n IND x; first by rewrite /search_arg.
    rewrite /search_arg -/search_arg.
    destruct (a < n.+1) eqn:a_lt_Sn; last by trivial.
    move: a_lt_Sn. rewrite ltnS => a_lt_Sn.
    destruct (search_arg a n) as [q|] eqn:REC;
      destruct (P (f n)) eqn:Pfn => //=.
    - rewrite <- REC in IND.
      destruct (R (f n) (f q)) eqn:REL => some_x_is;
        move=> y /andP [a_le_y y_lt_Sn] Pfy;
        injection some_x_is => x_is; rewrite -{}x_is //;
        move: y_lt_Sn; rewrite ltnS;
        rewrite leq_eqVlt => /orP [/eqP EQ | y_lt_n].
      + by rewrite EQ; apply (R_reflexive (f n)).
      + apply (R_transitive (f q)) => //.
        move: (IND q REC y) => HOLDS.
        apply HOLDS => //.
        by apply /andP; split.
      + rewrite EQ.
        move: (R_total (f q) (f n)) => /orP [R_qn | R_nq] //.
        by move: REL => /negP.
      + move: (IND q REC y) => HOLDS.
        apply HOLDS => //.
        by apply /andP; split.
    - move=> some_q_is y /andP [a_le_y y_lt_Sn] Pfy.
      move: y_lt_Sn. rewrite ltnS.
      rewrite leq_eqVlt => /orP [/eqP EQ | y_lt_n].
      + exfalso. move: Pfn => /negP Pfn. by subst.
      + apply IND => //. by apply /andP; split.
    - move=> some_n_is. injection some_n_is => n_is.
      move=> y /andP [a_le_y y_lt_Sn] Pfy.
      move: y_lt_Sn. rewrite ltnS.
      rewrite leq_eqVlt => /orP [/eqP EQ | y_lt_n].
      + by rewrite -n_is EQ; apply (R_reflexive (f n)).
      + exfalso.
        move: REC. rewrite search_arg_none => NONE.
        move: (NONE y) => not_Pfy.
        feed not_Pfy; first by apply /andP; split.
        by move: not_Pfy => /negP.
  Qed.

End ArgSearch.

Section ExMinn.

  (* We show that the fact that the minimal satisfying argument [ex_minn ex] of
     a predicate [pred] satisfies another predicate [P] implies the existence
     of a minimal element that satisfies both [pred] and [P]. *)
  Lemma prop_on_ex_minn:
    forall (P : nat -> Prop) (pred : nat -> bool) (ex : exists n, pred n),
      P (ex_minn ex) ->
      exists n, P n /\ pred n /\ (forall n', pred n' -> n <= n').
  Proof.
    intros.
    exists (ex_minn ex); repeat split; auto.
    all: have MIN := ex_minnP ex; move: MIN => [n Pn MIN]; auto.
  Qed.

  (* As a corollary, we show that if there is a constant [c] such
     that [P c], then the minimal satisfying argument [ex_minn ex]
     of a predicate [P] is less than or equal to [c]. *)
  Corollary ex_minn_le_ex:
    forall (P : nat -> bool) (exP : exists n, P n) (c : nat),
      P c ->
      ex_minn exP <= c.
  Proof.
    intros ? ? ? EX.
    rewrite leqNgt; apply/negP; intros GT.
    pattern (ex_minn (P:=P) exP) in GT;
      apply prop_on_ex_minn in GT; move: GT => [n [LT [Pn MIN]]].
    specialize (MIN c EX).
      by move: MIN; rewrite leqNgt; move => /negP MIN; apply: MIN.
  Qed.

End ExMinn.


(** * MoreInd: More on Induction *)

Require Export ProofObjects.

(* ##################################################### *)
(** * Induction Principles *)

(** This is a good point to pause and take a deeper look at induction
    principles.

    Every time we declare a new [Inductive] datatype, Coq
    automatically generates and proves an _induction principle_
    for this type.

    The induction principle for a type [t] is called [t_ind].  Here is
    the one for natural numbers: *)

Check nat_ind.
(*  ===> nat_ind :
           forall P : nat -> Prop,
              P 0  ->
              (forall n : nat, P n -> P (S n))  ->
              forall n : nat, P n  *)

(** The [induction] tactic is a straightforward wrapper that, at
    its core, simply performs [apply t_ind].  To see this more
    clearly, let's experiment a little with using [apply nat_ind]
    directly, instead of the [induction] tactic, to carry out some
    proofs.  Here, for example, is an alternate proof of a theorem
    that we saw in the [Basics] chapter. *)

Theorem mult_0_r' : forall n:nat,
  n * 0 = 0.
Proof.
  apply nat_ind.
  Case "O". reflexivity.
  Case "S". simpl. intros n IHn. rewrite -> IHn.
    reflexivity.  Qed.

(** This proof is basically the same as the earlier one, but a
    few minor differences are worth noting.  First, in the induction
    step of the proof (the ["S"] case), we have to do a little
    bookkeeping manually (the [intros]) that [induction] does
    automatically.

    Second, we do not introduce [n] into the context before applying
    [nat_ind] -- the conclusion of [nat_ind] is a quantified formula,
    and [apply] needs this conclusion to exactly match the shape of
    the goal state, including the quantifier.  The [induction] tactic
    works either with a variable in the context or a quantified
    variable in the goal.

    Third, the [apply] tactic automatically chooses variable names for
    us (in the second subgoal, here), whereas [induction] lets us
    specify (with the [as...]  clause) what names should be used.  The
    automatic choice is actually a little unfortunate, since it
    re-uses the name [n] for a variable that is different from the [n]
    in the original theorem.  This is why the [Case] annotation is
    just [S] -- if we tried to write it out in the more explicit form
    that we've been using for most proofs, we'd have to write [n = S
    n], which doesn't make a lot of sense!  All of these conveniences
    make [induction] nicer to use in practice than applying induction
    principles like [nat_ind] directly.  But it is important to
    realize that, modulo this little bit of bookkeeping, applying
    [nat_ind] is what we are really doing. *)

(** **** Exercise: 2 stars, optional (plus_one_r') *)
(** Complete this proof as we did [mult_0_r'] above, without using
    the [induction] tactic. *)

Theorem plus_one_r' : forall n:nat,
  n + 1 = S n.
Proof.
  apply nat_ind.
  {reflexivity. }
  {intros. simpl. rewrite -> plus_comm. reflexivity. }
  Qed.

(** Coq generates induction principles for every datatype defined with
    [Inductive], including those that aren't recursive. (Although
    we don't need induction to prove properties of non-recursive
    datatypes, the idea of an induction principle still makes sense
    for them: it gives a way to prove that a property holds for all
    values of the type.)

    These generated principles follow a similar pattern. If we define a
    type [t] with constructors [c1] ... [cn], Coq generates a theorem
    with this shape:
    t_ind :
       forall P : t -> Prop,
            ... case for c1 ... ->
            ... case for c2 ... ->
            ...
            ... case for cn ... ->
            forall n : t, P n
    The specific shape of each case depends on the arguments to the
    corresponding constructor.  Before trying to write down a general
    rule, let's look at some more examples. First, an example where
    the constructors take no arguments: *)

Inductive yesno : Type :=
  | yes : yesno
  | no : yesno.

Check yesno_ind.
(* ===> yesno_ind : forall P : yesno -> Prop,
                      P yes  ->
                      P no  ->
                      forall y : yesno, P y *)

(** **** Exercise: 1 star, optional (rgb) *)
(** Write out the induction principle that Coq will generate for the
    following datatype.  Write down your answer on paper or type it
    into a comment, and then compare it with what Coq prints. *)

Inductive rgb : Type :=
  | red : rgb
  | green : rgb
  | blue : rgb.
Check rgb_ind.
(** rgb_ind : forall P : rgb -> Prop,
       P red -> P green -> P blue -> forall y : rgb, P y*)

(** Here's another example, this time with one of the constructors
    taking some arguments. *)

Inductive natlist : Type :=
  | nnil : natlist
  | ncons : nat -> natlist -> natlist.

Check natlist_ind.
(* ===> (modulo a little variable renaming for clarity)
   natlist_ind :
      forall P : natlist -> Prop,
         P nnil  ->
         (forall (n : nat) (l : natlist), P l -> P (ncons n l)) ->
         forall n : natlist, P n *)

(** **** Exercise: 1 star, optional (natlist1) *)
(** Suppose we had written the above definition a little
   differently: *)

Inductive natlist1 : Type :=
  | nnil1 : natlist1
  | nsnoc1 : natlist1 -> nat -> natlist1.

(** Now what will the induction principle look like? *)
(** natlist1_ind :
      forall P : natlist1 -> Prop,
        P nnil1 -> (forall (l : natlist1) (n : nat), P l -> P (nsnoc1 l n)) ->
        forall n : natlist, P n*)

(** From these examples, we can extract this general rule:

    - The type declaration gives several constructors; each
      corresponds to one clause of the induction principle.
    - Each constructor [c] takes argument types [a1]...[an].
    - Each [ai] can be either [t] (the datatype we are defining) or
      some other type [s].
    - The corresponding case of the induction principle
      says (in English):
        - "for all values [x1]...[xn] of types [a1]...[an], if [P]
           holds for each of the inductive arguments (each [xi] of
           type [t]), then [P] holds for [c x1 ... xn]".

*)

(** **** Exercise: 1 star, optional (byntree_ind) *)
(** Write out the induction principle that Coq will generate for the
    following datatype.  Write down your answer on paper or type it
    into a comment, and then compare it with what Coq prints. *)

Inductive byntree : Type :=
 | bempty : byntree
 | bleaf  : yesno -> byntree
 | nbranch : yesno -> byntree -> byntree -> byntree.
(**

byntree_ind : forall P : byntree -> Prop,
                P bempty -> (forall y : yesno, P (bleaf y)) ->
                (forall (y : yesno) (b1 b2 : byntree), P b1 -> P b2 -> P (nbranch y b1 b2)) ->
                forall b : byntree, P b*)

(** **** Exercise: 1 star, optional (ex_set) *)
(** Here is an induction principle for an inductively defined
    set.
      ExSet_ind :
         forall P : ExSet -> Prop,
             (forall b : bool, P (con1 b)) ->
             (forall (n : nat) (e : ExSet), P e -> P (con2 n e)) ->
             forall e : ExSet, P e
    Give an [Inductive] definition of [ExSet]: *)

Inductive ExSet : Type :=
  |con1 : bool -> ExSet
  |con2 : nat -> ExSet -> ExSet.

(** What about polymorphic datatypes?

    The inductive definition of polymorphic lists
      Inductive list (X:Type) : Type :=
        | nil : list X
        | cons : X -> list X -> list X.
    is very similar to that of [natlist].  The main difference is
    that, here, the whole definition is _parameterized_ on a set [X]:
    that is, we are defining a _family_ of inductive types [list X],
    one for each [X].  (Note that, wherever [list] appears in the body
    of the declaration, it is always applied to the parameter [X].)
    The induction principle is likewise parameterized on [X]:
     list_ind :
       forall (X : Type) (P : list X -> Prop),
          P [] ->
          (forall (x : X) (l : list X), P l -> P (x :: l)) ->
          forall l : list X, P l
   Note the wording here (and, accordingly, the form of [list_ind]):
   The _whole_ induction principle is parameterized on [X].  That is,
   [list_ind] can be thought of as a polymorphic function that, when
   applied to a type [X], gives us back an induction principle
   specialized to the type [list X]. *)

(** **** Exercise: 1 star, optional (tree) *)
(** Write out the induction principle that Coq will generate for
   the following datatype.  Compare your answer with what Coq
   prints. *)

Inductive tree (X:Type) : Type :=
  | leaf : X -> tree X
  | node : tree X -> tree X -> tree X.
Check tree_ind.
(**
tree_ind : forall (X : Type) (P : tree X -> Prop),
            (forall x : X, P (leaf x)) ->
            (forall (t1 t2 : tree X), P t1 -> P t2 -> P (node t1 t2)) ->
            forall t : tree X, P t*)

(** **** Exercise: 1 star, optional (mytype) *)
(** Find an inductive definition that gives rise to the
    following induction principle:
      mytype_ind :
        forall (X : Type) (P : mytype X -> Prop),
            (forall x : X, P (constr1 X x)) ->
            (forall n : nat, P (constr2 X n)) ->
            (forall m : mytype X, P m ->
               forall n : nat, P (constr3 X m n)) ->
            forall m : mytype X, P m
*)
Inductive mytype (X : Type) : Type :=
  |constr1 : X -> mytype X
  |constr2 : nat -> mytype X
  |constr3 : mytype X -> nat -> mytype X.

(** **** Exercise: 1 star, optional (foo) *)
(** Find an inductive definition that gives rise to the
    following induction principle:
      foo_ind :
        forall (X Y : Type) (P : foo X Y -> Prop),
             (forall x : X, P (bar X Y x)) ->
             (forall y : Y, P (baz X Y y)) ->
             (forall f1 : nat -> foo X Y,
               (forall n : nat, P (f1 n)) -> P (quux X Y f1)) ->
             forall f2 : foo X Y, P f2
*)
Inductive foo (X Y : Type) : Type :=
  |bar : X -> foo X Y
  |baz : Y -> foo X Y
  |quux : nat -> foo X Y -> nat -> foo X Y.

(** **** Exercise: 1 star, optional (foo') *)
(** Consider the following inductive definition: *)

Inductive foo' (X:Type) : Type :=
  | C1 : list X -> foo' X -> foo' X
  | C2 : foo' X.

(** What induction principle will Coq generate for [foo']?  Fill
   in the blanks, then check your answer with Coq.)
     foo'_ind :
        forall (X : Type) (P : foo' X -> Prop),
              (forall (l : list X) (f : foo' X),
                    (forall (l : list X) (f : foo' X), P f -> P (C1 l f)) ->
             P C2 ->
             forall f : foo' X, P f
*)

(** [] *)

(* ##################################################### *)
(** ** Induction Hypotheses *)

(** Where does the phrase "induction hypothesis" fit into this story?

    The induction principle for numbers
       forall P : nat -> Prop,
            P 0  ->
            (forall n : nat, P n -> P (S n))  ->
            forall n : nat, P n
   is a generic statement that holds for all propositions
   [P] (strictly speaking, for all families of propositions [P]
   indexed by a number [n]).  Each time we use this principle, we
   are choosing [P] to be a particular expression of type
   [nat->Prop].

   We can make the proof more explicit by giving this expression a
   name.  For example, instead of stating the theorem [mult_0_r] as
   "[forall n, n * 0 = 0]," we can write it as "[forall n, P_m0r
   n]", where [P_m0r] is defined as... *)

Definition P_m0r (n:nat) : Prop :=
  n * 0 = 0.

(** ... or equivalently... *)

Definition P_m0r' : nat->Prop :=
  fun n => n * 0 = 0.

(** Now when we do the proof it is easier to see where [P_m0r]
    appears. *)

Theorem mult_0_r'' : forall n:nat,
  P_m0r n.
Proof.
  apply nat_ind.
  Case "n = O". reflexivity.
  Case "n = S n'".
    (* Note the proof state at this point! *)
    intros n IHn.
    unfold P_m0r in IHn. unfold P_m0r. simpl. apply IHn. Qed.

(** This extra naming step isn't something that we'll do in
    normal proofs, but it is useful to do it explicitly for an example
    or two, because it allows us to see exactly what the induction
    hypothesis is.  If we prove [forall n, P_m0r n] by induction on
    [n] (using either [induction] or [apply nat_ind]), we see that the
    first subgoal requires us to prove [P_m0r 0] ("[P] holds for
    zero"), while the second subgoal requires us to prove [forall n',
    P_m0r n' -> P_m0r n' (S n')] (that is "[P] holds of [S n'] if it
    holds of [n']" or, more elegantly, "[P] is preserved by [S]").
    The _induction hypothesis_ is the premise of this latter
    implication -- the assumption that [P] holds of [n'], which we are
    allowed to use in proving that [P] holds for [S n']. *)

(* ##################################################### *)
(** ** More on the [induction] Tactic *)

(** The [induction] tactic actually does even more low-level
    bookkeeping for us than we discussed above.

    Recall the informal statement of the induction principle for
    natural numbers:
      - If [P n] is some proposition involving a natural number n, and
        we want to show that P holds for _all_ numbers n, we can
        reason like this:
          - show that [P O] holds
          - show that, if [P n'] holds, then so does [P (S n')]
          - conclude that [P n] holds for all n.
    So, when we begin a proof with [intros n] and then [induction n],
    we are first telling Coq to consider a _particular_ [n] (by
    introducing it into the context) and then telling it to prove
    something about _all_ numbers (by using induction).

    What Coq actually does in this situation, internally, is to
    "re-generalize" the variable we perform induction on.  For
    example, in our original proof that [plus] is associative...
*)

Theorem plus_assoc' : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  (* ...we first introduce all 3 variables into the context,
     which amounts to saying "Consider an arbitrary [n], [m], and
     [p]..." *)
  intros n m p.
  (* ...We now use the [induction] tactic to prove [P n] (that
     is, [n + (m + p) = (n + m) + p]) for _all_ [n],
     and hence also for the particular [n] that is in the context
     at the moment. *)
  induction n as [| n'].
  Case "n = O". reflexivity.
  Case "n = S n'".
    (* In the second subgoal generated by [induction] -- the
       "inductive step" -- we must prove that [P n'] implies
       [P (S n')] for all [n'].  The [induction] tactic
       automatically introduces [n'] and [P n'] into the context
       for us, leaving just [P (S n')] as the goal. *)
    simpl. rewrite -> IHn'. reflexivity.  Qed.

(** It also works to apply [induction] to a variable that is
   quantified in the goal. *)

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

(** Note that [induction n] leaves [m] still bound in the goal --
    i.e., what we are proving inductively is a statement beginning
    with [forall m].

    If we do [induction] on a variable that is quantified in the goal
    _after_ some other quantifiers, the [induction] tactic will
    automatically introduce the variables bound by these quantifiers
    into the context. *)

Theorem plus_comm'' : forall n m : nat,
  n + m = m + n.
Proof.
  (* Let's do induction on [m] this time, instead of [n]... *)
  induction m as [| m'].
  Case "m = O". simpl. rewrite -> plus_0_r. reflexivity.
  Case "m = S m'". simpl. rewrite <- IHm'.
    rewrite <- plus_n_Sm. reflexivity.  Qed.

(** **** Exercise: 1 star, optional (plus_explicit_prop) *)
(** Rewrite both [plus_assoc'] and [plus_comm'] and their proofs in
    the same style as [mult_0_r''] above -- that is, for each theorem,
    give an explicit [Definition] of the proposition being proved by
    induction, and state the theorem and proof in terms of this
    defined proposition.  *)

Theorem plus_assoc'' : forall n m p, n + (m + p) = (n + m) + p.
Proof.
  intros. apply nat_ind with (n := n).
  {simpl. reflexivity. }
  {intros. simpl. rewrite -> H. reflexivity. }
  Qed.

Theorem plus_comm''' : forall n m, n + m = m + n.
Proof.
  intros. apply nat_ind with (n := n).
  {simpl. rewrite -> plus_0_r. reflexivity. }
  {intros. simpl. rewrite <- plus_n_Sm. rewrite -> H.
   reflexivity. }
  Qed.

(** ** Generalizing Inductions. *)

(** One potentially confusing feature of the [induction] tactic is
that it happily lets you try to set up an induction over a term
that isn't sufficiently general.  The net effect of this will be
do lose information (much as [destruct] can do), and leave
you unable to complete the proof. Here's an example: *)

Lemma one_not_beautiful_FAILED: ~ beautiful 1.
Proof.
  intro H.
  (* Just doing an [inversion] on [H] won't get us very far in the [b_sum]

    case. (Try it!). So we'll need induction. A naive first attempt: *)
  induction H.
  (* But now, although we get four cases, as we would expect from
     the definition of [beautiful], we lose all information about [H] ! *)
Abort.

(** The problem is that [induction] over a Prop only works properly over
   completely general instances of the Prop, i.e. one in which all
   the arguments are free (unconstrained) variables.
   In this respect it behaves more
   like [destruct] than like [inversion].

   When you're tempted to do use [induction] like this, it is generally
   an indication that you need to be proving something more general.
   But in some cases, it suffices to pull out any concrete arguments
   into separate equations, like this: *)

Lemma one_not_beautiful: forall n, n = 1 -> ~ beautiful n.
Proof.
 intros n E H.
  induction H  as [| | | p q Hp IHp Hq IHq].
    Case "b_0".
      inversion E.
    Case "b_3".
      inversion E.
    Case "b_5".
      inversion E.
    Case "b_sum".
      (* the rest is a tedious case analysis *)
      destruct p as [|p'].
      SCase "p = 0".
        destruct q as [|q'].
        SSCase "q = 0".
          inversion E.
        SSCase "q = S q'".
          apply IHq. apply E.
      SCase "p = S p'".
        destruct q as [|q'].
        SSCase "q = 0".
          apply IHp.  rewrite plus_0_r in E. apply E.
        SSCase "q = S q'".
          simpl in E. inversion E.  destruct p'.  inversion H0.  inversion H0.
Qed.

(** There's a handy [remember] tactic that can generate the second
proof state out of the original one. *)

Lemma one_not_beautiful': ~ beautiful 1.
Proof.
  intros H.
  remember 1 as n eqn:E.
  (* now carry on as above *)
  induction H.
  {inversion E. }
  {inversion E. }
  {inversion E. }
  {destruct n.
   {destruct m.
    {inversion E. }
    {apply IHbeautiful2. simpl in E. inversion E. reflexivity. }
   }
   {destruct m.
    {apply IHbeautiful1. rewrite -> plus_0_r in E. apply E. }
    {simpl in E. inversion E. destruct n.
     {simpl in *. inversion H2. }
     {simpl in *. inversion H2. }
    }
   }
   }
  Qed.

(* ####################################################### *)
(** * Informal Proofs (Advanced) *)

(** Q: What is the relation between a formal proof of a proposition
       [P] and an informal proof of the same proposition [P]?

    A: The latter should _teach_ the reader how to produce the
       former.

    Q: How much detail is needed??

    Unfortunately, There is no single right answer; rather, there is a
    range of choices.

    At one end of the spectrum, we can essentially give the reader the
    whole formal proof (i.e., the informal proof amounts to just
    transcribing the formal one into words).  This gives the reader
    the _ability_ to reproduce the formal one for themselves, but it
    doesn't _teach_ them anything.

   At the other end of the spectrum, we can say "The theorem is true
   and you can figure out why for yourself if you think about it hard
   enough."  This is also not a good teaching strategy, because
   usually writing the proof requires some deep insights into the
   thing we're proving, and most readers will give up before they
   rediscover all the same insights as we did.

   In the middle is the golden mean -- a proof that includes all of
   the essential insights (saving the reader the hard part of work
   that we went through to find the proof in the first place) and
   clear high-level suggestions for the more routine parts to save the
   reader from spending too much time reconstructing these
   parts (e.g., what the IH says and what must be shown in each case
   of an inductive proof), but not so much detail that the main ideas
   are obscured.

   Another key point: if we're comparing a formal proof of a
   proposition [P] and an informal proof of [P], the proposition [P]
   doesn't change.  That is, formal and informal proofs are _talking
   about the same world_ and they _must play by the same rules_. *)
(** ** Informal Proofs by Induction *)

(** Since we've spent much of this chapter looking "under the hood" at
    formal proofs by induction, now is a good moment to talk a little
    about _informal_ proofs by induction.

    In the real world of mathematical communication, written proofs
    range from extremely longwinded and pedantic to extremely brief
    and telegraphic.  The ideal is somewhere in between, of course,
    but while you are getting used to the style it is better to start
    out at the pedantic end.  Also, during the learning phase, it is
    probably helpful to have a clear standard to compare against.
    With this in mind, we offer two templates below -- one for proofs
    by induction over _data_ (i.e., where the thing we're doing
    induction on lives in [Type]) and one for proofs by induction over
    _evidence_ (i.e., where the inductively defined thing lives in
    [Prop]).  In the rest of this course, please follow one of the two
    for _all_ of your inductive proofs. *)

(** *** Induction Over an Inductively Defined Set *)

(** _Template_:

       - _Theorem_: <Universally quantified proposition of the form
         "For all [n:S], [P(n)]," where [S] is some inductively defined
         set.>

         _Proof_: By induction on [n].

           <one case for each constructor [c] of [S]...>

           - Suppose [n = c a1 ... ak], where <...and here we state
             the IH for each of the [a]'s that has type [S], if any>.
             We must show <...and here we restate [P(c a1 ... ak)]>.

             <go on and prove [P(n)] to finish the case...>

           - <other cases similarly...>                        []

    _Example_:

      - _Theorem_: For all sets [X], lists [l : list X], and numbers
        [n], if [length l = n] then [index (S n) l = None].

        _Proof_: By induction on [l].

        - Suppose [l = []].  We must show, for all numbers [n],
          that, if length [[] = n], then [index (S n) [] =
          None].

          This follows immediately from the definition of index.

        - Suppose [l = x :: l'] for some [x] and [l'], where
          [length l' = n'] implies [index (S n') l' = None], for
          any number [n'].  We must show, for all [n], that, if
          [length (x::l') = n] then [index (S n) (x::l') =
          None].

          Let [n] be a number with [length l = n].  Since
            length l = length (x::l') = S (length l'),
          it suffices to show that
            index (S (length l')) l' = None.
]]
          But this follows directly from the induction hypothesis,
          picking [n'] to be length [l'].  [] *)

(** *** Induction Over an Inductively Defined Proposition *)

(** Since inductively defined proof objects are often called
    "derivation trees," this form of proof is also known as _induction
    on derivations_.

    _Template_:

       - _Theorem_: <Proposition of the form "[Q -> P]," where [Q] is
         some inductively defined proposition (more generally,
         "For all [x] [y] [z], [Q x y z -> P x y z]")>

         _Proof_: By induction on a derivation of [Q].  <Or, more
         generally, "Suppose we are given [x], [y], and [z].  We
         show that [Q x y z] implies [P x y z], by induction on a
         derivation of [Q x y z]"...>

           <one case for each constructor [c] of [Q]...>

           - Suppose the final rule used to show [Q] is [c].  Then
             <...and here we state the types of all of the [a]'s
             together with any equalities that follow from the
             definition of the constructor and the IH for each of
             the [a]'s that has type [Q], if there are any>.  We must
             show <...and here we restate [P]>.

             <go on and prove [P] to finish the case...>

           - <other cases similarly...>                        []

    _Example_

       - _Theorem_: The [<=] relation is transitive -- i.e., for all
         numbers [n], [m], and [o], if [n <= m] and [m <= o], then
         [n <= o].

         _Proof_: By induction on a derivation of [m <= o].

           - Suppose the final rule used to show [m <= o] is
             [le_n]. Then [m = o] and we must show that [n <= m],
             which is immediate by hypothesis.

           - Suppose the final rule used to show [m <= o] is
             [le_S].  Then [o = S o'] for some [o'] with [m <= o'].
             We must show that [n <= S o'].
             By induction hypothesis, [n <= o'].

             But then, by [le_S], [n <= S o'].  [] *)

(* ##################################################### *)
(** * Optional Material *)

(** The remainder of this chapter offers some additional details on
    how induction works in Coq, the process of building proof
    trees, and the "trusted computing base" that underlies
    Coq proofs.  It can safely be skimmed on a first reading.  (We
    recommend skimming rather than skipping over it outright: it
    answers some questions that occur to many Coq users at some point,
    so it is useful to have a rough idea of what's here.) *)

(* ##################################################### *)
(** ** Induction Principles in [Prop] *)

(** Earlier, we looked in detail at the induction principles that Coq
    generates for inductively defined _sets_.  The induction
    principles for inductively defined _propositions_ like [gorgeous]
    are a tiny bit more complicated.  As with all induction
    principles, we want to use the induction principle on [gorgeous]
    to prove things by inductively considering the possible shapes
    that something in [gorgeous] can have -- either it is evidence
    that [0] is gorgeous, or it is evidence that, for some [n], [3+n]
    is gorgeous, or it is evidence that, for some [n], [5+n] is
    gorgeous and it includes evidence that [n] itself is.  Intuitively
    speaking, however, what we want to prove are not statements about
    _evidence_ but statements about _numbers_.  So we want an
    induction principle that lets us prove properties of numbers by
    induction on evidence.

    For example, from what we've said so far, you might expect the
    inductive definition of [gorgeous]...
    Inductive gorgeous : nat -> Prop :=
         g_0 : gorgeous 0
       | g_plus3 : forall n, gorgeous n -> gorgeous (3+m)
       | g_plus5 : forall n, gorgeous n -> gorgeous (5+m).
    ...to give rise to an induction principle that looks like this...
    gorgeous_ind_max :
       forall P : (forall n : nat, gorgeous n -> Prop),
            P O g_0 ->
            (forall (m : nat) (e : gorgeous m),
               P m e -> P (3+m) (g_plus3 m e) ->
            (forall (m : nat) (e : gorgeous m),
               P m e -> P (5+m) (g_plus5 m e) ->
            forall (n : nat) (e : gorgeous n), P n e
    ... because:

     - Since [gorgeous] is indexed by a number [n] (every [gorgeous]
       object [e] is a piece of evidence that some particular number
       [n] is gorgeous), the proposition [P] is parameterized by both
       [n] and [e] -- that is, the induction principle can be used to
       prove assertions involving both a gorgeous number and the
       evidence that it is gorgeous.

     - Since there are three ways of giving evidence of gorgeousness
       ([gorgeous] has three constructors), applying the induction
       principle generates three subgoals:

         - We must prove that [P] holds for [O] and [b_0].

         - We must prove that, whenever [n] is a gorgeous
           number and [e] is an evidence of its gorgeousness,
           if [P] holds of [n] and [e],
           then it also holds of [3+m] and [g_plus3 n e].

         - We must prove that, whenever [n] is a gorgeous
           number and [e] is an evidence of its gorgeousness,
           if [P] holds of [n] and [e],
           then it also holds of [5+m] and [g_plus5 n e].

     - If these subgoals can be proved, then the induction principle
       tells us that [P] is true for _all_ gorgeous numbers [n] and
       evidence [e] of their gorgeousness.

    But this is a little more flexibility than we actually need or
    want: it is giving us a way to prove logical assertions where the
    assertion involves properties of some piece of _evidence_ of
    gorgeousness, while all we really care about is proving
    properties of _numbers_ that are gorgeous -- we are interested in
    assertions about numbers, not about evidence.  It would therefore
    be more convenient to have an induction principle for proving
    propositions [P] that are parameterized just by [n] and whose
    conclusion establishes [P] for all gorgeous numbers [n]:
       forall P : nat -> Prop,
          ... ->
             forall n : nat, gorgeous n -> P n
    For this reason, Coq actually generates the following simplified
    induction principle for [gorgeous]: *)

Check gorgeous_ind.
(* ===>  gorgeous_ind
     : forall P : nat -> Prop,
       P 0 ->
       (forall n : nat, gorgeous n -> P n -> P (3 + n)) ->
       (forall n : nat, gorgeous n -> P n -> P (5 + n)) ->
       forall n : nat, gorgeous n -> P n *)

(** In particular, Coq has dropped the evidence term [e] as a
    parameter of the the proposition [P], and consequently has
    rewritten the assumption [forall (n : nat) (e: gorgeous n), ...]
    to be [forall (n : nat), gorgeous n -> ...]; i.e., we no longer
    require explicit evidence of the provability of [gorgeous n]. *)

(** In English, [gorgeous_ind] says:

    - Suppose, [P] is a property of natural numbers (that is, [P n] is
      a [Prop] for every [n]).  To show that [P n] holds whenever [n]
      is gorgeous, it suffices to show:

      - [P] holds for [0],

      - for any [n], if [n] is gorgeous and [P] holds for
        [n], then [P] holds for [3+n],

      - for any [n], if [n] is gorgeous and [P] holds for
        [n], then [P] holds for [5+n]. *)

(** As expected, we can apply [gorgeous_ind] directly instead of using [induction]. *)

Theorem gorgeous__beautiful' : forall n, gorgeous n -> beautiful n.
Proof.
   intros.
   apply gorgeous_ind.
   Case "g_0".
       apply b_0.
   Case "g_plus3".
       intros.
       apply b_sum. apply b_3.
       apply H1.
   Case "g_plus5".
       intros.
       apply b_sum. apply b_5.
       apply H1.
   apply H.
Qed.

(** The precise form of an Inductive definition can affect the
    induction principle Coq generates.

For example, in [Logic], we have defined [<=] as: *)

(* Inductive le : nat -> nat -> Prop :=
     | le_n : forall n, le n n
     | le_S : forall n m, (le n m) -> (le n (S m)). *)

(** This definition can be streamlined a little by observing that the
    left-hand argument [n] is the same everywhere in the definition,
    so we can actually make it a "general parameter" to the whole
    definition, rather than an argument to each constructor. *)

Inductive le (n:nat) : nat -> Prop :=
  | le_n : le n n
  | le_S : forall m, (le n m) -> (le n (S m)).

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

(** The second one is better, even though it looks less symmetric.
    Why?  Because it gives us a simpler induction principle. *)

Check le_ind.
(* ===>  forall (n : nat) (P : nat -> Prop),
           P n ->
           (forall m : nat, n <= m -> P m -> P (S m)) ->
           forall n0 : nat, n <= n0 -> P n0 *)

(** By contrast, the induction principle that Coq calculates for the
    first definition has a lot of extra quantifiers, which makes it
    messier to work with when proving things by induction.  Here is
    the induction principle for the first [le]: *)

(* le_ind :
     forall P : nat -> nat -> Prop,
     (forall n : nat, P n n) ->
     (forall n m : nat, le n m -> P n m -> P n (S m)) ->
     forall n n0 : nat, le n n0 -> P n n0 *)

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

(** **** Exercise: 2 stars, optional (foo_ind_principle) *)
(** Suppose we make the following inductive definition:
   Inductive foo (X : Set) (Y : Set) : Set :=
     | foo1 : X -> foo X Y
     | foo2 : Y -> foo X Y
     | foo3 : foo X Y -> foo X Y.
   Fill in the blanks to complete the induction principle that will be
   generated by Coq.
   foo_ind
        : forall (X Y : Set) (P : foo X Y -> Prop),
          (forall x : X, __________________________________) ->
          (forall y : Y, __________________________________) ->
          (________________________________________________) ->
           ________________________________________________

*)
(** [] *)

(** **** Exercise: 2 stars, optional (bar_ind_principle) *)
(** Consider the following induction principle:
   bar_ind
        : forall P : bar -> Prop,
          (forall n : nat, P (bar1 n)) ->
          (forall b : bar, P b -> P (bar2 b)) ->
          (forall (b : bool) (b0 : bar), P b0 -> P (bar3 b b0)) ->
          forall b : bar, P b
   Write out the corresponding inductive set definition.
   Inductive bar : Set :=
     | bar1 : ________________________________________
     | bar2 : ________________________________________
     | bar3 : ________________________________________.

*)
(** [] *)

(** **** Exercise: 2 stars, optional (no_longer_than_ind) *)
(** Given the following inductively defined proposition:
  Inductive no_longer_than (X : Set) : (list X) -> nat -> Prop :=
    | nlt_nil  : forall n, no_longer_than X [] n
    | nlt_cons : forall x l n, no_longer_than X l n ->
                               no_longer_than X (x::l) (S n)
    | nlt_succ : forall l n, no_longer_than X l n ->
                             no_longer_than X l (S n).
  write the induction principle generated by Coq.
  no_longer_than_ind
       : forall (X : Set) (P : list X -> nat -> Prop),
         (forall n : nat, ____________________) ->
         (forall (x : X) (l : list X) (n : nat),
          no_longer_than X l n -> ____________________ ->
                                  _____________________________ ->
         (forall (l : list X) (n : nat),
          no_longer_than X l n -> ____________________ ->
                                  _____________________________ ->
         forall (l : list X) (n : nat), no_longer_than X l n ->
           ____________________

*)
(** [] *)

(* ##################################################### *)
(** ** Induction Principles for other Logical Propositions *)

(** Similarly, in [Logic] we have defined [eq] as: *)

(* Inductive eq (X:Type) : X -> X -> Prop :=
       refl_equal : forall x, eq X x x. *)

(** In the Coq standard library, the definition of equality is
    slightly different: *)

Inductive eq' (X:Type) (x:X) : X -> Prop :=
    refl_equal' : eq' X x x.

(** The advantage of this definition is that the induction
    principle that Coq derives for it is precisely the familiar
    principle of _Leibniz equality_: what we mean when we say "[x] and
    [y] are equal" is that every property on [P] that is true of [x]
    is also true of [y].  *)

Check eq'_ind.
(* ===>
     forall (X : Type) (x : X) (P : X -> Prop),
       P x -> forall y : X, x =' y -> P y

   ===>  (i.e., after a little reorganization)
     forall (X : Type) (x : X) forall y : X,
       x =' y ->
       forall P : X -> Prop, P x -> P y *)

(** The induction principles for conjunction and disjunction are a
    good illustration of Coq's way of generating simplified induction
    principles for [Inductive]ly defined propositions, which we
    discussed above.  You try first: *)

(** **** Exercise: 1 star, optional (and_ind_principle) *)
(** See if you can predict the induction principle for conjunction. *)

(* Check and_ind. *)
(** [] *)

(** **** Exercise: 1 star, optional (or_ind_principle) *)
(** See if you can predict the induction principle for disjunction. *)

(* Check or_ind. *)
(** [] *)

Check and_ind.

(** From the inductive definition of the proposition [and P Q]
     Inductive and (P Q : Prop) : Prop :=
       conj : P -> Q -> (and P Q).
    we might expect Coq to generate this induction principle
     and_ind_max :
       forall (P Q : Prop) (P0 : P /\ Q -> Prop),
            (forall (a : P) (b : Q), P0 (conj P Q a b)) ->
            forall a : P /\ Q, P0 a
    but actually it generates this simpler and more useful one:
     and_ind :
       forall P Q P0 : Prop,
            (P -> Q -> P0) ->
            P /\ Q -> P0
    In the same way, when given the inductive definition of [or P Q]
     Inductive or (P Q : Prop) : Prop :=
       | or_introl : P -> or P Q
       | or_intror : Q -> or P Q.
    instead of the "maximal induction principle"
     or_ind_max :
       forall (P Q : Prop) (P0 : P \/ Q -> Prop),
            (forall a : P, P0 (or_introl P Q a)) ->
            (forall b : Q, P0 (or_intror P Q b)) ->
            forall o : P \/ Q, P0 o
    what Coq actually generates is this:
     or_ind :
       forall P Q P0 : Prop,
            (P -> P0) ->
            (Q -> P0) ->
            P \/ Q -> P0
]]
*)

(** **** Exercise: 1 star, optional (False_ind_principle) *)
(** Can you predict the induction principle for falsehood? *)

(* Check False_ind. *)
(** [] *)

(** Here's the induction principle that Coq generates for existentials: *)

Check ex_ind.
(* ===>  forall (X:Type) (P: X->Prop) (Q: Prop),
         (forall witness:X, P witness -> Q) ->
          ex X P ->
           Q *)

(** This induction principle can be understood as follows: If we have
         a function [f] that can construct evidence for [Q] given _any_
        witness of type [X] together with evidence that this witness has
        property [P], then from a proof of [ex X P] we can extract the
        witness and evidence that must have been supplied to the
        constructor, give these to [f], and thus obtain a proof of [Q]. *)

(* ######################################################### *)
(** ** Explicit Proof Objects for Induction *)

(** Although tactic-based proofs are normally much easier to
    work with, the ability to write a proof term directly is sometimes
    very handy, particularly when we want Coq to do something slightly
    non-standard.  *)

(** Recall the induction principle on naturals that Coq generates for
    us automatically from the Inductive declation for [nat]. *)

Check nat_ind.
(* ===>
   nat_ind : forall P : nat -> Prop,
      P 0 ->
      (forall n : nat, P n -> P (S n)) ->
      forall n : nat, P n  *)

(** There's nothing magic about this induction lemma: it's just
   another Coq lemma that requires a proof.  Coq generates the proof
   automatically too...  *)

Print nat_ind.
Print nat_rect.
(* ===> (after some manual inlining and tidying)
   nat_ind =
    fun (P : nat -> Prop)
        (f : P 0)
        (f0 : forall n : nat, P n -> P (S n)) =>
          fix F (n : nat) : P n :=
             match n with
            | 0 => f
            | S n0 => f0 n0 (F n0)
            end.
*)

(** We can read this as follows:
     Suppose we have evidence [f] that [P] holds on 0,  and
     evidence [f0] that [forall n:nat, P n -> P (S n)].
     Then we can prove that [P] holds of an arbitrary nat [n] via
     a recursive function [F] (here defined using the expression
     form [Fix] rather than by a top-level [Fixpoint]
     declaration).  [F] pattern matches on [n]:
      - If it finds 0, [F] uses [f] to show that [P n] holds.
      - If it finds [S n0], [F] applies itself recursively on [n0]
         to obtain evidence that [P n0] holds; then it applies [f0]
         on that evidence to show that [P (S n)] holds.
    [F] is just an ordinary recursive function that happens to
    operate on evidence in [Prop] rather than on terms in [Set].

*)

(**  We can adapt this approach to proving [nat_ind] to help prove
    _non-standard_ induction principles too.  Recall our desire to
    prove that

    [forall n : nat, even n -> ev n].

    Attempts to do this by standard induction on [n] fail, because the
    induction principle only lets us proceed when we can prove that
    [even n -> even (S n)] -- which is of course never provable.  What
    we did in [Logic] was a bit of a hack:

    [Theorem even__ev : forall n : nat,
     (even n -> ev n) /\ (even (S n) -> ev (S n))].

    We can make a much better proof by defining and proving a
    non-standard induction principle that goes "by twos":

 *)

 Definition nat_ind2 :
    forall (P : nat -> Prop),
    P 0 ->
    P 1 ->
    (forall n : nat, P n -> P (S(S n))) ->
    forall n : nat , P n :=
       fun P => fun P0 => fun P1 => fun PSS =>
          fix f (n:nat) := match n with
                             0 => P0
                           | 1 => P1
                           | S (S n') => PSS n' (f n')
                          end.

 (** Once you get the hang of it, it is entirely straightforward to
     give an explicit proof term for induction principles like this.
     Proving this as a lemma using tactics is much less intuitive (try
     it!).

     The [induction ... using] tactic variant gives a convenient way to
     specify a non-standard induction principle like this. *)

Lemma even__ev' : forall n, even n -> ev n.
Proof.
 intros.
 induction n as [ | |n'] using nat_ind2.
  Case "even 0".
    apply ev_0.
  Case "even 1".
    inversion H.
  Case "even (S(S n'))".
    apply ev_SS.
    apply IHn'.  unfold even.  unfold even in H.  simpl in H. apply H.
Qed.

(* ######################################################### *)
(** ** The Coq Trusted Computing Base *)

(** One issue that arises with any automated proof assistant is "why
    trust it?": what if there is a bug in the implementation that
    renders all its reasoning suspect?

    While it is impossible to allay such concerns completely, the fact
    that Coq is based on the Curry-Howard correspondence gives it a
    strong foundation. Because propositions are just types and proofs
    are just terms, checking that an alleged proof of a proposition is
    valid just amounts to _type-checking_ the term.  Type checkers are
    relatively small and straightforward programs, so the "trusted
    computing base" for Coq -- the part of the code that we have to
    believe is operating correctly -- is small too.

    What must a typechecker do?  Its primary job is to make sure that
    in each function application the expected and actual argument
    types match, that the arms of a [match] expression are constructor
    patterns belonging to the inductive type being matched over and
    all arms of the [match] return the same type, and so on.

    There are a few additional wrinkles:

    - Since Coq types can themselves be expressions, the checker must
      normalize these (by using the computation rules) before
      comparing them.

    - The checker must make sure that [match] expressions are
      _exhaustive_.  That is, there must be an arm for every possible
      constructor.  To see why, consider the following alleged proof
      object:
      Definition or_bogus : forall P Q, P \/ Q -> P :=
        fun (P Q : Prop) (A : P \/ Q) =>
           match A with
           | or_introl H => H
           end.
      All the types here match correctly, but the [match] only
      considers one of the possible constructors for [or].  Coq's
      exhaustiveness check will reject this definition.

    - The checker must make sure that each [fix] expression
      terminates.  It does this using a syntactic check to make sure
      that each recursive call is on a subexpression of the original
      argument.  To see why this is essential, consider this alleged
      proof:
          Definition nat_false : forall (n:nat), False :=
             fix f (n:nat) : False := f n.
      Again, this is perfectly well-typed, but (fortunately) Coq will
      reject it. *)

(** Note that the soundness of Coq depends only on the correctness of
    this typechecking engine, not on the tactic machinery.  If there
    is a bug in a tactic implementation (and this certainly does
    happen!), that tactic might construct an invalid proof term.  But
    when you type [Qed], Coq checks the term for validity from
    scratch.  Only lemmas whose proofs pass the type-checker can be
    used in further proof developments.  *)

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