(* week_40a_binary_trees.v *)
(* dIFP 2014-2015, Q1, Week 40 *)
(* Olivier Danvy <danvy@cs.au.dk> *)

(* ********** *)

Require Import Arith Bool unfold_tactic.

Lemma plus_1_l :
  forall n : nat,
    1 + n = S n.
Proof.
  intro n.
  rewrite -> plus_Sn_m.
  rewrite -> plus_0_l.
  reflexivity.
Qed.

Lemma plus_1_r :
  forall n : nat,
    n + 1 = S n.
Proof.
  intro n.
  rewrite -> (plus_comm).
  apply plus_1_l.
Qed.

Notation "A =n= B" := (beq_nat A B) (at level 70, right associativity).

(* ********** *)

(* Data type of binary trees of natural numbers: *)

Inductive binary_tree_nat : Type :=
  | Leaf : nat -> binary_tree_nat
  | Node : binary_tree_nat -> binary_tree_nat -> binary_tree_nat.

(* There is one base case: leaves.
   There is one induction case, with two subtrees.
*)

(* ********** *)

(* Sample of binary trees of natural numbers: *)

Definition bt_0 :=
  Leaf 42.

Definition bt_1 :=
  Node (Leaf 10)
       (Leaf 20).

Definition bt_2 :=
  Node (Node (Leaf 10)
             (Leaf 20))
       (Leaf 30).

(*
Print bt_2.
bt_2 = Node (Node (Leaf 10) (Leaf 20)) (Leaf 30)
     : binary_tree_nat
*)

(* ********** *)

(* How many leaves are there in a given binary tree? *)

(* A unit test: *)

Definition unit_test_for_number_of_leaves (candidate : binary_tree_nat -> nat) :=
  (candidate bt_0 =n= 1)
  &&
  (candidate bt_1 =n= 2)
  &&
  (candidate bt_2 =n= 3)
  &&
  (candidate (Node bt_1 bt_2) =n= 5)
  .

(* ***** *)

(* A specification: *)

Definition specification_of_number_of_leaves (number_of_leaves : binary_tree_nat -> nat) :=
  (forall n : nat,
     number_of_leaves (Leaf n) = 1)
  /\
  (forall t1 t2 : binary_tree_nat,
     number_of_leaves (Node t1 t2) = number_of_leaves t1 + number_of_leaves t2).

(* ***** *)

(* Uniqueness of the specification: *)

Theorem there_is_only_one_number_of_leaves :
  forall f g : binary_tree_nat -> nat,
    specification_of_number_of_leaves f ->
    specification_of_number_of_leaves g ->
    forall t : binary_tree_nat,
      f t = g t.
Proof.
  intros f g.
  unfold specification_of_number_of_leaves.
  intros [Hf_leaf Hf_node] [Hg_leaf Hg_node].
  intro t.
  induction t as [n | t1 IHt1 t2 IHt2].

  rewrite -> Hf_leaf.
  rewrite -> Hg_leaf.
  reflexivity.

  rewrite -> Hf_node.
  rewrite -> Hg_node.
  rewrite -> IHt1.
  rewrite -> IHt2.
  reflexivity.
Qed.

(* ***** *)

(* A first implementation, in direct style: *)

(* The auxiliary (recursive) function: *)

Fixpoint number_of_leaves_ds (t : binary_tree_nat) : nat :=
  match t with
    | Leaf n =>
      1
    | Node t1 t2 =>
      (number_of_leaves_ds t1) + (number_of_leaves_ds t2)
  end.

(* The canonical unfold lemmas: *)

Lemma unfold_number_of_leaves_ds_Leaf :
  forall n : nat,
    number_of_leaves_ds (Leaf n) = 1.
Proof.
  unfold_tactic number_of_leaves_ds.
Qed.

Lemma unfold_number_of_leaves_ds_Node :
  forall t1 t2 : binary_tree_nat,
    number_of_leaves_ds (Node t1 t2) =
    (number_of_leaves_ds t1) + (number_of_leaves_ds t2).
Proof.
  unfold_tactic number_of_leaves_ds.
Qed.

(* The main (non-recursive) function: *)

Definition number_of_leaves_v0 (t : binary_tree_nat) : nat :=
  number_of_leaves_ds t.

(* ***** *)

(* The standard sanity check: *)

Compute unit_test_for_number_of_leaves number_of_leaves_v0.
(*
     = true
     : bool
*)

(* ***** *)

(* The first implementation satisfies the specification: *)

Theorem number_of_leaves_v0_satisfies_the_specification_of_number_of_leaves :
  specification_of_number_of_leaves number_of_leaves_v0.
Proof.
  unfold specification_of_number_of_leaves.
  unfold number_of_leaves_v0.
  split.

  exact unfold_number_of_leaves_ds_Leaf.

  exact unfold_number_of_leaves_ds_Node.
Qed.

(* ***** *)

(* A second implementation, with an accumulator: *)

(* The auxiliary (recursive) function: *)

Fixpoint number_of_leaves_acc (t : binary_tree_nat) (a : nat) : nat :=
  match t with
    | Leaf n =>
      1 + a  (* or even better: S a *)
    | Node t1 t2 =>
      number_of_leaves_acc t1 (number_of_leaves_acc t2 a)
  end.

(* The canonical unfold lemmas: *)

Lemma unfold_number_of_leaves_acc_Leaf :
  forall n a : nat,
    number_of_leaves_acc (Leaf n) a = 1 + a.
Proof.
  unfold_tactic number_of_leaves_acc.
Qed.

Lemma unfold_number_of_leaves_acc_Node :
  forall (t1 t2 : binary_tree_nat)
         (a : nat),
    number_of_leaves_acc (Node t1 t2) a =
    number_of_leaves_acc t1 (number_of_leaves_acc t2 a).
Proof.
  unfold_tactic number_of_leaves_acc.
Qed.

(* The main (non-recursive) function: *)

Definition number_of_leaves_v1 (t : binary_tree_nat) : nat :=
  number_of_leaves_acc t 0.

(* ***** *)

(* The standard sanity check: *)

Compute unit_test_for_number_of_leaves number_of_leaves_v1.
(*
     = true
     : bool
*)

(* The second implementation satisfies the specification: *)

Theorem number_of_leaves_v1_satisfies_the_specification_of_number_of_leaves_first_attempt :
  specification_of_number_of_leaves number_of_leaves_v1.
