Require Import ZArith.
Require Import List.
Require Import Classical_Prop.
Open Scope Z_scope.

From QuickChick Require Import QuickChick.
Import QcDefaultNotation. Open Scope qc_scope.
Import GenLow GenHigh.
Set Warnings "-extraction-opaque-accessed,-extraction".

Require Import mathcomp.ssreflect.ssreflect.
From mathcomp Require Import seq ssreflect ssrbool ssrnat eqtype.

(****Expressoes sem Variaveis****)

(*1*)

Inductive Op : Type :=
  | P   : Op
  | M   : Op
  | MM  : Op.

Check forAll.
Require Import String. Open Scope string.
Instance showOp : Show (Op) :=
  {| show o :=
      match o with
      | P => "+"
      | M => "-"
      | MM => "*"
      end
  |}.

Definition genOp : G Op :=
  elems [P ; M ; MM].

Inductive aexp :=
  | Leaf : Z -> aexp
  | Node : aexp -> Op -> aexp -> aexp.

Instance showAExp : Show (aexp) :=
  {| show :=
      let fix aux a :=
        match a with
        | Leaf z => show z
        | Node l o r => "(" ++ aux l ++ " " ++ show o ++ " " ++ aux r ++ ")"
        end
      in aux
  |}.

Fixpoint genAExp (sz : nat) (gz : G Z) (go : G Op) :=
  match sz with
  | 0%nat => liftGen Leaf gz
  | S sz' => freq [ (1%nat, liftGen Leaf gz)
                  ; (sz, liftGen3 Node (genAExp sz' gz go) go (genAExp sz' gz go))
                  ]
  end.

Sample (genAExp 3 (choose(0,10)) genOp).

(*2*)

Fixpoint aeval (a : aexp) : Z :=
    match a with
    | Leaf n => n
    | Node L P R  => aeval L + aeval R
    | Node L M R  => aeval L - aeval R
    | Node L MM R => aeval L * aeval R
end.

Module TreeNotations.
Notation "( L ; + ; R )" := (Node L P R).
Notation "( L ; - ; R )" := (Node L M R).
Notation "( L ; * ; R )" := (Node L MM R).
Notation "« x »" := (Leaf x).
End TreeNotations.

Import TreeNotations.

Module ListNotations.
Notation "[ ]" := nil (format "[ ]") : list_scope.
Notation "[ x ]" := (cons x nil) : list_scope.
Notation "[ x ; y ; .. ; z ]" := (cons x (cons y .. (cons z nil) ..)) : list_scope.
End ListNotations.

Import ListNotations.

(*3*)

Eval compute in (2*3)+(3*(4-2)).

Eval compute in aeval ((«2»;*;«3»);+;(«3»;*;(«4»;-;«2»))).

Eval compute in (20-40)*(30+(1*1)).

Eval compute in aeval ((«20»;-;«40»);*;(«30»;+;(«1»;*;«1»))).

(*4*)

Fixpoint aevalR (a : aexp) (n : Z) : Prop :=
  match a with
  | Leaf z => z = n
  | Node a1 op a2 =>
      match op with
      | P =>
          exists (n1 n2: Z),  aevalR a1 n1 /\ aevalR a2 n2 /\ n1 + n2 = n
      | M =>
          exists (n1 n2: Z),  aevalR a1 n1 /\ aevalR a2 n2 /\ n1 - n2 = n
      | MM =>
          exists (n1 n2: Z),  aevalR a1 n1 /\ aevalR a2 n2 /\ n1 * n2 = n
     end
  end.

(*5*)

Theorem RelEqFun : forall (a : aexp) (n : Z),
                    (aevalR a n) <-> (aeval a = n).
Proof.
  induction a.
  - simpl. intros. reflexivity.
  - red. intros. induction o.
    + split.
      * simpl. intros.
        destruct H as [n1 H].
        destruct H as [n2 H].
        destruct H. destruct H0.
        assert (IHa1 := (IHa1 n1)).
        assert (IHa2 := (IHa2 n2)).
        unfold iff in IHa1; destruct IHa1; clear H3.
        unfold iff in IHa2; destruct IHa2; clear H4.
        assert (H5 := (H2 H)).
        assert (H6 := (H3 H0)).
        rewrite H5; rewrite H6.
        assumption.
      * simpl. intros.
        assert (IHa1 := (IHa1 (aeval a1))).
        assert (IHa2 := (IHa2 (aeval a2))).
        unfold iff in IHa1; destruct IHa1; clear H0.
        unfold iff in IHa2; destruct IHa2; clear H0.
        exists (aeval a1); exists (aeval a2).
        auto 4.
(*______________________________________________________________________________________________________________*)
    + split.
      * simpl. intros.
        destruct H as [n1 H];destruct H as [n2 H];destruct H; destruct H0.
        assert (IHa1 := (IHa1 n1));assert (IHa2 := (IHa2 n2)).
        unfold iff in IHa1; destruct IHa1; clear H3.
        unfold iff in IHa2; destruct IHa2; clear H4.
        assert (H5 := (H2 H));assert (H6 := (H3 H0)).
        rewrite H5; rewrite H6;assumption.
      * simpl. intros.
        assert (IHa1 := (IHa1 (aeval a1)));assert (IHa2 := (IHa2 (aeval a2))).
        unfold iff in IHa1; destruct IHa1; clear H0;unfold iff in IHa2; destruct IHa2; clear H0.
        eauto 7.
    + split.
      * simpl. intros.
        destruct H as [n1 H];destruct H as [n2 H];destruct H; destruct H0.
        assert (IHa1 := (IHa1 n1));assert (IHa2 := (IHa2 n2)).
        unfold iff in IHa1; destruct IHa1; clear H3.
        unfold iff in IHa2; destruct IHa2; clear H4.
        assert (H5 := (H2 H));assert (H6 := (H3 H0)).
        rewrite H5; rewrite H6;assumption.
      * simpl. intros.
        assert (IHa1 := (IHa1 (aeval a1)));assert (IHa2 := (IHa2 (aeval a2))).
        unfold iff in IHa1; destruct IHa1; clear H0;unfold iff in IHa2; destruct IHa2; clear H0.
        eauto 7.
Qed.

(****Maquina de Stack****)
Let stack     := list Z.

Inductive Exp : Type :=
  | Num   : Z -> Exp
  | Pls   : Exp
  | Min   : Exp
  | Mul   : Exp.

Definition stack_exp := list Exp.

Definition SPush (n : Z) (st : stack) : stack :=
  cons n st.

Definition SPlus (st : stack) : option stack :=
  match st with
    | nil => None
    | cons a nil => None
    | cons a (cons b c) => Some (cons (b+a) c)
  end.

Definition SMinus (st : stack) : option stack :=
  match st with
    | nil => None
    | cons a nil => None
    | cons a (cons b c) => Some (cons (b-a) c)
  end.

Definition SMult (st : stack) : option stack :=
  match st with
    | nil => None
    | cons a nil => None
    | cons a (cons b c) => Some (cons (b*a) c)
  end.

