(* Final Exam --- January 7, 2019 *)
Require Import Nat.
Require Import List.

Notation "[ ]" := nil.
Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..).

Definition admit {T: Type} : T.  Admitted.

(* 1. Prove the following two facts about natural numbers. *)

Lemma mul_0_r : forall n : nat, n * 0 = 0.
Proof.
   intros n. induction n as [| n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite -> IHn'. reflexivity. Qed.

Lemma mul_1_r : forall n : nat, n * 1 = n.
Proof.
  intros n. induction n as [| n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite -> IHn'. reflexivity. Qed.

(* 2. Complete the following definition so that (div5 n) returns true
iff n is divisible by 5. *)

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

Example test1: div5 15 = true.
Proof. reflexivity. Qed.

Example test2: div5 23 = false.
Proof. reflexivity. Qed.

(* 3. Define a function createList such that (createList n) returns
a list of n numbers from 2n to 1. *)

Fixpoint createList (n : nat) : list nat :=
  match n with
  | O => nil
  | S n' => (n+n)::(n+n-1)::createList n'
  end.

Example test3 : createList 4 = [8;7;6;5;4;3;2;1].
Proof. reflexivity. Qed.

(* 4. (1) Define the relation gtodd between odd numbers such that
   (gtodd m n) holds if and only if m is greater than n for odd numbers m and n.
(2) Show the transitivity of the relation gtodd. *)

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

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

Definition lt (n m:nat) := le (S n) m.

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

Lemma le_trans : forall m n o, m <= n -> n <= o -> m <= o.
Proof.
  intros m n o E1 E2.
  induction E2.
  - apply E1.
  - apply le_S. apply IHE2 in E1. apply E1. Qed.

Theorem lt_trans: forall m n o, m < n -> n < o -> m < o.
Proof.
  unfold lt.
  intros n m o Hnm Hmo.
  apply le_S in Hnm.
  apply le_trans with (m := (S n)) (n := (S m)) (o := o).
  apply Hnm.
  apply Hmo. Qed.

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

Definition oddb (n:nat) : bool   :=   negb (evenb n).
(* end of lemmas *)

Inductive gtodd : nat -> nat -> Prop :=
  | gt_odd : forall m n, (oddb m = true) /\ (oddb n = true) /\ n < m -> gtodd m n.

Example test4 : gtodd 3 1.
Proof.
  apply gt_odd.
  split.
  - reflexivity.
  - split.
    + reflexivity.
    + unfold lt. apply le_S. apply le_n. Qed.

Example test5 : ~ (gtodd 4 3).
Proof.
  unfold not.
  intros.
  inversion H.
  destruct H0.
  inversion H0. Qed.

Theorem gtodd_trans : forall m n p,
  gtodd m n -> gtodd n p -> gtodd m p.
Proof.
  intros.
  inversion H. inversion H0.
  apply gt_odd. destruct H1. destruct H7.
  destruct H4. destruct H9.
  split.
  - apply H1.
  - split.
    + apply H9.
    + apply lt_trans with (m := p) (n := n) (o := m).
      * apply H10.
      * apply H8. Qed.

(* 5. Write a function (partition):

      partition : list nat -> list (list nat )

   which partitions a list into a list of 3 sublists. The first sublist
   contains all even numbers in the original list. The second sublist
   contains all odd numbers divisible by 5 in the original list. The last
   sublist contains all other elements. The order of elements in the
   three sublists should be the same as their order in the original list.

   Hint: You can make use of the Coq function (filter).
*)

(* lemmas *)
Fixpoint filter {X:Type} (test: X->bool) (l:list X)
                : (list X) :=
  match l with
  | []     => []
  | h :: t => if test h then h :: (filter test t)
                        else       filter test t
  end.
(* end of lemmas *)

Definition partition (l : list nat) : list (list nat) :=
  [(filter evenb l); (filter div5 l); (filter (fun a=> andb (oddb a) (negb (div5 a))) l)].

Example test6: partition [1;2;3;9;4;5;6;15] = [[2;4;6]; [5;15]; [1;3;9]].
Proof. reflexivity. Qed.

(* 6. Prove that the excluded middle axiom implies the Peirce's law. *)

Theorem peirce :
  (forall P, P \/ ~P) -> (forall P Q : Prop, ((P->Q)->P)->P).
Proof.
  intros.
  assert (P \/ ~P) as H1.
  apply H.
  inversion H1.
  - apply H2.
  - apply H0. intros. unfold not in H2. apply H2 in H3. inversion H3. Qed.

(* 7. Let a sequence of numbers F(n) be given as follows.
   F(0) = 0
   F(1) = 1
   F(2) = 1
   F(n) = F(n-1) + F(n-2) + F(n-3)   for n > 2.

Define the function Seq such that (Seq n) returns the sequence.

[0; F(0); 1; F(1); 2; F(2); 3; F(3); ... ; n; F(n)].
*)

(* lemmas *)
Fixpoint SeqNum (n: nat) : nat :=
  match n with
  | O => 0
  | S n' => match n' with
            | O => 1
            | S m => match m with
                     | O => 1
                     | S m' => SeqNum m' + SeqNum m + SeqNum n'
                     end
            end
  end.

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

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

Fixpoint Seq (n: nat) : list nat :=
  match n with
  | O => [0; 0]
  | S n' => Seq n' ++ [n; SeqNum n]
  end.

Example test7 :  Seq 10 =
[0; 0; 1; 1; 2; 1; 3; 2; 4; 4; 5; 7; 6; 13; 7; 24; 8; 44; 9; 81; 10; 149].
Proof. reflexivity. Qed.

(* 8. Consider the following type:

Inductive btree : Set :=
 | leaf : btree
 | node : nat->btree->btree->btree.

Define a function taking as argument a natural number n
and a tree t and returning the number of occurrences of n in t.

Hint: You may use the function (eqb n m) which returns true iff the two natural
numbers n and m are equal.
*)

Inductive btree : Set :=
 | leaf : btree
 | node : nat->btree->btree->btree.

Fixpoint occur (n: nat)(t: btree) : nat :=
  match t with
  | leaf => 0
  | node m b1 b2 => if eqb n m then 1+(occur n b1)+(occur n b2)
                    else (occur n b1)+(occur n b2)
  end.

Example test8 : occur 2 (node 1 (node 2 leaf (node 2 leaf leaf)) (node 3 (node 2 leaf leaf) leaf)) = 3.
Proof. reflexivity. Qed.

(* 9 Design a sorting algorithm which transforms a list of natural numbers into
a list sorted in ascending oder. *)

(* lemmas *)
Fixpoint gea (n m: nat) : bool :=
  match n with
  | O => match m with
         | O => true
         | S m' =>false
         end
  | S n' => match m with
            | O => true
            | S m' => gea n' m'
            end
  end.

Fixpoint insert (n:nat)(l: list nat) : list nat :=
  match l with
  | nil => n :: nil
  | h :: t => match gea n h with
              | true => n :: h :: t
              | false => h :: (insert n t)
              end
  end.

Fixpoint insertion_sort (l: list nat) : list nat :=
  match l with
  | nil => nil
  | h :: t => insert h (insertion_sort t)
  end.

Fixpoint rev (l:list nat) : list nat :=
  match l with
  | nil      => nil
  | cons h t => app (rev t) (cons h nil)
  end.
(* end of lemmas *)

Definition transform (l: list nat) : list nat :=
  rev (insertion_sort l).

Example test10 : transform [2;4;1;6;9;6;4;1;3;5;10] = [1;1;2;3;4;4;5;6;6;9;10].
Proof. reflexivity. Qed.

(* 10. The following definitions specify the abstract syntax of
    some arithmetic expressions and an evaluation function. *)

Inductive aexp : Type :=
  | ANum : nat -> aexp
  | APlus : aexp -> aexp -> aexp
  | AMinus : aexp -> aexp -> aexp
  | AMult : aexp -> aexp -> aexp.

Fixpoint aeval (a : aexp) : nat :=
  match a with
  | ANum n => n
  | APlus a1 a2 => (aeval a1) + (aeval a2)
  | AMinus a1 a2 => (aeval a1) - (aeval a2)
  | AMult a1 a2 => (aeval a1) * (aeval a2)
  end.

(* Suppose we define a function that takes an arithmetic expression
   and slightly simplifies it, changing every occurrence of [e * 1]
   (i.e., [(AMult e (ANum 1)]) into just [e]. *)

Fixpoint optimize_mult1 (a:aexp) : aexp :=
  match a with
  | ANum n => ANum n
  | APlus e1 e2 => APlus (optimize_mult1 e1) (optimize_mult1 e2)
  | AMinus e1 e2 => AMinus (optimize_mult1 e1) (optimize_mult1 e2)
  | AMult e1 (ANum 1) => optimize_mult1 e1
  | AMult e1 e2 => AMult (optimize_mult1 e1) (optimize_mult1 e2)
  end.

(* Prove the following theorem that states the correctness of the
optimization with respect to the evaluation of arithmetic expressions. *)

Theorem optimize_mult1_sound: forall a,
  aeval (optimize_mult1 a) = aeval a.
Proof.
  intros. induction a.
  - simpl. reflexivity.
  - simpl. rewrite IHa1. rewrite IHa2. reflexivity.
  - simpl. rewrite IHa1. rewrite IHa2. reflexivity.
  - destruct a2.
    + destruct n.
      * simpl. rewrite mul_0_r. symmetry. rewrite mul_0_r. reflexivity.
      * destruct n. simpl. rewrite mul_1_r. apply IHa1.
        simpl. rewrite IHa1. reflexivity.
    + simpl. simpl in IHa2. rewrite IHa2. rewrite IHa1. reflexivity.
    + simpl. simpl in IHa2. rewrite IHa2. rewrite IHa1. reflexivity.
    + simpl. simpl in IHa2. rewrite IHa2. rewrite IHa1. reflexivity. Qed.


(* Homework 01 *)

(* include some library code *)
Require Import List.
Require Import NPeano.

(* decide if two nats are equal *)
Fixpoint nat_eq (m n: nat) : bool :=
  match m, n with
    | O, O => true
    | S mp, S np => nat_eq mp np
    | _, _ => false
  end.

(* [PROBLEM 1]

Define nat_le to decide if one nat is less than or equal to another.

Hint: You do not need to use any form of disjunction.
*)
Fixpoint nat_le (m n: nat) : bool :=
  match m, n with
    | O, _ => true
    | S mp, O => false
    | S mp, S np => nat_le mp np
  end.

Eval cbv in (nat_le 5 5). (* true *)
Eval cbv in (nat_le 3 5). (* true *)
Eval cbv in (nat_le 5 3). (* false *)

(* [PROBLEM 2]

Uset nat_le to define nat_lt which should decide if one nat is less than another.

For full credit, do not use other boolean functions.
*)
Definition nat_lt (m n: nat) : bool :=
  match m, n with
    | _, O => false
    | O, _ => true
    | S _, S np => nat_le m np
  end.

Eval cbv in (nat_lt 5 5). (* false *)
Eval cbv in (nat_lt 3 5). (* true *)
Eval cbv in (nat_lt 5 3). (* false *)

(* binary trees of nats *)
Inductive nat_tree : Set :=
| Leaf : nat_tree
| Branch : nat -> nat_tree -> nat_tree -> nat_tree.

(* ordered insertion *)
Fixpoint insert (n: nat) (nt: nat_tree) : nat_tree :=
  match nt with
    | Leaf => Branch n Leaf Leaf
    | Branch m tl tr =>
        if nat_lt n m then
          Branch m (insert n tl) tr
        else
          Branch m tl (insert n tr)
  end.

Eval cbv in (insert 3 Leaf).
Eval cbv in (insert 5 (insert 7 (insert 3 Leaf))).

(* [PROBLEM 3]

Define of_list to produce an ordered tree containing all elements from the list.

Use insert to help with sorting. Do not worry about duplicates in the list.
*)
Fixpoint of_list (ns: list nat) : nat_tree :=
  match ns with
    | nil => Leaf
    | x::xs => (insert x (of_list xs))
  end.

Eval cbv in (of_list (5::7::3::nil)).
Eval cbv in (of_list (3::7::5::nil)).
Eval cbv in (of_list (nil)).
Eval cbv in (of_list (1::1::nil)).

(* [PROBLEM 4]

Define to_list, which provides a list of elements generated by an in-order traversal of the tree nt.

For the difference between in-order, post-order, and pre-order traversals, see:
    http://en.wikipedia.org/wiki/Tree_traversal

Recall from lecture that we can append with the ++ operator.
*)
Fixpoint to_list (nt: nat_tree) : list nat :=
  match nt with
    | Leaf => nil
    | Branch m tl tr => to_list tl ++ m::nil ++ to_list tr
  end.

(* Should be: 3::5::7::nil *)
Eval cbv in (to_list (Branch 3 Leaf (Branch 7 (Branch 5 Leaf Leaf) Leaf))).
Eval cbv in (to_list (Branch 5 (Branch 3 Leaf Leaf) (Branch 7 Leaf Leaf))).
Eval cbv in (to_list (of_list (3::7::5::nil))).
Eval cbv in (to_list (of_list (7::3::5::nil))).
Eval cbv in (to_list (of_list (5::3::7::nil))).

(* [PROBLEM 5]

Define sum to add up all the nats in a nat_tree.
*)
Fixpoint sum (nt: nat_tree) : nat :=
  match nt with
    | Leaf => 0
    | Branch m tl tr => m + (sum tl) + (sum tr)
  end.

Eval cbv in (sum (of_list (1::2::3::nil))).
Eval cbv in (sum (of_list (99::1::nil))).
Eval cbv in (sum (of_list (nil))).

(* [PROBLEM 6]

Define prod to multiply up all the nats in a nat_tree.
*)
Fixpoint prod (nt: nat_tree) : nat :=
  match nt with
    | Leaf => 1
    | Branch m tl tr => m * (prod tl) * (prod tr)
  end.

Eval cbv in (prod (of_list (1::2::3::nil))).
Eval cbv in (prod (of_list (9::1::nil))).
Eval cbv in (prod (of_list (9::0::nil))).
Eval cbv in (prod (of_list (nil))).

(* [PROBLEM 7]

Define size to produce the number of nats in a nat_tree.

Note that Leaf should have size 0.
*)
Fixpoint size (nt: nat_tree) : nat :=
  match nt with
    | Leaf => 0
    | Branch m tl tr => 1 + (size tl) + (size tr)
  end.

Eval cbv in (size (of_list (1::2::3::nil))).
Eval cbv in (size (of_list (9::1::nil))).
Eval cbv in (size (of_list (9::0::nil))).
Eval cbv in (size (of_list (nil))).

(* [PROBLEM 8]

Define avg to compute the arithmetic mean of all the nats in a nat_tree.

Notes: Infix / is nat division. The average of an empty tree will be 0.
*)
Definition avg (nt: nat_tree) : nat :=
  (sum nt) / (size nt).

Eval cbv in (avg (of_list (1::2::3::nil))).
Eval cbv in (avg (of_list (9::1::nil))).
Eval cbv in (avg (of_list (9::0::nil))).
Eval cbv in (avg (of_list (nil))).

(* [PROBLEM 9]

Define map to apply a function of type nat -> nat to every nat in a nat_tree.

The resulting tree should have exactly the same structure as the initial tree.
*)
Fixpoint map (f: nat -> nat) (nt: nat_tree) : nat_tree :=
  match nt with
    | Leaf => Leaf
    | Branch m tl tr => Branch (f m) (map f tl) (map f tr)
  end.

Eval cbv in (to_list (map (fun a => a + 1) (of_list (1::2::3::nil)))). (* 2::3::4::nil *)
Eval cbv in (to_list (map (fun a => a * a) (of_list (1::2::3::nil)))). (* 1::4::9::nil *)

(* [PROBLEM 10]

Define increment_all to add one to all the nats in a nat_tree.

For full credit, do not use recursion (keep the Definition, don't change to Fixpoint).
*)
Definition increment_all (nt: nat_tree) : nat_tree :=
  map (fun a => a + 1) nt.

Eval cbv in (to_list (increment_all (of_list (1::2::3::nil)))). (* 2::3::4::nil *)

(* fold over nat_trees *)
Fixpoint fold {T: Type} (base: T) (f: T -> nat -> T) (nt: nat_tree) : T :=
  match nt with
    | Leaf => base
    | Branch n l r => f (fold (fold base f l) f r) n
  end.

(* [PROBLEM 11]

Define sum' to add up all the nats in a nat_tree.

For full credit, do not use recursion (keep the Definition, don't change to Fixpoint).
*)
Definition sum' := fold 0 (fun a b => a + b).

Eval cbv in (sum' (of_list (1::2::3::nil))).
Eval cbv in (sum' (of_list (99::1::nil))).
Eval cbv in (sum' (of_list (nil))).

(* [PROBLEM 12]

Define prod' to multiply up all the nats in a nat_tree.

For full credit, do not use recursion (keep the Definition, don't change to Fixpoint).
*)
Definition prod' := fold 1 (fun a b => a * b).

Eval cbv in (prod' (of_list (1::2::3::nil))).
Eval cbv in (prod' (of_list (9::1::nil))).
Eval cbv in (prod' (of_list (9::0::nil))).
Eval cbv in (prod' (of_list (nil))).

(* [PROBLEM 13]

Define avg' to compute the arithmetic mean of all the nats in a nat_tree.

For full credit, use fold.

Hint: Use let and a pair.
*)

Eval cbv in (pair 1 2).

Definition avg' (nt: nat_tree) : nat :=
  (let (totalSum, totalSize) :=
      (fold
        (pair 0 0)
        (fun sumAndSize n =>
          let (sum, size) := sumAndSize in (pair (sum + n) (size + 1)))
        nt)
    in (totalSum / totalSize)).

Eval cbv in (avg' (of_list (1::2::3::nil))).
Eval cbv in (avg' (of_list (9::1::nil))).
Eval cbv in (avg' (of_list (9::0::nil))).
Eval cbv in (avg' (of_list (nil))).

(* [PROBLEM 14]

Define mirror to flip all the branches in the tree:

       5              5
      / \            / \
     3   4     =>   4   3
    / \                / \
   1   6              6   1

(leaves are not displayed above)
*)
Fixpoint mirror (nt: nat_tree) : nat_tree :=
  match nt with
    | Leaf => Leaf
    | Branch m lt rt => Branch m (mirror rt) (mirror lt)
  end.

Eval cbv in (to_list (mirror (of_list (1::2::3::nil)))).

(* test if a nat appears in a given tree *)
Fixpoint mem (n: nat) (nt: nat_tree) : bool :=
  match nt with
    | Leaf => false
    | Branch m l r =>
      if nat_eq n m then
        true
      else if nat_lt n m then
        mem n l
      else
        mem n r
  end.

Eval cbv in (mem 2 (of_list (1::2::3::nil))).
Eval cbv in (mem 4 (of_list (1::2::3::nil))).

(* prove all the following lemmas *)

(* Warning!  This first one may be tricky... *)
Lemma nat_eq_ok:
  forall m n, nat_eq m n = true -> m = n.
Proof.
  intro. induction m.
  { intros. destruct n.
    { reflexivity. }
    { discriminate. }
  }
  { intro. induction n.
    { discriminate. }
    { firstorder. }
  }
Qed.

Lemma nat_le_ok:
  forall m n, nat_le m n = true -> m <= n.
Proof.
  intro. induction m.
  { firstorder. }
  { intro. induction n.
    { discriminate. }
    { firstorder. }
  }
Qed.

(* Hint: use nat_le_ok *)
Lemma nat_lt_ok:
  forall m n, nat_lt m n = true -> m < n.
Proof.
  intro. induction m.
  { intro. induction n.
    { discriminate. }
    { firstorder. }
  }
  { intro. induction n.
    { discriminate. }
    { intro. destruct m.
      { firstorder. }
      { firstorder. }
    }
  }
Qed.

(* Show that our nat equality decider is reflexive. *)
Lemma nat_eq_refl : forall n, nat_eq n n = true.
Proof.
  intro. induction n.
  { reflexivity. }
  { firstorder. }
Qed.

Theorem map_size : forall f t, size (map f t) = size t.
Proof.
  intros. induction t.
  { reflexivity. }
  { simpl. firstorder. }
Qed.

Theorem mirror_size : forall t, size (mirror t) = size t.
Proof.
  intro. induction t.
  { reflexivity. }
  { simpl. rewrite -> IHt1. rewrite -> IHt2. firstorder. }
Qed.

(*
We define the custom tactic break_if to help with some proofs below.

Don't worry about understanding the details for now.

Just remember that if you see an if-then-else, break_if will do case analysis on the branch condition and give you two subgoals: one where the branch condition was true and so the then branch was taken, and another where the branch condition was false and so the else branch was taken.
*)
Ltac break_if :=
  match goal with
    | |- context [ if ?cond then _ else _ ] => destruct cond as [] eqn:?
  end.

Lemma mem_left : forall v l r, mem v l = true -> mem v (Branch v l r) = true.
Proof.
  intros. simpl. rewrite -> nat_eq_refl. reflexivity.
Qed.

Lemma mem_right : forall v l r, mem v r = true -> mem v (Branch v l r) = true.
Proof.
  intros. simpl. rewrite -> nat_eq_refl. reflexivity.
Qed.

(* using the previous lemmas and tactics, prove that insertion implies membership *)
Theorem insert_mem :
  forall v t, mem v (insert v t) = true.
Proof.
  intros. induction t.
  { simpl. rewrite -> nat_eq_refl. reflexivity. }
  { simpl. break_if.
    { simpl. rewrite -> Heqb. break_if.
      { reflexivity. }
      { firstorder. }
    }
    { simpl. rewrite -> Heqb. break_if.
      { reflexivity. }
      { firstorder. }
    }
  }
Qed.

(* [PROBLEM 24]

Consider this alternate definition of fold:
*)
Fixpoint fold' {T: Type} (base: T) (f: T -> nat -> T) (nt: nat_tree) : T :=
  match nt with
    | Leaf => base
    | Branch n l r => fold' (f (fold' base f l) n) f r
  end.

Check fold.
Check fold'.
Print fold.

(*
For reference, the definition of fold:
fold =
fix fold (T : Type) (base : T) (f : T -> nat -> T) (nt : nat_tree)
         {struct nt} : T :=
  match nt with
  | Leaf => base
  | Branch n l r => f (fold T (fold T base f l) f r) n
  end
     : forall T : Type, T -> (T -> nat -> T) -> nat_tree -> T

Argument T is implicit and maximally inserted
Argument scopes are [type_scope _ _ _]
*)

(*
In a short English paragraph, describe how fold and fold' differ.

Fold's recurse looks like:  Branch n l r => f (fold (fold base f l) f r) n
Fold''s recurse looks like: Branch n l r => fold' (f (fold' base f l) n) f r

Fold traverses in "post-order". Aka it first does fold down the left sub tree, then down the right sub tree, then the current node.
Fold' traverses "in-order". Aka it first does fold down the left sub tree, then on the current node, then down the right sub tree.

Optional Bonus (5 points):

What should be true about a particular f for the following to hold:

  forall b nt, fold b f nt = fold' b f nt

  So long as f doesn't care about the order in which it visits nodes, fold and fold'
  will behave the same. For example, if f is used to compute size, sum, or mem,
  they'll behave identically. However, if for example f uses the traverse order
  to find the smallet number > 10, you may get different behavior. See the Eval
  examples below.

*)

(* sum works for both *)
Eval cbv in (fold 0 (fun b n => b + n) (of_list (1::2::3::nil))).
Eval cbv in (fold' 0 (fun b n => b + n) (of_list (1::2::3::nil))).

(* smallest num greater than 10 only works with this particular f with fold'
   because f uses knowledge of the traverse order. *)
Eval cbv in (fold' 0 (fun b n => if (andb (nat_le b 10) (nat_lt 10 n)) then n else b) (of_list (5::12::11::nil))). (* returns 11 *)

Eval cbv in (fold 0 (fun b n => if (andb (nat_le b 10) (nat_lt 10 n)) then n else b) (of_list (5::12::11::nil))). (* returns 12 *)


(**************************************************************)
(*   Copyright Dominique Larchey-Wendling    [*]              *)
(*             Jean-François Monin           [+]              *)
(*                                                            *)
(*           [*] Affiliation Univ. Lorraine - CNRS - LORIA    *)
(*           [+] Affiliation VERIMAG - Univ. Grenoble Alpes   *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*        CeCILL v2.1 FREE SOFTWARE LICENSE AGREEMENT         *)
(**************************************************************)

(** Textbook reference:
    [BBJ2002]: Computability and Logic
               Boolos, G.S. and Burgess, J.P. and Jeffrey, R.C.
               4th Edition, Cambridge University Press, 2002.
*)

From Coq Require Import Utf8.

From MuRec Require Import relations arith_mini between.

Section primitive_recursion.

  (** The fixpoint computing primitive recursion following [BBJ2002] pp 67
      where H := prim_rec, F and G represent respectively the (to be proved
      functional) relations h, f and g, ie. for ⇀ denoting partial functions
      we have the following encoding of types

        f : Xa ⇀ Y             ~~>  F : Xa → Y → Prop
        g : Xa ⨯ nat ⨯ Y ⇀ Y   ~~>  G : Xa → nat → Y → Y → Prop
        h : Xa ⨯ nat ⇀ Y       ~~>  H : Xa → nat → Y → Prop

      and the following encoding for the recursive equations

         h (x₀, 0)   = f(x₀)              ~~>  H x₀ 0 = F x₀
         h (x₀, S n) = g(x₀, n, h(x₀,n))  ~~>  H x₀ (S n) = (G x₀ n) ⋄ (H x₀ n)

      Notice that in [BBJ2002], Xa := nat^a and Y := nat but the definition
      can be made more polymorphic.

      In [BBJ2002] the primitive recursive scheme is written as follows,
      with x in place of x₀ and y in place of n:
         h(x₀, 0) = f(x),  h(x₀, n') = g(x₀, n, h(x₀,n))    (Pr)

     *)

  Context   {Xa Y : Type}
            (F : Xa → Y → Prop)
            (G : Xa → nat → Y → Y → Prop).

  Definition prim_rec x₀ := nat_rect (λ _, Y → Prop) (F x₀) (λ n p, (G x₀ n) ⋄ p).

  Definition prim_rec_alt x₀ :=
    fix loop n :=
      match n with
      | 0   => F x₀
      | S n => (G x₀ n) ⋄ (loop n)
      end.

  Goal prim_rec = prim_rec_alt.
  Proof. reflexivity. Qed.

  Hypothesis Ffun : functional F.
  Hypothesis Gfun : ∀ x₀ n, functional (G x₀ n).

  Fact prim_rec_fun x₀ : functional (prim_rec x₀).
  Proof.
    intros n; induction n; cbn.
    + apply Ffun.
    + now apply rel_subst_fun.
  Qed.

End primitive_recursion.

Arguments prim_rec_fun {Xa Y F G} Ffun Gfun {_ _ _ _}.

Section unbounded_minimisation.

  (** In [BBJ2002] pp 70 unbounded minimization is written as follows:

                          / y         if f(x₁,...,xₙ, y) = 0, and for all t < y,
      Mn[f](x₁,...,xₙ) = {               f(x₁,...,xₙ, t) is defined and ≠ 0
                          \ undefined if there is no such y.

      This definition is adapted here as follows:
      - at this stage, x₁,...,xₙ are ignored;
      - we consider unbounded minimization from a starting number denoted by s
        ([BBJ2002] corresponds to the special case where s = 0);
        the reason is that, even if the semantics of (AST of) mu-recursive algorithms,
        consideres only s = 0, the intended minimization algorithm is actually able to
        start at any s, a fact to be used when reasoning about this algorithm.

      Altogether, we state that F is 0 at y and strictly positive (ie a successor)
      from s (included) to y (excluded).
   *)

  Variable (F : nat → nat → Prop).

  Definition ze_at y  :=     F y 0.
  Definition def_at t := ∃k, F t k.
  Definition pos_at t := ∃k, F t (S k).

  Fact ze_at_def_at : ze_at ⊆₁ def_at.
  Proof. now intros n ?; exists 0. Qed.
  Fact pos_at_def_at : pos_at ⊆₁ def_at.
  Proof. now intros n (k & ?); exists (S k). Qed.

  Definition umin s y := ze_at y ∧ btwn pos_at s y.
  Definition umin₀ y := ze_at y ∧ ∀n, n < y → pos_at n.

  Fact umin_umin₀ y : umin 0 y → umin₀ y.
  Proof.
    intros (H1 & H2 & H3); split.
    + exact H1.
    + intro; apply H3, le_0_n.
  Qed.

  Fact umin₀_umin y : umin₀ y → umin 0 y.
  Proof.
    intros (H1 & H2); repeat split.
     + exact H1.
     + apply le_0_n.
     + intros ? ?; apply H2.
  Qed.

  Hypothesis Ffun : functional F.

  Arguments Ffun {_ _ _}.

  Fact umin_fun : functional umin.
  Proof.
    intros s y₁ y₂ [z1 py₁] [z2 py₂].
    destruct (btwn_eq_or_holds py₁ py₂) as [ [] | [ [? FS] | [? FS] ] ].
    - reflexivity.
    - discriminate (Ffun z1 FS).
    - discriminate (Ffun z2 FS).
  Qed.

  Fact umin₀_fun : functional₀ umin₀.
  Proof.
    intros y1 y2 H1 H2.
    apply (umin_fun 0); now apply umin₀_umin.
  Qed.

End unbounded_minimisation.

Arguments umin_umin₀ {F}.
Arguments umin₀_umin {F}.


Inductive day : Type :=
  | monday : day
  | tuesday : day
  | wednesday : day
  | thursday : day
  | friday : day
  | saturday : day
  | sunday : day.

Definition next_weekday (d:day) : day :=
  match d with
  | monday => tuesday
  | tuesday => wednesday
  | wednesday => thursday
  | thursday => friday
  | friday => monday
  | saturday => monday
  | sunday => monday
  end.
Eval simpl in (next_weekday friday).
Eval simpl in (next_weekday (next_weekday saturday)).

Example test_next_weekday:
  (next_weekday (next_weekday saturday)) = tuesday.
Proof. simpl. reflexivity. Qed.

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

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

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

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

Example test_orb1: (orb true false) = true.
Proof. simpl. reflexivity. Qed.
Example test_orb2: (orb false false) = false.
Proof. simpl. reflexivity. Qed.
Example test_orb3: (orb false true ) = true.
Proof. simpl. reflexivity. Qed.
Example test_orb4: (orb true true ) = true.
Proof. simpl. reflexivity. Qed.

Definition admit {T: Type} : T. Admitted.

Definition nandb (b1:bool) (b2:bool) : bool :=
  (negb (andb b1 b2)).

Example test_nandb1: (nandb true false) = true.
Proof. simpl. reflexivity. Qed.
Example test_nandb2: (nandb false false) = true.
Proof. simpl. reflexivity. Qed.
Example test_nandb3: (nandb false true) = true.
Proof. simpl. reflexivity. Qed.
Example test_nandb4: (nandb true true) = false.
Proof. simpl. reflexivity. Qed.

Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool :=
(andb b1 (andb b2 b3)).

Example test_andb31: (andb3 true true true) = true.
Proof. simpl. reflexivity. Qed.
Example test_andb32: (andb3 false true true) = false.
Proof. simpl. reflexivity. Qed.
Example test_andb33: (andb3 true false true) = false.
Proof. simpl. reflexivity. Qed.
Example test_andb34: (andb3 true true false) = false.
Proof. simpl. reflexivity. Qed.

Check (negb true).

Check negb.

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

Definition pred (n : nat) : nat :=
  match n with
    | O => O
    | S n' => n'
  end.

End Playground1.

Definition minustwo (n : nat) : nat :=
  match n with
    | O => O
    | S O => O
    | S (S n') => n'
  end.

Check (S (S (S (S O)))).
Eval simpl in (minustwo 4).
Check S.
Check pred.
Check minustwo.

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

Definition oddb (n:nat) : bool := negb (evenb n).

Example test_oddb1: (oddb (S O)) = true.
Proof. simpl. reflexivity. Qed.
Example test_oddb2: (oddb (S (S (S (S O))))) = false.
Proof. simpl. reflexivity. Qed.

Module Playground2.

Fixpoint plus (n : nat) (m : nat) : nat :=
  match n with
    | O => m
    | S n' => S (plus n' m)
  end.

Eval simpl in (plus (S (S (S O))) (S (S O))).

Fixpoint mult (n m : nat) : nat :=
  match n with
    | O => O
    | S n' => plus m (mult n' m)
  end.

Fixpoint minus (n m:nat) : nat :=
  match n, m with
  | O , _ => O
  | S _ , O => n
  | S n', S m' => minus n' m'
  end.

End Playground2.

Fixpoint exp (base power : nat) : nat :=
  match power with
    | O => S O
    | S p => mult base (exp base p)
  end.

Example test_mult1: (mult 3 3) = 9.
Proof. simpl. reflexivity. Qed.

Fixpoint factorial (n:nat) : nat :=
  match n with
  | O => 1
  | S n'  => (mult n (factorial (n')))
  end.

Example test_factorial1: (factorial 3) = 6.
Proof. simpl. reflexivity. Qed.
Example test_factorial2: (factorial 5) = (mult 10 12).
Proof. simpl. reflexivity. Qed.

Notation "x + y" := (plus x y) (at level 50, left associativity) : nat_scope.
Notation "x - y" := (minus x y) (at level 50, left associativity) : nat_scope.
Notation "x * y" := (mult x y) (at level 40, left associativity) : nat_scope.

Check ((0 + 1) + 1).

Fixpoint beq_nat (n m : nat) : bool :=
  match n with
  | O => match m with
         | O => true
         | S m' => false
         end
  | S n' => match m with
            | O => false
            | S m' => beq_nat n' m'
            end
  end.

Fixpoint ble_nat (n m : nat) : bool :=
  match n with
  | O => true
  | S n' =>
      match m with
      | O => false
      | S m' => ble_nat n' m'
      end
  end.

Example test_ble_nat1: (ble_nat 2 2) = true.
Proof. simpl. reflexivity. Qed.
Example test_ble_nat2: (ble_nat 2 4) = true.
Proof. simpl. reflexivity. Qed.
Example test_ble_nat3: (ble_nat 4 2) = false.
Proof. simpl. reflexivity. Qed.

Definition blt_nat (n m : nat) : bool :=
  match  (beq_nat n m) with
    | true => false
    | false => (ble_nat n m)
  end.

Example test_blt_nat1: (blt_nat 2 2) = false.
Proof. compute. reflexivity. Qed.
Example test_blt_nat2: (blt_nat 2 4) = true.
Proof. compute. reflexivity. Qed.
Example test_blt_nat3: (blt_nat 4 2) = false.
Proof. compute. reflexivity. Qed.

Theorem plus_O_n : forall n:nat, 0 + n = n.
Proof.
  simpl. reflexivity.  Qed.

Theorem plus_O_n' : forall n:nat, 0 + n = n.
Proof.
  reflexivity.  Qed.

Eval simpl in (forall n:nat, n + 0 = n).

Eval simpl in (forall n:nat, 0 + n = n).

Theorem plus_O_n'' : forall n:nat, 0 + n = n.
Proof.
  intros n. reflexivity. Qed.

Theorem plus_1_l : forall n:nat, 1 + n = S n.
Proof.
  intros n. reflexivity.  Qed.

Theorem mult_0_l : forall n:nat, 0 * n = 0.
Proof.
  intros n. reflexivity.  Qed.

Theorem plus_id_example : forall n m:nat,
  n = m ->
  n + n = m + m.
Proof.
  intros n m. intros H. rewrite <- H. reflexivity.
Qed.

Theorem plus_id_exercise : forall n m o : nat,
  n = m -> m = o -> n + m = m + o.
Proof.
  intros n m o. intros H. intros M.
  rewrite -> H. rewrite -> M.
  reflexivity.
Qed.

Theorem mult_0_plus : forall n m : nat,
  (0 + n) * m = n * m.
Proof.
  intros n m.
  rewrite -> plus_O_n.
  reflexivity.
Qed.

Theorem mult_1_plus : forall n m : nat,
  (1 + n) * m = m + (n * m).
Proof.
  intros n m. reflexivity.
Qed.

Theorem plus_1_neq_0_firsttry : forall n : nat,
  beq_nat (n + 1) 0 = false.
Proof.
  intros n.  destruct n as [| n'].
    reflexivity.
    reflexivity.
Qed.

Theorem plus_1_neq_0 : forall n : nat,
  beq_nat (n + 1) 0 = false.
Proof.
  intros n. destruct n as [| n'].
    reflexivity.
    reflexivity. Qed.

Theorem negb_involutive : forall b : bool,
  negb (negb b) = b.
Proof.
  intros b. destruct b.
    reflexivity.
    reflexivity. Qed.

Theorem zero_nbeq_plus_1 : forall n : nat,
  beq_nat 0 (n + 1) = false.
Proof.
  intros n. destruct n as [| n'].
  reflexivity. reflexivity. Qed.

(* Case nameing *)
Require String. Open Scope string_scope.

Ltac move_to_top x :=
  match reverse goal with
  | H : _ |- _ => try move x after H
  end.

Tactic Notation "assert_eq" ident(x) constr(v) :=
  let H := fresh in
  assert (x = v) as H by reflexivity;
  clear H.

Tactic Notation "Case_aux" ident(x) constr(name) :=
  first [
    set (x := name); move_to_top x
  | assert_eq x name; move_to_top x
  | fail 1 "because we are working on a different case" ].

Tactic Notation "Case" constr(name) := Case_aux Case name.
Tactic Notation "SCase" constr(name) := Case_aux SCase name.
Tactic Notation "SSCase" constr(name) := Case_aux SSCase name.
Tactic Notation "SSSCase" constr(name) := Case_aux SSSCase name.
Tactic Notation "SSSSCase" constr(name) := Case_aux SSSSCase name.
Tactic Notation "SSSSSCase" constr(name) := Case_aux SSSSSCase name.
Tactic Notation "SSSSSSCase" constr(name) := Case_aux SSSSSSCase name.
Tactic Notation "SSSSSSSCase" constr(name) := Case_aux SSSSSSSCase name.

Theorem andb_true_elim1 : forall b c : bool,
  andb b c = true -> b = true.
Proof.
  intros b c H.
  destruct b.
  Case "b = true".
    reflexivity.
  Case "b = false".
  rewrite <- H. reflexivity. Qed.

Theorem andb_true_elim2 : forall b c : bool,
  andb b c = true -> c = true.
Proof.
  intros
    b c H.
  destruct  c.
  Case "c = true".
  reflexivity.
  Case "c = false".
  rewrite <- H.
  destruct b.
  SCase "b = true".
  reflexivity.
  SCase "b = false".
  reflexivity.
Qed.

(* Induction *)
Theorem plus_0_r_firsttry : forall n:nat,
  n + 0 = n.
Proof.
  intros n.
  simpl. Admitted.

Theorem plus_0_r_secondtry : forall n:nat,
  n + 0 = n.
Proof.
  intros n. destruct n as [| n'].
  Case "n = 0".
    reflexivity.   Case "n = S n'".
    simpl. Admitted.

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

Theorem minus_diag : forall n,
  minus n n = 0.
Proof.
  intros n. induction n as [| n'].
  Case "n = 0".
    simpl. reflexivity.
  Case "n = S n'".
  simpl. rewrite -> IHn'. reflexivity. Qed.

Theorem mult_0_r : forall n:nat,
  n * 0 = 0.
Proof.
  intros n. induction n as [| n'].
  Case "n = 0".
  simpl. reflexivity.
  Case "n = S n'".
  simpl. rewrite -> IHn'. reflexivity. Qed.

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

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

Fixpoint double (n:nat) :=
  match n with
  | O => O
  | S n' => S (S (double n'))
  end.

Lemma double_plus : forall n, double n = n + n .
Proof.
  intros n.
  induction n as [| n'].
  Case "n = 0".
  simpl. reflexivity.
  Case "n = S n'".
  simpl. rewrite -> IHn'. rewrite -> plus_n_Sm. reflexivity. Qed.

Theorem plus_assoc : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  intros n m p. induction n as [| n'].
  Case "n = 0".
    reflexivity.
  Case "n = S n'".
    simpl. rewrite -> IHn'. reflexivity. Qed.

Theorem mult_0_plus' : forall n m : nat,
  (0 + n) * m = n * m.
Proof.
  intros n m.
  assert (H: 0 + n = n).
    Case "Proof of assertion". reflexivity.
  rewrite -> H.
  reflexivity. Qed.

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

Theorem plus_swap : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  intros n m p.
  rewrite -> plus_comm.
  rewrite <- plus_assoc.
  assert (H : p + n = n + p).
  Case "Proof of assertion".
  rewrite -> plus_comm. reflexivity.
  rewrite -> H.
  reflexivity. Qed.

Theorem mult_help : forall n m: nat,
    n * S m = n + n * m.
Proof.
  intros n m.
  induction n as [| n'].
  SCase "n = 0".
  simpl. reflexivity.
  SCase "n = S n'".
  simpl. rewrite <- plus_swap. rewrite -> IHn'. reflexivity. Qed.

Theorem mult_comm : forall m n : nat,
    m * n = n * m.
Proof.
  intros n m.
  induction m as [| m'].
  Case "m = 0".
  simpl. induction n as [| n'].
  SCase "n = 0".
  reflexivity.
  SCase "n = S n'".
  simpl. rewrite -> IHn'. reflexivity.
  Case "m = S m'".
  simpl. rewrite <- IHm'. rewrite <- mult_help. reflexivity. Qed.

Theorem plus_swap' : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  intros n m p.
  rewrite -> plus_assoc.
  rewrite -> plus_assoc.
  replace (n + m) with (m + n).
  reflexivity.
  rewrite -> plus_comm. reflexivity. Qed.


Require Export TopologicalSpaces.
Require Export EnsemblesSpec.

Section interior_closure.

Variable X:TopologicalSpace.
Variable S:Ensemble (point_set X).

Definition interior := FamilyUnion
  [ U:Ensemble (point_set X) | open U /\ Included U S ].
Definition closure := FamilyIntersection
  [ F:Ensemble (point_set X) | closed F /\ Included S F ].

Lemma interior_open : open interior.
Proof.
apply open_family_union.
intros.
destruct H as [[]]; trivial.
Qed.

Lemma interior_deflationary : Included interior S.
Proof.
red; intros.
destruct H.
destruct H as [[]]; auto with sets.
Qed.

Lemma interior_fixes_open: open S -> interior = S.
Proof.
intros.
apply Extensionality_Ensembles; split.
apply interior_deflationary.
red; intros.
exists S; trivial.
constructor; auto with sets.
Qed.

Lemma interior_maximal: forall U:Ensemble (point_set X),
  open U -> Included U S -> Included U interior.
Proof.
intros.
red; intros.
exists U; trivial.
constructor; split; trivial.
Qed.

Lemma closure_closed : closed closure.
Proof.
apply closed_family_intersection.
intros.
destruct H as [[]]; trivial.
Qed.

Lemma closure_inflationary : Included S closure.
Proof.
red; intros.
constructor; intros.
destruct H0 as [[]].
auto with sets.
Qed.

Lemma closure_fixes_closed : closed S -> closure = S.
Proof.
intro.
apply Extensionality_Ensembles; split.
red; intros.
destruct H0.
apply H0; split; auto with sets.
apply closure_inflationary.
Qed.

Lemma closure_minimal: forall F:Ensemble (point_set X),
  closed F -> Included S F -> Included closure F.
Proof.
intros; red; intros.
destruct H1.
apply H1.
constructor; split; trivial.
Qed.

End interior_closure.

Arguments interior [X].
Arguments closure [X].
Arguments interior_open [X].
Arguments interior_deflationary [X].
Arguments interior_fixes_open [X].
Arguments interior_maximal [X].
Arguments closure_closed [X].
Arguments closure_inflationary [X].
Arguments closure_fixes_closed [X].
Arguments closure_minimal [X].

Section interior_closure_relations.

Variable X:TopologicalSpace.

Lemma interior_increasing: forall S T:Ensemble (point_set X),
  Included S T -> Included (interior S) (interior T).
Proof.
intros.
apply interior_maximal.
apply interior_open.
assert (Included (interior S) S).
apply interior_deflationary.
auto with sets.
Qed.

Lemma interior_intersection: forall S T:Ensemble (point_set X),
  interior (Intersection S T) =
  Intersection (interior S) (interior T).
Proof.
intros.
apply Extensionality_Ensembles; split.
assert (Included (interior (Intersection S T)) (interior S)).
apply interior_increasing.
auto with sets.
assert (Included (interior (Intersection S T)) (interior T)).
apply interior_increasing.
auto with sets.
auto with sets.

apply interior_maximal.
apply open_intersection2; apply interior_open.
pose proof (interior_deflationary S).
pose proof (interior_deflationary T).
red; intros x H1; constructor; (apply H || apply H0);
destruct H1; trivial.
Qed.

Lemma interior_union: forall S T:Ensemble (point_set X),
  Included (Union (interior S) (interior T))
           (interior (Union S T)).
Proof.
intros.
apply interior_maximal.
apply open_union2; apply interior_open.
pose proof (interior_deflationary S).
pose proof (interior_deflationary T).
auto with sets.
Qed.

Lemma complement_inclusion: forall {Y:Type} (S T:Ensemble Y),
  Included S T -> Included (Complement T) (Complement S).
Proof.
intros.
red; intros.
red; intro.
contradiction H0.
auto with sets.
Qed.

Lemma interior_complement: forall S:Ensemble (point_set X),
  interior (Complement S) = Complement (closure S).
Proof.
intros.
apply Extensionality_Ensembles; split.
rewrite <- Complement_Complement with (A:=interior (Complement S)).
apply complement_inclusion.
apply closure_minimal.
red.
rewrite Complement_Complement.
apply interior_open.
pattern S at 1;
rewrite <- Complement_Complement with (A:=S).
apply complement_inclusion.
apply interior_deflationary.

apply interior_maximal.
apply closure_closed.
apply complement_inclusion.
apply closure_inflationary.
Qed.

Lemma closure_increasing: forall S T:Ensemble (point_set X),
  Included S T -> Included (closure S) (closure T).
Proof.
intros.
apply closure_minimal.
apply closure_closed.
pose proof (closure_inflationary T).
auto with sets.
Qed.

Lemma closure_complement: forall S:Ensemble (point_set X),
  closure (Complement S) = Complement (interior S).
Proof.
intros.
pose proof (interior_complement (Complement S)).
rewrite Complement_Complement in H.
rewrite H.
rewrite Complement_Complement; reflexivity.
Qed.

Lemma closure_union: forall S T:Ensemble (point_set X),
  closure (Union S T) = Union (closure S) (closure T).
Proof.
intros.
apply Extensionality_Ensembles; split.
apply closure_minimal.
apply closed_union2; apply closure_closed.
pose proof (closure_inflationary S).
pose proof (closure_inflationary T).
auto with sets.

assert (Included (closure S) (closure (Union S T))).
apply closure_increasing; auto with sets.
assert (Included (closure T) (closure (Union S T))).
apply closure_increasing; auto with sets.
auto with sets.
Qed.

Lemma closure_intersection: forall S T:Ensemble (point_set X),
  Included (closure (Intersection S T))
           (Intersection (closure S) (closure T)).
Proof.
intros.
assert (Included (closure (Intersection S T)) (closure S)).
apply closure_increasing; auto with sets.
assert (Included (closure (Intersection S T)) (closure T)).
apply closure_increasing; auto with sets.
auto with sets.
Qed.

Lemma meets_every_open_neighborhood_impl_closure:
  forall (S:Ensemble (point_set X)) (x:point_set X),
  (forall U:Ensemble (point_set X), open U -> In U x ->
                                Inhabited (Intersection S U)) ->
  In (closure S) x.
Proof.
intros.
apply NNPP; intro.
pose proof (H (Complement (closure S))).
destruct H1.
apply closure_closed.
exact H0.
destruct H1.
contradiction H2.
apply closure_inflationary.
assumption.
Qed.

Lemma closure_impl_meets_every_open_neighborhood:
  forall (S:Ensemble (point_set X)) (x:point_set X),
  In (closure S) x ->
  forall U:Ensemble (point_set X), open U -> In U x ->
    Inhabited (Intersection S U).
Proof.
intros.
apply NNPP; intro.
assert (Included (closure S) (Complement U)).
apply closure_minimal.
unfold closed.
rewrite Complement_Complement; assumption.
red; intros.
intro.
contradiction H2.
exists x0; constructor; trivial.

contradict H1.
apply H3.
assumption.
Qed.

Definition dense (S:Ensemble (point_set X)) : Prop :=
  closure S = Full_set.

Lemma dense_meets_every_nonempty_open:
  forall S:Ensemble (point_set X), dense S ->
    forall U:Ensemble (point_set X), open U -> Inhabited U ->
    Inhabited (Intersection S U).
Proof.
intros.
destruct H1.
apply closure_impl_meets_every_open_neighborhood with x; trivial.
rewrite H; constructor.
Qed.

Lemma meets_every_nonempty_open_impl_dense:
  forall S:Ensemble (point_set X),
  (forall U:Ensemble (point_set X), open U -> Inhabited U ->
   Inhabited (Intersection S U)) ->
  dense S.
Proof.
intros.
apply Extensionality_Ensembles; split; red; intros.
constructor.
apply meets_every_open_neighborhood_impl_closure.
intros.
apply H; trivial.
exists x; trivial.
Qed.

End interior_closure_relations.

Arguments interior_increasing [X].
Arguments interior_intersection [X].
Arguments interior_union [X].
Arguments interior_complement [X].
Arguments closure_increasing [X].
Arguments closure_complement [X].
Arguments closure_union [X].
Arguments closure_intersection [X].
Arguments dense [X].

Section Build_from_closure.

Variable X:Type.
Variable cl : Ensemble X -> Ensemble X.
Hypothesis cl_inflationary: forall S:Ensemble X,
  Included S (cl S).
Hypothesis cl_respects_union: forall S1 S2:Ensemble X,
  cl (Union S1 S2) = Union (cl S1) (cl S2).
Hypothesis cl_empty: cl Empty_set = Empty_set.
Hypothesis cl_idempotent: forall S:Ensemble X,
  cl (cl S) = cl S.

Lemma cl_increasing: forall S1 S2:Ensemble X,
  Included S1 S2 -> Included (cl S1) (cl S2).
Proof.
intros.
replace S2 with (Union S1 S2).
rewrite cl_respects_union.
auto with sets.
apply Extensionality_Ensembles; split; auto with sets.
Qed.

Definition Build_TopologicalSpace_from_closure_operator : TopologicalSpace.
refine (Build_TopologicalSpace_from_closed_sets
  (fun F => cl F = F) _ _ _).
apply cl_empty.
intros.
rewrite cl_respects_union; congruence.
intros.
apply Extensionality_Ensembles; split; try apply cl_inflationary.
red; intros.
constructor; intros.
rewrite <- (H S H1).
apply cl_increasing with (FamilyIntersection F); trivial.
red; intros.
destruct H2.
apply H2; trivial.
Defined.

Lemma Build_TopologicalSpace_from_closure_operator_closure:
  forall S:Ensemble (point_set Build_TopologicalSpace_from_closure_operator),
    closure S = cl S.
Proof.
intros.
apply Extensionality_Ensembles; split.
apply closure_minimal.
apply <- Build_TopologicalSpace_from_closed_sets_closed.
apply cl_idempotent.
trivial.
replace (closure S) with (cl (closure S)).
apply cl_increasing.
apply (closure_inflationary S).
pose proof (closure_closed S).
apply -> Build_TopologicalSpace_from_closed_sets_closed in H.
exact H.
Qed.

End Build_from_closure.

Arguments Build_TopologicalSpace_from_closure_operator [X].


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

Definition prim_rec := nat_rec (fun i : nat => nat).

Definition addition (n m : nat) := prim_rec m (fun p rec:nat => S rec) n.

Eval compute in (addition (S (S O)) (S (S (S O)))).

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

Inductive bool : Set := true | false.
Check bool_ind.
Check bool_rec.
Check bool_rect.

Lemma duality : forall b:bool, b =true \/ b = false.
intro b.
elim b.
left; trivial.
right; trivial.
Qed.


(* Discrete Mathematics in Coq, based on definitions in Epp, 4th Edition *)

Require Import Omega.
Require Import Nat.
Require Import List.
Require Import Arith.
Require Import Coq.Program.Wf.

(* Section 2.1 *)

(* This is the encoding of a definition of a statement, p. 24.
   It's called "lem" because the formal name for this property is the
   "Law of the Excluded Middle."

   Not all logics include this notion, so it's not built into Coq. Instead,
   we declare it as an axiom. A logic that doesn't have L.E.M. is called
   constructive. A logic that does include L.E.M. is called classical. *)
Axiom lem : forall p, p \/ ~p.

Theorem and_comm : forall p q, p /\ q <-> q /\ p.
Proof.
  intro p. intro q. (* Suppose we have propositions p and q *)
  split. (* Two cases for the two directions of the arrow *)
  - intro p_and_q. (* Assume p /\ q *)
    destruct p_and_q. (* Decompose to reveal p and q. *)
    split. (* Prove q and p separately. *)
    + assumption. (* We've assumed q. *)
    + assumption. (* We've assumed p. *)
  - intro q_and_p.  (* similar *)
    destruct q_and_p.
    split.
    + assumption.
    + assumption.
Qed. (* QED *)

Theorem or_comm : forall p q, p \/ q <-> q \/ p.
Proof.
  intro p. intro q.
  split.
  - intro p_or_q.
    destruct p_or_q. (* Decompose into two possible cases: either p, or q. *)
    + right. (* We will prove the *right* choice of q \/ p. *)
      assumption.
    + left.
      assumption.
  - intro q_or_p.
    destruct q_or_p.
    + right.
      assumption.
    + left.
      assumption.
Qed.

Theorem and_assoc : forall p q r, (p /\ q) /\ r <-> p /\ (q /\ r).
Proof.
  intro p. intro q. intro r.
  split.
  - intro pq_r.
    destruct pq_r.
    destruct H.
    split.
    + assumption.
    + split.
      * assumption.
      * assumption.
  - intro p_qr.
    destruct p_qr.
    destruct H0.
    split.
    + split.
      * assumption.
      * assumption.
    + assumption.
Qed.

Theorem or_assoc : forall p q r, (p \/ q) \/ r <-> p \/ (q \/ r).
Proof.
  intro p. intro q. intro r.
  split.
  - intro pq_r.
    destruct pq_r.
    + destruct H.
      * left.
        assumption.
      * right.
        left.
        assumption.
    + right.
      right.
      assumption.
  - intro p_qr.
    destruct p_qr.
    + left.
      left.
      assumption.
    + destruct H.
      * left.
        right.
        assumption.
      * right.
        assumption.
Qed.

Theorem and_distrib : forall p q r, p /\ (q \/ r) <-> (p /\ q) \/ (p /\ r).
Proof.
  intro p. intro q. intro r.
  split.
  - intro and_or.
    destruct and_or.
    destruct H0.
    + left.
      split.
      * assumption.
      * assumption.
    + right.
      split.
      * assumption.
      * assumption.
  - intro and_or_and.
    destruct and_or_and.
    + destruct H.
      split.
      * assumption.
      * left.
        assumption.
    + destruct H.
      split.
      * assumption.
      * right.
        assumption.
Qed.

Theorem or_distrib : forall p q r, p \/ (q /\ r) <-> (p \/ q) /\ (p \/ r).
Proof.
  intro p. intro q. intro r.
  split.
  - intro or_and.
    destruct or_and.
    + split.
      * left.
        assumption.
      * left.
        assumption.
    + destruct H.
      split.
      * right.
        assumption.
      * right.
        assumption.
  - intro or_and_or.
    destruct or_and_or.
    destruct H.
    + left.
      assumption.
    + destruct H0.
      * left.
        assumption.
      * right.
        split.
        -- assumption.
        -- assumption.
Qed.

Theorem and_ident : forall p, p /\ True <-> p.
Proof.
  intro p.
  split.
  - intro p_and_True.
    destruct p_and_True.
    assumption.
  - intro pf_p.
    split.
    + assumption.
    + constructor. (* This proves True. *)
Qed.

Theorem or_ident : forall p, p \/ False <-> p.
Proof.
  intro p.
  split.
  - intro p_or_False.
    destruct p_or_False.
    + assumption.
    + contradiction. (* If you've assumed False, then you're in an impossible case. *)
  - intro pf_p.
    left.
    assumption.
Qed.

Theorem and_neg : forall p, p /\ ~p <-> False.
Proof.
  intro p.
  split.
  - intro p_and_not_p.
    destruct p_and_not_p.
    contradiction. (* This tactic also looks for two contradictory hypotheses. *)
  - intro false.
    contradiction.
Qed.

Theorem or_neg : forall p, p \/ ~p <-> True.
Proof.
  intro p.
  split.
  - intro p_or_not_p.
    constructor.
  - intro true.
    apply lem. (* Here, we have to use our L.E.M. axiom. That's what "apply" does. *)
Qed.

Theorem double_neg : forall p, ~(~p) <-> p.
Proof.
  intro p.
  split.
  - intro not_not_p.
    (* Negations aren't useful for much, other than providing contradictions. So,
       we need to use L.E.M. *)
    pose proof (lem p) as lem_p. (* pose proof brings an existing proof into scope. *)
    destruct lem_p.
    + assumption.
    + contradiction.
  - intro pf_p.
    (* To prove a negation, we assume the opposite and find a contradiction. This
       is done with intro. *)
    intro not_p.
    contradiction.
Qed.

Theorem and_idempotent : forall p, p /\ p <-> p.
Admitted. (* This is what you tell Coq when you don't want to prove it.
             Here, I'm leaving this as an exercise. *)

Theorem or_idempotent : forall p, p \/ p <-> p.
Admitted.

Theorem and_bound : forall p, p /\ False <-> False.
Admitted.

Theorem or_bound : forall p, p \/ True <-> True.
Admitted.

Theorem and_deMorgan : forall p q, ~(p /\ q) <-> ~p \/ ~q.
Proof.
  intro p. intro q.
  split.
  - intro not_p_and_q.
    pose proof (lem p) as lem_p.
    pose proof (lem q) as lem_q.
    destruct lem_p.
    + destruct lem_q.
      * exfalso. (* Use this when you know you have a contradiction *)
        apply not_p_and_q. (* If you're proving False, you can apply a ~(...) to
                              change the goal to prove (...). *)
        split.
        -- assumption.
        -- assumption.
      * right.
        assumption.
    + left.
      assumption.
  - intro not_p_or_not_q.
    destruct not_p_or_not_q.
    + intro p_and_q.
      destruct p_and_q.
      contradiction.
    + intro p_and_q.
      destruct p_and_q.
      contradiction.
Qed.

Theorem or_deMorgan : forall p q, ~(p \/ q) <-> ~p /\ ~q.
Proof.
  intro p. intro q.
  split.
  - intro not_p_or_q.
    split.
    + intro pf_p.
      apply not_p_or_q.
      left.
      assumption.
    + intro pf_q.
      apply not_p_or_q.
      right.
      assumption.
  - intro not_p_and_not_q.
    destruct not_p_and_not_q.
    intro p_or_q.
    destruct p_or_q.
    + contradiction.
    + contradiction.
Qed.

Theorem and_absorption : forall p q, p /\ (p \/ q) <-> p.
Admitted.

Theorem or_absorption : forall p q, p \/ (p /\ q) <-> p.
Admitted.

Theorem not_true : ~ True <-> False.
Proof.
  split.
  - intro not_true.
    contradiction.
  - intro false.
    contradiction.
Qed.

Theorem not_false : ~ False <-> True.
Proof.
  split.
  - intro not_false.
    constructor.
  - intro true.
    intro false.
    contradiction.
Qed.

Theorem problem_2_1_53 : forall p q, ~((~p /\ q) \/ (~p /\ ~q)) \/ (p /\ q) <-> p.
Proof.
  intro p. intro q.
  rewrite or_deMorgan. (* rewrite uses a proof of equivalence to rewrite the goal *)
  rewrite and_deMorgan.
  rewrite and_deMorgan.
  rewrite double_neg.
  rewrite double_neg.
  rewrite <- or_distrib. (* this variant rewrites right-to-left *)
  rewrite and_comm.
  rewrite and_neg.
  rewrite or_ident.
  rewrite or_absorption.
  reflexivity. (* this solves a reflexive equivalence goal *)
Qed.

Theorem problem_2_1_52 : forall p q, ~(p \/ ~q) \/ (~p /\ ~q) <-> ~p.
Admitted. (* Exercise *)

(* Section 2.2 *)

Theorem implication : forall (p q : Prop), (p -> q) <-> (~p \/ q).
(* Note that Coq allows us to say what we're quantifying over. Above, it could
   always infer it. But, (->) is overloaded, so we need to tell Coq. *)
Proof.
  intro p. intro q.
  split.
  - intro implic.
    pose proof (lem p) as lem_p.
    destruct lem_p.
    + right.
      (* Here, we know (p -> q) and we're trying to prove q. If we `apply implic`, then
         our goal will reduce to just p. *)
      apply implic.
      assumption.
    + left.
      assumption.
  - intro or.
    intro pf_p. (* we can assume p here, because we're proving (p -> q) *)
    destruct or.
    + contradiction.
    + assumption.
Qed.

Theorem neg_implication : forall (p q : Prop), ~(p -> q) <-> p /\ ~q.
Admitted.

Theorem contrapositive : forall (p q : Prop), (p -> q) <-> (~q -> ~p).
Proof.
  intro p. intro q.
  rewrite implication.
  rewrite implication.
  rewrite double_neg.
  rewrite or_comm.
  reflexivity.
Qed.

(* Section 3.2 *)

Theorem forall_deMorgan : forall {A} {P : A -> Prop}, ~(forall x, P x) <-> exists y, ~(P y).
Proof.
  intro A. intro P.
  split.
  - intro not_forall.
    rewrite <- double_neg.
    intro not_exists.
    apply not_forall.
    intro x.
    rewrite <- double_neg.
    intro not_pred.
    apply not_exists.
    exists x. (* This is how we choose the value of an existential variable. *)
    assumption.
  - intro ex.
    destruct ex. (* You can use destruct to get a given existential variable. *)
    intro all.
    specialize (all x). (* instantiate a forall *)
    contradiction.
Qed.

Theorem exists_deMorgan : forall {A} {P : A -> Prop}, ~(exists x, P x) <-> forall y, ~(P y).
Proof.
  intro A. intro P.
  split.
  - intro not_exists.
    intro y.
    intro pred_y.
    apply not_exists.
    exists y.
    assumption.
  - intro all.
    intro ex.
    destruct ex.
    specialize (all x).
    contradiction.
Qed.

(* Section 3.3 *)

(* There exists a positive integer m such that for all positive integers n, m <= n. *)
Theorem example_3_3_5 : exists m, m > 0 /\ forall n, n > 0 -> m <= n.
Proof.
  exists 1. (* Choose the value for the existential. *)
  split.
  - omega. (* This solves most basic arithmetic problems. *)
  - intro n.
    intro pos.
    omega.
Qed.

(* Section 4.1 *)
Definition even n := exists k, n = 2 * k.
Definition odd n  := exists k, n = 2 * k + 1.

Definition prime n := n > 1 /\ forall r s, (r > 0 /\ s > 0 /\ n = r * s) -> (r = n \/ s = n).
Definition composite n := exists r s, r > 0 /\ s > 0 /\ n = r * s /\ 1 < r < n /\ 1 < s < n.

Theorem two_prime : prime 2.
Proof.
  unfold prime. (* This unfolds a definition in the goal. *)
  split.
  - omega.
  - intro r.
    intro s.
    intro Hyp.
    destruct Hyp.
    destruct H0.
    destruct r. (* either r is 0 or greater than 0. *)
    + omega.
    + destruct s.
      * omega.
      * destruct r.
        -- destruct s.
           ++ omega.
           ++ destruct s.
              ** omega.
              ** omega.
        -- destruct s.
           ++ omega.
           ++ simpl in H1.
              rewrite <- plus_n_Sm in H1.
              inversion H1.
Qed.
(* That proof got a little ugly, because we had to look at all possibilities for r and s
   below two. *)

Theorem six_composite : composite 6.
Proof.
  unfold composite.
  exists 2.
  exists 3.
  split.
  - omega.
  - split.
    + omega.
    + split.
      * omega.
      * split.
        -- omega.
        -- omega.
Qed.

(* Coq can do induction! *)
Theorem even_or_odd : forall n, even n \/ odd n.
Proof.
  intro n.
  induction n. (* This performs natural number induction on n. *)
  - left.
    exists 0.
    omega.
  - destruct IHn.
    * right.
      destruct H.
      exists x.
      omega.
    * left.
      destruct H.
      exists (x+1).
      omega.
Qed.

Theorem not_odd__even : forall n, ~ (odd n) <-> even n.
Proof.
  intro n.
  split.
  * intro not_odd.
    pose proof (even_or_odd n).
    destruct H.
    - assumption.
    - contradiction.
  * intro pf_even.
    intro pf_odd.
    destruct pf_even.
    destruct pf_odd.
    subst. (* This performs all substitutions Coq can find. *)
    omega.
Qed.

Theorem problem_4_1_28 : forall n, odd n -> odd (n * n).
Proof.
  intro n. intro Hodd.
  unfold odd in *. (* unfold everywhere *)
  destruct Hodd.
  (* (2x+1)(2x+1) = 4x^2 + 4x + 1 = 2(2*x^2 + 2*x) + 1 *)
  exists (2 * x * x + 2 * x).
  subst.
  ring. (* like omega, but works better with multiplication *)
Qed.

Theorem problem_4_1_27 : forall n m, (odd m /\ odd n) -> odd (m + n).
Admitted.

Theorem problem_4_1_30 : forall m, even m -> odd (3 * m + 5).
Admitted.


Module NaturalNumPlayground.

Inductive nat : Type :=
    | O
    | S (n : nat).

Check S ( S O) : nat.

Definition pred (n : nat) :=
    match n with
    | O => O
    | S n' => n'
    end.

Compute pred (S (S (S O))).

End NaturalNumPlayground.

Check (S (S (S O))).

Definition minustwo (n : nat) : nat :=
    match n with
    | O => O
    | S O => O
    | S (S n') => n'
    end.

Compute (minustwo 4).

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

Definition isodd (n : nat) : bool :=
    match n with
    | n => negb(iseven n)
    end.

Example check_is_even : (iseven 16) = true.
Proof. simpl. reflexivity. Qed.

Example check_is_odd : (isodd 17) = true.
Proof. simpl. reflexivity. Qed.

Module NaturalPlayground2.

Fixpoint plus (n m : nat) : nat :=
    match n with
    | O => m
    | S n' => (plus n' m)
    end.

End NaturalPlayground2.


Require Import Coq.Arith.PeanoNat.

(* is_even and is_odd (recursive definition) *)
Fixpoint
  is_odd (n:nat) : bool :=
  match n with
  | 0 => false
  | S x => is_even x
  end

  with

  is_even (n:nat) : bool :=
  match n with
  | 0 => true
  | S x => is_odd x
  end.

(* if n is odd, it is not even *)
Theorem odd_is_not_even :
  forall n, (is_odd n = true) -> (is_even n = false).
intros.
replace false with (negb true) by reflexivity.
rewrite <- H.
clear H.
induction n.
- reflexivity.
- simpl. rewrite IHn. destruct (is_odd n); reflexivity.
Qed.


Require Import Lia.

(* Un if con ambas ramas iguales es igual al resultado de las ramas. *)
Lemma obvious_if: forall (A: Type) (b:bool) (x: A), (if b then x else x) = x.
Proof.
intros.
destruct b; reflexivity.
Qed.

(* 2n es par para toda n... *)
Lemma even_2n: forall (n:nat), Nat.even(2*n) = true.
Proof.
induction n.
+ simpl; trivial.
+ simpl.
  assert (n + S (n + 0) = S (2 * n)).
  * lia.
  * rewrite H.
    trivial.
Qed.


(* Here we'll prove properties of your function-based implementation of dictionary. *)
Require Import b1.
(* If you find out that your implementation is incorrect,
   go back to the previous file, fix it,
   then run 'make' and restart this proof to load the new implementation. *)

(* You can do the exercises in the order they appear
   or jump straight into the NatDictProofs section
   and prove the previous statements when needed. *)

(* Tacticts needed for this exercises:
   - General-purpose tactics usable both in goal and premises
     - rewrite
     - apply
     - destruct
     - unfold
   - Tactics working with the goal:
     - intros
     - left / right
     - exfalso
     - split
     - simpl
   - Tactics that finish the proof (besides 'apply'):
     - inversion
       this is a general tactic, but for now we just derive contradictions with it
     - reflexivity
 *)

(* Tactics cheatsheet:
   https://www.cs.cornell.edu/courses/cs3110/2018sp/a5/coq-tactics-cheatsheet.html
*)

Section IfProofs.

  (* Show the following helper lemmas. *)
  (* Use 'rewrite' tactic to simplify the 'if' expression *)

  Lemma if_true_helper {A: Type} (b: bool) (a1 a2: A) (TRUE: b = true):
    (if b then a1 else a2) = a1.
  Proof.
  rewrite TRUE.
  reflexivity.
  Qed.

  Lemma if_false_helper {A: Type} (b: bool) (a1 a2: A) (FALSE: b = false):
    (if b then a1 else a2) = a2.
  Proof.
  rewrite FALSE.
  reflexivity.
Qed.

End IfProofs.

Section LogicProofs.

  Lemma neg_equiv (P Q: Prop) (EQUIV: P <-> Q):
    not P <-> not Q.
  Proof.
    Locate "<->".
    Print iff.
    unfold iff.
    unfold iff in EQUIV.

    Restart.

    unfold iff in *.
    destruct EQUIV as [pq qp].
    split.
    { intros np.
      Locate "~".
      Print not.
      unfold not in *. intros q.
      apply np. apply qp. apply q. }

    intros nq p. apply nq, pq, p.
  Qed.

  (* Show that boolean has only two values.
     Use 'destruct' tactic to perform case splitting.
     It will generate one goal per splitting result.
     To select the next goal, use '-' (see the proof above). *)
  Lemma bool_true_or_false (b: bool):
    b = true \/ b = false.
  Proof.
  destruct b.
  { left.
  reflexivity.
  }
  right.
  reflexivity.
Qed.
(*  unfold or *)

  (* Show the equivalence of two notions of boolean being false.
     An equivalence can be proven by showing two corresponding implications.
     To introduce the premise of an implication, use 'intros name' (picking the 'name' appropriately).
     Remember that you can use general-purpose tactics with 'in' modifier
     which allows to perform the corresponding action in the proof context.
*)
  Lemma false_is_not_true (b: bool):
    b = false <-> b <> true.
  Proof.
  unfold not.
  unfold iff.
  split.
  {destruct b.
    {
    intros h1.
    intros h2.
    inversion h1.
    }
    {intros h1.
    intros h2.
    inversion h2.
    }
  }
  {destruct b.
    {
    intros h1.
    destruct h1.
    reflexivity.
    }
    {
    intros h1.
    reflexivity.
    }
  }
Qed.

End LogicProofs.

Section NatEqProofs.

  (* This proof involves induction which we'll cover at the next seminar. *)
  Lemma nat_eq_refl (n: nat):
    nat_eq n n = true.
  Proof.
    induction n as [| n IHn].
    { simpl. reflexivity. }
    simpl. apply IHn.
  Qed.

  (* Here we give the specification to the 'nat_eq' function.
     That is, we precisely relate the output of 'nat_eq' function
     and properties of its arguments. *)

  (* So far we're only able to prove the half of the specification. *)
  Lemma eq_implies_nat_eq (n1 n2: nat):
    n1 = n2 -> nat_eq n1 n2 = true.
  Proof.
  intros h1.
  rewrite h1.
  apply nat_eq_refl.
Qed.

  (* This part of the specification, again, involves induction. *)
  Lemma nat_eq_implies_eq (n1 n2: nat):
    nat_eq n1 n2 = true -> n1 = n2.
  Proof.
    generalize dependent n2. induction n1.
    { intros. simpl in H. destruct n2; auto. inversion H. }
    intros. destruct n2; simpl in H.
    { inversion H. }
    apply IHn1 in H. rewrite H. reflexivity.
  Qed.

  (* Finally, this is the specification of 'nat_eq'. *)
  Lemma nat_eq_spec (n1 n2: nat):
    nat_eq n1 n2 = true <-> n1 = n2.
  Proof.
  unfold iff.
  split.
  {apply nat_eq_implies_eq. }
  {apply eq_implies_nat_eq. }
Qed.

  (* This is an obvious reformulation of 'nat_eq' specification.
     The specification, however, cannot be directly applied to prove this version.
     Fortunately, by this moment we have auxiliary statements
     that will eventually allow to reuse the specification.
     One way to prove this will be to show equivalence
     via an intermediate assertion.
     To do this, start with the 'iff_trans' lemma in this way:
     'apply (@iff_trans P Q R)' replacing P, Q and R with statements you need.
     To find out what Q should be,
     look at negation-related lemmas we've proved before.
 *)
  Lemma nat_eq_neg_spec (n1 n2: nat):
    nat_eq n1 n2 = false <-> n1 <> n2.
  Proof.

  apply (@iff_trans (nat_eq n1 n2 = false) (nat_eq n1 n2 <> true) (n1 <> n2)).
  { apply false_is_not_true. }
  { apply neg_equiv.
  apply nat_eq_spec. }
Qed.

  (* After you've proved the statement above, read about the 'eapply' tactic.
     The usage of 'eapply' allows to avoid specifying
     all the parameters of a lemma you've been applying.
     Replace the 'apply (@iff_trans P Q R)' with simply 'eapply iff_trans'
     and analyze how the proof proceeds.
     You can use 'eapply' in the subsequent proofs as well. *)

End NatEqProofs.

Section UpdProofs.
  Context {V: Type}.

  (* Prove that the updated function applied to the changed key is the new value. *)
  (* To exploit the term definition, use 'unfold' tactic. *)
  Lemma update_latest (f: nat -> V) (n: nat) (v: V):
    (upd f n v) n = v.
  Proof.
  unfold upd.
  rewrite nat_eq_refl.
  reflexivity.
Qed.

  (* Prove that update affect only one value *)
  (* Use the helper lemma for 'if'.  *)
  Lemma update_others (f: nat -> V) (n: nat) (v: V) (n': nat) (NEQ: n <> n'):
    (upd f n v) n' = f n'.
  Proof.
  unfold upd.
  apply nat_eq_neg_spec in NEQ.
  rewrite NEQ.
  reflexivity.
Qed.

End UpdProofs.

Section NatDictProofs.

  Context {V: Type}.

  (* Prove that new dictionary actually contains nothing. *)
  Lemma new_dict_empty (n: nat):
    contains' (@new_dict' V) n = false.
  Proof.
  unfold new_dict'.
  unfold contains'.
  unfold get'.
  reflexivity.
Qed.

  (* Prove that the inserted value gets retrieved *)
  Lemma insert_latest (d: @nat_dict_fun V) (n: nat) (v: V):
    get' (insert' d n v) n = Some v.
  Proof.
  unfold insert'.
  unfold get'.
  apply update_latest.
Qed.

  (* Prove that removed key is no more contained in the dict *)
  Lemma removed_not_contained (d: @nat_dict_fun V) (n: nat):
    contains' (remove' d n) n = false.
  Proof.
  unfold remove'.
  unfold contains'.
  unfold get'.
  rewrite update_latest.
  reflexivity.
Qed.

  (* Prove that insert doesn't affect other values *)
  Lemma insert_others (d: @nat_dict_fun V) (n: nat) (v: V) (n': nat) (NEQ: n <> n'):
    get' (insert' d n v) n' = get' d n'.
  Proof.
  unfold insert'.
  unfold get'.
  apply update_others, NEQ.
Qed.

  (* Prove that updating a dictionary with a value it already has yields the same dictionary *)
  (* You may want to prove an helper lemma beforehand. *)
  (* Also, remember that 'destruct' can be used not only on variables,
     but also on an arbitrary term.
     It can be used to separate cases when insert does matter and doesn't. *)

  Lemma n_eq_or_neq (n n': nat): (n=n')\/(n<>n').
  Proof.
  pattern n, n'.
  apply (nat_double_ind).
  {
    intros n0.
    destruct n0.
    auto.
    auto.
  }
  {
    intros n0.
    auto.
  }
  {
    intros n0 m.
    intros h.
    destruct h.
    auto.
    auto.
  }
Qed.

  Lemma insert_same (d: @nat_dict_fun V) (n: nat) (v: V)
        (HAD_V: get' d n = Some v):
    forall n', get' (insert' d n v) n' = get' d n'.
  Proof.
  intros n'.
  remember (n=n' \/ n<>n') as n_eq_n'.

  destruct (n_eq_or_neq n n').
  {
    rewrite H.
  unfold insert'.
  unfold get' in *.
  unfold upd.
  rewrite H in HAD_V.
  rewrite HAD_V.
  rewrite nat_eq_refl.
  reflexivity.
  }
  unfold insert'.
  unfold get'.
  apply insert_others.
  apply H.
Qed.

  (* Prove that inserting a value twice is the same as inserting it once *)
  Lemma insert_twice (d: @nat_dict_fun V) (n: nat) (v: V):
    forall n', get' (insert' (insert' d n v) n v) n' = get' (insert' d n v) n'.
  Proof.
  remember (insert' d n v) as d'.
  apply insert_same.
  rewrite Heqd'.
  apply insert_latest.
Qed.

End NatDictProofs.


From LF Require Export Lists.

Inductive boollist : Type :=
  | bool_nil
  | bool_cons (b : bool) (l : boollist).

(* polymorphic inductive type definitions *)
Inductive list (X: Type) : Type :=
  | nil
  | cons (x: X) (l : list X).

(*
  The definition of list is a function from Types to
  Inductive definitions.
  A list is a function from Types to Types.
  For any particular type X, the type list X is the
  Inductively defined set of lists whose elements are
  of type X.
*)

Check list: Type -> Type.

(*
  The X is now a parameter for the constructors nil and cons,
  what means they are now polymorphic constructors. When we
  use them, we must provide a first argument that is the
  type of the list they are building. For example, nil nat
  constructs the empty list of type nat.
*)

Check (nil nat) : list nat.
Check (cons nat 3 (nil nat)) : list nat.

Check nil : forall X : Type, list X.

Check cons : forall X: Type, X -> list X -> list X.

(* polymorphic version of the repeat function *)

Fixpoint repeat (X : Type) (x: X) (count : nat) : list X :=
  match count with
  | 0 => nil X
  | S count' => cons X x (repeat X x count')
  end.

Example test_repeat1 :
  repeat nat 4 2 = cons nat 4 (cons nat 4 (nil nat)).
Proof. reflexivity. Qed.

Example test_repeat2 :
  repeat bool false 1 = cons bool false (nil bool).
Proof. reflexivity. Qed.

(* mumble grumble *)
Module MumbleGrumble.

(* mumble is a Set that contains a, b, or c*)
Inductive mumble : Type :=
  | a
  | b (x : mumble) (y : nat)
  | c.

(* grumble is Type -> Type *)
Inductive grumble (X : Type) : Type :=
  | d (m : mumble)
  | e (x : X).

(** Which of the following are well-typed elements of [grumble X] for
    some type [X]?  (Add YES or NO to each line.)
      - [d (b a 5)] NO, you have to add the type argument
      - [d mumble (b a 5)] YES
      - [d bool (b a 5)] YES (it returns grumble bool)
      - [e bool true] YES
      - [e mumble (b c 0)] YES
      - [e bool (b c 0)] NO, because the e constructor must have the
                        same argument that is binded to X, but we are
                        using X = bool and b c 0 is of type mumble.
      - [c] YES *)

Check mumble.
Check grumble.

Check d bool (b a 5).
Check e mumble (b c 0).
Check c.
Check d (nat). (* mumble -> grumble nat *)
(* mumble is the type argument*)
Check d mumble (b a 5).

End MumbleGrumble.

(* Type annotation inference *)

Fixpoint repeat' X x count : list X :=
  match count with
  | 0 => nil X
  | S count' => cons X x (repeat' X x count')
  end.

Check repeat'
  : forall X : Type, X -> nat -> list X.
Check repeat
  : forall X : Type, X -> nat -> list X.

(*
 It has exactly the same type as repeat. Coq was able to use type inference to deduce what the types of X, x, and count must be, based on how they are used. For example, since X is used as an argument to cons, it must be a Type, since cons expects a Type as its first argument; matching count with 0 and S means it must be a nat; and so on.
This powerful facility means we don't always have to write explicit type annotations everywhere, although explicit type annotations can still be quite useful as documentation and sanity checks, so we will continue to use them much of the time.

*)

(* Type argument synthesis *)
(* similar to type annotation inference. we use "holes"
  totell Coq to attempt to infer the missing information.
*)

Fixpoint repeat'' X x count : list X :=
  match count with
  | 0 => nil _
  | S count' => cons _ x (repeat'' _ x count')
  end.

(* Implicit arguments *)
(* we can avoid writing _'s by telling Coq to always
  infer the type arguments of a given function.
  The Arguments directive specifies the name of the
  function (or constructor) then lists the (leading)
  argument names to be treated as implicit, each
  surrounded by curly braces.
*)

Arguments nil {X}.
Arguments cons {X}.
Arguments repeat {X}.

(* now we dont' have to supply any type arguments *)
Definition list123'' := cons 1 (cons 2 (cons 3 nil)).

(*Alternatively, we can declare an argument to be
  implicit when defining the function itself, by
  surrounding it in curly braces instead of parens.  *)

Fixpoint repeat''' {X : Type} (x: X) (count : nat) : list X :=
  match count with
  | 0 => nil
  | S count' => cons x (repeat''' x count')
  end.

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

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

Fixpoint length {X : Type} (l: list X) : nat :=
  match l with
  | nil => 0
  | cons _ l' => S (length l')
  end.

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

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

Example test_length1: length (cons 1 (cons 2 (cons 3 nil))) = 3.
Proof. reflexivity. Qed.

(* Supplying type arguments explicitly *)

(* The example below fails because nil is a constructor
of Type list. However, even though list has implicit type
arguments, Coq has no info available to infer the type of nil below. *)
Fail Definition mynil := nil.

(* @ is used to force implicit arguments to be explicit*)

Check @nil : forall X : Type, list X.
Definition mynil' := @nil nat.

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

(* Exercises *)
Theorem app_nil_r : forall (X:Type), forall l: list X,
  l ++ [] = l.
Proof.
  intros T l.
  induction l as [| h t IHl].
  - reflexivity.
  - simpl. rewrite IHl. reflexivity.
Qed.

Theorem app_assoc : forall A (l m n : list A),
  l ++ m ++ n = (l ++ m) ++ n.
Proof.
  intros T l m n.
  induction l as [| h t IHl].
  - simpl. reflexivity.
  - simpl. rewrite IHl. reflexivity.
Qed.

Lemma app_length : forall (X: Type) (l1 l2 : list X),
  length (l1 ++ l2) = length l1 + length l2.
Proof.
  intros T l1 l2.
  induction l1 as [| h1 t1 IHl1].
  - simpl. reflexivity.
  - simpl. rewrite IHl1. reflexivity.
Qed.

Theorem rev_app_distr: forall X (l1 l2 : list X),
  rev (l1 ++ l2) = rev l2 ++ rev l1.
Proof.
  intros T l1 l2.
  induction l1 as [| h1 t1 IHl1].
  - simpl. rewrite app_nil_r. reflexivity.
  - simpl. rewrite app_assoc. rewrite IHl1. reflexivity.
Qed.

Theorem rev_involutive : forall X : Type, forall l : list X,
  rev (rev l) = l.
Proof.
  intros T l.
  induction l as [| h t IHl].
  - reflexivity.
  - simpl. rewrite rev_app_distr. simpl.
    rewrite IHl. reflexivity.
Qed.

(* Polymorphic Pairs or products *)
Inductive prod (X Y : Type) : Type :=
  | pair (x : X) (y: Y).

Arguments pair {X} {Y}.

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

Notation "X * Y" := (prod X Y) : type_scope.

(* (x,y) is a value built from two other values, while
  x*y is a type built from two other types. *)

Definition fst {X Y : Type} (p: X * Y) : X :=
  match p with
  | (x, y) => x
  end.

Definition snd {X Y : Type} (p : X * Y) : Y :=
  match p with
  | (x, y) => y
  end.

(* zip takes two lists and combine them
  into a list of pairs *)

Fixpoint combine {X Y : Type} (lx : list X) (ly : list Y)
    : list (X*Y) :=
  match lx, ly with
  | [], _ => []
  | _, [] => []
  | x :: tx, y :: ty => (x, y) :: (combine tx ty)
  end.

Check combine.
Compute (combine [1;2] [false;false;true;true]).

(* split takes a list of pairs and returns a pair
  of lists. it is also called unzip *)

Fixpoint split {X Y : Type} (l: list (X*Y)) : (list X) * (list Y) :=
  match l with
  | [] => ([], [])
  | (x, y) :: l' => match (split l') with
                    | (x', y') => (x::x', y::y')
                    end
  end.

Example test_split:
  split [(1,false);(2,false)] = ([1;2],[false;false]).
Proof.
  reflexivity. Qed.

(* Polymorphic Options *)
Module OptionPlayground.

Inductive option (X: Type) : Type :=
  | Some (x : X)
  | None.

Arguments Some {X}.
Arguments None {X}.

End OptionPlayground.

Fixpoint nth_error {X : Type} (l : list X) (n : nat) :=
  match l with
  | nil => None
  | a :: l' => match n with
              | O => Some a
              | S n' => nth_error l' 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 [[1];[2]] 1 = Some [2].
Proof. reflexivity. Qed.
Example test_nth_error3 : nth_error [true] 2 = None.
Proof. reflexivity. Qed.

Definition hd_error {X : Type} (l : list X) : option X :=
  match l with
  | nil => None
  | h :: t => Some h
  end.

Check @hd_error : forall X : Type, list X -> option X.
Example test_hd_error1 : hd_error [1;2] = Some 1.
Proof. reflexivity. Qed.
Example test_hd_error2 : hd_error [[1];[2]] = Some [1].
Proof. reflexivity. Qed.

(* Functions as Data *)
Definition doit3times {X : Type} (f: X->X) (n : X): X :=
  f (f (f n)).
(* applies f three times to some value n *)

 Fixpoint filter {X:Type} (test: X->bool) (l:list X) : list X :=
  match l with
  | [] => []
  | h :: t =>
    if test h then h :: (filter test t)
    else filter test t
  end.

Example test_filter1: filter even [1;2;3;4] = [2;4].
Proof. reflexivity. Qed.

Definition length_is_1 {X : Type} (l : list X) : bool :=
  (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 odd 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.

Definition filter_even_gt7 (l : list nat) : list nat :=
  filter (fun n => (7 <=? n) && even 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 :=
(filter test l, filter (fun x => negb (test x)) l).
(* we create a pair with the resulting lists
  from applying filter with test to each element
  and from applying filter with the negb of test
  to each element of the list (using an anonymous
  function
*)

Example test_partition1: partition odd [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.

(* Map *)
Fixpoint map {X Y : Type} (f: X->Y) (l : list X) : list Y :=
  match l with
  | [] => []
  | h :: t => (f h) :: (map f t)
  end.

Example test_map1: map (fun x => plus 3 x) [2;0;2] = [5;3;5].
Proof. reflexivity. Qed.

(* The element types of the input and output lists need not
   be the same, since map takes two type arguments, X and Y.
*)

Example test_map2:
  map odd [2;1;2;5] = [false;true;false;true].
Proof. reflexivity. Qed.

(*
  It can even be applied to a list of numbers and a
  function from numbers to lists of booleans to yield
  a list of lists of booleans:
*)

 Example test_map3:
    map (fun n => [even n;odd n]) [2;1;2;5]
  = [[true;false];[false;true];[true;false];[false;true]].
Proof. reflexivity. Qed.

(* map and rev are commutative *)

(* Auxiliar theorem: distributive on map app *)

(* both have type X as this is the type of the input list.
   we apply a function X->Y to each element of each list, so
   in the end we append two lists of type Y.*)
Theorem map_app_distr: forall (X Y : Type) (f: X -> Y) (l1 l2: list X),
  map f (l1 ++ l2) = map f l1 ++ map f l2.
Proof.
  intros X Y f l1 l2.
  induction l1 as [| h1 t1 IHl1].
    - reflexivity.
    - simpl. rewrite IHl1. reflexivity.
Qed.

Theorem map_rev : forall (X Y : Type) (f: X -> Y) (l: list X),
  map f (rev l) = rev (map f l).
Proof.
  intros X Y f l.
  induction l as [| h t IHl].
  - reflexivity.
  - simpl. rewrite <- IHl. rewrite map_app_distr.
    simpl. reflexivity.
Qed.

(* flat_map: a map that uses a function of type X->list Y *)

Fixpoint flat_map {X Y: Type} (f: X -> list Y) (l: list X) : list Y :=
  match l with
  | [] => []
  | h :: t => (f h) ++ (flat_map f t)
  end.

Example test_flat_map1:
  flat_map (fun n => [n;n;n]) [1;5;4]
  = [1; 1; 1; 5; 5; 5; 4; 4; 4].
Proof. reflexivity. Qed.

Definition option_map {X Y : Type} (f : X -> Y) (xo : option X)
                      : option Y :=
  match xo with
  | None => None
  | Some x => Some (f x)
  end.

(* Fold *)
 Fixpoint fold {X Y: Type} (f : X->Y->Y) (l : list X) (b : Y)
                         : Y :=
  match l with
  | nil => b
  | h :: t => f h (fold f t b)
  end.

Check (fold andb) : list bool -> bool -> bool.
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.

(* functions that construct functions *)

Definition constfun {X: Type} (x: X) : nat -> X :=
  fun (k: nat) => x.

(* ftrue is built from constfun *)
Definition ftrue := constfun true.

Example constfun_example1 : ftrue 0 = true.
Proof. reflexivity. Qed.

Example constfun_example2 : (constfun 5) 99 = 5.
Proof. reflexivity. Qed.

Check plus: nat -> nat -> nat.

(*
  The function "plus" by itself has three binary operators.
  As it is right-associative, it is the same as writing
  nat -> (nat -> nat).
  Plus is a one-argument function that takes nat and returns
  a one-argument function that takes another nat and returns
  a nat.

  Basically: one argument -> function (partial application)
  two arguments -> number
*)

Definition plus3 := plus 3.
Check plus3 : nat -> nat.
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.

(* Additional exercises *)
Module Exercises.

Definition fold_length {X : Type} (l : list X) : nat :=
  fold (fun _ n => S n) l 0.
Example test_fold_length1 : fold_length [4;7;0] = 3.
Proof. reflexivity. Qed.

Theorem fold_length_correct : forall X (l : list X),
  fold_length l = length l.
Proof.
  intros X l.
  induction l as [| h t IHl].
  - reflexivity.
  - simpl. rewrite <- IHl. reflexivity.
Qed.

(* fold applies a binary operator between every two elements of a list *)
(* the return of our anonymous function should be a list *)

Definition fold_map {X Y: Type} (f: X -> Y) (l: list X) : list Y :=
  fold (fun h t => f h::t ) l [].

Theorem fold_map_correct : forall X Y (f: X -> Y) (l: list X),
  fold_map f l = map f l.
Proof.
  intros.
  induction l as [| h t IHl].
  - simpl. reflexivity.
  - simpl. rewrite <- IHl. reflexivity.
Qed.

(* Currying *)
Definition prod_curry {X Y Z : Type}
  (f : X * Y -> Z) (x : X) (y : Y) : Z := f (x, y).

Check prod_curry.

(* To uncurry, we need to "destruct" the pair from
  p. *)
Definition prod_uncurry {X Y Z : Type}
  (f : X -> Y -> Z) (p : X * Y) : Z :=
  match p with
  | (x, y) => f x y
  end.

Check @prod_curry.
Check @prod_uncurry.

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.
  intros.
  destruct p as [x y].
  reflexivity.
Qed.


Require Import List String Omega ZArith.

Local Open Scope string_scope.
Local Open Scope list_scope.
Local Open Scope Z_scope.

Definition channel : Type := list string.
Definition msg : string := " ""Message."" ".
Record netstate := NetState {t : Z; r : Z; c1 : channel; c2 : channel}.
Definition initial := {| t := 5 ; r := 5 ; c1 := nil ; c2 := nil |}.

Inductive netEvalR : netstate -> netstate -> Prop :=
| Initial : (netEvalR initial initial)
| Step1 : forall st st',
    netEvalR st st' ->
    st'.(t) > 0 ->
    (netEvalR st' {| t := st'.(t) - 1 ; r := st'.(r) ;
                     c1 := msg :: st'.(c1) ; c2 := st'.(c2) |})
| Step2 : forall st st',
    netEvalR st st' ->
    st'.(c2) <> nil ->
    (netEvalR st' {| t := st'.(t) + 1 ; r := st'.(r) ;
                     c1 := st'.(c1) ; c2 := (tl st'.(c2)) |})
| Step3 : forall st st',
    netEvalR st st' ->
    st'.(c1) <> nil ->
    (netEvalR st' {| t := st'.(t) ; r := st'.(r) + 1 ;
                    c1 := (tl st'.(c1)) ; c2 := st'.(c2) |})
| Step4 : forall st st',
    netEvalR st st' ->
    st'.(r) > 0 ->
    (netEvalR st' {| t := st'.(t) ; r := st'.(r) - 1 ;
                     c1 := st'.(c1) ; c2 := (msg :: st'.(c2)) |}).

Definition safety1 (st' : netstate) : Prop := st'.(t) >= 0 /\ st'.(r) >= 0.

Lemma safety1_holds: forall st st' : netstate,
         (netEvalR st st') ->
         safety1 st'.
Proof.
  intros st st' H. split; induction H; simpl; omega.
Qed.

Definition safety2 (st' : netstate) : Prop :=
  Zlength st'.(c1) + Zlength st'.(c2) + st'.(t) + st'.(r) = 10.

Lemma safety2_holds : forall st st' : netstate,
    (netEvalR st st') ->
    safety2 st'.
Proof.
  intros st st' H. unfold safety2. induction H; simpl;
    try reflexivity;                           (* Initial state *)
    try (rewrite Zlength_cons; omega);         (* Steps 1 and 4 *)
    [destruct (c2 st') | destruct (c1 st')];   (* Steps 2 and 3 *)
      try contradiction;
      (simpl; rewrite Zlength_cons in IHnetEvalR; omega).
Qed.

Theorem safety_holds : forall st st' : netstate,
      (netEvalR st st') -> safety1 st' /\ safety2 st'.
Proof.
  intros st st' H. split;
  [apply (safety1_holds st st') | apply (safety2_holds st st')];
    assumption.
Qed.


Require Import Problem.

Lemma plus_n_0: forall n, n + 0 = n.
Proof.
  induction n.
  - reflexivity.
  - simpl. rewrite -> IHn. reflexivity.
Qed.

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

Theorem plus_comm_proof: plus_comm.
Proof.
  unfold plus_comm.
  intros.
  induction n.
  - rewrite -> plus_n_0. reflexivity.
  - simpl. rewrite -> plus_n_Sm. rewrite -> IHn. reflexivity.
Qed.


Require Import ssreflect ssrbool ssrnat eqtype ssrfun seq path.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Inductive evenP: nat -> Prop :=
| EvenO  : evenP 0
| EvenSs : forall n, evenP n -> evenP (n + 2).

Fixpoint evenb n := if n is n'.+2 then evenb n' else n == 0.

Lemma even_4: evenb 4.
Proof. done. Qed.

Theorem even_3_contra: ~evenb 3.
Proof. done. Qed.

(*Proof by induction on the rule (for evenP) *)
Lemma evenP_plus n m : evenP n -> evenP m -> evenP (n + m).
Proof.
elim=>//; move=>k Ek Hk Hm=>/=; rewrite -(addnC m) addnA; constructor.
by rewrite addnC; apply: Hk.
Qed.

(* TODO: How to build induction on recursive function? *)
Lemma evenb_plus m n : evenb m -> evenb n -> evenb (m + n).
Proof.
elim: m {-2}m (leqnn m)=>[|m IH]; case=>//.
by case=>// m' /ltnW /IH.
Qed.

Inductive evenP1 n : Prop :=
  Even01 of n = 0 | EvenSs1 m of n = m.+2 & evenP1 m.

Lemma evenP_contra': forall n', evenP n' -> forall n, n' = (n + 1 + n) -> False.
Proof.
move=>k; elim=>[n|]=>{k}.
-rewrite addnC addnA addn1.
 move=> E. move:(ltn0Sn (n+n))=>H; rewrite E in H.
 by move:(ltnn ((n+n).+1)); rewrite H. case.
-move=>_ _ n. rewrite addnC addn0; case:n=>[|n]//=.
+by rewrite addn1 addnS addnC !addnS; move/eqP; rewrite !eqSS; move/eqP.
 (* TODO: what exactly is happened here? *)
move=>n H IHEven. case.
+by rewrite !addn0 (addnC 0) addn0 addnC add2n.
 (* TODO: what exactly is happened here? *)
move=>n0; rewrite addn2 addn1 addnS addnC !addnS.
move/eqP; rewrite !eqSS; move/eqP=>E; subst n.
by apply: (IHEven n0); rewrite addnC addn1 addnS.
Qed.

Lemma evenP_contra: forall n, evenP (n + 1 + n) -> False.
Proof.
move=>n. move:(@evenP_contra' (n + 1 + n))=>H.
move/H=>H1. move:(H1 n)=> H2. apply:H2. done.
Qed.

(* TODO: How to characterize this general pattern when inducing of n<=n *)
Lemma even_contra n: evenb (n + 1 + n) -> False.
Proof.
Proof. by elim: n=>[|n IH] //; rewrite addSn addnS. Qed.

(*
Proof.
elim: n {-2}n (leqnn n)=>[|n IH]; elim=>//.
case=>// m H1 H3; rewrite ltnS in H3.
move:(ltn_trans H3 (ltnSn n))=>/H1=> H4.
rewrite 2!addnS=>/=.
by rewrite addnS addnC -(addnC 1) addnS addnS addnA /= in H4.
Qed.
*)

(* Emulating discriminate *)
Lemma one_isnt_zero: 1 <> 0.
Proof.
move=>E.
have X: if 1 == 0 then True else False by rewrite E; constructor.
exact X.
Qed.

Lemma leqD n m: n <= m -> exists p, m = n + p.
Proof.
elim: m; first by rewrite leqn0; move/eqP=>->; eexists _.
move=> m Hm.
elim: n m Hm=>//; first by move=>m _ _; exists m.+1.
move=> n Hn m Hm. rewrite ltnS leq_eqVlt; case/orP.
- by move/eqP=>->; exists 0.
by case/Hm=>p E; subst m; exists p.+1.
Qed


(* Solutions provided by B.Pierce et al, with my
note regarding plus_n_O *)

Print plus_n_O.  (* apparently BUILT IN *)

Lemma plus_n_0 : forall n:nat,
   n+0=n.
Proof.
   intros. induction n.
   reflexivity.
   simpl. rewrite -> IHn. reflexivity.
Qed.
Theorem plus_n_Sm : forall n m : nat,
  S (n + m) = n + (S m).
Proof.
  (* ADMITTED *)
  intros n m. induction n as [| n'].
  (* Case "n = 0". *)
    simpl. reflexivity.
  (* Case "n = S n'". *)
    simpl. rewrite -> IHn'. reflexivity.  Qed.
(* /ADMITTED *)

Theorem plus_comm : forall n m : nat,
  n + m = m + n.
Proof.
  (* ADMITTED *)
  intros n m. induction m as [| m'].
  (* Case "m = 0". *)
    simpl. (* rewrite -> plus_n_O. *)
      rewrite -> plus_n_0.  reflexivity.
  (* Case "m = S m'". *)
    simpl. rewrite <- IHm'. rewrite <- plus_n_Sm.
    reflexivity.  Qed.
(* /ADMITTED *)

Theorem plus_assoc : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  (* ADMITTED *)
  intros n m p. induction n as [| n'].
  (* Case "n = 0". *)
    reflexivity.
  (* Case "n = S n'". *)
    simpl. rewrite -> IHn'. reflexivity.   Qed.
(* /ADMITTED *)

Theorem mult_0_r : forall n:nat,
  n * 0 = 0.
Proof.
  (* ADMITTED *)
  intros n. induction n as [| n'].
  (* Case "n = 0". *)
    reflexivity.
  (* Case "n = S n'". *)
    simpl. rewrite -> IHn'. reflexivity.  Qed.
(* /ADMITTED *)

Theorem plus_swap : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  (* ADMITTED *)
  intros n m p.
  rewrite -> plus_assoc.
  assert (H: n + m = m + n).
    (* Case "Proof of assertion". *)
    rewrite <- plus_comm. reflexivity.
  rewrite -> H. rewrite -> plus_assoc. reflexivity.  Qed.
(* /ADMITTED *)
(* QUIETSOLUTION *)

Theorem mult_m_Sn : forall m n : nat,
 m * (S n) = m + (m * n).
Proof.
  induction m as [| m'].
  (* Case "m = 0". *)
    intros n. simpl. reflexivity.
  (* Case "m = S m'". *)
    intros n.
    simpl.
    rewrite -> IHm'.
    rewrite -> plus_swap.
    reflexivity.  Qed.
(* /QUIETSOLUTION *)

Theorem mult_comm : forall m n : nat,
 m * n = n * m.
Proof.
  (* ADMITTED *)
  induction m as [| m'].
  (* Case "m = 0". *)
    intros n. simpl. rewrite mult_0_r. reflexivity.
  (* Case "m = S m'". *)
    intros n.
    simpl.
    rewrite -> mult_m_Sn.
    rewrite -> IHm'.
    reflexivity.  Qed.
(* /ADMITTED *)