Proof.
  unfold specification_of_number_of_leaves.
  unfold number_of_leaves_v1.
  split.

  intro n.
  apply (unfold_number_of_leaves_acc_Leaf n 0).

  intros t1 t2.
  rewrite -> unfold_number_of_leaves_acc_Node.
  (* Hum, we are stuck.  Let's venture a helpful lemma: *)
Abort.

Lemma about_number_of_leaves_acc_tentative :
  forall (t : binary_tree_nat)
         (a : nat),
    number_of_leaves_acc t a = (number_of_leaves_acc t 0) + a.
Proof.
Admitted.

Theorem number_of_leaves_v1_satisfies_the_specification_of_number_of_leaves_second_attempt :
  specification_of_number_of_leaves number_of_leaves_v1.
Proof.
  unfold specification_of_number_of_leaves.
  unfold number_of_leaves_v1.
  split.

  intro n.
  apply (unfold_number_of_leaves_acc_Leaf n 0).

  intros t1 t2.
  rewrite -> unfold_number_of_leaves_acc_Node.
  rewrite -> about_number_of_leaves_acc_tentative.
  reflexivity.
  (* Yay, the proof goes through.
     So let's prove the helpful lemma. *)
Abort.

Lemma about_number_of_leaves_acc :
  forall (t : binary_tree_nat)
         (a : nat),
    number_of_leaves_acc t a = (number_of_leaves_acc t 0) + a.
Proof.
  intro t.
  induction t as [n | t1 IHt1 t2 IHt2].

  (* Base case: *)
  intro a.
  (* left-hand side: *)
  rewrite -> unfold_number_of_leaves_acc_Leaf.
  (* right-hand side: *)
  rewrite -> unfold_number_of_leaves_acc_Leaf.
  rewrite -> plus_0_r.
  reflexivity.

  (* Induction case: *)
  intro a.
  (* left-hand side: *)
  rewrite -> unfold_number_of_leaves_acc_Node.
  rewrite -> IHt1.
  rewrite -> IHt2.
  (* right-hand side: *)
  rewrite -> unfold_number_of_leaves_acc_Node.
  rewrite -> (IHt1 (number_of_leaves_acc t2 0)).
  (* postlude: *)
  apply plus_assoc.
Qed.

Theorem number_of_leaves_v1_satisfies_the_specification_of_number_of_leaves :
  specification_of_number_of_leaves number_of_leaves_v1.
Proof.
  unfold specification_of_number_of_leaves.
  unfold number_of_leaves_v1.
  split.

  intro n.
  apply (unfold_number_of_leaves_acc_Leaf n 0).

  intros t1 t2.
  rewrite -> unfold_number_of_leaves_acc_Node.
  rewrite -> about_number_of_leaves_acc.
  reflexivity.
Qed.

(* ***** *)

(* The two implementations implement the same function: *)

Theorem number_of_leaves_v0_and_v1_implement_the_same_function :
  forall t : binary_tree_nat,
    number_of_leaves_v0 t = number_of_leaves_v1 t.
Proof.
  (* Pedestrian attempt: *)
  intro t.
  unfold number_of_leaves_v0.
  unfold number_of_leaves_v1.
  induction t as [n | t1 IHt1 t2 IHt2].

  rewrite -> unfold_number_of_leaves_ds_Leaf.
  rewrite -> unfold_number_of_leaves_acc_Leaf.
  rewrite -> plus_0_r.
  reflexivity.

  rewrite -> unfold_number_of_leaves_ds_Node.
  rewrite -> unfold_number_of_leaves_acc_Node.
  rewrite -> about_number_of_leaves_acc.
  rewrite -> IHt1.
  rewrite -> IHt2.
  reflexivity.

  Restart.

  (* Reusing what we did before: *)

  exact (there_is_only_one_number_of_leaves
           number_of_leaves_v0
           number_of_leaves_v1
           number_of_leaves_v0_satisfies_the_specification_of_number_of_leaves
           number_of_leaves_v1_satisfies_the_specification_of_number_of_leaves).

  Restart.

  (* Reusing what we did before, less concisely: *)

  intro t.
  exact (there_is_only_one_number_of_leaves
           number_of_leaves_v0
           number_of_leaves_v1
           number_of_leaves_v0_satisfies_the_specification_of_number_of_leaves
           number_of_leaves_v1_satisfies_the_specification_of_number_of_leaves
           t).
Qed.

(* ***** *)

(* A third implementation, with higher-order functions: *)

Definition compose_nat (f g : nat -> nat) (n : nat) :=
  f (g n).

Notation "F << G" := (compose_nat F G) (at level 70, right associativity).

Compute (S << S) 40.

Compute ((fun x => 2 + x) << (fun y => 10 * y)) 4.

Lemma unfold_compose_nat :
  forall (f g : nat -> nat)
          (n : nat),
    compose_nat f g n = f (g n).
Proof.
  unfold_tactic compose_nat.
Qed.

(* The auxiliary (recursive) function: *)

Fixpoint number_of_leaves_higher_order (t : binary_tree_nat) : nat -> nat :=
  match t with
    | Leaf n =>
      S
    | Node t1 t2 =>
      (number_of_leaves_higher_order t1) << (number_of_leaves_higher_order t2)
  end.

(* The canonical unfold lemmas: *)

Lemma unfold_number_of_leaves_higher_order_Leaf :
  forall n : nat,
    number_of_leaves_higher_order (Leaf n) = S.
Proof.
  unfold_tactic number_of_leaves_higher_order.
Qed.

Lemma unfold_number_of_leaves_higher_order_Node :
  forall (t1 t2 : binary_tree_nat),
    number_of_leaves_higher_order (Node t1 t2) =
    ((number_of_leaves_higher_order t1) << (number_of_leaves_higher_order t2)).
Proof.
  unfold_tactic number_of_leaves_higher_order.
Qed.

(* The main (non-recursive) function: *)

Definition number_of_leaves_v2 (t : binary_tree_nat) : nat :=
  number_of_leaves_higher_order t 0.

(* ***** *)

(* The standard sanity check: *)

Compute unit_test_for_number_of_leaves number_of_leaves_v2.
(*
     = true
     : bool
*)

(* The second implementation satisfies the specification: *)

Theorem number_of_leaves_v2_satisfies_the_specification_of_number_of_leaves_first_attempt :
  specification_of_number_of_leaves number_of_leaves_v2.
Proof.
  unfold specification_of_number_of_leaves.
  unfold number_of_leaves_v2.
  split.

  intro n.
  rewrite -> unfold_number_of_leaves_higher_order_Leaf.
  reflexivity.

  intros t1 t2.
  rewrite -> unfold_number_of_leaves_higher_order_Node.
  rewrite -> unfold_compose_nat.
(* Aha: number_of_leaves_v2 is the same as number_of_leaves_v1! *)
Abort.

Lemma about_number_of_leaves_higher_order :
  forall (t : binary_tree_nat)
         (a : nat),
    number_of_leaves_higher_order t a =
    number_of_leaves_acc t a.
Proof.
  intro t.
  induction t as [n | t1 IHt1 t2 IHt2].

  intro a.
  rewrite -> unfold_number_of_leaves_higher_order_Leaf.
  rewrite -> unfold_number_of_leaves_acc_Leaf.
  rewrite -> (plus_1_l a).
  reflexivity.

  intro a.
  rewrite -> unfold_number_of_leaves_higher_order_Node.
  rewrite -> unfold_compose_nat.
  rewrite -> IHt1.
  rewrite -> IHt2.
  rewrite -> unfold_number_of_leaves_acc_Node.
  reflexivity.
Qed.

Theorem number_of_leaves_v2_satisfies_the_specification_of_number_of_leaves :
  specification_of_number_of_leaves number_of_leaves_v2.
Proof.
  unfold specification_of_number_of_leaves.
  unfold number_of_leaves_v2.
  split.

  intro n.
  rewrite -> about_number_of_leaves_higher_order.
  exact (unfold_number_of_leaves_acc_Leaf n 0).

  intros t1 t2.
  rewrite -> about_number_of_leaves_higher_order.
  rewrite -> unfold_number_of_leaves_acc_Node.
  rewrite -> about_number_of_leaves_acc.
  rewrite -> about_number_of_leaves_higher_order.
  rewrite -> about_number_of_leaves_higher_order.
  reflexivity.
Qed.

(* ***** *)

(* A fourth implementation, in CPS: *)

(* The auxiliary (recursive) function: *)

Fixpoint number_of_leaves_cps (ans : Type) (t : binary_tree_nat) (k : nat -> ans) : ans :=
  match t with
    | Leaf n =>
      k 1
    | Node t1 t2 =>
      number_of_leaves_cps
        ans
        t1
        (fun n1 => number_of_leaves_cps
                     ans
                     t2
                     (fun n2 => k (n1 + n2)))
  end.

(* The canonical unfold lemmas: *)

Lemma unfold_number_of_leaves_cps_Leaf :
  forall (ans : Type)
         (n : nat)
         (k : nat -> ans),
    number_of_leaves_cps ans (Leaf n) k = k 1.
Proof.
  unfold_tactic number_of_leaves_cps.
Qed.

Lemma unfold_number_of_leaves_cps_Node :
  forall (ans : Type)
         (t1 t2 : binary_tree_nat)
         (k : nat -> ans),
    number_of_leaves_cps ans (Node t1 t2) k =
    number_of_leaves_cps
      ans
      t1
      (fun n1 => number_of_leaves_cps
                   ans
                   t2
                   (fun n2 => k (n1 + n2))).
Proof.
  unfold_tactic number_of_leaves_cps.
Qed.

(* The main (non-recursive) function: *)

Definition number_of_leaves_v3 (t : binary_tree_nat) : nat :=
  number_of_leaves_cps nat t (fun n => n).

(* ***** *)

(* The standard sanity check: *)

Compute unit_test_for_number_of_leaves number_of_leaves_v3.
(*
     = true
     : bool
*)

(* The fourth implementation satisfies the specification: *)

Theorem number_of_leaves_v3_satisfies_the_specification_of_number_of_leaves_first_attempt :
  specification_of_number_of_leaves number_of_leaves_v3.
Proof.
  unfold specification_of_number_of_leaves.
  unfold number_of_leaves_v3.
  split.

  intro n.
  rewrite -> unfold_number_of_leaves_cps_Leaf.
  reflexivity.

  intros t1 t2.
  rewrite -> unfold_number_of_leaves_cps_Node.
  (* Hum, we are stuck.  Let's venture a helpful lemma: *)
Abort.

Lemma about_number_of_leaves_cps_tentative :
  forall (ans : Type)
         (t : binary_tree_nat)
         (k : nat -> ans),
    number_of_leaves_cps ans t k =
    k (number_of_leaves_cps nat t (fun n => n)).
Proof.
Admitted.

Theorem number_of_leaves_v3_satisfies_the_specification_of_number_of_leaves_second_attempt :
  specification_of_number_of_leaves number_of_leaves_v3.
Proof.
  unfold specification_of_number_of_leaves.
  unfold number_of_leaves_v3.
  split.

  intro n.
  rewrite -> unfold_number_of_leaves_cps_Leaf.
  reflexivity.

  intros t1 t2.
  rewrite -> unfold_number_of_leaves_cps_Node.
  rewrite -> about_number_of_leaves_cps_tentative.
  rewrite -> about_number_of_leaves_cps_tentative.
  reflexivity.
  (* Yay, the proof goes through.
     So let's prove the helpful lemma. *)
Abort.

Lemma about_number_of_leaves_cps :
  forall (ans : Type)
         (t : binary_tree_nat)
         (k : nat -> ans),
    number_of_leaves_cps ans t k =
    k (number_of_leaves_cps nat t (fun n => n)).
Proof.
  intros ans t.
  induction t as [n | t1 IHt1 t2 IHt2].

  (* Base case: *)
  intro k.
  (* left-hand side: *)
  rewrite -> unfold_number_of_leaves_cps_Leaf.
  (* right-hand side: *)
  rewrite -> unfold_number_of_leaves_cps_Leaf.
  reflexivity.

  (* Induction case: *)
  intro k.
  (* left-hand side: *)
  rewrite -> unfold_number_of_leaves_cps_Node.
  rewrite -> IHt1.
  rewrite -> IHt2.
  (* right-hand side: *)
  symmetry.
  (* OK, left-hand side then: *)
  rewrite -> unfold_number_of_leaves_cps_Node.
  (* And we are stuck.
     Let's strengthen the induction hypothesis. *)

  Restart.

  intros ans t.
  revert ans.
  induction t as [n | t1 IHt1 t2 IHt2].

  (* Base case: *)
  intros ans k.
  (* left-hand side: *)
  rewrite -> unfold_number_of_leaves_cps_Leaf.
  (* right-hand side: *)
  rewrite -> unfold_number_of_leaves_cps_Leaf.
  reflexivity.

  (* Induction case: *)
  intros ans k.
  (* left-hand side: *)
  rewrite -> unfold_number_of_leaves_cps_Node.
  rewrite -> IHt1.
  rewrite -> IHt2.
  (* right-hand side: *)
  symmetry.
  (* OK, left-hand side then: *)
  rewrite -> unfold_number_of_leaves_cps_Node.
  rewrite -> IHt1.
  rewrite -> IHt2.
  reflexivity.
Qed.

Theorem number_of_leaves_v3_satisfies_the_specification_of_number_of_leaves :
  specification_of_number_of_leaves number_of_leaves_v3.
Proof.
  unfold specification_of_number_of_leaves.
  unfold number_of_leaves_v3.
  split.

  intro n.
  rewrite -> unfold_number_of_leaves_cps_Leaf.
  reflexivity.

  intros t1 t2.
  rewrite -> unfold_number_of_leaves_cps_Node.
  rewrite -> about_number_of_leaves_cps.
  rewrite -> about_number_of_leaves_cps.
  reflexivity.
Qed.

(* ***** *)

(* The four implementations implement the same function: *)

Theorem number_of_leaves_v0_and_v3_implement_the_same_function :
  forall t : binary_tree_nat,
    number_of_leaves_v0 t = number_of_leaves_v3 t.
Proof.
  exact (there_is_only_one_number_of_leaves
           number_of_leaves_v0
           number_of_leaves_v3
           number_of_leaves_v0_satisfies_the_specification_of_number_of_leaves
           number_of_leaves_v3_satisfies_the_specification_of_number_of_leaves).
Qed.

Theorem number_of_leaves_v1_and_v3_implement_the_same_function :
  forall t : binary_tree_nat,
    number_of_leaves_v1 t = number_of_leaves_v3 t.
Proof.
  exact (there_is_only_one_number_of_leaves
           number_of_leaves_v1
           number_of_leaves_v3
           number_of_leaves_v1_satisfies_the_specification_of_number_of_leaves
           number_of_leaves_v3_satisfies_the_specification_of_number_of_leaves).
Qed.

Theorem number_of_leaves_v2_and_v3_implement_the_same_function :
  forall t : binary_tree_nat,
    number_of_leaves_v2 t = number_of_leaves_v3 t.
Proof.
  exact (there_is_only_one_number_of_leaves
           number_of_leaves_v2
           number_of_leaves_v3
           number_of_leaves_v2_satisfies_the_specification_of_number_of_leaves
           number_of_leaves_v3_satisfies_the_specification_of_number_of_leaves).
Qed.

(* ********** *)
(* ********** *)
(* EXERCISES BEGIN HERE! *)

(* Exercise:
   Revisit how to compute the number of nodes
   of a binary tree.
*)

Definition specification_of_number_of_nodes (number_of_nodes : binary_tree_nat -> nat) :=
  (forall n : nat,
     number_of_nodes (Leaf n) = 0)
  /\
  (forall t1 t2 : binary_tree_nat,
     number_of_nodes (Node t1 t2) = S (number_of_nodes t1 + number_of_nodes t2)).

 Fixpoint number_of_leaves_acc' (t : binary_tree_nat) (a : nat) : nat :=
   match t with
     | Leaf n =>
       1 + a
     | Node t1 t2 =>
       (number_of_leaves_acc' t2 (number_of_leaves_acc' t1 a))
   end.

 Definition number_of_leaves_v1' (t : binary_tree_nat) : nat :=
   number_of_leaves_acc' t 0.

Compute unit_test_for_number_of_leaves number_of_leaves_v1'.
(*
  = true
  : bool
*)

Lemma unfold_number_of_leaves_acc'_bc :
  forall (n a : nat),
    number_of_leaves_acc' (Leaf n) a = 1 + a.
Proof.
  unfold_tactic number_of_leaves_acc'.
Qed.

Lemma unfold_number_of_leaves_acc'_ic :
  forall (t1 t2 : binary_tree_nat) (a : nat),
    number_of_leaves_acc' (Node t1 t2) a = number_of_leaves_acc' t2 ( number_of_leaves_acc' t1 a).
Proof.
  unfold_tactic number_of_leaves_acc'.
Qed.

Lemma eureka_now :
  forall (t : binary_tree_nat) (a : nat),
    number_of_leaves_acc' t a = a + number_of_leaves_acc' t 0.
Proof.
  intro t.
  induction t as [ t' | t1 IHt1 t2 IHt2].
  intro a.
  rewrite -> unfold_number_of_leaves_acc'_bc.
  rewrite -> unfold_number_of_leaves_acc'_bc.
  rewrite -> (plus_0_r).
  rewrite -> (plus_comm).
  reflexivity.

  intro a.
  rewrite -> (unfold_number_of_leaves_acc'_ic).
  rewrite -> (unfold_number_of_leaves_acc'_ic).
  rewrite -> IHt2.
  rewrite -> IHt1.
  rewrite -> (IHt2 (number_of_leaves_acc' t1 0)).
  rewrite <- (plus_assoc).
  reflexivity.
Qed.

Lemma number_of_leaves_acc'_fits_specification_of_number_of_leaves :
  specification_of_number_of_leaves number_of_leaves_v1'.
Proof.
  unfold number_of_leaves_v1'.
  unfold specification_of_number_of_leaves.
  split.
  intro n.
  rewrite -> (unfold_number_of_leaves_acc'_bc).
  rewrite -> plus_0_r.
  reflexivity.

  intros t1 t2.
  rewrite -> (unfold_number_of_leaves_acc'_ic).
  rewrite -> (eureka_now).
  reflexivity.
Qed.

Fixpoint number_of_leaves_cps' (ans : Type) (t : binary_tree_nat) (k : nat -> ans) : ans :=
   match t with
     | Leaf n =>
       k 1
     | Node t1 t2 =>
       number_of_leaves_cps'
         ans
         t2
         (fun n2 => number_of_leaves_cps'
                      ans
                      t1
                      (fun n1 => k (n1 + n2)))
   end.

 Definition number_of_leaves_v3' (t : binary_tree_nat) : nat :=
   number_of_leaves_cps' nat t (fun n => n).

Compute unit_test_for_number_of_leaves number_of_leaves_v3'.
(*
  = true
  : bool
*)
Lemma unfold_number_of_leaves_cps'_bc :
  forall (ans : Type)
         (n : nat)
         (k : nat -> ans),
    number_of_leaves_cps' ans (Leaf n) k = k 1.
Proof.
  unfold_tactic number_of_leaves_cps'.
Qed.

Lemma unfold_number_of_leaves_cps'_ic :
  forall (ans : Type)
         (t1 t2 : binary_tree_nat)
         (k : nat -> ans),
    number_of_leaves_cps' ans (Node t1 t2) k =
    number_of_leaves_cps'
      ans
      t2
      (fun n2 => number_of_leaves_cps'
                   ans
                   t1
                   (fun n1 => k (n1 + n2))).
Proof.
  unfold_tactic number_of_leaves_cps'.
Qed.

Lemma about_number_of_leaves_cps' :
  forall (ans : Type)
         (t : binary_tree_nat)
         (k : nat -> ans),
    number_of_leaves_cps' ans t k =
    k (number_of_leaves_cps' nat t (fun n => n)).
Proof.
  intros ans t.
  revert ans.
  induction t as [n | t1 IHt1 t2 IHt2].

  (* Base case: *)
  intros ans k.
  (* left-hand side: *)
  rewrite -> unfold_number_of_leaves_cps'_bc.
  (* right-hand side: *)
  rewrite -> unfold_number_of_leaves_cps'_bc.
  reflexivity.

  (* Induction case: *)
  intros ans k.
  (* left-hand side: *)
  rewrite -> unfold_number_of_leaves_cps'_ic.

  rewrite -> IHt2.
  rewrite -> IHt1.
  (* right-hand side: *)
  symmetry.
  (* OK, left-hand side then: *)
  rewrite -> unfold_number_of_leaves_cps'_ic.

  rewrite -> IHt2.
  rewrite -> IHt1.
  reflexivity.
Qed.

Lemma number_of_leaves_cps'_fits_the_specification_of_number_of_leaves :
  specification_of_number_of_leaves number_of_leaves_v3'.
Proof.
  unfold specification_of_number_of_leaves.
  split.
  intro n.
  unfold number_of_leaves_v3'.
  rewrite -> (unfold_number_of_leaves_cps'_bc).
  reflexivity.

  intros t1 t2.
  unfold number_of_leaves_v3'.
  rewrite -> (unfold_number_of_leaves_cps'_ic).
  rewrite -> (about_number_of_leaves_cps').
  rewrite -> (about_number_of_leaves_cps').
  reflexivity.
Qed.

Definition specification_of_product_of_leaves (product_of_leaves : binary_tree_nat -> nat) :=
  (forall n : nat,
     product_of_leaves (Leaf n) = n)
  /\
  (forall t1 t2 : binary_tree_nat,
     product_of_leaves (Node t1 t2) = product_of_leaves t1 * product_of_leaves t2).

Definition bt_3 :=
  Node (Leaf 20)
       (Node (Leaf 3) (Leaf 4)).

Definition unit_test_for_product_of_leaves (candidate : binary_tree_nat -> nat) :=
  (candidate bt_0 =n= 42)
  &&
  (candidate bt_1 =n= 200)
  &&
  (candidate bt_3 =n= 240)
  .

Theorem there_is_only_one_product_of_leaves :
  forall f g : binary_tree_nat -> nat,
    specification_of_product_of_leaves f ->
    specification_of_product_of_leaves g ->
    forall t : binary_tree_nat,
      f t = g t.
Proof.
  intros f g.
  unfold specification_of_product_of_leaves.
  intros [Hf_leaf Hf_node] [Hg_leaf Hg_node].
  intro t.
  induction t as [ t' | t1 IHt1 t2 IHt2].
  rewrite -> Hf_leaf.
  rewrite -> Hg_leaf.
  reflexivity.

  rewrite -> Hf_node.
  rewrite -> Hg_node.
  rewrite -> IHt1.
  rewrite -> IHt2.
  reflexivity.
Qed.

Fixpoint product_of_leaves_ds (t : binary_tree_nat) : nat :=
  match t with
    | Leaf n => n
    | Node t1 t2 => (product_of_leaves_ds t1) * (product_of_leaves_ds t2)
end.

Lemma unfold_product_of_leaves_ds_bc :
  forall n : nat,
    product_of_leaves_ds (Leaf n) = n.
Proof.
  unfold_tactic product_of_leaves_ds.
Qed.

Lemma unfold_product_of_leaves_ds_ic :
  forall t1 t2 : binary_tree_nat,
    product_of_leaves_ds (Node t1 t2) = (product_of_leaves_ds t1) * (product_of_leaves_ds t2).
Proof.
  unfold_tactic product_of_leaves_ds.
Qed.

Definition product_of_leaves_v0 (t : binary_tree_nat) : nat :=
  product_of_leaves_ds t.

Compute unit_test_for_product_of_leaves product_of_leaves_v0.
(*
  = true
  : bool
*)
Lemma product_of_leaves_v0_fits_the_specification_of_product_of_leaves :
  specification_of_product_of_leaves product_of_leaves_v0.
Proof.
  unfold specification_of_product_of_leaves.
  unfold product_of_leaves_v0.
  split.
  intro n.
  rewrite -> (unfold_product_of_leaves_ds_bc).
  reflexivity.

  intros t1 t2.
  rewrite -> (unfold_product_of_leaves_ds_ic).
  reflexivity.
Qed.

Fixpoint product_of_leaves_good  (t : binary_tree_nat) : nat :=
  match t with
    | Leaf n => n
    | Node t1 t2 =>
      match (product_of_leaves_good t1) with
        | 0 => 0
        | x => x * (product_of_leaves_good t2)
      end
  end.

Fixpoint product_of_leaves_cps (ans : Type) (t : binary_tree_nat) (k : nat -> ans) : ans :=
  match t with
    | Leaf n =>
      k n
    | Node t1 t2 =>
      product_of_leaves_cps
        ans
        t1
        (fun n1 => product_of_leaves_cps
                     ans
                     t2
                     (fun n2 => k (n1 * n2)))
  end.

Compute bt_1.
Compute product_of_leaves_cps nat bt_1 (fun n => n).

Lemma unfold_product_of_leaves_good_bc :
  forall n : nat,
    product_of_leaves_good (Leaf n) = n.
Proof.
  unfold_tactic product_of_leaves_good.
Qed.

Lemma unfold_product_of_leaves_good_ic :
  forall (t1 t2 : binary_tree_nat),
    product_of_leaves_good (Node t1 t2) =  match (product_of_leaves_good t1) with
        | 0 => 0
        | x => x * (product_of_leaves_good t2)
      end.
Proof.
  unfold_tactic product_of_leaves_good.
Qed.

Definition product_of_leaves_v1 (t : binary_tree_nat) : nat :=
  product_of_leaves_good t.

Compute unit_test_for_product_of_leaves product_of_leaves_v1.
(*
  = true
  : bool
*)
Lemma product_of_leaves_v1_fits_the_specification_of_product_of_leaves :
  specification_of_product_of_leaves product_of_leaves_v1.
  unfold specification_of_product_of_leaves.
  unfold product_of_leaves_v1.
  split.
  intro n.
  rewrite -> unfold_product_of_leaves_good_bc.
  reflexivity.

  intros t1 t2.
  rewrite -> unfold_product_of_leaves_good_ic.
  case (product_of_leaves_good t1) as [ | n'].
    rewrite -> (mult_0_l).
    reflexivity.
  reflexivity.
Qed.

Theorem product_of_leaves_v0_and_v1_implement_the_same_function :
  forall t : binary_tree_nat,
    product_of_leaves_v0 t = product_of_leaves_v1 t.
Proof.
  exact (there_is_only_one_product_of_leaves
           product_of_leaves_v0
           product_of_leaves_v1
           product_of_leaves_v0_fits_the_specification_of_product_of_leaves
           product_of_leaves_v1_fits_the_specification_of_product_of_leaves ).
Qed.

(* ********** *)

(* Food for thought (with thanks to John Anker):
   For any binary tree,
   how would you compare its number of leaves and its number of nodes?
   Is there a relation?  If so, could you formalize it in Coq?
*)

Definition unit_test_for_number_of_nodes (candidate : binary_tree_nat -> nat) :=
  (candidate bt_0 =n= 0)
  &&
  (candidate bt_1 =n= 1)
  &&
  (candidate bt_2 =n= 2)
  &&
  (candidate (Node bt_1 bt_2) =n= 4)
  .

Theorem there_is_only_one_number_of_nodes :
  forall f g : binary_tree_nat -> nat,
    specification_of_number_of_nodes f ->
    specification_of_number_of_nodes g ->
    forall t : binary_tree_nat,
      f t = g t.
Proof.
  intros f g.
  unfold specification_of_number_of_nodes.
  intros [Hf_leaf Hf_node] [Hg_leaf Hg_node].
  intro t.
  induction t as [n | t1 IHt1 t2 IHt2].

  rewrite -> Hf_leaf.
  rewrite -> Hg_leaf.
  reflexivity.

  rewrite -> Hf_node.
  rewrite -> Hg_node.
  rewrite -> IHt1.
  rewrite -> IHt2.
  reflexivity.
Qed.

Fixpoint number_of_nodes_ds (t : binary_tree_nat) : nat :=
  match t with
    | Leaf n =>
      0
    | Node t1 t2 =>
      (number_of_nodes_ds t1) + (number_of_nodes_ds t2) + 1
  end.

Lemma unfold_number_of_nodes_ds_leaf :
  forall n : nat,
    number_of_nodes_ds (Leaf n) = 0.
Proof.
  unfold_tactic number_of_nodes_ds.
Qed.

Lemma unfold_number_of_nodes_ds_node :
  forall t1 t2 : binary_tree_nat,
    number_of_nodes_ds (Node t1 t2) =
    (number_of_nodes_ds t1) + (number_of_nodes_ds t2) + 1.
Proof.
  unfold_tactic number_of_nodes_ds.
Qed.

Definition number_of_nodes_v0 (t : binary_tree_nat) : nat :=
  number_of_nodes_ds t.

Compute unit_test_for_number_of_nodes number_of_nodes_v0.
(*
  = true
  : bool
*)

Lemma number_of_nodes_v0_fits_the_specification_of_number_of_nodes :
  specification_of_number_of_nodes number_of_nodes_v0.
Proof.
  unfold specification_of_number_of_nodes.
  unfold number_of_nodes_v0.
  split.
  intro n.
  rewrite -> (unfold_number_of_nodes_ds_leaf).
  reflexivity.

  intros t1 t2.
  rewrite -> (unfold_number_of_nodes_ds_node).
  rewrite -> (plus_1_r).
  reflexivity.
Qed.

Theorem number_of_leaves_relates_to_number_of_nodes :
  forall t : binary_tree_nat,
    number_of_leaves_v0 t = 1 + number_of_nodes_v0 t.
Proof.
  intro t.
  unfold number_of_nodes_v0.
  unfold number_of_leaves_v0.
  induction t as [ t' | t1 IHt1 t2 IHt2 ].
  rewrite -> (unfold_number_of_leaves_ds_Leaf).
  rewrite -> (unfold_number_of_nodes_ds_leaf).
  rewrite -> (plus_0_r).
  reflexivity.

  rewrite -> (unfold_number_of_nodes_ds_node).
  rewrite -> (unfold_number_of_leaves_ds_Node).
  rewrite <- (plus_assoc).
  rewrite -> (plus_comm (number_of_nodes_ds t2) 1).
  rewrite <- (IHt2).
  rewrite -> (plus_assoc).
  rewrite <- (IHt1).
  reflexivity.
Qed.

(* ********** *)

(* end of week_40a_binary_trees.v *)


(* week_38a_recap.v *)
(* dIFP 2014-2015, Q1, Week 38 *)
(* Olivier Danvy <danvy@cs.au.dk> *)

(* ********** *)

(* Learning goals for this week:

   - Using previous lemmas (with rewrite or apply)
     without giving them all their arguments,
     and
     acquiring a sense of which arguments are actually needed,
     to disambiguate.

     To this end, all the proofs of this week's exercises
     should be in two versions, separated by "Restart.":
     * in the first version,
       all the uses of previous lemmas
       should have _complete arguments_; and
     * in the second version,
       all the uses of previous lemmas
       should have _as few arguments as possible_.

   - at

   - The exact tactic:
     it is like apply, requires all the arguments,
     and is used to complete a subgoal.

   - The f_equal tactic:
     it is like f_equal_S,
     just for any function rather than just for S.

   - Proofs by case.

   - Searching the libraries.
*)

(* ********** *)

Require Import Arith Bool.

Search (_ + _ = _ + _ -> _ = _).
Search (S _ + _ = _).

SearchAbout plus.

(* ********** *)

Require Import unfold_tactic.

Lemma unfold_plus_bc :
  forall y : nat,
    0 + y = y.
(* left-hand side in the base case of plus
   =
   the corresponding conditional branch *)
Proof.
  unfold_tactic plus.
Qed.

Lemma unfold_plus_ic :
  forall x' y : nat,
    (S x') + y = S (x' + y).
(* left-hand side in the inductive case of plus
   =
   the corresponding conditional branch *)
Proof.
  unfold_tactic plus.
Qed.

Lemma unfold_mult_bc :
  forall y : nat,
    0 * y = 0.
(* left-hand side in the base case
   =
   the corresponding conditional branch *)
Proof.
  unfold_tactic mult.
Qed.

Lemma unfold_mult_ic :
  forall x' y : nat,
    (S x') * y = y + (x' * y).
(* left-hand side in the inductive case
   =
   the corresponding conditional branch *)
Proof.
  unfold_tactic mult.
Qed.

(* ***** *)

Lemma plus_1_l :
  forall x : nat,
    1 + x = S x.
Proof.
  intro x.
  rewrite -> (unfold_plus_ic 0).
  rewrite -> (unfold_plus_bc x).
  reflexivity.

  Restart.

  intro x.
  rewrite -> unfold_plus_ic.
  rewrite -> unfold_plus_bc.
  reflexivity.
Qed.

Lemma plus_1_r :
  forall x : nat,
    x + 1 = S x.
Proof.
  intro x.
  rewrite -> (plus_comm x 1).
  exact (plus_1_l x).

  Restart.

  intro x.
  rewrite -> plus_comm.
  apply plus_1_l.
Qed.

(* ***** *)

Lemma f_equal_S :
  forall x y : nat,
    x = y -> S x = S y.
Proof.
  intros x y.
  intro H_xy.
  rewrite -> H_xy.
  reflexivity.

  Restart.

  Check f_equal.
  Check (f_equal S).
  apply (f_equal S).

  Restart.

  exact (f_equal S).

  Restart.

  apply f_equal.
Qed.

Lemma f_equal_plus_1 :
  forall x y : nat,
    x = y -> 1 + x = 1 + y.
Proof.
  exact (f_equal (plus 1)).

  Restart.

  apply f_equal.
Qed.

Lemma f_equal_plus_10 :
  forall x y : nat,
    x = y -> 10 + x = 10 + y.
Proof.
  exact (f_equal (plus 10)).

  Restart.

  apply f_equal.
Qed.

Lemma f_equal_plus_20 :
  forall x y : nat,
    x = y -> x + 20 = 20 + y.
Proof.
  intros x y H_xy.
  rewrite -> (plus_comm x 20).
  exact (f_equal (plus 20) H_xy).

  Restart.

  intros x y H_xy.
  rewrite -> plus_comm.
  apply f_equal.
  exact H_xy.
Qed.

Lemma f_equal_plus_30 :
  forall x y : nat,
    x = y -> 30 + x = y + 30.
Proof.
  intros x y H_xy.
  rewrite -> (plus_comm y 30).
  exact (f_equal (plus 30) H_xy).

  Restart.

  intros x y H_xy.
  rewrite -> plus_comm.

  Restart.

  intros x y H_xy.
  rewrite -> (plus_comm y 30).

  Restart.

  intros x y H_xy.
  rewrite -> (plus_comm y _).

  Restart.

  intros x y H_xy.
  rewrite -> (plus_comm _ 30).

  apply f_equal.
  exact H_xy.
Qed.

(* ********** *)

(* Binomial expansion at rank 2: *)

Definition square (x : nat) : nat :=
  x * x.

Lemma unfold_square :
  forall x : nat,
    square x = x * x.
Proof.
  unfold_tactic square.
Qed.

Lemma binomial_2 :
  forall x y : nat,
    square (x + y) = square x + 2 * x * y + square y.
Proof.
  intros x y.
  rewrite -> unfold_square.
  Search((_ + _) * _ = _).
  rewrite -> mult_plus_distr_r.
  rewrite -> mult_plus_distr_l.
  rewrite -> mult_plus_distr_l.
  rewrite -> (mult_comm y x).
  symmetry.
  rewrite -> unfold_square.
  rewrite -> unfold_square.
  rewrite -> (unfold_mult_ic 1 x).
  rewrite -> (unfold_mult_ic 0 x).
  rewrite -> unfold_mult_bc.
  rewrite -> plus_0_r.
  rewrite -> mult_plus_distr_r.
  rewrite -> plus_assoc.
  rewrite -> plus_assoc.
  reflexivity.

  Restart.

  intros x y.
  rewrite ->3 unfold_square.
  Restart.

  intros x y.

  rewrite -> unfold_square.
  rewrite -> unfold_square.
  rewrite -> unfold_square.
  ring.
Qed.

(* ********** *)

(* [To be done at home, let's skip to the evenp example.] *)

(* The power (i.e., exponentiation) function: *)

(* A unit test: *)

Notation "A =n= B" := (beq_nat A B) (at level 70, right associativity).

Definition unit_test_for_power (candidate : nat -> nat -> nat) :=
  (candidate 2 0 =n= 1)
  &&
  (candidate 2 1 =n= 2)
  &&
  (candidate 2 2 =n= 4)
  &&
  (candidate 2 10 =n= 1024)
  .

(* A specification: *)

Definition specification_of_power (power : nat -> nat -> nat) :=
  (forall x : nat,
     power x 0 = 1)
  /\
  (forall x n' : nat,
     power x (S n') = x * (power x n')).

(* Uniqueness of the specification: *)

Proposition there_is_only_one_power :
  forall power1 power2 : nat -> nat -> nat,
    specification_of_power power1 ->
    specification_of_power power2 ->
    forall x n : nat,
      power1 x n = power2 x n.
Proof.
Abort.
(* Replace "Abort." with a (standard) proof. *)

(* Some lemmas about power: *)

Lemma about_power_base_one :
  forall power : nat -> nat -> nat,
    specification_of_power power ->
    forall n : nat,
      power 1 n = 1.
Proof.
Abort.
(* Replace "Abort." with a (standard) proof. *)

Lemma about_power_base_mult :
  forall power : nat -> nat -> nat,
    specification_of_power power ->
    forall x y n : nat,
      power (x * y) n = (power x n) * (power y n).
Proof.
Abort.
(* Replace "Abort." with a (standard) proof. *)

Lemma about_power_exponent_plus :
  forall power : nat -> nat -> nat,
    specification_of_power power ->
    forall x i j : nat,
      power x (i + j) = (power x i) * (power x j).
Proof.
Abort.
(* Replace "Abort." with a (standard) proof. *)

Lemma about_power_exponent_mult :
  forall power : nat -> nat -> nat,
    specification_of_power power ->
    forall x i j : nat,
      power x (i * j) = power (power x i) j.
Proof.
Abort.
(* Replace "Abort." with a (standard) proof. *)

(* ***** *)

(* First implementation: *)

Fixpoint power_v1 (x n : nat) : nat :=
  match n with
    | 0 => 1
    | S n' => x * (power_v1 x n')
  end.

Compute unit_test_for_power power_v1.
(*
     = true
     : bool
*)

Lemma unfold_power_v1_bc :
  forall x : nat,
    power_v1 x 0 = 1.
Proof.
  unfold_tactic power_v1.
Qed.

Lemma unfold_power_v1_ic :
  forall x n' : nat,
    power_v1 x (S n') = x * (power_v1 x n').
Proof.
  unfold_tactic power_v1.
Qed.

Proposition power_v1_satisfies_the_specification_of_power :
  specification_of_power power_v1.
Proof.
Abort.
(* Replace "Abort." with a (standard) proof. *)

(* ***** *)

(* Second implementation
   (lambda-dropped version of the first): *)

Definition power_v2 (x n_orig : nat) : nat :=
  let fix visit (n : nat) : nat :=
      match n with
        | 0 => 1
        | S n' => x * (visit n')
      end
  in visit n_orig.

Compute unit_test_for_power power_v2.
(*
     = true
     : bool
*)

Lemma unfold_power_v2_bc :
  forall x : nat,
    power_v2 x 0 = 1.
Proof.
  unfold_tactic power_v2.
Qed.

Lemma unfold_power_v2_ic :
  forall x n' : nat,
    power_v2 x (S n') = x * (power_v2 x n').
Proof.
  unfold_tactic power_v2.
Qed.

Proposition power_v2_satisfies_the_specification_of_power :
  specification_of_power power_v2.
Proof.
Abort.
(* Replace "Abort." with a (standard) proof. *)

(* ***** *)

(* Third implementation (version with an accumulator): *)

Fixpoint power_acc (x n a : nat) : nat :=
  match n with
    | 0 => a
    | S n' => power_acc x n' (x * a)
  end.

Definition power_v3 (x n : nat) : nat :=
  power_acc x n 1.

Compute unit_test_for_power power_v3.
(*
     = true
     : bool
*)

Lemma unfold_power_acc_bc :
  forall x a : nat,
    power_acc x 0 a = a.
Proof.
  unfold_tactic power_acc.
Qed.

Lemma unfold_power_acc_ic :
  forall x n' a : nat,
    power_acc x (S n') a = power_acc x n' (x * a).
Proof.
  unfold_tactic power_acc.
Qed.

Proposition power_v3_satisfies_the_specification_of_power :
  specification_of_power power_v3.
Proof.
Abort.
(* Replace "Abort." with a (standard) proof. *)

(* ********** *)

(* The even predicate: *)

(* A unit test: *)

Notation "A =b= B" := (eqb A B) (at level 70, right associativity).

Definition unit_test_for_evenp (candidate : nat -> bool) :=
  (candidate 0 =b= true)
  &&
  (candidate 1 =b= false)
  &&
  (candidate 2 =b= true)
  &&
  (candidate 3 =b= false)
  .

(* A specification: *)

Definition specification_of_evenp (evenp : nat -> bool) :=
  (evenp 0 = true)
  /\
  (evenp 1 = false)
  /\
  (forall n'' : nat,
     evenp (S (S n'')) = evenp n'').

(* Uniqueness of the specification: *)

Proposition there_is_only_one_evenp :
  forall f g : nat -> bool,
    specification_of_evenp f ->
    specification_of_evenp g ->
    forall n : nat,
      f n = g n.
Proof.
  intros f g.
  unfold specification_of_evenp.
  intros [Hf_0 [Hf_1 Hf_SS]]
         [Hg_0 [Hg_1 Hg_SS]].
  intro n.
  induction n as [ | n' IHn'].

  rewrite -> Hf_0.
  rewrite -> Hg_0.
  reflexivity.

  case n' as [ | n''] eqn:Hn'.

  rewrite -> Hf_1.
  rewrite -> Hg_1.
  reflexivity.

  rewrite -> Hf_SS.
  rewrite -> Hg_SS.

  case n'' as [ | n'''] eqn:Hn''.
  rewrite -> Hf_0.
  rewrite -> Hg_0.
  reflexivity.

  Restart.

  intros f g.
  unfold specification_of_evenp.
  intros [Hf_0 [Hf_1 Hf_SS]]
         [Hg_0 [Hg_1 Hg_SS]].
  intro n.

  assert(consecutive :
           forall x : nat,
             f x = g x /\ f (S x) = g (S x)).

  intro x.
  induction x as [ | x' [IHx' IHSx']].

  split.

    rewrite -> Hf_0.
    rewrite -> Hg_0.
    reflexivity.

    rewrite -> Hf_1.
    rewrite -> Hg_1.
    reflexivity.

    split.

    exact IHSx'.

    rewrite -> Hf_SS.
    rewrite -> Hg_SS.

    exact IHx'.

    destruct(consecutive n) as [H_magic _].
    exact H_magic.
Qed.

    (* Properties: *)

Lemma about_evenp :
  forall evenp : nat -> bool,
    specification_of_evenp evenp ->
    forall x : nat,
      evenp (S x) = negb (evenp x).
Proof.
  intros evenp.
  unfold specification_of_evenp.
  intros [H_0 [H_1 H_SS]].
  intro x.
  induction x as [ | x' IHx'].

  rewrite -> H_1.
  rewrite -> H_0.
  unfold negb.
  reflexivity.

  rewrite -> H_SS.
  rewrite -> IHx'.
  destruct (evenp x') eqn:H_evenp_x'.

    unfold negb.
    reflexivity.

  unfold negb.
  reflexivity.
Qed.

Lemma about_evenp_of_a_sum :
  forall evenp : nat -> bool,
    specification_of_evenp evenp ->
    forall x y : nat,
      evenp (x + y) = eqb (evenp x) (evenp y).
Proof.
  intros evenp.
  unfold specification_of_evenp.
  intros [H_0 [H_1 H_SS]].
  intro x.
  induction x as [ | x' IHx'].

  intro y.
  rewrite -> plus_0_l.
  rewrite -> H_0.
  unfold eqb.
  destruct (evenp y) eqn:H_y.
    reflexivity.
  reflexivity.

  (* Det samme som
  intro y.
  destruct y as [ | y' ].
  *)

  intros [ | y' ].

  rewrite -> plus_0_r.
  rewrite -> H_0.
  destruct (evenp (S x')) eqn:H_evenp_Sx'.
  unfold eqb.
  reflexivity.

  unfold eqb.
  reflexivity.

  rewrite -> unfold_plus_ic.
  rewrite -> plus_comm.
  rewrite -> unfold_plus_ic.
  rewrite -> plus_comm.
  rewrite -> H_SS.
  rewrite -> IHx'.
  rewrite -> about_evenp.
  rewrite -> about_evenp.
  destruct (evenp x') eqn:H_evenp_x'.
    destruct (evenp y') eqn:H_evenp_y'.
      unfold negb.
      unfold eqb.
      reflexivity.
    unfold negb.
    unfold eqb.
    reflexivity.
  destruct (evenp y') eqn:H_evenp_y'.
    unfold negb.
    unfold eqb.
    reflexivity.
  unfold negb.
  unfold eqb.
  reflexivity.

Qed.

(* An implementation: *)

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

Compute unit_test_for_evenp evenp_v0.
(*
     = true
     : bool
*)

(* Or equivalently (syntactic sugar): *)

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

Compute unit_test_for_evenp evenp_v0'.
(*
     = true
     : bool
*)

Lemma unfold_evenp_v0_bc0 :
  evenp_v0 0 = true.
Proof.
  unfold_tactic evenp_v0.
Qed.

Lemma unfold_evenp_v0_bc1 :
  evenp_v0 1 = false.
Proof.
  unfold_tactic evenp_v0.
Qed.

Lemma unfold_evenp_v0_ic :
  forall n'' : nat,
    evenp_v0 (S (S n'')) = evenp_v0 n''.
Proof.
  unfold_tactic evenp_v0.
Qed.

Proposition evenp_satisfies_the_specification_of_evenp :
  specification_of_evenp evenp_v0.
Proof.
Abort.
(* Replace "Abort." with a (standard) proof. *)

(* ********** *)

(* The Fibonacci numbers: *)

(* A unit test: *)

Definition unit_test_for_fib (candidate: nat -> nat) :=
  (candidate 0 =n= 0)
  &&
  (candidate 1 =n= 1)
  &&
  (candidate 2 =n= 1)
  &&
  (candidate 3 =n= 2)
  &&
  (candidate 4 =n= 3)
  &&
  (candidate 5 =n= 5)
  &&
  (candidate 6 =n= 8)
  &&
  (candidate 7 =n= 13)
  &&
  (candidate 8 =n= 21)
  &&
  (candidate 9 =n= 34)
  .

(* A specification: *)

Definition specification_of_the_fibonacci_function (fib : nat -> nat) :=
  fib 0 = 0
  /\
  fib 1 = 1
  /\
  forall n'' : nat,
    fib (S (S n'')) = fib (S n'') + fib n''.

(* Uniqueness of the specification: *)

Proposition there_is_only_one_fibonacci_function :
  forall fib1 fib2 : nat -> nat,
    specification_of_the_fibonacci_function fib1 ->
    specification_of_the_fibonacci_function fib2 ->
    forall n : nat,
      fib1 n = fib2 n.
Proof.
Abort.
(* Replace "Abort." with a proof. *)

(* ***** *)

(* A first implementation: *)

Fixpoint fib_ds (n : nat) : nat :=
  match n with
    | 0 => 0
    | S n' => match n' with
                | 0 => 1
                | S n'' => fib_ds n' + fib_ds n''
              end
  end.

Definition fib_v0 (n : nat) : nat :=
  fib_ds n.

Compute unit_test_for_fib fib_v0.

Lemma unfold_fib_ds_base_case_0 :
  fib_ds 0 = 0.
Proof.
  unfold_tactic fib_ds.
Qed.

Lemma unfold_fib_ds_base_case_1 :
  fib_ds 1 = 1.
Proof.
  unfold_tactic fib_ds.
Qed.

Lemma unfold_fib_ds_induction_case :
  forall n'' : nat,
    fib_ds (S (S n'')) = fib_ds (S n'') + fib_ds n''.
Proof.
  unfold_tactic fib_ds.
Qed.

Theorem fib_ds_fits_the_specification_of_the_fibonacci_function :
  specification_of_the_fibonacci_function fib_ds.
Proof.
Abort.
(* Replace "Abort." with a (standard) proof. *)

Corollary fib_v0_fits_the_specification_of_the_fibonacci_function :
  specification_of_the_fibonacci_function fib_v0.
Proof.
  unfold fib_v0.
  apply fib_ds_fits_the_specification_of_the_fibonacci_function.
Qed.

(* ***** *)

(* A second implementation, with an accumulator: *)

Fixpoint fib_acc (n a1 a0 : nat) : nat :=
  match n with
    | 0 => a0
    | S n' => fib_acc n' (a1 + a0) a1
  end.

Definition fib_v1 (n : nat) : nat :=
  fib_acc n 1 0.

Compute unit_test_for_fib fib_v1.

Lemma unfold_fib_acc_base_case :
  forall a1 a0 : nat,
    fib_acc 0 a1 a0 = a0.
Proof.
  unfold_tactic fib_acc.
Qed.

Lemma unfold_fib_acc_induction_case :
  forall n' a1 a0 : nat,
    fib_acc (S n') a1 a0 = fib_acc n' (a1 + a0) a1.
Proof.
  unfold_tactic fib_acc.
Qed.

Lemma unfold_fib_v1 :
  forall n : nat,
    fib_v1 n = fib_acc n 1 0.
Proof.
  unfold_tactic fib_acc.
Qed.

(* Eureka lemma: *)

Lemma about_fib_acc :
  forall fib : nat -> nat,
    specification_of_the_fibonacci_function fib ->
    forall k i : nat,
      fib_acc k (fib (S i)) (fib i) = fib (k + i).
Proof.
Abort.
(* Replace "Abort." with a (standard) proof. *)
Qed.

Theorem fib_v1_fits_the_specification_of_the_fibonacci_function :
  specification_of_the_fibonacci_function fib_v1.
Proof.
Abort.
(* Replace "Abort." with a proof. *)

(* ***** *)

(* A third implementation, with a co-accumulator: *)

Fixpoint fib_co_acc (n : nat) : nat * nat :=
  match n with
    | O => (1, 0)
    | S n' => let (a1, a0) := fib_co_acc n'
              in (a1 + a0, a1)
  end.

Definition fib_v2 (n : nat) : nat :=
  match n with
    | O => 0
    | S n' => let (a1, a0) := fib_co_acc n'
              in a1
  end.

Compute unit_test_for_fib fib_v2.

Lemma unfold_fib_co_acc_base_case :
  fib_co_acc 0 = (1, 0).
Proof.
  unfold_tactic fib_co_acc.
Qed.

Lemma unfold_fib_co_acc_induction_case :
  forall n' : nat,
    fib_co_acc (S n') = let (a1, a0) := fib_co_acc n'
                        in (a1 + a0, a1).
Proof.
  unfold_tactic fib_co_acc.
Qed.

Lemma unfold_fib_v2_0 :
  fib_v2 0 = 0.
Proof.
  unfold_tactic fib_v2.
Qed.

Lemma unfold_fib_v2_Sn' :
  forall n' : nat,
    fib_v2 (S n') = let (a1, a0) := fib_co_acc n'
                    in a1.
Proof.
  unfold_tactic fib_v2.
Qed.

(* Eureka lemma: *)

Lemma about_fib_co_acc :
  forall fib : nat -> nat,
    specification_of_the_fibonacci_function fib ->
    forall n : nat,
      fib_co_acc n = (fib (S n), fib n).
Proof.
Abort.
(* Replace "Abort." with a (standard) proof. *)

Theorem fib_v2_fits_the_specification_of_the_fibonacci_function :
  specification_of_the_fibonacci_function fib_v2.
Proof.
Abort.
(* Replace "Abort." with a proof. *)

(* ********** *)

(* end of week_38a_recap.v *)


From LF Require Export Lists.

Inductive list (X : Type) : Type :=
  | nil
  | cons (x : X) (l : list X).

Check list : Type -> Type.

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.

Check (cons nat 2 (cons nat 1 (nil nat))) : list nat.

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

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

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

Module NumberGrumble.
  Inductive number : Type :=
  | a
  | b (x : number) (y : nat)
  | c.

  Inductive grumble (X : Type) :=
  | d (m : number)
  | 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
    d mumble (b a 5)    YES
    d bool (b a 5)      YES
    e bool true         YES
    e mumble (b c 0)    YES
    e bool (b c 0)      No
    c                   NO
 *)

  Check d number (b a 5) : grumble number.
  Check d bool (b a 5) : grumble bool.
  Check e bool true : grumble bool.
  Check e number (b c 0) : grumble number.

End NumberGrumble.

Fixpoint repeat' X x count : list X :=
  match count with
  | O => 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.

(*
This may sound similar to type annotation inference -- and, indeed, the two procedures rely on the same underlying mechanisms. Instead of simply omitting the types of some arguments to a function, like
    repeat' X x count : list X :=
we can also replace the types with holes
    repeat' (X : _) (x : _) (count : _) : list X :=
to tell Coq to attempt to infer the missing information.
*)

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

Definition list123 :=
  cons nat 1 (cons nat 2 (cons nat 3 (nil nat))).
Definition list123' :=
  cons _ 1 (cons _ 2 (cons _ 3 (nil _))).

(*
The Arguments directive specifies the name of the function
(or constructor) and 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}.

Definition list123'' := cons 1 (cons 2 (cons 3 nil)).

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

(*
We will use the latter style whenever possible, but __we will
continue to use explicit Argument declarations for Inductive
constructors.__ The reason for this is that marking the parameter
of an inductive type as implicit causes it to become implicit
for the type itself, not just for its constructors. For instance,
consider the following alternative definition of the list type:
*)

Inductive list' {X : Type} : Type :=
  | nil'
  | cons' (x : X) (l : list').

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

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

Fixpoint length {X : Type} (l : list X) : nat :=
  match l with
  | nil => O
  | cons h tl => S (length tl)
  end.

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

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

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

Fail Definition mynil := nil.

Definition mynil : list nat := nil.

Check @nil : forall (X : Type), list X.

Definition mylist' := @nil nat.

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

Notation "[ ]" := nil.

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

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

Definition list123''' := [1;2;3].

Fail Definition mynil'' := [].
Definition mynil'' : list nat := [].

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

Theorem app_assoc :
  forall (X : Type), forall (l1 l2 l3: list X),
  app (app l1 l2) l3 = app l1 (app l2 l3).
Proof.
  intros.
  induction l1 as [|l1'].
  - simpl.
    reflexivity.
  - simpl.
    rewrite IHl1.
    reflexivity.
Qed.

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

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

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

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.

(*
  The annotation : type_scope tells Coq that this abbreviation
  should only be used when parsing types, not when parsing
  expressions. This avoids a clash with the multiplication
  symbol.
*)

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.

Fixpoint combine {X Y : Type} (l1 : list X) (l2 : list Y) : list (X * Y) :=
  match l1, l2 with
  | _, nil => nil
  | nil, _ => nil
  | cons h1 tl1, cons h2 tl2 => cons (h1, h2) (combine tl1 tl2)
  end.

Compute combine [1; 2] [true; false; true].

Fixpoint split { X Y : Type} (l : list (X * Y)) : ((list X) * (list Y)) :=
  match l with
  | nil => (nil, nil)
  | cons (hx, hy) tl =>
    match (split tl) with
    | (lx, ly) => (cons hx lx, cons hy ly)
    end
  end.

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

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

  Arguments Some {X}.
  Arguments None {X}.
End OptionPlayground.

Fixpoint nth_err {X : Type} (l : list X) (n : nat) : option X :=
  match n, l with
  | O, h :: tl => Some h
  | _, nil => None
  | S n', h :: tl => nth_err tl n'
  end.

Example test_nth_err1 :
  nth_err [4;5;6;7] 0 = Some 4.
Proof.
  simpl.
  reflexivity.
Qed.

Example test_nth_err2 :
  nth_err [[1];[2]] 1 = Some [2].
Proof.
  simpl.
  reflexivity.
Qed.

Example test_nth_err3 :
  nth_err [true] 2 = None.
Proof.
  simpl.
  reflexivity.
Qed.

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

Check @hd_err : forall (X : Type), list X -> option X.

Example test_hd_err1 :
  hd_err [1; 2] = Some 1.
Proof.
  simpl.
  reflexivity.
Qed.

Example test_hd_err2 :
  hd_err [[1]; [2]] = Some [1].
Proof.
  simpl.
  reflexivity.
Qed.

(* Higher-Order Functions *)

Definition doit3times {X : Type} (f : X -> X) (n : X) : X :=
  f (f (f n)).

Check @doit3times : forall (X : Type), (X -> X) -> X -> X.

Example test_doit3times :
  doit3times minustwo 9 = 3.
Proof.
  (* compute. *)
  reflexivity.
Qed.

Example test_doit3times' :
  doit3times negb true = false.
Proof.
  (* compute. *)
  reflexivity.
Qed.

Fixpoint filter {X : Type} (test : X -> bool) (l : list X) : (list X) :=
  match l with
  | nil => nil
  | h :: tl =>
    match test h with
    | true => h :: (filter test tl)
    | false => (filter test tl)
    end
  end.

Example test_filter1 :
  filter even [1;2;3;4] = [2;4].
Proof.
  simpl.
  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.
  simpl.
  reflexivity.
Qed.

Definition countoddmember' (l : list nat) : nat :=
  length (filter odd l).

Example test_countoddmember'1 :
  countoddmember' [1;0;3;1;4;5] = 4.
Proof.
  compute.
  reflexivity.
Qed.

Example test_countoddmember'2 :
  countoddmember' [0;2;4] = 0.
Proof.
  compute.
  reflexivity.
Qed.

Example test_countoddmember'3 :
  countoddmember' nil = 0.
Proof.
  compute.
  reflexivity.
Qed.

(* Anonymous Functions *)

Example test_anno_fun' :
  doit3times (fun n => n * n) 2 = 256.
Proof.
  reflexivity.
Qed.

Example test_filter2' :
  filter (fun l => length l =? 1)
    [[1;2];[3];[4];[5;6;7];[];[8]] = [[3];[4];[8]].
Proof.
  simpl.
  reflexivity.
Qed.

Definition filter_even_gt7 (l : list nat) : list nat:=
  filter (fun n => (even n) && (n >=? 7)) l.

Example test_filter_even_gt7 :
  filter_even_gt7 [1;2;6;9;10;3;12;8] = [10;12;8].
Proof.
  compute.
  reflexivity.
Qed.

Example test_filter_even_gt7_2 :
  filter_even_gt7 [5;2;6;19;129] = [].
Proof.
  compute.
  reflexivity.
Qed.

Definition partition {X : Type} (f : X -> bool) (l : list X) : ((list X) * (list X)) :=
  (filter f l, filter (fun n => negb (f n)) l).

Example test_patition1 :
  partition odd [1;2;3;4;5] = ([1;3;5], [2;4]).
Proof.
  compute.
  reflexivity.
Qed.

Example test_partition2 :
  partition (fun x => false) [5;9;0] = ([], [5;9;0]).
Proof.
  compute.
  reflexivity.
Qed.

Fixpoint map {X Y : Type} (f : X -> Y) (l : list X) : (list Y) :=
  match l with
  | nil => nil
  | h :: tl => (f h) :: (map f tl)
  end.

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

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

Lemma 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.
  induction l1 as [| l1'].
  - simpl.
    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.
  induction l as [| l'].
  - simpl.
    reflexivity.
  - simpl.
    rewrite <- IHl.
    simpl.
    rewrite map_app_distr.
    reflexivity.
Qed.

Fixpoint flat_map {X Y : Type} (f : X -> list Y) (l : list X) : list Y :=
  match l with
  | nil => nil
  | h :: tl => (f h) ++ (flat_map f tl)
  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.
  compute.
  reflexivity.
Qed.

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

Fixpoint fold {X Y : Type} (f : X -> Y -> Y) (l : list X) (acc : Y) : Y :=
  match l with
  | nil => acc
  | h :: tl => f h (fold f tl acc)
  end.

Example test_fold1 :
  fold plus [1;2;3;4] 0 = 10.
Proof.
  compute.
  reflexivity.
Qed.

Check (fold andb) : list bool -> bool -> bool.

Example fold_example1 :
  fold mult [1;2;3;4] 1 = 24.
Proof.
  compute.
  reflexivity.
Qed.

Example fold_example2 :
  fold andb [true;true;false;true] true = false.
Proof.
  compute.
  reflexivity.
Qed.

Example fold_example3 :
  fold app [[1];[];[2;3];[4]] [] = [1;2;3;4].
Proof.
  compute.
  reflexivity.
Qed.

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

Definition ftrue := constfun true.

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

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

Check plus : nat -> nat -> nat.

Definition plus3 := plus 3.

Check plus3 : nat -> nat.

Example test_plus3 : plus3 4 = 7.
Proof.
  compute.
  reflexivity.
Qed.

Example test_plus3' : doit3times plus3 0 = 9.
Proof.
  compute.
  reflexivity.
Qed.

Example test_plus3'' : doit3times (plus 3) 0 = 9.
Proof.
  compute.
  reflexivity.
Qed.

Module Exercises.
  Definition fold_length {X : Type} (l : list X) : nat :=
    fold (fun _ acc => S acc) l 0.

  Example test_fold_length1 : fold_length [4;7;0] = 3.
  Proof.
    compute.
    reflexivity.
  Qed.

  (* Lemma fole_length_: .
  Proof.

  Qed. *)

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

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

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

(*
  It is possible to convert a function between these two types.
  Converting from X × Y → Z to X → Y → Z is called currying, in
  honor of the logician Haskell Curry. Converting from X → Y → Z
  to X × Y → Z is called uncurrying.
*)

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

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

  Example test_map1': map (plus 3) [2;0;2] = [5;3;5].
  Proof.
    compute.
    reflexivity.
  Qed.

  Check @prod_curry.
  Check @prod_uncurry.

  Theorem uncurry_curry :
    forall (X Y Z : Type) (f : X -> Y -> Z) (x : X) (y : Y),
    prod_curry (prod_uncurry f) x y = f x y.
  Proof.
    intros.
    compute.
    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.
    simpl.
    compute.
    reflexivity.
  Qed.

  Theorem nth_err_formal:
    forall (X : Type) (l : list X) (n : nat),
    length l = n -> @nth_err X l n = None.
  Proof.
    intros.
    induction l as [|l'].
    - rewrite <- H.
      simpl.
      reflexivity.
    - rewrite <- H.
      simpl.
      rewrite <- IHl.
  Admitted.

Module Church.
  Definition cnat :=
    forall (X : Type), (X -> X) -> X -> X.

  Definition zero : cnat :=
    fun (X : Type) (succ : X -> X) (zero : X) => zero.

  Definition one : cnat :=
    fun (X : Type) (succ : X -> X) (zero : X) => succ zero.

  Definition two : cnat :=
    fun (X : Type) (succ : X -> X) (zero : X) => succ (succ zero).

  Definition three : cnat := @doit3times.

  Example zero_church_peano : zero nat S O = 0.
  Proof.
    compute.
    reflexivity.
  Qed.

  Example one_church_peano : one nat S O = 1.
  Proof.
    reflexivity.
  Qed.

  Example two_church_peano : two nat S O = 2.
  Proof.
    reflexivity.
  Qed.

  Definition scc (n : cnat) : cnat :=
    fun (X : Type) (succ : X -> X) (x : X) => succ (n X succ x).

  Example scc_1 : scc zero = one.
  Proof.
    reflexivity.
  Qed.

  Example scc_2 : scc one = two.
  Proof.
    reflexivity.
  Qed.

  Example scc_3 : scc two = three.
  Proof.
    reflexivity.
  Qed.

  Definition plus (n m : cnat) : cnat :=
    fun (X : Type) (succ : X -> X) (x : X) =>
      n X succ (m X succ x).

  Example plus_1 : plus zero one = one.
  Proof.
    reflexivity.
  Qed.

  Example plus_2 : plus two three = plus three two.
  Proof.
    reflexivity.
  Qed.

  Example plus_3 :
    plus (plus two two) three = plus one (plus three three).
  Proof.
    reflexivity.
  Qed.

  Definition mult (n m : cnat) : cnat :=
    fun (X : Type) (succ : X -> X) (x : X) =>
      (n X (fun x' => m X succ x')) x.

  Example mult_1 : mult one one = one.
  Proof.
    reflexivity.
  Qed.

  Example mult_2 : mult zero (plus three three) = zero.
  Proof.
    reflexivity.
  Qed.

  Example mult_3 : mult two three = plus three three.
  Proof.
    reflexivity.
  Qed.

  Definition exp (n m : cnat) : cnat :=
    fun (X : Type) (succ : X -> X) (x : X) =>
      (m (X -> X) (n X) succ) x.

  Example exp_1 : exp two two = plus two two.
  Proof.
    reflexivity.
  Qed.

  Example exp_2 : exp three zero = one.
  Proof.
    reflexivity.
  Qed.

  Example exp_3 : exp three two = plus (mult two (mult two two)) one.
  Proof.
    reflexivity.
  Qed.

End Church.
End Exercises.


From mathcomp Require Import ssreflect ssrfun ssrbool eqtype ssrnat div.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

(** Use SSReflect tactics.
    DO NOT use automation like [tauto], [intuition], [firstorder], etc.,
    except for [by], [done], [exact] tactic(al)s. *)

(** * Exercise *)
Lemma nlem (A : Prop):
  ~ (A \/ ~ A) -> A.
Proof.
rewrite /not.
move=> f.
move: (f).
case.
right.
move=> a.
apply f.
left.
done.
Qed.

(** Hint: you might want to use a separate lemma here to make progress.
Or, use the `have` tactic: `have: statement` creates a new subgoal and asks
you to prove the statement. This is like a local lemma. *)

(** * Exercise *)
Lemma weak_Peirce (A B : Prop) :
  ((((A -> B) -> A) -> A) -> B) -> B.
Proof.
move=> f1.
apply (f1).
move=> f2.
apply (f2).
move=> a.
apply f1.
move=> _.
done.
Qed.

(** * Exercise *)
(* Prove that having a general fixed-point combinator in Coq would be incosistent *)
Definition FIX := forall A : Type, (A -> A) -> A.

Lemma fix_inconsistent :
  FIX -> False.
Proof.
rewrite /FIX.
apply.
done.
Qed.

Section Boolean.
(** * Exercise *)
Lemma negbNE b : ~~ ~~ b -> b.
Proof.
by case: b; done.
Qed.

(** * Exercise *)
Lemma negbK : involutive negb.
Proof.
rewrite /involutive /cancel.
by case.
Qed.

(** * Exercise *)
Lemma negb_inj : injective negb.
Proof.
by case ; case.
Qed.

End Boolean.

(** * Exercise *)
Fixpoint triple (n : nat) : nat :=
  if n is n'.+1 then (triple n').+3
  else n.

Lemma triple_mul3 n :
  triple n = 3 * n.
Proof.
move: n.
elim=> [// | n IHn /=] ; by rewrite mulnS -IHn.
Qed.
(** Hints:
- use the /= action to simplify your goal: e.g. move=> /=.
- use `Search (<pattern>)` to find a useful lemma about multiplication
*)

(** * Exercise
Prove by it induction: you may re-use the addnS and addSn lemmas only *)
Lemma double_inj m n :
  m + m = n + n -> m = n.
Proof.
move: m n.
elim=> [| m IHm] ; case=> [| n] //.
rewrite !addSn !addnS.
case=> /IHm -> //.
Qed.

(* This is a harder exercise than the previous ones but
   the tactics you already know are sufficient *)

(** * Optional exercise
    [negb \o odd] means "even".
    The expression here says, informally,
    the sum of two numbers is even if the summands have the same "evenness",
    or, equivalently, "even" is a morphism from [nat] to [bool] with respect
    to addition and equivalence correspondingly.
    Hint: [Unset Printing Notations.] and [rewrite /definition] are your friends :)
 *)
Lemma even_add :
  {morph (negb \o odd) : x y / x + y >-> x == y}.
Proof.
Admitted.

(** * Optional exercise *)
Lemma DNE_iff_nppp :
  (forall P, ~ ~ P -> P) <-> (forall P, (~ P -> P) -> P).
Proof.
Admitted.

(** * Optional exercise *)
Lemma leq_add1l p m n :
  m <= n -> m <= p + n.
Proof.
Search (_ <= _ + _).
Admitted.
(** Hint: this lemmas does not require induction, just look for a couple lemmas *)

(* ================================================ *)

(*
More fun with functions, OPTIONAL
*)

Section PropertiesOfFunctions.

Section SurjectiveEpic.
Context {A B : Type}.

(* https://en.wikipedia.org/wiki/Surjective_function *)
(** Note: This definition is too strong in Coq's setting, see [epic_surj] below *)
Definition surjective (f : A -> B) :=
  exists g : B -> A, f \o g =1 id.

(** This is a category-theoretical counterpart of surjectivity:
    https://en.wikipedia.org/wiki/Epimorphism *)
Definition epic (f : A -> B) :=
  forall C (g1 g2 : B -> C), g1 \o f =1 g2 \o f -> g1 =1 g2.

(** * Optional exercise *)
Lemma surj_epic f : surjective f -> epic f.
Proof.
Admitted.

(** * Optional exercise *)
Lemma epic_surj f : epic f -> surjective f.
  (** Why is this not provable? *)
Abort.

End SurjectiveEpic.

Section EpicProperties.
Context {A B C : Type}.

(** * Optional exercise *)
Lemma epic_comp (f : B -> C) (g : A -> B) :
  epic f -> epic g -> epic (f \o g).
Admitted.

(** * Optional exercise *)
Lemma comp_epicl (f : B -> C) (g : A -> B) :
  epic (f \o g) -> epic f.
Admitted.

(** * Optional exercise *)
Lemma retraction_epic (f : B -> A) (g : A -> B) :
  (f \o g =1 id) -> epic f.
Admitted.

End EpicProperties.

(** The following section treats some properties of injective functions:
    https://en.wikipedia.org/wiki/Injective_function *)

Section InjectiveMonic.

Context {B C : Type}.

(** This is a category-theoretical counterpart of injectivity:
    https://en.wikipedia.org/wiki/Monomorphism *)
Definition monic (f : B -> C) :=
  forall A (g1 g2 : A -> B), f \o g1 =1 f \o g2 -> g1 =1 g2.

(** * Optional exercise *)
Lemma inj_monic f : injective f -> monic f.
Proof.
Admitted.

(** * Optional exercise *)
Lemma monic_inj f : monic f -> injective f.
Proof.
Admitted.

End InjectiveMonic.

Section MonicProperties.
Context {A B C : Type}.

(** * Optional exercise *)
Lemma monic_comp (f : B -> C) (g : A -> B) :
  monic f -> monic g -> monic (f \o g).
Proof.
Admitted.

(** * Optional exercise *)
Lemma comp_monicr (f : B -> C) (g : A -> B) :
  monic (f \o g) -> monic g.
Proof.
Admitted.

(** * Optional exercise *)
Lemma section_monic (f : B -> A) (g : A -> B) :
  (g \o f =1 id) -> monic f.
Proof.
Admitted.

End MonicProperties.

End PropertiesOfFunctions.


Require Import Arith.

Inductive le' : nat -> nat -> Prop :=
  | le'_0_p : forall p:nat, le' 0 p
  | le'_Sn_Sp : forall n p:nat, le' n p -> le' (S n) (S p).

Hint Resolve le'_0_p le'_Sn_Sp.

Lemma le'_n : forall n : nat, le' n n.
Proof.
 simple induction n; auto.
Qed.

Lemma le'_n_Sp : forall n p : nat, le' n p -> le' n (S p).
Proof.
  simple induction n.
  auto.
  intros n0 Hn0 p Hp.
  inversion_clear Hp.
  auto.
Qed.
Hint Resolve le'_n le'_n_Sp.

Lemma le_le' : forall n p: nat, le n p -> le' n p.
Proof.
 simple induction 1; auto with arith.
Qed.

Lemma le'_le : forall n p: nat, le' n p -> le n p.
Proof.
 simple induction n; auto with arith.
 intros n0 Hn0 p; case p.
 inversion 1.
 inversion 1.
 auto with arith.
Qed.


(* Exercise 1 *)

Require Import Coq.Lists.List.
Import ListNotations.
Require Import Coq.Arith.PeanoNat.

(* 1.1. *)

Definition tl(l: list nat) : list nat :=
  match l with
  | [] => []
  | h::t => t
end.

Compute tl [1;2;3].

(* 1.2. *)

Definition removelast (l: list nat) : list nat :=
  match l with
  | [] => []
  | h :: t => h :: removelast t
end.

Compute removelast [1;2;3;4;5].

(* 1.3. *)

Definition firstn (n: nat) (l: list nat) : list nat :=
  match n with
  | O => l
  | S n' => match l with
            | [] => []
            | h :: t => h :: firstn n' t
            end
end.

Compute firstn 3 [1;2;3;4;5].

(* 1.4.*)

Definition skipn (n: nat) (l: list nat) : list nat :=
  match n with
  | O => l
  | S n' => match l with
            | [] => []
            | h :: t => skipn n' t
            end
end.

Compute skipn 3 [1;2;3;4;5].

(* 1.5.*)

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

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

Check Some 1.

Fixpoint last {X:Type} (l: list X) : option X :=
  match l with
  | [] => None
  | h :: [] => Some h
  | h :: t => last t
end.

Compute last [].
Compute last [1;2;3].

(* 1.6.*)

Fixpoint seq (start: nat) (len: nat) : list nat :=
  match len with
  | 0 => []
  | S len' => start :: (seq (S start) len')
end.

Compute seq 3 4.

(* 1.7.*)

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

Compute split [(1,true);(2,false);(3,true)].

Fixpoint split2 {X Y : Type} (l: list (X*Y)) : (list X)*(list Y) :=
  match l with
  | [] => ([],[])
  | (x, y) :: t => let( left, right) := split t in (x:: left, y::right)
end.

Compute split [(1,true);(2,false);(3,true)].

(* 1.8.*)

Fixpoint append { X : Type} (l1: list X) (l2 : list X) : list X :=
  match l1 with
  | [] => l2
  | h :: t => h :: append t l2
end.

Compute append [1;2;3] [4;5;6].

(* 1.9.*)

Fixpoint rev {X : Type} (l: list X) : list X :=
  match l with
  | [] => []
  | h :: t => append (rev t) [h]
end.

Compute rev [1;2;3].

(* 1.10.*)

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

Compute existsb (fun e => e <=? 3) [2;4;5].
Compute existsb (fun e => e <=? 3) [4;5].

(* 1.11.*)

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

Compute forallb (fun e => e <=? 3) [1;2;3].
Compute forallb (fun e => e <=? 3) [1;2;4].

(* 1.12.*)

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

Compute find (fun e => e <=? 3) [6;4;1;3;7].
Compute find (fun e => e <=? 3) [6;4;4;5;7].

(* 1.13.*)

(* Exercise 2 *)

(* 2.1. *)

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.

Fixpoint partition {X: Type} (test: X -> bool) (l: list X) : (list X) * (list X) :=
  (filter test l , filter (fun e => negb (test e)) l).

Compute partition (fun e => e <=? 3) [6;4;1;3;7].

(* 2.2. *)

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

Fixpoint list_prod {X Y: Type} (l1: list X) (l2: list Y) : list (X*Y) :=
  match l1 with
  | [] => []
  | h1 :: t1 => (map (fun e => (h1 , e)) l2) ++ (list_prod t1 l2)
end.

(* Duvida *)

Compute list_prod [1; 2] [true; false].

(* 2.3. *)

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.

Definition length {X : Type} (l: list X) : nat :=
  fold (fun e c => c + 1) l 0.

Compute length [6;4;1;3;7].

(* 2.4. *)

Definition new_map {X Y: Type} (f:X->Y) (l:list X) : (list Y) :=
  fold (fun x y => f x :: y) l [].

Fixpoint list_prod' {X Y: Type} (l1: list X) (l2: list Y) : list (X*Y) :=
  match l1 with
  | [] => []
  | h1 :: t1 => (new_map (fun e => (h1 , e)) l2) ++ (list_prod t1 l2)
end.

Compute list_prod' [1; 2] [true; false].

(* 2.5. *)

Definition new_filter {X:Type} (test: X->bool) (l:list X): (list X) :=
  fold (fun x y => if test x then x :: y else y ) l [].

Fixpoint partition' {X: Type} (test: X -> bool) (l: list X) : (list X) * (list X) :=
  (filter test l , new_filter (fun e => negb (test e)) l).

Compute partition' (fun e => e <=? 3) [6;4;1;3;7].

(* 2.6. *)

Check andb.

Definition new_forallb {X: Type} (test: X -> bool) (l: list X) : bool :=
  fold andb (map test l) true.

Compute new_forallb (fun e => e <=? 3) [1;2;3].
Compute new_forallb (fun e => e <=? 3) [1;2;4].

(* Exercise 3 *)

(* 3.1. *)

Theorem thm_simpl1: forall a b c:nat,
    a = 0 -> b*(a+b) = b*b.
Proof.
  intros.
  rewrite -> H.
  simpl.
  reflexivity.
Qed.

(* 3.2. *)

Theorem thm_simpl2: forall (a b c d:nat) (f: nat -> nat -> nat),
    a=b -> c=d -> (forall x y, f x y = f y x) -> f a c = f d b.
Proof.
  intros.
  rewrite -> H1.
  rewrite -> H.
  rewrite -> H0.
  reflexivity.
Qed.

(* 3.3. *)

Theorem identity_fn_applied_twice :
  forall (f : bool -> bool),
  (forall (x : bool), f x = x) ->
  forall (b : bool), f (f b) = b.
Proof.
  intros.
  rewrite H.
  rewrite H.
  reflexivity.
Qed.

(* 3.4. *)

Theorem negation_fn_applied_twice :
  forall (f : bool -> bool),
  (forall (x : bool), f x = negb x)->
  forall (b : bool), f (f b) = b.
Proof.
  intros.
  rewrite H. rewrite H.

  rewrite identity_fn_applied_twice.
  -reflexivity.
  - intros.
    rewrite H.


(** * Rel: Properties of Relations *)

Require Export SfLib.

(** This short, optional chapter develops some basic definitions and a
    few theorems about binary relations in Coq.  The key definitions
    are repeated where they are actually used (in the [Smallstep]
    chapter), so readers who are already comfortable with these ideas
    can safely skim or skip this chapter.  However, relations are also
    a good source of exercises for developing facility with Coq's
    basic reasoning facilities, so it may be useful to look at it just
    after the [Logic] chapter. *)

(** A (binary) _relation_ on a set [X] is a family of propositions
    parameterized by two elements of [X] -- i.e., a proposition about
    pairs of elements of [X].  *)

Definition relation (X: Type) := X->X->Prop.

(** Somewhat confusingly, the Coq standard library hijacks the generic
    term "relation" for this specific instance. To maintain
    consistency with the library, we will do the same.  So, henceforth
    the Coq identifier [relation] will always refer to a binary
    relation between some set and itself, while the English word
    "relation" can refer either to the specific Coq concept or the
    more general concept of a relation between any number of possibly
    different sets.  The context of the discussion should always make
    clear which is meant. *)

(** An example relation on [nat] is [le], the less-that-or-equal-to
    relation which we usually write like this [n1 <= n2]. *)

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

(* ######################################################### *)
(** * Basic Properties of Relations *)

(** As anyone knows who has taken an undergraduate discrete math
    course, there is a lot to be said about relations in general --
    ways of classifying relations (are they reflexive, transitive,
    etc.), theorems that can be proved generically about classes of
    relations, constructions that build one relation from another,
    etc.  For example... *)

(** A relation [R] on a set [X] is a _partial function_ if, for every
    [x], there is at most one [y] such that [R x y] -- i.e., if [R x
    y1] and [R x y2] together imply [y1 = y2]. *)

Definition partial_function {X: Type} (R: relation X) :=
  forall x y1 y2 : X, R x y1 -> R x y2 -> y1 = y2.

(** For example, the [next_nat] relation defined earlier is a partial
    function. *)

Print next_nat.
(* ====> Inductive next_nat (n : nat) : nat -> Prop :=
           nn : next_nat n (S n) *)
Check next_nat : relation nat.

Theorem next_nat_partial_function :
   partial_function next_nat.
Proof.
  unfold partial_function.
  intros x y1 y2 H1 H2.
  inversion H1. inversion H2.
  reflexivity.  Qed.

(** However, the [<=] relation on numbers is not a partial function.
    In short: Assume, for a contradiction, that [<=] is a partial
    function.  But then, since [0 <= 0] and [0 <= 1], it follows that
    [0 = 1].  This is nonsense, so our assumption was
    contradictory. *)

Theorem le_not_a_partial_function :
  ~ (partial_function le).
Proof.
  unfold not. unfold partial_function. intros Hc.
  assert (0 = 1) as Nonsense.
   Case "Proof of assertion".
   apply Hc with (x := 0).
     apply le_n.
     apply le_S. apply le_n.
  inversion Nonsense.   Qed.

(** **** Exercise: 2 stars, optional  *)
(** Show that the [total_relation] defined in earlier is not a partial
    function. *)

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

(** **** Exercise: 2 stars, optional  *)
(** Show that the [empty_relation] defined earlier is a partial
    function. *)

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

(** A _reflexive_ relation on a set [X] is one for which every element
    of [X] is related to itself. *)

Definition reflexive {X: Type} (R: relation X) :=
  forall a : X, R a a.

Theorem le_reflexive :
  reflexive le.
Proof.
  unfold reflexive. intros n. apply le_n.  Qed.

(** A relation [R] is _transitive_ if [R a c] holds whenever [R a b]
    and [R b c] do. *)

Definition transitive {X: Type} (R: relation X) :=
  forall a b c : X, (R a b) -> (R b c) -> (R a c).

Theorem le_trans :
  transitive le.
Proof.
  intros n m o Hnm Hmo.
  induction Hmo.
  Case "le_n". apply Hnm.
  Case "le_S". apply le_S. apply IHHmo.  Qed.

Theorem lt_trans:
  transitive lt.
Proof.
  unfold lt. unfold transitive.
  intros n m o Hnm Hmo.
  apply le_S in Hnm.
  apply le_trans with (a := (S n)) (b := (S m)) (c := o).
  apply Hnm.
  apply Hmo. Qed.

(** **** Exercise: 2 stars, optional  *)
(** We can also prove [lt_trans] more laboriously by induction,
    without using le_trans.  Do this.*)

Theorem lt_trans' :
  transitive lt.
Proof.
  (* Prove this by induction on evidence that [m] is less than [o]. *)
  unfold lt. unfold transitive.
  intros n m o Hnm Hmo.
  induction Hmo as [| m' Hm'o].
    (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional  *)
(** Prove the same thing again by induction on [o]. *)

Theorem lt_trans'' :
  transitive lt.
Proof.
  unfold lt. unfold transitive.
  intros n m o Hnm Hmo.
  induction o as [| o'].
  (* FILL IN HERE *) Admitted.
(** [] *)

(** The transitivity of [le], in turn, can be used to prove some facts
    that will be useful later (e.g., for the proof of antisymmetry
    below)... *)

Theorem le_Sn_le : forall n m, S n <= m -> n <= m.
Proof.
  intros n m H. apply le_trans with (S n).
    apply le_S. apply le_n.
    apply H.  Qed.

(** **** Exercise: 1 star, optional  *)
Theorem le_S_n : forall n m,
  (S n <= S m) -> (n <= m).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional (le_Sn_n_inf)  *)
(** Provide an informal proof of the following theorem:

    Theorem: For every [n], [~(S n <= n)]

    A formal proof of this is an optional exercise below, but try
    the informal proof without doing the formal proof first.

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

(** **** Exercise: 1 star, optional  *)
Theorem le_Sn_n : forall n,
  ~ (S n <= n).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** Reflexivity and transitivity are the main concepts we'll need for
    later chapters, but, for a bit of additional practice working with
    relations in Coq, here are a few more common ones.

   A relation [R] is _symmetric_ if [R a b] implies [R b a]. *)

Definition symmetric {X: Type} (R: relation X) :=
  forall a b : X, (R a b) -> (R b a).

(** **** Exercise: 2 stars, optional  *)
Theorem le_not_symmetric :
  ~ (symmetric le).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** A relation [R] is _antisymmetric_ if [R a b] and [R b a] together
    imply [a = b] -- that is, if the only "cycles" in [R] are trivial
    ones. *)

Definition antisymmetric {X: Type} (R: relation X) :=
  forall a b : X, (R a b) -> (R b a) -> a = b.

(** **** Exercise: 2 stars, optional  *)
Theorem le_antisymmetric :
  antisymmetric le.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars, optional  *)
Theorem le_step : forall n m p,
  n < m ->
  m <= S p ->
  n <= p.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** A relation is an _equivalence_ if it's reflexive, symmetric, and
    transitive.  *)

Definition equivalence {X:Type} (R: relation X) :=
  (reflexive R) /\ (symmetric R) /\ (transitive R).

(** A relation is a _partial order_ when it's reflexive,
    _anti_-symmetric, and transitive.  In the Coq standard library
    it's called just "order" for short. *)

Definition order {X:Type} (R: relation X) :=
  (reflexive R) /\ (antisymmetric R) /\ (transitive R).

(** A preorder is almost like a partial order, but doesn't have to be
    antisymmetric. *)

Definition preorder {X:Type} (R: relation X) :=
  (reflexive R) /\ (transitive R).

Theorem le_order :
  order le.
Proof.
  unfold order. split.
    Case "refl". apply le_reflexive.
    split.
      Case "antisym". apply le_antisymmetric.
      Case "transitive.". apply le_trans.  Qed.

(* ########################################################### *)
(** * Reflexive, Transitive Closure *)

(** The _reflexive, transitive closure_ of a relation [R] is the
    smallest relation that contains [R] and that is both reflexive and
    transitive.  Formally, it is defined like this in the Relations
    module of the Coq standard library: *)

Inductive clos_refl_trans {A: Type} (R: relation A) : relation A :=
    | rt_step : forall x y, R x y -> clos_refl_trans R x y
    | rt_refl : forall x, clos_refl_trans R x x
    | rt_trans : forall x y z,
          clos_refl_trans R x y ->
          clos_refl_trans R y z ->
          clos_refl_trans R x z.

(** For example, the reflexive and transitive closure of the
    [next_nat] relation coincides with the [le] relation. *)

Theorem next_nat_closure_is_le : forall n m,
  (n <= m) <-> ((clos_refl_trans next_nat) n m).
Proof.
  intros n m. split.
    Case "->".
      intro H. induction H.
      SCase "le_n". apply rt_refl.
      SCase "le_S".
        apply rt_trans with m. apply IHle. apply rt_step. apply nn.
    Case "<-".
      intro H. induction H.
      SCase "rt_step". inversion H. apply le_S. apply le_n.
      SCase "rt_refl". apply le_n.
      SCase "rt_trans".
        apply le_trans with y.
        apply IHclos_refl_trans1.
        apply IHclos_refl_trans2. Qed.

(** The above definition of reflexive, transitive closure is
    natural -- it says, explicitly, that the reflexive and transitive
    closure of [R] is the least relation that includes [R] and that is
    closed under rules of reflexivity and transitivity.  But it turns
    out that this definition is not very convenient for doing
    proofs -- the "nondeterminism" of the [rt_trans] rule can sometimes
    lead to tricky inductions.

    Here is a more useful definition... *)

Inductive refl_step_closure {X:Type} (R: relation X) : relation X :=
  | rsc_refl  : forall (x : X), refl_step_closure R x x
  | rsc_step : forall (x y z : X),
                    R x y ->
                    refl_step_closure R y z ->
                    refl_step_closure R x z.

(** (Note that, aside from the naming of the constructors, this
    definition is the same as the [multi] step relation used in many
    other chapters.) *)

(** (The following [Tactic Notation] definitions are explained in
    another chapter.  You can ignore them if you haven't read the
    explanation yet.) *)

Tactic Notation "rt_cases" tactic(first) ident(c) :=
  first;
  [ Case_aux c "rt_step" | Case_aux c "rt_refl"
  | Case_aux c "rt_trans" ].

Tactic Notation "rsc_cases" tactic(first) ident(c) :=
  first;
  [ Case_aux c "rsc_refl" | Case_aux c "rsc_step" ].

(** Our new definition of reflexive, transitive closure "bundles"
    the [rt_step] and [rt_trans] rules into the single rule step.
    The left-hand premise of this step is a single use of [R],
    leading to a much simpler induction principle.

    Before we go on, we should check that the two definitions do
    indeed define the same relation...

    First, we prove two lemmas showing that [refl_step_closure] mimics
    the behavior of the two "missing" [clos_refl_trans]
    constructors.  *)

Theorem rsc_R : forall (X:Type) (R:relation X) (x y : X),
       R x y -> refl_step_closure R x y.
Proof.
  intros X R x y H.
  apply rsc_step with y. apply H. apply rsc_refl.   Qed.

(** **** Exercise: 2 stars, optional (rsc_trans)  *)
Theorem rsc_trans :
  forall (X:Type) (R: relation X) (x y z : X),
      refl_step_closure R x y  ->
      refl_step_closure R y z ->
      refl_step_closure R x z.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** Then we use these facts to prove that the two definitions of
    reflexive, transitive closure do indeed define the same
    relation. *)

(** **** Exercise: 3 stars, optional (rtc_rsc_coincide)  *)
Theorem rtc_rsc_coincide :
         forall (X:Type) (R: relation X) (x y : X),
  clos_refl_trans R x y <-> refl_step_closure R x y.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** $Date: 2014-12-31 15:31:47 -0500 (Wed, 31 Dec 2014) $ *)


From LF Require Export Basics.

(*
 * PROOF BY INDUCTION
 *)

(* Let's recap the definition of `plus`... *)

Module plus_recap.
    Fixpoint plus (a b : nat) : nat :=
        match a with
        | O => b
        | S n' => S (plus n' b)
        end.

    Example test_plus'_1 : plus 2 3 = 5.
    Proof. reflexivity. Qed.
End plus_recap.

(* By that definition, the simplification of `plus` depends on the parameter
 * `a`. Let's try to prove the neutrality of `0` when it is passed on the left.
 *)

Theorem add_0_l : forall n : nat, 0 + n = n.
Proof.
    (* This simplification is quite trivial. Recall the definition. When applied
     * on the left, the zero will be simply pattern matched which will, in turn,
     * return the right-hand side argument (in our theorem, `n`).
     *)
    simpl.
    reflexivity.
Qed.

(* However, when the `0` is on the right, things aren't so simple. Not because
 * of the zero on the right-hand side, but because of `n` on the left side.
 *)

Theorem add_0_r_first_try : forall n : nat, n + 0 = n.
Proof.
    (* This simplification does nothing. Well, that's quite fair. How would you
     * simplify the expression `n + 0` by that `plus` definition? Since `n` is
     * arbitrary (i.e. `n` can be any of the natural numbers), it could be
     * `O` or even `S n'`, being `n'` another arbitrary natural number.
     *)
    simpl.
Abort.

(* We can not even use something like `destruct` to solve this problem since,
 * when destructing `n: nat`, we would get `S n'`, being `n'` another arbitrary
 * natural number. If we try to `destruct` again, we'd get `S (S n'')`, which
 * also didn't help much. The `match` definition can't be simplified.
 *
 * You can see some kind of “growing recursion” pattern here. Indeed, natural
 * numbers may be inductively defined!
 *
 * Hence, most proofs on inductively-defined types also need to be implemented
 * using induction, a more powerful reasoning technique.
 *
 * For example, if we want to prove some proposition `P(n)` for all natural
 * numbers, we may proceed with induction as follows:
 *
 *   - Show that `P(O)` holds;
 *   - Show that, for any `n'`, if `P(n')` holds, then so does `P(S n')`;
 *   - Conclude that `P(n)` holds for all `n: nat`.
 *
 * In Coq, we may use the `induction` tactic to break a goal involving some
 * `n: nat` into two sub-goals:
 *
 *   - One to show `P(O)`;
 *   - One to show `P(n') -> P(S n')`.
 *)

Theorem add_0_r : forall n : nat, n + 0 = n.
Proof.
    intros n.
    (* The `induction` tactic will break `n + 0 = n` into two sub-goals:
     *   - `0 + 0 = 0`, the base case (`P(O)`);
     *   - `n' + 0 = n' -> S n' + 0 = S n'`, (`P(n') -> P(S n')`).
     *)
    induction n as [| n' IHn' (* Induction hypothesis for n' *)].
    - reflexivity.
    - simpl. rewrite -> IHn'. reflexivity.
Qed.

(******************************************************************************)

(* Exercises *)

Theorem mul_0_r : forall n : nat,
  n * 0 = 0.
Proof.
    intros n.
    induction n as [| n' IHn'].
    - reflexivity.
    - 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' IHn'].
    - reflexivity.
    - simpl. rewrite -> IHn'. reflexivity.
Qed.

Theorem add_comm : forall n m : nat,
  n + m = m + n.
Proof.
    intros n m.
    induction n as [| n' IHn'].
    - rewrite -> add_0_r. reflexivity.
    - simpl. rewrite -> IHn'. rewrite ->  plus_n_Sm. reflexivity.
Qed.

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

(******************************************************************************)

(* Exercise *)

(* Consider the following function, which doubles its argument: *)

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

(* Use induction to prove this simple fact about double: *)

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

(******************************************************************************)

(* Exercise *)

Check negb_involutive: forall b : bool, negb (negb b) = b.

Theorem even_S : forall n : nat,
  even (S n) = negb (even n).
Proof.
    induction n as [| n' IHn'].
    - simpl. reflexivity.
    - rewrite -> IHn'.
      simpl.
      rewrite -> negb_involutive.
      reflexivity.
Qed.

(******************************************************************************)

(* Exercise *)

(* Briefly explain the difference between the tactics `destruct` and
 * `induction`.
 *)

(* At first glance, both tactics appear similar. Indeed, both break an
 * inductively-defined type over two N sub-goals, one for each constructor.
 *
 * However, `destruct` simply “breaks” a variable over its constructors, doing
 * nothing more than that. Indeed, it may be useful to prove definitions that
 * “go up”.
 *
 * On the other hand, `induction` is more powerful since, besides breaking a
 * variable over its constructors, it also creates assumptions that facilitate
 * proving some property for all possible values of a given inductively-defined
 * type. In general it is useful to prove definitions that “go down”.
 *
 * I should note that I am not still 100% sure about that “up” and “down”
 * metaphors. I might amend or even remove them later.
 *)

Definition manual_grade_for_destruct_induction : option (nat * string) := None.

(******************************************************************************)

(*
 * PROOFS WITHIN PROOFS
 *)

(* Sometimes it is useful to create a “proof within a proof”. For example, it
 * may be desirable to not pollute the top-level environment with a name that
 * won't be reused in another place.
 *
 * In such cases, the `assert` tactic may be used. It essentially asserts a
 * named assertion and introduces two sub-goals. The first one that is used to
 * prove assertion. The second sub-goal being the original goal (i.e. the one
 * before the `assert`, but with the proven assertion on its context).
 *
 * The `assert` tactic can also be used as a technique to better specify where
 * the `replace` tactic should act on.
 *
 * One may also use the `replace` tactic as an alternative to the combination of
 * the `assert` and `rewrite` tactics. The former takes the following form:
 *
 *     replace (a) with (b).
 *
 * It will generate two sub-goals, a) the expression with (a) is in place of (b)
 * and (b) is in place of (a); and b) a goal where `a = b`.
 *)

Theorem plus_rearrange_first_try : forall n m p q : nat,
  (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  (* Here we only want to rewrite `n + m` as `m + n`. However, `replace` is also
   * rewriting `p + q`, which is not desirable here.
   *)
  rewrite add_comm.
Abort.

(* So we may use `assert` to specify where the rewrite should take place. And
 * prove such assertion with the `add_comm` theorem. *)

 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). {
    (* Here we prove the assertion. *)
    rewrite -> add_comm. reflexivity.
  }
  (* Here we prove the original goal with the given assertion in the context.*)
  rewrite -> H.
  reflexivity.
Qed.

(******************************************************************************)

(*
 * MORE EXERCISES
 *)

(******************************************************************************)

(* Exercises *)

Theorem add_shuffle3 : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  intros n m p.
  do 2 (rewrite -> add_assoc).
  assert (H: n + m = m + n). { rewrite -> add_comm. reflexivity. }
  rewrite -> H.
  reflexivity.
Qed.

(* Helper *)
Theorem mul_n_0 : forall n : nat, n * 0 = 0.
Proof.
  induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite -> IHn'. reflexivity.
Qed.

(* Helper *)
Theorem mul_n_Sm : forall n m : nat,
  n * (S m) = n + n * m.
Proof.
  intros n m.
  induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite -> IHn'. rewrite -> add_shuffle3. reflexivity.
Qed.

Theorem mul_comm : forall n m : nat,
  n * m = m * n.
Proof.
  intros n m.
  induction n as [| n' IHn'].
  - rewrite -> mul_n_0. reflexivity.
  - simpl. rewrite -> mul_n_Sm. rewrite -> IHn'. reflexivity.
Qed.

(******************************************************************************)

(* Exercises *)

Check leb: nat -> nat -> bool.

(* Guess: Induction; equal comparison is at the bottom, ref. “go down”. *)
Theorem leb_refl : forall n : nat,
  (n <=? n) = true.
Proof.
  induction n as [| n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite -> IHn'. reflexivity.
Qed.

(* Guess: Simplification; this case is covered in the def. with “depth 1”. *)
Theorem zero_neqb_S : forall n : nat,
  0 =? (S n) = false.
Proof.
  intros n. simpl. reflexivity.
Qed.

(* Guess: Case analysis; since first argument is matched first. *)
Theorem andb_false_r : forall b : bool,
  andb b false = false.
Proof.
  destruct b.
  - reflexivity.
  - reflexivity.
Qed.

(* Guess: Simplification and rewriting; since has assumption. *)
Theorem plus_leb_compat_l : forall n m p : nat,
  n <=? m = true -> (p + n) <=? (p + m) = true.
Proof.
  intros n m p H.
  induction p as [| n' IHn'].
  - simpl. rewrite -> H. reflexivity.
  - simpl. rewrite -> IHn'. reflexivity.
Qed. (* Wrong guess. *)

(* Guess: Simplification; this case is covered in the def. with “depth 1”. *)
Theorem S_neqb_0 : forall n : nat,
  (S n) =? 0 = false.
Proof.
  intros n. simpl. reflexivity.
Qed.

(* Guess: Induction; `n` (on the right) won't match with “depth 1”. *)
Theorem mult_1_l : forall n : nat, 1 * n = n.
Proof.
  intros n. simpl.
  induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite -> IHn'. reflexivity.
Qed.

(* Guess: Case analysis; bool is not really a inductively-defined type. *)
Theorem all3_spec : forall b c : bool,
  orb
    (andb b c)
    (orb (negb b)
         (negb c))
  = true.
Proof.
  intros b c.
  destruct b eqn:Eb.
  - destruct c.
    + reflexivity.
    + reflexivity.
  - destruct c.
    + reflexivity.
    + reflexivity.
Qed.

(* Guess: Induction. *)
Theorem mult_plus_distr_r : forall n m p : nat,
  (n + m) * p = (n * p) + (m * p).
Proof.
  intros n m p.
  induction n as [| n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite -> IHn'. rewrite -> add_assoc. reflexivity.
Qed.

(* Guess: Induction. *)
Theorem mult_assoc : forall n m p : nat,
  n * (m * p) = (n * m) * p.
Proof.
  intros n m p.
  induction n as [| n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite -> IHn'. rewrite -> mult_plus_distr_r. reflexivity.
Qed.

(******************************************************************************)

(* Exercise *)

Theorem eqb_refl : forall n : nat,
  (n =? n) = true.
Proof.
  intros n.
  induction n as [| n' IHn'].
  - simpl. reflexivity.
  - simpl. rewrite -> IHn'. reflexivity.
Qed.

(******************************************************************************)

(* Exercise *)

Theorem add_shuffle3' : forall n m p : nat,
  n + (m + p) = m + (n + p).
Proof.
  intros n m p.
  do 2 (rewrite -> add_assoc).
  replace (n + m) with (m + n).
  - reflexivity.
  - rewrite -> add_comm. reflexivity.
Qed.

(******************************************************************************)

(* Exercise *)

(* Taken from `Basics.v`, repeated for convenience. *)
Inductive bin : Type :=
  | Z
  | B0 (n : bin)
  | B1 (n : bin).

(* Taken from `Basics.v`, repeated for convenience. *)
Fixpoint incr (m : bin) : bin :=
  match m with
  | Z => B1 Z
  | B0 m' => B1 m'
  | B1 m' => B0 (incr m')
  end.

(* Taken from `Basics.v`, repeated for convenience. *)
Fixpoint decr (m : bin) : bin :=
  match m with
  | Z => Z
  | B0 m' => B1 (decr m')
  | B1 Z => Z
  | B1 m' => B0 m'
  end.

(* Taken from `Basics.v`, repeated for convenience. *)
Fixpoint bin_to_nat (m : bin) : nat :=
  match m with
  | Z => 0
  | B0 m' => 2 * (bin_to_nat m')
  | B1 m' => 1 + 2 * (bin_to_nat m')
  end.

(* Theorem bin_to_nat_pres_incr : forall b : bin,
  S (bin_to_nat b) = bin_to_nat (incr b).
Proof.
  intros b.
  induction b as [| b0' IHb0' | b1' IHb1'].
  - simpl. reflexivity.
  - simpl. reflexivity.
  - simpl.
    rewrite <- IHb1'.
    simpl.
    rewrite plus_n_Sm.
    reflexivity. *)