(* Final Exam --- January 8, 2018 *)
Require Import Nat.
Require Import List.

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

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

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

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

Example test1 : createList 5 = [1;2;3;4;5].
Proof.
intros.
simpl.
reflexivity.
Qed.

(* 2. Complete the following definition so that (last n l) holds iff
 n is the last element of the list l. *)

Inductive last (n : nat) : list nat -> Prop :=
  | last_emp: False -> last n []
  | last_single: forall m, m = n -> last n [m]
  | last_nxt: forall m l, last n l -> last n ([m] ++ l).

Example test2 : last 5 [1;2;3;4;5].
Proof. apply last_nxt. apply last_nxt. apply last_nxt. apply last_nxt.
 apply last_single. reflexivity. Qed.

Example test3 : forall n, ~ (last n [ ]).
Proof. unfold not. intros. inversion H. inversion H0. Qed.

(* 3. Define the Fibonacci sequence. The function (fib n) returns the first
n Fibonacci numbers. *)
Fixpoint fib (n: nat) : list nat :=
  match n with
  | O => [0]
  | S n' => match n' with
            | O => (fib n') ++ [1]
            | S m => (fib n') ++ [(hd 0 (rev(fib m)) + hd 0 (rev(fib n')))]
            end
  end.

Print hd.

Example test4 :  fib 15 =
[0; 1; 1; 2; 3; 5; 8; 13; 21; 34; 55; 89; 144; 233; 377; 610].
Proof.
intros.
simpl.
reflexivity.
Qed.

(* 4. Prove that the excluded middle axiom implies the double negation axiom. *)
Theorem double_negation :
  (forall P, P \/ ~P) -> (forall P, ~~P <-> P).
Proof.
intros.
split.
- destruct (H(P)).
  + intros. apply H0.
  + intros.
    unfold not in H1.
    unfold not in H0.
    apply H1 in H0.
    inversion H0.
- destruct (H(P)).
  + intros.
    unfold not.
    intros.
    apply H2 in H0.
    inversion H0.
  + intros.
    apply H0 in H1.
    inversion H1.
Qed.

(* 5. Define the greater than relation and show its transitivity. *)
Inductive gt : nat -> nat -> Prop :=
| equal : forall n, gt n n
| greater : forall n m, (gt n m) -> (gt (S n) m).

Example test5 : gt 3 1.
Proof.
apply greater.
apply greater.
apply equal.
Qed.

Example test6 : ~ (gt 1 2).
Proof.
unfold not.
intros H.
inversion H.
inversion H1.
Qed.

Example gt_transitive : forall m n p,
  gt m n -> gt n p -> gt m p.
Proof.
intros.
induction H.
- apply H0.
- apply greater.
  apply IHgt.
  apply H0.
Qed.

(* 作业原题 *)

(* 6. Consider the following function f. What does this function do? *)
Fixpoint f (l: list nat) : list nat :=
   match l with
   | nil => l
   | h :: t => f t ++ [h]
   end.

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

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

Lemma rev_app_distr: forall l1 l2 : list nat,
  f (l1 ++ l2) = f l2 ++ f l1.
Proof.
intros.
induction l1 as [| h1 l1 IHl1'].
- simpl. rewrite -> app_nil_r. reflexivity.
- simpl. rewrite -> IHl1'. rewrite -> app_assoc. reflexivity.
Qed.

(* Show that function f has the following property. *)
Theorem double_f : forall l : list nat,
  f (f l) = l.
Proof.
intros.
induction l as [| h l' IHl'].
- simpl.
  reflexivity.
- simpl.
  rewrite -> rev_app_distr. rewrite -> IHl'.
  simpl.
  reflexivity.
Qed.

(* 7. Complete the following definition so that (div3 n) returns true
iff n is divisible by 3. *)

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

Example test7: div3 12 = true.
Proof.
intros.
simpl.
reflexivity.
Qed.

Example test8: div3 13 = false.
Proof.
intros.
simpl.
reflexivity.
Qed.

(* 8. Write a function (partition):

      partition : list nat -> list nat * list nat

   which partitions a list into a pair of sublists. The first member of
   the pair is the sublist of the original list containing the
   elements divisible by 3, and the second is the sublist
   containing those that are not divisible by 3.  The order of elements in the
   two sublists should be the same as their order in the original list.

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

Definition partition (l : list nat)
                   : list nat * list nat :=
  (filter div3 l, filter (fun n => if (div3 n) then false else true) l).

Example test9: partition [1;2;3;4;5;6] = ([3;6], [1;2;4;5]).
Proof.
unfold partition.
reflexivity.
Qed.

(* 9. Consider the following type:

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

Define a function taking as argument a natural number n
and a tree t: btree and returning true iff t has (at least)
an occurrence of n.

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

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

Fixpoint occur (n: nat)(t: btree) : bool :=
  match t with
    | leaf => false
    | node m tl tr => match (eqb m n) with
                        | true => true
                        | false => orb (occur n tl)  (occur n tr)
                      end
  end.

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

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

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

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

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

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

(* Prove the following theorem that states the correctness of the
optimization with respect to the evaluation of arithmetic expressions. *)
Theorem plus_comm : forall n m : nat,
  n + m = m + n.
Proof.
  intros n m. induction n as [|n' IHn'].
  - simpl. rewrite <- plus_n_O. reflexivity.
  - simpl. destruct m as [|m'].
  + rewrite -> IHn'. reflexivity.
  + rewrite -> IHn'. rewrite plus_n_Sm. reflexivity. Qed.

(* 作业原题 *)
Theorem optimize_plus0_sound: forall a,
  aeval (optimize_plus0 a) = aeval a.
Proof.
  intros.
  induction a ;try (simpl;reflexivity).
  destruct a2;
  try (simpl; simpl in IHe1; rewrite IHe1; rewrite IHe2; reflexivity).
  destruct n.
  simpl; rewrite <- IHa1; rewrite plus_comm;reflexivity.
  simpl. rewrite <- IHa1. reflexivity. simpl. simpl in IHa2.  rewrite IHa2. rewrite <- IHa1. reflexivity.
  simpl. simpl in IHa2. rewrite IHa2. rewrite <- IHa1. reflexivity.
  simpl. simpl in IHa2. rewrite IHa2. rewrite <- IHa1. reflexivity.
  simpl. simpl in IHa2. rewrite IHa2. rewrite <- IHa1. reflexivity.
  simpl. simpl in IHa2. rewrite IHa2. rewrite <- IHa1. reflexivity.
Qed.


Require Import ssreflect ssrnat.

(**
# 第7回 ソースファイルの分割とコンパイル/SectionとModule (2014/05/18)

http://qnighy.github.io/coqex2014/ex7.html

## 課題33 (種別:B / 締め切り : 2014/06/01)

2で定義したlist boolのモジュールと、3で定義した冪乗のモジュールを合成して、新たなモジュールを
作成せよ。

ヒント

モジュールへの機能の追加の練習です。標準ライブラリのCoq.Structuresの記述を参考にするとよいでしょう。
*)

(**
### 1.

課題32の半群モジュール型を参考にして、モノイドを表すモジュール型 Monoid を定義せよ。
 *)
Require Import Arith List.

Module Type Monoid.
  Parameter G : Type.
  Parameter Id : G.                         (* 単位元 *)
  Parameter mult : G -> G -> G.
  Axiom mult_assoc :                        (* 結合則 *)
    forall x y z : G, mult x (mult y z) = mult (mult x y) z.
  Axiom left_id :                           (* 左単位元 *)
    forall x : G, mult Id x = x.
  Axiom right_id :                          (* 右単位元 *)
    forall x : G, mult x Id = x.
End Monoid.

(**
### 2.

list boolに自然なモノイドの構造を入れ、Monoid型をもつモジュールとして定義せよ。
*)

Check list bool.
Check @nil bool.
Check @app bool.

Module BoolList_Monoid <: Monoid.
  Definition G := list bool.
  Definition Id := @nil bool.               (* [] *)
  Definition mult := @app bool.             (* append. *)
  Theorem mult_assoc :
    forall x y z : G, mult x (mult y z) = mult (mult x y) z.
  Proof.
    by apply: app_assoc.
  Qed.
  Theorem left_id : forall x : G, mult Id x = x.
  Proof.
    by [].
  Qed.
  Theorem right_id : forall x : G, mult x Id = x.
  Proof.
    elim.
      by [].
    by move=> a l /= ->.
  Qed.
End BoolList_Monoid.

(*
### 3.

モノイドの元の冪乗(指数は自然数)を定義し、指数法則を証明せよ。これを定義する際、定義済みの
Monoidモジュールを直接変更するのではなく、MonoidモジュールMを引数にとる新たなモジュールを定
義すること。
*)

Module Type Exponent (M : Monoid).
  Parameter exp : M.G -> nat -> M.G.
  Axiom exp_law_add : forall (x : M.G) (n m : nat),
    M.mult (exp x n) (exp x m) = exp x (n + m).
  Axiom exp_law_mul : forall (x : M.G) (n m : nat),
    exp (exp x n) m = exp x (n * m).
End Exponent.

Fixpoint app_exp (x : list bool) (n : nat) :=
  match n with
    | 0 => nil
    | n'.+1 => app x (app_exp x n')
  end.
Eval compute in app_exp (true :: nil) 0.    (* [] *)
Eval compute in app_exp (true :: false :: nil) 6.
Eval compute in app_exp (app_exp (true :: false :: nil) 2) 3.
Eval compute in app_exp (app_exp (true :: false :: nil) 3) 2.

Lemma app_add_exp_law :
  forall (x : list bool) (n m : nat),
    (app_exp x n) ++ (app_exp x m) = app_exp x (n + m).
Proof.
  move=> x n m.
  elim n.
    by rewrite /= add0n.
  move=> n' IHn /=.
  rewrite -app_assoc.
  by rewrite IHn.
Qed.

Lemma app_exp_null :
  forall (n : nat), app_exp nil n = nil.
Proof.
  elim.
    by [].
  move=> n IHn.
  by rewrite /= IHn.
Qed.

Lemma app_mul_exp_law :
  forall (x : list bool) (n m : nat),
    app_exp (app_exp x n) m = app_exp x (n * m).
Proof.
  move=> x n m.
  elim: n.
    by rewrite /= app_exp_null.

  elim: m.
    move=> n.
    by rewrite /= !muln0 /=.
  move=> m IHm n.
  admit.                                    (* XXXX *)
Qed.

Module Exponent_exp <: Exponent BoolList_Monoid.
  Definition exp := app_exp.
  Theorem exp_law_add : forall (x : BoolList_Monoid.G) (n m : nat),
    BoolList_Monoid.mult (exp x n) (exp x m) = exp x (n + m).
  Proof.
    apply: app_add_exp_law.
  Qed.
  Theorem exp_law_mul : forall (x : BoolList_Monoid.G) (n m : nat),
    exp (exp x n) m = exp x (n * m).
  Proof.
    apply: app_mul_exp_law.
  Qed.
End Exponent_exp.

(* END *)


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

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

Eval simpl in (next_weekday friday).
Eval simpl in (next_weekday (next_weekday saturday)).
Compute next_weekday friday.

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

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

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

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

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

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

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

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

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

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

Check (negb true).
Check negb.

Definition xorb (b1:bool) (b2:bool) : bool :=
  andb (negb (andb b1 b2)) (orb b1 b2).
Example test_xor1: (xorb true true) = false.
Proof. simpl. reflexivity. Qed.
Example test_xor2: (xorb false true) = true.
Proof. simpl. reflexivity. Qed.
Example test_xor3: (xorb true false) = true.
Proof. simpl. reflexivity. Qed.
Example test_xor4: (xorb false false) = false.
Proof. simpl. reflexivity. Qed.

Module Playground1.

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

Definition mypred (n : mynat) : mynat :=
  match n with
  | O => O
  | S n' => n'
  end.

Inductive mynat' : Type :=
  | stop
  | tick (foo : mynat').

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

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

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

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

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

Fixpoint plus (n:mynat) (m:mynat) : mynat :=
  match n with
  | O => m
  | S n' => S (plus n' m)
  end.
Fixpoint mult (n m:mynat) : mynat :=
  match n with
  | O => O
  | S n' => plus m (mult n' m)
  end.
Fixpoint minus (n m:mynat) : mynat :=
  match n, m with
  | O   , _ => O
  | S _ , O => n
  | S n', S m' => minus n' m'
  end.
Fixpoint power (base index:mynat):mynat:=
  match index with
  | O => S O
  | S n' => mult base (power base n')
  end.

Eval simpl in plus (S (S (S O))) (S (S O)).
Eval simpl in mult (S (S (S O))) (S (S O)).
Eval simpl in minus (S (S (S O))) (S (S O)).
Eval simpl in power (S (S (S O))) (S (S O)).

Fixpoint factorial (n:mynat) : mynat :=
  match n with
  | O => S O
  | S n' => mult n (factorial n')
  end.
