(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)

(*i $Id: Rsigma.v 14641 2011-11-06 11:59:10Z herbelin $ i*)

Require Import Rbase.
Require Import Rfunctions.
Require Import Rseries.
Require Import PartSum.
Open Local Scope R_scope.

Set Implicit Arguments.

Section Sigma.

  Variable f : nat -> R.

  Definition sigma (low high:nat) : R :=
    sum_f_R0 (fun k:nat => f (low + k)) (high - low).

  Theorem sigma_split :
    forall low high k:nat,
      (low <= k)%nat ->
      (k < high)%nat -> sigma low high = sigma low k + sigma (S k) high.
  Proof.
    intros; induction  k as [| k Hreck].
    cut (low = 0%nat).
    intro; rewrite H1; unfold sigma in |- *; rewrite <- minus_n_n;
      rewrite <- minus_n_O; simpl in |- *; replace (high - 1)%nat with (pred high).
    apply (decomp_sum (fun k:nat => f k)).
    assumption.
    apply pred_of_minus.
    inversion H; reflexivity.
    cut ((low <= k)%nat \/ low = S k).
    intro; elim H1; intro.
    replace (sigma low (S k)) with (sigma low k + f (S k)).
    rewrite Rplus_assoc;
      replace (f (S k) + sigma (S (S k)) high) with (sigma (S k) high).
    apply Hreck.
    assumption.
    apply lt_trans with (S k); [ apply lt_n_Sn | assumption ].
    unfold sigma in |- *; replace (high - S (S k))%nat with (pred (high - S k)).
    pattern (S k) at 3 in |- *; replace (S k) with (S k + 0)%nat;
      [ idtac | ring ].
    replace (sum_f_R0 (fun k0:nat => f (S (S k) + k0)) (pred (high - S k))) with
    (sum_f_R0 (fun k0:nat => f (S k + S k0)) (pred (high - S k))).
    apply (decomp_sum (fun i:nat => f (S k + i))).
    apply lt_minus_O_lt; assumption.
    apply sum_eq; intros; replace (S k + S i)%nat with (S (S k) + i)%nat.
    reflexivity.
    ring.
    replace (high - S (S k))%nat with (high - S k - 1)%nat.
    apply pred_of_minus.
    omega.
    unfold sigma in |- *; replace (S k - low)%nat with (S (k - low)).
    pattern (S k) at 1 in |- *; replace (S k) with (low + S (k - low))%nat.
    symmetry  in |- *; apply (tech5 (fun i:nat => f (low + i))).
    omega.
    omega.
    rewrite <- H2; unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *;
      replace (high - S low)%nat with (pred (high - low)).
    replace (sum_f_R0 (fun k0:nat => f (S (low + k0))) (pred (high - low))) with
    (sum_f_R0 (fun k0:nat => f (low + S k0)) (pred (high - low))).
    apply (decomp_sum (fun k0:nat => f (low + k0))).
    apply lt_minus_O_lt.
    apply le_lt_trans with (S k); [ rewrite H2; apply le_n | assumption ].
    apply sum_eq; intros; replace (S (low + i)) with (low + S i)%nat.
    reflexivity.
    ring.
    omega.
    inversion H; [ right; reflexivity | left; assumption ].
  Qed.

  Theorem sigma_diff :
    forall low high k:nat,
      (low <= k)%nat ->
      (k < high)%nat -> sigma low high - sigma low k = sigma (S k) high.
  Proof.
    intros low high k H1 H2; symmetry  in |- *; rewrite (sigma_split H1 H2); ring.
  Qed.

  Theorem sigma_diff_neg :
    forall low high k:nat,
      (low <= k)%nat ->
      (k < high)%nat -> sigma low k - sigma low high = - sigma (S k) high.
  Proof.
    intros low high k H1 H2; rewrite (sigma_split H1 H2); ring.
  Qed.

  Theorem sigma_first :
    forall low high:nat,
      (low < high)%nat -> sigma low high = f low + sigma (S low) high.
  Proof.
    intros low high H1; generalize (lt_le_S low high H1); intro H2;
      generalize (lt_le_weak low high H1); intro H3;
        replace (f low) with (sigma low low).
    apply sigma_split.
    apply le_n.
    assumption.
    unfold sigma in |- *; rewrite <- minus_n_n.
    simpl in |- *.
    replace (low + 0)%nat with low; [ reflexivity | ring ].
  Qed.

  Theorem sigma_last :
    forall low high:nat,
      (low < high)%nat -> sigma low high = f high + sigma low (pred high).
  Proof.
    intros low high H1; generalize (lt_le_S low high H1); intro H2;
      generalize (lt_le_weak low high H1); intro H3;
        replace (f high) with (sigma high high).
    rewrite Rplus_comm; cut (high = S (pred high)).
    intro; pattern high at 3 in |- *; rewrite H.
    apply sigma_split.
    apply le_S_n; rewrite <- H; apply lt_le_S; assumption.
    apply lt_pred_n_n; apply le_lt_trans with low; [ apply le_O_n | assumption ].
    apply S_pred with 0%nat; apply le_lt_trans with low;
      [ apply le_O_n | assumption ].
    unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *;
      replace (high + 0)%nat with high; [ reflexivity | ring ].
  Qed.

  Theorem sigma_eq_arg : forall low:nat, sigma low low = f low.
  Proof.
    intro; unfold sigma in |- *; rewrite <- minus_n_n.
    simpl in |- *; replace (low + 0)%nat with low; [ reflexivity | ring ].
  Qed.

End Sigma.


Add LoadPath "C:/Coq/buffer".
Require Export Poly.

Theorem silly1 : forall (n m o p : nat),
  n = m -> [n;o] = [n;p] -> [n;o] = [m;p].
Proof. intros n m o p eq1 eq2. rewrite <- eq1. apply eq2. Qed.

Theorem silly2 : forall (n m o p : nat),
  n = m -> (forall (q r : nat), q = r -> [q;o] = [r;p]) -> [n;o] = [m;p].
Proof. intros n m o p eq1 eq2. apply eq2. apply eq1. Qed.

Theorem silly2a : forall (n m : nat),
  (n,n) = (m,m) ->
  (forall (q r : nat), (q,q) = (r,r) -> [q] = [r]) -> [n] = [m].
Proof. intros n m eq1 eq2. apply eq2. apply eq1. Qed.

(* using apply before introducing hypotheses may simplify proof *)
Theorem silly_ex :
  (forall n, evenb n = true -> oddb (S n) = true) ->
  evenb 3 = true ->
  oddb 4 = true.
Proof. intros eq1. apply eq1. Qed.

(* use symmetry tatic to swap equality, need to sometimes with apply *)
Theorem silly3_firsttty :
    forall (n : nat), true = beq_nat n 5 ->
    beq_nat (S (S n)) 7 = true.
Proof.
  intros n H. simpl. symmetry. apply H. Qed.