(*1*)
Fixpoint execute (s : stack) (a : stack_exp) : option stack :=
  match a with
  | nil => Some s
  | cons (Num n) a' => execute (SPush n s) a'
  | cons Pls a'     =>
      match SPlus s with
      | Some s' => execute s' a'
      | None => None
      end
  | cons Min a'     =>
      match SMinus s with
      | Some s' => execute s' a'
      | None => None
      end
  | cons Mul a'     =>
      match SMult s with
      | Some s' => execute s' a'
      | None => None
      end
  end.

Fixpoint stack_eq (st1 st2 : stack) : bool :=
  match st1, st2 with
  | nil, nil => true
  | cons z1 st1', cons z2 st2' => Zeq_bool z1 z2 && stack_eq st1' st2'
  | _, _ => false
  end.

Definition option_stack_eq (o1 o2 : option stack) : bool :=
  match o1, o2 with
  | None, None => true
  | Some st1, Some st2 => stack_eq st1 st2
  | _, _ => false
  end.

(*2*)

Let stack_machine : stack := nil.

Let expression    : stack_exp  := [Num 2; Num 3; Mul; Num 3; Num 4; Num 2; Min; Mul; Pls].

Eval compute in execute stack_machine expression.

(*3*)

(*
    Decidimos usar o option para saber se houve problema.
    *)

(****Compilador****)
Open Scope list.
Fixpoint compile (a : aexp) : stack_exp :=
  match a with
  | Leaf z => cons (Num z) nil
  | Node l P r => compile l ++ compile r ++ cons Pls nil
  | Node l M r => compile l ++ compile r ++ cons Min nil
  | Node l MM r => compile l ++ compile r ++ cons Mul nil
  end.

Definition Correction' (a : aexp) :=
  option_stack_eq (execute nil (compile a)) (Some (cons (aeval a) nil)).