Example test_factorial1: (factorial (S (S (S O)))) = S (S (S (S (S (S O))))).
Proof. simpl. reflexivity. Qed.
Example test_factorial2: (factorial (S (S (S (S (S O))))))
= (mult (mult (S (S O)) (S (S (S (S (S O))))))  (mult (S (S (S O))) (S (S (S (S O)))))).
Proof. simpl. reflexivity. Qed.
Notation "x + y" := (plus x y) (at level 50, left associativity) : mynat_scope.
Notation "x - y" := (minus x y) (at level 50, left associativity) : mynat_scope.
Notation "x * y" := (mult x y) (at level 40, left associativity) : mynat_scope.

Fixpoint beq_nat (n m : mynat) : bool :=
  match n with
  | O => match m with
         | O => true
         | S m' => false
         end
  | S n' => match m with
            | O => false
            | S m' => beq_nat n' m'
            end
  end.
Fixpoint ble_nat (n m : mynat) : bool :=
  match n with
  | O => true
  | S n' =>
      match m with
      | O => false
      | S m' => ble_nat n' m'
      end
  end.
Definition blt_nat (n m : mynat) : bool :=
 andb (ble_nat n m) (negb (beq_nat n m)).

Example test_blt_nat1: (blt_nat (S (S O)) (S (S O))) = false.
Proof. simpl. reflexivity. Qed.
Example test_blt_nat2: (blt_nat (S (S O)) (S (S (S (S O))))) = true.
Proof. simpl. reflexivity. Qed.
Example test_blt_nat3: (blt_nat (S (S (S (S O)))) (S (S O))) = false.
Proof. simpl. reflexivity. Qed.
End Playground1.

Definition minustwo_ex (n : Playground1.mynat) : Playground1.mynat :=
  match n with
  | Playground1.O => Playground1.O
  | Playground1.S Playground1.O => Playground1.O
  | Playground1.S (Playground1.S (n')) => n'
  end.

Check (S (S (S (S 0)))).
(*Eval simpl in (minustwo 4).*)
Check S.
Check Playground1.S.

Theorem plus_0_n : forall n:nat, 0+n=n.
Proof. intros n. simpl. reflexivity. Qed.
Theorem plus_id_example : forall n m:nat,
  n=m->n+n=m+m.
Proof. intros n m. intros H. rewrite -> H. reflexivity. Qed.
Theorem plus_id_exercise : forall n m o:nat,
  n=m->m=o->n+m=m+o.
Proof. intros n m o. intros H. intros I. rewrite <- I. rewrite<-H. reflexivity. Qed.
Theorem mult_0_plus : forall n m:nat,
  (0+n)*m=n*m.
Proof. intros n m. rewrite -> plus_0_n. reflexivity. Qed.
Theorem mult_1_plus : forall n m:nat,(1+n)*m=m+(n*m).
Proof. intros n m. reflexivity. Qed.

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

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

Theorem plus_0_r : forall n:nat, n+0=n.
Proof. intros n. induction n. reflexivity. simpl. rewrite IHn. reflexivity. Qed.
Theorem minus_diag : forall n, minus n n = 0.
Proof. intros n. induction n. reflexivity. simpl. rewrite IHn. reflexivity. Qed.
Theorem mult_0_r : forall n:nat, n*0=0.
Proof. intros n. induction n. 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. rewrite plus_0_n. reflexivity. simpl. rewrite IHn. reflexivity. Qed.
Theorem plus_comm : forall n m:nat, n+m=m+n.
Proof. intros n m. induction n. simpl. rewrite plus_0_r. reflexivity. simpl. rewrite IHn. rewrite plus_n_Sm. reflexivity. Qed.
Fixpoint double (n:nat) :=
  match n with
  | O => O
  | S n' => S (S (double n'))
  end.
Lemma double_plus : forall n:nat, double n=n+n.
Proof. intros n. induction n. reflexivity. simpl. rewrite IHn. rewrite plus_n_Sm. reflexivity. Qed.

Theorem plus_assoc : forall n m p:nat, n+(m+p)=(n+m)+p.
Proof. intros n m p. induction n. reflexivity. simpl. rewrite -> IHn. reflexivity. Qed.

Require String. Open Scope string_scope.

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

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

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

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

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

Theorem plus_rearrange : forall n m p q:nat, (n+m)+(p+q)=(m+n)+(p+q).
Proof. intros n m p q. assert (H: n+m=m+n). rewrite plus_comm. reflexivity.
rewrite H. reflexivity. Qed.
Theorem plus_swap : forall n m p:nat, n+(m+p)=m+(n+p).
Proof. intros n m p. rewrite <- plus_comm. assert (H: p+n=n+p). rewrite plus_comm. reflexivity.
rewrite <- H. assert(H2: m+(p+n)=(m+p)+n). rewrite plus_assoc. reflexivity. rewrite H2. reflexivity. Qed.
Theorem S_plus : forall n:nat, S n = n+1.
Proof. intros n. induction n. reflexivity. assert (H1:S(S n)=S(n+1)). rewrite IHn. reflexivity.
rewrite H1. simpl. reflexivity. Qed.
Theorem mult_1 : forall n:nat, n*1=n.
Proof. induction n. reflexivity. simpl. rewrite IHn. reflexivity. Qed.
Theorem mult_suc_r : forall n m:nat, n*(S m)=n+n*m.
Proof. induction n. reflexivity. simpl. intros m. rewrite IHn.
rewrite plus_assoc. assert (H1:m+n=n+m). rewrite plus_comm. reflexivity.
rewrite H1. rewrite plus_assoc. reflexivity. Qed.
Theorem mult_comm : forall m n:nat, m*n=n*m.
Proof. induction m. intros n. rewrite mult_0_r. reflexivity.
simpl. intros n. rewrite IHm. simpl. rewrite mult_suc_r. reflexivity. Qed.

Fixpoint evenb (n:nat) : bool :=
  match n with
  | O => true
  | S O => false
  | S (S n') => evenb n'
  end.
Theorem evenb_n__oddb_Sn : forall n:nat, evenb n=negb(evenb (S n)).
Proof. induction n. reflexivity. simpl. rewrite IHn. rewrite negb_involutive.
destruct n. reflexivity. reflexivity. Qed.

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

Theorem ble_nat_refl : forall n:nat,
  true = ble_nat n n.
Proof. induction n. reflexivity. simpl. rewrite IHn. reflexivity. Qed.

Theorem zero_nbeq_S : forall n:nat,
  beq_nat 0 (S n) = false.
Proof. reflexivity. Qed.

Theorem andb_false_r : forall b : bool,
  andb b false = false.
Proof. destruct b. reflexivity. reflexivity. Qed.

Theorem plus_ble_compat_l : forall n m p : nat,
  ble_nat n m = true -> ble_nat (p + n) (p + m) = true.
Proof. induction p. simpl. intros H. rewrite H. reflexivity.
intros H2. simpl. rewrite IHp. reflexivity. rewrite H2. reflexivity. Qed.

Theorem S_nbeq_0 : forall n:nat,
  beq_nat (S n) 0 = false.
Proof. reflexivity. Qed.

Theorem mult_1_l : forall n:nat, 1 * n = n.
Proof. simpl. induction n. reflexivity. simpl. rewrite IHn. reflexivity. Qed.

Theorem all3_spec : forall b c : bool,
    orb
      (andb b c)
      (orb (negb b)
               (negb c))
  = true.
Proof. destruct b. destruct c. reflexivity. reflexivity. destruct c. reflexivity. reflexivity. Qed.

Theorem mult_plus_distr_r : forall n m p : nat,
  (n + m) * p = (n * p) + (m * p).
Proof. induction p. rewrite mult_0_r. rewrite mult_0_r. rewrite mult_0_r. reflexivity.
rewrite mult_suc_r. rewrite mult_suc_r. rewrite mult_suc_r. rewrite IHp.
rewrite plus_assoc. rewrite plus_assoc.
assert (H0:m+n*p=n*p+m). rewrite plus_comm. reflexivity.
assert (H1:n+m+n*p=n+n*p+m). rewrite <- plus_assoc.
rewrite <- plus_assoc. rewrite H0. reflexivity.
rewrite H1. reflexivity. Qed.

Theorem mult_assoc : forall n m p : nat,
  n * (m * p) = (n * m) * p.
Proof. induction n. reflexivity. simpl. intros m p. rewrite IHn.
rewrite mult_plus_distr_r. reflexivity. Qed.

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


Require Export Arith.
Require Export ArithRing.

Fixpoint div2 (n:nat):nat:=
  match n with 0 => 0 | 1 => 0 | S (S p) => S (div2 p) end.

Fixpoint rem2 (n:nat):nat:=
  match n with 0 => 0 | 1 => 1 | S (S p) => rem2 p end.

Theorem div2_ind :
  forall P: nat -> Prop,
    P 0 -> P 1 ->
    (forall n, P n -> P (S (S n))) ->
    forall n, P n.
Proof.
 intros P H0 H1 Hstep n.
 assert (P n/\P(S n)).
 elim n; intuition.
 intuition.
Qed.

Fixpoint fib (n:nat) : nat :=
  match n with
    0 => 1
  | 1 => 1
  | S ((S p) as q) => fib p + fib q
  end.

Fixpoint fib2 (n:nat) : nat*nat :=
  match n with
    0 => (1, 1)
  | S p =>
    let (v1, v2) := fib2 p in (v2, v1 + v2)
  end.

Theorem fib_ind :
  forall P : nat -> Prop,
    P 0 -> P 1 ->
    (forall n, P n -> P (S n) -> P (S (S n)))->
    forall n, P n.
Proof.
 intros P H0 H1 Hstep n.
 assert (P n/\P(S n)).
 elim n; intuition.
 intuition.
Qed.

Theorem div2_rem2_eq : forall n, 2 * div2 n + rem2 n = n.
Proof.
 intros n; elim n using div2_ind; try (simpl; auto with arith; fail).
 intros p IHp; pattern p at 3; rewrite <- IHp.
 simpl;ring.
Qed.

Theorem fib_fib2_equiv : forall n, fib n = (fst (fib2 n)).
Proof.
 intros n; elim n using fib_ind; try(simpl;auto with arith;fail).
 intros p IHp IHSp.
 replace (fib (S (S p))) with (fib p + fib (S p)).
 rewrite IHp; rewrite IHSp.
 simpl.
 case (fib2 p); auto.
 auto.
Qed.


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

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

Compute (next_weekday friday).
Compute (next_weekday (next_weekday saturday)).

Example test_next_weekday:
  (next_weekday (next_weekday saturday)) = tuesday.

Proof. simpl. reflexivity. Qed.

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

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

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

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

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

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

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

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

Compute (negb true).
Compute (andb true false).

Example test_orbff: (orb false false) = false.
Proof. simpl. reflexivity. Qed.
Example test_orbft: (orb false true) = true.
Proof. simpl. reflexivity. Qed.
Example test_orbtf: (orb true false) = true.
Proof. simpl. reflexivity. Qed.
Example test_orbtt: (orb true true) = true.
Proof. simpl. reflexivity. Qed.

Infix "&&" := andb.
Infix "||" := orb.

Example infixor: true || true || false = true.
Proof. simpl. reflexivity. Qed.
Example infixand: true && true && false = false.
Proof. simpl. reflexivity. Qed.

Check true.
Check (negb true).
Check negb.
Check andb.

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

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

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

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

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

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

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

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

Example mul33: (mul (S O) (S (S O))) = (S (S O)).
Proof. simpl. reflexivity. Qed.
Example minus73: (minus 7 3) = 4.
Proof. simpl. reflexivity. Qed.
Compute (plus 2 3).
Compute (oddb 11).
Compute (evenb 11).
Compute (minustwo (S (S (S O)))).
Compute (minustwo 9).

Fixpoint exp (a b : nat) : nat :=
  match b with
  | O => S O
  | S p' => mul (exp a p') a
  end.