Theorem rev_excercise1 : forall (l l' : list nat),
    l = rev l' ->
    l' = rev l.
Proof. intros l l' H. symmetry. rewrite -> H. apply rev_involutive. Qed.

Theorem trans_eq : forall (X:Type) (n m o : X),
  n = m -> m = o -> n = o.
Proof.
  intros X n m o eq1 eq2. rewrite -> eq1. rewrite -> eq2.
  reflexivity. Qed.

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.
  intros a b c d e f eq1 eq2.
  apply trans_eq with (m := [c;d]).
  apply eq1. apply eq2. Qed.

Example trans_eq_excercise : forall (n m o p : nat),
  m = (minustwo o) ->
  (n + p) = m ->
  (n + p) = (minustwo o).
Proof. intros n m o p eq1 eq2. apply trans_eq with m. apply eq2. apply eq1. Qed.

Theorem S_injective : forall (n m : nat),
  S n = S m ->
  n = m.
Proof.
  intros n m H. inversion H. reflexivity. Qed.

Theorem inversion_ex1 : forall (n m o : nat),
  [n ; m] = [o ; o] ->
  [n] = [m].
Proof.
  intros n m o H. inversion H. reflexivity. Qed.

Theorem inversion_ex2 : forall (n m : nat),
  [n] = [m] ->
  n = m.
Proof.
  intros n m H. inversion H as [Hnm]. reflexivity. Qed.

Theorem inversion_ex3 : forall (X : Type) (x y z : X) (l j : list X),
  x :: y :: l = z :: j ->
  y :: l = x :: j ->
  x = y.
Proof.
  intros X x y z l j H1 H2. inversion H2. reflexivity. Qed.

Theorem beq_nat_O_1 : forall n,
  beq_nat 0 n = true -> n = 0.
Proof.
  intros n. destruct n as [| n']. intros H. reflexivity. simpl. intros H. inversion H. Qed.

(* principle of explosion *)
Theorem inversion_ex6 : forall (X : Type) (x y z : X) (l j : list X),
  x :: y :: l = [] ->
  y :: l = z :: j ->
  x = z.
Proof. intros X x y z l j H1 H2. inversion H1. Qed.

Theorem f_equal : forall (A B : Type) (f:A->B) (x y : A),
  x = y -> f x = f y.
Proof. intros A B f x y H. rewrite -> H. reflexivity. Qed.

(* can use many tatics in the context instead of the goal
  Usually by adding 'in <hypothesis_name>' after the tatic*)
Theorem S_inj : forall (n m : nat) (b : bool),
  beq_nat (S n) (S m) = b ->
  beq_nat n m = b.
Proof. intros n m b H. simpl in H. apply H. Qed.

(* apply and apply in are backwards and forwards reasoning resp
  apply is modus ponens and apply in is like modus ponens but on hypotheses*)

Theorem silly3' : forall (n : nat),
  (beq_nat n 5 = true -> beq_nat (S (S n)) 7 = true) ->
  true = beq_nat n 5 ->
  true = beq_nat (S (S n)) 7.
Proof. intros n eq H. symmetry in H. apply eq in H. symmetry in H. apply H. Qed.

Theorem plus_n_n_injective : forall n m,
  n + n = m + m -> n = m.
Proof. intros n. induction n as [| n'].
    - intros [| m']. reflexivity. inversion 1.
    - intros [| m']. inversion 1.
      + intros H. apply f_equal. apply IHn'.
        rewrite <- plus_n_Sm in H. simpl in H.
        rewrite <- plus_n_Sm in H.
        inversion H. reflexivity.
Qed.

Theorem double_injective: forall n m,
  double n = double m -> n = m.
Proof. intros n. induction n as [| n'].
  - simpl. intros m eq. destruct m as [| m'].
    +reflexivity.
    +inversion eq.
  - simpl. intros m eq. destruct m as [| m'].
    +simpl. inversion eq.
    +apply f_equal. apply IHn'. inversion eq. reflexivity.
Qed.

Theorem beq_nat_true : forall n m,
  beq_nat n m = true -> n = m.
Proof. intros n. induction n as [| n' Hn'].
    - intros [| m'].
      +reflexivity.
      +inversion 1.
    - intros [| m'].
      +inversion 1.
      +intros H. simpl in H. apply Hn' in H.
       rewrite -> H. reflexivity.
Qed.

Theorem double_injective' : forall n m,
  double n = double m -> n = m.
Proof. intros n m. induction m as [| m'].
  - simpl. intros eq. destruct n as [| n'].
    +reflexivity.
    +inversion eq.
  -intros eq. destruct n as [| n'].
    +inversion eq.
    +apply f_equal. simpl in eq. Abort.
(*
  The above fails because n must be introduced before m
  so we cannot preform case analysis on n.
  The induction hypothesis is not general enough

  Solution to this problem is to use the
  generalize dependent tactic
*)

Theorem double_injective_take2 : forall n m,
  double n = double m -> n = m.
Proof.
  intros n m. (* n and m in context *)
  generalize dependent n.
  induction m as [| m' Hm'].
    - intros [| n']. reflexivity. inversion 1.
    - intros [| n']. inversion 1.
      + intros H. apply f_equal. apply Hm'.
        inversion H. reflexivity.
Qed.

Theorem beq_id_true : forall x y,
  beq_id x y = true -> x = y.
Proof. intros [n] [m]. simpl. intros H.
       assert (H' : n = m). { apply beq_nat_true. apply H. }
       rewrite H'. reflexivity.
Qed.

Theorem nth_error_after_last :
  forall (n : nat) (X : Type) (l : list X),
    length l = n ->
    nth_error l n = None.
Proof. intros n X l. generalize dependent n.
       induction l as [| h t Ht].
       -simpl. reflexivity.
       -intros [| n'].
        +inversion 1.
        +simpl. intros H. apply Ht.
         inversion H. reflexivity.
Qed.

Definition square n := n * n.

Lemma square_mult : forall n m,
  square (n*m) = square n * square m.
Proof. intros n m. unfold square. rewrite mult_assoc.
       assert (H : n * m * n = n * n * m).
      { rewrite mult_comm. apply mult_assoc. }
      rewrite H. rewrite mult_assoc. reflexivity.
Qed.

(* using unfold *)
Definition bar x :=
  match x with
  | 0 => 5
  | S _ => 5
  end.
(* cannot progress without using destruct
   but may not know that match is the problem*)
Fact silly_fact_FAILED : forall m,
  bar m + 1 = bar (m + 1) + 1.
Proof. intros m. simpl. (* does nothing *)
Abort.
(* using unfold allows to see that we are getting
   stuck at a match statement *)
Fact silly_fact : forall m,
  bar m + 1 = bar (m + 1) + 1.
Proof. intros m. unfold bar. destruct m; reflexivity.
Qed.

Definition sillyfun (n : nat) : bool :=
  if beq_nat n 3 then false
  else if beq_nat n 5 then false
  else false.

Theorem sillyfun_false : forall (n : nat),
  sillyfun n = false.
Proof.
  intros n. unfold sillyfun.
  destruct (beq_nat n 3).
    - (* beq_nat n 3 = true *) reflexivity.
    - (* beq_nat n 3 = false *) destruct (beq_nat n 5).
      + (* beq_nat n 5 = true *) reflexivity.
      + (* beq_nat n 5 = false *) reflexivity.
Qed.

Theorem combine_split : forall X Y (l : list (X * Y)) l1 l2,
  split l = (l1, l2) ->
  combine l1 l2 = l.
Proof. intros X Y. intros l. induction l as [| hl tl Htl].
       -intros. inversion H. reflexivity.
       -intros [| hl1 tl1] [| hl2 tl2]; intros; inversion H.
        Abort.

(* what goes wrong here? *)
Theorem bool_fn_applied_thrice_FAIL :
  forall (f : bool -> bool) (b : bool),
  f (f (f b)) = f b.
Proof.
  intros f b. destruct (f b) eqn:H.
  - destruct (f true) eqn:Hf.
    + apply Hf.
    + destruct (f false) eqn:Hff.
      ++ reflexivity.
      ++ (* false = true OH NO! *) Abort.

Theorem bool_fn_applied_thrice :
  forall (f : bool -> bool) (b : bool),
  f (f (f b)) = f b.
Proof. intros f b. destruct b.
      - destruct (f true) eqn:Hf.
        { rewrite -> Hf. apply Hf. }
        { destruct (f false) eqn:Hff.
           + apply Hf.
           + apply Hff. }
      - destruct (f false) eqn:Hf.
        { destruct (f true) eqn:Hff.
           + apply Hff.
           + apply Hf. }
        { rewrite -> Hf.  apply Hf. }
Qed.

Theorem beq_nat_sym : forall (n m : nat),
  beq_nat n m = beq_nat n m.
Proof. intros. destruct (beq_nat n m); reflexivity.
Qed.

Theorem beq_nat_trans : forall n m p,
  beq_nat n m = true ->
  beq_nat m p = true ->
  beq_nat n p = true.

Proof. intros n m p Hn Hp.
      assert (beq_nat n m = true -> n = m) as Enm.
      { apply beq_nat_true. }
      assert (beq_nat m p = true -> m = p) as Emp.
      { apply beq_nat_true. }
      apply Enm in Hn. apply Emp in Hp.
      rewrite Hn. rewrite Hp. rewrite <- beq_nat_refl. reflexivity.
Qed.

Theorem filter_excercise : forall (X : Type) (test : X -> bool)
  (x : X) (l lf : list X), filter test l = x :: lf -> test x = true.
Proof. intros X test x l lf. induction l as [| h t Ht].
        - inversion 1.
        - intros H. unfold filter in H. destruct (test h) eqn:Htest.
          + inversion H. rewrite <- H1. apply Htest.
          + apply Ht in H. apply H.
Qed.

Fixpoint forallb {X : Type} (test : X -> bool) (l : list X) : bool :=
  match l with
  | nil => true
  | h :: t => andb (test h) (forallb test t)
  end.

Compute forallb evenb [12;1;4;8].
Compute forallb negb [false; false; false].
Compute forallb oddb [1;3;5;7;9].
Compute forallb negb [false;false].
Compute forallb evenb [0;2;4;5].
Compute forallb (beq_nat 5) [].
(* could define this with orb but this way is faster *)
Fixpoint existsb {X : Type} (test : X -> bool) (l : list X) :=
  match l with
  | nil => false
  | h :: t =>
    match (test h) with
    | true => true
    | false => existsb test t
  end.

Compute existsb (beq_nat 5) [0;2;3;6].
Compute existsb (andb true) [true;true;false].
Compute existsb oddb [1;0;0;0;0;3].
Compute existsb evenb [].

Definition existsb' {X : Type} (test : X -> bool) (l : list X) :=
  negb (forallb (fun n => negb (test n)) l).

Theorem existsb_existsb' :
  forall (X : Type) (test : X -> bool) (l : list X),
  existsb test l = existsb' test l.
Proof. intros X test l. induction l as [| h t Ht].
      - reflexivity.
      - simpl. destruct (test h) eqn:Htest; unfold existsb'; simpl; rewrite -> Htest; simpl.
        + reflexivity.
        + rewrite -> Ht. reflexivity.
Qed.


Add LoadPath "somePath".

Require Export propVar_relation.

(*----------rel cons----------*)
Definition consistent_environment (theta : environment)(R:propVar_relation) :=
  forall x y: propVar, (R x y) -> (theta x -> theta y).

Lemma environment_union_consistent : forall R:propVar_relation, forall th1 th2:environment,
consistent_environment th1 R -> consistent_environment th2 R -> consistent_environment (environment_union th1 th2) R.
Proof.
intros.
intro;intros.
apply orb_true_iff in H2.
destruct H2.
apply orb_true_iff.
left.
apply (H x);auto.
apply orb_true_iff.
right.
apply (H0 x);auto.
Qed.

Lemma full_environment_consistent : forall R:propVar_relation, consistent_environment full_environment R.
Proof.
intros;intro;intros.
unfold full_environment;auto.
Qed.

Lemma empty_environment_consistent : forall R:propVar_relation, consistent_environment empty_environment R.
Proof.
intros;intro;intros.
inversion H0.
Qed.

Definition rel_cons (R:propVar_relation)(f g:propForm):=
forall theta:environment, consistent_environment theta R -> [[f]]theta -> [[g]]theta.

Lemma consistent_environment_rel_union : forall theta:environment, forall R1 R2:propVar_relation,
consistent_environment theta (R1 U R2)
->
(consistent_environment theta R1 /\ consistent_environment theta R2).
Proof.
intros.
unfold consistent_environment in *.
split.
intros.
apply (H x y).
left;auto.
assumption.
intros.
apply (H x y).
right;auto.
assumption.
Qed.

Lemma rel_union_consistent_environment : forall theta:environment, forall R1 R2:propVar_relation,
(consistent_environment theta R1 /\ consistent_environment theta R2)
->
consistent_environment theta (R1 U R2).
Proof.
intros.
unfold consistent_environment.
destruct H.
intros.
destruct H1.
exact (H x y H1 H2).
exact (H0 x y H1 H2).
Qed.


From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat seq.

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

(* Generalizable All Variables. *)
Require Import Aw_0_Notations.
Require Import Aw_1_3_Categories.
Require Import Aw_1_5_Isomorphisms.

(******************************************************************************)
(* Chapter 2.1: Epic and Monic morphisms                                      *)
(******************************************************************************)

(* Definition 2.1a *)
Class Monic `{C : Category} {a b : C} (f : a ~> b) : Prop :=
  monic : forall c (g1 g2 : c ~> a), f \\o g1 === f \\o g2 -> g1 === g2.
(* Implicit Arguments monic [ C a b Ob Hom ]. *)

(* Definition 2.1b *)
Class Epic `{C : Category} {a b : C} (f : a ~> b) : Prop :=
  epic : forall c (g1 g2 : b~>c), g1 \\o f === g2 \\o f -> g1 === g2.
(* Implicit Arguments epic [ C a b Ob Hom ]. *)

(* Proposition 2.6 *)
(* すべての同型は、エピepiである。 *)
Instance iso_epic `(i : Isomorphic) : Epic #i.
Proof.
  Check #i : a ~> b.
  Check iso_forward i : a ~> b.

  rewrite /Epic => c g1 g2 H.
  rewrite -[g1]right_identity -[g2]right_identity.
  rewrite -iso_comp2 -2!associativity.
  rewrite H.
  reflexivity.
Qed.

(* Proposition 2.6 *)
(* すべての同型は、モノmonicである。 *)
Instance iso_monic `(i : Isomorphic) : Monic #i.
Proof.
  rewrite /Monic => c g1 g2 H.
  rewrite -[g1]left_identity -[g2]left_identity.
  rewrite -iso_comp1 2!associativity.
  rewrite H.
  reflexivity.
Qed.

(* a BiMorphism is an epic monic *)
Class BiMorphism `{C : Category} {a b : C} (f : a ~> b) : Prop :=
  {
    bimorphism_epic  :> Epic  f;
    bimorphism_monic :> Monic f
  }.
Coercion bimorphism_epic  : BiMorphism >-> Epic.
Coercion bimorphism_monic : BiMorphism >-> Monic.

Class EndoMorphism `{C : Category} (A : C) :=
  endo : A ~> A.

Class AutoMorphism `{C : Category} (A : C) : Type :=
  {
    auto_endo1 : EndoMorphism A;
    auto_endo2 : EndoMorphism A;
    auto_iso   : Isomorphism  (@endo _ _ _ _ auto_endo1) (@endo _ _ _ _ auto_endo2);
  }.

(*Class Balanced `{C:Category} : Prop :=
  balanced : forall (a b:C)(f:a~>b), BiMorphism f -> Isomorphism f.*)


Require Export PropL.

(* ((Existential Quantification)) *)

(* Exercise: 1 star, optional (english_exists) *)

(* ex nat (fun n => beautiful (S n)) means:
There exists such natural number n that the following number has property
"beautiful" *)

(* END english_exists. *)

(* Exercise: 1 star (dist_not_exists) *)

Theorem dist_not_exists : forall (X : Type) (P : X -> Prop),
  (forall x, P x) -> not (exists x, not (P x)).
Proof.
  unfold not.
  intros X P H1 H2.
  inversion H2.
  apply H.
  apply H1.
Qed.

(* END dist_not_exists. *)

(* Exercise: 3 stars, optional (not_exists_dist) *)

Theorem not_exists_dist : excluded_middle -> forall (X : Type) (P : X -> Prop),
  not (exists x, not (P x)) -> (forall x, P x).
Proof.
  unfold not.
  intros EM X P H x.
  apply excluded_middle_implies_classic in EM.
  unfold classic in EM.
  unfold not in EM.
  apply EM.
  intros pxf.
  apply H.
  exists x.
  apply pxf.
Qed.

(* END not_exists_dist. *)

(* Exercise: 2 stars (dist_exists_or) *)

Theorem dist_exists_or : forall (X : Type) (P Q : X -> Prop),
  (exists x, P x \/ Q x) <-> (exists x, P x) \/ (exists x, Q x).
Proof.
  intros X P Q.
  split.
  Case "a -> b".
    intros H.
    inversion H.
    inversion H0.
    left.
    exists x.
    apply H1.
    right.
    exists x.
    apply H1.
  Case "a <- b".
    intros H.
    inversion H.
    inversion H0.
    exists x.
    left.
    apply H1.
    inversion H0.
    exists x.
    right.
    apply H1.
Qed.

(* END dist_exists_or. *)

(* ((Evidence-Carrying Booleans)) *)

Theorem eq_nat_dec : forall n m : nat, { n = m } + { n <> m }.
Proof.
  induction n.
  Case "n = 0".
    destruct m.
    SCase "m = 0".
      left.
      trivial.
    SCase "m = S m".
      right.
      intros H.
      inversion H.
  Case "n = S n".
    induction m.
    SCase "m = 0".
      right.
      intros H.
      inversion H.
    SCase "m = S m".
      destruct IHn with (m := m).
      left. apply f_equal. apply e.
      right. intros H. apply n0. inversion H. trivial.
Defined.

Definition override' {X : Type} (f : nat -> X) (k : nat) (x : X) : nat -> X :=
  fun (k' : nat) => if eq_nat_dec k k' then x else f k'.

(* Exercise: 1 star (override_shadow') *)

Theorem override_shadow' : forall (X : Type) x1 x2 k1 k2 (f : nat -> X),
  (override' (override' f k1 x2) k1 x1) k2 = (override' f k1 x1) k2.
Proof.
  intros X x1 x2 k1 k2 f.
  unfold override'.
  destruct (eq_nat_dec k1 k2).
  trivial.
  trivial.
Qed.

(* ((Additional Exercises)) *)

(* Exercise: 3 stars (all_forallb) *)

Inductive all {X : Type} (P : X -> Prop) : list X -> Prop :=
  | all_nil  : all P nil
  | all_cons : forall x l, P x -> all P l -> all P (cons x l).

Theorem forallb_true_all: forall (X : Type) (test : X -> bool) (l : list X),
  all (fun x => test x = true) l -> forallb test l = true.
Proof.
  intros X test l.
  induction l.
    reflexivity.
    intros H.
    simpl.
    inversion H.
    rewrite -> H2.
    simpl.
    apply IHl.
    apply H3.
Qed.

Theorem forallb_false_not_all :
  forall (X : Type) (test : X -> bool) (l : list X),
  not (all (fun x => test x = true) l) -> forallb test l = false.
Proof.
  intros X test l.
  unfold not.
  induction l.
  Case "l = nil".
    intros H.
    apply ex_falso_quodlibet.
    apply H.
    apply all_nil.
  Case "l = a :: l".
    intros H.
    simpl.
    destruct (test a) eqn: Q.
    SCase "test a = true".
      simpl.
      apply IHl.
      intros H'.
      apply H.
      apply all_cons.
      apply Q.
      apply H'.
    SCase "test a = false".
      reflexivity.
Qed.

(* END all_forallb. *)

(* Exercise: 4 stars, advanced (filter_challenge) *)

Inductive merged {X : Type} : list X -> list X -> list X -> Prop :=
  | merged_nil   : merged nil nil nil
  | merged_left  : forall x l1 l2 l3,
                     merged l1 l2 l3 -> merged (x :: l1) l2 (x :: l3)
  | merged_right : forall x l1 l2 l3,
                     merged l1 l2 l3 -> merged l1 (x :: l2) (x :: l3).

Theorem filter_spec : forall (X : Type) (f : X -> bool) (l l1 l2 : list X),
  (all (fun b => f b = true)  l1) ->
  (all (fun b => f b = false) l2) ->
  merged l1 l2 l ->
  filter f l = l1.
Proof.
  intros X f l.
  induction l.
  Case "l = nil".
    intros l1 l2 H1 H2 H3.
    inversion H3.
    reflexivity.
  Case "l = a :: l".
    simpl.
    intros l1 l2 H1 H2 H3.
    inversion H3.
    SCase "merged_left".
      inversion H1.
      SSCase "l1 = nil".
        rewrite <- H7 in H0.
        inversion H0.
      SSCase "x0 :: l5 = l1".
        rewrite <- H9 in H0.
        inversion H0.
        rewrite <- H11 in H7.
        rewrite -> H in H7.
        rewrite -> H7.
        replace (filter f l) with l5.
        trivial.
        symmetry.
        apply IHl with (l2 := l2).
        apply H8.
        apply H2.
        rewrite <- H12.
        apply H5.
    SCase "merged_right".
      inversion H2.
      SSCase "l2 = nil".
        rewrite <- H7 in H4.
        inversion H4.
      SSCase "x0 :: l5 = l2".
        rewrite <- H9 in H4.
        inversion H4.
        rewrite <- H11 in H7.
        rewrite -> H in H7.
        rewrite -> H7.
        apply IHl with (l2 := l3).
        apply H1.
        rewrite <- H12 in H8.
        apply H8.
        apply H5.
Qed.

(* END filter_challenge. *)

(* Exercise: 5 stars, advanced, optional (filter_challenge_2) *)

Theorem filter_empty : forall (X : Type) (test : X -> bool) (l : list X),
  filter test l = nil -> all (fun x => test x = false) l.
Proof.
  intros X test l.
  induction l.
  Case "l = nil".
    intros H.
    apply all_nil.
  Case "l = a :: l".
    intros H.
    simpl in H.
    destruct (test a) eqn: TA.
    SCase "test a = true".
      inversion H.
    SCase "test a = false".
      apply all_cons.
      apply TA.
      apply IHl.
      apply H.
Qed.

Theorem subseq_all : forall (X : Type) (P : X -> Prop) (l1 l2 : list X),
  all P l1 -> subseq l2 l1 -> all P l2.
Proof.
  intros X P l1.
  induction l1.
  Case "l1 = nil".
    intros.
    inversion H0.
    apply all_nil.
  Case "l1 = a :: l1".
    intros.
    inversion H.
    inversion H0.
    apply all_nil.
    generalize dependent H7.
    generalize dependent H4.
    apply IHl1.
    apply all_cons.
    apply H3.
    generalize dependent H7.
    generalize dependent H4.
    apply IHl1.
Qed.

Theorem filter_subseq :
  forall (X : Type) (test : X -> bool) l,
  subseq (filter test l) l.
Proof.
  intros X test.
  induction l.
  Case "l = nil".
    simpl.
    apply subseq_nil.
  Case "l = a :: l".
    simpl.
    destruct (test a).
    SCase "test a = true".
      apply subseq_cons'.
      apply IHl.
    SCase "test a = false".
      apply subseq_cons.
      apply IHl.
Qed.

Theorem all_cons_inv : forall (X : Type) (P : X -> Prop) (x : X) (l : list X),
  all P (x :: l) -> all P l.
Proof.
  intros X P x l H.
  inversion H.
  apply H3.
Qed.

Theorem filter_spec_2_helper :
  forall (X : Type) (test : X -> bool) (n : nat) (l ls : list X),
  length l <= n ->
  subseq ls l -> (all (fun x => test x = true) ls) ->
  length ls <= length (filter test l).
Proof.
  intros X test n.
  induction n.
  Case "n = 0".
    intros l ls Hn Hs.
    inversion Hn.
    apply length_nil_zero in H0.
    rewrite -> H0 in Hs.
    inversion Hs.
    simpl.
    intros.
    apply O_le_n.
  Case "n = S n".
    destruct l.
    SCase "l = nil".
      intros ls Hn Hs.
      inversion Hs.
      simpl.
      intros.
      apply O_le_n.
    SCase "l = a :: l".
      intros ls Hn.
      generalize dependent ls.
      simpl in Hn.
      apply Sn_le_Sm__n_le_m in Hn.
      simpl.
      destruct (test x) eqn : Htx.
      SSCase "test x = true".
        destruct ls.
        SSSCase "ls = nil".
          simpl.
          intros.
          apply O_le_n.
        SSSCase "ls = x0 :: ls".
          intros Hs Ht.
          simpl.
          apply n_le_m__Sn_le_Sm.
          apply all_cons_inv in Ht.
          inversion Hs.
          SSSSCase "cons".
            assert (subseq ls l).
            apply subseq_cons_inv in H1.
            apply H1.
            apply IHn.
            apply Hn.
            apply H3.
            apply Ht.
          SSSSCase "cons'".
            apply IHn.
            apply Hn.
            apply H0.
            apply Ht.
      SSCase "test x = false".
        intros ls Hs Ht.
        inversion Hs.
        SSSCase "ls = nil".
          simpl. apply O_le_n.
        SSSCase "cons".
          apply IHn.
          apply Hn.
          apply H1.
          apply Ht.
        SSSCase "cons'".
          rewrite <- H0 in Ht.
          inversion Ht.
          rewrite -> H in H5.
          rewrite -> H5 in Htx.
          inversion Htx.
Qed.

Theorem filter_spec_2 :
  forall (X : Type) (test : X -> bool) (l ls : list X),
  subseq ls l ->
  (all (fun x => test x = true) ls) ->
  length ls <= length (filter test l).
Proof.
  intros.
  apply filter_spec_2_helper with (n := length l).
  apply le_n.
  apply H.
  apply H0.
Qed.

(* END filter_challenge_2. *)

(* Exercise: 4 stars, advanced (no_repeats) *)

Inductive appears_in {X : Type} (a : X) : list X -> Prop :=
  | ai_here  : forall l,   appears_in a (a :: l)
  | ai_later : forall b l, appears_in a l -> appears_in a (b :: l).

Lemma appears_in_app : forall (X : Type) (xs ys : list X) (x : X),
  appears_in x (xs ++ ys) -> appears_in x xs \/ appears_in x ys.
Proof.
  intros X xs.
  induction xs.
  Case "xs = nil".
    intros ys x H.
    simpl in H.
    right.
    apply H.
  Case "xs = a :: xs".
    intros ys x H.
    simpl in H.
    inversion H.
    left.
    apply ai_here.
    apply IHxs in H1.
    inversion H1.
    left.
    apply ai_later.
    apply H3.
    right.
    apply H3.
Qed.

Lemma app_appears_in : forall (X : Type) (xs ys : list X) (x : X),
  appears_in x xs \/ appears_in x ys -> appears_in x (xs ++ ys).
Proof.
  intros X xs.
  induction xs.
  Case "xs = nil".
    intros ys x H.
    inversion H.
    inversion H0.
    simpl. apply H0.
  Case "xs = a :: xs".
    intros ys x H.
    inversion H.
    inversion H0.
    apply ai_here.
    simpl.
    apply ai_later.
    apply IHxs.
    left.
    apply H2.
    simpl.
    apply ai_later.
    apply IHxs.
    right.
    apply H0.
Qed.

Inductive disjoint {X : Type} : list X -> list X -> Prop :=
  | dis_nil  : forall l, disjoint nil l
  | dis_cons : forall x l1 l2, disjoint l1 l2 -> not (appears_in x l2) ->
                disjoint (x :: l1) l2.

Inductive no_repeats {X : Type} : list X -> Prop :=
  | nr_nil  : no_repeats nil
  | nr_cons : forall x l, no_repeats l -> not (appears_in x l) ->
                no_repeats (x :: l).

Theorem disjoint_app_no_repeats : forall (X : Type) (l1 l2 : list X),
  disjoint l1 l2 -> no_repeats l1 -> no_repeats l2 -> no_repeats (l1 ++ l2).
Proof.
  induction l1.
  Case "l1 = nil".
    intros. simpl. apply H1.
  Case "l1 = a :: l1".
    intros. simpl.
    inversion H0.
    inversion H.
    apply nr_cons.
    apply IHl1.
    apply H8.
    apply H4.
    apply H1.
    unfold not.
    intros.
    apply appears_in_app in H11.
    inversion H11.
    unfold not in H5.
    apply H5.
    apply H12.
    unfold not in H10.
    apply H10.
    apply H12.
Qed.

(* END no_repeats. *)

(* Exercise: 3 stars (nostutter) *)

Inductive nostutter {X : Type} : list X -> Prop :=
  | nost_nil  : nostutter nil
  | nost_one  : forall a, nostutter (a :: nil)%list
  | nost_cons : forall a b l, not (a = b) -> nostutter (b :: l)%list ->
                  nostutter (a :: b :: l)%list.

Example test_nostutter1 : nostutter (3 :: 1 :: 4 :: 1 :: 5 :: 6 :: nil)%list.
Proof. repeat constructor; auto. Qed.

Example test_nostutter2 : forall (X : Type), nostutter (@nil X).
Proof. repeat constructor; auto. Qed.

Example test_nostutter3 : nostutter (5 :: nil)%list.
Proof. repeat constructor; auto. Qed.

Example test_nostutter4 : not (nostutter (3 :: 1 :: 1 :: 4 :: nil)%list).
Proof.
  intro.
  repeat match goal with
    h : nostutter _ |- _ => inversion h; clear h; subst end.
  contradiction H1; trivial.
Qed.

(* END nostutter. *)

(* Exercise: 4 stars, advanced (pigeonhole principle) *)

Lemma appears_in_app_split : forall (X : Type) (x : X) (l : list X),
  appears_in x l -> exists l1, exists l2, (l = l1 ++ (x :: l2))%list.
Proof.
  intros X x l H.
  induction l.
  Case "l = nil".
    inversion H.
  Case "l = a :: l".
    inversion H.
    SCase "a = x".
      exists nil.
      exists l.
      reflexivity.
    SCase "appears_in x l".
      apply IHl in H1.
      destruct H1.
      destruct H1.
      exists (a :: x0)%list.
      exists x1.
      rewrite -> H1.
      reflexivity.
Qed.

Inductive repeats {X : Type} : list X -> Prop :=
  | rep_n    : forall x l, appears_in x l -> repeats (x :: l)
  | rep_cons : forall x l, repeats l -> repeats (x :: l).

Theorem pure_functions : forall (X Y : Type) (f : X -> Y) (x1 x2 : X),
  x1 = x2 -> f x1 = f x2.
Proof.
  intros X Y f x1 x2 H.
  rewrite -> H.
  trivial.
Qed.

Theorem appears_app_comm : forall (X : Type) (x : X) (l1 l2 : list X),
  appears_in x (l1 ++ l2) -> appears_in x (l2 ++ l1).
Proof.
  intros.
  apply appears_in_app in H.
  apply or_comm in H.
  apply app_appears_in in H.
  apply H.
Qed.

Theorem length_app_comm : forall (X : Type) (l1 l2 : list X),
  length (l1 ++ l2) = length (l2 ++ l1).
Proof.
  intros X l1 l2.
  rewrite -> app_length.
  rewrite -> app_length.
  rewrite -> plus_comm.
  reflexivity.
Qed.

Theorem pigeonhole_principle :
  excluded_middle ->
  forall (X : Type) (l1 l2 : list X),
  (forall x, appears_in x l1 -> appears_in x l2) ->
  length l2 < length l1 ->
  repeats l1.
Proof.
  intros EM.
  intros X l1. induction l1 as [|x l1'].
  Case "l1 = nil".
    intros. inversion H0.
  Case "l1 = x :: l1'".
    intros.
    assert (appears_in x (x :: l1')).
      apply ai_here.
    apply H in H1.
    apply appears_in_app_split in H1.
    inversion H1.
    inversion H2.
    rewrite -> H3 in H0.
    rewrite -> length_app_comm in H0.
    unfold lt in H0.
    simpl in H0.
    apply Sn_le_Sm__n_le_m in H0.
    rewrite -> H3 in H.
    assert (forall z : X, appears_in z (x :: l1') ->
        appears_in z (x :: (x1 ++ x0))%list).
      intros z Hz.
      apply H in Hz.
      apply appears_app_comm in Hz.
      simpl in Hz.
      apply Hz.
    (* Excluded middle *)
    assert (appears_in x l1' \/ not (appears_in x l1')).
      apply EM.
    destruct H5.
    SCase "x appears in l1'".
      apply rep_n.
      apply H5.
    SCase "x does not appear in l1'".
      apply rep_cons.
      apply IHl1' with (l2 := (x1 ++ x0)%list).
      intros x2 Hh.
      assert (x2 = x \/ not (x2 = x)).
        apply EM.
      destruct H6.
      SSCase "x2 = x".
        rewrite -> H6 in Hh.
        apply H5 in Hh.
        inversion Hh.
      SSCase "x2 <> x".
        apply ai_later with (b := x) in Hh.
        apply H4 in Hh.
        inversion Hh.
        apply H6 in H8.
        inversion H8.
        apply H8.
        unfold lt.
        apply H0.
Qed.

(* END pigeonhole principle. *)


Require Export GeoCoq.Elements.OriginalProofs.lemma_30helper.
Require Export GeoCoq.Elements.OriginalProofs.lemma_crossimpliesopposite.
Require Export GeoCoq.Elements.OriginalProofs.proposition_30A.

Section Euclid.

Context `{Ax:euclidean_euclidean}.

Lemma parnotmeet: forall A B C D,
 Par A B C D -> ~ Meet A B C D.
Proof.
intros.
conclude_def Par.
Qed.

Lemma proposition_30 :
   forall A B C D E F G H K,
   Par A B E F -> Par C D E F -> BetS G H K -> Col A B G -> Col E F H -> Col C D K -> neq A G -> neq E H -> neq C K ->
   Par A B C D.
Proof.
intros.
let Tf:=fresh in
assert (Tf:exists b, (BetS A G b /\ Cong G b A G)) by (conclude lemma_extension);destruct Tf as [b];spliter.
let Tf:=fresh in
assert (Tf:exists f, (BetS E H f /\ Cong H f E H)) by (conclude lemma_extension);destruct Tf as [f];spliter.
let Tf:=fresh in
assert (Tf:exists d, (BetS C K d /\ Cong K d C K)) by (conclude lemma_extension);destruct Tf as [d];spliter.
assert (nCol C D E) by (forward_using lemma_parallelNC).
assert (neq C D) by (forward_using lemma_NCdistinct).
assert (Col A G b) by (conclude_def Col ).
assert (Col G A b) by (forward_using lemma_collinearorder).
assert (Col G A B) by (forward_using lemma_collinearorder).
assert (neq G A) by (conclude lemma_inequalitysymmetric).
assert (Col A b B) by (conclude lemma_collinear4).
assert (Col B A b) by (forward_using lemma_collinearorder).
assert (Par E F A B) by (conclude lemma_parallelsymmetric).
assert (Par E F B A) by (forward_using lemma_parallelflip).
assert (neq A b) by (forward_using lemma_betweennotequal).
assert (neq b A) by (conclude lemma_inequalitysymmetric).
assert (Par E F b A) by (conclude lemma_collinearparallel).
assert (Par E F A b) by (forward_using lemma_parallelflip).
assert (Par A b E F) by (conclude lemma_parallelsymmetric).
assert (Col E H f) by (conclude_def Col ).
assert (Col H E f) by (forward_using lemma_collinearorder).
assert (Col H E F) by (forward_using lemma_collinearorder).
assert (neq H E) by (conclude lemma_inequalitysymmetric).
assert (Col E f F) by (conclude lemma_collinear4).
assert (Col F E f) by (forward_using lemma_collinearorder).
assert (neq E f) by (forward_using lemma_betweennotequal).
assert (neq f E) by (conclude lemma_inequalitysymmetric).
assert (Par A b F E) by (forward_using lemma_parallelflip).
assert (Par A b f E) by (conclude lemma_collinearparallel).
assert (Par A b E f) by (forward_using lemma_parallelflip).
assert (Col C K d) by (conclude_def Col ).
assert (Col K C d) by (forward_using lemma_collinearorder).
assert (Col K C D) by (forward_using lemma_collinearorder).
assert (neq K C) by (conclude lemma_inequalitysymmetric).
assert (Col C d D) by (conclude lemma_collinear4).
assert (Col D C d) by (forward_using lemma_collinearorder).
assert (Par E F C D) by (conclude lemma_parallelsymmetric).
assert (Par E F D C) by (forward_using lemma_parallelflip).
assert (neq C d) by (forward_using lemma_betweennotequal).
assert (neq d C) by (conclude lemma_inequalitysymmetric).
assert (Par E F d C) by (conclude lemma_collinearparallel).
assert (Par E F C d) by (forward_using lemma_parallelflip).
assert (Par C d E F) by (conclude lemma_parallelsymmetric).
assert (Par C d F E) by (forward_using lemma_parallelflip).
assert (Par C d f E) by (conclude lemma_collinearparallel).
assert (Par C d E f) by (forward_using lemma_parallelflip).
assert (eq H H) by (conclude cn_equalityreflexive).
assert (Col E H H) by (conclude_def Col ).
assert (Col A b G) by (forward_using lemma_collinearorder).
assert (Col E f H) by (forward_using lemma_collinearorder).
assert (Col f E H) by (forward_using lemma_collinearorder).
assert (Par A b f E) by (forward_using lemma_parallelflip).
assert (Par A b H E) by (conclude lemma_collinearparallel).
assert (Par H E A b) by (conclude lemma_parallelsymmetric).
assert (Par E H b A) by (forward_using lemma_parallelflip).
assert (Col b A G) by (forward_using lemma_collinearorder).
assert (Par E H G A) by (conclude lemma_collinearparallel).
assert (Par E H A G) by (forward_using lemma_parallelflip).
assert (Par A G E H) by (conclude lemma_parallelsymmetric).
assert (Par C d f E) by (forward_using lemma_parallelflip).
assert (Col f E H) by (forward_using lemma_collinearorder).
assert (Par C d H E) by (conclude lemma_collinearparallel).
assert (Par H E C d) by (conclude lemma_parallelsymmetric).
assert (Par H E d C) by (forward_using lemma_parallelflip).
assert (Col C K d) by (conclude_def Col ).
assert (Col d C K) by (forward_using lemma_collinearorder).
assert (neq C K) by (forward_using lemma_betweennotequal).
assert (neq K C) by (conclude lemma_inequalitysymmetric).
assert (Par H E K C) by (conclude lemma_collinearparallel).
assert (Par E H C K) by (forward_using lemma_parallelflip).
assert (TP E H C K) by (conclude lemma_paralleldef2B).
assert (OS C K E H) by (conclude_def TP ).
assert (nCol E H K) by (forward_using lemma_parallelNC).
assert (BetS K H G) by (conclude axiom_betweennesssymmetry).
assert (TS K E H G) by (conclude_def TS ).
assert (TS C E H G) by (conclude lemma_planeseparation).
let Tf:=fresh in
assert (Tf:exists Q, (BetS C Q G /\ Col E H Q /\ nCol E H C)) by (conclude_def TS );destruct Tf as [Q];spliter.
assert (Par E f C d) by (conclude lemma_parallelsymmetric).
assert (TP E f C d) by (conclude lemma_paralleldef2B).
assert (OS C d E f) by (conclude_def TP ).
assert (OS d C E f) by (forward_using lemma_samesidesymmetric).
assert (Col E H f) by (conclude_def Col ).
assert (Col H E f) by (forward_using lemma_collinearorder).
assert (Col H E Q) by (forward_using lemma_collinearorder).
assert (Col E f Q) by (conclude lemma_collinear4).
assert (nCol C E f) by (forward_using lemma_parallelNC).
assert (nCol E f C) by (forward_using lemma_NCorder).
assert (TS C E f G) by (conclude_def TS ).
assert (TS d E f G) by (conclude lemma_planeseparation).
let Tf:=fresh in
assert (Tf:exists P, (BetS d P G /\ Col E f P /\ nCol E f d)) by (conclude_def TS );destruct Tf as [P];spliter.
assert (~ ~ (CR A f G H \/ CR A E G H)).
 {
 intro.
 assert (CR A E G H) by (conclude lemma_30helper).
 contradict.
 }
assert (~ ~ (CR C f K H \/ CR C E K H)).
 {
 intro.
 assert (CR C E K H) by (conclude lemma_30helper).
 contradict.
 }
assert (Col F E H) by (forward_using lemma_collinearorder).
assert (Col B A G) by (forward_using lemma_collinearorder).
assert (Par A B F E) by (forward_using lemma_parallelflip).
assert (Par A B H E) by (conclude lemma_collinearparallel).
assert (Par A B E H) by (forward_using lemma_parallelflip).
assert (Par E H A B) by (conclude lemma_parallelsymmetric).
assert (Par E H B A) by (forward_using lemma_parallelflip).
assert (Par E H G A) by (conclude lemma_collinearparallel).
assert (Par E H A G) by (forward_using lemma_parallelflip).
assert (Par A G E H) by (conclude lemma_parallelsymmetric).
assert (nCol A G H) by (forward_using lemma_parallelNC).
assert (Par C D F E) by (forward_using lemma_parallelflip).
assert (Par C D H E) by (conclude lemma_collinearparallel).
assert (Par C D E H) by (forward_using lemma_parallelflip).
assert (Par E H C D) by (conclude lemma_parallelsymmetric).
assert (Par E H D C) by (forward_using lemma_parallelflip).
assert (Col D C K) by (forward_using lemma_collinearorder).
assert (Par E H K C) by (conclude lemma_collinearparallel).
assert (Par E H C K) by (forward_using lemma_parallelflip).
assert (Par C K E H) by (conclude lemma_parallelsymmetric).
assert (nCol C K H) by (forward_using lemma_parallelNC).
assert (nCol K H C) by (forward_using lemma_NCorder).
assert (nCol E H K) by (forward_using lemma_parallelNC).
assert (Col E H f) by (conclude_def Col ).
assert (neq H f) by (forward_using lemma_betweennotequal).
assert (neq f H) by (conclude lemma_inequalitysymmetric).
assert (eq H H) by (conclude cn_equalityreflexive).
assert (Col E H H) by (conclude_def Col ).
assert (nCol f H K) by (conclude lemma_NChelper).
assert (nCol K H f) by (forward_using lemma_NCorder).
assert (Col K H H) by (conclude_def Col ).
assert (Par A b C d).
by cases on (CR A f G H \/ CR A E G H).
{
 assert (TS A G H f) by (forward_using lemma_crossimpliesopposite).
 assert (Par A b C d).
 by cases on (CR C f K H \/ CR C E K H).
 {
  assert (TS f H K C) by (forward_using lemma_crossimpliesopposite).
  assert (Par A b C d)
   by (apply (proposition_30A _ _ _ _ E f G H K);assumption).
  close.
  }
 {
  let Tf:=fresh in
  assert (Tf:exists M, (BetS C M E /\ BetS K M H)) by (conclude_def CR );destruct Tf as [M];spliter.
  assert (Col K M H) by (conclude_def Col ).
  assert (Col K H M) by (forward_using lemma_collinearorder).
  assert (BetS f H E) by (conclude axiom_betweennesssymmetry).
  assert (OS f C K H) by (conclude_def OS ).
  assert (eq K K) by (conclude cn_equalityreflexive).
  assert (Col K H K) by (conclude_def Col ).
  assert (TS C K H d) by (conclude_def TS ).
  assert (TS f K H d) by (conclude lemma_planeseparation).
  let Tf:=fresh in
  assert (Tf:exists m, (BetS f m d /\ Col K H m /\ nCol K H f)) by (conclude_def TS );destruct Tf as [m];spliter.
  assert (Par f E C d) by (conclude lemma_parallelsymmetric).
  assert (~ Meet f E C d) by (auto using parnotmeet).
  assert (Col f H E) by (forward_using lemma_collinearorder).
  assert (neq f E) by (forward_using lemma_betweennotequal).
  assert (neq f H) by (conclude lemma_inequalitysymmetric).
  assert (neq K d) by (forward_using lemma_betweennotequal).
  assert (Col H K m) by (forward_using lemma_collinearorder).
  assert (BetS H m K) by (conclude lemma_collinearbetween).
  assert (BetS K m H) by (conclude axiom_betweennesssymmetry).
  assert (BetS d m f) by (conclude axiom_betweennesssymmetry).
  assert (CR d f K H) by (conclude_def CR ).
  assert (nCol C K H) by (forward_using lemma_NCorder).
  assert (Col C K d) by (conclude_def Col ).
  assert (neq d K) by (conclude lemma_inequalitysymmetric).
  assert (Col C K K) by (conclude_def Col ).
  assert (nCol d K H) by (conclude lemma_NChelper).
  assert (TS d H K f) by (forward_using lemma_crossimpliesopposite).
  assert (Par d C E f) by (forward_using lemma_parallelflip).
  assert (BetS d K C) by (conclude axiom_betweennesssymmetry).
  assert (TS f H K d) by (conclude lemma_oppositesidesymmetric).
  assert (Par A b d C).
  { simple eapply proposition_30A.
    exact H40.
    exact H171.
    exact H2.
    exact H9.
    exact H11.
    exact H172.
    exact H138.
    exact H173.
 }
  assert (Par A b C d) by (forward_using lemma_parallelflip).
  close.
  }
(** cases *)
 close.
 }
{
 assert (Par A b C d).
 by cases on (CR C f K H \/ CR C E K H).
 {
  let Tf:=fresh in
  assert (Tf:exists M, (BetS C M f /\ BetS K M H)) by (conclude_def CR );destruct Tf as [M];spliter.
  assert (Col K M H) by (conclude_def Col ).
  assert (Col K H M) by (forward_using lemma_collinearorder).
  assert (nCol K H E) by (forward_using lemma_NCorder).
  assert (nCol K H C) by (forward_using lemma_NCorder).
  assert (OS E C K H) by (conclude_def OS ).
  assert (eq K K) by (conclude cn_equalityreflexive).
  assert (Col K H K) by (conclude_def Col ).
  assert (TS C K H d) by (conclude_def TS ).
  assert (TS E K H d) by (conclude lemma_planeseparation).
  let Tf:=fresh in
  assert (Tf:exists m, (BetS E m d /\ Col K H m /\ nCol K H E)) by (conclude_def TS );destruct Tf as [m];spliter.
  assert (Par E f C d) by (conclude lemma_parallelsymmetric).
  assert (~ Meet E f C d) by (auto using parnotmeet).
  assert (Col E H f) by (forward_using lemma_collinearorder).
  assert (neq E f) by (forward_using lemma_betweennotequal).
  assert (neq E H) by (conclude lemma_inequalitysymmetric).
  assert (neq K d) by (forward_using lemma_betweennotequal).
  assert (Col H K m) by (forward_using lemma_collinearorder).
  assert (BetS H m K) by (conclude lemma_collinearbetween).
  assert (BetS K m H) by (conclude axiom_betweennesssymmetry).
  assert (BetS d m E) by (conclude axiom_betweennesssymmetry).
  assert (CR d E K H) by (conclude_def CR ).
  assert (nCol C K H) by (forward_using lemma_NCorder).
  assert (Col C K d) by (conclude_def Col ).
  assert (neq d K) by (conclude lemma_inequalitysymmetric).
  assert (Col C K K) by (conclude_def Col ).
  assert (nCol d K H) by (conclude lemma_NChelper).
  assert (TS d H K E) by (forward_using lemma_crossimpliesopposite).
  assert (Par d C f E) by (forward_using lemma_parallelflip).
  assert (BetS d K C) by (conclude axiom_betweennesssymmetry).
  assert (TS E H K d) by (conclude lemma_oppositesidesymmetric).
  assert (TS A G H E) by (forward_using lemma_crossimpliesopposite).
  assert (BetS f H E) by (conclude axiom_betweennesssymmetry).
  assert (Par A b d C) by (conclude proposition_30A).
  assert (Par A b C d) by (forward_using lemma_parallelflip).
  close.
  }
 {
  assert (TS C H K E) by (forward_using lemma_crossimpliesopposite).
  assert (TS E H K C) by (conclude lemma_oppositesidesymmetric).
  assert (TS A G H E) by (forward_using lemma_crossimpliesopposite).
  assert (BetS f H E) by (conclude axiom_betweennesssymmetry).
  assert (Par A b C d).
   {
  simple eapply proposition_30A.
   exact H62.
   exact H70.
   exact H2.
   exact H9.
   exact H143.
   exact H13.
   exact H142.
   exact H141.
  }
  close.
  }
(** cases *)
 close.
 }
(** cases *)
assert (Par A b d C) by (forward_using lemma_parallelflip).
assert (Col d C D) by (forward_using lemma_collinearorder).
assert (neq D C) by (conclude lemma_inequalitysymmetric).
assert (Par A b D C) by (conclude lemma_collinearparallel).
assert (Par A b C D) by (forward_using lemma_parallelflip).
assert (Par C D A b) by (conclude lemma_parallelsymmetric).
assert (Par C D b A) by (forward_using lemma_parallelflip).
assert (Col b A B) by (forward_using lemma_collinearorder).
assert (nCol A B E) by (forward_using lemma_parallelNC).
assert (neq B A) by (forward_using lemma_NCdistinct).
assert (Par C D B A) by (conclude lemma_collinearparallel).
assert (Par C D A B) by (forward_using lemma_parallelflip).
assert (Par A B C D) by (conclude lemma_parallelsymmetric).
close.
Qed.

End Euclid.


Require Export Coq.ZArith.ZArith.

Open Scope Z.

Module bounds.

Lemma lt_lt_trans: forall (b c a d x:Z),
  b < x < c ->
  a <= b ->
  c <= d ->
  a < x < d.
Proof. intros b c a d x [] ; split ; omega. Qed.

Lemma lt_impl_le: forall (a b x:Z),
  a < x < b ->
  a <= x <= b.
Proof. intros ; split ; omega. Qed.

Lemma le_le_trans: forall (a b c d x:Z),
  b <= x <= c ->
  a <= b ->
  c <= d ->
  a <= x <= d.
Proof. intros a b c d x [] ; split ; omega. Qed.

Lemma le_lt_trans: forall (b c a d x:Z),
  b <= x <= c ->
  a < b ->
  c < d ->
  a < x < d.
Proof. intros b c a d x [] ; split ; omega. Qed.

Lemma lelt_lt_trans: forall (b c a d x:Z),
  b <= x < c ->
  a < b ->
  c < d ->
  a < x < d.
Proof. intros b c a d x [] ; split ; omega. Qed.

Lemma lelteq_lt_trans: forall (b d a x:Z),
  b <= x < d ->
  a < b ->
  a < x < d.
Proof. intros b a d x [] ; split ; omega. Qed.

End bounds.

Close Scope Z.


Theorem p_implies_nnp : forall (p : Prop), p -> ~~p.
Proof.
  intros p.
  intros Hp.
  unfold not.
  intros Hnp.
  apply (Hnp Hp).
Qed.

Definition lem : Prop :=
forall (p : Prop), p \/ (~p).

Theorem doubleneg_elim :
lem -> forall (p : Prop), ~~ p -> p.
Proof.
  intros Hlem p Hnnp.
  unfold not in Hnnp.
  destruct (Hlem p) as [Hp | Hnp].
  - assumption.
  - unfold not in Hnp. apply Hnnp in Hnp. contradiction.
Qed.


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

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

Unset Positivity Checking.
Unset Guard Checking.

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

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

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

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

Definition synth (lf2 : natural) (lf1 : natural) (x : natural) (y : natural)
  : natural := mult x y.


Require Import Arith.
Require Import Fin.
Require Import Vector.
Require Import NatMisc.
Import VectorNotations.
Require Import NotationsMisc.
Require Import SigmaMisc.
From Equations Require Import Equations.
Set Equations Transparent.
Unset Equations WithK.

Derive EqDec for Fin.t.

(* any two elements in Fin.t (1) are equal *)

Equations fin1IsProp (x y : Fin.t 1) : x = y :=
  fin1IsProp F1 F1 := eq_refl.

(* a vector v of elements of (Fin.t n) of length m describes
   a map (Fin.t m) -> (Fin.t n)  *)

Definition mapOfVect {m n : nat} (v : Vector.t (Fin.t n) m) :
                     (Fin.t m) -> (Fin.t n) := nth v.

(* operation on vectors inducing composition on corresponding maps *)

Definition vectCompose {m n o : nat}
                       (v : Vector.t (Fin.t o) n)
                       (w : Vector.t (Fin.t n) m) :
                        Vector.t (Fin.t o) m :=
  map (nth v) w.

Equations nthMapLemma {A B: Type} {n : nat} (f : A -> B)
                      (w : Vector.t A n) (x : Fin.t n) :
                      nth (map f w) x = f (nth w x) :=
nthMapLemma f nil x                :=! x;
nthMapLemma f (cons _ ws') F1      := eq_refl;
nthMapLemma f (cons _ ws') (FS x') := nthMapLemma f ws' x'.

(* in order to improve the readability of the elements of ER,
   we interpret the "new" class in ERNew as the largest element
   in Fin.t (S n).
   For this it is convenient to introduce FL, the largest element
   in a Fin.t, and a map FU that just "shifts up" Fin.t n to Fin.t (S n).
   Under the involutive isomorphism invertFin, FL corresponds to F1
   and FU to FS.
*)

Equations FL (n : nat) :
             Fin.t (S n) :=
  FL 0     := F1;
  FL (S n) := FS (FL n).

Equations FU {n : nat} (x : Fin.t n) :
             Fin.t (S n) :=
  FU F1     := F1;
  FU (FS x) := FS (FU x).

Equations invertFin {n : nat} (x : Fin.t n) :
                    Fin.t n :=
  invertFin  F1    := FL _;
  invertFin (FS x) := FU (invertFin x).

Equations invFULemma {n : nat} (x : Fin.t n) :
                     invertFin (FU x) = FS (invertFin x) :=
  invFULemma F1     := _;
  invFULemma (FS x) := (f_equal _ (invFULemma x)).

Equations invFLLemma (n : nat) :
                     invertFin (FL n) = F1 :=
  invFLLemma 0     := eq_refl;
  invFLLemma (S n) := f_equal FU (invFLLemma n).

(* invertFin is an involution *)

Equations invertFinInv {n : nat} (x : Fin.t n) :
                       invertFin (invertFin x) = x :=
  invertFinInv {n:=0}      x     :=! x;
  invertFinInv {n:=(S _)}  F1    := (invFLLemma _);
  invertFinInv {n:=(S _)} (FS y) := (eq_trans
                                     (invFULemma (invertFin y))
                                     (f_equal _ (invertFinInv y))).

(* in particular, it is injective *)
Equations invertFinInjective {n : nat} (x y : Fin.t n)
                             (invEq: invertFin x = invertFin y) :
                              x = y :=
  invertFinInjective x y eq := x
                                 ={ eq_sym (invertFinInv _) }=
                               invertFin (invertFin x)
                                 ={ f_equal invertFin eq }=
                               invertFin (invertFin y)
                                 ={ invertFinInv _ }=
                               y QED.

(* to use invertFin for pattern matching, we have to keep
   the association ... *)

Definition invFinViewType {n : nat} (x : (Fin.t n)) : Type :=
  { y : Fin.t n & x = invertFin y }.

Definition invFinView {n : nat} (x : (Fin.t n)) : invFinViewType x :=
  {| invertFin x ; eq_sym (invertFinInv x) |}.

(* case splitting according to FU and FL *)

Equations(noind) finFUOrFL {n : nat} (x : Fin.t (S n)) :
                 { y : Fin.t n & x = FU y } + ( x = FL n ) :=
  finFUOrFL  {n:=0}     F1                  := (inr eq_refl);
  finFUOrFL  {n:=(S _)} x with invFinView x := {
                        | {| F1  ; eq |} := (inr eq);
                        | {| FS _; eq |} := (inl {| invertFin _ ; eq |})}.

Equations shiftinLast {n : nat} {A : Type} (a : A) (v : Vector.t A n) :
                      nth (shiftin a v) (FL n) = a :=
  shiftinLast a  []         := eq_refl;
  shiftinLast a (cons _ ws) := eq_trans _ (shiftinLast a ws).

Equations shiftinPrevious {n : nat} {A : Type} (a : A)
                          (v : Vector.t A n) (t : Fin.t n) :
                          nth (shiftin a v) (FU t) = nth v t :=
  shiftinPrevious a  nil         t      :=! t;
  shiftinPrevious a (cons _ ws)  F1     := eq_refl;
  shiftinPrevious a (cons _ ws) (FS t') := eq_trans _ (shiftinPrevious a ws _).

(* these are NoConfusion principles for FL and FU ...
   how to formulate properly ? *)

Lemma finNotFUAndFL {n : nat} (x : Fin.t n)
                    (eq : FU x = FL n) : False.
Proof.
  induction n.
  - apply (Fin.case0 _ x).
  - pose (f_equal invertFin eq) as eq'. simpl in eq'.
    rewrite invFULemma in eq'.
    rewrite invFLLemma in eq'.
    simpl in eq'.
    inversion eq'.
Defined.

Lemma fuIsInjective {n : nat} (x y : Fin.t n)
                    (eq : FU x = FU y) : x = y.
Proof.
  induction n.
  - apply Fin.case0.
  - apply (f_equal invertFin) in eq.
    repeat rewrite invFULemma in eq.
    inversion eq.
    apply sigmaNat in H0.
    apply invertFinInjective.
    exact H0.
Defined.

(* order relations on Fin.t *)

Equations toNat {n : nat} (x : Fin.t n) : nat :=
  toNat {n:=0}      x      :=! x;
  toNat {n:=(S _)}  F1     := 0;
  toNat {n:=(S _)} (FS x') := S (toNat x').

Definition leF : forall {m n : nat},
                 Fin.t m -> Fin.t n -> Prop :=
  fun m n x y => toNat x <= toNat y.

Definition ltF : forall {m n : nat},
                 Fin.t m -> Fin.t n -> Prop :=
  fun m n x y => toNat x < toNat y.

Notation "x <=~ y" := (leF x y) (at level 70).
Notation "x <~ y"  := (ltF x y) (at level 70).
Notation "x =~ y"  := ((x <=~ y) /\ (y <=~ x)) (at level 70).

Definition leFDecidable {m n : nat}
                        (x : Fin.t m) (y : Fin.t n) :
                        {x <=~ y} + {~ (x <=~ y)}.
Proof.
  pose (toNat x) as x'.
  pose (toNat y) as y'.
  exact (le_dec x' y').
Defined.

Definition ltFDecidable {m n : nat}
                        (x : Fin.t m) (y : Fin.t n) :
                        {x <~ y} + {~ (x <~ y)}.
Proof.
  pose (toNat x) as x'.
  pose (toNat y) as y'.
  exact (lt_dec x' y').
Defined.

Lemma ltTleF {m n : nat} (x : Fin.t m) (y : Fin.t n) :
              x <~ y <-> (FS x) <=~ y.
Proof.
  unfold "<~","<=~","<".
  destruct m.
  - inversion x.
  - destruct n.
    + inversion y.
    + rewrite toNat_equation_3. intuition.
Defined.

Lemma eqFLemma {m n : nat} (x : Fin.t m) (y : Fin.t n) :
                x =~ y <-> (toNat x = toNat y).
Proof.
  unfold "<=~"; split.
  - apply leAntiSymmetric.
  - intro eq; split; rewrite eq; trivial.
Defined.

Lemma eqFToEq {m : nat} (x y : Fin.t m) :
               x =~ y <-> x = y.
Proof.
  rewrite eqFLemma.
  induction m.
  - apply Fin.case0. assumption.
  - induction x; dependent induction y.
    + intuition.
    + split; intro; apply False_rec.
      * program_simpl.
      * inversion H.
    + split; intro; apply False_rec.
      * program_simpl.
      * inversion H.
    + split; intro; inversion H.
      * rewrite (IHx y) in H1; congruence.
      * rewrite H; reflexivity.
Defined.

Lemma ltFTricho {m n : nat} (x : Fin.t m) (y : Fin.t n) :
      (x =~ y) + (y <~ x) + (x <~ y).
Proof.
  unfold "<~".
  pose (ltTricho (toNat x) (toNat y)) as tnT.
  destruct tnT as [[Eq | GT ]| LT]; intuition.
  pose ((proj2 (eqFLemma x y)) (eq_sym Eq)); intuition.
Defined.

Lemma ltFTricho' {m : nat} (x y : Fin.t m) :
      (x = y) + (y <~ x) + (x <~ y).
Proof.
  destruct (ltFTricho x y).
  - left. destruct s.
    + left. rewrite eqFToEq in a; assumption.
    + right; assumption.
  - right. assumption.
Defined.

Lemma ltFFS {m n : nat} {x : Fin.t m} {y : Fin.t n} :
      ((FS x) <~ (FS y)) <-> (x <~ y).
Proof.
  unfold "<~".
  repeat (rewrite toNat_equation_3).
  split.
  - apply leSN.
  - apply leNS.
Defined.

Lemma ltFFS1 {m n : nat} {x : Fin.t m} {y : Fin.t n} :
      ((FS x) <~ (FS y)) -> (x <~ y).
Proof. rewrite ltFFS. intuition. Defined.

Lemma notLtF1 {m n : nat} {x : Fin.t m} : ~ (x <~ (@F1 n)).
Proof.
  unfold "<~". rewrite toNat_equation_2. apply notLt0.
Defined.

Lemma ltFIrrefl {m : nat} (x : Fin.t m) : ~ (x <~ x).
Proof.
  apply lt_irrefl.
Defined.

Lemma ltFAsymm {m n : nat} (x : Fin.t m) (y : Fin.t n) : x <~ y -> ~ (y <~ x).
Proof. apply Nat.lt_asymm. Defined.


Require Import Reals.
Require Import Interval.Tactic.

Goal
  forall x, (-1/2 <= x <= 0)%R ->
  True.
Proof.
intros x Hx.
interval_intro (Rabs x + x)%R upper with (i_bisect x, i_autodiff x, i_depth 5).
exact I.
Qed.


(** * Tactics: More Basic Tactics *)

(** This chapter introduces several additional proof strategies
    and tactics that allow us to begin proving more interesting
    properties of functional programs.  We will see:

    - how to use auxiliary lemmas in both "forward-style" and
      "backward-style" proofs;
    - how to reason about data constructors (in particular, how to use
      the fact that they are injective and disjoint);
    - how to strengthen an induction hypothesis (and when such
      strengthening is required); and
    - more details on how to reason by case analysis. *)

Require Export Poly.

(* ################################################################# *)
(** * The [apply] Tactic *)

(** We often encounter situations where the goal to be proved is
    _exactly_ the same as some hypothesis in the context or some
    previously proved lemma. *)

Theorem silly1 : forall (n m o p : nat),
     n = m  ->
     [n;o] = [n;p] ->
     [n;o] = [m;p].
Proof.
  intros n m o p eq1 eq2.
  rewrite <- eq1.

(** Here, we could finish with "[rewrite -> eq2.  reflexivity.]" as we
    have done several times before.  We can achieve the same effect in
    a single step by using the [apply] tactic instead: *)

  apply eq2.  Qed.

(** The [apply] tactic also works with _conditional_ hypotheses
    and lemmas: if the statement being applied is an implication, then
    the premises of this implication will be added to the list of
    subgoals needing to be proved. *)

Theorem silly2 : forall (n m o p : nat),
     n = m  ->
     (forall (q r : nat), q = r -> [q;o] = [r;p]) ->
     [n;o] = [m;p].
Proof.
  intros n m o p eq1 eq2.
  apply eq2. apply eq1.  Qed.

(** You may find it instructive to experiment with this proof
    and see if there is a way to complete it using just [rewrite]
    instead of [apply]. *)
(*I tried and it seems like there is no way.
    to proof it using just rewrite. *)

(** Typically, when we use [apply H], the statement [H] will
    begin with a [forall] that binds some _universal variables_.  When
    Coq matches the current goal against the conclusion of [H], it
    will try to find appropriate values for these variables.  For
    example, when we do [apply eq2] in the following proof, the
    universal variable [q] in [eq2] gets instantiated with [n] and [r]
    gets instantiated with [m]. *)

Theorem silly2a : forall (n m : nat),
     (n,n) = (m,m)  ->
     (forall (q r : nat), (q,q) = (r,r) -> [q] = [r]) ->
     [n] = [m].
Proof.
  intros n m eq1 eq2.
  apply eq2. apply eq1.  Qed.

(** **** Exercise: 2 stars, optional (silly_ex)  *)
(** Complete the following proof without using [simpl]. *)

Definition test := (forall n, evenb n = true -> oddb (S n) = true).

Check test.

Theorem silly_ex :
     (forall n, evenb n = true -> oddb (S n) = true) ->
     evenb 3 = true ->
     oddb 4 = true.
Proof.
  intros eq1 eq2. apply eq1. apply eq2. Qed.
(** [] *)

(** To use the [apply] tactic, the (conclusion of the) fact
    being applied must match the goal exactly -- for example, [apply]
    will not work if the left and right sides of the equality are
    swapped. *)

Theorem silly3_firsttry : forall (n : nat),
     true = beq_nat n 5  ->
     beq_nat (S (S n)) 7 = true.
Proof.
  intros n H.
  simpl.

(** Here we cannot use [apply] directly, but we can use the [symmetry]
    tactic, which switches the left and right sides of an equality in
    the goal. *)

  symmetry.
  simpl. (* (This [simpl] is optional, since [apply] will perform
            simplification first, if needed.) *)
  apply H.  Qed.

(** **** Exercise: 3 stars (apply_exercise1)  *)
(** (_Hint_: You can use [apply] with previously defined lemmas, not
    just hypotheses in the context.  Remember that [Search] is
    your friend.) *)
SearchAbout rev.
Theorem rev_exercise1 : forall (l l' : list nat),
     l = rev l' ->
     l' = rev l.
Proof.
  intros l l' eq1. rewrite -> eq1. symmetry. apply rev_involutive.
  (*Alternative:
  rewrite -> eq1.
  rewrite -> rev_involutive. reflexivity.
  *)
Qed.
(** [] *)

(** **** Exercise: 1 star, optionalM (apply_rewrite)  *)
(** Briefly explain the difference between the tactics [apply] and
    [rewrite].  What are the situations where both can usefully be
    applied?

(* Rewrite allows us to choose the direction of rewriting with -> or <-.
Apply on the other hand requires the fact to match the goal exaclty before
it can be applied. In particular the apply tactic is specifically for
conditional hypotheses and lemmas as rewrite does not help in simplification.
Thus both are usefully applied when it is not conditional.
 *)
*)
(** [] *)

(* ################################################################# *)
(** * The [apply ... with ...] Tactic *)

(** The following silly example uses two rewrites in a row to
    get from [[a,b]] to [[e,f]]. *)

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.
  intros a b c d e f eq1 eq2.
  rewrite -> eq1. rewrite -> eq2. reflexivity.  Qed.

(** Since this is a common pattern, we might like to pull it out
    as a lemma recording, once and for all, the fact that equality is
    transitive. *)

Theorem trans_eq : forall (X:Type) (n m o : X),
  n = m -> m = o -> n = o.
Proof.
  intros X n m o eq1 eq2. rewrite -> eq1. rewrite -> eq2.
  reflexivity.  Qed.

(** Now, we should be able to use [trans_eq] to prove the above
    example.  However, to do this we need a slight refinement of the
    [apply] tactic. *)

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.
  intros a b c d e f eq1 eq2.

(** If we simply tell Coq [apply trans_eq] at this point, it can
    tell (by matching the goal against the conclusion of the lemma)
    that it should instantiate [X] with [[nat]], [n] with [[a,b]], and
    [o] with [[e,f]].  However, the matching process doesn't determine
    an instantiation for [m]: we have to supply one explicitly by
    adding [with (m:=[c,d])] to the invocation of [apply]. *)

  apply trans_eq with (m:=[c;d]).
  apply eq1. apply eq2.   Qed.

(** Actually, we usually don't have to include the name [m] in
    the [with] clause; Coq is often smart enough to figure out which
    instantiation we're giving. We could instead write: [apply
    trans_eq with [c;d]]. *)

(** **** Exercise: 3 stars, optional (apply_with_exercise)  *)
Example trans_eq_exercise : forall (n m o p : nat),
     m = (minustwo o) ->
     (n + p) = m ->
     (n + p) = (minustwo o).
Proof.
  intros n m o p eq1 eq2. apply trans_eq with m. apply eq2. apply eq1. Qed.
(** [] *)

(* ################################################################# *)
(** * The [inversion] Tactic *)

(** Recall the definition of natural numbers:

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

    It is obvious from this definition that every number has one of
    two forms: either it is the constructor [O] or it is built by
    applying the constructor [S] to another number.  But there is more
    here than meets the eye: implicit in the definition (and in our
    informal understanding of how datatype declarations work in other
    programming languages) are two more facts:

    - The constructor [S] is _injective_.  That is, if [S n = S m], it
      must be the case that [n = m].

    - The constructors [O] and [S] are _disjoint_.  That is, [O] is not
      equal to [S n] for any [n].

    Similar principles apply to all inductively defined types: all
    constructors are injective, and the values built from distinct
    constructors are never equal.  For lists, the [cons] constructor
    is injective and [nil] is different from every non-empty list.
    For booleans, [true] and [false] are different.  (Since neither
    [true] nor [false] take any arguments, their injectivity is not
    interesting.)  And so on. *)

(** Coq provides a tactic called [inversion] that allows us to
    exploit these principles in proofs. To see how to use it, let's
    show explicitly that the [S] constructor is injective: *)

Theorem S_injective : forall (n m : nat),
  S n = S m ->
  n = m.
Proof.
  intros n m H.

(** By writing [inversion H] at this point, we are asking Coq to
    generate all equations that it can infer from [H] as additional
    hypotheses, replacing variables in the goal as it goes. In the
    present example, this amounts to adding a new hypothesis [H1 : n =
    m] and replacing [n] by [m] in the goal. *)

  inversion H.
  reflexivity.
Qed.

(** Here's a more interesting example that shows how multiple
    equations can be derived at once. *)

Theorem inversion_ex1 : forall (n m o : nat),
  [n; m] = [o; o] ->
  [n] = [m].
Proof.
  intros n m o H. inversion H. reflexivity. Qed.

(** We can name the equations that [inversion] generates with an
    [as ...] clause: *)

Theorem inversion_ex2 : forall (n m : nat),
  [n] = [m] ->
  n = m.
Proof.
  intros n m H. inversion H as [Hnm]. reflexivity.  Qed.

(** **** Exercise: 1 star (inversion_ex3)  *)
Example inversion_ex3 : forall (X : Type) (x y z : X) (l j : list X),
  x :: y :: l = z :: j ->
  y :: l = x :: j ->
  x = y.
Proof.
  intros X x y z l j H1 H2. inversion H1. inversion H2. symmetry. apply H0.

(** [] *)

(** When used on a hypothesis involving an equality between
    _different_ constructors (e.g., [S n = O]), [inversion] solves the
    goal immediately.  Consider the following proof: *)

Theorem beq_nat_0_l : forall n,
   beq_nat 0 n = true -> n = 0.
Proof.
  intros n.

(** We can proceed by case analysis on [n]. The first case is
    trivial. *)

  destruct n as [| n'].
  - (* n = 0 *)
    intros H. reflexivity.

(** However, the second one doesn't look so simple: assuming
    [beq_nat 0 (S n') = true], we must show [S n' = 0], but the latter
    clearly contradictory!  The way forward lies in the assumption.
    After simplifying the goal state, we see that [beq_nat 0 (S n') =
    true] has become [false = true]: *)

  - (* n = S n' *)
    simpl.

(** If we use [inversion] on this hypothesis, Coq notices that
    the subgoal we are working on is impossible, and therefore removes
    it from further consideration. *)

    intros H. inversion H. Qed.

(** This is an instance of a logical principle known as the _principle
    of explosion_, which asserts that a contradictory hypothesis
    entails anything, even false things! *)

Theorem inversion_ex4 : forall (n : nat),
  S n = O ->
  2 + 2 = 5.
Proof.
  intros n contra. inversion contra. Qed.

Theorem inversion_ex5 : forall (n m : nat),
  false = true ->
  [n] = [m].
Proof.
  intros n m contra. inversion contra. Qed.

(** If you find the principle of explosion confusing, remember
    that these proofs are not actually showing that the conclusion of
    the statement holds.  Rather, they are arguing that, if the
    nonsensical situation described by the premise did somehow arise,
    then the nonsensical conclusion would follow.  We'll explore the
    principle of explosion of more detail in the next chapter. *)

(** **** Exercise: 1 star (inversion_ex6)  *)
Example inversion_ex6 : forall (X : Type)
                          (x y z : X) (l j : list X),
  x :: y :: l = [] ->
  y :: l = z :: j ->
  x = z.
Proof. intros X x y z l j H1 H2. inversion H1.
Qed.

(** [] *)

(** To summarize this discussion, suppose [H] is a hypothesis in the
    context or a previously proven lemma of the form

        c a1 a2 ... an = d b1 b2 ... bm

    for some constructors [c] and [d] and arguments [a1 ... an] and
    [b1 ... bm].  Then [inversion H] has the following effect:

    - If [c] and [d] are the same constructor, then, by the
      injectivity of this constructor, we know that [a1 = b1], [a2 =
      b2], etc.  The [inversion H] adds these facts to the context and
      tries to use them to rewrite the goal.

    - If [c] and [d] are different constructors, then the hypothesis
      [H] is contradictory, and the current goal doesn't have to be
      considered at all.  In this case, [inversion H] marks the
      current goal as completed and pops it off the goal stack. *)

(** The injectivity of constructors allows us to reason that
    [forall (n m : nat), S n = S m -> n = m].  The converse of this
    implication is an instance of a more general fact about both
    constructors and functions, which we will find useful in a few
    places below: *)

Theorem f_equal : forall (A B : Type) (f: A -> B) (x y: A),
  x = y -> f x = f y.
Proof. intros A B f x y eq. rewrite eq.  reflexivity.  Qed.

(* ################################################################# *)
(** * Using Tactics on Hypotheses *)

(** By default, most tactics work on the goal formula and leave
    the context unchanged.  However, most tactics also have a variant
    that performs a similar operation on a statement in the context.

    For example, the tactic [simpl in H] performs simplification in
    the hypothesis named [H] in the context. *)

Theorem S_inj : forall (n m : nat) (b : bool),
     beq_nat (S n) (S m) = b  ->
     beq_nat n m = b.
Proof.
  intros n m b H. simpl in H. apply H.  Qed.

(** Similarly, [apply L in H] matches some conditional statement
    [L] (of the form [L1 -> L2], say) against a hypothesis [H] in the
    context.  However, unlike ordinary [apply] (which rewrites a goal
    matching [L2] into a subgoal [L1]), [apply L in H] matches [H]
    against [L1] and, if successful, replaces it with [L2].

    In other words, [apply L in H] gives us a form of "forward
    reasoning": from [L1 -> L2] and a hypothesis matching [L1], it
    produces a hypothesis matching [L2].  By contrast, [apply L] is
    "backward reasoning": it says that if we know [L1->L2] and we are
    trying to prove [L2], it suffices to prove [L1].

    Here is a variant of a proof from above, using forward reasoning
    throughout instead of backward reasoning. *)

Theorem silly3' : forall (n : nat),
  (beq_nat n 5 = true -> beq_nat (S (S n)) 7 = true) ->
  true = beq_nat n 5  ->
  true = beq_nat (S (S n)) 7.
Proof.
  intros n eq H.
  symmetry in H. apply eq in H. symmetry in H.
  apply H.  Qed.

(** Forward reasoning starts from what is _given_ (premises,
    previously proven theorems) and iteratively draws conclusions from
    them until the goal is reached.  Backward reasoning starts from
    the _goal_, and iteratively reasons about what would imply the
    goal, until premises or previously proven theorems are reached.
    If you've seen informal proofs before (for example, in a math or
    computer science class), they probably used forward reasoning.  In
    general, idiomatic use of Coq tends to favor backward reasoning,
    but in some situations the forward style can be easier to think
    about.  *)

(** **** Exercise: 3 stars, recommended (plus_n_n_injective)  *)
(** Practice using "in" variants in this exercise.  (Hint: use
    [plus_n_Sm].) *)

Theorem plus_n_n_injective : forall n m,
     n + n = m + m ->
     n = m.
Proof.
  intros n. induction n as [| n'].
  { intros m H0. simpl in H0. destruct m as [| m'].
    { reflexivity. }
    { inversion H0. } }
  { intros m H1. destruct m as [| m'].
    { inversion H1. }
    { inversion H1.
      apply f_equal. apply IHn'.
      rewrite <- plus_n_Sm in H0. rewrite <- plus_n_Sm in H0.
      apply S_injective in H0.
      apply H0. } }
Qed.

(** [] *)

(* ################################################################# *)
(** * Varying the Induction Hypothesis *)

(** Sometimes it is important to control the exact form of the
    induction hypothesis when carrying out inductive proofs in Coq.
    In particular, we need to be careful about which of the
    assumptions we move (using [intros]) from the goal to the context
    before invoking the [induction] tactic.  For example, suppose
    we want to show that the [double] function is injective -- i.e.,
    that it maps different arguments to different results:

    Theorem double_injective: forall n m,
      double n = double m -> n = m.

    The way we _start_ this proof is a bit delicate: if we begin with

      intros n. induction n.

    all is well.  But if we begin it with

      intros n m. induction n.

    we get stuck in the middle of the inductive case... *)

Theorem double_injective_FAILED : forall n m,
     double n = double m ->
     n = m.
Proof.
  intros n m. induction n as [| n'].
  - (* n = O *) simpl. intros eq. destruct m as [| m'].
    + (* m = O *) reflexivity.
    + (* m = S m' *) inversion eq.
  - (* n = S n' *) intros eq. destruct m as [| m'].
    + (* m = O *) inversion eq.
    + (* m = S m' *) apply f_equal.

(** At this point, the induction hypothesis, [IHn'], does _not_ give us
    [n' = m'] -- there is an extra [S] in the way -- so the goal is
    not provable. *)

      Abort.

(** What went wrong? *)

(** The problem is that, at the point we invoke the induction
    hypothesis, we have already introduced [m] into the context --
    intuitively, we have told Coq, "Let's consider some particular [n]
    and [m]..." and we now have to prove that, if [double n = double
    m] for _these particular_ [n] and [m], then [n = m].

    The next tactic, [induction n] says to Coq: We are going to show
    the goal by induction on [n].  That is, we are going to prove, for
    _all_ [n], that the proposition

      - [P n] = "if [double n = double m], then [n = m]"

    holds, by showing

      - [P O]

         (i.e., "if [double O = double m] then [O = m]") and

      - [P n -> P (S n)]

        (i.e., "if [double n = double m] then [n = m]" implies "if
        [double (S n) = double m] then [S n = m]").

    If we look closely at the second statement, it is saying something
    rather strange: it says that, for a _particular_ [m], if we know

      - "if [double n = double m] then [n = m]"

    then we can prove

       - "if [double (S n) = double m] then [S n = m]".

    To see why this is strange, let's think of a particular [m] --
    say, [5].  The statement is then saying that, if we know

      - [Q] = "if [double n = 10] then [n = 5]"

    then we can prove

      - [R] = "if [double (S n) = 10] then [S n = 5]".

    But knowing [Q] doesn't give us any help at all with proving
    [R]!  (If we tried to prove [R] from [Q], we would start with
    something like "Suppose [double (S n) = 10]..." but then we'd be
    stuck: knowing that [double (S n)] is [10] tells us nothing about
    whether [double n] is [10], so [Q] is useless.) *)

(** Trying to carry out this proof by induction on [n] when [m] is
    already in the context doesn't work because we are then trying to
    prove a relation involving _every_ [n] but just a _single_ [m]. *)

(** The successful proof of [double_injective] leaves [m] in the goal
    statement at the point where the [induction] tactic is invoked on
    [n]: *)

Theorem double_injective : forall n m,
     double n = double m ->
     n = m.
Proof.
  intros n. induction n as [| n'].
  - (* n = O *) simpl. intros m eq. destruct m as [| m'].
    + (* m = O *) reflexivity.
    + (* m = S m' *) inversion eq.

  - (* n = S n' *) simpl.

(** Notice that both the goal and the induction hypothesis are
    different this time: the goal asks us to prove something more
    general (i.e., to prove the statement for _every_ [m]), but the IH
    is correspondingly more flexible, allowing us to choose any [m] we
    like when we apply the IH. *)

    intros m eq.

(** Now we've chosen a particular [m] and introduced the assumption
    that [double n = double m].  Since we are doing a case analysis on
    [n], we also need a case analysis on [m] to keep the two "in sync." *)

    destruct m as [| m'].
    + (* m = O *) simpl.

(** The 0 case is trivial: *)

      inversion eq.

    + (* m = S m' *)
      apply f_equal.

(** At this point, since we are in the second branch of the [destruct
    m], the [m'] mentioned in the context is the predecessor of the
    [m] we started out talking about.  Since we are also in the [S]
    branch of the induction, this is perfect: if we instantiate the
    generic [m] in the IH with the current [m'] (this instantiation is
    performed automatically by the [apply] in the next step), then
    [IHn'] gives us exactly what we need to finish the proof. *)

      apply IHn'. inversion eq. reflexivity. Qed.

(** What you should take away from all this is that we need to be
    careful about using induction to try to prove something too
    specific: To prove a property of [n] and [m] by induction on [n],
    it is sometimes important to leave [m] generic. *)

(** The following exercise requires the same pattern. *)

(** **** Exercise: 2 stars (beq_nat_true)  *)
Theorem beq_nat_true : forall n m,
    beq_nat n m = true -> n = m.
Proof.
  intros n. induction n as [| n'].
  { intros m eq. destruct m as [| m'].
    { reflexivity. }
    { inversion eq. } }
  { intros m eq. destruct m as [| m'].
    { inversion eq. }
    { apply f_equal. apply IHn'. simpl in eq. apply eq. }}
Qed.

(** [] *)

(** **** Exercise: 2 stars, advancedM (beq_nat_true_informal)  *)
(** Give a careful informal proof of [beq_nat_true], being as explicit
    as possible about quantifiers. *)

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

(** The strategy of doing fewer [intros] before an [induction] to
    obtain a more general IH doesn't always work by itself; sometimes
    some _rearrangement_ of quantified variables is needed.  Suppose,
    for example, that we wanted to prove [double_injective] by
    induction on [m] instead of [n]. *)

Theorem double_injective_take2_FAILED : forall n m,
     double n = double m ->
     n = m.
Proof.
  intros n m. induction m as [| m'].
  - (* m = O *) simpl. intros eq. destruct n as [| n'].
    + (* n = O *) reflexivity.
    + (* n = S n' *) inversion eq.
  - (* m = S m' *) intros eq. destruct n as [| n'].
    + (* n = O *) inversion eq.
    + (* n = S n' *) apply f_equal.
        (* Stuck again here, just like before. *)
Abort.

(** The problem is that, to do induction on [m], we must first
    introduce [n].  (If we simply say [induction m] without
    introducing anything first, Coq will automatically introduce [n]
    for us!)  *)

(** What can we do about this?  One possibility is to rewrite the
    statement of the lemma so that [m] is quantified before [n].  This
    works, but it's not nice: We don't want to have to twist the
    statements of lemmas to fit the needs of a particular strategy for
    proving them!  Rather we want to state them in the clearest and
    most natural way. *)

(** What we can do instead is to first introduce all the quantified
    variables and then _re-generalize_ one or more of them,
    selectively taking variables out of the context and putting them
    back at the beginning of the goal.  The [generalize dependent]
    tactic does this. *)

Theorem double_injective_take2 : forall n m,
     double n = double m ->
     n = m.
Proof.
  intros n m.
  (* [n] and [m] are both in the context *)
  generalize dependent n.
  (* Now [n] is back in the goal and we can do induction on
     [m] and get a sufficiently general IH. *)
  induction m as [| m'].
  - (* m = O *) simpl. intros n eq. destruct n as [| n'].
    + (* n = O *) reflexivity.
    + (* n = S n' *) inversion eq.
  - (* m = S m' *) intros n eq. destruct n as [| n'].
    + (* n = O *) inversion eq.
    + (* n = S n' *) apply f_equal.
      apply IHm'. inversion eq. reflexivity. Qed.

(** Let's look at an informal proof of this theorem.  Note that
    the proposition we prove by induction leaves [n] quantified,
    corresponding to the use of generalize dependent in our formal
    proof.

    _Theorem_: For any nats [n] and [m], if [double n = double m], then
      [n = m].

    _Proof_: Let [m] be a [nat]. We prove by induction on [m] that, for
      any [n], if [double n = double m] then [n = m].

      - First, suppose [m = 0], and suppose [n] is a number such
        that [double n = double m].  We must show that [n = 0].

        Since [m = 0], by the definition of [double] we have [double n =
        0].  There are two cases to consider for [n].  If [n = 0] we are
        done, since [m = 0 = n], as required.  Otherwise, if [n = S n']
        for some [n'], we derive a contradiction: by the definition of
        [double], we can calculate [double n = S (S (double n'))], but
        this contradicts the assumption that [double n = 0].

      - Second, suppose [m = S m'] and that [n] is again a number such
        that [double n = double m].  We must show that [n = S m'], with
        the induction hypothesis that for every number [s], if [double s =
        double m'] then [s = m'].

        By the fact that [m = S m'] and the definition of [double], we
        have [double n = S (S (double m'))].  There are two cases to
        consider for [n].

        If [n = 0], then by definition [double n = 0], a contradiction.

        Thus, we may assume that [n = S n'] for some [n'], and again by
        the definition of [double] we have [S (S (double n')) =
        S (S (double m'))], which implies by inversion that [double n' =
        double m'].  Instantiating the induction hypothesis with [n'] thus
        allows us to conclude that [n' = m'], and it follows immediately
        that [S n' = S m'].  Since [S n' = n] and [S m' = m], this is just
        what we wanted to show. [] *)

(** Before we close this section and move on to some exercises,
    let's digress briefly and use [beq_nat_true] to prove a similar
    property of identifiers that we'll need in later chapters: *)

Theorem beq_id_true : forall x y,
  beq_id x y = true -> x = y.
Proof.
  intros [m] [n]. simpl. intros H.
  assert (H' : m = n). { apply beq_nat_true. apply H. }
  rewrite H'. reflexivity.
Qed.

(** **** Exercise: 3 stars, recommended (gen_dep_practice)  *)
(** Prove this by induction on [l]. *)

Theorem nth_error_after_last: forall (n : nat) (X : Type) (l : list X),
     length l = n ->
     nth_error l n = None.
Proof.
  intros n X l.
  generalize dependent n.
  induction l as [|h tl IH].
  { simpl. intros n H. reflexivity. }
  { intros n H. simpl. destruct n as [| n'].
    { simpl. inversion H. }
    { simpl. apply IH. simpl in H. apply S_injective. apply H. }}
Qed.

(** [] *)

(* ################################################################# *)
(** * Unfolding Definitions *)

(** It sometimes happens that we need to manually unfold a Definition
    so that we can manipulate its right-hand side.  For example, if we
    define... *)

Definition square n := n * n.

(** ... and try to prove a simple fact about [square]... *)

Lemma square_mult : forall n m, square (n * m) = square n * square m.
Proof.
  intros n m.
  simpl.

(** ... we get stuck: [simpl] doesn't simplify anything at this point,
    and since we haven't proved any other facts about [square], there
    is nothing we can [apply] or [rewrite] with.

    To make progress, we can manually [unfold] the definition of
    [square]: *)

  unfold square.

(** Now we have plenty to work with: both sides of the equality are
    expressions involving multiplication, and we have lots of facts
    about multiplication at our disposal.  In particular, we know that
    it is commutative and associative, and from these facts it is not
    hard to finish the proof. *)

  rewrite mult_assoc.
  assert (H : n * m * n = n * n * m).
  { rewrite mult_comm. apply mult_assoc. }
  rewrite H. rewrite mult_assoc. reflexivity.
Qed.

(** At this point, a deeper discussion of unfolding and simplification
    is in order.

    You may already have observed that tactics like [simpl],
    [reflexivity], and [apply] will often unfold the definitions of
    functions automatically when this allows them to make progress.  For
    example, if we define [foo m] to be the constant [5]... *)

Definition foo (x: nat) := 5.

(** then the [simpl] in the following proof (or the [reflexivity], if
    we omit the [simpl]) will unfold [foo m] to [(fun x => 5) m] and
    then further simplify this expression to just [5]. *)

Fact silly_fact_1 : forall m, foo m + 1 = foo (m + 1) + 1.
Proof.
  intros m.
  simpl.
  reflexivity.
Qed.

(** However, this automatic unfolding is rather conservative.  For
    example, if we define a slightly more complicated function
    involving a pattern match... *)

Definition bar x :=
  match x with
  | O => 5
  | S _ => 5
  end.

(** ...then the analogous proof will get stuck: *)

Fact silly_fact_2_FAILED : forall m, bar m + 1 = bar (m + 1) + 1.
Proof.
  intros m.
  simpl. (* Does nothing! *)
Abort.

(** The reason that [simpl] doesn't make progress here is that it
    notices that, after tentatively unfolding [bar m], it is left with
    a match whose scrutinee, [m], is a variable, so the [match] cannot
    be simplified further.  (It is not smart enough to notice that the
    two branches of the [match] are identical.)  So it gives up on
    unfolding [bar m] and leaves it alone.  Similarly, tentatively
    unfolding [bar (m+1)] leaves a [match] whose scrutinee is a
    function application (that, itself, cannot be simplified, even
    after unfolding the definition of [+]), so [simpl] leaves it
    alone.

    At this point, there are two ways to make progress.  One is to use
    [destruct m] to break the proof into two cases, each focusing on a
    more concrete choice of [m] ([O] vs [S _]).  In each case, the
    [match] inside of [bar] can now make progress, and the proof is
    easy to complete. *)

Fact silly_fact_2 : forall m, bar m + 1 = bar (m + 1) + 1.
Proof.
  intros m.
  destruct m.
  - simpl. reflexivity.
  - simpl. reflexivity.
Qed.

(** This approach works, but it depends on our recognizing that the
    [match] hidden inside [bar] is what was preventing us from making
    progress.

    A more straightforward way to make progress is to explicitly tell
    Coq to unfold [bar]. *)

Fact silly_fact_2' : forall m, bar m + 1 = bar (m + 1) + 1.
Proof.
  intros m.
  unfold bar.

(** Now it is apparent that we are stuck on the [match] expressions on
    both sides of the [=], and we can use [destruct] to finish the
    proof without thinking too hard. *)

  destruct m.
  - reflexivity.
  - reflexivity.
Qed.

(* ################################################################# *)
(** * Using [destruct] on Compound Expressions *)

(** We have seen many examples where [destruct] is used to
    perform case analysis of the value of some variable.  But
    sometimes we need to reason by cases on the result of some
    _expression_.  We can also do this with [destruct].

    Here are some examples: *)

Definition sillyfun (n : nat) : bool :=
  if beq_nat n 3 then false
  else if beq_nat n 5 then false
  else false.

Theorem sillyfun_false : forall (n : nat),
  sillyfun n = false.
Proof.
  intros n. unfold sillyfun.
  destruct (beq_nat n 3).
    - (* beq_nat n 3 = true *) reflexivity.
    - (* beq_nat n 3 = false *) destruct (beq_nat n 5).
      + (* beq_nat n 5 = true *) reflexivity.
      + (* beq_nat n 5 = false *) reflexivity.  Qed.

(** After unfolding [sillyfun] in the above proof, we find that
    we are stuck on [if (beq_nat n 3) then ... else ...].  But either
    [n] is equal to [3] or it isn't, so we can use [destruct (beq_nat
    n 3)] to let us reason about the two cases.

    In general, the [destruct] tactic can be used to perform case
    analysis of the results of arbitrary computations.  If [e] is an
    expression whose type is some inductively defined type [T], then,
    for each constructor [c] of [T], [destruct e] generates a subgoal
    in which all occurrences of [e] (in the goal and in the context)
    are replaced by [c]. *)

(** **** Exercise: 3 stars, optional (combine_split)  *)
Theorem combine_split : forall X Y (l : list (X * Y)) l1 l2,
  split l = (l1, l2) ->
  combine l1 l2 = l.
Proof.
  intros X Y.
  destruct l as [| h tl].
  { simpl. intros l1 l2 eq. inversion eq. simpl. reflexivity. }
  { intros l1 l2 eq. destruct combine.
    { inversion eq.

  destruct l1 as [| h tl].
    { simpl. reflexivity. }
    { simpl. inversion eq. } }
  { intros l1 l2 eq.
(* STUCK !!! *)
  (* FILL IN HERE *) Admitted.
(** [] *)

(** However, [destruct]ing compound expressions requires a bit of
    care, as such [destruct]s can sometimes erase information we need
    to complete a proof. *)
(** For example, suppose we define a function [sillyfun1] like
    this: *)

Definition sillyfun1 (n : nat) : bool :=
  if beq_nat n 3 then true
  else if beq_nat n 5 then true
  else false.

(** Now suppose that we want to convince Coq of the (rather
    obvious) fact that [sillyfun1 n] yields [true] only when [n] is
    odd.  By analogy with the proofs we did with [sillyfun] above, it
    is natural to start the proof like this: *)

Theorem sillyfun1_odd_FAILED : forall (n : nat),
     sillyfun1 n = true ->
     oddb n = true.
Proof.
  intros n eq. unfold sillyfun1 in eq.
  destruct (beq_nat n 3).
  (* stuck... *)
Abort.

(** We get stuck at this point because the context does not
    contain enough information to prove the goal!  The problem is that
    the substitution performed by [destruct] is too brutal -- it threw
    away every occurrence of [beq_nat n 3], but we need to keep some
    memory of this expression and how it was destructed, because we
    need to be able to reason that, since [beq_nat n 3 = true] in this
    branch of the case analysis, it must be that [n = 3], from which
    it follows that [n] is odd.

    What we would really like is to substitute away all existing
    occurences of [beq_nat n 3], but at the same time add an equation
    to the context that records which case we are in.  The [eqn:]
    qualifier allows us to introduce such an equation, giving it a
    name that we choose. *)

Theorem sillyfun1_odd : forall (n : nat),
     sillyfun1 n = true ->
     oddb n = true.
Proof.
  intros n eq. unfold sillyfun1 in eq.
  destruct (beq_nat n 3) eqn:Heqe3.
  (* Now we have the same state as at the point where we got
     stuck above, except that the context contains an extra
     equality assumption, which is exactly what we need to
     make progress. *)
    - (* e3 = true *) apply beq_nat_true in Heqe3.
      rewrite -> Heqe3. reflexivity.
    - (* e3 = false *)
     (* When we come to the second equality test in the body
        of the function we are reasoning about, we can use
        [eqn:] again in the same way, allow us to finish the
        proof. *)
      destruct (beq_nat n 5) eqn:Heqe5.
        + (* e5 = true *)
          apply beq_nat_true in Heqe5.
          rewrite -> Heqe5. reflexivity.
        + (* e5 = false *) inversion eq.  Qed.

(** **** Exercise: 2 stars (destruct_eqn_practice)  *)
Theorem bool_fn_applied_thrice :
  forall (f : bool -> bool) (b : bool),
  f (f (f b)) = f b.
Proof.
  intros f b. apply f_equal. destruct b eqn:H.
  { destruct f eqn:f1.
    { reflexivity. }
    { rewrite <- H. inversion H. rewrite <- H0.   }
  }
  (* FILL IN HERE *) Admitted.
(** [] *)

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

(** We've now seen many of Coq's most fundamental tactics.  We'll
    introduce a few more in the coming chapters, and later on we'll
    see some more powerful _automation_ tactics that make Coq help us
    with low-level details.  But basically we've got what we need to
    get work done.

    Here are the ones we've seen:

      - [intros]: move hypotheses/variables from goal to context

      - [reflexivity]: finish the proof (when the goal looks like [e =
        e])

      - [apply]: prove goal using a hypothesis, lemma, or constructor

      - [apply... in H]: apply a hypothesis, lemma, or constructor to
        a hypothesis in the context (forward reasoning)

      - [apply... with...]: explicitly specify values for variables
        that cannot be determined by pattern matching

      - [simpl]: simplify computations in the goal

      - [simpl in H]: ... or a hypothesis

      - [rewrite]: use an equality hypothesis (or lemma) to rewrite
        the goal

      - [rewrite ... in H]: ... or a hypothesis

      - [symmetry]: changes a goal of the form [t=u] into [u=t]

      - [symmetry in H]: changes a hypothesis of the form [t=u] into
        [u=t]

      - [unfold]: replace a defined constant by its right-hand side in
        the goal

      - [unfold... in H]: ... or a hypothesis

      - [destruct... as...]: case analysis on values of inductively
        defined types

      - [destruct... eqn:...]: specify the name of an equation to be
        added to the context, recording the result of the case
        analysis

      - [induction... as...]: induction on values of inductively
        defined types

      - [inversion]: reason by injectivity and distinctness of
        constructors

      - [assert (H: e)] (or [assert (e) as H]): introduce a "local
        lemma" [e] and call it [H]

      - [generalize dependent x]: move the variable [x] (and anything
        else that depends on it) from the context back to an explicit
        hypothesis in the goal formula *)

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

(** **** Exercise: 3 stars (beq_nat_sym)  *)
Theorem beq_nat_sym : forall (n m : nat),
  beq_nat n m = beq_nat m n.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars, advancedM? (beq_nat_sym_informal)  *)
(** Give an informal proof of this lemma that corresponds to your
    formal proof above:

   Theorem: For any [nat]s [n] [m], [beq_nat n m = beq_nat m n].

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

(** **** Exercise: 3 stars, optional (beq_nat_trans)  *)
Theorem beq_nat_trans : forall n m p,
  beq_nat n m = true ->
  beq_nat m p = true ->
  beq_nat n p = true.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars, advancedM (split_combine)  *)
(** We proved, in an exercise above, that for all lists of pairs,
    [combine] is the inverse of [split].  How would you formalize the
    statement that [split] is the inverse of [combine]?  When is this
    property true?

    Complete the definition of [split_combine_statement] below with a
    property that states that [split] is the inverse of
    [combine]. Then, prove that the property holds. (Be sure to leave
    your induction hypothesis general by not doing [intros] on more
    things than necessary.  Hint: what property do you need of [l1]
    and [l2] for [split] [combine l1 l2 = (l1,l2)] to be true?) *)

Definition split_combine_statement : Prop
  (* ("[: Prop]" means that we are giving a name to a
     logical proposition here.) *)
  (* REPLACE THIS LINE WITH ":= _your_definition_ ." *). Admitted.

Theorem split_combine : split_combine_statement.
Proof.
(* FILL IN HERE *) Admitted.

(** [] *)

(** **** Exercise: 3 stars, advanced (filter_exercise)  *)
(** This one is a bit challenging.  Pay attention to the form of your
    induction hypothesis. *)

Theorem filter_exercise : forall (X : Type) (test : X -> bool)
                             (x : X) (l lf : list X),
     filter test l = x :: lf ->
     test x = true.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 4 stars, advanced, recommended (forall_exists_challenge)  *)
(** Define two recursive [Fixpoints], [forallb] and [existsb].  The
    first checks whether every element in a list satisfies a given
    predicate:

      forallb oddb [1;3;5;7;9] = true

      forallb negb [false;false] = true

      forallb evenb [0;2;4;5] = false

      forallb (beq_nat 5) [] = true

    The second checks whether there exists an element in the list that
    satisfies a given predicate:

      existsb (beq_nat 5) [0;2;3;6] = false

      existsb (andb true) [true;true;false] = true

      existsb oddb [1;0;0;0;0;3] = true

      existsb evenb [] = false

    Next, define a _nonrecursive_ version of [existsb] -- call it
    [existsb'] -- using [forallb] and [negb].

    Finally, prove a theorem [existsb_existsb'] stating that
    [existsb'] and [existsb] have the same behavior. *)

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

(** $Date: 2016-10-08 18:36:21 -0400 (Sat, 08 Oct 2016) $ *)