Require Export Induction.

Module NatList.

Inductive natprod : Set :=
  | pair : nat -> nat -> 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.

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

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

Theorem surjective_pairing : forall p : natprod, p = (fst p, snd p).
Proof. intro p; destruct p as [x y]; reflexivity. Qed.

Theorem snd_fst_is_swap : forall p : natprod, (snd p, fst p) = swap_pair p.
Proof. intro p; destruct p as [x y]; reflexivity. Qed.

Theorem fst_swap_is_snd : forall p : natprod, fst (swap_pair p) = snd p.
Proof. intro p; destruct p as [x y]; reflexivity. Qed.

Inductive natlist : Set :=
  | nil  : natlist
  | cons : nat -> natlist -> natlist.

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

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

Fixpoint length (l : natlist) : nat :=
  match l with
    | []      => 0
    | n :: l' => S (length l')
  end.

Fixpoint app (l1 l2 : natlist) : natlist :=
  match l1 with
    | []       => l2
    | n :: l1' => n :: app l1' l2
  end.

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

Example test_app1: [1;2;3] ++ [4;5] = [1;2;3;4;5].
Proof. reflexivity. Qed.
Example test_app2: nil ++ [4;5] = [4;5].
Proof. reflexivity. Qed.
Example test_app3: [1;2;3] ++ nil = [1;2;3].
Proof. reflexivity. Qed.

Definition hd (default : nat) (l : natlist) : nat :=
  match l with
    | []     => default
    | n :: _ => n
  end.

Definition tl (l : natlist) : natlist :=
  match l with
    | []      => []
    | _ :: l' => l'
  end.

Example test_hd1: hd 0 [1;2;3] = 1.
Proof. reflexivity. Qed.
Example test_hd2: hd 0 [] = 0.
Proof. reflexivity. Qed.
Example test_tl: tl [1;2;3] = [2;3].
Proof. reflexivity. Qed.

Fixpoint nonzeros (l : natlist) : natlist :=
  match l with
    | []          => []
    | O     :: l' => nonzeros l'
    | (S n) :: l' => (S n) :: nonzeros l'
  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
    | []      => []
    | n :: l' => match (oddb n) with
                   | true  => n :: oddmembers l'
                   | false => oddmembers l'
                 end
  end.

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