Compute (exp 2 4).

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

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

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

Check ((0 + 1) + 1).

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

Example beq_nat11: (beq_nat 1 1) = true.
Proof. simpl. reflexivity. Qed.
Example beq_nat10099: (beq_nat 100 99) = false.
Proof. simpl. reflexivity. Qed.

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

Example leb12: (leb 1 2) = true.
Proof. simpl. reflexivity. Qed.
Example leb21: (leb 2 1) = false.
Proof. simpl. reflexivity. Qed.
Example test_leb1: (leb 2 2) = true.
Proof. simpl. reflexivity. Qed.
Example test_leb2: (leb 2 4) = true.
Proof. simpl. reflexivity. Qed.
Example test_leb3: (leb 4 2) = false.
Proof. simpl. reflexivity. Qed.

Definition blt_nat (n m : nat) : bool :=
  (leb n m) && (negb (beq_nat n m)).

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

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

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

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

Theorem plus_n_O : forall n, n = n + O.
Proof.
  intros n. simpl. Abort.

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

Theorem plus_id_excercise : forall n m : nat,
  n = m -> m = O -> n + m = m + O.
Proof.
  intros n m.
  intros H.
  intros P.
  rewrite -> H.
  rewrite -> P.
  reflexivity.
Qed.

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

Theorem mult_S_1 : forall n m : nat,
  m = S n ->
  m * (1 + n) = m * m.
Proof.
  intros n m.
  intros H.
  rewrite -> plus_1_1.
  rewrite -> H.
  reflexivity.
Qed.

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

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

Theorem andb_commutative : forall b c,
  andb b c = andb c b.
Proof.
  intros b c. destruct b.
  - destruct c.
    + reflexivity.
    + reflexivity.
  - destruct c.
    + reflexivity.
    + reflexivity.
Qed.

Theorem andb_exchange : forall a b c,
  andb (andb a b) c = andb (andb a c) b .
Proof.
  intros a b c. destruct a.
  - destruct b.
    { destruct c.
      - reflexivity.
      - reflexivity. }
    { destruct c.
      - reflexivity.
      - reflexivity. }
  - destruct b.
    { destruct c.
      - reflexivity.
      - reflexivity. }
    { destruct c.
      - reflexivity.
      - reflexivity. }
Qed.

Theorem andb_communtative'' : forall a b,
  a && b = b && a.
Proof.
  intros [] [].
  - reflexivity.
  - reflexivity.
  - reflexivity.
  - reflexivity.
Qed.

Theorem andb_true_elim1 : forall b c : bool,
  andb b c = true -> b = true.
Proof.
  intros [] [].
  - reflexivity.
  - simpl. intros H.
    reflexivity.
  - simpl. intros H. rewrite -> H. reflexivity.
  - simpl. intros H. rewrite -> H. reflexivity.
Qed.

Theorem andb_true_elim2 : forall b c : bool,
  andb b c = true -> c = true.
Proof.
  intros [] [].
  - reflexivity.
  - simpl. intros H.
    rewrite -> H. reflexivity.
  - simpl. reflexivity.
  - simpl. intros H. rewrite -> H. reflexivity.
Qed.

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

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

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 f H b. rewrite -> H. rewrite -> H.
  rewrite -> negb_involutive. reflexivity.
Qed.

Theorem andb_eq_orb :
  forall (b c : bool),
  (andb b c = orb b c) ->
  b = c.
Proof.
  intros [] [].
  - reflexivity.
  - simpl. intros H. rewrite -> H. reflexivity.
  - simpl. intros H. rewrite -> H. reflexivity.
  - reflexivity.
Qed.

Inductive bin : Type :=
  | O : bin
  | T2 : bin -> bin
  | P1 : bin -> bin.

Fixpoint incr (b : bin) : bin :=
  match b with
  | O => P1 (T2 O)
  | T2 n' =>
    match n' with
    | O => P1 (T2 O)
    | P1 m => P1 (T2 (incr m))
    | T2 m => P1 (T2 n')
    end
  | P1 n' =>
    match n' with
    | O => T2 (P1 (T2 O))
    | P1 m => P1 (incr n')
    | T2 m => T2 (incr m)
    end
  end.

(*
1 + 2*(1 + m) = 1 + 2*(incr m)
1 + 2*2*m
1 + 1 + 1 + m = 1 + incr(m + 1)
1 + 1 + 2*m = 2*(1 + m)
*)

Fixpoint bin_to_nat (b : bin) : nat :=
  match b with
  | O => 0
  | P1 n' => S (bin_to_nat n')
  | T2 n' => mult 2 (bin_to_nat n')
  end.

Compute (incr (incr (incr O))).
Compute (bin_to_nat (incr (incr (incr O)))).

Theorem bin_P1_eq_P1_bin : forall (b : bin),
  1 + (bin_to_nat b) = (bin_to_nat (P1 b)).
Proof.
  intros b. simpl. reflexivity.
Qed.

Theorem bin_T2_eq_P1_bin : forall (b : bin),
  2 * (bin_to_nat b) = (bin_to_nat (T2 b)).
Proof.
  intros b. simpl. reflexivity.
Qed.

Example test_bin_incr1 : (incr (T2 (P1 (T2 O)))) = P1 (T2 (P1 (T2 O))).
Proof. reflexivity. Qed.
Example test_bin_incr2 : (incr (P1 (T2 (P1 (T2 O)))) = (T2 (T2 (P1 (T2 O))))).
Proof. reflexivity. Qed.
Example test_bin_incr3 : (incr (incr (incr (incr (incr (incr (incr (incr O)))))))) = T2 (T2 (T2 (P1 (T2 O)))).
Proof. reflexivity. Qed.
Example test_bin_incr4 :  (incr (incr (incr (incr (incr (incr (incr (T2 (T2 (T2 (P1 (T2 O)))))))))))) = P1 (T2 (P1 (T2 (P1 (T2 (P1 (T2 O))))))).
Proof. reflexivity. Qed.
Example test_bin_incr5 : (incr (incr (T2 (T2 (T2 (P1 (T2 O))))))) = T2 (P1 (T2 (T2 (P1 (T2 O))))).
Proof. reflexivity. Qed.

Example test_bin_to_nat1 : (bin_to_nat (incr (P1 (T2 (P1 (T2 O)))))) = (bin_to_nat (T2 (T2 (P1 (T2 O))))).
Proof. reflexivity. Qed.
Example test_bin_to_nat2 : (bin_to_nat (incr (incr (P1 (T2 (P1 (T2 O))))))) = (bin_to_nat (T2 (T2 (P1 (T2 O))))) + 1.
Proof. reflexivity. Qed.
Example test_bin_to_nat3 : (bin_to_nat (T2 (T2 (T2 (P1 (T2 O)))))) = (bin_to_nat (T2 (T2 (P1 (T2 O))))) + (bin_to_nat (T2 (T2 (P1 (T2 O))))).
Proof. reflexivity. Qed.
Example test_bin_to_nat4 : (bin_to_nat (T2 (T2 (T2 (T2 (T2 (T2 (T2 (T2 (T2 (T2 (P1 (T2 O))))))))))))) = 1024.
Proof. reflexivity. Qed.
Example test_bin_to_nat5 : (bin_to_nat (incr (incr (incr O)))) + (bin_to_nat (incr (incr O))) = (bin_to_nat (P1 (T2 (T2 (P1 (T2 O)))))).
Proof. reflexivity. Qed.
Example test_bin_to_nat6 : (bin_to_nat  (T2 O)) = 0.
Proof. reflexivity. Qed.

Definition foo (t : False) : nat := 3.

Check foo.
Require Import Coq.omega.Omega.
Definition bar (l : list nat) (H : length l < 5) : { l : list nat | length l < 6}.
refine (exist _ (cons 0 l) _).
simpl. omega. Defined.

Extraction bar.
Extraction foo.
(* create a subset type and take a proof argument and take in a list and a proof that the list has less than 5 elements *(
(* incorrect inductive elimination, proofs can be eliminated only to build proofs *)
Definition bar (t : ) : nat :=
  match t with
  | conj I _ => 3
  end.

Check bar.
Extraction bar.


Require Import List.
Import ListNotations.

(** * Preliminaries *)

(** See the definition of lists *)
Print list.

(** The raw constructors and the syntactic sugar *)
Check (cons 1 (cons 2 (cons 3 nil)) = [13;21]).

(** Note that [Check] merely checks the type, not that the thing holds! *)

Check forall A (h:A) (t:list A), h::nil = cons h t.

Section Lists_of_A.
(* We use a section and a [Variable] so that we do not have to worry about [A]
   at each definition / lemma *)
Variable A: Type.

(** ** Definition by pattern matching on lists *)

Definition tail (l : list A) : list A :=
  match l with
  | [] => []   (* functions are total in Coq ! *)
  | h::t => t
  end.

(** Proof by computation *)
Lemma tail_1 : forall a b c, tail [a;b;c] = [b;c].
  intros.
  simpl.
  trivial.
Qed.

(** ** Definition by recursion (and pattern matching) *)

(** The following definition always terminates:
    the recursive call to length is allowed for subterms of [l] only (extracted by [match]) ! *)

Fixpoint length (l : list A) : nat :=
  match l with
  | [] => 0
  | _ :: l' => S (length l')
  end.

(** Proof by case analysis *)
Lemma len_tail : forall l, l = [] \/ 1 + length (tail l) = length l.
Proof.
  (* for inductively defined objects,
     we get a case for each constructor *)
  destruct l.
  + left.
    trivial.
  + right.
    simpl tail.
    simpl length.
    (* or equivalently: simpl. *)
    trivial.
Qed.

(** Another definition, by induction on the first argument *)
Fixpoint app (l m : list A): list A :=
  match l with
  | [] => m
  | a :: l1 => a :: app l1 m
  end.

(** Proof by induction on lists *)
Lemma app_length : forall l1 l2 : list A,
  length l1 + length l2 = length (app l1 l2).
Proof.
  (* similar to (destruct l1),
     but you additionally get an induction hypothesis *)
  induction l1.
  + simpl.
    reflexivity.
  + simpl.
    intro.
    rewrite -> IHl1.  (* [->] can be skipped; try also rewrite <- *)
    reflexivity. (* trivial is also good enough *)
Qed.

(** This lemma is very easy *)
Lemma app_nil_l : forall l, app nil l = l.
Proof.
  simpl.
  trivial.
Qed.

(** What about this one? :) *)
Lemma app_nil_r : forall l, app l nil = l.
Proof.
  simpl. (* no effect :) *)
  (* exercise *)
Admitted.

(** another proof by induction *)
Lemma app_assoc : forall l1 l2 l3 : list A,
  app l1 (app l2 l3) = app (app l1 l2) l3.
Proof.
  (* exercise *)
Admitted.

