(** * Selection:  Selection sort, with specification and proof of correctness*)
(**
  This sorting algorithm works by choosing (and deleting) the smallest
  element, then doing it again, and so on.  It takes O(N^2) time.

  You should never* use a selection sort.  If you want a simple
  quadratic-time sorting algorithm (for small input sizes) you should
  use insertion sort.  Insertion sort is simpler to implement, runs
  faster, and is simpler to prove correct.   We use selection sort here
  only to illustrate the proof techniques.

     *Well, hardly ever.  If the cost of "moving" an element is _much_
  larger than the cost of comparing two keys, then selection sort is
  better than insertion sort.  But this consideration does not apply in our
  setting, where the elements are  represented as pointers into the
  heap, and only the pointers need to be moved.

  What you should really never use is bubble sort.  Bubble sort
  would be the wrong way to go.  Everybody knows that!
  https://www.youtube.com/watch?v=k4RRi_ntQc8
*)

(* ################################################################# *)
(** * The selection-sort program  *)

Require Import Perm.

(** Find (and delete) the smallest element in a list. *)

Fixpoint select (x: nat) (l: list nat) : nat * list nat :=
match l with
|  nil => (x, nil)
|  h::t => if x <=? h
               then let (j, l') := select x t in (j, h::l')
               else let (j,l') := select h t in (j, x::l')
end.

(** Now, selection-sort works by repeatedly extracting the smallest element,
   and making a list of the results. *)

(* Uncomment this function, and try it.
Fixpoint selsort l :=
match l with
| i::r => let (j,r') := select i r
               in j :: selsort r'
| nil => nil
end.
*)

(** _Error: Recursive call to selsort has principal argument equal
  to [r'] instead of [r]_.  That is, the recursion is not _structural_, since
  the list r' is not a structural sublist of (i::r).  One way to fix the
  problem is to use Coq's [Function] feature, and prove that
  [length(r')<length(i::r)].  Later in this chapter, we'll show that approach.

  Instead, here we solve this problem is by providing "fuel", an additional
  argument that has no use in the algorithm except to bound the
  amount of recursion.  The [n] argument, below, is the fuel. *)

Fixpoint selsort l n {struct n} :=
match l, n with
| x::r, S n' => let (y,r') := select x r
               in y :: selsort r' n'
| nil, _ => nil
| _::_, O => nil  (* Oops!  Ran out of fuel! *)
end.

(** What happens if we run out of fuel before we reach the end
   of the list?  Then WE GET THE WRONG ANSWER. *)

Example out_of_gas: selsort [3;1;4;1;5] 3 <> [1;1;3;4;5].
Proof.
simpl.
intro. inversion H.
Qed.

(** What happens if we have have too much fuel?  No problem. *)

Example too_much_gas: selsort [3;1;4;1;5] 10 = [1;1;3;4;5].
Proof.
simpl.
auto.
Qed.

(** The selection_sort algorithm provides just enough fuel. *)

Definition selection_sort l := selsort l (length l).

Example sort_pi: selection_sort [3;1;4;1;5;9;2;6;5;3;5] = [1;1;2;3;3;4;5;5;5;6;9].
Proof.
unfold selection_sort.
simpl.
reflexivity.
Qed.

(** Specification of correctness of a sorting algorithm:
   it rearranges the elements into a list that is totally ordered. *)

Inductive sorted: list nat -> Prop :=
 | sorted_nil: sorted nil
 | sorted_1: forall i, sorted (i::nil)
 | sorted_cons: forall i j l, i <= j -> sorted (j::l) -> sorted (i::j::l).

Definition is_a_sorting_algorithm (f: list nat -> list nat) :=
  forall al, Permutation al (f al) /\ sorted (f al).

(* ################################################################# *)
(** * Proof of correctness of selection sort. *)
(** Here's what we want to prove. *)

Definition selection_sort_correct : Prop :=
    is_a_sorting_algorithm selection_sort.

(** We'll start by working on part 1, permutations. *)

(** **** Exercise: 3 stars (select_perm)  *)
Lemma select_perm: forall x l,
  let (y,r) := select x l in
   Permutation (x::l) (y::r).
Proof.

(** NOTE: If you wish, you may [Require Import Multiset] and use the  multiset
  method, along with the theorem [contents_perm].  If you do,
  you'll still leave the statement of this theorem unchanged. *)

intros x l; revert x.
induction l; intros; simpl in *.
(* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars (selection_sort_perm)  *)
Lemma selsort_perm:
  forall n,
  forall l, length l = n -> Permutation l (selsort l n).
Proof.

(** NOTE: If you wish, you may [Require Import Multiset] and use the  multiset
  method, along with the theorem [same_contents_iff_perm]. *)

(* FILL IN HERE *) Admitted.

Theorem selection_sort_perm:
  forall l, Permutation l (selection_sort l).
Proof.
(* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars (select_smallest)  *)
Lemma select_smallest_aux:
  forall x al y bl,
    Forall (fun z => y <= z) bl ->
    select x al = (y,bl) ->
    y <= x.
Proof.
(* Hint: no induction needed in this lemma.
   Just use existing lemmas about select, along with [Forall_perm] *)
(* FILL IN HERE *) Admitted.

Theorem select_smallest:
  forall x al y bl, select x al = (y,bl) ->
     Forall (fun z => y <= z) bl.
Proof.
intros x al; revert x; induction al; intros; simpl in *.
 (* FILL IN HERE *) admit.
bdestruct (x <=? a).
*
destruct (select x al) eqn:?H.
 (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars (selection_sort_sorted)  *)
Lemma selection_sort_sorted_aux:
  forall  y bl,
   sorted (selsort bl (length bl)) ->
   Forall (fun z : nat => y <= z) bl ->
   sorted (y :: selsort bl (length bl)).
Proof.
 (* Hint: no induction needed.  Use lemmas selsort_perm and Forall_perm.*)
 (* FILL IN HERE *) Admitted.

Theorem selection_sort_sorted: forall al, sorted (selection_sort al).
Proof.
intros.
unfold selection_sort.
(* Hint: do induction on the [length] of al.
    In the inductive case, use [select_smallest], [select_perm],
    and [selection_sort_sorted_aux]. *)
 (* FILL IN HERE *) Admitted.
(** [] *)

(** Now we wrap it all up.  *)

Theorem selection_sort_is_correct: selection_sort_correct.
Proof.
split. apply selection_sort_perm. apply selection_sort_sorted.
Qed.

(* ################################################################# *)
(** * Recursive functions that are not structurally recursive *)

(** [Fixpoint] in Coq allows for recursive functions where some
  parameter is structurally recursive: in every call, the argument
  passed at that parameter position is an immediate substructure
  of the corresponding formal parameter.  For recursive functions
  where that is not the case -- but for which you can still prove
  that they terminate -- you can use a more advanced feature of
  Coq, called [Function]. *)

Require Import Recdef.  (* needed for [Function] feature *)

Function selsort' l {measure length l} :=
match l with
| x::r => let (y,r') := select x r
               in y :: selsort' r'
| nil => nil
end.

(** When you use [Function] with [measure], it's your
  obligation to prove that the measure actually decreases,
  before you can use the function. *)

Proof.
intros.
pose proof (select_perm x r).
rewrite teq0 in H.
apply Permutation_length in H.
simpl in *; omega.
Defined.  (* Use [Defined] instead of [Qed], otherwise you
  can't compute with the function in Coq. *)

(** **** Exercise: 3 stars (selection_sort'_perm)  *)
Lemma selsort'_perm:
  forall n,
  forall l, length l = n -> Permutation l (selsort' l).
Proof.

(** NOTE: If you wish, you may [Require Import Multiset]
  and use the  multiset method, along with the
  theorem [same_contents_iff_perm]. *)

(** Important!  Don't unfold [selsort'], or in general, never
  unfold anything defined with [Function]. Instead, use the
  recursion equation [selsort'_equation] that is automatically
  defined by the [Function] command. *)

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

Eval compute in selsort' [3;1;4;1;5;9;2;6;5].

(** $Date: 2017-05-18 12:44:19 -0400 (Thu, 18 May 2017) $ *)


Require Export Tactics.

Theorem plus_2_2_is_4 :
  2+2=4.
Proof. reflexivity. Qed.

Definition plus_fact : Prop := 2 + 2 = 4.
Check plus_fact.

Theorem plus_fact_is_true : plus_fact.
Proof. reflexivity. Qed.

Definition  is_three (n : nat) : Prop := n = 3.
Check is_three.

Definition injective {A B} (f : A -> B) :=
  forall x y : A, f x = f y -> x = y.

Lemma succ_inj : injective S.
Proof.
  intros n m H. inversion H. reflexivity.
Qed.

Example and_example : 3 + 4 = 7 /\ 2*2 = 4.
Proof.
  split.
  - (* 3 + 4 = 7 *) reflexivity.
  - (* 2 + 2 = 4 *) reflexivity.
Qed.

Lemma and_intro : forall A B : Prop, A -> B -> A /\ B.
Proof.
  intros A B HA HB. split.
  - apply HA.
  - apply HB.
Qed.

Example and_example' : 3 + 4 = 7 /\ 2 * 2 = 4.
Proof.
  apply and_intro.
  - (* 3 + 4 = 7 *) reflexivity.
  - (* 2 * 2 = 4 *) reflexivity.
Qed.

Example and_exercise :
  forall n m : nat, n + m = 0 -> n = 0 /\ m = 0.
Proof.
  intros n m H.
  apply and_intro.
  - (* n = 0 *) induction n as [| n'].
    + reflexivity.
    + inversion H.
  - (* m = 0 *) induction m as [| m'].
    + reflexivity.
    + rewrite plus_comm in H. inversion H.
Qed.

Lemma and_example2 :
  forall n m : nat , n = 0 /\ m = 0 -> n + m = 0.
Proof.
  intros n m H.
  destruct H as [Hn Hm].
  rewrite Hn. rewrite Hm.
  reflexivity.
Qed.

Lemma and_example2' :
  forall n m : nat, n = 0 /\ m = 0 -> n + m = 0.
Proof.
  intros n m [Hn Hm].
  rewrite Hn. rewrite Hm.
  reflexivity.
Qed.

Lemma and_example2'' :
  forall n m : nat, n = 0 -> m = 0 -> n + m = 0.
Proof.
  intros n m Hn Hm.
  rewrite Hn. rewrite Hm.
  reflexivity.
Qed.

Lemma and_example3 :
  forall n m : nat, n + m = 0 -> n * m = 0.
Proof.
  intros n m H.
  assert (H' : n = 0 /\ m = 0).
  { apply and_exercise. apply H. }
  destruct H' as [Hn Hm].
  rewrite Hn. reflexivity.
Qed.

Lemma proj1 : forall P Q : Prop,
    P /\ Q -> P.
Proof.
  intros P Q [HP HQ].
  apply HP. Qed.

Lemma proj2 : forall P Q : Prop,
    P /\ Q -> Q.
Proof.
  intros P Q [HP HQ].
  apply HQ.
Qed.

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

Theorem and_assoc : forall P Q R : Prop,
    P /\ (Q /\ R) -> (P /\ Q) /\ R.
Proof.
  intros P Q R [HP [HQ HR]].
  split.
  - split.
    + apply HP.
    + apply HQ.
  - apply HR.
Qed.

Lemma or_example :
  forall n m : nat, n = 0 \/ m = 0 -> n * m = 0.
Proof.
  intros n m [Hn | Hm].
  - (* n = 0 *)
    rewrite Hn. reflexivity.
  - (* m = 0 *)
    rewrite Hm. rewrite <- mult_n_O.
    reflexivity.
Qed.

Lemma or_intro : forall A B : Prop, A -> A \/ B.
Proof.
  intros A B HA.
  left.
  apply HA.
Qed.

Lemma zero_or_succ :
  forall n : nat, n = 0 \/ n = S (pred n).
Proof.
  intros [|n].
  - left. reflexivity.
  - right. reflexivity.
Qed.

Lemma mult_eq_0 :
  forall n m, n * m = 0 -> n = 0 \/ m = 0.
Proof.
  intros [| n].
  - intros m H. rewrite mult_0_l in H. left. apply H.
  - intros [| m].
    + right. reflexivity.
    + intros H. inversion H.
Qed.

Theorem or_commut : forall P Q : Prop,
    P \/ Q -> Q \/ P.
Proof.
  intros P Q [HP | HQ].
  - right. apply HP.
  - left. apply HQ.
Qed.

Module MyNot.

Definition not (P:Prop) := P -> False.

(*Notation "¬ x" := (not x) : type_scope.*)

Check not.

End MyNot.

Theorem ex_falso_quodlibet : forall (P:Prop),
    False -> P.
Proof.
  intros P contra.
  destruct contra.
Qed.

Fact not_implies_our_not : forall (P:Prop),
  (not P) -> (forall (Q:Prop), P -> Q).
Proof.
  intros.
  apply ex_falso_quodlibet. apply H. assumption.
Qed.

Theorem zero_not_one : ~(0 = 1).
Proof.
  intros contra. inversion contra.
Qed.

Check (0 <> 1).

Theorem zero_not_one' : 0 <> 1.
Proof.
  intros H. inversion H.
Qed.

Theorem not_False :
  ~ False.
Proof.
  unfold not. intros H. destruct H. Qed.

Theorem contradiction_implies_anything : forall P Q : Prop,
    (P /\ ~P) -> Q.
Proof.
  intros P Q [HP HNA]. unfold not in HNA.
  apply HNA in HP. destruct HP.
Qed.

Theorem double_neg : forall P : Prop,
    P -> ~~P.
Proof.
  intros P H. unfold not. intros G. apply G. apply H.
Qed.

Theorem contrapositive : forall (P Q : Prop),
    (P -> Q) -> (~Q -> ~P).
Proof.
  intros P Q H H0.
  unfold not in H0.
  unfold not.
  intros P'.
  apply H0.
  apply H.
  apply P'.
Qed.

Theorem not_both_true_and_false : forall P : Prop, ~ (P /\ ~P).
Proof.
  intros.
  unfold not. intros H. destruct H.
  apply H0. assumption.
Qed.

Theorem not_true_is_false : forall b : bool,
    b <> true -> b = false.
Proof.
  intros [] H.
  - (* b = true *)
    unfold not in H.
    apply ex_falso_quodlibet.
    apply H. reflexivity.
  - (* b = false *)
    reflexivity.
Qed.

Theorem not_true_is_false' : forall b : bool,
    b <> true -> b = false.
Proof.
  intros [] H.
  - (* b = true *)
    unfold not in H.
    exfalso.
    apply H. reflexivity.
  - (* b = false *)
    reflexivity.
Qed.

Lemma True_is_true : True.
Proof.
  apply I.
Qed.

Module MyIff.

  Definition iff (P Q : Prop) := (P -> Q) /\ (Q -> P).

  Notation "P <-> Q" := (iff P Q)
                          (at level 95, no associativity)
                        : type_scope.
End MyIff.

Theorem iff_sym : forall P Q : Prop,
    (P <-> Q) -> (Q <-> P).
Proof.
  intros P Q [HAB HBA].
  split.
  - (* -> *) apply HBA.
  - (* <- *) apply HAB.
Qed.

Lemma not_true_iff_false : forall b,
  b <> true <-> b = false.
Proof.
  intros b. split.
  - (* -> *) apply not_true_is_false.
  - (* <- *)
    intros H. rewrite H. intros H'. inversion H'.
Qed.

Theorem iff_refl : forall P : Prop,
    P <-> P.
Proof.
  intros P.
  split.
  - (* P -> P *)
    intros H. apply H.
  - intros H. apply H.
Qed.

Theorem iff_trans : forall P Q R : Prop,
    (P <-> Q) -> (Q <-> R) -> (P <-> R).
Proof.
  split.
  - (* P -> R *)
    intros H1.
    apply H0.
    apply H.
    assumption.
  - (* R -> P *)
    intros H1.
    apply H.
    apply H0.
    assumption.
Qed.

Theorem or_distributes_over_and : forall P Q R: Prop,
    P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R).
Proof.
  split.
  - (* -> *)
    intros H. inversion H.
    + split.
      { left. apply H0. }
      { left. apply H0. }
    + split.
      { right. apply H0. }
      { right. apply H0. }
  - (* <- *)
    intros H. inversion H.
    + destruct H1.
      { left. apply H1. }
      { destruct H0.
        - left. apply H0.
        - right. split.
          + apply H0.
          + apply H1. }
Qed.

Require Import Coq.Setoids.Setoid.

Lemma mult_0 : forall n m, n * m = 0 <-> n=0 \/ m=0.
Proof.
  split.
  - apply mult_eq_0.
  - apply or_example.
Qed.

Lemma or_assoc :
  forall P Q R : Prop, P \/ (Q \/ R) <-> (P \/ Q) \/ R.
Proof.
  intros P Q R. split.
  - intros [H | [H | H]].
    + left. left. apply H.
    + left. right. apply H.
    + right. apply H.
  - intros [[H | H] | H].
    + left. apply H.
    + right. left. apply H.
    + right. right. apply H.
Qed.

Lemma mult_0_3 :
  forall n m p, n*m*p = 0 <-> n = 0 \/ m = 0 \/ p = 0.
Proof.
  intros n m p.
  rewrite mult_0. rewrite mult_0. rewrite or_assoc.
  reflexivity.
Qed.

Lemma apply_iff_example :
  forall n m: nat, n * m = 0 -> n = 0 \/ m = 0.
Proof.
  intros n m H. apply mult_0. apply H.
Qed.

Lemma four_is_even: exists n :nat , 4 = n + n.
Proof.
  exists 2. reflexivity.
Qed.

Theorem exists_example_2 : forall n,
    (exists m, n = 4 + m) -> (exists o, n = 2 + o).
Proof.
  intros n [m Hm].
  exists (2+m).
  apply Hm.
Qed.

Theorem dist_not_exists: forall (X:Type) (P : X-> Prop),
    (forall x, P x) -> ~(exists x, ~ P x).
Proof.
  intros.
  intros x.
  destruct x.
  apply H0.
  apply H.
Qed.

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.
  - (*->*) intros H. destruct H as [X' H]. destruct H as [HP | HQ].
    + left. exists X'. apply HP.
    + right. exists X'. apply HQ.
  - (*<-*) intros H. destruct H as [HP | HQ].
    + destruct HP as [X' HP]. exists X'. left. apply HP.
    + destruct HQ as [X' HQ]. exists X'. right. apply HQ.
Qed.

Fixpoint In {A : Type} (x : A) (l : list A) : Prop :=
  match l with
  | [] => False
  | x' :: l' => x' = x \/ In x l'
  end.

Example In_example_1 : In 4 [1; 2; 3; 4; 5].
Proof.
  simpl. right. right. right. left. reflexivity.
Qed.

Example In_example_2 : forall n,
    In n [2; 4] -> exists n', n = 2 * n'.
Proof.
  simpl.
  intros n [H | [H | []]].
  - exists 1. rewrite <- H. reflexivity.
  - exists 2. rewrite <- H. reflexivity.
Qed.

Lemma In_map :
  forall (A B : Type) (f : A -> B) (l : list A) (x : A),
    In x l ->
    In (f x) (map f l).
Proof.
  intros A B f l x.
  induction l as [| x' l' IHl' ].
  - (* l = nil, contradiction *)
    simpl. intros [].
  - (* l = x' :: l' *)
    simpl. intros [H | H].
    + rewrite H. left. reflexivity.
    + right. apply IHl'. apply H.
Qed.

Lemma In_map_iff :
  forall (A B : Type) (f : A -> B) (l : list A) (y : B),
    In y (map f l) <->
    exists x, f x = y /\ In x l.
Proof.
  intros A B f l y. split.
  - (* -> *) intros H. induction l as [|x' l' IHl'].
    + (* l = nil, contradiction *)
      simpl in H. contradiction.
    + (* l = x' :: l' *)
      simpl in H. destruct H as [H1 | H2].
      { exists x'. split.
        - apply H1.
        - simpl. left. reflexivity. }
      { apply IHl' in H2. destruct H2 as [x2 H2]. exists x2. split.
        - apply proj1 in H2. apply H2.
        - simpl. right. apply proj2 in H2. apply H2. }
  - (* <- *) intros H. induction l as [| x' l' IHl'].
    + (* l = [] *)
      simpl in H. destruct H as [x' H]. apply proj2 in H. contradiction.
    + (* l = x' :: l' *)
      simpl. simpl in H. destruct H as [x'' H].
      inversion H. destruct H1 as [H2 | H3].
      { left. rewrite H2. apply H0. }
      { right. apply IHl'. exists x''. split.
        - apply H0.
        - apply H3. }
Qed.

Lemma in_app_iff : forall A l l' (a:A),
    In  a (l++l') <-> In a l \/ In a l'.
Proof.
  intros A l l'. split.
  - (* -> *)
    intros H. induction l.
    + simpl. simpl in H. right. apply H.
    + simpl. simpl in H. destruct H.
      { left. left. apply H. }
      { apply IHl in H. apply or_assoc. right. apply H. }
  - (* <- *)
    intros H. induction l.
    + simpl. simpl in H. destruct H.
      { contradiction. }
      { apply H. }
    + simpl. simpl in H. apply or_assoc in H. destruct H as [H1 | [H2 | H3]].
      { left. apply H1. }
      { right. apply IHl. left.  apply H2.
      } { right. apply IHl. right. apply H3. }
Qed.

Fixpoint All {T : Type} (P : T -> Prop) (l : list T) : Prop :=
  match l with
  | [] => True
  | h :: t => P h /\ All P t
  end.

Lemma All_In :
  forall T (P : T -> Prop) (l : list T),
    (forall x, In x l -> P x) <->
    All P l.
Proof.
  intros T P l. split.
  - (* -> *) intros H. induction l.
    + simpl. reflexivity.
    + simpl. split.
      { apply H. simpl. left. reflexivity. }
      { apply IHl. intros x0 H0. apply H. simpl. right. apply H0. }
  - (* <- *) intros H. induction l.
    + simpl. intros x0 H0. contradiction.
    + simpl. intros x0 H0. destruct H0 as [|H1 H2].
      { simpl in H. apply proj1 in H. rewrite H0 in H. apply H. }
      { simpl in H. apply proj2 in H.
        apply IHl with x0 in H. apply H. apply H1. }
Qed.

Definition combine_odd_even (Podd Peven : nat -> Prop) : nat -> Prop :=
  fun (n : nat) =>  if oddb n then Podd n else Peven n.

Theorem combine_odd_even_intro :
  forall (Podd Peven : nat -> Prop) (n : nat),
    (oddb n = true -> Podd n) ->
    (oddb n = false -> Peven n) ->
    combine_odd_even Podd Peven n.
Proof.
  intros Podd Peven n Hodd Heven.
  unfold combine_odd_even. destruct (oddb n) eqn: H.
  - apply Hodd. reflexivity.
  - apply Heven. reflexivity.
Qed.

Theorem combine_odd_even_elim_odd :
  forall (Podd Peven : nat -> Prop) (n : nat),
    combine_odd_even Podd Peven n ->
    oddb n = true ->
    Podd n.
Proof.
  intros Podd Peven n Hcomb Hodd.
  unfold combine_odd_even in Hcomb.
  rewrite Hodd in Hcomb. assumption.
Qed.

Theorem combine_odd_even_elim_even :
  forall (Podd Peven : nat -> Prop) (n : nat),
    combine_odd_even Podd Peven n ->
    oddb n = false ->
    Peven n.
Proof.
  intros Podd Peven n Hcomb Heven.
  unfold combine_odd_even in Hcomb.
  rewrite Heven in Hcomb. assumption.
Qed.

Lemma plus_comm3 :
  forall n m p, n + (m + p) = (p + m) + n.
Proof.
  intros n m p.
  rewrite plus_comm.
  assert (H : m + p = p + m).
  { rewrite plus_comm. reflexivity. }
  rewrite H.
  reflexivity.
Qed.

Lemma plus_comm3_take3 :
  forall n m p, n + (m + p) = (p + m) + n.
Proof.
  intros n m p.
  rewrite plus_comm.
  rewrite (plus_comm m).
  reflexivity.
Qed.

Example lemma_application_ex :
  forall {n : nat} {ns : list nat},
    In n (map (fun m => m * 0) ns) ->
    n = 0.
Proof.
  intros n ns H.
  destruct (proj1 _ _ ( In_map_iff _ _ _ _ _) H)
    as [m [Hm _]].
  rewrite mult_0_r in Hm. rewrite <- Hm. reflexivity.
Qed.

Axiom functional_extensionality :
  forall {X Y : Type}
         {f g : X -> Y},
    (forall (x:X) , f x = g x) -> f = g.

Example funtion_equality_ex2 :
  (fun x => plus x 1) = (fun x => plus 1 x).
Proof.
  apply functional_extensionality. intros x.
  apply plus_comm.
Qed.

Fixpoint rev_append {X} (l1 l2 : list X) : list X :=
  match l1 with
  | [] => l2
  | x :: l1' => rev_append l1' (x :: l2)
  end.

Definition tr_rev {X} (l : list X) : list X :=
  rev_append l [].

Theorem app_nil_l : forall(X:Type), forall l:list X,
      [] ++ l = l.
Proof.
  reflexivity.
Qed.

Lemma tr_rev_correct : forall X, @tr_rev X = @rev X.
Proof.
  intros X. apply functional_extensionality.
  intros x. induction x as [|x' lx].
  - simpl. unfold tr_rev. simpl. reflexivity.
  - simpl.
    rewrite <- IHlx. simpl tr_rev.
    unfold tr_rev. simpl rev_append.
Abort.
 (* rev_append lx [ ] = rev lx
          I think this is the problem. *)

Theorem evenb_double : forall k, evenb (double k) = true.
Proof.
  intros k. induction k as [| k' IHk'].
  - reflexivity.
  - simpl. apply IHk'.
Qed.

Theorem evenb_double_conv : forall n,
    exists k , n = if evenb n then double k
                   else S (double k).
(* for any n in N there exists k s.t. k = 2n or k = 2n+1. *)
Proof.
  intros n. induction n as [|n' IHn'].
  - simpl. exists 0. simpl. reflexivity.
  - destruct (evenb n') eqn: Heq.
    + rewrite evenb_S. rewrite Heq. simpl. destruct IHn' as [n'' IHn'].
      exists n''. rewrite IHn'. reflexivity.
    + rewrite evenb_S. rewrite Heq. simpl. destruct IHn' as [n'' IHn'].
      exists (n'' + 1). rewrite IHn'. rewrite double_plus. rewrite double_plus.
      rewrite plus_n_Sm. rewrite <- plus_1_l. rewrite <- plus_n_Sm.
      rewrite <- (plus_1_l (n'' + n'')). rewrite plus_comm.
      rewrite plus_assoc. rewrite (plus_comm 1).
      rewrite plus_assoc. reflexivity.
Qed.

Theorem even_bool_prop : forall n,
    evenb n = true <-> exists k, n = double k.
Proof.
  intros n. split.
  - intros H. destruct (evenb_double_conv n) as [k Hk].
    rewrite Hk. rewrite H. exists k. reflexivity.
  - intros [k Hk]. rewrite Hk. apply evenb_double.
Qed.

Theorem beq_nat_true_iff : forall n1 n2 : nat,
    beq_nat n1 n2 = true <-> n1 = n2.
Proof.
  intros n1 n2. split.
  - apply beq_nat_true.
  - intros H. rewrite H. rewrite <- beq_nat_refl. reflexivity.
Qed.

Example even_1000 : exists k, 1000 = double k.
Proof. exists 500. reflexivity. Qed.

Example even_1000' : evenb 1000 = true.
Proof. reflexivity. Qed.

Example even_1000'' : exists k, 1000 = double k.
Proof. apply even_bool_prop. reflexivity. Qed.

Lemma andb_true_iff : forall b1 b2 : bool,
    b1 && b2 = true <-> b1 = true /\ b2 = true.
Proof.
  intros b1 b2. split.
  - (* -> *) intros H. split.
    + rewrite andb_commutative in H. apply andb_true_elim2 in H. apply H.
    + apply andb_true_elim2 in H. apply H.
  - (* <- *) intros H. inversion H. rewrite H0. rewrite H1. reflexivity.
Qed.

Lemma orb_true_iff : forall b1 b2,
    b1 || b2 = true <-> b1 = true \/ b2 = true.
Proof.
  intros b1 b2. split.
  - (* -> *) intros H.
    destruct b1.
    + simpl. left. reflexivity.
    + simpl. right. assumption.
  - (* <- *) intros H.
    destruct H as [H1 | H2].
    + rewrite H1. simpl. reflexivity.
    + rewrite H2. destruct b1.
      { reflexivity. }
      { reflexivity. }
Qed.

Theorem beq_nat_false_iff : forall x y : nat,
    beq_nat x y = false <-> x <> y.
Proof.
  intros x y. unfold not. split.
  - (* -> *) intros H0 H1. apply beq_nat_true_iff in H1.
    rewrite H1 in H0. inversion H0.
  - (* <- *) intros H.
    induction x as [| x'].
    + induction y as [| y'].
      { simpl. exfalso. apply H. reflexivity. }
      { generalize dependent y'. reflexivity. }
    + induction y as [| y'].
      { simpl. reflexivity. }
      { simpl. destruct (beq_nat x' y') eqn:Heq.
        - exfalso. apply H. apply f_equal. apply beq_nat_true_iff. apply Heq.
        - reflexivity. }
Qed.

Fixpoint beq_list {A : Type} (beq : A -> A -> bool)
         (l1 l2 : list A) : bool :=
  match l1,l2 with
  | [] , [] => true
  | [] , _ => false
  | _ , [] => false
  | h1 :: t1, h2 :: t2 => (andb (beq h1 h2) (beq_list beq t1 t2))
  end.

Lemma beq_list_true_iff :
  forall A (beq : A -> A -> bool),
    (forall a1 a2, beq a1 a2 = true <-> a1 = a2) ->
    forall l1 l2, beq_list beq l1 l2 = true <-> l1 = l2.
Proof.
  intros A beq H l1 l2. split.
  - (* -> *) generalize dependent l2.
    induction l1 as [| h1 l1' IHl1].
    + induction l2 as [| h2 l2' IHl2].
      { simpl. reflexivity. }
      { simpl. intros H1. inversion H1. }
    + induction l2 as [| h2 l2' IHl2].
      { simpl. intros H1. inversion H1. }
      { simpl. intros H1. destruct (beq h1 h2) eqn:Heq.
        + apply H in Heq. rewrite <- Heq.
          assert (l1' = l2' -> h1 :: l1' = h1 :: l2') as H2.
          { intros H3. rewrite H3. reflexivity. }
          apply H2. apply IHl1. apply H1.
        + inversion H1. }
  - (* <- *) generalize dependent l2.
    induction l1 as [| h1 l1' IHl1'].
    + induction l2 as [| h2 l2' IHl2'].
      { simpl. reflexivity. }
      { simpl. intros H1. inversion H1. }
    + induction l2 as [| h2 l2' IHl2'].
      { simpl. intros H1. inversion H1. }
      { simpl. intros H1. destruct (beq h1 h2) eqn:Heq.
        + apply IHl1'. apply H in Heq. rewrite Heq in H1.
          assert (h1 :: l1' = h1 :: l2' -> l1' = l2') as H2.
          { intros H3. inversion H1. reflexivity. }
          apply H2. rewrite Heq. apply H1.
        + inversion H1. apply H in H2. rewrite H2 in Heq. symmetry. apply Heq. }
Qed.

Fixpoint forallb {X : Type} (test : X -> bool) (l : list X) : bool :=
  match l with
  | [] => true
  | x :: l' => andb (test x) (forallb test l')
  end.

Theorem forallb_true_iff : forall X test (l : list X),
    forallb test l = true <-> All (fun x => test x = true) l.
Proof.
Abort.

Definition excluded_middle := forall P : Prop,
    P \/ ~P.

Theorem restricted_excluded_middle : forall P b,
    (P <-> b = true) -> P \/ ~P.
Proof.
  intros P [] H.
  - left. rewrite H. reflexivity.
  - right. rewrite H. intros contra. inversion contra.
Qed.

Theorem restricted_excluded_middle_eq : forall (n m : nat),
    n = m \/ n <> m.
Proof.
  intros n m.
  apply (restricted_excluded_middle (n=m) (beq_nat n m)).
  symmetry.
  apply beq_nat_true_iff.
Qed.

Theorem excluded_middle_irrefutable: forall (P : Prop),
    ~~(P \/ ~P).
Proof.
  unfold not. intros P H. apply H.
  right. intros. apply H. left. apply H0.
Qed.


Require Import Arith.
Require Import Omega.
Require Import Psatz.

Require Import kernel_numeric.

(**
Sum properties for proving graph theorems.
**)

Lemma sum_i_to_n (n : nat) :
  2 * sum' n (fun i => i) = n * (n - 1).
Proof.
  induction n.
  - auto.
  - simpl_sum.
    set (y := sum' n (fun x => x)) in *.
    ring_simplify.
    ring_simplify in IHn.
    rewrite IHn.
    nia.
Qed.

Lemma sum_sum_n (n : nat) :
  2 * sum' n (fun x => sum' x (fun y => 1)) = n * (n - 1).
Proof.
  replace (sum' n (fun x => sum' x (fun y => 1))) with
  (sum' n (fun x => x)).
  - apply sum_i_to_n.
  - apply change_sum'.
    intros j p.
    rewrite sum_n_krat_1.
    + auto.
    + auto.  (* Kaj je to?? *)
Qed.

Theorem zero_is_not_succ (n k l : nat):
    (sum' n (fun y : nat => (if Nat.eq_dec 0 (S y) then k else l))) = n * l.
Proof.
  rewrite (same_sum' n l).
  - auto.
  - intros j p.
    destruct (Nat.eq_dec 0 (S j)); omega.
Qed.

Theorem end_is_not_included (n k l : nat):
    (sum' n (fun y : nat => (if Nat.eq_dec n y then k else l))) = n * l.
Proof.
  rewrite (same_sum' n l).
  - auto.
  - intros j p.
    destruct (Nat.eq_dec n j); omega.
Qed.

Theorem nat_eq_dec_reverse (n k l x : nat):
  (sum' n (fun y : nat => (if Nat.eq_dec x y then k else l))) =
  (sum' n (fun y : nat => (if Nat.eq_dec y x then k else l))).
Proof.
  apply change_sum.
  intros j p.
  destruct (Nat.eq_dec x j); destruct (Nat.eq_dec j x); omega.
Qed.

Theorem sum_succ_transformation (n k l x: nat) (p: 0 < x < 1 + n):
  sum' n (fun y : nat => if Nat.eq_dec x (S y) then 1 else 0) =
  sum' n (fun y : nat => if Nat.eq_dec (x - 1) y then 1 else 0).
Proof.
  apply change_sum.
  intros j q.
  destruct (Nat.eq_dec x (S j)); destruct (Nat.eq_dec (x - 1) j); omega.
Qed.

Theorem one_is_found (x y : nat) (p : y < x):
  sum' x (fun x0 : nat => if Nat.eq_dec y x0 then 1 else 0) = 1.
Proof.
  induction x.
  - omega.
  - rewrite sum'_S.
    destruct (Nat.eq_dec y x).
    + assert (sum' x (fun x0 : nat => if Nat.eq_dec y x0 then 1 else 0) =
              sum' x (fun x0 : nat => 0)).
      * apply change_sum.
        intros j q.
        destruct (Nat.eq_dec y j); auto; omega.
      * rewrite (sum_n_krat_k x 0) in H.
        rewrite H.
        omega.
    + rewrite IHx; omega.
Qed.

Theorem one_is_found_general_rv (x y k l : nat) (p : y < x):
  sum' x (fun x0 : nat => if Nat.eq_dec x0 y then k else l) = k + (x - 1) * l.
Proof.
  induction x.
  - omega.
  - rewrite sum'_S.
    destruct (Nat.eq_dec x y).
    + assert (sum' x (fun x0 : nat => if Nat.eq_dec x0 y then k else l) =
              sum' x (fun x0 : nat => l)).
      * apply change_sum.
        intros j q.
        destruct (Nat.eq_dec j y); auto; omega.
      * rewrite (sum_n_krat_k x l) in H.
        rewrite H.
        replace (S x - 1) with x; omega.
    + rewrite IHx.
      (* lia ne zna *)
      (* nia pa zna ze tu*)
      (* seveda to je nelinearna enacba :) ... ne vem zakaj sem spregledal *)
      * nia.
      * omega.
Qed.

Theorem one_is_found_general (x y k l : nat) (p : y < x):
  sum' x (fun x0 : nat => if Nat.eq_dec y x0 then k else l) = k + (x - 1) * l.
Proof.
  (*
  assert (k + (x - 1) * l =
          sum' x (fun x0 : nat => if Nat.eq_dec x0 y then k else l)) as A.
  - rewrite (one_is_found_general_rv); auto.
  - rewrite A.
    apply change_sum.
    intros j q.
    destruct (Nat.eq_dec y j); destruct (Nat.eq_dec j y); omega.
  *)
  rewrite nat_eq_dec_reverse.
  apply one_is_found_general_rv; auto.
Qed.

Theorem one_is_found_rv (x y : nat) (p : y < x):
  sum' x (fun x0 : nat => if Nat.eq_dec x0 y then 1 else 0) = 1.
Proof.
  rewrite (one_is_found_general_rv x y 1 0 p).
  omega.
Qed.


Require Export induction.
Require Export basics.

Module NatList.

Inductive natprod : Type :=
  | pair (n_1 n_2 : nat).

Definition fst (p : natprod) : nat :=
  match p with
  | pair x y => x
  end.
Definition snd (p : natprod) : nat :=
  match p with
  | pair x y => y
  end.

Notation "( x , y )" := (pair x y).

Definition swap_pair (p : natprod) : natprod :=
  match p with
  | (x,y) => (y,x)
  end.

Theorem surjective_pairing : forall (p : natprod),
  p = (fst p, snd p).
Proof.
  intros p.
  destruct p as [n m].
    reflexivity.
Qed.

(* Exercise 1 *)
Theorem snd_fst_is_swap : forall (p : natprod),
  (snd p, fst p) = swap_pair p.
Proof.
  intro p.
  destruct p as [n m].
    reflexivity.
Qed.

(* Exercise 2 *)
Theorem fst_swap_is_snd : forall (p : natprod),
  fst (swap_pair p) = snd p.
Proof.
  intros p.
  destruct p as [n m].
    reflexivity.
Qed.

Inductive natlist : Type :=
  | nil
  | cons (n : nat) (l : natlist).

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

Fixpoint repeat (n count : nat) : natlist :=
  match count with
  | O => nil
  | S count' => n :: (repeat n count')
  end.

Fixpoint length (l : natlist) : nat :=
  match l with
  | nil => O
  | h :: t => S (length t)
  end.

Fixpoint app (l1 l2 : natlist) : natlist :=
  match l1 with
  | nil => l2
  | h :: t => h :: (app t l2)
  end.

Notation "x ++ y" := (app x y)
                     (right associativity, at level 60).

Definition hd (default : nat) (l : natlist) : nat :=
  match l with
  | nil => default
  | h :: t => h
  end.

Definition tl (l : natlist) : natlist :=
  match l with
  | nil => nil
  | h :: t => t
  end.

(* Exercise 3 *)
Fixpoint nonzeros (l : natlist) : natlist :=
  match l with
  | nil => nil
  | O :: t => nonzeros t
  | a :: t => a :: nonzeros t
  end.

Example test_nonzeros:
  nonzeros [0;1;0;2;3;0;0] = [1;2;3].
Proof. reflexivity. Qed.

Fixpoint oddmembers (l : natlist) : natlist :=
  match l with
  | nil => nil
  | a :: t =>
    if oddb a then
      a :: oddmembers t
    else
      oddmembers t
  end.

Example test_oddmembers:
  oddmembers [0;1;0;2;3;0;0] = [1;3].
Proof. reflexivity. Qed.

Definition countoddmembers (l : natlist) : nat :=
  length (oddmembers l).

Example test_countoddmembers1:
  countoddmembers [1;0;3;1;4;5] = 4.
Proof. reflexivity. Qed.

Example test_countoddmembers2:
  countoddmembers [0;2;4] = 0.
Proof. reflexivity. Qed.

Example test_countoddmembers3:
  countoddmembers nil = 0.
Proof. reflexivity. Qed.

(* Exercise 4 *)
Fixpoint alternate (l1 l2 : natlist) : natlist :=
  match l1, l2 with
  | nil, l2 => l2
  | l1, nil => l1
  | a :: t1, b :: t2 => a :: b :: alternate t1 t2
  end.

Example test_alternate1:
  alternate [1;2;3] [4;5;6] = [1;4;2;5;3;6].
Proof. reflexivity. Qed.

Example test_alternate2:
  alternate [1] [4;5;6] = [1;4;5;6].
Proof. reflexivity. Qed.

Example test_alternate3:
  alternate [1;2;3] [4] = [1;4;2;3].
Proof. reflexivity. Qed.

Example test_alternate4:
  alternate [] [20;30] = [20;30].
Proof. reflexivity. Qed.

(* Exercise 5 *)
Definition bag := natlist.

Fixpoint count (v:nat) (s:bag) : nat :=
  match s with
  | nil => 0
  | a :: t =>
    if a =? v then
      1 + count v t
    else
      count v t
  end.

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

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

Definition sum: bag -> bag -> bag := app.

Example test_sum1: count 1 (sum [1;2;3] [1;4;1]) = 3.
Proof. reflexivity. Qed.

Definition add : nat -> bag -> bag := cons.

Example test_add1: count 1 (add 1 [1;4;1]) = 3.
Proof. reflexivity. Qed.

Example test_add2: count 5 (add 1 [1;4;1]) = 0.
Proof. reflexivity. Qed.

Definition member (v : nat) (s : bag) : bool :=
  negb (count v s =? 0).

Example test_member1: member 1 [1;4;1] = true.
Proof. reflexivity. Qed.

Example test_member2: member 2 [1;4;1] = false.
Proof. reflexivity. Qed.

(* Exercise 6 *)
Fixpoint remove_one (v : nat) (s : bag) : bag :=
  match s with
  | nil => nil
  | a :: t =>
     if a =? v then
        t
      else
        a :: remove_one v t
  end.

Example test_remove_one1:
  count 5 (remove_one 5 [2;1;5;4;1]) = 0.
Proof. reflexivity. Qed.

Example test_remove_one2:
  count 5 (remove_one 5 [2;1;4;1]) = 0.
Proof. reflexivity. Qed.

Example test_remove_one3:
  count 4 (remove_one 5 [2;1;4;5;1;4]) = 2.
Proof. reflexivity. Qed.

Example test_remove_one4:
  count 5 (remove_one 5 [2;1;5;4;5;1;4]) = 1.
Proof. reflexivity. Qed.

Fixpoint remove_all (v : nat) (s : bag) : bag :=
  match s with
  | nil => nil
  | a :: t =>
     if a =? v then
        remove_all v t
      else
        a :: remove_all v t
  end.

Example test_remove_all1: count 5 (remove_all 5 [2;1;5;4;1]) = 0.
Proof. reflexivity. Qed.

Example test_remove_all2: count 5 (remove_all 5 [2;1;4;1]) = 0.
Proof. reflexivity. Qed.

Example test_remove_all3: count 4 (remove_all 5 [2;1;4;5;1;4]) = 2.
Proof. reflexivity. Qed.

Example test_remove_all4: count 5 (remove_all 5 [2;1;5;4;5;1;4;5;1;4]) = 0.
Proof. reflexivity. Qed.

Fixpoint subset (s1 : bag) (s2 : bag) : bool :=
  match s1 with
  | nil => true
  | a :: t =>
    if member a s2 then
      subset t (remove_one a s2)
    else
      false
  end.

Example test_subset1: subset [1;2] [2;1;4;1] = true.
Proof. reflexivity. Qed.

Example test_subset2: subset [1;2;2] [2;1;4;1] = false.
Proof. reflexivity. Qed.

(* Exercise 7 *)

Lemma bag_subset_common: forall (b1 b2 : bag) (a : nat),
  (subset b1 b2 = true) -> (subset (a :: b1) (a :: b2) = true).
Proof.
  intros b1 b2 a H.
  simpl. unfold member. unfold count.

  assert (H2 : forall n : nat, n =? n = true). {
    intros n. induction n as [| n' IH].
    - reflexivity.
    - simpl. rewrite -> IH. reflexivity.
  }

  rewrite -> (H2 a).
  simpl.
  rewrite -> H.
  reflexivity.
Qed.

Theorem bag_self_subset: forall b : bag,
  subset b b = true.
Proof.
  intros b.
  induction b as [| a t IH].
  - reflexivity.
  - rewrite -> (bag_subset_common t t a IH).
    reflexivity.
Qed.

Theorem nil_app : forall l : natlist,
  [] ++ l = l.
Proof. reflexivity. Qed.

Theorem tl_length_pred : forall l : natlist,
  pred (length l) = length (tl l).
Proof.
  intros l. destruct l as [| n l'].
  - (* l = nil *)
    reflexivity.
  - (* l = cons n l' *)
    reflexivity.
Qed.

Theorem app_assoc : forall l1 l2 l3 : natlist,
  (l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3).
Proof.
  intros l1 l2 l3. induction l1 as [| n l1' IHl1'].
  - (* l1 = nil *)
    reflexivity.
  - (* l1 = cons n l1' *)
    simpl. rewrite -> IHl1'. reflexivity.
Qed.

Fixpoint rev (l : natlist) : natlist :=
  match l with
  | nil => nil
  | h :: t => rev t ++ [h]
  end.

Example test_rev1: rev [1;2;3] = [3;2;1].
Proof. reflexivity. Qed.

Example test_rev2: rev nil = nil.
Proof. reflexivity. Qed.

Theorem app_length : forall l1 l2 : natlist,
  length (l1 ++ l2) = (length l1) + (length l2).
Proof.
  (* WORKED IN CLASS *)
  intros l1 l2. induction l1 as [| n l1' IHl1'].
  - (* l1 = nil *)
    reflexivity.
  - (* l1 = cons *)
    simpl. rewrite -> IHl1'. reflexivity.
Qed.

Theorem rev_length_firsttry : forall l : natlist,
  length (rev l) = length l.
Proof.
  intros l. induction l as [| n l' IHl'].
  - (* l =  *)
    reflexivity.
  - (* l = n :: l' *)
    simpl. rewrite -> app_length, plus_comm.
    simpl. rewrite -> IHl'.
    reflexivity.
Qed.

(* Exercise 8 *)
Theorem app_nil_r : forall l : natlist,
  l ++ [] = l.
Proof.
  induction l as [| a l' IH].
  - reflexivity.
  - simpl.
    rewrite -> IH.
    reflexivity.
Qed.

Theorem rev_app_distr: forall l1 l2 : natlist,
  rev (l1 ++ l2) = rev l2 ++ rev l1.
Proof.
  intros l1 l2.
  induction l1 as [| a l' IH].
  - rewrite -> app_nil_r. reflexivity.
  - simpl. rewrite -> IH. rewrite -> app_assoc.
    reflexivity.
Qed.

Theorem rev_involutive : forall l : natlist,
  rev (rev l) = l.
Proof.
  induction l as [| a l' IH].
  - reflexivity.
  - simpl. rewrite -> rev_app_distr. simpl. rewrite -> IH.
    reflexivity.
Qed.

Theorem app_assoc4 : forall l1 l2 l3 l4 : natlist,
  l1 ++ (l2 ++ (l3 ++ l4)) = ((l1 ++ l2) ++ l3) ++ l4.
Proof.
  intros l1 l2 l3 l4.
  rewrite <- app_assoc.
  rewrite -> (app_assoc (l1 ++ l2) l3 l4).
  reflexivity.
Qed.

Lemma nonzeros_app : forall l1 l2 : natlist,
  nonzeros (l1 ++ l2) = (nonzeros l1) ++ (nonzeros l2).
Proof.
  intros l1 l2.
  induction l1 as [| a l' IH].
  - reflexivity.
  - simpl. rewrite -> IH. destruct a.
    + reflexivity.
    + reflexivity.
Qed.

Fixpoint eqblist (l1 l2 : natlist) : bool :=
  match l1, l2 with
  | nil, nil => true
  | nil, l2 => false
  | l1, nil => false
  | a :: l1', b :: l2' =>
    if a =? b then eqblist l1' l2'
    else false
  end.

Example test_eqblist1 :
  (eqblist nil nil = true).
Proof. reflexivity. Qed.

Example test_eqblist2 :
  eqblist [1;2;3] [1;2;3] = true.
Proof. reflexivity. Qed.

Example test_eqblist3 :
  eqblist [1;2;3] [1;2;4] = false.
Proof. reflexivity. Qed.

Theorem eqblist_refl : forall l : natlist,
  true = eqblist l l.
Proof.
  induction l as [| a l' IH].
  - reflexivity.
  - simpl. rewrite -> nat_equals_self. rewrite <- IH.
    reflexivity.
Qed.

Theorem count_member_nonzero : forall s : bag,
  1 <=? (count 1 (1 :: s)) = true.
Proof.
  intros s.
  reflexivity.
Qed.

Theorem leb_n_Sn : forall n,
  n <=? (S n) = true.
Proof.
  intros n. induction n as [| n' IHn'].
  - (* 0 *)
    simpl. reflexivity.
  - (* S n' *)
    simpl. rewrite IHn'. reflexivity.
Qed.

Theorem remove_does_not_increase_count: forall s : bag,
  (count 0 (remove_one 0 s)) <=? (count 0 s) = true.
Proof.
  induction s as [| a s' IH].
  - reflexivity.
  - destruct a.
    + simpl. rewrite -> leb_n_Sn. reflexivity.
    + simpl. rewrite -> IH. reflexivity.
Qed.

Theorem rev_injective : forall (l1 l2 : natlist),
  rev l1 = rev l2 -> l1 = l2.
Proof.
  intros l1 l2 H.
  rewrite <- rev_involutive.
  rewrite <- H.
  rewrite -> rev_involutive.
  reflexivity.
Qed.

Fixpoint nth_bad (l:natlist) (n:nat) : nat :=
  match l with
  | nil => 42 (* arbitrary! *)
  | a :: l' =>
    match n =? O with
    | true => a
    | false => nth_bad l' (pred n)
    end
  end.

Inductive natoption : Type :=
  | Some (n : nat)
  | None.

Fixpoint nth_error (l:natlist) (n:nat) : natoption :=
  match l with
  | nil => None
  | a :: l' =>
    match n =? O with
    | true => Some a
    | false => nth_error l' (pred n)
    end
  end.

Example test_nth_error1 : nth_error [4;5;6;7] 0 = Some 4.
Proof. reflexivity. Qed.
Example test_nth_error2 : nth_error [4;5;6;7] 3 = Some 7.
Proof. reflexivity. Qed.
Example test_nth_error3 : nth_error [4;5;6;7] 9 = None.
Proof. reflexivity. Qed.

Definition hd_error (l : natlist) : natoption :=
  match l with
  | nil => None
  | a :: _ => Some a
  end.

Example test_hd_error1 : hd_error [] = None.
Proof. reflexivity. Qed.
Example test_hd_error2 : hd_error [1] = Some 1.
Proof. reflexivity. Qed.
Example test_hd_error3 : hd_error [5;6] = Some 5.
Proof. reflexivity. Qed.

Definition option_elim (d : nat) (o : natoption) : nat :=
  match o with
  | Some n' => n'
  | None => d
  end.

Theorem option_elim_hd : forall (l : natlist) (default : nat),
  hd default l = option_elim default (hd_error l).
Proof.
  intros l default.
  destruct l.
  - simpl. reflexivity.
  - simpl. reflexivity.
Qed.

End NatList.

Inductive id : Type :=
  | Id (n : nat).

Definition eqb_id (x1 x2 : id) : bool :=
  match x1, x2 with
  | Id n1, Id n2 => n1 =? n2
  end.

Theorem eqb_id_refl : forall x, true = eqb_id x x.
Proof.
  intro x.
  destruct x.
    simpl.
    rewrite -> nat_equals_self.
    reflexivity.
Qed.

Module PartialMap.

Export NatList.

Inductive partial_map : Type :=
  | empty
  | record (i : id) (v : nat) (m : partial_map).

Definition update (d : partial_map)
                  (x : id) (value : nat)
                  : partial_map :=
  record x value d.

Fixpoint find (x : id) (d : partial_map) : natoption :=
  match d with
  | empty => None
  | record y v d' => if eqb_id x y
                     then Some v
                     else find x d'
  end.

Theorem update_eq :
  forall (d : partial_map) (x : id) (v: nat),
    find x (update d x v) = Some v.
Proof.
  intros d x v.
  simpl.
  rewrite <- eqb_id_refl.
  reflexivity.
Qed.

Theorem update_neq :
  forall (d : partial_map) (x y : id) (o: nat),
    eqb_id x y = false -> find x (update d y o) = find x d.
Proof.
  intros d x y o.
  intro H.
  simpl.
  rewrite -> H.
  reflexivity.
Qed.

End PartialMap.


Require Import Arith.

Definition sum f := fix s n := match n with O => f O | S x => f n + s x end.

Theorem arith_sum a b n : 2 * sum (fun i => a + i * b) n = S n * (2 * a + n * b).
Proof.
intros a b n.
induction n; simpl; ring_simplify; auto.
rewrite IHn; ring.
Qed.


Require Export Lists.

Inductive boollist: Type :=
| bool_nil: boollist
| bool_cons: bool -> boollist -> boollist.

Inductive list (X: Type): Type :=
| nil: list X
| cons: X -> list X -> list X.

Fixpoint length (X: Type) (l: list X): nat :=
    match l with
    | nil => 0
    | cons h t => S (length X t)
    end.
Example test_length1 :
        length nat (cons nat 1 (cons nat 2 (nil nat))) = 2.
Proof. reflexivity. Qed.
Example test_length2 :
        length bool (cons bool true (nil bool)) = 1.
Proof. reflexivity. Qed.

Fixpoint app (X : Type) (l1 l2 : list X)
    : (list X) :=
    match l1 with
    | nil => l2
    | cons h t => cons X h (app X t l2)
    end.

Fixpoint snoc (X:Type) (l:list X) (v:X) : (list X) :=
    match l with
    | nil => cons X v (nil X)
    | cons h t => cons X h (snoc X t v)
    end.

Fixpoint rev (X:Type) (l:list X) : list X :=
    match l with
    | nil => nil X
    | cons h t => snoc X (rev X t) h
    end.

Example test_rev1 :
    rev nat (cons nat 1 (cons nat 2 (nil nat)))
    = (cons nat 2 (cons nat 1 (nil nat))).
Proof. reflexivity. Qed.

Example test_rev2:
    rev bool (nil bool) = nil bool.
Proof. reflexivity. Qed.

Module MumbleBaz.
Inductive mumble: Type :=
| a: mumble
| b: mumble -> nat -> mumble
| c: mumble.
Inductive grumble (X: Type): Type :=
| d: mumble -> grumble X
| e: X -> grumble X.

Inductive baz: Type :=
| x: baz -> baz
| y: baz -> bool -> baz.
End MumbleBaz.

Arguments nil {X}.
Arguments cons {X} _ _.
Arguments length {X} l.
Arguments app {X} l1 l2.
Arguments rev {X} l.
Arguments snoc {X} l v.
Notation "x :: y" := (cons x y)
    (at level 60, right associativity).
Notation "[ ]" := nil.
Notation "[ x ; .. ; y ]" := (cons x .. (cons y []) ..).
Notation "x ++ y" := (app x y)
    (at level 60, right associativity).

Fixpoint repeat {X: Type} (n: X) (count: nat): list X :=
    match count with
    | O => nil
    | S count' => cons n (repeat n count')
    end.
Example test_repeat1:
      repeat true 2 = cons true (cons true nil).
Proof. reflexivity. Qed.

Theorem nil_app: forall (X: Type) (l: list X), app [] l = l.
Proof. reflexivity. Qed.

(* Skipped polymorphic DS *)

Definition doit3times {X: Type} (f: X -> X) (n: X): X := f (f (f n)).
Example test_doit3times': doit3times negb true = false.
Proof. reflexivity. Qed.

Definition plus3 := plus 3.
Example test_plus3 : plus3 4 = 7.
Proof. reflexivity. Qed.
Example test_plus3' : doit3times plus3 0 = 9.
Proof. reflexivity. Qed.
Example test_plus3'' : doit3times (plus 3) 0 = 9.
Proof. reflexivity. Qed.

Definition prod_curry {X Y Z: Type} (f: X * Y -> Z) (x: X) (y: Y): Z :=
    f (x, y).
Definition prod_uncurry {X Y Z: Type} (f: X -> Y -> Z) (p: X * Y): Z :=
    match p with (x, y) => f x y end.
Theorem uncurry_curry : forall(X Y Z : Type) (f : X -> Y -> Z) x y,
    prod_curry (prod_uncurry f) x y = f x y.
Proof. reflexivity. Qed.
Theorem curry_uncurry : forall(X Y Z : Type) (f : (X * Y) -> Z) (p : X * Y),
    prod_uncurry (prod_curry f) p = f p.
Proof. Admitted.

Fixpoint filter {X: Type} (test: X -> bool) (l: list X): list X :=
    match l with
    | nil => []
    | x :: xs => if test x then x :: (filter test xs) else (filter test xs)
    end.
Example test_filter1: filter evenb [1;2;3;4] = [2;4].
Proof. reflexivity. Qed.

Definition length_is_1 {X : Type} (l : list X) : bool :=
    beq_nat (length l) 1.

Example test_filter2:
    filter length_is_1 [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ]
    = [ [3]; [4]; [8] ].
Proof. reflexivity. Qed.

Definition countoddmembers' (l:list nat) : nat :=
      length (filter oddb l).
Example test_countoddmembers'1: countoddmembers' [1;0;3;1;4;5] = 4.
Proof. reflexivity. Qed.
Example test_countoddmembers'2: countoddmembers' [0;2;4] = 0.
Proof. reflexivity. Qed.
Example test_countoddmembers'3: countoddmembers' nil = 0.
Proof. reflexivity. Qed.

Example test_anon_fun':
    doit3times (fun n => n * n) 2 = 256.
Proof. reflexivity. Qed.
Example test_filter2':
    filter (fun l => beq_nat (length l) 1)
    [ [1; 2]; [3]; [4]; [5;6;7]; []; [8] ] = [ [3]; [4]; [8] ].
Proof. reflexivity. Qed.

Definition filter_even_gt7 (l: list nat): list nat :=
    filter (fun n => andb (evenb n) (ble_nat 7 n)) l.
Example test_filter_even_gt7_1 :
    filter_even_gt7 [1;2;6;9;10;3;12;8] = [10;12;8].
Proof. reflexivity. Qed.
Example test_filter_even_gt7_2 :
    filter_even_gt7 [5;2;6;19;129] = [].
Proof. reflexivity. Qed.

Definition partition {X: Type} (test: X -> bool) (l: list X): list X * list X :=
    pair (filter test l) (filter (fun n => negb (test n)) l).
Example test_partition1: partition oddb [1;2;3;4;5] = ([1;3;5], [2;4]).
Proof. reflexivity. Qed.
Example test_partition2: partition (fun x => false) [5;9;0] = ([], [5;9;0]).
Proof. reflexivity. Qed.

Fixpoint map {X Y: Type} (f: X -> Y) (l: list X): list Y :=
    match l with
    | nil => []
    | x :: xs => f x :: map f xs
    end.
Example test_map1: map (plus 3) [2;0;2] = [5;3;5].
Proof. reflexivity. Qed.
Example test_map2: map oddb [2;1;2;5] = [false;true;false;true].
Proof. reflexivity. Qed.
Example test_map3:
    map (fun n => [evenb n;oddb n]) [2;1;2;5]
    = [[true;false];[false;true];[true;false];[false;true]].
Proof. reflexivity. Qed.

Fixpoint fold {X Y: Type} (f: X -> Y -> Y) (l: list X) (b: Y): Y :=
    match l with
    | nil => b
    | x :: xs => f x (fold f xs b)
    end.
Example fold_example1 : fold mult [1;2;3;4] 1 = 24.
Proof. reflexivity. Qed.
Example fold_example2 : fold andb [true;true;false;true] true = false.
Proof. reflexivity. Qed.
Example fold_example3 : fold app [[1];[];[2;3];[4]] [] = [1;2;3;4].
Proof. reflexivity. Qed.

Definition constfun {X: Type} (x: X) : nat -> X :=
      fun (k:nat) => x.
Definition ftrue := constfun true.
Example constfun_example1 : ftrue 0 = true.
Proof. reflexivity. Qed.
Example constfun_example2 : (constfun 5) 99 = 5.
Proof. reflexivity. Qed.

Definition override {X: Type} (f: nat -> X) (k:nat) (x:X) : nat -> X:=
    fun (k':nat) => if beq_nat k k' then x else f k'.
Definition fmostlytrue := override (override ftrue 1 false) 3 false.
Example override_example1 : fmostlytrue 0 = true.
Proof. reflexivity. Qed.
Example override_example2 : fmostlytrue 1 = false.
Proof. reflexivity. Qed.
Example override_example3 : fmostlytrue 2 = true.
Proof. reflexivity. Qed.
Example override_example4 : fmostlytrue 3 = false.
Proof. reflexivity. Qed.

Theorem override_example: forall b: bool,
    (override (constfun b) 3 true) 2 = b.
Proof.
    intros b.
    reflexivity.
Qed.

Theorem unfold_example: forall m n,
    3 + n = m -> plus3 n + 1 = m + 1.
Proof.
    intros n m H.
    unfold plus3.
    rewrite -> H.
    reflexivity.
Qed.

Theorem override_neq: forall (X: Type) x1 x2 k1 k2 (f: nat -> X),
    f k1 = x1 -> beq_nat k2 k1 = false -> (override f k2 x2) k1 = x1.
Proof.
    intros x x1 x2 k1 k2 f H1 H2.
    unfold override.
    rewrite -> H2.
    rewrite -> H1.
    reflexivity.
Qed.


From NAT Require Import Peanos_axioms.
From NAT Require Import Tutorial_World.
From NAT Require Import Addition_World.
From NAT Require Import Function_World.
From NAT Require Import Proposition_World.

Section Advanced_Proposition_World.
(*Now, let us consider the following proposition. Now if you said the proposition out loud you might wonder what there is to prove. After all, it states that `If P and Q then P and Q.` But this is not strickly true. Rather, we are trying to show that if we have a proof of P, and a proof of Q, that it is possible to construct a proof of P /\ Q, and as far as Coq is concerned, it does not know our interpretation of these symbols, it only has a notion of the `legal moves` we can make on it.*)
Proposition p_and_q (P Q : Prop) (p : P)(q : Q): P /\ Q.
Proof.
    split.
    exact p. exact q.
Qed.
(*Next we wish to show that, given a proof of P and Q, that we can construct a proof of Q and P.*)
Proposition and_symm (P Q : Prop) : P /\ Q -> Q /\ P.
Proof.
    intro h.
    destruct h.
    split.
    exact H0. exact H.
Qed.
(*Finally we wish to shoe that /\ is a transitive realtion. Bonus points if you have begun to suspect that /\ is an equivalence relation!*)
Proposition and_trans (P Q R : Prop) : (P /\ Q) -> (Q /\ R) -> (P /\ R ).
Proof.
    intros h1 h2.
    destruct h1. destruct h2.
    split.
    exact H. exact H2.
Qed.

Proposition iff_trans (P Q R : Prop) : (P <-> Q) -> (Q <-> R) -> (P <-> R).
Proof.
    intros h1 h2.
    split. intro hp.
    apply h2. apply h1.
    exact hp.
    intro hr.
    apply h1. apply h2.
    exact hr.
Qed.

Proposition q_then_or_q ( P Q : Prop) : Q -> (P \/ Q).
Proof.
      intro hq.
      right.
      exact hq.
Qed.

Proposition or_symm (P Q : Prop) : P \/ Q -> Q \/ P.
Proof.
    intro hpq.
    case hpq.
    intro hp.
    right. exact hp.
    intro hq.
    left. exact hq.
Qed.
(*Another good problem would be to show that or is not transitive. *)

Proposition and_or_dist_left (P Q R : Prop) :
(P /\ (Q \/ R)) <-> ((P /\ Q) \/ (P /\ R)).
Proof.
    split.
    intro h1.
    destruct h1 as [hp hq].
    destruct hq.
    left. exact (p_and_q (P)(Q)(hp)(H)).
    right. exact (p_and_q (P)(R)(hp)(H)).
    intro h.
    destruct h. destruct H.
    split. exact H.
    left. exact H0.
    destruct H.
    split. exact H.
    right. exact H0.
Qed.

Proposition contra (P Q : Prop) : (P /\ ~P) -> Q.
Proof.
    intro h.
    destruct h as [p notp].
    assert False.
    exact (notp (p)).
    exfalso. exact H.
Qed.

Lemma a_then_b (A B : Prop)(b : B) : A->B.
Proof.
    intro h. exact b.
Qed.
Lemma prop_assoc (A B C : Prop) : ((A -> B) -> C) -> (A -> (B -> C)).
Proof.
    intros h h1 h2.
    assert (A->B). exact (a_then_b (A)(B)(h2)).
    apply h in H. exact H.
Qed.

(*Logic*)
Definition prop_degeneracy := forall A:Prop, A = True \/ A = False.

Definition prop_extensionality := forall A B:Prop, (A <-> B) -> A = B.

Definition excluded_middle := forall A:Prop, A \/ ~ A.

Lemma True_is_true : True.
Proof. apply I. Qed.

Lemma False_is_not_true : False <> True.
Proof.
    intro h. rewrite h. apply True_is_true.
Qed.

Lemma True_then_false (h : prop_degeneracy) : (True -> False) = False.
Proof.
    unfold prop_degeneracy in h.
    assert ((True -> False) = True \/ (True -> False) = False).
    exact (h (True -> False)).
    case H. intro hq. exfalso.
    assert (True -> False). rewrite hq. exact True_is_true.
    apply H0. exact True_is_true.
    intro h1. exact h1.
Qed.
(**)

Lemma not_true_is_false (h : prop_extensionality) ( hm : excluded_middle) :
(~True) = False.
Proof.
    unfold excluded_middle in hm. unfold prop_extensionality in h.
    apply h. split.
    intro hp. apply hp. exact True_is_true.

    intros hp ht. exact hp.
Qed.

Lemma prop_equality_right_select (A B C : Prop) :
((A = B) = C) -> (B = C).
Proof.
Admitted.

Lemma not_false_is_true (h : prop_degeneracy) : (~False) = True.
Proof.
    unfold prop_degeneracy in h.
    assert (((~False) = True)= True \/ ((~False) = True)= False).
    exact (h((~False) = True)).
    case H. intro h1.
    rewrite h1. exact True_is_true.
    intro h1.
    assert (True = False). apply prop_equality_right_select in h1. exact h1.
    assert (True -> False). intro ht. rewrite <-H0. exact True_is_true.
    exfalso. rewrite <- H0. exact True_is_true.
Qed.

Lemma deg_ext : prop_degeneracy -> prop_extensionality.
Proof.
    intro h. unfold prop_degeneracy in h. unfold prop_extensionality.
    intros ha hb H.
    assert (ha = True \/ ha = False). exact (h(ha)).
    assert (hb = True \/ hb = False). exact (h(hb)).
    destruct H0. destruct H1.
    rewrite H0. rewrite H1. reflexivity.
    exfalso.
    destruct H. rewrite H0 in H. rewrite H1 in H. rewrite (True_then_false) in H.
    exact H. exact h.
    destruct H1.
    destruct H. rewrite H1 in H2. rewrite H0 in H2. rewrite (True_then_false) in H2.
    exfalso. exact H2. exact h.
    rewrite H0. rewrite H1. reflexivity.
Qed.

Lemma deg_mid : prop_degeneracy -> excluded_middle.
Proof.
    unfold prop_degeneracy. unfold excluded_middle. intros h ha.
    assert (ha = True \/ ha = False). exact (h(ha)).
    destruct H. left. rewrite H. exact True_is_true.
    right. rewrite H.
    assert ((~ False) = True). apply not_false_is_true. exact h.
    rewrite H0. exact True_is_true.
Qed.

Lemma false_implies (A : Prop): False -> A.
Proof.
    intro h. exfalso. exact h.
Qed.
Lemma implied_truth (A : Prop) : A -> True.
Proof.
    intro h. exact True_is_true.
Qed.
Lemma iff_true_then_True (A : Prop) (a : A): A <-> True.
Proof.
    split.
    intro h.  exact True_is_true. intro h. exact a.
Qed.

Lemma swap_not (A : Prop) (h_ext : prop_extensionality)(h_mid : excluded_middle )
: ((~A) = True) -> (A = False).
Proof.
    intro h.
    unfold prop_extensionality in h_ext.
    unfold excluded_middle in h_mid.
    apply h_ext.
    split. intro ha.
    assert ((A -> False) <-> False). split. intro H. apply H. exact ha.
    intros H1 H2. exact H1. apply H.
    assert ((~ A )= (A -> False)). reflexivity.
    rewrite <-H0 in H. rewrite h in H.
    apply H. exact True_is_true. exact ha. exact (false_implies (A)).
Qed.

Lemma swap_not_op (A : Prop) (h_ext : prop_extensionality)(h_mid : excluded_middle )
: ((~A) = False) -> (A = True).
Proof.
Admitted.

Lemma mid_ext_deg :
((prop_extensionality) /\ (excluded_middle)) -> (prop_degeneracy).
Proof.
    unfold prop_degeneracy. unfold prop_extensionality. unfold excluded_middle.
    intro h. destruct h as [h_ext h_mid].
    intro ha.
    assert (ha \/ ~ha). exact (h_mid (ha)).
    destruct H.
    assert (ha <-> True). exact (iff_true_then_True (ha)(H)).
    apply h_ext in H0.
    left. exact H0.

    assert (~ha <-> True). split. exact (implied_truth (~ha)).
    intro ht. exact H.
    apply h_ext in H0.
    right.
    apply (swap_not (ha)) in H0. exact H0. exact h_ext. exact h_mid.
Qed.

Proposition ext_mid_iff_deg : ((prop_extensionality) /\ (excluded_middle)) <-> (prop_degeneracy).
Proof.
    split. exact mid_ext_deg. intro h. split. apply deg_ext. exact h.
    apply deg_mid. exact h.
Qed.

Proposition contradiction (h: prop_degeneracy) (P : Prop): P <-> ((~P) = False).
Proof.
    split. intro h1.
    unfold prop_degeneracy in h.
    assert (P = True \/ P = False). exact (h(P)).
    case H.
    intro Hp. rewrite Hp. apply not_true_is_false.
    apply deg_ext. exact h. apply deg_mid. exact h.
    intro H1. exfalso. rewrite H1 in h1. exact h1.
    intro hp.
    assert ((~P) = True \/ (~P) = False). exact (h (~P)).
    case H.
    intro Hp. exfalso. rewrite <- hp. rewrite Hp. exact True_is_true.
    intro Hp. apply (swap_not_op (P)) in Hp. rewrite Hp. exact True_is_true.
    apply deg_ext. exact h. apply deg_mid. exact h.
Qed.

Proposition contrapostive2 (P Q : Prop) : (~Q -> ~P) -> (P -> Q).
Proof.
Admitted.

End Advanced_Proposition_World.


Require Import Logic.Rel.R.
Require Import Logic.Rel.Include.
Require Import Logic.Rel.Properties.

(* Equivalence relation generated by a given relation on Type a.                *)
Inductive Equiv (a:Type) (r:Rel a) : Rel a :=
| EquivBase : forall (x y:a), r x y -> Equiv a r x y
| EquivRefl : forall (x:a), Equiv a r x x
| EquivSym  : forall (x y:a), Equiv a r x y -> Equiv a r y x
| EquivTrans: forall (x y z:a), Equiv a r x y -> Equiv a r y z -> Equiv a r x z
.

Arguments Equiv      {a}.
Arguments EquivBase  {a}.
Arguments EquivRefl  {a}.
Arguments EquivSym   {a}.
Arguments EquivTrans {a}.

(* The equivalence relation generated by a given relation is reflexive.         *)
Lemma Equiv_reflexive : forall (a:Type) (r:Rel a), reflexive (Equiv r).
Proof.
    intros a r. unfold reflexive. intros x. apply EquivRefl.
Qed.

(* The equivalence relation generated by a given relation is symmetric.         *)
Lemma Equiv_symmetric : forall (a:Type) (r:Rel a), symmetric (Equiv r).
Proof.
    intros a r. unfold symmetric. intros x y H1. apply EquivSym. assumption.
Qed.

(* The equivalence relation generated by a given relation is transitive.        *)
Lemma Equiv_transitive : forall (a:Type) (r:Rel a), transitive (Equiv r).
Proof.
    intros a r. unfold transitive. intros x y z H1 H2.
    apply EquivTrans with y; assumption.
Qed.

(* The equivalence relation generated by a given relation is an equivalence.    *)
Lemma Equiv_equivalence : forall (a:Type) (r:Rel a), equivalence (Equiv r).
Proof.
    intros a r. unfold equivalence. split.
    - apply Equiv_reflexive.
    - split.
        + apply Equiv_symmetric.
        + apply Equiv_transitive.
Qed.

(* The equivalence relation generated by a given relation contains it.          *)
Lemma Equiv_super : forall (a:Type) (r:Rel a), r <= Equiv r.
Proof.
    intros a r. apply incl_charac. intros x y H1. apply EquivBase. assumption.
Qed.

(* The equivalence relation generated by a given relation is the smallest.      *)
Lemma Equiv_smallest : forall (a:Type) (r s:Rel a),
    equivalence s -> r <= s -> Equiv r <= s.
Proof.
    intros a r s [H1 [H2 H3]] H4. apply incl_charac. intros x y H5.
    induction H5 as [x y H5|x|x y H5 IH|x y z H5 H6 H7 IH].
    - apply incl_charac_to with r; assumption.
    - apply H1.
    - apply H2. assumption.
    - apply H3 with y; assumption.
Qed.


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

(* See Chlipala, CPDT Predicates chapter (definition of even) for example
 * similar to below.  Possibly identical.
 *)
Lemma pred_even : forall (n:nat), (even n) -> (even (pred (pred n))) .
(* instead of doing induction over n, do induction over the structure of the
 * proof.  ie, do induction over even.
 *   in coq, we can use number to indicate anonymous terms.  In the below
 * case, induction 1 means to induct over the first even predicate.
 *)
induction 1 .
  simpl . constructor .
  simpl . exact H . (* or assumption . *)
Qed .
(* First failed attempt
intros. unfold pred.
Abort .
*)
(* 2nd failed attempt.  inducting over n leads nowhere good
induction n. simpl . intro ; exact H .
Abort .
*)
(*  Want to substitute n (nat) for S n ... is that allowed ? *)


Require Import Arith.

Fixpoint rplus (n p:nat) {struct p} : nat :=
  match p with
  | O => n
  | S q => S (rplus n q)
  end.

Eval compute in (rplus 33 17).

Theorem rplus_0_p : forall p:nat, rplus 0 p = p.
Proof.
 induction p; simpl; auto.
Qed.

Theorem rplus_Sn_p : forall n p:nat, rplus (S n) p = S (rplus n p).
Proof.
 induction p; simpl; auto.
Qed.

Theorem plus_rplus_equiv : forall n p:nat, n + p = rplus n p.
Proof.
 induction n; simpl.
 intro p; rewrite rplus_0_p; auto.
 intro p; rewrite rplus_Sn_p; auto.
Qed.


Require Import Nat Arith.

Inductive Nat : Type := zero : Nat | succ : Nat -> Nat.

Inductive Lst : Type := cons : Nat -> Lst -> Lst |  nil : Lst.

Inductive Tree : Type := node : Nat -> Tree -> Tree -> Tree |  leaf : Tree.

Inductive Pair : Type := mkpair : Nat -> Nat -> Pair
with ZLst : Type := zcons : Pair -> ZLst -> ZLst |  znil : ZLst.

Fixpoint plus (plus_arg0 : Nat) (plus_arg1 : Nat) : Nat
           := match plus_arg0, plus_arg1 with
              | zero, n => n
              | succ n, m => succ (plus n m)
              end.

Fixpoint mult (mult_arg0 : Nat) (mult_arg1 : Nat) : Nat
           := match mult_arg0, mult_arg1 with
              | zero, n => zero
              | succ n, m => plus (mult n m) m
              end.

Fixpoint qmult (qmult_arg0 : Nat) (qmult_arg1 : Nat) (qmult_arg2 : Nat) : Nat
           := match qmult_arg0, qmult_arg1, qmult_arg2 with
              | zero, n, m => m
              | succ n, m, p => qmult n m (plus p m)
              end.

Lemma plus_succ : forall (x y : Nat), plus x (succ y) = succ (plus x y).
Proof.
  intros.
  induction x.
  - reflexivity.
  - simpl. rewrite IHx. reflexivity.
Qed.

Lemma plus_assoc : forall (x y z : Nat), plus (plus x y) z = plus x (plus y z).
Proof.
  intros.
  induction x.
  - reflexivity.
  - simpl. rewrite IHx. reflexivity.
Qed.

Lemma plus_zero : forall (x : Nat), plus x zero = x.
Proof.
  intros.
  induction x.
  - reflexivity.
  - simpl. rewrite IHx. reflexivity.
Qed.

Lemma plus_commut : forall (x y : Nat), plus x y = plus y x.
Proof.
  intros.
  induction x.
  - rewrite plus_zero. reflexivity.
  - simpl. rewrite plus_succ. rewrite IHx. reflexivity.
Qed.

Theorem theorem0 : forall (x : Nat) (y : Nat) (z : Nat), eq (plus (mult x y) z) (qmult x y z).
Proof.
  induction x.
  - reflexivity.
  - intros. simpl. rewrite <- IHx. rewrite plus_assoc. rewrite (plus_commut y z). reflexivity.
Qed.


Require Import init.

Require Export cauchy_real_base.

Lemma cauchy_plus : ∀ a b : real_base, cauchy_seq (λ n, r_seq a n + r_seq b n).
Proof.
    intros [a a_cauchy] [b b_cauchy]; cbn.
    intros ε ε_pos.
    pose proof (half_pos ε_pos) as ε2_pos.
    specialize (a_cauchy _ ε2_pos) as [N1 a_cauchy].
    specialize (b_cauchy _ ε2_pos) as [N2 b_cauchy].
    exists (max N1 N2).
    intros i j i_ge j_ge.
    specialize (a_cauchy i j (trans (lmax _ _) i_ge) (trans (lmax _ _) j_ge)).
    specialize (b_cauchy i j (trans (rmax _ _) i_ge) (trans (rmax _ _) j_ge)).
    pose proof (lt_lrplus a_cauchy b_cauchy) as ltq.
    rewrite plus_half in ltq.
    apply (le_lt_trans (abs_tri _ _)) in ltq.
    applys_eq ltq.
    apply f_equal.
    do 2 rewrite <- plus_assoc.
    apply lplus.
    rewrite neg_plus.
    do 2 rewrite plus_assoc.
    apply rplus.
    apply plus_comm.
Qed.

Lemma cauchy_neg : ∀ a : real_base, cauchy_seq (λ n, -r_seq a n).
Proof.
    intros [a a_cauchy] ε ε_pos; cbn.
    specialize (a_cauchy ε ε_pos) as [N a_cauchy].
    exists N.
    intros i j.
    rewrite abs_minus.
    rewrite neg_neg, plus_comm.
    apply a_cauchy.
Qed.

Notation "a ⊕ b" := (make_real _ (cauchy_plus a b)) : real_scope.
Notation "⊖ a" := (make_real _ (cauchy_neg a)) : real_scope.

Open Scope real_scope.

Lemma real_plus_wd : ∀ a b c d, a ~ b → c ~ d → a ⊕ c ~ b ⊕ d.
Proof.
    intros [a a_cauchy] [b b_cauchy] [c c_cauchy] [d d_cauchy] ab cd ε ε_pos.
    cbn in *.
    pose proof (half_pos ε_pos) as ε2_pos.
    specialize (ab _ ε2_pos) as [N1 ab].
    specialize (cd _ ε2_pos) as [N2 cd].
    exists (max N1 N2).
    intros i i_ge.
    specialize (ab i (trans (lmax N1 N2) i_ge)).
    specialize (cd i (trans (rmax N1 N2) i_ge)).
    pose proof (lt_lrplus ab cd) as ltq.
    rewrite plus_half in ltq.
    apply (le_lt_trans (abs_tri _ _)) in ltq.
    applys_eq ltq.
    apply f_equal.
    do 2 rewrite <- plus_assoc.
    apply lplus.
    rewrite neg_plus.
    do 2 rewrite plus_assoc.
    apply rplus.
    apply plus_comm.
Qed.

Lemma real_neg_wd : ∀ a b, a ~ b → ⊖a ~ ⊖b.
Proof.
    intros [a a_cauchy] [b b_cauchy] ab ε ε_pos; cbn in *.
    specialize (ab ε ε_pos) as [N ab].
    exists N.
    intros n.
    rewrite abs_minus.
    rewrite neg_neg, plus_comm.
    apply ab.
Qed.

Global Instance real_plus : Plus real := {
    plus := binary_op (binary_self_wd real_plus_wd)
}.

Global Instance real_zero : Zero real := {
    zero := rat_to_real 0
}.

Global Instance real_neg : Neg real := {
    neg := unary_op (unary_self_wd real_neg_wd)
}.

Global Instance real_plus_assoc : PlusAssoc real.
Proof.
    split.
    intros a b c.
    equiv_get_value a b c.
    unfold plus; equiv_simpl.
    intros ε ε_pos.
    exists 0.
    intros i i_ge.
    rewrite plus_assoc.
    rewrite plus_rinv.
    rewrite <- abs_zero.
    exact ε_pos.
Qed.

Global Instance real_plus_comm : PlusComm real.
Proof.
    split.
    intros a b.
    equiv_get_value a b.
    unfold plus; equiv_simpl.
    intros ε ε_pos.
    exists 0.
    intros i i_ge.
    rewrite (plus_comm (r_seq a i)).
    rewrite plus_rinv.
    rewrite <- abs_zero.
    exact ε_pos.
Qed.

Global Instance real_plus_lid : PlusLid real.
Proof.
    split.
    intros a.
    equiv_get_value a.
    unfold plus, zero; equiv_simpl.
    intros ε ε_pos.
    exists 0.
    intros i i_ge.
    rewrite plus_lid.
    rewrite plus_rinv.
    rewrite <- abs_zero.
    exact ε_pos.
Qed.

Global Instance real_plus_linv : PlusLinv real.
Proof.
    split.
    intros a.
    equiv_get_value a.
    unfold plus, neg, zero; cbn.
    unfold rat_to_real; equiv_simpl.
    intros ε ε_pos.
    exists 0.
    intros i i_ge.
    rewrite plus_linv.
    rewrite plus_rinv.
    rewrite <- abs_zero.
    exact ε_pos.
Qed.