Check forAll.
Sample (genAExp 3 (choose(0,10)) genOp).
QuickChick (forAll (genAExp 3 (choose(0,10)) genOp) Correction').

(*2*)

Eval compute in execute nil (compile ((«2»;*;«3»);+;(«3»;*;(«4»;-;«2»)))).

(*3*)

Lemma Dinamic_Execute (z : Z) (se1 se2 : stack_exp):
  forall (st st1 : stack),
    execute st se1 = Some (z :: nil) ->
    execute (st ++ st1) (se1 ++ se2) = execute (z :: st1) se2.
Proof.
  induction se1.
  - simpl.
    intros.
    inversion H.
    simpl.
    reflexivity.
  - induction a.
    + simpl.
      intros.
      apply (IHse1 (z0 :: st) st1).
      assumption.
    + induction st.
      * intros.
        simpl in H.
        inversion H.
      * induction st.
        -- intros.
           simpl in H.
           inversion H.
        -- simpl.
           intros.
           apply (IHse1 ((a0 + a) :: st) st1).
           assumption.
    + induction st.
      * intros.
        simpl in H.
        inversion H.
      * induction st.
        -- intros.
           simpl in H.
           inversion H.
        -- simpl.
           intros.
           apply (IHse1 ((a0 - a) :: st) st1).
           assumption.
    + induction st.
      * intros.
        simpl in H.
        inversion H.
      * induction st.
        -- intros.
           simpl in H.
           inversion H.
        -- simpl.
           intros.
           apply (IHse1 ((a0 * a) :: st) st1).
           assumption.
Qed.

Theorem Correction : forall (a : aexp),
                     (execute nil (compile a) = Some (cons (aeval a) nil)).
Proof.
  intros.
  induction a.
  - simpl. reflexivity.
  - induction o.
    + simpl.
      assert (H := ((Dinamic_Execute (aeval a1) (compile a1) (compile a2 ++ Pls :: nil) nil nil) IHa1)); rewrite <- (app_nil_end nil) in H.
      assert (H1 := ((Dinamic_Execute (aeval a2) (compile a2) (Pls :: nil) nil (aeval a1 :: nil)) IHa2)); simpl in H1.
      rewrite H.
      rewrite H1.
      reflexivity.
(*______________________________________________________________________________________________________________*)
    + simpl.
      assert (H := ((Dinamic_Execute (aeval a1) (compile a1) (compile a2 ++ Min :: nil) nil nil) IHa1)); rewrite <- (app_nil_end nil) in H.
      assert (H1 := ((Dinamic_Execute (aeval a2) (compile a2) (Min :: nil) nil (aeval a1 :: nil)) IHa2)); simpl in H1.
      rewrite H; rewrite H1; reflexivity.
    + simpl.
      assert (H := ((Dinamic_Execute (aeval a1) (compile a1) (compile a2 ++ Mul :: nil) nil nil) IHa1)); rewrite <- (app_nil_end nil) in H.
      assert (H1 := ((Dinamic_Execute (aeval a2) (compile a2) (Mul :: nil) nil (aeval a1 :: nil)) IHa2)); simpl in H1.
      rewrite H; rewrite H1; 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 => monday
      | saturday => monday
      | sunday => monday
    end.

Eval compute in (next_weekday friday).

Eval compute in (next_weekday (next_weekday saturday)).

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

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

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

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

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

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

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

Check true.

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

Check (negb true).

Eval compute in (negb true).

Check negb.

Module Playground1.

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

Check O.

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

End Playground1.

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

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

Eval compute in (minustwo 3).

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

Eval compute in (minustwo (S (S O))).
Eval compute in (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 (S O)) = true.
Proof. reflexivity. Qed.
Example test_oddb2: (oddb (S (S (S (S O))))) = false.
Proof. reflexivity. Qed.

Module Playground2.

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

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

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

Eval compute in (mult 3 3).

Fixpoint minus (n m: nat) : nat :=
  match n, m with
    | 0, _ => 0
    | S _ , 0 => 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.

Check ((0 +1) + 1).

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

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

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

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

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

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

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

Theorem plus_1_l : forall n:nat, 1 + n = S 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_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.

Inductive bin : Type :=
  | zero : bin
  | twice : bin -> bin
  | twice_plus_one : bin -> bin.

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

Fixpoint bin_to_nat (n:bin) : nat :=
  match n with
    | zero => O
    | twice x => twice_nat (bin_to_nat x)
    | twice_plus_one x => S (twice_nat (bin_to_nat x))
end.

Fixpoint incr (n:bin) : bin :=
    match n with
      | zero => twice_plus_one zero
      | twice x => twice_plus_one x
      | twice_plus_one x => twice (incr x)
    end.

Example test_bin_incr1: (bin_to_nat(incr zero)) = (S O).
Proof.
reflexivity.
Qed.

Fixpoint leb (n m : nat) : bool :=
  match n with
  | O => true
  | S n' =>
      match m with
      | O => false
      | S m' => leb n' m'
      end
  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 test : nat := 3.
Check test.

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

Theorem mult_0_plus : forall n m : nat,
  (0 + n) * m = n * m.
Proof.
  intros n m.
  rewrite -> plus_O_n.
  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.


Inductive bool : Type :=
  | true
  | false.

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.

(* Complete specification for orb; a truth table *)
Example test_orb1: (orb true false) = true.
Proof. simpl. reflexivity. Qed.
Example test_orb2: (orb false true) = true.
Proof. simpl. reflexivity. Qed.
Example test_orb3: (orb true true) = true.
Proof. simpl. reflexivity. Qed.
Example test_orb4: (orb false false) = false.
Proof. simpl. reflexivity. Qed.

(* Complete specification for andb *)
Example test_andb1: (andb true false) = false.
Proof. simpl. reflexivity. Qed.
Example test_andb2: (andb false true) = false.
Proof. simpl. reflexivity. Qed.
Example test_andb3: (andb false false) = false.
Proof. simpl. reflexivity. Qed.
Example test_andb4: (andb true true) = true.
Proof. simpl. reflexivity. Qed.

(* Introducing infix notation via [Notation] *)
Notation "x && y" := (andb x y).
Notation "x || y" := (orb x y).

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

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

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

(* Exercise: andb3 *)
Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool :=
  match b1 with
  | true => (andb b2 b3)
  | false => false
  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.


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.

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

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

Notation "x <=? y" := (leb x y) (at level 70) : nat_scope.

Definition ltb (n m : nat) : bool :=
	match n <=? m with
	| false => false
	| true => negb(m <=? n)
	end.

Example test_ltb1: (ltb 2 2) = false.
Proof.
reflexivity.
Qed.

Example test_ltb2: (ltb 2 4) = true.
Proof.
reflexivity.
Qed.

Example test_ltb3: (ltb 4 2) = false.
Proof.
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.
rewrite -> H.
intros I.
rewrite -> I.
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 zero_nbeq_plus_1 : forall n : nat,
  beq_nat 0 (n + 1) = false.
Proof.
intros n.
destruct n as [ | 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.
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.
	(* case b = true *)
	rewrite H.
	rewrite H.
	simpl.
	reflexivity.
	(* case b = false *)
	rewrite H.
	rewrite H.
	simpl.
	reflexivity.
Qed.


From LF Require Export Induction.
Module NatList.
    Inductive natprod : Type :=
        | pair (n1 n2 : nat).

    Check (pair 3 5) : natprod.

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

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

    Compute (fst (pair 3 5)).

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

    Compute (fst (3, 5)).

    Definition fst' (p : natprod) : nat :=
        match p with
        | (x, _) => x
        end.

    Definition snd' (p : natprod) : nat :=
        match p with
        | (_, y) => y
        end.

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

    Theorem surjective_pairing' : forall n m : nat,
        (n, m) = (fst (n, m), snd (n, m)).
    Proof.
        reflexivity.
    Qed.

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

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

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

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

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

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

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

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

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

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

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

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

    Fixpoint nonzeros (l : natlist) : natlist :=
        match l with
        | nil => nil
        | 0 :: t => nonzeros t
        | h :: t => h :: (nonzeros t)
        end.

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

    Fixpoint oddmembers (l:natlist) : natlist :=
        match l with
        | nil => nil
        | h :: t => let
            t' := oddmembers t
            in if odd h then h :: t' else t'
        end.

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

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

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

    Fixpoint alternate (l1 l2 : natlist) : natlist :=
        match l1, l2 with
        | nil, l2' => l2'
        | l1', nil => l1'
        | h1 :: t1, h2 :: t2 => h1 :: h2 :: (alternate t1 t2)
        end.

    Example test_alternate1: alternate [1;2;3] [4;5;6] = [1;4;2;5;3;6].
    Proof. reflexivity. Qed.
    Example test_alternate2: alternate [1] [4;5;6] = [1;4;5;6].
    Proof. reflexivity. Qed.
    Example test_alternate3: alternate [1;2;3] [4] = [1;4;2;3].
    Proof. reflexivity. Qed.
    Example test_alternate4: alternate [] [20;30] = [20;30].
    Proof. reflexivity. Qed.

    Definition bag := natlist.

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

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

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

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

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

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

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

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

    (* Exercise: 3starts, standard, optional (bag_more_functions)

    Here are some more bag functions for you to practice with.

    When remove_one is applied to a bag without the number to remove, it should
    return the same bag unchanged. (This exercise is optional, but students
    following the advanced track will need to fill in the definition of remove_one
    for a later exercise.)

    *)

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

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

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

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

    Fixpoint subset (s1 : bag) (s2 : bag) : bool :=
        match s1, s2 with
        | nil, _ => true
        | _, nil => false
        | h :: t, s2' => (member h s2') && subset t (remove_one h s2')
        end.

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

    (* Exercise: 2 stars, standard especially useful (add_inc_count)

    Adding a value to a bag should increase the value's count by one.
    State that as a theorem and prove it.
    *)

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

    Theorem bag_add_inc_count : forall v : nat, forall b : bag,
        count v (add v b) = S (count v b).
    Proof.
        intros v b.
        destruct b as [|bh' bt'].
        - simpl. rewrite -> eq_refl. reflexivity.
        - simpl. rewrite -> eq_refl. reflexivity.
    Qed.

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

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

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

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

    (* Exercise: 3 stars, standard (list_exercises)

    More practice with lists:
    *)

    Theorem app_nil_r : forall l : natlist,
        l ++ [] = l.
    Proof.
        intros l. induction l as [|lh' lt' IHl'].
        - reflexivity.
        - simpl. rewrite -> IHl'. reflexivity.
    Qed.

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

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

    Theorem rev_involutive : forall l : natlist,
        rev (rev l) = l.
    Proof.
        intros l. induction l as [|lh lt IHl'].
        - reflexivity.
        - (* l = cons lh lt *)
            simpl.
            rewrite -> rev_app_distr.
            rewrite -> IHl'.
            reflexivity.
    Qed.

    (* There is a short solution to the next one. If you find yourself
       getting tangled up, step back and try to look for a simpler way.
    *)

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

    (* An exercise about your implementation of nonzeros: *)

    Lemma nonzeros_app: forall l1 l2 : natlist,
        nonzeros (l1 ++ l2) = (nonzeros l1) ++ (nonzeros l2).
    Proof.
        intros l1 l2. induction l1 as [|l1h l1t IHl1'].
        - reflexivity.
        - induction l1h as [|l1h' IHl1h'].
            -- simpl. rewrite -> IHl1'. reflexivity.
            -- simpl. rewrite -> IHl1'. reflexivity.
    Qed.

    (* Exercise: 2 stars, standard (eqblist)

    Fill in the definition of eqblist, which compares lists of numbers
    for equality. Prove that eqblist l l yields true for every list l.

    *)

    Fixpoint eqblist (l1 l2 : natlist) : bool :=
        match l1, l2 with
        | nil, nil => true
        | h1 :: t1, h2 :: t2 => (h1 =? h2) && eqblist t1 t2
        | _, _ => false
        end.

    Example test_eqblist1 : (eqblist nil nil = true).
    Proof. reflexivity. Qed.
    Example test_eqblist2 : eqblist [1;2;3] [1;2;3] = true.
    Proof. reflexivity. Qed.
    Example test_eqblist3 : eqblist [1;2;3] [1;2;4] = false.
    Proof. reflexivity. Qed.

    Theorem eqblist_refl : forall l:natlist,
        eqblist l l = true.
    Proof.
        intros l. induction l as [|h t IHl'].
        - reflexivity.
        - simpl. rewrite -> IHl'. rewrite -> eq_refl. reflexivity.
    Qed.

    (* Exercise: 1 star, standard (count_member_nonzero) *)

    Theorem count_member_nonzero: forall s : bag,
        1 <=? (count 1 (1 :: s)) = true.
    Proof.
        intros s. induction s as [|h t IHs'].
        - reflexivity.
        - simpl. reflexivity.
    Qed.

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

    (* Exercise: 3 stars, advanced (remove_does_not_increase_count) *)

    Theorem remove_does_not_increase_count: forall s : bag,
       (count 0 (remove_one 0 s)) <=? (count 0 s) = true.
    Proof.
        intros s. induction s as [|h t IHs'].
        - reflexivity.
        - simpl. induction h as [|h' IHh'].
            -- simpl. rewrite -> leb_n_Sn. reflexivity.
            -- simpl. rewrite -> IHs'. reflexivity.
    Qed.

    (* Exercise: 3 stars, standard, optional (bag_count_sum)

    Write down an interesting theorem bag_count_sum about bags involving
    the functions count and sum, and prove it using Coq. (You may find that
    the difficulty of the proof depends on how you defined count! Hint: If
    you defined count using =? you may find it useful to know that destruct
    works on arbitrary expressions, not just simple identifiers.)
    *)

    Theorem bag_count_sum: forall n : nat, forall b1 b2: bag,
        count n b1 + count n b2 = count n (sum b1 b2).
    Proof.
        intros n b1 b2. induction b1 as [|b1h b1t IHb1].
        - reflexivity.
        - simpl. destruct (b1h =? n) as [].
            -- simpl. rewrite -> IHb1. reflexivity.
            -- rewrite -> IHb1. reflexivity.
    Qed.

    (* Exercise: 4 stars, advanced (rev_injective)

    Prove that the rev function is injective. There is a hard way and an easy
    way to do this.
    *)

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

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

    Fixpoint nth_error (l : natlist) (n : nat) : natoption :=
        match l, n with
        | nil, _ => None
        | a :: _, 0 => Some a
        | _ :: l', S n' => nth_error l' n'
        end.

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

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

    (* Exercise: 2 stars, standard (hd_error)

    Using the same idea, fix the hd function from earlier so we
    don't have to pass a default element for the nil case.
    *)

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

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

    (* Exercise: 1 star, standard, optional (option_elim_hd)

    This exercise relates your new hd_error to the old hd.
    *)

    Theorem option_elim_hd: forall (l : natlist) (default : nat),
        hd default l = option_elim default (hd_error l).
    Proof.
        intros l d. destruct l as [].
        - reflexivity.
        - reflexivity.
    Qed.
End NatList.

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

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

(* Exercise: 1 star standard (eqb_id_refl) *)

Theorem eqb_id_refl: forall x: id,
    eqb_id x x = true.
Proof.
    intros x. destruct x. simpl. rewrite -> NatList.eq_refl. reflexivity.
Qed.

Module PartialMap.
    Export NatList.

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

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

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

    (* Exercise: 1 star, standard (update_eq) *)

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

    (* Exercise: 1 star, standard (update-neq) *)

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


(** * Multiset:  Insertion sort with multisets *)

(** We have seen how to specify algorithms on "collections", such as
    sorting algorithms, using permutations.  Instead of using
    permutations, another way to specify these algorithms is to use
    multisets.  A _set_ of values is like a list with no repeats where
    the order does not matter.  A _multiset_ is like a list, possibly
    with repeats, where the order does not matter.  One simple
    representation of a multiset is a function from values to [nat]. *)

Require Import Perm.
Require Import Sort.
Require Export FunctionalExtensionality.

(** In this chapter we will be using natural numbers for two different
    purposes: the values in the lists that we sort, and the
    multiplicity (number of times occurring) of those values.  To keep
    things straight, we'll use the [value] type for values, and [nat]
    for multiplicities. *)

Definition value := nat.

Definition multiset := value -> nat.

(** Just like sets, multisets have operators for [union], for the
    [empty] multiset, and the multiset with just a single element. *)

Definition empty : multiset :=
   fun x => 0.

Definition union (a b : multiset) : multiset :=
   fun x => a x + b x.

Definition singleton (v: value) : multiset :=
   fun x => if x =? v then 1 else 0.

(** **** Exercise: 1 star (union_assoc)  *)
(** Since multisets are represented as functions, to prove that one
    multiset equals another we must use the axiom of functional
    extensionality. *)

Lemma union_assoc: forall a b c : multiset, (* assoc stands for "associative" *)
   union a (union b c) = union (union a b) c.
Proof.
  intros.
  extensionality x.
(* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 1 star (union_comm)  *)
Lemma union_comm: forall a b : multiset,  (* comm stands for "commutative" *)
   union a b = union b a.
Proof.
(* FILL IN HERE *) Admitted.
(** [] *)

(** Remark on efficiency:  These multisets aren't very efficient.  If
  you wrote programs with them, the programs would run slowly. However,
  we're using them for _specifications_, not for _programs_.  Our
  multisets built with [union] and [singleton] will never really
  _execute_ on any large-scale inputs; they're only used in the proof
  of correctness of algorithms such as [sort].  Therefore, their
  inefficiency is not a problem. *)

(** Contents of a list, as a multiset: *)

Fixpoint contents (al: list value) : multiset :=
  match al with
  | a :: bl => union (singleton a) (contents bl)
  | nil => empty
  end.

(** Recall the insertion-sort program from [Sort.v].  Note that it
    handles lists with repeated elements just fine. *)

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

Example sort_pi_same_contents:
    contents (sort [3;1;4;1;5;9;2;6;5;3;5]) = contents [3;1;4;1;5;9;2;6;5;3;5].
Proof.
extensionality x.
do 10 (destruct x; try reflexivity).
  (* Why does this work? Try it step by step, without [do 10] *)
Qed.

(* ################################################################# *)
(** * Correctness *)

(** A sorting algorithm must rearrange the elements into a list that
    is totally ordered.  But let's say that a different way: the
    algorithm must produce a list _with the same multiset of values_,
    and this list must be totally ordered. *)

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

(** **** Exercise: 3 stars (insert_contents)  *)
(** First, prove the auxiliary lemma [insert_contents], which will be
    useful for proving [sort_contents] below.  Your proof will be by
    induction.  You do not need to use [extensionality]. *)

Lemma insert_contents: forall x l, contents (x::l) = contents (insert x l).
Proof.
(* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars (sort_contents)  *)
(** Now prove that sort preserves contents. *)

Theorem sort_contents: forall l, contents l = contents (sort l).
(* FILL IN HERE *) Admitted.
(** [] *)

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

Theorem insertion_sort_correct:
  is_a_sorting_algorithm' sort.
Proof.
split. apply sort_contents. apply sort_sorted.
Qed.

(** **** Exercise: 1 star (permutations_vs_multiset)  *)
(** Compare your proofs of [insert_perm, sort_perm] with your proofs
    of [insert_contents, sort_contents].  Which proofs are simpler?

      - [ ] easier with permutations,
      - [ ] easier with multisets
      - [ ] about the same.

   Regardless of "difficulty", which do you prefer / find easier to
   think about?
      - [ ] permutations or
      - [ ] multisets

   Put an X in one box in each list. *)
(** [] *)

(* ################################################################# *)
(** * Permutations and multisets *)

(** The two specifications of insertion sort are equivalent.  One
    reason is that permutations and multisets are closely related.
    We're going to prove:

       [Permutation al bl <-> contents al = contents bl.] *)

(** **** Exercise: 3 stars  *)
(** The forward direction is easy, by induction on the evidence for
    [Permutation]: *)

Lemma perm_contents:
  forall al bl : list nat,
   Permutation al bl -> contents al = contents bl.
(* FILL IN HERE *) Admitted.
(** [] *)

(** The other direction,
    [contents al = contents bl -> Permutation al bl],
    is surprisingly difficult.  (Or maybe there's an easy way
    that I didn't find.) *)

Fixpoint list_delete (al: list value) (v: value) :=
  match al with
  | x::bl => if x =? v then bl else x :: list_delete bl v
  | nil => nil
  end.

Definition multiset_delete (m: multiset) (v: value) :=
   fun x => if x =? v then pred(m x) else m x.

(** **** Exercise: 3 stars (delete_contents)  *)
Lemma delete_contents:
  forall v al,
   contents (list_delete al v) = multiset_delete (contents al) v.
Proof.
  intros.
  extensionality x.
  induction al.
  simpl. unfold empty, multiset_delete.
  bdestruct (x =? v); auto.
  simpl.
  bdestruct (a =? v).
  (* FILL IN HERE *) Admitted.

(** **** Exercise: 2 stars (contents_perm_aux)  *)
Lemma contents_perm_aux:
 forall v b, empty = union (singleton v) b -> False.
Proof.
(* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars (contents_in)  *)
Lemma contents_in:
  forall (a: value) (bl: list value) , contents bl a > 0 -> In a bl.
Proof.
(* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars (in_perm_delete)  *)
Lemma in_perm_delete:
  forall a bl,
  In a bl -> Permutation (a :: list_delete bl a) bl.
Proof.
(* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 4 stars (contents_perm)  *)
Lemma contents_perm:
 forall al bl, contents al = contents bl -> Permutation al bl.
Proof.
  induction al; destruct bl; intro.
  auto.
  simpl in H.
  contradiction (contents_perm_aux _ _ H).
  simpl in H. symmetry in H.
  contradiction (contents_perm_aux _ _ H).
  specialize (IHal (list_delete (v :: bl) a)).
  remember (v::bl) as cl.
  clear v bl Heqcl.

  (** From this point on, you don't need induction.
    Use the lemmas [perm_trans], [delete_contents],
     [in_perm_delete], [contents_in].   At _certain points_
     you'll need to unfold the definitions of
     [multiset_delete], [union], [singleton]. *)

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

(* ################################################################# *)
(** * The main theorem: equivalence of multisets and permutations *)
Theorem same_contents_iff_perm:
  forall al bl, contents al = contents bl <-> Permutation al bl.
Proof.
  intros. split. apply contents_perm. apply perm_contents.
Qed.

(** Therefore, it doesn't matter whether you prove your sorting
    algorithm using the Permutations method or the multiset method. *)

Corollary sort_specifications_equivalent:
    forall sort, is_a_sorting_algorithm sort <->  is_a_sorting_algorithm' sort.
Proof.
  unfold is_a_sorting_algorithm, is_a_sorting_algorithm'.
  split; intros;
  destruct (H al); split; auto;
  apply same_contents_iff_perm; auto.
Qed.


Require Import Arith.

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

Lemma sum_odd_n_p : forall (n:nat), sum_odd_n (n:nat) = n*n.
  induction n.
  simpl. reflexivity.
  simpl. rewrite IHn. ring.
Qed.

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

Compute sum_n 3.
Search mult.
(*
Nat.mul_succ_r: forall n m : nat, n * S m = n * m + n
Nat.mul_succ_l: forall n m : nat, S n * m = n * m + m
 *)

Lemma sum_n_helper : forall n : nat,
  2 * sum_n (S n) = 2 * (S n) + 2 * sum_n n.
Proof.
  intros n. simpl. ring.
Qed.

Theorem sum_n_formula : forall n, 2 * sum_n n = (n*(n+1)).
Proof.
  intros n.
  induction n as [| k IH].
  - (* base case n = 0 *)
    simpl. reflexivity.
  - (* inductive case *)
    rewrite -> sum_n_helper.
    rewrite IH.
    ring.
Qed.

Lemma div_helper : forall a b c : nat,
  c <> 0 -> c * a = b -> a = b / c.
Proof.
  intros a b c neq eq.
  rewrite <- eq.
  rewrite Nat.mul_comm.
  rewrite Nat.div_mul.
  trivial.
  assumption.
Qed.

(* need to figure out how to do this without the ring tactic. *)
(*Require Import QArith.*)

Theorem sum_n_formula2 : forall n : nat , sum_n n = (n * (n+1)/2)%nat .
Proof.
  intros n.
  apply div_helper.
  - discriminate.
  - rewrite sum_n_formula.
    simpl. reflexivity.
Qed.

Theorem plus_comm: forall a b,
    a+b = b+a.
Proof.
  intros a b. ring.
Qed.

Theorem foil : forall a b c d,
    (a+b) * (c+d) = a*c+b*c + a*d + b*d.
Proof.
  intros a b c d. ring.
Qed.

Require Import ZArith.
Open Scope Z_scope.

Theorem sub_add_1 : forall a :Z, a -1 + 1 = a.
Proof.
  intros a. ring.
Qed.

Close Scope Z_scope.

Require Import Field.
Require Import Qcanon.
Open Scope Qc_scope.

Theorem frac_qc: forall x y z : Qc, z<> 0 -> (x+y)/z = x/z + y/z.
Proof.
  intros x y z z_not_0.
  field. assumption.
Qed.

Close Scope Qc_scope.
(*
Module RealExample.

  Require Import Reals.
  Open Scope R_scope.

  Theorem frac_r : forall x y z, z<>0 -> (x+y) / z = x/z + y/z.
  Proof.
    intros x y z z_not_0.
    field. assumption.
  Qed.

  Close Scope R_scope.
End RealExample.
*)
(*
Open Scope R_scope.

Theorem *)
Search (_:N N _:N).
Compute Nat.pow 2 O.

Fixpoint pow_series_2_n (k: nat) : nat :=
  match k with
    O => O
  | S p => (Nat.pow 2 p) + (pow_series_2_n p)
  end.

Compute pow_series_2_n 2.
Compute O + O.

Theorem sum_2_pow_n: forall n:


(* Taken from Logical Foundatins *)

Inductive even : nat -> Prop :=
| even_O : even 0
| even_S n (H : even n) : even (S (S n)).

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

Fact even_double n :
  even (double n).
Proof.
  induction n as [|n IH]; cbn.
  - exact even_O.
  - now apply even_S.
Qed.

Theorem even_correct n :
  even n <-> exists k, n = double k.
Proof.
  split.
  - intros H. induction H as [|n H [k IH]].
    + now exists 0.
    + exists (S k). cbn. now rewrite IH.
  - intros [k H]. rewrite H. now apply even_double.
Qed.

Theorem even_sum n m :
  even n -> even m -> even (n + m).
Proof.
  intros H1 H2.
  induction H1 as [|n _ IH]; cbn.
  - exact H2.
  - now apply even_S.
Qed.

Theorem not_even_S n :
  even n -> ~ even (S n).
Proof.
  induction n as [|n IH]; cbn.
  - intros H1 H2. inversion H2.
  - intros H1 H2. contradict H1. apply IH. now inversion H2.
Qed.

Theorem even_inv n :
  even (S (S n)) -> even n.
Proof.
  intros H. now inversion H.
Qed.

Theorem even_sum_inv n m :
  even (n + m) -> even n -> even m.
Proof.
  intros H H1.
  induction H1 as [|n H1 IH].
  - now cbn in H.
  - apply even_inv in H. now apply IH.
Qed.


Require Export ct16.

Section DivConq.

Variable A : Type.
Variable le: A -> A -> Prop.
Variable le_dec: forall (x y: A), {le x y} + {~le x y}.
Implicit Type l : list A.

(* split_pivot:=
 * takes an input term as pivot and list l and split into two sublists where the
 * first sublist contains all element/s that is/are le_dec _ pivot and the
 * second sublist contains the rest of the element/s.
 *)

Fixpoint split_pivot (pivot : A) l : list A * list A :=
  match l with
  | nil => (nil, nil)
  | a :: l' => let (l1, l2) := (split_pivot pivot l') in
    if le_dec a pivot
    then (a :: l1, l2) else (l1, a :: l2)
  end.

(* split_pivot_wf:
 * states that for any list ls, each of the sublists generated has length less
 * than or equal to its original list's.
 *)

Lemma split_pivot_wf1 : forall a l, length (fst (split_pivot a l)) <= length l.
Proof.
induction l; simpl; auto; destruct (le_dec a0 a); destruct (split_pivot a l);
simpl in *; auto; apply le_n_S; auto.
Defined.

Lemma split_pivot_wf2 : forall a l, length (snd (split_pivot a l)) <= length l.
Proof.
induction l; simpl; auto; destruct (le_dec a0 a); destruct (split_pivot a l);
simpl in *; auto; apply le_n_S; auto.
Defined.

(* div_conq_pivot:
 * - another variation of div_conq_split, just that for this, it will use
 *   split_pivot instead.
 * - To prove some proposition P holds for all lists ls, one needs to prove the
 *   following:
 *   1. P holds for empty list, nil.
 *   2. If P hold fst(split_pivot a l) and snd(split_pivot a l), then P must
 *      also hold for (a :: l).
 *)

Theorem div_conq_pivot :
  forall (P : list A -> Type),
    P nil
    -> (forall a l, P (fst (split_pivot a l)) -> P (snd (split_pivot a l))
      -> P (a :: l))
    -> forall l, P l.
Proof.
intros; eapply well_founded_induction_type. eapply lengthOrder_wf.
destruct x; intros; auto; apply X0; apply X1; apply le_lt_n_Sm.
apply split_pivot_wf1. apply split_pivot_wf2.
Defined.

Hypothesis notle_le: forall x y, ~ le x y -> le y x.

(* Forall_snd_split_pivot:
 * le a x for every element, x, in snd(split_pivot a l).
 *)

Lemma Forall_snd_split_pivot : forall a l, Forall (le a) (snd(split_pivot a l)).
Proof.
induction l; simpl; auto; destruct (le_dec a0 a); destruct (split_pivot a l);
simpl in *; auto.
Defined.

End DivConq.

Ltac div_conq_pivot := eapply div_conq_pivot.


(* boolean implementation and theorems.*)

(* A value of type bool is one of a finite set of elements: either true or false.*)
Inductive bool : Type :=
  | true : bool
  | false : bool.

(* NOTE: functions here are named as <function>b; the b is used to indicate
    that it is a boolean function.*)

(* negb defines the negation of a boolean value.*)
Definition negb (b:bool) : bool :=
  match b with
    | true => false
    | false => true
  end.

Example test_negb_true: (negb true) = false.
Proof. simpl. reflexivity. Qed.
Example test_negb_false: (negb false) = true.
Proof. simpl. reflexivity. Qed.

(*
Boolean "and".

Given two boolean values, a and b, andb returns true if both are true
or false otherwise.

Theorem:
  If a is true, the result of andb depends on the value of a; returning the
  value of b means that if b is true, andb returns true.

  Otherwise, if a is false, there is no way for andb to return true.
*)
Definition andb (a:bool) (b:bool) : bool :=
  match a with
    | true => b
    | false => false
  end.

Example test_andb_ff: (andb false false) = false.
Proof. simpl. reflexivity. Qed.
Example test_andb_ft: (andb false true) = false.
Proof. simpl. reflexivity. Qed.
Example test_andb_tf: (andb true false) = false.
Proof. simpl. reflexivity. Qed.
Example test_andb_tt: (andb true true) = true.
Proof. simpl. reflexivity. Qed.

(*
Boolean "or".

Given two boolean values, a and b, orb returns true if either value is true
or false otherwise.

Theorem:
  If a is true, then orb is true and no further evaluation needs to be done.

  Otherwise, if a is false, the value of the or is dependent on b: if b is
  false, the outcome is false as this implies both a and b are false. Otherwise,
  the outcome is true.
*)

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

Example test_orb_ff: (orb false false) = false.
Proof. reflexivity. Qed.
Example test_orb_ft: (orb false true) = true.
Proof. reflexivity. Qed.
Example test_orb_tf: (orb true false) = true.
Proof. reflexivity. Qed.
Example test_orb_tt: (orb true true) = true.
Proof. reflexivity. Qed.

(*
Exercise: 1 star (nandb)
Complete the definition of the following function, then make sure that the
Example assertions below can each be verified by Coq.
 *)
Definition nandb (b1:bool) (b2:bool) : bool :=
  match b1 with
    | false => true
    | true => negb b2
  end.

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

(*
Do the same for the andb3 function below. This function should return true
when all of its inputs are true, and false otherwise.
 *)
Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool :=
  (andb (andb b1 b2) b3).

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

(* proving the involution of the boolean negation *)
Theorem negb_involutive : forall b : bool,
  negb (negb b) = b.
Proof.
  intros b. destruct b.
  reflexivity. reflexivity.
Qed.

(*
Exercise: 2 stars (boolean functions)
Use the tactics you have learned so far to prove the following theorem about boolean
functions.
 *)

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

(*
Now state and prove a theorem negation_fn_applied_twice similar to the previous one
but where the second hypothesis says that the function f has the property that
f x = negb x.
 *)

Theorem identity_fn_applied_twice_neg :
  forall (f : bool -> bool),
  (forall (x : bool), f x = negb x) ->
  forall (b : bool), f (f b) = b.
Proof.
  intros f x b.
  rewrite -> x.
  rewrite -> x.
  rewrite -> negb_involutive.
  reflexivity.
Qed.

(*
Exercise: 2 stars (andb_eq_orb)
Prove the following theorem. (You may want to first prove a subsidiary lemma or two.)
 *)

Theorem andb_eq_orb :
  forall(b c : bool),
  (andb b c = orb b c) ->
  b = c.
Proof.
  intros b c.
  destruct b. destruct c.
  reflexivity. simpl.
  intros H1. rewrite H1.
  reflexivity. simpl.
  destruct c. intros H2. rewrite H2. reflexivity. reflexivity.
Qed.


Require Import Coq.Program.Tactics.

Module Type Monoid.
  Parameter M: Type.
  Parameter e: M.
  Parameter mult: M -> M -> M.
  Axiom mult_e_l:
    forall x, mult e x = x.
  Axiom mult_e_r:
    forall x, mult x e = x.
  Axiom mult_assoc:
    forall x y z, mult x (mult y z) = mult (mult x y) z.
End Monoid.

Module list_bool_Monoid <: Monoid.
  Definition M := list bool.
  Definition e: M := nil.
  Definition mult x y: M := app x y.
  Proposition mult_e_l:
    forall x, mult e x = x.
    auto.
  Qed.
  Proposition mult_e_r:
    forall x, mult x e = x.
    induction x; auto.
    unfold mult.
    simpl.
    unfold mult in IHx.
    rewrite IHx.
    reflexivity.
  Qed.
  Proposition mult_assoc:
    forall x y z, mult x (mult y z) = mult (mult x y) z.
    Require Import List.
    apply app_assoc.
  Qed.
End list_bool_Monoid.

Print Monoid.
Print list_bool_Monoid.

Module MonoidExponential (M: Monoid).
  Fixpoint exp (x: M.M) (n: nat): M.M :=
    match n with
    | 0 => M.e
    | S n' => M.mult x (exp x n')
    end.
  Proposition exp_law:
    forall n m x, M.mult (exp x n) (exp x m) = exp x (n + m).
  induction n.
  simpl.
  intros.
  rewrite M.mult_e_l.
  auto.
  (* step *)
  simpl.
  intros.
  rewrite <- M.mult_assoc.
  rewrite IHn.
  auto.
  Qed.
End MonoidExponential.

Module list_bool_Exponential.
  Include list_bool_Monoid.
  Include MonoidExponential list_bool_Monoid.
End list_bool_Exponential.


Theorem mult_0_r : forall n:nat,
  n * 0 = 0.
Proof.
  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.
  reflexivity.
  simpl.
  rewrite -> IHn.
  reflexivity.
  Qed.

Theorem plus_comm : forall n m : nat,
  n + m = m + n.
Proof.
  intros n m.
  induction n.
  induction m.
  reflexivity.
  simpl.
  rewrite <- IHm.
  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.

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

Lemma double_plus : forall n, double n = n + n .
Proof.
  induction n.
  reflexivity.
  simpl.
  rewrite -> IHn.
  rewrite -> plus_n_Sm with n n.
  reflexivity.
  Qed.

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

Theorem evenb_S : forall n : nat,
  evenb (S n) = negb (evenb n).
Proof.
  induction n.
  reflexivity.
  rewrite -> IHn.
  assert(H: forall a : bool, a = negb (negb a)).
  {
    intros [].
    reflexivity.
    reflexivity.
  }
  rewrite <- H.
  simpl.
  reflexivity.
  Qed.

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

Theorem mult_dist : forall n m p : nat,
  p * (n + m) = p * n + p * m.
Proof.
  intros n m p.
  induction p.
  reflexivity.
  simpl.
  rewrite -> IHp.
  simpl.
  rewrite -> plus_assoc with (n + m) (p * n) (p * m).
  rewrite -> plus_assoc with (n + p * n) m (p * m).
  rewrite <- plus_assoc with n (p * n) m.
  rewrite -> plus_comm with (p * n) m.
  rewrite -> plus_assoc with n m (p * n).
  reflexivity.
  Qed.

Lemma mult_one_same : forall n : nat,
  n * 1 = n.
Proof.
  induction n.
  reflexivity.
  simpl.
  rewrite -> IHn.
  reflexivity.
  Qed.

Theorem mult_comm : forall m n : nat,
  m * n = n * m.
Proof.
  intros m n.
  induction m.
  induction n.
  reflexivity.
  simpl.
  rewrite <- IHn.
  reflexivity.
  simpl.
  rewrite -> IHm.
  assert (H : n + n * m = n * 1 + n * m).
  {
    rewrite -> mult_one_same with n.
    reflexivity.
  }
  rewrite -> H.
  rewrite <- mult_dist with 1 m n.
  simpl.
  reflexivity.
  Qed.

Fixpoint eqb (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' => eqb n' m'
            end
  end.

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

Notation "x =? y" := (eqb x y) (at level 70) : nat_scope.
Notation "x <=? y" := (leb x y) (at level 70) : nat_scope.

Theorem leb_refl : forall n:nat,
  true = (n <=? n).
Proof.
  induction n.
  reflexivity.
  simpl.
  rewrite <- IHn.
  reflexivity.
  Qed.

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

Theorem andb_false_r : forall b : bool,
  andb b false = false.
Proof.
  intros [].
  reflexivity.
  reflexivity.
  Qed.

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

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

Theorem mult_1_l : forall n:nat, 1 * n = n.
Proof.
  intros n.
  simpl.
  rewrite -> plus_comm with n 0.
  reflexivity.
  Qed.

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

Theorem mult_plus_distr_r : forall n m p : nat,
  (n + m) * p = (n * p) + (m * p).
Proof.
  intros n m p.
  rewrite -> mult_comm with (n + m) p.
  rewrite -> mult_comm with n p.
  rewrite -> mult_comm with m p.
  rewrite -> mult_dist with n m p.
  reflexivity.
  Qed.

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

Theorem eqb_refl : forall n : nat,
  true = (n =? n).
Proof.
  induction n.
  reflexivity.
  simpl.
  rewrite <- IHn.
  reflexivity.
  Qed.

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

Inductive bin : Type :=
  | Z
  | A (n : bin)
  | B (n : bin).

Fixpoint incr (m:bin) : bin :=
  match m with
  | Z => B Z
  | A n => B n
  | B n => A (incr n)
  end.

Fixpoint bin_to_nat (m:bin) : nat :=
  match m with
  | Z => O
  | A n => 2 * bin_to_nat n
  | B n => 1 + 2 * bin_to_nat n
  end.

Theorem bin_to_nat_pres_incr : forall (b : bin),
  bin_to_nat (incr b) = S (bin_to_nat b).
Proof.
  induction b.
  reflexivity.
  reflexivity.
  simpl.
  rewrite -> IHb.
  simpl.
  rewrite <- plus_n_Sm.
  reflexivity.
  Qed.

Fixpoint nat_to_bin (n:nat) : bin :=
  match n with
  | O => Z
  | S n' => incr(nat_to_bin n')
  end.

Theorem nat_bin_nat : forall n, bin_to_nat (nat_to_bin n) = n.
Proof.
  induction n.
  reflexivity.
  simpl.
  rewrite -> bin_to_nat_pres_incr with (nat_to_bin n).
  rewrite -> IHn.
  reflexivity.
  Qed.


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

Example test_plus_1: (plus (S O) (S O)) = (S (S O)).
Proof. simpl. reflexivity. Qed.
Example test_plus_2: (plus O O) = O.
Proof. simpl. reflexivity. Qed.

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

Example test_mult_0: (mult O O) = O.
Proof. simpl. reflexivity. Qed.
Example test_mult_1: (mult (S (S O)) (S (S O))) = (S (S (S (S O)))).
Proof. simpl. reflexivity. Qed.

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

Example test_minus_0: (minus O O) = O.
Proof. simpl. reflexivity. Qed.

Example test_minus_1: (minus (S O) O) = S O.
Proof. simpl. reflexivity. Qed.

Example test_minus_2: (minus (S (S O)) (S O)) = (S O).
Proof. simpl. reflexivity. Qed.

Example test_minus_3: (minus O (S O)) = O.
Proof. simpl. reflexivity. Qed.

Example test_minus_4: (minus (S (S O)) (S (S (S O)))) = O.
Proof. simpl. reflexivity. Qed.

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

Example test_exp_1: (exp (S O) O) = S O.
Proof. simpl. reflexivity. Qed.

Example test_exp_2: (exp (S (S O)) (S (S O))) = (S (S (S (S O)))).
Proof. simpl. reflexivity. Qed.

Infix "*" := mult.

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

Example test_fact_1: (fact O) = (S O).
Proof. simpl. reflexivity. Qed.

Example test_fact_2: (fact (S (S (S O)))) = (S (S (S (S (S (S O)))))).
Proof. simpl. reflexivity. Qed.

Example test_fact_3: (fact (S O)) = (S O).
Proof. simpl. reflexivity. Qed.

Example test_factorial1: (fact 3) = 6.
Proof. simpl. reflexivity. Qed.

Example test_fact4: (fact 5) = (mult 10 12).
Proof. simpl. reflexivity. Qed.

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

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

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

Example test_beq_nat3: (beq_nat 2 3) = false.
Proof. simpl. reflexivity. Qed.

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

Example test_leq_nat1: (leq_nat 4 3) = false.
Proof. simpl. reflexivity. Qed.

Example test_leq_nat2: (leq_nat 3 3) = true.
Proof. simpl. reflexivity. Qed.

Example test_leq_nat3: (leq_nat 2 3) = true.
Proof. simpl. reflexivity. Qed.

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

Example test_blt_nat1: (blt_nat 4 3) = false.
Proof. simpl. reflexivity. Qed.

Example test_blt_nat2: (blt_nat 3 3) = false.
Proof. simpl. reflexivity. Qed.

Example test_blt_nat3: (blt_nat 2 3) = true.
Proof. simpl. reflexivity. Qed.

Example test_blt_nat4: (blt_nat 2 2) = false.
Proof. simpl. reflexivity. Qed.
Example test_blt_nat5: (blt_nat 2 4) = true.
Proof. simpl. reflexivity. Qed.
Example test_blt_nat6: (blt_nat 4 2) = false.
Proof. simpl. reflexivity. Qed.

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

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

Theorem plus_id_n_m : forall n m : nat,
  n = m ->
  n + n = m + m.
Proof.
  (* move n and m into the context *)
  intros n m.
  (* move the hypotesis into the context *)
  intros H.
  (* rewrite the goal using the hypothesis: *)
  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.
  intros H2.

  rewrite -> H1.
  rewrite -> H2.
  reflexivity.
 Qed.

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

Theorem plus_S_n : forall n : nat,
  (1 + n) = S n.
Proof.
  intros n.
  reflexivity.
Qed.

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

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

Theorem andb_commutative'' :
  forall b c, andb b c = andb c b.
Proof.
  intros [] [].
  - reflexivity.
  - reflexivity.
  - 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_two_equals : forall b c : bool,
  b = true ->
  c = true ->
  andb b c = true.
Proof.
  intros b c.
  intros H1.
  intros H2.
  rewrite -> H1.
  rewrite -> H2.
  reflexivity.
Qed.

Theorem andb_true_elim2 : forall b c : bool,
  andb b c = true -> c = true.
Proof.
  intros b c H.
  destruct c.
  reflexivity.
  rewrite <- H.
  destruct b.
  reflexivity.
  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 x b.
 destruct b.
 rewrite -> x.
 rewrite -> x.
 reflexivity.
 rewrite -> x.
 rewrite -> x.
 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 x b.
  destruct b.
  rewrite -> x.
  rewrite -> x.
  reflexivity.
  rewrite -> x.
  rewrite -> x.
  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 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. (* Introduce our parameters *)
  rewrite -> H.
  apply H.
Qed.

Theorem andb_eq_orb :
  forall (b c : bool),
  (andb b c = orb b c) ->
  b = c.
Proof.
  intros b c;
  destruct b,c;
  intro H;
  inversion H.
  inversion H.
  reflexivity.
  reflexivity.
Qed.

Inductive bin : Type :=
  | T : bin
  | O : bin -> bin
  | S : bin -> bin.

Example construct: (S (S (S (S (O (S (S (O (S T))))))))) = (S (S (S (S (O (S (S (O (S T))))))))).
Proof. simpl. reflexivity. Qed.

Fixpoint incr (b : bin) : bin :=
  match b with
  | T => T
  | S T => S (O T)
  | O T => (S T)
  | S n => S (incr n)
  | O n => O (incr n)
  end.

Example zero_inc: incr (O T) = (S T).
Proof. reflexivity. Qed.

Example one_inc: incr (S T) = (S (O T)).
Proof. reflexivity. Qed.

Example two_inc: incr (S (O T)) = (S (S T)).
Proof. simpl. reflexivity. Qed.

Example ten_inc: incr (S (O (S (O T)))) = (S (O (S (S T)))).
Proof. simpl. reflexivity. Qed.

Fixpoint bin_length (b : bin) : nat :=
  match b with
   | T => 0
   | O n => 1 + (bin_length n)
   | S n => 1 + (bin_length n)
  end.

Example bin_length_0: bin_length T = 0.
Proof. simpl. reflexivity. Qed.

Example bin_length_1: bin_length (S T) = 1.
Proof. simpl. reflexivity. Qed.

Example bin_length_3: bin_length (S (O (S T))) = 3.
Proof. simpl. reflexivity. Qed.

Fixpoint bin_to_nat (b : bin) : nat :=
  match b with
   | T => 0
   | S n => 1 * (exp 2 (bin_length n)) + (bin_to_nat n)
   | O n => 0 + (bin_to_nat n)
  end.

Example bin_to_nat_110: bin_to_nat (S (S (O T))) = 6.
Proof. simpl. reflexivity. Qed.

Example bin_to_nat_11: bin_to_nat (S (S T)) = 3.
Proof. simpl. reflexivity. Qed.

Example bin_to_nat_incr: bin_to_nat (incr (S (S (O T)))) = 6+1.
Proof. simpl. reflexivity. Qed.

Inductive bin' : Type :=
  | Z : bin'
  | D : bin' -> bin'
  | F : bin' -> bin'.

Fixpoint incr' (b: bin') : bin' :=
  match b with
    | Z => F Z
    | D b' => F b'
    | F b' => D (incr' b')
  end.

Fixpoint bin_to_nat' (b: bin') : nat :=
  match b with
    | Z => 0
    | D b' => 2 * (bin_to_nat' b')
    | F b' => 1 + 2 * (bin_to_nat' b')
  end.