(** recursive predicate on lists *)
Fixpoint In (a:A) (l:list A) : Prop :=
  match l with
  | [] => False
  | h::t => a = h \/ In a t
  end.
(* Note that we have defined a predicate [In : A -> list A -> Prop] by recursion on lists *)

(* simple proof *)
Lemma In_sing : forall a:A, In a [a].
Proof.
  intros.
  simpl.
  left.
  trivial.
Qed.

(** use the predicate by computing it *)
Lemma In_not_empty : forall (a:A) l, In a l -> l <> [].
Proof.
  intros.
  destruct l.
  + simpl in H.
    tauto.
  + congruence. (* handle simple equality or disequality *)
Qed.

Lemma not_In_empty : forall a:A, ~ In a [].
Proof.
  intros.
  intro H.
  simpl in H.
  tauto.
Restart. (* another possible proof *)
  intros.
  intro H.
  apply In_not_empty in H as H2.  (* use a lemma for forward reasonning *)
  apply In_not_empty in H. (* or simply if we don't care for the current state of H *)
  congruence.  (* handle clearly wrong disequality in hypotheses *)
Qed.

Lemma in_app_or : forall a l1 l2, In a (app l1 l2) -> In a l1 \/ In a l2.
Proof.
  (* exercise *)
  intros a l1 l2.
  induction l1; intros; simpl.
  + right.
    simpl in H.
    assumption.
  + simpl in H.
    destruct H as [B | C].
    - intuition.
    - apply IHl1 in C.
      intuition.
Admitted.

(** ** Inductive predicate *)
Inductive contains (a:A) : list A -> Prop :=
| C_here : forall l, contains a (a::l)
| C_there : forall l b, contains a l -> contains a (b::l).

(* Corresponds to definitions by rules with \u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013

rule (C_here) \u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013
               contains a (a::l)

                   contains a l
rule (C_there) \u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013\u2013
                 contains a (b::l)

or to a Prolog definition:

contains(A, [[A|L]]).
contains(A, [[B|L]]] :- contains(A,L).

*)

(** proving an inductive predicate *)
Lemma cont_abc : forall a b c, contains b [a;b;c].
Proof.
  intros.
  apply C_there.
  apply C_here.
Restart. (* or simpler *)
  intros.
  constructor 2.
  constructor 1.
Restart. (* even simpler *)
  intros.
  constructor. (* any constructor that can be used *)
  constructor.
Restart. (* simplest *)
  repeat constructor.
Qed.

(** using an inductive predicate *)
Lemma cont_nempty : forall a l, contains a l -> l <> [].
Proof.
  intros.
  destruct H.  (* basic tactic - works well if [contains] is applied to variables *)
  + congruence.
  + congruence.
Qed.

Lemma not_cont_empty : forall a, ~ contains a [].
Proof.
  intros.
  intro H.
  destruct H.  (* if [contains] is applied to terms other than variables,
                  we can lose information *)
  (* we are stuck *)
  Undo.
  inversion H. (* this works - [contains a []] is impossible
                  and it is automatically discarded;
                  both [C_here] and [C_there] need a non-empty list *)
  (* do [Show Proof.] to see that some case analysis is really going on underneath *)
Qed.

(** [inversion H] - for a hypothesis [H : C t1 t2] :
   how could it happen that [C t1 t2] holds
*)

(* you may also try [inversion_clear] *)
Lemma cont_double : forall a b c, contains a [b;c] -> a=b \/ a=c.
Proof.
  (* exercise *)
Admitted.

(** three lemmas establishing the correspondence between contains and In *)
Lemma cont_In : forall a l, contains a l -> In a l.
Proof.
  (* exercise *)
Admitted.

Lemma In_cont : forall a l, In a l -> contains a l.
Proof.
  (* exercise *)
Admitted.

(* given the previous two lemmas, this one requires no more than three tactics *)
Lemma In_iff_cont : forall a l, In a l <-> contains a l.
Proof.
  (* exercise *)
Admitted.

(** ** Another inductive predicate *)

Inductive prefix : list A -> list A -> Prop :=
| P_nil : forall l2, prefix [] l2
| P_cons : forall a l1 l2, prefix l1 l2 -> prefix (a::l1) (a::l2).

Lemma pref_contains: forall a l, prefix [a] l -> contains a l.
Proof.
  intros.
  inversion H.
  apply C_here.
Qed.

(** a couple of simple lemmas *)
Lemma pref_reflexive: forall l, prefix l l.
Proof.
 (* exercise *)
Admitted.

(* Hint: there are two lists to do induction on,
   but only one will work. *)
Lemma pref_app : forall l1 l2, prefix l1 (l1++l2).
Proof.
  (* exercise *)
Admitted.

Lemma pref_app2 : forall l1 l2 l3,
  prefix l2 l3 -> prefix (l1++l2) (l1++l3).
Proof.
  (* exercise *)
Admitted.

(* Hint: this one needs induction + inversion *)
Lemma pref_short : forall l1 l2 l3, prefix (l1++l2) (l1++l3) -> prefix l2 l3.
Proof.
  (* exercise *)
Admitted.

(** example of proof by induction on the evidence for predicate "prefix" *)
Lemma pref_app3 : forall l1 l2 l3, prefix l1 l2 -> prefix l1 (l2++l3).
Proof.
  intros.
  induction H.
  + constructor.
  + simpl.
    constructor.
    trivial.
Qed.

(** Hint: induction on the evidence for the first occurrence of "prefix" *)
Lemma pref_antisymm: forall l1 l2,
  prefix l1 l2 -> prefix l2 l1 -> l1 = l2.
Proof.
  (* exercise *)
Admitted.

(** transitivity of prefix *)
Lemma pref_trans : forall l1 l2 l3, prefix l1 l2 -> prefix l2 l3 -> prefix l1 l3.
Proof.
  intros.
  induction H.
  + constructor.
  + (* IHprefix is useless! There are two reasons:
      1) If prefix (a::l2) l3 than it is impossible that prefix l2 l3
      2) we need to prove prefix (a :: l1) l3,
         but the conclusion of the inductive assumption only says prefix l1 l3 *)
Restart.  (* We need to strengthen our induction hypothesis
             to the more general form forall l3... *)
  intros l1 l2 l3 H.
  revert l3.  (* now our goal is forall l3... ! *)
  (* exercise *)
Admitted.

(** ** Reversing lists for the bored ones only !!! *)

(* this is the definition from the library, with quadratic time complexity *)
Fixpoint rev_slow (l: list A) :=
  match l with
  | [] => []
  | h::t => rev_slow t ++ [h]
  end.

(* reversing in linear time using an accumulator *)
Fixpoint reva (lr l : list A) := match l with
  | [] => lr
  | h::t => reva (h::lr) t
end.

Definition rev l := reva [] l.

Lemma rev_equiv: forall l: list A, rev l = rev_slow l.
Proof.
  induction l.
  + unfold rev. simpl. trivial.
  + unfold rev in *.
    simpl.
    rewrite <- IHl.
    simpl.
    (* The inducton hypothesis is not strong enough *)
Abort.

(* This is a more general fact about the accumulator *)
(* Hint: do induction on l3,
   but make sure that the hypothesis is as general as possible! *)
Lemma reva_app: forall l1 l2 l3: list A,
  reva (l1 ++ l2) l3 = reva l1 l3 ++ l2.
Proof.
  (*Exercise*)
Admitted.

(* Hint: specialise the previous lemma *)
Lemma reva_singl: forall a l,
  reva [a] l = reva [] l ++ [a].
Proof.
  (* Exercise *)
Admitted.

Lemma rev_equiv: forall l: list A, rev l = rev_slow l.
Proof.
  induction l.
  + unfold rev. simpl. trivial.
  + unfold rev in *.
    simpl.
    rewrite <- IHl.
    simpl. apply reva_singl.
Qed.

(* another property we might want to prove is that reverse is an involution *)
Lemma rev_rev : forall l : list A, rev (rev l) = l.
Proof.
  unfold rev.
  induction l.
  + simpl.
    trivial.
  + simpl.
    (* No way! Induction hypothesis is no good. We need stronger assumptions... *)
Abort.

(* auxilary lemma 1 *)
Lemma reva_reva : forall l1 lr : list A, reva lr l1 = app (reva [] l1) lr.
Proof.
  (* exercise *)
Admitted.

(* auxilary lemma 2 *)
Lemma reva_app : forall l1 l2 lr, reva lr (app l1 l2) = app (reva [] l2) (reva lr l1).
Proof.
  (* exercise *)
Admitted.

(* Now, we can do the proof! *)
Lemma rev_rev : forall l : list A, rev (rev l) = l.
Proof.
  (* exercise *)
Admitted.

(* Hooray! *)

(** ** Final notes *)

(** NB: The official [rev] is quadratic (no problem unless you do some
   serious computations within Coq) and friendlier with proofs *)
Print List.rev.
(** NB2. [++] is [app] *)
Eval simpl in ([1;2;3] ++ [4;5;6]).

(* see below *)
Check prefix.
Check app.
Check pref_trans.

End Lists_of_A.

(** NB3. Note that after closing the section, our definitions (and also lemmas)
    get abstracted over variables from the section *)
Check prefix.
Check app.
Check pref_trans.

(** This is the end... *)


(* begin hide *)
Require Import CoList.
Require Import CoTree.
Require Import PArith.
Require Import QArith.
(* end hide *)

(** * Enumerating The Rationals: The Calkin-Wilf Tree *)

(** _Current Status: while the implementation of the tree and the deforestation
    algorithm function perfectly, and were easy to implement, we haven't acutally
    had the time to investigate proving anything with regard to our implementation_.
  *)

(** The third approach of enumerating the rationals explored in the paper is the
    construction and deforestation of the Calkin-Wilf tree.

    The Calkin-Wilf tree maps all levels in the Stern-Brocot tree to their
    bit-reversal permutation.

  #
    <img style="width:100%;" alt="The Calkin-Wilf Tree" src="calkin_wilf.png" />
  #

    Below we will construct the Calkin-Wilf tree.
  *)