Fixpoint countoddmembers (l : natlist) : nat :=
  match l with
    | []      => O
    | n :: l' => match (oddb n) with
                   | true  => S (countoddmembers l')
                   | false => countoddmembers l'
                 end
  end.

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 with
    | []        => l2
    | n1 :: l1' => match l2 with
                     | []        => l1
                     | n2 :: l2' => n1 :: n2 :: alternate l1' l2'
                   end
  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
    | []      => O
    | n :: s' => match beq_nat v n with
                   | true  => S (count v s')
                   | false => count v s'
                 end
  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 (v : nat) (s : bag) : bag := cons v s.

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 (beq_nat 0 (count v s)).

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

Fixpoint remove_one (v : nat) (s : bag) : bag :=
  match s with
    | []      => []
    | n :: s' => match beq_nat v n with
                   | true  => s'
                   | false => n :: remove_one v s'
                 end
  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
    | []      => []
    | n :: s' => match beq_nat v n with
                   | true  => remove_all v s'
                   | false => n :: remove_all v s'
                 end
  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 s2 : bag) : bool :=
  match s1 with
    | []       => true
    | n :: s1' => match ble_nat (count n s1) (count n s2) with
                    | true  => subset s1' s2
                    | false => false
                  end
  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.

Theorem add_increments_count : forall (s : bag) (v : nat), count v (add v s) = S (count v s).
Proof. intros s v; simpl; rewrite <- beq_nat_refl; reflexivity. Qed.

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

Theorem tl_length_pred : forall l : natlist, length (tl l) = pred (length l).
Proof. intro l; destruct l as [| n l']; reflexivity. Qed.

Theorem app_ass : forall l1 l2 l3 : natlist, l1 ++ (l2 ++ l3) = (l1 ++ l2) ++ l3.
Proof. intros l1 l2 l3; induction l1 as [| n l1'].
Case "l1 = []".     reflexivity.
Case "l1 = n::l1'". simpl; rewrite IHl1'; reflexivity.
Qed.

Theorem app_length : forall l1 l2 : natlist, length (l1 ++ l2) = length l1 + length l2.
Proof. intros l1 l2; induction l1 as [| n l1'].
Case "l1 = []".     reflexivity.
Case "l1 = n::l1'". simpl; rewrite IHl1'; reflexivity.
Qed.

Fixpoint snoc (l : natlist) (v : nat) : natlist :=
  match l with
    | []      => [v]
    | n :: l' => n :: snoc l' v
  end.

Fixpoint rev (l : natlist) : natlist :=
  match l with
    | []      => []
    | n :: l' => snoc (rev l') n
  end.

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

Theorem length_snoc : forall (l : natlist) (v : nat), length (snoc l v) = S (length l).
Proof. intros l v; induction l as [| n l'].
Case "l = []".    reflexivity.
Case "l = n::l'". simpl; rewrite IHl'; reflexivity.
Qed.

Theorem length_rev : forall l : natlist, length (rev l) = length l.
Proof. intro l; induction l as [| n l'].
Case "l = []".    reflexivity.
Case "l = n::l'". simpl; rewrite <- IHl'; rewrite length_snoc; reflexivity.
Qed.

Theorem app_nil_end : forall l : natlist, l ++ [] = l.
Proof. intro l; induction l as [| n l'].
Case "l = []".    reflexivity.
Case "l = n::l'". simpl; rewrite IHl'; reflexivity.
Qed.

Lemma rev_snoc : forall (l : natlist) (v : nat), rev (snoc l v) = v :: rev l.
Proof. intros l v; induction l as [| n l'].
Case "l = []".    reflexivity.
Case "l = n::l'". simpl; rewrite IHl'; reflexivity.
Qed.

Theorem rev_involutive : forall l : natlist, rev (rev l) = l.
Proof. intro l; induction l as [| n l'].
Case "l = []".    reflexivity.
Case "l = n::l'". simpl; rewrite rev_snoc; rewrite IHl'; reflexivity.
Qed.

Theorem app_ass4 :
  forall l1 l2 l3 l4 : natlist, l1 ++ (l2 ++ (l3 ++ l4)) = ((l1 ++ l2) ++ l3) ++ l4.
Proof. intros l1 l2 l3 l4; repeat rewrite app_ass; reflexivity. Qed.

Theorem snoc_append : forall (l : natlist) (v : nat), snoc l v = l ++ [v].
Proof. intros l v; induction l as [| n l'].
Case "l = []".    reflexivity.
Case "l = n::l'". simpl. rewrite IHl'; reflexivity.
Qed.

Theorem distr_rev : forall l1 l2 : natlist, rev (l1 ++ l2) = (rev l2) ++ (rev l1).
Proof. intros l1 l2; induction l1 as [| n l1'].
Case "l1 = []".     simpl; rewrite app_nil_end; reflexivity.
Case "l1 = n::l1'". simpl; repeat rewrite snoc_append; rewrite IHl1';
                    rewrite app_ass; reflexivity.
Qed.

Lemma nonzeros_app :
  forall l1 l2 : natlist, nonzeros (l1 ++ l2) = nonzeros l1 ++ nonzeros l2.
Proof. intros l1 l2; induction l1 as [| n l1'].
Case "l1 = []".     reflexivity.
Case "l1 = n::l1'". destruct n as [| n']; simpl; rewrite IHl1'; reflexivity.
Qed.

Theorem snoc_app_cons :
  forall (l1 l2 : natlist) (v : nat), (snoc l1 v) ++ l2 = l1 ++ (v :: l2).
Proof. intros l1 l2 v; rewrite snoc_append; rewrite <- app_ass; reflexivity. Qed.

Theorem count_member_nonzero : forall (s : bag) (v : nat), ble_nat 1 (count v (v :: s)) = true.
Proof. intros s v; simpl; rewrite <- beq_nat_refl; reflexivity.
Qed.

Theorem ble_n_Sn : forall n : nat, ble_nat n (S n) = true.
Proof. intro n; induction n as [| n'].
Case "n = 0".    reflexivity.
Case "n = S n'". simpl; exact IHn'.
Qed.

(* This actually appears somewhat more subtle if you try to replace 0 by (v : nat).
 * Instead of destructing n, you need to destruct (beq_nat v n), but there are three
 * occurrences of this in the theorem and one of them is behind the reduction of
 * count v (remove_one v s).  One needs some way to retain the case-analyzed value of
 * beq_nat v n in the context, which I don't know how to do. *)
Theorem remove_decreases_count :
  forall (s : bag), ble_nat (count 0 (remove_one 0 s)) (count 0 s) = true.
Proof. intro s; induction s as [| n s'].
Case "s = []".    reflexivity.
Case "s = n::s'". simpl; destruct n as [| n'].
 SCase "n = 0".    apply ble_n_Sn.
 SCase "n = S n'". simpl; exact IHs'.
Qed.

(* To solve the problem above, use the eqn: clause of destruct which retains the case info. *)
Theorem remove_decreases_count' :
  forall (s : bag) (v : nat), ble_nat (count v (remove_one v s)) (count v s) = true.
Proof. intros s v; induction s as [| n s'].
Case "s = []".    reflexivity.
Case "s = n::s'". simpl; destruct (beq_nat v n) eqn: nH.
 SCase "v = n".  apply ble_n_Sn.
 SCase "v /= n". simpl; rewrite nH; exact IHs'.
Qed.

Theorem sum_adds_count :
  forall (v : nat) (s1 s2 : bag), count v (sum s1 s2) = count v s1 + count v s2.
Proof. intros v s1 s2; induction s1 as [| n s1'].
Case "s1 = []".     reflexivity.
Case "s1 = n::s1'". simpl; destruct (beq_nat v n); rewrite IHs1'; reflexivity.
Qed.

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

Inductive natoption : Set :=
| Some : nat -> natoption
| None : natoption.

Fixpoint index (i : nat) (l : natlist) : natoption :=
  match l with
    | []    => None
    | n::l' => match i with
                 | O    => Some n
                 | S i' => index i' l'
               end
  end.

Example test_index1 : index 0 [4;5;6;7] = Some 4.
Proof. reflexivity. Qed.
Example test_index2 : index 3 [4;5;6;7] = Some 7.
Proof. reflexivity. Qed.
Example test_index3 : index 10 [4;5;6;7] = None.
Proof. reflexivity. Qed.

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

Definition hd_opt (l : natlist) : natoption :=
  match l with
    | []   => None
    | n::_ => Some n
  end.

Example test_hd_opt1 : hd_opt [] = None.
Proof. reflexivity. Qed.
Example test_hd_opt2 : hd_opt [1] = Some 1.
Proof. reflexivity. Qed.
Example test_hd_opt3 : hd_opt [5;6] = Some 5.
Proof. reflexivity. Qed.

Theorem option_elim_hd :
  forall (l : natlist) (default : nat), hd default l = option_elim default (hd_opt l).
Proof. intros l default; destruct l as [| n l']; reflexivity. Qed.

Fixpoint beq_natlist (l1 l2 : natlist) : bool :=
  match l1, l2 with
    | [],      []      => true
    | n1::l1', n2::l2' => andb (beq_nat n1 n2) (beq_natlist l1' l2')
    | _,       _       => false
  end.

Example test_beq_natlist1 : (beq_natlist nil nil = true).
Proof. reflexivity. Qed.
Example test_beq_natlist2 : beq_natlist [1;2;3] [1;2;3] = true.
Proof. reflexivity. Qed.
Example test_beq_natlist3 : beq_natlist [1;2;3] [1;2;4] = false.
Proof. reflexivity. Qed.
Example test_beq_natlist4 : beq_natlist [1;2;3] [1;2] = false.
Proof. reflexivity. Qed.

Theorem beq_natlist_refl : forall l : natlist, true = beq_natlist l l.
Proof. intro l; induction l as [| n l'].
Case "l = []".    reflexivity.
Case "l = n::l'". simpl; rewrite <- beq_nat_refl; rewrite <- IHl'; reflexivity.
Qed.

Module Dictionary.

Inductive dictionary : Set :=
| empty : dictionary
| record : nat -> nat -> dictionary -> dictionary.

Definition insert (key value : nat) (d : dictionary) : dictionary :=
  record key value d.

Fixpoint find (key : nat) (d : dictionary) : natoption :=
  match d with
    | empty         => None
    | record k v d' => if beq_nat key k
                         then Some v
                         else find key d'
  end.

Theorem dictionary_invariant1 :
  forall (d : dictionary) (k v : nat), find k (insert k v d) = Some v.
Proof. intros d k v; simpl; rewrite <- beq_nat_refl; reflexivity. Qed.

Theorem dictionary_invariant2 :
  forall (d : dictionary) (k k' v : nat),
    beq_nat k k' = false -> find k d = find k (insert k' v d).
Proof. intros d k k' v Hneq; simpl; rewrite Hneq; reflexivity. Qed.

End Dictionary.

End NatList.


(** Cheat sheet available at
      #https://www-sop.inria.fr/teams/marelle/types18/cheatsheet.pdf#
*)

From mathcomp Require Import all_ssreflect.

Implicit Type p q r : bool.
Implicit Type m n a b c : nat.

(** *** Exercise 1:
    - use no lemma to prove the following statement
*)
Lemma orbC p q : p || q = q || p.
(*D*)Proof. by case: p; case: q. Qed.

(** *** Exercise 2:
   - look up what [==>] is and prove that as you like
*)
Lemma Peirce p q : ((p ==> q) ==> p) ==> p.
(*D*)Proof. by case: p; case: q. Qed.

(** *** Exercise 3:
    - what is [(+)] ?
    - prove this using move and rewrite
*)
Lemma find_me p q :  ~~ p = q -> p (+) q.
(*D*)Locate "(+)".
(*D*)Search _ addb negb.
(*D*)Proof. by move=> np_q; rewrite -np_q addbN negb_add. Qed.

(** *** Exercise 4:
    - prove this satement by induction
*)
Lemma iterSr A n (f : A -> A) x : iter n.+1 f x = iter n f (f x).
(*D*)Proof. by elim: n => // n IH; rewrite /= -IH. Qed.

(** *** Exercise 5:
    - look up the definition of [iter] (note there is an accumulator varying
      during recursion)
    - prove the following statement by induction
*)
Lemma iter_predn m n : iter n predn m = m - n.
Proof.
(*D*)elim: n m => [|n IHn] m.
(*D*)  by rewrite subn0.
(*D*)by rewrite /= IHn subnS.
Qed.


(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2012     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)

(** The type [nat] of Peano natural numbers (built from [O] and [S])
    is defined in [Datatypes.v] *)

(** This module defines the following operations on natural numbers :
    - predecessor [pred]
    - addition [plus]
    - multiplication [mult]
    - less or equal order [le]
    - less [lt]
    - greater or equal [ge]
    - greater [gt]

   It states various lemmas and theorems about natural numbers,
   including Peano's axioms of arithmetic (in Coq, these are provable).
   Case analysis on [nat] and induction on [nat * nat] are provided too
 *)

Require Import Notations.
Require Import Datatypes.
Local Open Scope identity_scope.
Require Import Logic_Type.
Require Coq.Init.Nat.

Open Scope nat_scope.
Local Notation "0" := O.

Definition eq_S := f_equal S.

Hint Resolve (f_equal S): v62.
Hint Resolve (f_equal (A:=nat)): core.

(** The predecessor function *)

Definition pred (n:nat) : nat := match n with
                                 | O => n
                                 | S u => u
                                 end.
(* Hint Resolve (f_equal pred): v62. *)

Theorem pred_Sn : forall n:nat, n = pred (S n).
Proof.
  simpl; reflexivity.
Qed.

(** Injectivity of successor *)

Definition eq_add_S n m (H: S n = S m): n = m := f_equal pred H.
Hint Immediate eq_add_S: core.

Theorem not_eq_S : forall n m:nat, n <> m -> S n <> S m.
Proof.
  red; auto.
Qed.
Hint Resolve not_eq_S: core.

Definition IsSucc (n:nat) : Type :=
  match n with
  | O => False
  | S p => True
  end.

(** Zero is not the successor of a number *)

(* XXX Andrej: Try to put back in, does not work with current Coq. *)
(* Theorem O_S : forall n:nat, 0 <> S n. *)
(* Proof. *)
(*   discriminate. *)
(* Qed. *)
(* Hint Resolve O_S: core. *)

(* XXX Andrej: Try to put back in, does not work with current Coq. *)
(* Theorem n_Sn : forall n:nat, n <> S n. *)
(* Proof. *)
(*   induction n; auto. *)
(* Qed. *)
(* Hint Resolve n_Sn: core. *)

(** addition *)

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

where "n + m" := (plus n m) : nat_scope.

Hint Resolve (f_equal2 plus): v62.
Hint Resolve (f_equal2 (A1:=nat) (A2:=nat)): core.

Lemma plus_n_O : forall n:nat, n = n + 0.
Proof.
  induction n; simpl; auto.
Qed.
Hint Resolve plus_n_O: core.

Lemma plus_O_n : forall n:nat, 0 + n = n.
Proof.
  auto.
Qed.

Lemma plus_n_Sm : forall n m:nat, S (n + m) = n + S m.
Proof.
  intros n m; induction n; simpl; auto.
Qed.
Hint Resolve plus_n_Sm: core.

Lemma plus_Sn_m : forall n m:nat, S n + m = S (n + m).
Proof.
  auto.
Qed.

(** Standard associated names *)

Notation plus_0_r_reverse := plus_n_O (only parsing).
Notation plus_succ_r_reverse := plus_n_Sm (only parsing).

(** Multiplication *)

Fixpoint mult (n m:nat) : nat :=
  match n with
  | O => 0
  | S p => m + p * m
  end

where "n * m" := (mult n m) : nat_scope.

Hint Resolve (f_equal2 mult): core.

Lemma mult_n_O : forall n:nat, 0 = n * 0.
Proof.
  induction n; simpl; auto.
Qed.
Hint Resolve mult_n_O: core.

Lemma mult_n_Sm : forall n m:nat, n * m + n = n * S m.
Proof.
  intros; induction n as [| p H]; simpl; auto.
  destruct H; rewrite <- plus_n_Sm; apply eq_S.
  pattern m at 1 3; elim m; simpl; auto.
Qed.
Hint Resolve mult_n_Sm: core.

(** Standard associated names *)

Notation mult_0_r_reverse := mult_n_O (only parsing).
Notation mult_succ_r_reverse := mult_n_Sm (only parsing).

(** Truncated subtraction: [m-n] is [0] if [n>=m] *)

Fixpoint minus (n m:nat) : nat :=
  match n, m with
  | O, _ => n
  | S k, O => n
  | S k, S l => k - l
  end

where "n - m" := (minus n m) : nat_scope.

(** Definition of the usual orders, the basic properties of [le] and [lt]
    can be found in files Le and Lt *)

Inductive le (n:nat) : nat -> Type :=
  | le_n : le n n
  | le_S : forall m:nat, le n m -> le n (S m).
Local Notation "n <= m" := (le n m) : nat_scope.

Hint Constructors le: core.
(*i equivalent to : "Hints Resolve le_n le_S : core." i*)

Definition lt (n m:nat) := S n <= m.
Hint Unfold lt: core.

Local Infix "<" := lt : nat_scope.

Definition ge (n m:nat) := m <= n.
Hint Unfold ge: core.

Local Infix ">=" := ge : nat_scope.

Definition gt (n m:nat) := m < n.
Hint Unfold gt: core.

Local Infix ">" := gt : nat_scope.

Local Notation "x <= y <= z" := (x <= y /\ y <= z) : nat_scope.
Local Notation "x <= y < z" := (x <= y /\ y < z) : nat_scope.
Local Notation "x < y < z" := (x < y /\ y < z) : nat_scope.
Local Notation "x < y <= z" := (x < y /\ y <= z) : nat_scope.

Theorem le_pred : forall n m, n <= m -> pred n <= pred m.
Proof.
induction 1; auto. destruct m; simpl; auto.
Qed.

Theorem le_S_n : forall n m, S n <= S m -> n <= m.
Proof.
intros n m. exact (le_pred (S n) (S m)).
Qed.

(** Case analysis *)

Theorem nat_case :
 forall (n:nat) (P:nat -> Type), P 0 -> (forall m:nat, P (S m)) -> P n.
Proof.
  induction n; auto.
Qed.

(** Principle of double induction *)

Theorem nat_double_ind :
 forall R:nat -> nat -> Type,
   (forall n:nat, R 0 n) ->
   (forall n:nat, R (S n) 0) ->
   (forall n m:nat, R n m -> R (S n) (S m)) -> forall n m:nat, R n m.
Proof.
  induction n; auto.
  destruct m; auto.
Qed.

(** Maximum and minimum : definitions and specifications *)

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

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

(* Theorem max_l : forall n m : nat, m <= n -> max n m = n. *)
(* Proof. *)
(* induction n; destruct m; simpl; auto. inversion 1. *)
(* intros. apply f_equal. apply IHn. apply le_S_n. trivial. *)
(* Qed. *)

(* Theorem max_r : forall n m : nat, n <= m -> max n m = m. *)
(* Proof. *)
(* induction n; destruct m; simpl; auto. inversion 1. *)
(* intros. apply f_equal. apply IHn. apply le_S_n. trivial. *)
(* Qed. *)

(* Theorem min_l : forall n m : nat, n <= m -> min n m = n. *)
(* Proof. *)
(* induction n; destruct m; simpl; auto. inversion 1. *)
(* intros. apply f_equal. apply IHn. apply le_S_n. trivial. *)
(* Qed. *)

(* Theorem min_r : forall n m : nat, m <= n -> min n m = m. *)
(* Proof. *)
(* induction n; destruct m; simpl; auto. inversion 1. *)
(* intros. apply f_equal. apply IHn. apply le_S_n. trivial. *)
(* Qed. *)

(** [n]th iteration of the function [f] *)

Fixpoint nat_iter (n:nat) {A} (f:A->A) (x:A) : A :=
  match n with
    | O => x
    | S n' => f (nat_iter n' f x)
  end.

Lemma nat_iter_succ_r n {A} (f:A->A) (x:A) :
  nat_iter (S n) f x = nat_iter n f (f x).
Proof.
  induction n; intros; simpl; rewrite <- ?IHn; trivial.
Qed.

Theorem nat_iter_plus :
  forall (n m:nat) {A} (f:A -> A) (x:A),
    nat_iter (n + m) f x = nat_iter n f (nat_iter m f x).
Proof.
  induction n; intros; simpl; rewrite ?IHn; trivial.
Qed.

(** Preservation of invariants : if [f : A->A] preserves the invariant [Inv],
    then the iterates of [f] also preserve it. *)

Theorem nat_iter_invariant :
  forall (n:nat) {A} (f:A -> A) (P : A -> Type),
    (forall x, P x -> P (f x)) ->
    forall x, P x -> P (nat_iter n f x).
Proof.
  induction n; simpl; trivial.
  intros A f P Hf x Hx. apply Hf, IHn; trivial.
Qed.


(* ----------------------------------------------------------------- *)
(*                     Basic algebra of Sets                         *)
(* ----------------------------------------------------------------- *)

From Practice Require Import Basin.Base.
From Practice Require Import Basin.ElemAlg.
From Practice Require Import Basin.ClassicalSets.

Import List.
Import ListNotations.

(* Union: CommMonoid *)
Program Instance magma_union U: Magma _ (@Union U).

Program Instance assoc_union U: Associative _ (@Union U).
Next Obligation. firstorder. Qed.

Program Instance comm_union U: Commutative _ (@Union U).
Next Obligation. firstorder. Qed.

Program Instance hasid_union U: HasIdentity _ (@Union U) := { mid := EmptySet }.
Next Obligation. firstorder. Qed.
Next Obligation. firstorder. Qed.

Program Instance semigroup_union U: Semigroup _ (@Union U).
Program Instance monoid_union U: Monoid _ (@Union U).
Program Instance cmon_union U: CommMonoid _ (@Union U).

Program Instance magma_intersect U: Magma _ (@Intersect U).

Program Instance assoc_intersect U: Associative _ (@Intersect U).
Next Obligation. firstorder. Qed.

Program Instance comm_intersect U: Commutative _ (@Intersect U).
Next Obligation. firstorder. Qed.

Program Instance hasid_intersect U: HasIdentity _ (@Intersect U) := { mid := FullSet }.
Next Obligation. firstorder. Qed.
Next Obligation. firstorder. Qed.

Program Instance semigroup_intersect U: Semigroup _ (@Intersect U).
Program Instance monoid_intersect U: Monoid _ (@Intersect U).
Program Instance cmon_intersect U: CommMonoid _ (@Intersect U).

Lemma cat_unions_as_unionover: forall U (L: list (ESet U)),
  MCat Union L == MCatOver Union id L.
Proof. move=> U L. by rewrite /MCatOver map_id. Qed.

Lemma cat_intersects_as_intersectover: forall U (L: list (ESet U)),
  MCat Intersect L == MCatOver Intersect id L.
Proof. move=> U L. by rewrite /MCatOver map_id. Qed.

Lemma cat_unionover_compl: forall I U (L: list I) (F: I -> ESet U),
  ~! (MCatOver Union F L) == MCatOver Intersect (fun i => ~! F i) L.
Proof. move=> I U L F. elim: L; firstorder. Qed.

Lemma cat_intersectover_compl: forall I U (L: list I) (F: I -> ESet U),
  ~! (MCatOver Intersect F L) == MCatOver Union (fun i => ~! F i) L.
Proof. move=> I U L F. elim: L => [|a L IH]. firstorder.
  constructor=> x. decides (x :in: F a); firstorder. Qed.

(* Set of lists where each element is in a set *)
Definition ForallSet {U} (T: ESet U): ESet (list U) :=
  mkSet (fun L => Forall (InSet T) L).

(* Set of lists where at least single element is in a set *)
Definition ExistsSet {U} (T: ESet U): ESet (list U) :=
  mkSet (fun L => Exists (InSet T) L).


Require Import Bool Arith List Cpdt.CpdtTactics.
Set Implicit Arguments.

Inductive binop : Set := Plus | Times.

Inductive exp : Set :=
| Const : nat -> exp
| Binop : binop -> exp -> exp -> exp.

Definition binopDenote (b : binop) : nat -> nat -> nat :=
    match b with
    | Plus => plus
    | Times => mult
    end.

Fixpoint expDenote (e : exp) : nat :=
    match e with
    | Const n => n
    | Binop b e1 e2 => (binopDenote b) (expDenote e1) (expDenote e2)
    end.

Eval simpl in expDenote (Const 42).

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

Inductive instr : Set :=
| iConst : nat -> instr
| iBinop : binop -> instr.

Definition prog := list instr.

Definition stack := list nat.

Definition instrDenote (i: instr) (s : stack) : option stack :=
    match i with
    | iConst n => Some (n :: s)
    | iBinop b =>
        match s with
        | arg1 :: arg2 :: s' =>
            Some ((binopDenote b) arg1 arg2 :: s')
        | _ =>
            None
        end
    end.

Fixpoint progDenote (p : prog) (s : stack) : option stack :=
    match p with
    | nil => Some s
    | i :: p' =>
        match instrDenote i s with
        | None => None
        | Some s' => progDenote p' s'
        end
    end.

Fixpoint compile (e : exp) : prog :=
    match e with
    | Const n => iConst n :: nil
    | Binop b e1 e2 => compile e2 ++ compile e1 ++ iBinop b :: nil
    end.

Eval simpl in (compile (Const 42)).

(* "Compiling e and executing it is the same as
   pushing the value of expDonte on the stack" *)
Lemma compile_correct' : forall e p s,
    progDenote (compile e ++ p) s = progDenote p (expDenote e :: s).
    induction e; crush.

Theorem compile_correct :
    forall e, progDenote (compile e) nil = Some (expDenote e :: nil).


Set Warnings "-notation-overridden,-parsing".
From LF Require Export Tactics.
From Coq Require Import Setoids.Setoid.
Lemma and_intro : forall A B : Prop, A -> B -> A /\ B.
Proof.
  intros A B HA HB. split.
  - apply HA.
  - apply HB.
Qed.

Example and_exercise :
  forall n m : nat, n + m = 0 -> n = 0 /\ m = 0.
Proof.
    intros. split.
    - destruct n .
    -- reflexivity.
    -- discriminate.
    - destruct m .
    -- reflexivity.
    -- rewrite<-plus_n_Sm in H. discriminate.
Qed.

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

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

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

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

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

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

Fact not_implies_our_not : forall (P:Prop),
    ~P -> (forall (Q:Prop), P -> Q).
Proof.
    intros. destruct H. apply H0. Qed.

Theorem not_False :
  ~ False.
Proof.
  unfold not. intros H. destruct H. Qed.
Theorem contradiction_implies_anything : forall P Q : Prop,
  (P /\ ~P) -> Q.
Proof.
  (* WORKED IN CLASS *)
  intros P Q [HP HNA]. unfold not in HNA.
  apply HNA in HP. destruct HP. Qed.
Theorem double_neg : forall P : Prop,
  P -> ~~P.
Proof.
  (* WORKED IN CLASS *)
  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. unfold not. intros. apply H in H1. apply H0 in H1.
    apply H1. Qed.

Theorem not_both_true_and_false : forall P : Prop,
  ~ (P /\ ~P).
Proof.
    intros P. unfold not. intros [HP HNA]. apply HNA in HP.
    apply HP. Qed.

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

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

Theorem or_distributes_over_and : forall P Q R : Prop,
P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R).
Proof.
    intros P Q R. split.
    - intros [HP | [HQ HR]].
    -- split. left. apply HP. left. apply HP.
    -- split. right. apply HQ. right. apply HR.
    - intros. destruct H as [HPQ HPR]. destruct HPQ.
    -- left. apply H.
    -- destruct HPR.
    + left. apply H0.
    + right. split. apply H. apply H0.
Qed.

Lemma mult_eq_0: forall n m, n*m =0 -> n = 0 \/ m = 0 .
Proof.
    intros n m H. destruct n.
    - left. reflexivity.
    - destruct m.
    -- right. reflexivity.
    -- discriminate.
Qed.

Lemma eq_mult_0: forall n m, n=0 \/ m =0-> n*m=0 .
Proof.
    intros n m [Hn|Hm].
    - rewrite->Hn. reflexivity.
    - rewrite->Hm. apply mult_comm.
Qed.

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

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

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

Theorem exists_example_2 : forall n,
  (exists m, n = 4 + m) ->
  (exists o, n = 2 + o).
Proof.
  (* WORKED IN CLASS *)
  intros n [m Hm]. (* note implicit destruct here *)
  exists (2 + m).
  apply Hm. Qed.

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

Theorem dist_exists_or : forall (X:Type) (P Q : X -> Prop),
  (exists x, P x \/ Q x) <-> (exists x, P x) \/ (exists x, Q x).
Proof.
    intros. split.
    - intros [x [HP|HQ]].
    -- left. exists x. apply HP.
    -- right. exists x. apply HQ.
    - intros [HP | HQ].
    -- destruct HP as [x HP]. exists x. left. apply HP.
    -- destruct HQ as [x HQ]. exists x. right. apply HQ.
Qed.

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

Example In_example_1 : In 4 [1; 2; 3; 4; 5].
Proof.
  (* WORKED IN CLASS *)
  simpl. right. right. right. left. reflexivity.
Qed.
Example In_example_2 :
  forall n, In n [2; 4] ->
  exists n', n = 2 * n'.
Proof.
  (* WORKED IN CLASS *)
  simpl.
  intros n [H | [H | []]].
  - exists 1. rewrite <- H. reflexivity.
  - exists 2. rewrite <- H. reflexivity.
Qed.

Theorem In_map_iff :
  forall (A B : Type) (f : A -> B) (l : list A) (y : B),
    In y (map f l) <->
    exists x, f x = y /\ In x l.
Proof.
  intros A B f l y. split.
  - induction l as [|h t IH].
  -- intros. simpl in H. destruct H.
  -- intros. simpl. destruct H eqn:H1.
    + exists h. split. apply e. left. reflexivity.
    + clear H1. apply IH in i. destruct i. exists x. destruct H0.
      split. apply H0. right. apply H1.
  - induction l as [|h t IH].
  -- intros. simpl in H. destruct H. destruct H. destruct H0.
  -- intros. simpl. destruct H. simpl in H. destruct H.
     destruct H0.
      * left. rewrite->H0. apply H.
      * right. apply IH. exists x. split. apply H. apply H0.
Qed.

Theorem In_app_iff : forall A l l' (a:A),
  In a (l++l') <-> In a l \/ In a l'.
Proof.
  intros A l. induction l as [|a' l' IH].
  - split.
  -- simpl. intros. right. apply H.
  -- simpl. intros. destruct H. destruct H. apply H.
  - split.
  -- simpl. intros. destruct H.
  + left. left. apply H.
  + apply IH in H. destruct H.
  * left. right. apply H.
  * right. apply H.
  -- simpl. intros. destruct H as [[H1|H2]|H3].
  + left. apply H1.
  + right. apply IH. left. apply H2.
  + right. apply IH. right. apply H3.
Qed.

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

Theorem All_In :
  forall T (P : T -> Prop) (l : list T),
    (forall x, In x l -> P x) <->
    All P l.
Proof.
  intros. split.
  - intros. induction l as [|h t IH].
  -- simpl. reflexivity.
  -- simpl. split.
  + apply H. simpl. left. reflexivity.
  + apply IH. intros. simpl in H. apply H. right. apply H0.
  - induction l as [|h t IH].
  + intros. simpl in H0. destruct H0.
  + simpl. intros. destruct H. destruct H0.
  * rewrite<-H0. apply H.
  * apply IH. apply H1. apply H0.
Qed.

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

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

Theorem combine_odd_even_elim_odd :
  forall (Podd Peven : nat -> Prop) (n : nat),
    combine_odd_even Podd Peven n ->
    oddb n = true ->
    Podd n.
Proof.
  intros. unfold combine_odd_even in H. destruct (oddb n).
  - apply H.
  - discriminate.
Qed.

Theorem combine_odd_even_elim_even :
  forall (Podd Peven : nat -> Prop) (n : nat),
    combine_odd_even Podd Peven n ->
    oddb n = false ->
    Peven n.
Proof.
  intros. unfold combine_odd_even in H. destruct (oddb n).
  - discriminate.
  - apply H.
Qed.

Theorem in_not_nil :
  forall A (x : A) (l : list A), In x l -> l <> [].
Proof.
  intros A x l H. unfold not. intro Hl.
  rewrite Hl in H.
  simpl in H.
  apply H.
Qed.

Lemma in_not_nil_42 :
  forall l : list nat, In 42 l -> l <> [].
Proof.
  intros l H.
  apply in_not_nil with (x := 42).
  apply H.
Qed.

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

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

Print Assumptions function_equality_ex2.

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

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

Lemma rev_append_empty: forall X (l1 l2:list X), rev_append l1 l2 = rev_append l1 []++ l2.
Proof.
  intros X l1. induction l1.
  - intros l2. reflexivity.
  - intros l2. simpl. destruct l2 as [|h t].
  -- rewrite app_nil_r. reflexivity.
  -- rewrite IHl1. replace (rev_append l1 [x]) with (rev_append l1 [] ++ [x]).
  + rewrite<- app_assoc. reflexivity.
  + rewrite<-IHl1. reflexivity.
Qed.

Theorem tr_rev_correct : forall X, @tr_rev X = @rev X.
Proof.
  intros. apply functional_extensionality.
  unfold tr_rev. induction x as [|h t HX].
  - reflexivity.
  - simpl. rewrite<-HX. apply rev_append_empty.
Qed.

Definition even x := exists n : nat, x = double n.
Theorem evenb_S : forall n : nat,
  evenb (S n) = negb (evenb n).
Proof.
  intros. induction n.
  - reflexivity.
  - rewrite IHn. simpl. rewrite negb_involutive. reflexivity.
Qed.

Theorem S_injective' : forall (n m : nat),
  S n = S m ->
  n = m.
Proof.
  intros n m H.
  injection H as H1. apply H1. Qed.

Lemma evenb_double_conv : forall n, exists k,
  n = if evenb n then double k else S (double k).
Proof.
  intros. induction n as [|n' IH].
  - simpl. exists 0. reflexivity.
  - rewrite evenb_S. destruct (evenb n').
  -- simpl. destruct IH. exists x. rewrite H. reflexivity.
  -- simpl. destruct IH. exists (S x). rewrite H. simpl. reflexivity.
Qed.

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

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

Theorem eqb_eq : forall n1 n2 : nat,
  n1 =? n2 = true <-> n1 = n2.
Proof.
  intros n1 n2. split.
  - apply eqb_true.
  - intros H. rewrite H. rewrite <- eqb_refl. reflexivity.
Qed.

Theorem andb_true_iff : forall b1 b2:bool,
  b1 && b2 = true <-> b1 = true /\ b2 = true.
Proof.
  intros. split.
  - intros. destruct b1.
  + simpl in H. rewrite H. split. reflexivity. reflexivity.
  + simpl in H. discriminate.
  - intros. destruct b1.
  + destruct H. rewrite H0. reflexivity.
  + destruct H. simpl. apply H.
Qed.

Theorem orb_true_iff : forall b1 b2,
  orb b1 b2 = true <-> b1 = true \/ b2 = true.
Proof.
  intros. split.
  - intros. destruct b1.
  -- left. reflexivity.
  -- simpl in H. right. apply H.
  - intros. destruct H.
  -- rewrite H. simpl. reflexivity.
  -- destruct b1.
  + reflexivity.
  + simpl. apply H.
Qed.
Lemma not_true_iff_false : forall b,
  b <> true <-> b = false.
Proof.
  (* WORKED IN CLASS *)
  intros b. split.
  - (* -> *) apply not_true_is_false.
  - (* <- *)
    intros H. rewrite H. intros H'. discriminate H'.
Qed.

Theorem eqb_neq : forall x y : nat,
  x =? y = false <-> x <> y.
Proof.
  intros. split.
  - rewrite<- not_true_iff_false. intros. intros H'.
  destruct H. rewrite H'. symmetry. apply eqb_refl.
  - rewrite<- not_true_iff_false. intros. intros H'.
  destruct H. apply eqb_true in H'. apply H'.
Qed.

Fixpoint eqb_list {A : Type} (eqb : A -> A -> bool)
                  (l1 l2 : list A) : bool:=
  match l1,l2 with
  |nil,nil => true
  |h::t,nil=>false
  |nil,h::t=>false
  |h1::t1,h2::t2=>(eqb h1 h2) && (eqb_list eqb t1 t2)
end.

Lemma andb_true_elim1: forall a b , (a && b) =true->a = true.
Proof.
  intros. destruct a.
  - reflexivity.
  - simpl in H. apply H.
Qed.

Theorem eqb_list_true_iff :
  forall A (eqb : A -> A -> bool),
    (forall a1 a2, eqb a1 a2 = true <-> a1 = a2) ->
    forall l1 l2, eqb_list eqb l1 l2 = true <-> l1 = l2.
Proof.
  intros. split.
  - generalize dependent l2. induction l1 as [|h t IH].
  -- simpl. destruct l2.
  + reflexivity.
  + intros. discriminate.
  -- simpl. destruct l2 as [|h' t'].
  + intros. discriminate.
  + intros. apply andb_true_iff in H0. destruct H0.
    apply H in H0. rewrite H0. apply IH in H1. rewrite H1.
    reflexivity.
  - generalize dependent l2. induction l1 as [|h t IH].
  -- simpl. intros. destruct l2.
  + reflexivity.
  + discriminate.
  -- simpl. intros. destruct l2.
  + discriminate.
  + injection H0 as H0. apply H in H0. apply IH in H1.
    rewrite H0. rewrite H1. reflexivity.
Qed.

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

Theorem forallb_true_iff : forall X test (l : list X),
   forallb test l = true <-> All (fun x => test x = true) l.
Proof.
  intros. split.
  - intros. induction l as [|h t IH].
  -- reflexivity.
  -- simpl. simpl in H. apply andb_true_iff in H.
    destruct H as [H1 H2]. split.
  + apply H1.
  + apply IH in H2. apply H2.
  - intros. induction l as [|h t IH].
  -- reflexivity.
  -- simpl. simpl in H. destruct H as [H1 H2].
  rewrite H1. apply IH in H2. rewrite H2. reflexivity.
Qed.

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

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


(** * IndPrinciples: Induction Principles *)

(** With the Curry-Howard correspondence and its realization in Coq in
    mind, we can now take a deeper look at induction principles. *)

Set Warnings "-notation-overridden,-parsing".
From LF Require Export ProofObjects.

(* ################################################################# *)
(** * Basics *)

(** Every time we declare a new [Inductive] datatype, Coq
    automatically generates an _induction principle_ for this type.
    This induction principle is a theorem like any other: If [t] is
    defined inductively, the corresponding induction principle is
    called [t_ind].  Here is the one for natural numbers: *)

Check nat_ind.
(*  ===> nat_ind :
           forall P : nat -> Prop,
              P 0  ->
              (forall n : nat, P n -> P (S n))  ->
              forall n : nat, P n  *)

(** The [induction] tactic is a straightforward wrapper that, at its
    core, simply performs [apply t_ind].  To see this more clearly,
    let's experiment with directly using [apply nat_ind], instead of
    the [induction] tactic, to carry out some proofs.  Here, for
    example, is an alternate proof of a theorem that we saw in the
    [Basics] chapter. *)

Theorem mult_0_r' : forall n:nat,
  n * 0 = 0.
Proof.
  apply nat_ind.
  - (* n = O *)
    reflexivity.
  - (* n = S n' *)
    simpl. intros n' IHn'. rewrite -> IHn'.
    reflexivity.  Qed.

(** This proof is basically the same as the earlier one, but a
    few minor differences are worth noting.

    First, in the induction step of the proof (the ["S"] case), we
    have to do a little bookkeeping manually (the [intros]) that
    [induction] does automatically.

    Second, we do not introduce [n] into the context before applying
    [nat_ind] -- the conclusion of [nat_ind] is a quantified formula,
    and [apply] needs this conclusion to exactly match the shape of
    the goal state, including the quantifier.  By contrast, the
    [induction] tactic works either with a variable in the context or
    a quantified variable in the goal.

    These conveniences make [induction] nicer to use in practice than
    applying induction principles like [nat_ind] directly.  But it is
    important to realize that, modulo these bits of bookkeeping,
    applying [nat_ind] is what we are really doing. *)

(** **** Exercise: 2 stars, standard, optional (plus_one_r')

    Complete this proof without using the [induction] tactic. *)

Theorem plus_one_r' : forall n:nat,
  n + 1 = S n.
Proof.
  apply nat_ind.
  - reflexivity.
  - intros n H. apply plus_comm.
Qed.
(** [] *)

(** Coq generates induction principles for every datatype defined with
    [Inductive], including those that aren't recursive.  Although of
    course we don't need induction to prove properties of
    non-recursive datatypes, the idea of an induction principle still
    makes sense for them: it gives a way to prove that a property
    holds for all values of the type.

    These generated principles follow a similar pattern. If we define
    a type [t] with constructors [c1] ... [cn], Coq generates a
    theorem with this shape:

    t_ind : forall P : t -> Prop,
              ... case for c1 ... ->
              ... case for c2 ... -> ...
              ... case for cn ... ->
              forall n : t, P n

    The specific shape of each case depends on the arguments to the
    corresponding constructor.  Before trying to write down a general
    rule, let's look at some more examples. First, an example where
    the constructors take no arguments: *)

Inductive yesno : Type :=
  | yes
  | no.

Check yesno_ind.
(* ===> yesno_ind : forall P : yesno -> Prop,
                      P yes  ->
                      P no  ->
                      forall y : yesno, P y *)

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

    Write out the induction principle that Coq will generate for the
    following datatype.  Write down your answer on paper or type it
    into a comment, and then compare it with what Coq prints. *)

(*
  forall P: rgb -> Prop,
    P red ->
    P green ->
    P blue ->
    forall x: rgb, P x
*)
Inductive rgb : Type :=
  | red
  | green
  | blue.
Check rgb_ind.
(** [] *)

(** Here's another example, this time with one of the constructors
    taking some arguments. *)

Inductive natlist : Type :=
  | nnil
  | ncons (n : nat) (l : natlist).

Check natlist_ind.
(* ===> (modulo a little variable renaming)
   natlist_ind :
      forall P : natlist -> Prop,
         P nnil  ->
         (forall (n : nat) (l : natlist),
            P l -> P (ncons n l)) ->
         forall n : natlist, P n *)

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

    Suppose we had written the above definition a little
   differently: *)

Inductive natlist1 : Type :=
  | nnil1
  | nsnoc1 (l : natlist1) (n : nat).

(** Now what will the induction principle look like?
natlist1_ind:
  forall P: natlist1 -> Prop,

    [] *)

(** From these examples, we can extract this general rule:

    - The type declaration gives several constructors; each
      corresponds to one clause of the induction principle.
    - Each constructor [c] takes argument types [a1] ... [an].
    - Each [ai] can be either [t] (the datatype we are defining) or
      some other type [s].
    - The corresponding case of the induction principle says:

        - "For all values [x1]...[xn] of types [a1]...[an], if [P]
          holds for each of the inductive arguments (each [xi] of type
          [t]), then [P] holds for [c x1 ... xn]".
*)

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

    Write out the induction principle that Coq will generate for the
    following datatype.  (Again, write down your answer on paper or
    type it into a comment, and then compare it with what Coq
    prints.) *)

Inductive byntree : Type :=
 | bempty
 | bleaf (yn : yesno)
 | nbranch (yn : yesno) (t1 t2 : byntree).
(** [] *)

(*
( byntree_ind: forall P: byntree -> Prop,
    ( P bempty ) ->
    ( forall yn:yesno, P (blead yn) ) ->
    ( forall yn:yesno (t1 t2:byntree), P t1 -> P t2 -> P (nbranch yn t1 t2)) ->
    forall t:byntree, P t
*)

Check byntree_ind.
(** **** Exercise: 1 star, standard, optional (ex_set)

    Here is an induction principle for an inductively defined
    set.

      ExSet_ind :
         forall P : ExSet -> Prop,
             (forall b : bool, P (con1 b)) ->
             (forall (n : nat) (e : ExSet), P e -> P (con2 n e)) ->
             forall e : ExSet, P e

    Give an [Inductive] definition of [ExSet]: *)

Inductive ExSet : Type :=
  | con1 (b:bool)
  | cons2 (n:nat) (e: ExSet).

Check ExSet_ind.

(** [] *)

(* ################################################################# *)
(** * Polymorphism *)

(** Next, what about polymorphic datatypes?

    The inductive definition of polymorphic lists

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

    is very similar to that of [natlist].  The main difference is
    that, here, the whole definition is _parameterized_ on a set [X]:
    that is, we are defining a _family_ of inductive types [list X],
    one for each [X].  (Note that, wherever [list] appears in the body
    of the declaration, it is always applied to the parameter [X].)
    The induction principle is likewise parameterized on [X]:

      list_ind :
        forall (X : Type) (P : list X -> Prop),
           P [] ->
           (forall (x : X) (l : list X), P l -> P (x :: l)) ->
           forall l : list X, P l

    Note that the _whole_ induction principle is parameterized on
    [X].  That is, [list_ind] can be thought of as a polymorphic
    function that, when applied to a type [X], gives us back an
    induction principle specialized to the type [list X]. *)

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

    Write out the induction principle that Coq will generate for
   the following datatype.  Compare your answer with what Coq
   prints. *)

Inductive tree (X:Type) : Type :=
  | leaf (x : X)
  | node (t1 t2 : tree X).
Check tree_ind.
(*
  tree_ind:
    forall (X : Type) (P : tree X -> Prop),
    (forall x : X, P (leaf X x)) ->
    (forall t1 : tree X,
      P t1 ->
        forall t2 : tree X,
        P t2 -> P (node X t1 t2)) ->
          forall t : tree X, P t
*)

(** [] *)

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

    Find an inductive definition that gives rise to the
    following induction principle:

      mytype_ind :
        forall (X : Type) (P : mytype X -> Prop),
            (forall x : X, P (constr1 X x)) ->
            (forall n : nat, P (constr2 X n)) ->
            (forall m : mytype X, P m ->
               forall n : nat, P (constr3 X m n)) ->
            forall m : mytype X, P m
*)
(** [] *)

(* mytype X is a type
   mytype: Type -> Type
*)
Inductive mytype (X: Type) :=
  | constr1 (x:X)
  | constr2 (n:nat)
  | constr3 (m: mytype X) (n:nat).

Check mytype_ind.
(** **** Exercise: 1 star, standard, optional (foo)

    Find an inductive definition that gives rise to the
    following induction principle:

      foo_ind :
        forall (X Y : Type) (P : foo X Y -> Prop),
             (forall x : X, P (bar X Y x)) ->
             (forall y : Y, P (baz X Y y)) ->
             (forall f1 : nat -> foo X Y,
               (forall n : nat, P (f1 n)) -> P (quux X Y f1)) ->
             forall f2 : foo X Y, P f2
*)
(** [] *)

Inductive foo (X Y:Type) :=
  | bar (x : X)
  | baz (y : Y)
  | quux (f1:nat -> foo X Y).

Check foo_ind.

(** **** Exercise: 1 star, standard, optional (foo')

    Consider the following inductive definition: *)

Inductive foo' (X:Type) : Type :=
  | C1 (l : list X) (f : foo' X)
  | C2.

(** What induction principle will Coq generate for [foo']?  Fill
   in the blanks, then check your answer with Coq.)

     foo'_ind :
        forall (X : Type) (P : foo' X -> Prop),
              (forall (l : list X) (f : foo' X), P f -> P (C1 X k f)) ->
              P (C2 X) ->
             forall f : foo' X, P f
*)

Check foo'_ind.
(** [] *)

(* ################################################################# *)
(** * Induction Hypotheses *)

(** Where does the phrase "induction hypothesis" fit into this story?

    The induction principle for numbers

       forall P : nat -> Prop,
            P 0  ->
            (forall n : nat, P n -> P (S n))  ->
            forall n : nat, P n

   is a generic statement that holds for all propositions
   [P] (or rather, strictly speaking, for all families of
   propositions [P] indexed by a number [n]).  Each time we
   use this principle, we are choosing [P] to be a particular
   expression of type [nat->Prop].

   We can make proofs by induction more explicit by giving
   this expression a name.  For example, instead of stating
   the theorem [mult_0_r] as "[forall n, n * 0 = 0]," we can
   write it as "[forall n, P_m0r n]", where [P_m0r] is defined
   as... *)

Definition P_m0r (n:nat) : Prop :=
  n * 0 = 0.

(** ... or equivalently: *)

Definition P_m0r' : nat->Prop :=
  fun n => n * 0 = 0.

(** Now it is easier to see where [P_m0r] appears in the proof. *)

Theorem mult_0_r'' : forall n:nat,
  P_m0r n.
Proof.
  apply nat_ind.
  - (* n = O *) reflexivity.
  - (* n = S n' *)
    (* Note the proof state at this point! *)
    intros n IHn.
    unfold P_m0r in IHn. unfold P_m0r. simpl. apply IHn. Qed.

(** This extra naming step isn't something that we do in
    normal proofs, but it is useful to do it explicitly for an example
    or two, because it allows us to see exactly what the induction
    hypothesis is.  If we prove [forall n, P_m0r n] by induction on
    [n] (using either [induction] or [apply nat_ind]), we see that the
    first subgoal requires us to prove [P_m0r 0] ("[P] holds for
    zero"), while the second subgoal requires us to prove [forall n',
    P_m0r n' -> P_m0r (S n')] (that is "[P] holds of [S n'] if it
    holds of [n']" or, more elegantly, "[P] is preserved by [S]").
    The _induction hypothesis_ is the premise of this latter
    implication -- the assumption that [P] holds of [n'], which we are
    allowed to use in proving that [P] holds for [S n']. *)

(* ################################################################# *)
(** * More on the [induction] Tactic *)

(** The [induction] tactic actually does even more low-level
    bookkeeping for us than we discussed above.

    Recall the informal statement of the induction principle for
    natural numbers:
      - If [P n] is some proposition involving a natural number n, and
        we want to show that P holds for _all_ numbers n, we can
        reason like this:
          - show that [P O] holds
          - show that, if [P n'] holds, then so does [P (S n')]
          - conclude that [P n] holds for all n.
    So, when we begin a proof with [intros n] and then [induction n],
    we are first telling Coq to consider a _particular_ [n] (by
    introducing it into the context) and then telling it to prove
    something about _all_ numbers (by using induction).

    What Coq actually does in this situation, internally, is to
    "re-generalize" the variable we perform induction on.  For
    example, in our original proof that [plus] is associative... *)

Theorem plus_assoc' : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  (* ...we first introduce all 3 variables into the context,
     which amounts to saying "Consider an arbitrary [n], [m], and
     [p]..." *)
  intros n m p.
  (* ...We now use the [induction] tactic to prove [P n] (that
     is, [n + (m + p) = (n + m) + p]) for _all_ [n],
     and hence also for the particular [n] that is in the context
     at the moment. *)
  induction n as [| n'].
  - (* n = O *) reflexivity.
  - (* n = S n' *)
    (* In the second subgoal generated by [induction] -- the
       "inductive step" -- we must prove that [P n'] implies
       [P (S n')] for all [n'].  The [induction] tactic
       automatically introduces [n'] and [P n'] into the context
       for us, leaving just [P (S n')] as the goal. *)
    simpl. rewrite -> IHn'. reflexivity.  Qed.

(** It also works to apply [induction] to a variable that is
    quantified in the goal. *)

Theorem plus_comm' : forall n m : nat,
  n + m = m + n.
Proof.
  induction n as [| n'].
  - (* n = O *) intros m. rewrite <- plus_n_O. reflexivity.
  - (* n = S n' *) intros m. simpl. rewrite -> IHn'.
    rewrite <- plus_n_Sm. reflexivity.  Qed.

(** Note that [induction n] leaves [m] still bound in the goal --
    i.e., what we are proving inductively is a statement beginning
    with [forall m].

    If we do [induction] on a variable that is quantified in the goal
    _after_ some other quantifiers, the [induction] tactic will
    automatically introduce the variables bound by these quantifiers
    into the context. *)

Theorem plus_comm'' : forall n m : nat,
  n + m = m + n.
Proof.
  (* Let's do induction on [m] this time, instead of [n]... *)
  induction m as [| m'].
  - (* m = O *) simpl. rewrite <- plus_n_O. reflexivity.
  - (* m = S m' *) simpl. rewrite <- IHm'.
    rewrite <- plus_n_Sm. reflexivity.  Qed.

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

    Rewrite both [plus_assoc'] and [plus_comm'] and their proofs in
    the same style as [mult_0_r''] above -- that is, for each theorem,
    give an explicit [Definition] of the proposition being proved by
    induction, and state the theorem and proof in terms of this
    defined proposition.  *)

Check nat_ind.

Definition P_plus_assoc (m:nat): Prop :=
  forall n p, (m + n) + p = m + (n + p).

Definition P_plus_comm (m:nat): Prop := forall n, m + n = n + m.

Theorem plus_comm_from_def: forall m, P_plus_comm m.
Proof.
  apply nat_ind.
  - unfold P_plus_comm.
    apply nat_ind.
    { reflexivity. }
    { intros n H. simpl.
      rewrite <- H. simpl.
      reflexivity.
    }
  - unfold P_plus_comm.
    intros n H.
    intros n0.
    simpl.
    Search (_ + S _ = S (_ + _)).
    rewrite plus_n_Sm.
    rewrite H.
    reflexivity.
Qed.

(* ################################################################# *)
(** * Induction Principles in [Prop] *)

(** Earlier, we looked in detail at the induction principles that Coq
    generates for inductively defined _sets_.  The induction
    principles for inductively defined _propositions_ like [even] are a
    tiny bit more complicated.  As with all induction principles, we
    want to use the induction principle on [even] to prove things by
    inductively considering the possible shapes that something in [even]
    can have.  Intuitively speaking, however, what we want to prove
    are not statements about _evidence_ but statements about
    _numbers_: accordingly, we want an induction principle that lets
    us prove properties of numbers by induction on evidence.

    For example, from what we've said so far, you might expect the
    inductive definition of [even]...

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

    ...to give rise to an induction principle that looks like this...

    ev_ind_max : forall P : (forall n : nat, even n -> Prop),
         P O ev_0 ->
         (forall (m : nat) (E : even m),
            P m E ->
            P (S (S m)) (ev_SS m E)) ->
         forall (n : nat) (E : even n),
         P n E

     ... because:

     - Since [even] is indexed by a number [n] (every [even] object [E] is
       a piece of evidence that some particular number [n] is even),
       the proposition [P] is parameterized by both [n] and [E] --
       that is, the induction principle can be used to prove
       assertions involving both an even number and the evidence that
       it is even.

     - Since there are two ways of giving evidence of evenness ([even]
       has two constructors), applying the induction principle
       generates two subgoals:

         - We must prove that [P] holds for [O] and [ev_0].

         - We must prove that, whenever [n] is an even number and [E]
           is an evidence of its evenness, if [P] holds of [n] and
           [E], then it also holds of [S (S n)] and [ev_SS n E].

     - If these subgoals can be proved, then the induction principle
       tells us that [P] is true for _all_ even numbers [n] and
       evidence [E] of their evenness.

    This is more flexibility than we normally need or want: it is
    giving us a way to prove logical assertions where the assertion
    involves properties of some piece of _evidence_ of evenness, while
    all we really care about is proving properties of _numbers_ that
    are even -- we are interested in assertions about numbers, not
    about evidence.  It would therefore be more convenient to have an
    induction principle for proving propositions [P] that are
    parameterized just by [n] and whose conclusion establishes [P] for
    all even numbers [n]:

       forall P : nat -> Prop,
       ... ->
       forall n : nat,
       even n -> P n

    For this reason, Coq actually generates the following simplified
    induction principle for [even]: *)

Check even_ind.
(* ===> ev_ind
        : forall P : nat -> Prop,
          P 0 ->
          (forall n : nat, even n -> P n -> P (S (S n))) ->
          forall n : nat,
          even n -> P n *)

(** In particular, Coq has dropped the evidence term [E] as a
    parameter of the the proposition [P]. *)

(** In English, [ev_ind] says:

    - Suppose, [P] is a property of natural numbers (that is, [P n] is
      a [Prop] for every [n]).  To show that [P n] holds whenever [n]
      is even, it suffices to show:

      - [P] holds for [0],

      - for any [n], if [n] is even and [P] holds for [n], then [P]
        holds for [S (S n)]. *)

(** As expected, we can apply [ev_ind] directly instead of using
    [induction].  For example, we can use it to show that [even'] (the
    slightly awkward alternate definition of evenness that we saw in
    an exercise in the \chap{IndProp} chapter) is equivalent to the
    cleaner inductive definition [even]: *)
Theorem ev_ev' : forall n, even n -> even' n.
Proof.
  apply even_ind.
  - (* ev_0 *)
    apply even'_0.
  - (* ev_SS *)
    intros m Hm IH.
    apply (even'_sum 2 m).
    + apply even'_2.
    + apply IH.
Qed.

(** The precise form of an [Inductive] definition can affect the
    induction principle Coq generates.

    For example, in chapter [IndProp], we defined [<=] as: *)

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

(** This definition can be streamlined a little by observing that the
    left-hand argument [n] is the same everywhere in the definition,
    so we can actually make it a "general parameter" to the whole
    definition, rather than an argument to each constructor. *)

Inductive le (n:nat) : nat -> Prop :=
  | le_n : le n n
  | le_S m (H : le n m) : le n (S m).

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

(** The second one is better, even though it looks less symmetric.
    Why?  Because it gives us a simpler induction principle. *)

Check le_ind.
(* ===>  forall (n : nat) (P : nat -> Prop),
           P n ->
           (forall m : nat, n <= m -> P m -> P (S m)) ->
           forall n0 : nat, n <= n0 -> P n0 *)

(* ################################################################# *)
(** * Formal vs. Informal Proofs by Induction *)

(** Question: What is the relation between a formal proof of a
    proposition [P] and an informal proof of the same proposition [P]?

    Answer: The latter should _teach_ the reader how to produce the
    former.

    Question: How much detail is needed??

    Unfortunately, there is no single right answer; rather, there is a
    range of choices.

    At one end of the spectrum, we can essentially give the reader the
    whole formal proof (i.e., the "informal" proof will amount to just
    transcribing the formal one into words).  This may give the reader
    the ability to reproduce the formal one for themselves, but it
    probably doesn't _teach_ them anything much.

   At the other end of the spectrum, we can say "The theorem is true
   and you can figure out why for yourself if you think about it hard
   enough."  This is also not a good teaching strategy, because often
   writing the proof requires one or more significant insights into
   the thing we're proving, and most readers will give up before they
   rediscover all the same insights as we did.

   In the middle is the golden mean -- a proof that includes all of
   the essential insights (saving the reader the hard work that we
   went through to find the proof in the first place) plus high-level
   suggestions for the more routine parts to save the reader from
   spending too much time reconstructing these (e.g., what the IH says
   and what must be shown in each case of an inductive proof), but not
   so much detail that the main ideas are obscured.

   Since we've spent much of this chapter looking "under the hood" at
   formal proofs by induction, now is a good moment to talk a little
   about _informal_ proofs by induction.

   In the real world of mathematical communication, written proofs
   range from extremely longwinded and pedantic to extremely brief and
   telegraphic.  Although the ideal is somewhere in between, while one
   is getting used to the style it is better to start out at the
   pedantic end.  Also, during the learning phase, it is probably
   helpful to have a clear standard to compare against.  With this in
   mind, we offer two templates -- one for proofs by induction over
   _data_ (i.e., where the thing we're doing induction on lives in
   [Type]) and one for proofs by induction over _evidence_ (i.e.,
   where the inductively defined thing lives in [Prop]). *)

(* ================================================================= *)
(** ** Induction Over an Inductively Defined Set *)

(** _Template_:

       - _Theorem_: <Universally quantified proposition of the form
         "For all [n:S], [P(n)]," where [S] is some inductively defined
         set.>

         _Proof_: By induction on [n].

           <one case for each constructor [c] of [S]...>

           - Suppose [n = c a1 ... ak], where <...and here we state
             the IH for each of the [a]'s that has type [S], if any>.
             We must show <...and here we restate [P(c a1 ... ak)]>.

             <go on and prove [P(n)] to finish the case...>

           - <other cases similarly...>                        []

    _Example_:

      - _Theorem_: For all sets [X], lists [l : list X], and numbers
        [n], if [length l = n] then [index (S n) l = None].

        _Proof_: By induction on [l].

        - Suppose [l = []].  We must show, for all numbers [n],
          that, if [length [] = n], then [index (S n) [] =
          None].

          This follows immediately from the definition of [index].

        - Suppose [l = x :: l'] for some [x] and [l'], where
          [length l' = n'] implies [index (S n') l' = None], for
          any number [n'].  We must show, for all [n], that, if
          [length (x::l') = n] then [index (S n) (x::l') =
          None].

          Let [n] be a number with [length l = n].  Since

            length l = length (x::l') = S (length l'),

          it suffices to show that

            index (S (length l')) l' = None.

          But this follows directly from the induction hypothesis,
          picking [n'] to be [length l'].  [] *)

(* ================================================================= *)
(** ** Induction Over an Inductively Defined Proposition *)

(** Since inductively defined proof objects are often called
    "derivation trees," this form of proof is also known as _induction
    on derivations_.

    _Template_:

       - _Theorem_: <Proposition of the form "[Q -> P]," where [Q] is
         some inductively defined proposition (more generally,
         "For all [x] [y] [z], [Q x y z -> P x y z]")>

         _Proof_: By induction on a derivation of [Q].  <Or, more
         generally, "Suppose we are given [x], [y], and [z].  We
         show that [Q x y z] implies [P x y z], by induction on a
         derivation of [Q x y z]"...>

           <one case for each constructor [c] of [Q]...>

           - Suppose the final rule used to show [Q] is [c].  Then
             <...and here we state the types of all of the [a]'s
             together with any equalities that follow from the
             definition of the constructor and the IH for each of
             the [a]'s that has type [Q], if there are any>.  We must
             show <...and here we restate [P]>.

             <go on and prove [P] to finish the case...>

           - <other cases similarly...>                        []

    _Example_

       - _Theorem_: The [<=] relation is transitive -- i.e., for all
         numbers [n], [m], and [o], if [n <= m] and [m <= o], then
         [n <= o].

         _Proof_: By induction on a derivation of [m <= o].

           - Suppose the final rule used to show [m <= o] is
             [le_n]. Then [m = o] and we must show that [n <= m],
             which is immediate by hypothesis.

           - Suppose the final rule used to show [m <= o] is
             [le_S].  Then [o = S o'] for some [o'] with [m <= o'].
             We must show that [n <= S o'].
             By induction hypothesis, [n <= o'].

             But then, by [le_S], [n <= S o'].  [] *)

(* Wed Jan 9 12:02:46 EST 2019 *)


(** Calculation of the simple arithmetic language. *)

Require Import Tactics.
Require Export Memory.
Module Arith (mem : MemoryExt).
Import mem.

(** * Syntax *)

Inductive var := X | Y | Z.

Inductive Expr : Set :=
| Val : nat -> Expr
| Add : Expr -> Expr -> Expr
| Var : var -> Expr.

(** * Semantics *)

Definition env := var -> nat.

Fixpoint eval (e : env) (x: Expr) : nat :=
  match x with
    | Val n => n
    | Add x1 x2 => eval e x1 + eval e x2
    | Var v => e v
  end.

(** * Compiler *)

Inductive Code : Set :=
| LOAD : nat -> Code -> Code
| LDA : adr -> Code -> Code
| ADD : adr -> Code -> Code
| STORE : adr -> Code -> Code
| HALT : Code.

Fixpoint comp' (x : Expr) (vars: var -> adr) (r : adr) (c : Code) : Code :=
  match x with
  | Val n => LOAD n c
  | Add x1 x2 => comp' x1  vars r (STORE r (comp' x2 vars (next r) (ADD r c)))
  | Var v => LDA (vars v) c
  end.

Definition mkVars : var -> adr :=
  fun v =>
    match v with
    | X => first
    | Y => next first
    | Z => next (next first)
    end.

Definition firstFresh : adr := next (next (next first)).

Definition mkMem (e : env) : Mem :=
  set (mkVars Z) (e Z) ((set (mkVars Y) (e Y) (set (mkVars X) (e X) empty))).

Definition comp (x : Expr) : Code := comp' x mkVars firstFresh HALT.

(** * Virtual Machine *)

Definition Memory : Type := Mem.
Definition Acc : Type := nat.

Definition State : Type := (Code * Memory * Acc)%type.

Reserved Notation "x ==> y" (at level 80, no associativity).
Inductive VM : State -> State -> Prop :=
| vm_load n c m a : (LOAD n c , m, a) ==> (c , m, n)
| vm_add c r m a : (ADD r c, m, a) ==> (c, free r m, get r m + a)
| vm_store c r m a : (STORE r c, m, a) ==> (c, set r a m, a)
| vm_lda c r m a : (LDA r c, m, a) ==> (c, m, get r m)
where "x ==> y" := (VM x y).

(** * Calculation *)

(** Boilerplate to import calculation tactics *)

Module VM <: Preorder.
Definition State := State.
Definition VM := VM.
End VM.
Module VMCalc := Calculation VM.
Import VMCalc.

Lemma env_fresh (e : env) vars r m
  (Fresh : forall v, vars v < r)
  (Env : forall v, e v = get (vars v) m) v n:
  e v = get (vars v) (set r n m).
Proof.
  rewrite get_set'; auto using next_fresh.
Qed.

(** Specification of the compiler *)

Theorem spec x r c a m vars e
  (Fresh : forall v, vars v < r)
  (Env : forall v, e v = get (vars v) m):
  isFreeFrom r m ->
  (comp' x vars r c, m, a) =>> (c , m, eval e x).

(** Setup the induction proof *)

Proof.
  intros.
  generalize dependent c.
  generalize dependent m.
  generalize dependent r.
  generalize dependent a.
  induction x;intros.

(** Calculation of the compiler *)

(** - [x = Val n]: *)

  begin
  (c, m, n).
  <== { apply vm_load }
  (LOAD n c, m, a).
  [].

(** - [x = Add x1 x2]: *)

  begin
    (c, m, eval e x1 + eval e x2).
  = {rewrite isFreeFrom_free, get_set}
    (c, free r (set r (eval e x1) m), get r (set r (eval e x1) m)  + eval e x2).
  <== {apply vm_add}
    (ADD r c, set r (eval e x1) m, eval e x2).
  <<= {apply IHx2; auto using isFreeFrom_set, env_fresh}
    (comp' x2 vars (next r) (ADD r c), set r (eval e x1) m, eval e x1).
  <== {apply vm_store}
    (STORE r (comp' x2 vars (next r) (ADD r c)), m, eval e x1).
  <<= { apply IHx1}
    (comp' x1 vars r (STORE r (comp' x2 vars (next r) (ADD r c))), m, a).
  [].

(** - [x = Var v]: *)

  begin
    (c, m, e v).
  = {rewrite Env}
    (c, m, get (vars v) m).
  <<= {apply vm_lda}
    (LDA (vars v) c , m, a).
  [].
Qed.

Lemma mkMemEnv (e : env) (v : var) : e v = get (mkVars v) (mkMem e).
Proof.
  destruct v;
  unfold mkMem; simpl;
    repeat first [rewrite get_set' by (apply next_fresh; auto) | rewrite get_set];
    reflexivity.
Qed.

Lemma mkVarsFresh v : mkVars v < firstFresh.
Proof.
  unfold firstFresh. destruct v; simpl; auto.
Qed.

Lemma isFreeFromFirst e : isFreeFrom firstFresh (mkMem e).
Proof.
  unfold mkMem. simpl. eauto using isFreeFrom_first, isFreeFrom_set.
Qed.

Theorem spec_top x a e:
  (comp x, mkMem e, a) =>> (HALT , mkMem e, eval e x).
Proof.
  apply spec.
  - apply mkVarsFresh.
  - apply mkMemEnv.
  - apply isFreeFromFirst.
Qed.

(** * Soundness *)

(** Since the VM is defined as a small step operational semantics, we
have to prove that the VM is deterministic and does not get stuck in
order to derive soundness from the above theorem. *)

Lemma determ_vm : determ VM.
  intros C C1 C2 V. induction V; intro V'; inversion V'; subst; reflexivity.
Qed.

Theorem sound x a C e : (comp x, mkMem e, a) =>>! C -> C = (HALT , mkMem e, eval e x).
Proof.
  intros.
  pose (spec_top x) as H'. unfold comp in *. pose (determ_trc determ_vm) as D.
  unfold determ in D. eapply D. apply H. split. apply H'. intro Contra. destruct Contra.
  inversion H0.
Qed.

End Arith.


(* pair constructing *)

Inductive natprod : Type :=
  | pair (n1 n2 : nat).

(* getting first or second *)
Definition fst (p : natprod) : nat :=
    match p with
    | pair x y => x
    end.
Definition snd (p : natprod) : nat :=
    match p with
    | pair x y => y
    end.

Compute fst(pair 1 2). (* 1 *)

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

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

(* Note that pattern-matching on a pair (with parentheses: (x, y)) is not to be confused with the "multiple pattern" syntax (with no parentheses: x, y) that we have seen previously. The above examples illustrate pattern matching on a pair with elements x and y, whereas, for example, the definition of minus in Basics performs pattern matching on the values n and m: *)

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

(* The distinction is minor, but it is worth knowing that they are not the same.  *)

(* Now let's try to prove a few simple facts about pairs.
If we state properties of pairs in a slightly peculiar way, we can sometimes complete their proofs with just reflexivity (and its built-in simplification): *)

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

(* But just reflexivity is not enough if we state the lemma in the most natural way: *)
Theorem surjective_pairing_stuck : forall (p : natprod),
    p = (fst p, snd p).
Proof.
    simpl. (* Doesn't reduce anything! *) Abort.

(* Instead, we need to expose the structure of p so that simpl can perform the pattern match in fst and snd. We can do this with destruct. *)

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

(* Notice that, unlike its behavior with nats, where it generates two subgoals, destruct generates just one subgoal here. That's because natprods can only be constructed in one way. *)


Require Export D.

Inductive natprod : Type :=
  pair : nat -> nat -> natprod.

Check (pair 3 5).

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

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

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

Eval compute in (fst (3,5)).

Definition swap_pari (p:natprod) : natprod :=
(snd p, fst p).

Inductive natlist : Type :=
| nil : natlist
| cons : nat -> natlist -> natlist.

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

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

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

Fixpoint app (l1 l2:natlist) : natlist :=
match l1 with
|[] => l2
|hd::tl => hd::(app tl l2)
end.

Definition hd (default:nat) (l:natlist) : nat :=
match l with
| [] => default
| hd::tl => hd
end.

Definition tl (l:natlist) : natlist :=
match l with
| [] => []
| hd::tl => tl
end.

Example test_hd1: hd 0 [1;2;3] = 1.
Proof. reflexivity. Qed.
Example test_hd2: hd 0 [] = 0.
Proof. reflexivity. Qed.
Example test_tl: tl [1;2;3] = [2;3].
Proof. reflexivity. Qed.

Fixpoint nonzeros (l:natlist) : natlist :=
match l with
|[] => []
|hd::tl => if beq_nat hd 0 then nonzeros tl
          else hd::(nonzeros tl)
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
|[] => []
|hd::tl => if oddb hd then hd::(oddmembers tl)
          else oddmembers tl
end.

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

Fixpoint countoddmembers (l:natlist) : nat :=
match l with
|[] => O
|hd::tl => if oddb hd then S (countoddmembers tl)
          else countoddmembers tl
end.

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 snoc (l:natlist) (v:nat) : natlist :=
match l with
| [] => [v]
| hd::tl => hd::(snoc tl v)
end.

Fixpoint rev (l:natlist) : natlist :=
match l with
|[] => []
|hd::tl => snoc (rev tl) hd
end.
Example test_rev1: rev [1;2;3] = [3;2;1].
Proof. reflexivity. Qed.
Example test_rev2: rev nil = nil.
Proof. reflexivity. Qed.

Inductive natoption : Type :=
|Some : nat ->natoption
|None : natoption
.

Fixpoint index (n:nat) (l:natlist) : natoption :=
match l with
|[] => None
|hd::tl => if beq_nat n 0 then Some hd
          else index (pred n) tl
end.

Example test_index1 : index 0 [4;5;6;7] = Some 4.
Proof. reflexivity. Qed.
Example test_index2 : index 3 [4;5;6;7] = Some 7.
Proof. reflexivity. Qed.
Example test_index3 : index 10 [4;5;6;7] = None.
Proof. reflexivity. Qed.


From LF Require Export Induction.

Module NatList.

Inductive natprod : Type :=
| pair : nat -> nat -> natprod.

Check (pair 3 5).

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

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

Compute (fst (pair 3 5)).

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

Compute (fst (4,5)).

Definition fst' (p : natprod ) : nat :=
match p with
| (x,y) => x
end.
Definition snd' (p : natprod ) : nat :=
match p with
| (x,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]. simpl. 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].
    simpl.
    reflexivity.
Qed.

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

Inductive natlist: Type :=
| nil : natlist
| cons : nat -> natlist -> natlist.

Notation " x :: l " := (cons x l).

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

Notation "[ ]" := nil.

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

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

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

Notation "x ++ y" := (app x y).

Example test_app1 : [1;2;3] ++ [4;5] = [1;2;3;4;5].
Proof. reflexivity. Qed.
Example test_app2 : nil ++ [4;5] = [4;5].
Proof. reflexivity. Qed.
Example test_app3 : [1;2;3] ++ nil = [1;2;3].
Proof. reflexivity. Qed.

Definition hd (default:nat) (l :natlist) : nat :=
match l with
    | nil => default
    | h :: t => h
end.
Definition tl (l :natlist) : natlist :=
match l with
    | nil => nil
    | h :: t => t
end.
Example test_hd1 : hd 0 [1;2;3] = 1.
Proof. reflexivity. Qed.
Example test_hd2 : hd 0 nil = 0.
Proof. reflexivity. Qed.
Example test_tl : tl [1;2;3] = [2;3].
Proof. reflexivity. Qed.

Fixpoint nonzeros (l :natlist) : natlist :=
match l with
    | nil => nil
    | h :: t => match h with
                | O => nonzeros t
                | S h' => h :: (nonzeros t)
                end
end.
Example test_nonzeros: nonzeros [0;1;0;2;3;0;0] = [1;2;3].
Proof. simpl. reflexivity. Qed.

Fixpoint oddmembers (l :natlist) : natlist :=
match l with
    | nil => nil
    | h :: t => match (odd h) with
                | false => oddmembers t
                | true => h :: (oddmembers t)
                end
end.

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

Fixpoint countoddmembers (l :natlist) : nat :=
match l with
    | nil => O
    | h :: t => match (odd h) with
                | false => countoddmembers t
                | true => S (countoddmembers t)
                end
end.

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

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

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

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

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

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

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

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

Definition bag := natlist.

Fixpoint count (v :nat) (s:bag) : nat :=
match s with
    | nil => O
    | h :: t => match eqb v h with
                | true => S (count v t)
                | false => count v t
                end
end.

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

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

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

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

Definition add (v :nat) (s:bag) : bag :=
v :: s.

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

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

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

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

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

Fixpoint remove_one (v :nat) (s:bag) : bag :=
match s with
    | nil => nil
    | h :: t => match eqb h v with
                | true => t
                | false => h :: remove_one v t
                end
end.

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

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

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

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

Fixpoint remove_all (v :nat) (s:bag) : bag :=
    match s with
    | nil => nil
    | h :: t => match eqb h v with
                | true => remove_all v t
                | false => h :: remove_all v t
                end
end.

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

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

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

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

Fixpoint subset (s1 :bag) (s2 :bag) : bool :=
match s1 with
    | nil => true
    | h :: t => match leb (count h s1)  (count h s2) with
                | true => subset t s2
                | false => false
                end
end.

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

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

Theorem bag_sum_nil: forall (b : bag), sum b [] = b .
Proof.
    induction b as [|h' t' IHb'].
    - reflexivity.
    - simpl. rewrite IHb'. reflexivity.
Qed.

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

Theorem bag_theorem1 : forall v1 v2 : nat, forall b: bag, leb (count v1 b) (count v1 (add v2 b)) = true.
Proof.
    intros v1 v2 b.
    induction b as [|h t IHb'].
    - reflexivity.
    - simpl. destruct (eqb v1 h) as [|].
        -- destruct (eqb v1 v2) as [|].
            --- simpl. rewrite -> leb_n_Sn. reflexivity.
            --- simpl. rewrite leb_refl. reflexivity.
        -- destruct (eqb v1 v2) as [|].
            --- simpl. rewrite -> leb_n_Sn. reflexivity.
            --- simpl. rewrite leb_refl. reflexivity.
Qed.

Theorem bag_theorem2 : forall v : nat, forall b1 b2 : bag, leb (count v b1) (count v (sum b1 b2)) = true.
Proof.
    intros v b1 b2.
    induction b1 as [|h1 b1 IHb1].
    - simpl. reflexivity.
    - simpl. destruct (eqb v h1) as [|].
        -- simpl. rewrite IHb1. reflexivity.
        -- rewrite IHb1. reflexivity.
Qed.

(* Theorem bag_theorem3 : forall v : nat, forall b1 b2, (member v b1) && (member v b2) = true -> subset b1 b2 = true .
Proof.
    intros v.
    intros b1 b2.
    destruct (member v b1) as [|].
    - destruct (member v b2) as [|].
        -- simpl. induction b1 as [|h1 t1 IHb1].
            --- reflexivity.
            --- assert(H1 : member v b2 = true). {
                reflexivity.
                }
Qed. *)

(*
Theorem bag_theorem3 : forall v : nat, forall b , subset b (v :: b) = true.
Proof.
    intros v b.
    induction b

Theorem bag_theorem3 : forall b , subset b b = true.
Proof.
    intros b.
    induction b as [|h t IHb].
    - reflexivity.
    - simpl. rewrite <- eqb_refl. simpl. rewrite <- leb_refl. simpl.

Theorem bag_theorem3 : forall b1 b2 : bag, subset b1 (sum b1 b2) = true.
Proof.
    induction b1 as [|h1 t1 IHb].
    - simpl. reflexivity.
    - simpl. rewrite <- eqb_refl. simpl. intros b2. rewrite bag_theorem2.
        assert(H1 : leb (count h1 t1) (count h1 (sum t1 b2)) = true). {
            rewrite bag_theorem2. reflexivity
        }

        rewrite -> bag_theorem2.  destruct (eqb h1 v) as [|].
        -- simpl. rewrite leb_n_Sn.

Theorem bag_theorem3 : forall v : nat, forall b1 b2 , subset b1 (v :: sum b1 b2) = subset b1 (sum b1 b2).
Proof.
    intros v b1 b2.
    induction b2 as [|h2 t2 IHb2].
    - rewrite bag_sum_nil. rewrite reflexivity.
    - simpl. rewrite <- eqb_refl. simpl. destruct (eqb h1 v) as [|].
        -- rewrite -> bag_theorem2. rewrite <- leb_n_Sn.

Theorem bag_theorem : forall b1 b2 : bag, subset b1 (sum b1 b2) = true.
Proof.
    intros b1 b2.
    induction b1 as [|h1 t1 IHb1].
    -- simpl. reflexivity.
    -- simpl. rewrite <- eqb_refl. simpl. rewrite bag_theorem2. simpl. *)

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

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

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

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

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

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

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

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

Theorem rev_add_n: forall l : natlist, forall n : nat, rev(l ++ [n]) = [n] ++ rev l.
Proof.
    intros l n.
    induction l as [|h l' IHl'].
    - reflexivity.
    - simpl. rewrite IHl'. reflexivity.
Qed.

Theorem rev_involutive : forall l : natlist,
rev (rev l ) = l.
Proof.
    intros l.
    induction l as [|n l' IHl'].
    - reflexivity.
    - simpl. rewrite rev_add_n. rewrite IHl'. reflexivity.
Qed.

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

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

Fixpoint eqblist (l1 l2 : natlist) : bool :=
match l1 with
| nil => match l2 with
            | nil => true
            | n2::l2' => false
        end
| n1::l1' => match l2 with
            | nil => false
            | n2::l2' => match eqb n1 n2 with
                    | true => eqblist l1' l2'
                    | false => false
                    end
            end
end.

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

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

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

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

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

Theorem ble_n_Sn : forall n,
leb n (S n) = true.
Proof.
    intros n. induction n as [| n' IHn' ].
    - simpl. reflexivity.
    - simpl. rewrite IHn'. reflexivity.
Qed.

Theorem remove_decreases_count: forall (s : bag),
leb (count 0 (remove_one 0 s)) (count 0 s) = true.
Proof.
    induction s as [| h t IHs'].
    - reflexivity.
    - simpl. destruct h as [| h'].
        -- simpl. rewrite ble_n_Sn. reflexivity.
        -- simpl. rewrite IHs'. reflexivity.
Qed.

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

Inductive natoption : Type :=
| Some : nat -> natoption
| None : natoption.

Fixpoint nth_error (l :natlist) (n:nat) : natoption :=
match l with
| nil => None
| a :: l' => match eqb n O with
        | true => Some a
        | false => nth_error l' (pred n)
        end
end.
Example test_nth_error1 : nth_error [4;5;6;7] 0 = Some 4.
Proof. reflexivity. Qed.
Example test_nth_error2 : nth_error [4;5;6;7] 3 = Some 7.
Proof. reflexivity. Qed.
Example test_nth_error3 : nth_error [4;5;6;7] 9 = None.
Proof. reflexivity. Qed.

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

Definition hd_error (l : natlist) : natoption :=
match l with
| nil => None
| n :: t => Some n
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.

Theorem option_elim_hd : forall (l :natlist) (default:nat),
hd default l = option_elim default (hd_error l ).
Proof.
    intros l default.
    destruct l as [|h t].
    - reflexivity.
    - simpl. reflexivity.
Qed.

Inductive id : Type :=
| Id : nat -> id.

Definition beq_id x1 x2 :=
match x1, x2 with
| Id n1, Id n2 => eqb n1 n2
end.

Theorem beq_id_refl : forall x, true = beq_id x x.
Proof.
    intros x.
    destruct x as [].
    simpl. rewrite eqb_refl. reflexivity.
Qed.

End NatList.

Module PartialMap.
Import NatList.

Inductive partial_map : Type :=
| empty : partial_map
| record : id -> nat -> partial_map -> partial_map.

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

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

Theorem update_eq :
forall (d : partial_map) (k : id ) (v : nat),
find k (update d k v ) = Some v.
Proof.
    intros d k v.
    destruct d as [|id' n' d'].
    - simpl. rewrite <- beq_id_refl. reflexivity.
    - simpl. rewrite <- beq_id_refl. reflexivity.
Qed.

Theorem update_neq :
forall (d : partial_map) (m n : id ) (o: nat),
beq_id m n = false -> find m (update d n o) = find m d.
Proof.
    intros d m n o H.
    simpl. rewrite H. reflexivity.
Qed.

(* Inductive baz : Type :=
| Baz1 : baz -> baz
| Baz2 : baz -> bool -> baz.
How many elements does the type baz have? zero *)

Definition injective : forall {t1 t2}, (t1 -> t2) -> Prop := fun t1 t2 f1 => forall x1 x2, f1 x1 = f1 x2 -> x1 = x2.

Definition surjective : forall {t1 t2}, (t1 -> t2) -> Prop := fun t1 t2 f1 => forall x1, exists x2, f1 x2 = x1.

Definition bijective : forall {t1 t2}, (t1 -> t2) -> Prop := fun t1 t2 f1 => injective f1 /\ surjective f1.

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

Theorem baz_False : baz -> False.
Proof.
    induction 1;
    firstorder.
Qed.

Goal exists f1 : baz -> False, bijective f1.
Proof.
exists baz_False. unfold bijective, injective, surjective. firstorder.
assert (H2 := baz_False x1). firstorder.
assert (H2 := x1). firstorder.
Qed.

End PartialMap.


From mathcomp Require Import all_ssreflect.
Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Definition next (p: nat * nat): nat * nat :=
  match p with
  | (0, y) => (S y, 0)
  | (S x, y) => (x, S y)
  end.

Compute (next (0,0)).
Compute (next (1,0)).
Compute (next (0, 1)).
Compute (next (3, 3)).

Fixpoint decode (n: nat): nat * nat :=
  match n with
  | 0 => (0, 0)
  | S n' => next (decode n')
  end.

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

Definition encode (p: nat * nat): nat :=
  let (x, y) := p in s (x + y) + y.

(* 7.2.1 *)
Theorem step: forall c, encode (next c) = S (encode c).
Proof.
  move => [x y].
  elim x.
    by rewrite /next /encode 2!addn0 add0n /(s y.+1) -/s addSn addnC.
  move => n IH.
  by rewrite /next /encode addnS addSn addnS.
Qed.

(* 7.2.2 *)
Theorem eq: forall n, encode (decode n) = n.
Proof.
  elim => [//| n IH].
  by rewrite /decode -/decode step IH.
Qed.

(* 7.2.3 *)
Lemma enc0: forall c, encode c = 0 -> c = (0, 0).
Proof.
  move => [x y].
  case x; case y => //.
Qed.

Lemma step_enc: forall x y, next (S x, y) = (x, S y).
Proof. by []. Qed.

Lemma step_enc': forall x, next (0, x) = (S x, 0).
Proof. by []. Qed.

Theorem eq': forall c, decode (encode c) = c.
Proof.
  move => c.
  (* elim: {-1}(encode c) (erefl (encode c)). *)
  have H: (forall ec, encode c = ec -> decode ec = c) -> (decode (encode c) = c).
    move => Hec.
    by apply Hec.
  apply H => {H}.
  move => ec.
  move: c.
  elim: ec => [c |n IH c].
    by move/enc0 ->.
  rewrite /decode -/decode.
  case: c IH => [x y] IH.
  case x; case y => //.
    move => n'.
    rewrite -step_enc step => H.
    rewrite (IH (1, n')) => //.
    by apply (eq_add_S _ _ H).

    move => n'.
    rewrite -step_enc' step => H.
    rewrite (IH (0, n')) => //.
    by apply (eq_add_S _ _ H).

    move => n' n''.
    rewrite -step_enc step => H.
    rewrite (IH (n''.+2, n')) => //.
    by apply (eq_add_S _ _ H).
Qed.

(* 7.2.4 *)

Section tst.
Variables x y: nat.
Goal x = y -> x == y.
Proof.
  move/eqnP. (* reflection between = and eqn *)
  Print eqnP.
  Search (eqn _ _ = _ == _).
  Print erefl.
  rewrite {1}eqnE. (* equality betweek eqn and == *)
  by [].
Qed.
End tst.


Require Import not.

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

Theorem exsists_example2 : forall (n:nat),
    (exists m, n = 4 + m) -> (exists p, n = 2 + p).
Proof. intros n [m H]. exists (2 + m). apply H. Qed.

Theorem forall_exists : forall (a:Type) (P:a -> Prop),
    (forall x, P x) -> ¬ (exists x, ¬ P x).
Proof. intros a P H [x H']. apply H'. apply H. Qed.

Theorem exists_or : forall (a:Type) (P Q:a -> Prop),
    (exists x, P x \/ Q x) <-> (exists x, P x) \/ (exists x, Q x).
Proof.
    intros a P Q. split.
    - intros [x [Hp|Hq]].
        + left. exists x. exact Hp.
        + right. exists x. exact Hq.
    - intros [[x Hp]|[x Hq]].
        + exists x. left. exact Hp.
        + exists x. right. exact Hq.
Qed.