Module CalkinWilf.

  Local Open Scope positive_scope.

  (** The algorithm used to construct the Calkin-Wilf tree in the paper can be
      seen below. It trivially translates to Coq, because it avoids all [0]'s,
      and therefore we have no issues constructing rationals. Furthermore, it is
      in itself much simpler.
<<
    rats6 :: [Rational]
    rats6 = bf (unfold next (1, 1))
      where next (m, n) = (m / n, (m, m + n), (n + m, n))
>>
      Our translation of the algorithm can be seen below.
    *)

  Definition next (q:positive*positive) : (positive*positive)*Q*(positive*positive) :=
      match q with
        | (m,n) => ((m,m + n),Zpos m # n,(m + n,n))
      end.

  Definition tree : cotree Q := CoTree.unfold next (1,1).

  Definition enum : colist Q := CoTree.bf tree.

End CalkinWilf.


Import Init.Nat.
Require Import Arith.
Require Import Omega.
Require Import List.
Require Import Nat.

Fixpoint sum_n n :=
  match n with
    0 => 0
  | S p => p + sum_n p
  end.

Lemma sum_n_p : forall n, 2 * sum_n n + n = n * n.
  induction n.
  reflexivity.
  assert (SnSn : S n * S n = n * n + 2 * n + 1).
  ring.
  rewrite SnSn.
  rewrite <- IHn.
  simpl.
  ring.
Qed.

Fixpoint evenb n :=
  match n with
    0 => true
  | 1 => false
  | S (S p) => evenb p
  end.

Lemma evenb_p : forall n, evenb n = true ->
      exists x, n = 2 * x.
  assert (Main :
    forall n,
    (evenb n = true -> exists x, n = 2 * x) /\
    (evenb (S n) = true -> exists x, S n = 2 * x)).
  induction n.
  split. exists 0. ring.
  simpl; intros H; discriminate H.
  split.
    destruct IHn as [_ IHn']; exact IHn'.
  simpl evenb; intros H; destruct IHn as [IHn' _].
  assert (H' : exists x, n = 2 * x).
    apply IHn'; exact H.
  destruct H' as [x q]; exists (x + 1); rewrite q; ring.
  intros n ev.
  destruct (Main n) as [H _].  apply H. exact ev.
Qed.

(*

Exercise on addition, alternative definition We can define a new
addition function on natural numbers:

Fixpoint add n m := match n with 0 => m | S p => add p (S m) end.

Prove the following statements.
forall n m, add n (S m) = S (add n m)
forall n m, add (S n) m = S (add n m)
forall n m, add n m = n + m

Remember that you may use a lemma you just proved when proving a new exercise

*)

Fixpoint add n m := match n with 0 => m | S p => add p (S m) end.

Lemma add_assoc_l : forall n m, add n (S m) = S (add n m).
  induction n.
  simpl; reflexivity.
  induction m.
  simpl.
  apply IHn.
  simpl.
  rewrite <- IHn with (m := S (S m)).
  reflexivity.
Qed.

Lemma add_assoc_r : forall n m, add (S n) m = S (add n m).
  induction n.
  simpl; reflexivity.
  induction m; simpl; apply IHn.
Qed.

Lemma add_plus : forall n m, add n m = n + m.
  induction n.
  intros m.
  simpl.
  reflexivity.
  intros m.
  simpl.
  rewrite IHn.
  ring.
Qed.

Fixpoint sum_odd_n (n : nat) : nat :=
  match n with
    0 => 0
  | S p => 1 + 2 * p + sum_odd_n p
  end.

Lemma sum_odd_n_lemma :  forall n : nat, sum_odd_n n = n * n.
  induction n; simpl. reflexivity.
  f_equal.
  replace (n + 0) with n.
  rewrite IHn.
  ring.
  ring.
Qed.

Definition is_zero (n : nat) : bool :=
    match n with
      0 => true
    | _ => false
    end.

Lemma not_is_zero_pred :
    forall x, is_zero x = false -> S (Nat.pred x) = x.
  intros x.
  unfold is_zero, Nat.pred.
  case x.
  discriminate.
  reflexivity.
Qed.

(* Chap 6 *)

Require Import List.
Import ListNotations.

Fixpoint insert n l :=
  match l with
    [] => n::nil
  | a :: tl => if n <=? a
                then n :: l
                else a :: insert n tl
  end.

Fixpoint sort l :=
  match l with
    [] => []
  | a :: tl => insert a (sort tl)
  end.

Fixpoint count n l :=
  match l with
    [] => 0
  | a :: tl =>
      let r := count n tl
        in if n =? a then 1+r else r
  end.

Lemma insert_incr : forall n l, count n (insert n l) = 1 + count n l.
  intros n l ; induction l.
  { simpl.
    rewrite Nat.eqb_refl.
    reflexivity.
  }
  { simpl.
    case (n <=? a).
    { simpl.
      rewrite Nat.eqb_refl.
      reflexivity.
    }
    { simpl.
      case (n =? a).
      - rewrite IHl; reflexivity.
      - rewrite IHl; reflexivity.
    }
  }
Qed.


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

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

Compute (next_weekday friday).
Compute (next_weekday (next_weekday monday)).

Example test_next_weekday:
  (next_weekday (next_weekday monday)) = wednesday.
  Proof. simpl. reflexivity. Qed.

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

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

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

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

Compute (andb true true).
Compute (andb true false).
Compute (andb false true).
Compute (andb false false).

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

Infix "&&" := andb.
Infix "||" := orb.

Example test_orb5: true || true || false = true.
Proof. simpl. reflexivity. Qed.

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

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

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

Example test_andb31: (andb3 true true true) = true.
Proof. simpl. reflexivity. Qed.

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

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

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

Check true.
Check negb.

Module Playground1.

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

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

End Playground1.

Check (S (S O)).

Definition minusTwo (n:nat) : nat :=
  pred (pred n).

Check minusTwo.

Compute (minusTwo (S (S (S (S O))))).

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

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

Example test_oddb1: oddb 1 = true.
Proof. simpl. reflexivity. Qed.
Example test_oddb2: oddb 4 = false.
Proof. simpl. reflexivity. Qed.

Module Playground2.

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

Compute (plus 3 3).

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

Compute (mult 3 4).

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

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

End Playground2.

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

Example test_exp1: (exp 5 2) = 25.
Proof. simpl. reflexivity. Qed.

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

Example test_factorial1: (factorial 5) = 120.
Proof. simpl. reflexivity. Qed.

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

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

Check ((0 + 1) + 1).

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

Example test_beq_nat1: (beq_nat 3 3) = true.
Proof. simpl. reflexivity. Qed.

Example test_beq_nat2: (beq_nat 4 3) = false.
Proof. simpl. reflexivity. Qed.

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

Example test_leb1: (leb 2 2) = true.
Proof. simpl. reflexivity. Qed.
Example test_leb2: (leb 2 4) = true.
Proof. simpl. reflexivity. Qed.
Example test_leb3: (leb 4 2) = false.
Proof. simpl. reflexivity. Qed.

Definition blt_nat (n m : nat) : bool :=
  negb (leb m n).

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

Theorem plus_O_l: forall n : nat, O + n = n.
Proof.
  intros n. reflexivity. Qed.

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

Theorem mult_O_l: forall n : nat, O * n = O.
Proof.
  intros n. reflexivity. Qed.

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

Theorem plus_O_r: forall n : nat, n = n + O.
Proof.
  intros n.
  induction n as [| n' IHn'].
  - reflexivity.
  - simpl. rewrite <- IHn'. reflexivity.
Qed.

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

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

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

Theorem mult_O_plus: forall n m : nat,
  (O + n) * m = n * m.
Proof.
  intros n m.
  rewrite -> plus_O_l.
  reflexivity. Qed.

Theorem mult_S_l: forall n m: nat,
  m = S n -> m * (1 + n) = m * m.
Proof.
  intros n m.
  intros H.
  rewrite -> plus_1_l.
  rewrite <- H.
  reflexivity.  Qed.

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

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

Theorem andb_commutative: forall a b: bool,
  a && b = b && a.
Proof.
  intros a b. destruct a.
    - destruct b.
      + reflexivity.
      + reflexivity.
    - destruct b.
      + reflexivity.
      + reflexivity.
  Qed.

Theorem andb_true_elim2 : forall b c: bool,
   (b && c) = true -> c = true.
Proof.
  intros [] [].
  intros H.
  - reflexivity.
  - simpl. intros. rewrite -> H. reflexivity.
  - simpl. intros. reflexivity.
  - simpl. intros. rewrite -> H. reflexivity.
Qed.

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

(* Fixpoint blah (n: nat) : nat :=
  match n with
  | O => blah (S O)
  | _ => n
  end.
*)

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

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.
  destruct b.
  - rewrite -> H.
    rewrite -> H.
    reflexivity.
  - rewrite -> H.
    rewrite -> H.
    reflexivity.
Qed.

Theorem andb_eq_orb : forall (b c: bool),
  (b && c = b || c) -> b = c.
Proof.
  intros b c.
  destruct b.
  - destruct c.
    + reflexivity.
    + simpl. intros. rewrite -> H. reflexivity.
  - destruct c.
    + simpl. intros. rewrite -> H. reflexivity.
    + reflexivity.
Qed.

Inductive bin : Type :=
  | Zero : bin
  | TwicePlusOne : bin -> bin
  | Twice : bin -> bin.

Fixpoint incr (b: bin) : bin :=
  match b with
  | Zero => TwicePlusOne Zero
  | Twice n => TwicePlusOne n
  | TwicePlusOne n => Twice (incr n)
  end.

Fixpoint bin_to_nat (b: bin) : nat :=
  match b with
  | Zero => O
  | Twice n => mult 2 (bin_to_nat n)
  | TwicePlusOne n => (mult 2 (bin_to_nat n)) + 1
  end.

Compute (bin_to_nat (incr (incr (incr (incr Zero))))).

Example test_bin_incr1: (bin_to_nat Zero) = 0.
Proof. reflexivity. Qed.

Example test_bin_incr2: (bin_to_nat (incr Zero)) = 1.
Proof. reflexivity. Qed.

Example test_bin_incr3: (bin_to_nat (incr (incr Zero))) = 2.
Proof. reflexivity. Qed.

Example test_bin_incr4: (bin_to_nat (incr (incr (incr Zero)))) = 3.
Proof. reflexivity. Qed.

Example test_bin_incr5: (bin_to_nat (incr Zero)) = S (bin_to_nat Zero).
Proof. reflexivity. Qed.


(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)

Require Import Arith Omega.

Set Implicit Arguments.

Section nat_rev_ind.

  (** A reverse recursion principle *)

  Variables (P : nat -> Prop)
            (HP : forall n, P (S n) -> P n).

  Theorem nat_rev_ind x y : x <= y -> P y -> P x.
  Proof. induction 1; auto. Qed.

End nat_rev_ind.

Section nat_rev_ind'.

  (** A reverse recursion principle *)

  Variables (P : nat -> Prop) (k : nat)
            (HP : forall n, n < k -> P (S n) -> P n).

  Theorem nat_rev_ind' x y : x <= y <= k -> P y -> P x.
  Proof.
    intros H1 H2.
    set (Q n := n <= k /\ P n).
    assert (forall x y, x <= y -> Q y -> Q x) as H.
      apply nat_rev_ind.
      intros n (H3 & H4); split.
      omega.
      revert H4; apply HP, H3.
    apply (H x y).
    omega.
    split; auto; omega.
  Qed.

End nat_rev_ind'.

Section minimizer_pred.

  Variable (P : nat -> Prop)
           (HP : forall p: { n | P n \/ ~ P n }, { P (proj1_sig p) } + { ~ P (proj1_sig p) }).

  Definition minimizer n := P n /\ forall i, i < n -> ~ P i.

  Inductive bar n : Prop :=
    | in_bar_0 : P n -> bar n
    | in_bar_1 : ~ P n -> bar (S n) -> bar n.

  Let bar_ex n : bar n -> P n \/ ~ P n.
  Proof. induction 1; auto. Qed.

  Let loop : forall n, bar n -> { k | P k /\ forall i, n <= i < k -> ~ P i }.
  Proof.
    refine (fix loop n Hn { struct Hn } := match HP (exist _ n (bar_ex Hn)) with
      | left H => exist _ n _
      | right H => match loop (S n) _ with
        | exist _ k Hk => exist _ k _
      end
    end).
    * split; auto; intros; omega.
    * destruct Hn; [ destruct H | ]; assumption.
    * destruct Hk as (H1 & H2).
      split; trivial; intros i Hi.
      destruct (eq_nat_dec i n).
      - subst; trivial.
      - apply H2; omega.
  Qed.

  Hypothesis Hmin : ex minimizer.

  Let bar_0 : bar 0.
  Proof.
    destruct Hmin as (k & H1 & H2).
    apply in_bar_0 in H1.
    clear HP.
    revert H1.
    apply nat_rev_ind' with (k := k).
    intros i H3.
    apply in_bar_1, H2; trivial.
    omega.
  Qed.

  Definition minimizer_pred : sig minimizer.
  Proof.
    destruct (loop bar_0) as (k & H1 & H2).
    exists k; split; auto.
    intros; apply H2; omega.
  Defined.

End minimizer_pred.

Check minimizer_pred.
Print Assumptions minimizer_pred.
Recursive Extraction minimizer_pred.

(** Let P be a computable predicate:
      - whenever P n has a value (P n or not P n) then that value can be computed
    Then minimizer P is computable as well:
      - whenever minimizer P holds for some n, then such an n can be computed
 *)

Corollary minimizer_alt (P : nat -> Prop) :
    (forall n, P n \/ ~ P n -> { P n } + { ~ P n }) -> ex (minimizer P) -> sig (minimizer P).
Proof.
  intro H; apply minimizer_pred.
  intros (n & Hn); apply H, Hn.
Defined.

Check minimizer_alt.
Print Assumptions minimizer_alt.
Recursive Extraction minimizer_alt.

Section minimizer.

  Variable (R : nat -> nat -> Prop)
           (Rfun : forall n u v, R n u -> R n v -> u = v)
           (HR : forall n, ex (R n) -> sig (R n)).

  Definition minimizer n := R n 0 /\ forall i, i < n -> exists u, R i (S u).

  Fact minimizer_fun n m : minimizer n -> minimizer m -> n = m.
  Proof.
    intros (H1 & H2) (H3 & H4).
    destruct (lt_eq_lt_dec n m) as [ [ H | ] | H ]; auto;
      [ apply H4 in H | apply H2 in H ]; destruct H as (u & Hu);
      [ generalize (Rfun H1 Hu) | generalize (Rfun H3 Hu) ]; discriminate.
  Qed.

  Inductive bar n : Prop :=
    | in_bar_0 : R n 0 -> bar n
    | in_bar_1 : (exists u, R n (S u)) -> bar (S n) -> bar n.

  Let bar_ex n : bar n -> ex (R n).
  Proof.
    induction 1 as [ n Hn | n (k & Hk) _ _ ].
    exists 0; auto.
    exists (S k); trivial.
  Qed.

  Let loop : forall n, bar n -> { k | R k 0 /\ forall i, n <= i < k -> exists u, R i (S u) }.
  Proof.
    refine (fix loop n Hn { struct Hn } := match HR (bar_ex Hn) with
        | exist _ u Hu => match u as m return R _ m -> _ with
            | 0   => fun H => exist _ n _
            | S v => fun H => match loop (S n) _ with
                | exist _ k Hk => exist _ k _
              end
          end Hu
      end).
    * split; auto; intros; omega.
    * destruct Hn as [ Hn | ]; trivial; exfalso; generalize (Rfun H Hn); discriminate.
    * destruct Hk as (H1 & H2); split; trivial; intros i Hi.
      destruct (eq_nat_dec i n).
      - subst; exists v; trivial.
      - apply H2; omega.
  Qed.

  Hypothesis Hmin : ex minimizer.

  Let bar_0 : bar 0.
  Proof.
    destruct Hmin as (k & H1 & H2).
    apply in_bar_0 in H1.
    clear Hmin HR.
    revert H1.
    apply nat_rev_ind' with (k := k).
    intros i H3.
    apply in_bar_1, H2; trivial.
    omega.
  Qed.

  Definition minimizer_coq : sig minimizer.
  Proof.
    destruct (loop bar_0) as (k & H1 & H2).
    exists k; split; auto.
    intros; apply H2; omega.
  Defined.

End minimizer.

Check minimizer_coq.
Print Assumptions minimizer_coq.

Extraction "minimizer.ml" minimizer_coq.


(* bool ::= true | false *)

Inductive bool: Set :=
  | true
  | false
.

(* Cada linha iniciada com um símbolo de pipeline, '|', representa um construtor; *)
(* 'true' e 'false' são do tipo 'bool' e são as únicas expressões construtoras que pertencem a tal conjunto. *)

(* ----------------------------------------- *)

(* Deifinição 1.1. (negb) *)

(* negb : bool -> bool *)

(* |-------------------| *)
(* |   b   | negb (b)  | *)
(* |-------------------| *)
(* | false |    true   | *)
(* |  true |   false   | *)
(* |-------------------| *)

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

(* Teorema 1.1. Demonstre que negb é um função involutiva, ou seja, que, para todo 'b' em 'bool', negb (negb (b)) = b*)
Theorem negb_involutive : forall (b : bool),
  negb (negb b) = b.
Proof.

  (*Seja 'b' em 'bool'.*)
  intro b.

  destruct b eqn:E.

  (*Caso b := true*)
  - (* Pela definição de 'negb', temos que negb (negb (true)) = true. *)
    simpl.
    (* Reflexividade da '=' *)
    reflexivity.

  (*Caso b := false*)
  - (* Pela definição de 'negb', temos que negb (negb (false)) = false. *)
    simpl.
    (* Reflexividade da '=' *)
    reflexivity.

Qed.


Require Import Algebra.Semigroup.
Require Import Algebra.Monoid.
Section GroupTheory.
Context {G: Set}(mult: G -> G -> G)(ident: G)(inv: G -> G).

Class Group := {
  group_assoc: forall (a b c: G), mult (mult a b) c = mult a (mult b c);
  group_ident_left: forall (a: G), mult ident a = a;
  group_ident_right: forall (a: G), mult a ident = a;
  group_inv_left: forall (a: G), mult (inv a) a = ident;
  group_inv_right: forall (a: G), mult a (inv a) = ident;
}.

Theorem group_monoid:
  Group -> Monoid mult ident.
Proof.
  intros Ggroup.
  constructor.
  { apply group_assoc. }
  { apply group_ident_left. }
  { apply group_ident_right. }
Qed.

Theorem group_semigroup:
  Group -> Semigroup mult.
Proof.
  intros Ggroup.
  constructor.
  apply group_assoc.
Qed.

Context `{Ggroup: Group}.

Lemma group_left_mult (a b: G):
  a = b -> forall (c: G), mult c a = mult c b.
Proof.
  intros <-;
    reflexivity.
Qed.

Lemma group_right_mult (a b: G):
  a = b -> forall (c: G), mult a c = mult b c.
Proof.
  intros <-;
    reflexivity.
Qed.

Theorem group_ident_unique (ident': G):
  (forall (a: G), mult ident' a = a) ->
  (forall (a: G), mult a ident' = a) ->
  ident' = ident.
Proof.
  intros Hlident' Hrident'.
  rewrite <- (Hrident' ident).
  rewrite <- (group_ident_left ident').
  rewrite (group_ident_left (mult ident ident')).
  reflexivity.
Qed.

Theorem group_idemp_ident (a: G):
  mult a a = a ->
  a = ident.
Proof.
  intros Hidemp.
  apply group_right_mult with (c := inv a) in Hidemp.
  rewrite group_assoc in Hidemp.
  rewrite group_inv_right in Hidemp.
  rewrite group_ident_right in Hidemp.
  assumption.
Qed.

Theorem group_left_cancel (a b c: G):
  mult c a = mult c b -> a = b.
Proof.
  intros Hcacb.
  apply group_left_mult with (c := inv c) in Hcacb.
  rewrite <- 2 group_assoc in Hcacb.
  rewrite group_inv_left in Hcacb.
  rewrite 2 group_ident_left in Hcacb.
  assumption.
Qed.

Theorem group_right_cancel (a b c: G):
  mult a c = mult b c -> a = b.
Proof.
  intros Hacbc.
  apply group_right_mult with (c := inv c) in Hacbc.
  rewrite 2 group_assoc in Hacbc.
  rewrite group_inv_right in Hacbc.
  rewrite 2 group_ident_right in Hacbc.
  assumption.
Qed.

Theorem group_inv_unique (a aInv: G):
  mult aInv a = ident ->
  mult a aInv = ident ->
  aInv = inv a.
Proof.
  intros Hlinv Hrinv.
  rewrite <- (group_inv_right a) in Hrinv.
  apply group_left_cancel in Hrinv.
  assumption.
Qed.

Theorem group_inv_involute (a: G):
  inv (inv a) = a.
Proof.
  symmetry.
  apply group_inv_unique.
  { apply group_inv_right. }
  { apply group_inv_left. }
Qed.

Theorem group_inv_mult (a b: G):
  inv (mult a b) = mult (inv b) (inv a).
Proof.
  symmetry.
  apply group_inv_unique;
    rewrite group_assoc.
  { remember (mult (inv a) (mult a b)) as b'.
    rewrite <- group_assoc in Heqb'.
    rewrite group_inv_left in Heqb'.
    rewrite group_ident_left in Heqb'.
    subst b'.
    apply group_inv_left. }
  { remember (mult b (mult (inv b) (inv a))) as inva.
    rewrite <- group_assoc in Heqinva.
    rewrite group_inv_right in Heqinva.
    rewrite group_ident_left in Heqinva.
    subst inva.
    apply group_inv_right. }
Qed.

Theorem group_left_mult_soln (a b: G):
  exists! (x: G), mult a x = b.
Proof.
  exists (mult (inv a) b).
  split.
  { rewrite <- group_assoc.
    rewrite group_inv_right.
    rewrite group_ident_left.
    reflexivity. }
  { intros x Haxb.
    apply group_left_mult with (c := inv a) in Haxb.
    rewrite <- group_assoc in Haxb.
    rewrite group_inv_left in Haxb.
    rewrite group_ident_left in Haxb.
    symmetry.
    assumption. }
Qed.

Theorem group_right_mult_soln (a b: G):
  exists! (x: G), mult x a = b.
Proof.
  exists (mult b (inv a)).
  split.
  { rewrite group_assoc.
    rewrite group_inv_left.
    rewrite group_ident_right.
    reflexivity. }
  { intros x Hxab.
    apply group_right_mult with (c := inv a) in Hxab.
    rewrite group_assoc in Hxab.
    rewrite group_inv_right in Hxab.
    rewrite group_ident_right in Hxab.
    symmetry.
    assumption. }
Qed.

Theorem group_inv_ident:
  inv ident = ident.
Proof.
  symmetry.
  apply group_inv_unique;
    apply group_ident_right.
Qed.
End GroupTheory.

Section SemigroupTheory.
Context {G: Set}(mult: G -> G -> G).
Context `{Gsubgroup: Semigroup G mult}.
Context (ident: G)(inv: G -> G).

Theorem group_semigroup_left_ident_left_inv:
  (Monoid mult ident /\ Group mult ident inv) ->
  forall (a: G), mult ident a = a /\ mult (inv a) a = ident.
Proof.
  intros [Gmonoid Ggroup] a.
  split;
    [apply monoid_ident_left | apply group_inv_left];
    assumption.
Qed.

Theorem group_semigroup_right_ident_right_inv:
  (Monoid mult ident /\ Group mult ident inv) ->
  forall (a: G), mult a ident = a /\ mult a (inv a) = ident.
Proof.
  intros [Gmonoid Ggroup] a.
  split;
    [apply monoid_ident_right | apply group_inv_right];
    assumption.
Qed.

Lemma semigroup_left_ident_left_inv_idemp_ident:
  (forall (a: G), mult ident a = a) ->
  (forall (a: G), mult (inv a) a = ident) ->
  forall (a: G), mult a a = a -> a = ident.
Proof.
  intros Hlident Hlinv a Hidemp.
  apply semigroup_left_mult with (c := inv a)(mult0 := mult) in Hidemp.
  rewrite <- semigroup_assoc in Hidemp;
    try assumption.
  rewrite Hlinv in Hidemp.
  rewrite Hlident in Hidemp.
  assumption.
Qed.

Lemma semigroup_right_ident_right_inv_idemp_ident:
  (forall (a: G), mult a ident = a) ->
  (forall (a: G), mult a (inv a) = ident) ->
  forall (a: G), mult a a = a -> a = ident.
Proof.
  intros Hrident Hrinv a Hidemp.
  apply semigroup_right_mult with (c := inv a)(mult0 := mult) in Hidemp.
  rewrite semigroup_assoc in Hidemp;
    try assumption.
  rewrite Hrinv in Hidemp.
  rewrite Hrident in Hidemp.
  assumption.
Qed.

Theorem semigroup_left_ident_left_inv_group:
  (forall (a: G), mult ident a = a) ->
  (forall (a: G), mult (inv a) a = ident) ->
  Monoid mult ident /\ Group mult ident inv.
Proof.
  intros Hlident Hlinv.
  cut (forall (a: G), mult a (inv a) = ident).
  { intros Hrinv.
    split;
      constructor;
      try apply semigroup_assoc;
      try assumption;
    intros a;
    rewrite <- (Hlinv a);
    rewrite <- semigroup_assoc;
      try assumption;
    rewrite Hrinv;
    apply Hlident. }
  { intros a.
    apply semigroup_left_ident_left_inv_idemp_ident;
      try assumption.
    rewrite semigroup_assoc;
      try assumption.
    remember (mult (inv a) (mult a (inv a))) as inva.
    rewrite <- semigroup_assoc in Heqinva;
      try assumption.
    rewrite Hlinv in Heqinva.
    rewrite Hlident in Heqinva.
    subst inva.
    reflexivity. }
Qed.

Theorem semigroup_right_ident_right_inv_group:
  (forall (a: G), mult a ident = a) ->
  (forall (a: G), mult a (inv a) = ident) ->
  Monoid mult ident /\ Group mult ident inv.
Proof.
  intros Hrident Hrinv.
  cut (forall (a: G), mult (inv a) a = ident).
  { intros Hlinv.
    split;
      constructor;
      try apply semigroup_assoc;
      try assumption;
    intros a;
    rewrite <- (Hrinv a);
    rewrite semigroup_assoc;
      try assumption;
    rewrite Hlinv;
    rewrite Hrident;
    reflexivity. }
  { intros a.
    apply semigroup_right_ident_right_inv_idemp_ident;
      try assumption.
    rewrite <- semigroup_assoc;
      try assumption.
    remember (mult (mult (inv a) a) (inv a)) as inva.
    rewrite semigroup_assoc in Heqinva;
      try assumption.
    rewrite Hrinv in Heqinva.
    rewrite Hrident in Heqinva.
    subst inva.
    reflexivity. }
Qed.
End SemigroupTheory.

Section SubgroupTheory.
Context {G: Set}(mult: G -> G -> G)(ident: G)(inv: G -> G).
Context `{Gsubgroup: Semigroup G mult}.
Context `{Gmonoid: Monoid G mult ident}.
Context `{Ggroup: Group G mult ident inv}.
Context (P: G -> Prop).

Class Subgroup := {
  subgroup_mult_closed: forall (a b: G), P a -> P b -> P (mult a b);
  subgroup_ident: P ident;
  subgroup_inv_closed: forall (a: G), P a -> P (inv a);
}.

Theorem subgroup_mult_inv_closed:
  Subgroup ->
  forall (a b: G), P a -> P b -> P (mult a (inv b)).
Proof.
  intros Psubgroup a b Pa Pb.
  apply subgroup_mult_closed;
    try assumption.
  apply subgroup_inv_closed;
    assumption.
Qed.

Lemma subset_mult_inv_closed_ident:
  {a: G | P a} ->
  (forall (a b: G), P a -> P b -> P (mult a (inv b))) ->
  P ident.
Proof.
  intros [a Ha] Hmultinv.
  rewrite <- (group_inv_right mult ident inv a).
  apply Hmultinv;
    assumption.
Qed.

Theorem subset_mult_inv_closed_subgroup:
  {a: G | P a} ->
  (forall (a b: G), P a -> P b -> P (mult a (inv b))) ->
  Subgroup.
Proof.
  intros [g Pg] Hmultinv.
  constructor.
  { intros a b Pa Pb.
    rewrite <- (group_inv_involute mult ident inv b).
    apply Hmultinv;
      try assumption.
    rewrite <- (monoid_ident_left mult ident).
    apply Hmultinv;
      try assumption.
    apply subset_mult_inv_closed_ident;
      try exists g;
      try assumption. }
  { apply subset_mult_inv_closed_ident;
      try exists g;
      try assumption. }
  { intros a Pa.
    rewrite <- (monoid_ident_left mult ident).
    apply Hmultinv;
      try assumption.
    apply subset_mult_inv_closed_ident;
      try exists g;
      try assumption. }
Qed.
End SubgroupTheory.


(*
If we have a map from P to Q and Q to R,
then we can decude a mapping from P to R using natural deduction.

P -> Q    Q -> R
----------------
     P -> R

We can prove this in Coq.
*)
Theorem implication1 (P Q R: Prop):
  forall
  (f: P -> Q)
  (g: Q -> R),
  P ->
  R.
Proof.
intros f g p.
(* If we need to prove R and
   we know Q implies R
   then we only need to prove Q *)
apply g.
(* If we need to prove Q and
   we know P implies Q
   then we only need to prove P *)
apply f.
(* but we have a P as an hypothesis *)
exact p.
Qed.

(* We can also do forwards instead of
   backwards reasoning
*)
Theorem implication2 (P Q R: Prop):
  forall
  (f: P -> Q)
  (g: Q -> R),
  P ->
  R.
Proof.
intros f g p.
(* lets apply f in p, since we know P implies Q *)
apply f in p.
(* now lets apply g in p to get R *)
apply g in p.
(* now we have R *)
exact p.
Qed.

(* Programmers might just know this as
   function application.
   Coq type checks this function,
   so we know that it is correct.
*)
Definition application (P Q R: Prop)
  (f: P -> Q) (g: Q -> R): P -> R :=
fun p => g (f p).

(*
We can combine the two in the same proof,
because the Curry-Howard Isomorphism says they are the same.
*)
Theorem implication3 (P Q R: Prop): forall
  (f: P -> Q) (g: Q -> R), P -> R.
Proof.
intros f g.
(* This program is a proof *)
exact (fun p =>
  g (f p)
).
Qed.

(*
Underneath all these tactics, they are just code.
When we Print our proofs and code they are all the same:
`g (f p)`
*)
Print implication3.
Print implication1.
Print application.

Theorem implication4 (P Q R: Prop): forall
  (f: P -> Q) (g: Q -> R) (p: P), R.
Proof.
(* Some tactics can do some types of reasoning for us. *)
auto.
(* The proof is irrelevant, we only care that it is true *)
Qed.

(* This is also the same `g (f p)` *)
Print implication4.

(*
Given A and B, we can deduce A

A /\ B
-------
   A
*)
Theorem conjunction (A: Prop) (B: Prop):
  forall
  (pair: A /\ B),
  A.
Proof.
intros pair.
destruct pair.
exact H.
Restart.
intros pair.
(*
If we squint this looks just like the `product` function below.
This is because logical conjunction is the same as:
products, pairs, tuples or records in programming.
*)
exact (
  match pair with
  | conj A B => A
  end
).
Qed.

(* A * B = (A, B) *)
Definition product (A: Set) (B: Set)
  (pair: A * B): A :=
match pair with
  | (a, b) => a
end.

(*
If we have B then we can deduce A or B.

   B
-------
A \/ B
*)
Theorem disjunction (A: Prop) (B: Prop):
  forall
  (b: B),
  A \/ B.
Proof.
intros.
right.
exact b.
Restart.
intros.
(*
If we squint this looks just like the `sum` function below.
This is because logical disjunction is the same as:
sum types, coproducts or algebriac data types in programming.
*)
exact (
  (* Right b *)
  or_intror b
).
Qed.

(* A + B = Either A B
   inl   = Left
   inr   = Right
*)
Definition sum (A: Set) (B: Set)
  (b: B): A + B :=
(* Right b *)
inr b.


Require Import Category.
Require Import natAsMonoid.
Require Import MonoidAsCategory.

(* turning the monoids NatPlus and NatMult into a categories *)

Definition NatPlusAsCat : Category nat := toCategory NatPlus.
Definition NatMultAsCat : Category nat := toCategory NatMult.

(*
Check NatPlusAsCat.
Check NatMultAsCat.
*)

(* the source of every morphism is the identity of the monoid *)

Example source_test1 : forall n:nat, source NatPlusAsCat n = 0.
Proof. reflexivity. Qed.

Example source_test2 : forall n:nat, source NatMultAsCat n = 1.
Proof. reflexivity. Qed.

(* the target of every morphism is the identity of the monoid *)

Example target_test1 : forall n:nat, target NatPlusAsCat n = 0.
Proof. reflexivity. Qed.

Example target_test2 : forall n:nat, target NatMultAsCat n = 1.
Proof. reflexivity. Qed.

(* composition is defined everywhere and coincides with summation *)

Example compose_test1 : forall n m:nat, compose NatPlusAsCat n m = Some (n + m).
Proof. reflexivity. Qed.

Example compose_test2 : forall n m:nat, compose NatMultAsCat n m = Some (n * m).
Proof. reflexivity. Qed.


Require Import PeanoNat.
Require Import Omega.

Definition strict_incr (f: nat -> nat) :=
  forall n, f n < f (S n).

Lemma f_nat_incr {f: nat -> nat}:
  strict_incr f -> forall m, f 0 < f (S m).
Proof.
  intros I.
  induction m; [pose (I 0)|pose (I (S m))]; omega.
Qed.

Lemma f_nat_incr_neq {f: nat -> nat}:
  strict_incr f -> forall {n m}, n <> m -> f n <> f m.
Proof.
  intros I n m.
  case (Nat.compare_spec n m); [now intros| |]; intros t _.
  + assert (strict_incr (fun i => f (n + i))) as I'.
    { intro i. now replace (n + S i) with (S (n + i)) by omega. }
    replace n with (n + 0) by omega.
    replace m with (n + S (m - n - 1)) by omega.
    apply Nat.lt_neq, (f_nat_incr I').
  + assert (strict_incr (fun i => f (m + i))) as I'.
    { intro i. now replace (m + S i) with (S (m + i)) by omega. }
    replace m with (m + 0) by omega.
    replace n with (m + S (n - m - 1)) by omega.
    apply Nat.neq_sym, Nat.lt_neq, (f_nat_incr I').
Qed.


(*Software Foundations*)
(* Exercice *** *)
Lemma plus_assoc: forall n m p: nat, (n + m) + p = n + (m + p).
Proof.
    intros. induction n as [|n'].
    simpl. reflexivity.
    simpl. rewrite IHn'. reflexivity.
Qed.

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


Require Export MoreProp.

Inductive and (P Q : Prop) : Prop :=
    conj : P -> Q -> (and P Q).

Notation "P /\ Q" := (and P Q) : type_scope.

Check conj.

Theorem and_example :
    (beautiful 0) /\ (beautiful 3).
Proof.
    apply conj.
    Case "left". apply b_0.
    Case "right". apply b_3.
Qed.

Theorem and_example' :
    (ev 0) /\ (ev 4).
Proof.
    split.
    Case "left". apply ev_0.
    Case "right". apply ev_SS. apply ev_SS. apply ev_0.
Qed.

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

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

Theorem and_commut : forall P Q : Prop,
    P /\ Q -> Q /\ P.
Proof.
    intros P Q H.
    inversion H.
    split.
        apply H1.

        apply H0.
Qed.

Theorem and_assoc : forall P Q R : Prop,
    P /\ (Q /\ R) -> (P /\ Q) /\ R.
Proof.
    intros P Q R H.
    inversion H as (HP, (HQ, HR)).
    split.
    split.
        apply HP.

        apply HQ.

        apply HR.
Qed.

Theorem even__ev : forall n : nat,
    (even n -> ev n) /\ (even (S n) -> ev (S n)).
Proof.
    intros n.
    induction n as [| n'].
        split.
        intros H.
        apply ev_0.

        intros H1.
        inversion H1.

    inversion IHn' as (HP, HQ).
    split.
    apply HQ.

    intros J.
    apply ev_SS.
    apply HP.
    unfold even.
    unfold even in J.
    simpl in J.
    apply J.
Qed.

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

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

Theorem iff_implies : forall P Q : Prop,
    (P <-> Q) -> P -> Q.
Proof.
    intros P Q H.
    inversion H as [HAB HBA].
    apply HAB.
Qed.

Theorem iff_sym : forall P Q : Prop,
    (P <-> Q) -> (Q <-> P).
Proof.
    intros P Q H.
    inversion H as [HAB HBA].
    split.
    Case "->". apply HBA.
    Case "<-". apply HAB.
Qed.

Theorem iff_refl : forall P : Prop,
    P <-> P.

Proof.
    intros P.
    split.
    Case "->". intros J. apply J.
    Case "<-". intros J. apply J.
Qed.

Theorem iff_trans : forall P Q R : Prop,
    (P <-> Q) -> (Q <-> R) -> (P <-> R).
Proof. Admitted.

Inductive or (P Q : Prop) : Prop :=
| or_introl : P -> or P Q
| or_intror : Q -> or P Q.

Notation "P \/ Q" := (or P Q) : type_scope.
Check or_introl.

Check or_intror.

Theorem or_commut : forall P Q : Prop,
    P \/ Q -> Q \/ P.
Proof.
    intros P Q H.
    inversion H as [HP | HQ].
    Case "left". apply or_intror. apply HP.
    Case "right". apply or_introl. apply HQ.
Qed.

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

Theorem or_distributes_over_and_1 : forall P Q R : Prop,
    P \/ (Q /\ R) -> (P \/ Q) /\ (P \/ R).
Proof.
    intros P Q R. intros H. inversion H as [HP | [HQ HR]].
    Case "left". split.
        SCase "left". left. apply HP.
        SCase "right". left. apply HP.
    Case "right". split.
        SCase "left". right. apply HQ.
        SCase "right". right. apply HR.
Qed.

Theorem or_distributes_over_and_2 : forall P Q R : Prop,
    (P \/ Q) /\ (P \/ R) -> P \/ (Q /\ R).
Proof.
    intros P Q R H.
    inversion H as [[HP1| HQ1] [HP2| HR1]].
    Case "leftleft".
        left. apply HP1.

    Case "left".
        left. apply HP1.

    Case "right".
        left. apply HP2.

    Case "rightright".
        right. split.
            SCase "left". apply HQ1.
            SCase "right". apply HR1.
Qed.

Theorem andb_prop : forall b c,
    andb b c = true -> b = true /\ c = true.
Proof.
    intros b c H.
    destruct b.
    Case "b = true". destruct c.
        SCase "c = true". apply conj. reflexivity. reflexivity.
        SCase "c = false". inversion H.
    Case "b = false". inversion H.
Qed.

Theorem andb_true_intro : forall b c,
    b = true /\ c = true -> andb b c = true.
Proof.
    intros b c H.
    inversion H.
    rewrite H0. rewrite H1. reflexivity.
Qed.

Theorem andb_false : forall b c,
    andb b c = false -> b = false \/ c = false.
Proof.
    intros b c H.
    destruct b.
    Case "b = true".
        simpl in H. right. apply H.

    Case "b = false".
        simpl in H. left. apply H.
Qed.

Theorem orb_prop : forall b c,
    orb b c = true -> b = true \/ c = true.
Proof.
    intros b c H.
    destruct b.
    Case "b = true".
        simpl in H. left. apply H.

    Case "b = false".
        simpl in H. right. apply H.
Qed.

Theorem orb_false_elim : forall b c,
    orb b c = false -> b = false /\ c = false.
Proof.
    intros b c H.
    destruct b.
    Case "b = true".
        inversion H.

    Case "b = false".
        simpl in H. split.
        SCase "left". reflexivity.
        SCase "right". apply H.
Qed.

Inductive False : Prop := .
Check tt.

Theorem False_implies_nonsense :
    False -> 2 + 2 = 5.
Proof.
    intros contra.
    inversion contra.
Qed.

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

Inductive True : Prop := tt : True.

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

Notation "~ x" := (not x) : type_scope.

Check not.

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

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

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

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

    apply HP.
Qed.

Theorem not_both_true_and_false : forall P : Prop,
    ~ (P /\ ~P).
Proof.
    intros P.
    unfold not.
    intros H.
    inversion H as [HL HR].
    apply HR in HL.
    apply HL.
Qed.

Theorem five_not_even :
    ~ ev 5.
Proof.
    unfold not.
    intros H.
    inversion H.
    inversion H1.
    inversion H3.
Qed.

Theorem classic_double_neg : forall P : Prop,
    ~~P -> P.
Proof.
    intros P H. unfold not in H. Abort.

(*
    TODO: Exercise classical_axioms
*)

Notation "x <> y" := (~ (x = y)) : type_scope.

Theorem not_false_then_true : forall b : bool,
    b <> false -> b = true.
Proof.
    intros b H. destruct b.
    Case "b = true". reflexivity.
    Case "b = false".
        unfold not in H.
        apply ex_falso_quodlibet.
        apply H. reflexivity.
Qed.

Theorem false_beq_nat : forall n m : nat,
    n <> m ->
    beq_nat n m = false.
Proof. Admitted.

Theorem beq_nat_false : forall n m,
    beq_nat n m = false -> n <> m.
Proof. Admitted.

Theorem ble_nat_false : forall n m ,
    ble_nat n m = false -> ~(n <= m).
Proof. Admitted.

Inductive ex (X:Type) (P : X->Prop) : Prop :=
    ex_intro : forall(witness:X), P witness -> ex X P.

Notation "'exists' x , p" := (ex _ (fun x => p))
    (at level 200, x ident, right associativity) : type_scope.
Notation "'exists' x : X , p" := (ex _ (fun x:X => p))
    (at level 200, x ident, right associativity) : type_scope.

Example exists_example_1 : exists n, n + (n * n) = 6.
Proof.
    apply ex_intro with (witness:=2).
    reflexivity.
Qed.

Example exists_example_1' : exists n, n + (n * n) = 6.
Proof.
    exists 2.
    reflexivity.
Qed.

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

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

Module MyEQ.
Inductive eq {X:Type} : X -> X -> Prop :=
    refl_equal : forall x, eq x x.

Notation "x = y" := (eq x y)
                    (at level 70, no associativity)
                    : type_scope.

Lemma leibniz_equality : forall(X : Type) (x y : X),
    x = y -> forall P : X -> Prop, P x -> P y.
Proof.
    intros X x y H P.
    inversion H.
    intros J.
    apply J.
Qed.

End MyEQ.

Lemma four : 2 + 2 = 1 + 3.
Proof.
    apply refl_equal.
Qed.

Inductive sumbool (A B : Prop) : Set :=
| left : A -> sumbool A B
| right : B -> sumbool A B.

Notation "{ A } + { B }" := (sumbool A B) : type_scope.

Theorem eq_nat_dec : forall n m : nat, {n = m} + {n <> m}.
Proof.
    intros n.
    induction n as [|n'].
    Case "n = 0".
        intros m.
        destruct m as [|m'].
        SCase "m = 0".
            left. reflexivity.
        SCase "m = S m'".
            right. intros contra. inversion contra.
    Case "n = S n'".
        intros m.
        destruct m as [|m'].
        SCase "m = 0".
            right. intros contra. inversion contra.
        SCase "m = S m'".
            destruct IHn' with (m := m') as [eq | neq].
            left. apply f_equal. apply eq.
            right. intros Heq. inversion Heq as [Heq']. apply neq. apply Heq'.
Defined.

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

Theorem override_same' : forall(X:Type) x1 k1 k2 (f : nat -> X),
    f k1 = x1 ->
    (override' f k1 x1) k2 = f k2.
Proof.
    intros X x1 k1 k2 f. intros Hx1.
    unfold override'.
    destruct (eq_nat_dec k1 k2).
    Case "k1 = k2".
        rewrite <- e.
        symmetry. apply Hx1.
    Case "k1 <> k2".
        reflexivity.
Qed.

(*
    TODO: Additional exercises
*)


Require Import ZArith Nnat ROmega.
Open Scope Z_scope.

(** Test of the zify preprocessor for (R)Omega *)

(* More details in file PreOmega.v

   (r)omega with Z        : starts with zify_op
   (r)omega with nat      : starts with zify_nat
   (r)omega with positive : starts with zify_positive
   (r)omega with N        : starts with uses zify_N
   (r)omega with *        : starts zify (a saturation of the others)
*)

(* zify_op *)

Goal forall a:Z, Z.max a a = a.
intros.
romega with *.
Qed.

Goal forall a b:Z, Z.max a b = Z.max b a.
intros.
romega with *.
Qed.

Goal forall a b c:Z, Z.max a (Z.max b c) = Z.max (Z.max a b) c.
intros.
romega with *.
Qed.

Goal forall a b:Z, Z.max a b + Z.min a b = a + b.
intros.
romega with *.
Qed.

Goal forall a:Z, (Z.abs a)*(Z.sgn a) = a.
intros.
zify.
intuition; subst; romega. (* pure multiplication: omega alone can't do it *)
Qed.

Goal forall a:Z, Z.abs a = a -> a >= 0.
intros.
romega with *.
Qed.

Goal forall a:Z, Z.sgn a = a -> a = 1 \/ a = 0 \/ a = -1.
intros.
romega with *.
Qed.

(* zify_nat *)

Goal forall m: nat, (m<2)%nat -> (0<= m+m <=2)%nat.
intros.
romega with *.
Qed.

Goal forall m:nat, (m<1)%nat -> (m=0)%nat.
intros.
romega with *.
Qed.

Goal forall m: nat, (m<=100)%nat -> (0<= m+m <=200)%nat.
intros.
romega with *.
Qed.
(* 2000 instead of 200: works, but quite slow *)

Goal forall m: nat, (m*m>=0)%nat.
intros.
romega with *.
Qed.

(* zify_positive *)

Goal forall m: positive, (m<2)%positive -> (2 <= m+m /\ m+m <= 2)%positive.
intros.
romega with *.
Qed.

Goal forall m:positive, (m<2)%positive -> (m=1)%positive.
intros.
romega with *.
Qed.

Goal forall m: positive, (m<=1000)%positive -> (2<=m+m/\m+m <=2000)%positive.
intros.
romega with *.
Qed.

Goal forall m: positive, (m*m>=1)%positive.
intros.
romega with *.
Qed.

(* zify_N *)

Goal forall m:N, (m<2)%N -> (0 <= m+m /\ m+m <= 2)%N.
intros.
romega with *.
Qed.

Goal forall m:N, (m<1)%N -> (m=0)%N.
intros.
romega with *.
Qed.

Goal forall m:N, (m<=1000)%N -> (0<=m+m/\m+m <=2000)%N.
intros.
romega with *.
Qed.

Goal forall m:N, (m*m>=0)%N.
intros.
romega with *.
Qed.

(* mix of datatypes *)

Goal forall p, Z.of_N (N.of_nat (N.to_nat (Npos p))) = Zpos p.
intros.
romega with *.
Qed.


Require Import Arith.

Goal forall n m p q : nat, (n + m) + (p + q) = (n + p) + (m + q).
Proof.
  intros.
  rewrite (plus_assoc (n + m) p q).
  rewrite (plus_assoc (n + p) m q).
  rewrite <- (plus_assoc n m p).
  rewrite <- (plus_assoc n p m).
  rewrite (plus_comm m p).
  reflexivity.
Qed.

Goal forall n m : nat, (n + m) * (n + m) = n * n + m * m + 2 * n * m.
Proof.
  intros.
  rewrite (mult_plus_distr_r n m (n + m)).
  rewrite (mult_plus_distr_l n n m).
  rewrite (mult_plus_distr_l m n m).
  rewrite (plus_assoc (n * n + n * m) (m * n) (m * m)).
  rewrite <- (mult_1_r (n * m)).
  rewrite (mult_comm m n).
  rewrite <- (plus_assoc (n * n) (n * m * 1) (n * m)).
  rewrite (mult_n_Sm (n * m) 1).
  rewrite (mult_comm (n * m) 2).
  rewrite (mult_assoc 2 n m).
  rewrite <- (plus_assoc (n * n) (2 * n * m) (m * m)).
  rewrite (plus_comm (2 * n * m) (m * m)).
  rewrite (plus_assoc (n * n) (m * m) (2 * n * m)).
  reflexivity.
Qed.