From LF Require Export Induction.
(* From LF Require Export Basics. *)

Module NatList.

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

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).
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.
Example swap_pair_test : swap_pair (1, 2) = (2, 1). Proof. reflexivity. Qed.

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.
    rewrite surjective_pairing.
    destruct p as [n m].
    simpl.  (* have to expose the structure of p for simpl to perform the pattern match *)
    reflexivity.
Qed.

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

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

Definition mylist := cons 1 (cons 2 (cons 3 nil)).
Notation "x :: l" := (cons x l)
                     (at level 60, right associativity).
Notation "[ ]" := nil.
Notation "[ x ; .. ; y ]" := (cons x .. (cons y nil) ..).
Definition mylist1 := 1 :: (2 :: (3 :: nil)).
Definition mylist2 := 1 :: 2 :: 3 :: nil.
Definition mylist3 := [1;2;3].

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

Example test_repeat0: repeat 1 0 = []. Proof. reflexivity. Qed.
Example test_repeat1: repeat 1 1 = [1]. Proof. reflexivity. Qed.
Example test_repeat2: repeat 1 3 = [1;1;1]. Proof. reflexivity. Qed.

Fixpoint length (lst : natlist) : nat :=
    match lst with
        | nil => 0
        | cons x y => 1 + length y
    end.
Example test_length0: length [] = 0. Proof. reflexivity. Qed.
Example test_length1: length [1] = 1. Proof. reflexivity. Qed.
Example test_length2: length [1;1;1] = 3. Proof. reflexivity. Qed.

Fixpoint append' (lst1 lst2 : natlist) : natlist :=
  match lst1, lst2 with
    | nil, nil => nil
    | _, nil =>  lst1
    | nil, _ => lst2
    | cons x lst1', lst2 => cons x (append' lst1' lst2)
  end.

  (* h = head, t = tail *)
Fixpoint append (lst1 lst2 : natlist) : natlist :=
  match lst1 with
    | nil => lst2
    | h :: t => h :: (append t lst2)
  end.
Notation "lst1 ++ lst2" := (append lst1 lst2).
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
    | [ ] => [ ]
    | h :: t => t
  end.

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

  (* USEFUL *)

Fixpoint nonzeros (l:natlist) : natlist :=
  match l with
    | [] => []
    | h :: t => match h with
                  | O => nonzeros t
                  | _ => h :: nonzeros t
                end
  end.
Example test_nonzeros0: nonzeros [0;1;0;2;3;0;0] = [1;2;3]. Proof. reflexivity. Qed.
Example test_nonzeros1: nonzeros [0;0;0] = []. Proof. reflexivity. Qed.
Example test_nonzeros2: nonzeros [1;2;3] = [1;2;3]. Proof. reflexivity. Qed.
Example test_nonzeros3: nonzeros [] = []. Proof. reflexivity. Qed.

Definition odd (n : nat) : bool :=
  negb (even n).

(* if then else is a two way constructor for bools *)
Fixpoint oddmembers' (l:natlist) : natlist :=
  match l with
    | [] => []
    | h :: t => match (odd h) with
                  | true => h :: (oddmembers' t)
                  | _ => (oddmembers' t)
                  end
  end.
Fixpoint oddmembers (l:natlist) : natlist :=
  match l with
    | [] => []
    | h :: t => if (odd h) then h :: (oddmembers t) else (oddmembers t)
  end.
Example test_oddmembers0: oddmembers [0;1;0;2;3;0;0] = [1;3].  Proof. reflexivity. Qed.
Example test_oddmembers1: oddmembers [1;3;5] = [1;3;5].  Proof. reflexivity. Qed.
Example test_oddmembers2: oddmembers [0;2;4] = [].  Proof. reflexivity. Qed.
Example test_oddmembers3: oddmembers [] = [].  Proof. reflexivity. Qed.

Definition countoddmembers (l:natlist) : nat :=
  length (oddmembers l).
Example test_countoddmembers0: countoddmembers [0;1;0;2;3;0;0] = 2.  Proof. reflexivity. Qed.
Example test_countoddmembers1: countoddmembers [1;3;5] = 3.  Proof. reflexivity. Qed.
Example test_countoddmembers2: countoddmembers [0;2;4] = 0.  Proof. reflexivity. Qed.
Example test_countoddmembers3: countoddmembers [] = 0.  Proof. reflexivity. Qed.

  (*
Note: one natural and elegant way of writing alternate will fail to
satisfy Coq's requirement that all Fixpoint definitions be
"obviously terminating."
If you find yourself in this rut, look for a slightly more verbose
solution that considers elements of both lists at the same time.
One possible solution involves defining a new kind of pairs,
but this is not the only way.
*)
Fixpoint alternate' (l1 l2 : natlist) : natlist :=
  match l1 with
    | [] => l2
    | h1 :: t1 => match l2 with
                  | [] => l1
                  | h2 :: t2 => h1 :: h2 :: (alternate' t1 t2)
                  end
    end.
Fixpoint alternate (l1 l2 : natlist) : natlist :=
  match l1, l2 with
    | [], [] => []
    | _, [] => l1
    | [], _ => l2
    | h1 :: t1, h2 :: t2 => h1 :: h2 :: (alternate t1 t2)
  end.
Example test_alternate1: alternate [1;2;3] [4;5;6] = [1;4;2;5;3;6].  Proof. reflexivity. Qed.
Example test_alternate2: alternate [1] [4;5;6] = [1;4;5;6].  Proof. reflexivity. Qed.
Example test_alternate3: alternate [1;2;3] [4] = [1;4;2;3].  Proof. reflexivity. Qed.
Example test_alternate4: alternate [] [1;2;3] = [1;2;3].  Proof. reflexivity. Qed.
Example test_alternate5: alternate [1;2;3] [] = [1;2;3].  Proof. reflexivity. Qed.
Example test_alternate6: alternate [1;3] [2;4;5;6] = [1;2;3;4;5;6].  Proof. reflexivity. Qed.
Example test_alternate7: alternate [1;3;5;6] [2;4] = [1;2;3;4;5;6].  Proof. reflexivity. Qed.
Example test_alternate8: alternate [] [] = [].  Proof. reflexivity. Qed.

  (*
 A bag (or multiset) is like a set, except that each element can
 appear multiple times rather than just once.
 One possible representation for a bag of numbers is as a list.
  *)
Definition bag := natlist.
Compute eqb 1 2.
(* TODO: length of filter *)
Fixpoint count (v : nat) (s : bag) : nat :=
  match s with
    | [] => 0
    | h :: t => if (h =? v) then 1 + (count v t) else (count v t)
  end.
Example test_count0: count 1 [1;2;3;1;4;1] = 3. Proof. reflexivity. Qed.
Example test_count1: count 1 [1;1;1] = 3. Proof. reflexivity. Qed.
Example test_count2: count 1 [2;3;4] = 0. Proof. reflexivity. Qed.
Example test_count3: count 1 [] = 0. Proof. reflexivity. Qed.

(*
Multiset sum is similar to set union: sum a b contains all the elements of a and of b.
(Mathematicians usually define union on multisets a little bit differently --
  using max instead of sum -- which is why we don't call this operation union.)
*)
Definition sum (a b : bag) : bag :=
  (append a b).
Example test_sum1:              count 1 (sum [1;2;3] [1;4;1]) = 3. Proof. reflexivity. Qed.

Definition add (v : nat) (s : bag) : bag := 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.

Fixpoint member (v : nat) (s : bag) : bool :=
  match s with
    | [] => false
    | h :: t => if (eqb h v) then true else (member v t)
  end.

(* Fixpoint member (v : nat) (s : bag) : bool :=  *)
  (* ((count v s) >=? 1). *)
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
    | [] => []
    | h :: t => if (eqb h v) then t else (h :: (remove_one v t))
  end.
Example test_remove_one1: count 5 (remove_one 5 [2;1;5;4;1]) = 0. Proof. reflexivity. Qed.
Example test_remove_one2: count 5 (remove_one 5 [2;1;4;1]) = 0. Proof. reflexivity. Qed.
Example test_remove_one3: count 4 (remove_one 5 [2;1;4;5;1;4]) = 2. Proof. reflexivity. Qed.
Example test_remove_one4: count 5 (remove_one 5 [2;1;5;4;5;1;4]) = 1. Proof. reflexivity. Qed.

Fixpoint remove_all (v:nat) (s:bag) : bag :=
  match s with
    | [] => []
    | h :: t => if (eqb h v) then (remove_all v t) else (h :: (remove_all v t))
  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.
Example test_remove_all5:  count 5 (remove_all 5 [5;5;2;1;4;1;5;5]) = 0. Proof. reflexivity. Qed.

Fixpoint subset (s1 : bag) (s2 : bag) : bool :=
  match s1, s2 with
    | [], [] => true
    | [], _ => true
    | _, [] => false
    | h::t, _ =>  if (member h s2)
                  then (subset t (remove_one h s2))
                  else false
  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.
Example test_subset3:              subset [1;2;3] [1;2;3] = true. Proof. reflexivity. Qed.
Example test_subset4:              subset [] [1;2;3] = true. Proof. reflexivity. Qed.
Example test_subset5:              subset [] [] = true. Proof. reflexivity. Qed.
Example test_subset6:              subset [1] [] = false. Proof. reflexivity. Qed.

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

(* Lemma ternary : forall cond : bool, forall a, forall b,
  if cond then (eqb a a) else (eqb b b).
Proof.
  intros cond a b.
  simpl.
  destruct cond as [| t f].
 - reflexivity.
  - reflexivity.
Qed.  *)

(*
Require and Import are used often together
But they do different things.
Require loads the file.
Import manages the name space.

When coq files (DIR/File.vo) are loaded with Require,
 the contents of File.vo is wrapped in
 Module DIR.FILE
 ...
 End
Everything defined in the file is then accessed with
      DIR.FILE.SOME_DEF

The file can itself have modules M (MODULE) inside of it.
To access contents of M, type
    DIR.File.MODULE_M.SOME_DEF_IN_MODULE_M

    Import gets all definitions to the top level.
Import DIR.FILE.MODULE_M gets SOME_DEF_IN_MODULE_M to the top level,
so now it can be referenced without DIR.FILE.MODULE_M path
https://stackoverflow.com/questions/36621752/how-to-import-the-library-coq-arith-peanonat-in-coq/36647535#36647535
*)
(* Require Import Coq.Arith.EqNat. *)

(* Check beq_nat_refl.
Check (eqb 1 2).
Check true.
Check Datatypes.true.
It's fine to use Admitted. to avoid type issues from the stdlib *)
Lemma eqbnat_refl': forall v : nat, v =? v = true. Proof. Admitted.

Theorem bag_theorem: forall v n : nat, forall b : bag,
  (count v (add v b)) = S (count v b).
Proof.
  intros v n b.
  simpl.
  rewrite eqbnat_refl'.
  reflexivity.
Qed.

(* As with numbers, simple facts about list-processing functions can sometimes be proved entirely by simplification.
  *)
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'].
  - (* l = nil *)
    reflexivity.
  - (* l = cons n l' *)
    reflexivity. Qed.

(* interesting theorems about lists require induction for their proofs.   *)

(* Since larger lists can always be broken down into smaller ones, eventually reaching nil *)
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'].
  - (* l1 = nil *)
    reflexivity.
  - (* l1 = cons n l1' *)
    simpl. rewrite -> IHl1'. reflexivity. Qed.
(* Coq proof is not especially illuminating as a static document
-- it is easy to see what's going on if you are reading the proof
   in an interactive Coq session and you can see the current goal
   and context at each point, but this state is not visible in the
   written-down parts of the Coq proof. So a natural-language proof
-- one written for human readers -- will need to include more explicit
   signposts; in particular, it will help the reader stay oriented
   if we remind them exactly what the induction hypothesis is in the
   second case.

Theorem: For all lists l1, l2, and l3, (l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3).
Proof: By induction on l1.
Suppose l1 = [].
Then ([] ++ l2) ++ l3 = [] ++ (l2 ++ l3), by definition of ++.

Otherwise, suppose l1 = n::l1', with
    (l1' ++ l2) ++ l3 = l1' ++ (l2 ++ l3)
as the induction hypothesis.
Now ((n :: l1') ++ l2) ++ l3 = (n :: l1') ++ (l2 ++ l3). by definition of ++.
Finally,
    n :: ((l1' ++ l2) ++ l3) = n :: (l1' ++ (l2 ++ l3)),
which is immediate from the induction hypothesis. ☐

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

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

Theorem rev_length_firsttry : forall l : natlist,
  length (rev l) = length l.
Proof.
  intros l. induction l as [| n l' IHl'].
  - (* l = nil *)
    reflexivity.
  - (* l = n :: l' *)
    (* This is the tricky case.  Let's begin as usual
       by simplifying. *)
    simpl.
    (* Now we seem to be stuck: the goal is an equality
       involving ++, but we don't have any useful equations
       in either the immediate context or in the global
       environment!  We can make a little progress by using
       the IH to rewrite the goal... *)
    rewrite <- IHl'.
    (* ... but now we can't go any further. *)
Abort.

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

(*
Theorem app_length: For all lists l1 and l2, we have
  length (l1 ++ l2) = length l1 + length l2
Proof. By induction on l1.

Base case: l1 = []
We have
  length ([] ++ l2) = length [] + length l2
Which follows directly from definition of ++ and plus

  --

Inductive step: l1 = n :: l1' where
  length (l1 ++ l2) = length l1 + length l2
We show
    length ((n :: l1') ++ l2) = length (n :: l1') + length l2
which follows directly from definition of length and ++ together with
the inductive hypothesis.  ☐
*)
Theorem rev_length : forall  l : natlist,
  length (rev l) = length l.
Proof.
  intros l. induction l as [| n l' IHl'].
  - (* l = nil *)
    reflexivity.
  - (* l = n l' *)
    simpl. rewrite app_length.
    simpl. rewrite IHl'.
    rewrite add_comm.
    simpl. reflexivity.
 Qed.
(*
Theorem rev_length: For all lists l, we have
      length (rev l) = length l.

Proof. By induction on l.

Base case: l = []
We have
  length (rev []) = length []
Which follows directly from definition of rev, length, and plus.

  --

Inductive step: l1 = n :: l1' where the IH is
    length (rev l') = length l'.
We must show
    length (rev (n :: l1')) = length (n :: l1')
By definition of rev, app_length, we get
    length (rev l' ++ [n]) = length (n :: l1')        (rev)
    length (rev l') + length [n] = length (n :: l1')  (app_length)
    length l' + length [n] = length (n :: l1')  (IH)
which follows directly from definition of length and plus.  ☐

Theorem: For all lists l, length (rev l) = length l.
Proof: First, observe that
    length (l ++ [n]) = S (length l)
 for any l, by induction on l.
The main property again follows by induction on l,
using the observation together with the induction hypothesis
in the case where l = n'::l'. ☐ ** too big brain for me. readability is more important.

*)
(* Search rev.
Search (_ + _ = _ + _).
Search (_ + _ = _ + _) inside Induction.
Search (?x + ?y = ?y + ?x). *)

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

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

Theorem rev_involutive : forall l : natlist,
  rev (rev l) = l.
Proof.
  intros l. induction l as [| n l' IHl'].
  - (* l = [] *)
    reflexivity.
  - (* l = n l' *)
    simpl.
    rewrite rev_app_distr.
    rewrite IHl'.
    simpl.
    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. induction l1 as [| n l1' IHl1'].
  - (* l1 = [] *)
    simpl. rewrite app_assoc. reflexivity.
  - (* l1 = n l1' *)
    simpl. rewrite <- IHl1'. 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'].
  - (* l1 = [] *)
    simpl. reflexivity.
  - (* l1 = n l1' *)
    induction n as [| n' IHn'].
    + (* n = O *)
      simpl. rewrite IHl1'. reflexivity.
    + (* n = S n' *)
      simpl. rewrite IHl1'. reflexivity.
Qed.

Fixpoint eqblist (l1 l2 : natlist) : bool :=
  match l1 with
    | [] => match l2 with
              | [] => true
              | _ => false
              end
    | h1 :: t1 => match l2 with
              | [] => false
              | h2 :: t2 => if (eqb h1 h2) then (eqblist t1 t2) else false
              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.
Example test_eqblist4 : eqblist [1] [1;2;4] = false. Proof. reflexivity. Qed.
Example test_eqblist5 : eqblist [1;2;3] [1] = false. Proof. reflexivity. Qed.

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

Theorem count_member_nonzero : forall (s : bag),
  1 <=? (count 1 (1 :: s)) = true.
Proof.
  intros s. simpl. reflexivity.
Qed.

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

Theorem remove_does_not_increase_count: forall (s : bag),
  (count 0 (remove_one 0 s)) <=? (count 0 s) = true.
Proof.
  intros s. induction s as [| n s' IHs'].
  - (* s = [] *)
    simpl. reflexivity.
  - (* s = n s' *)
  induction n as [| n' IHn' ].
    + (* n = O *)
      simpl. rewrite leb_n_Sn. reflexivity.
    + (* n = S n' *)
      simpl.
      rewrite IHs'.
      reflexivity.
Qed.

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

Theorem bag_count_sum: forall n: nat, forall b1 b2: bag,
      (count n b1) + (count n b2) = (count n (sum b1 b2)).
Proof.
  intros n b1 b2.
Admitted.

Lemma rev_n : forall n:nat,
  rev ([n]) = [n].
Proof. simpl. reflexivity. Qed.

Lemma rev_empty : rev [] = []. Proof. reflexivity. Qed.

Theorem rev_injective : forall (l1 l2 : natlist),
  rev l1 = rev l2 -> l1 = l2.
Proof.
  intros l1 l2.
  intros H.
  induction l1 as [| n1 l1' IHl1' ].
  - (* l1 = [] *)
    rewrite <- rev_involutive.
    rewrite <- H.
    reflexivity.
  - (* l1 = n1 l1' *)
    rewrite <- rev_involutive.
    rewrite <- H.
    rewrite rev_involutive.
    reflexivity.
Qed.

Fixpoint nth_bad (l:natlist) (n:nat) : nat :=
  match l with
  | nil => 42 (* can't tell if 42 is the input or error *)
  | a :: l' => match n with
               | 0 => a
               | S n' => nth_bad l' n'
               end
  end.

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

Fixpoint nth_error (l:natlist) (n:nat) : natoption :=
  match l with
  | [] => None
  | h :: t => match n with
               | O => Some h
               | S n' => nth_error t 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.

(* Fix the hd function from earlier so the default value is not hard-coded. *)
Definition hd_error (l : natlist) : natoption :=
  match l with
    | [] => None
    | h :: t => Some h
  end.
Example test_hd_error1 : hd_error [] = None. Proof. reflexivity. Qed.
Example test_hd_error2 : hd_error [1] = Some 1. Proof. reflexivity. Qed.
Example test_hd_error3 : hd_error [5;6] = Some 5. Proof. reflexivity. Qed.

Theorem option_elim_hd : forall (l:natlist) (default:nat),
  hd default l = option_elim default (hd_error l).
Proof.
  intros l. induction l as [| n l' IHl'].
  - (* l = [] *)
    simpl. reflexivity.
  - (* l = n l' *)
    simpl.  reflexivity.
Qed.

End NatList.

Module PartialMap.
Export NatList. (* make the definitions from NatList available here *)

(* Partial Maps *)
(* Internally, an id is just a number.
Introducing a separate type by wrapping each nat with
the tag Id makes definitions more readable and gives
us flexibility to change representations later if we want to. *)
Inductive id : Type :=
  | Id (n : nat).

Definition eqb_id (x1 x2 : id) :=
  match x1, x2 with
  | Id n1, Id n2 => n1 =? n2
  end.
Theorem eqb_id_refl : forall x : id, eqb_id x x = true.
Proof.
  intros x.
  destruct x as [x'].
  simpl.
  rewrite eqbnat_refl'.
  reflexivity.
Qed.

Inductive partial_map : Type :=
  | empty
  | record (i : id) (v : nat) (m : partial_map).
Definition update (d : partial_map)
                  (x : id) (value : nat)
                  : partial_map :=
  record x value d.

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

Definition map0 :=
  (record (Id 0) 0 (record (Id 1) 1 (record (Id 2) 2 empty))).
Example test_find0: find (Id 0) map0 = Some 0. Proof. reflexivity. Qed.
Example test_find1: find (Id 1) map0 = Some 1. Proof. reflexivity. Qed.
Example test_find2: find (Id 2) map0 = Some 2. Proof. reflexivity. Qed.
Example test_find3: find (Id 3) map0 = None. Proof. reflexivity. Qed.
Example test_find4: find (Id 3) empty = None. Proof. reflexivity. Qed.

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

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

End PartialMap.


Lemma solving_by_reflexivity:
    2 + 3 = 5
.
Proof.
  simpl.
  reflexivity.
Qed.

Lemma solving_by_apply :
  forall (P Q: nat -> Prop),
  (forall n, Q n -> P n)
  -> (forall n, Q n)
  -> P 2.
Proof.
  intros P Q n1 n2.
  apply n1.
  apply n2.
Qed.

Lemma solving_conj_goal:
  forall (P: nat -> Prop) (F: Prop),
  (forall n, P n) -> F -> F /\ P 2.
Proof.
  auto.
Qed.

Require Import Arith.
(* add Le.le_refl to hint database *)
Hint Resolve Le.le_refl.
(* add molt_le_compat_l to arith database. *)
Hint Resolve mult_le_compat_l: arith.

Require Import Omega.

Lemma omega_demo :
  forall (x y z : nat),
  (x + y = z + z) -> (x - y <= 4) -> (x - z <= 2)
.
Proof.
  intros.
  info omega.
Qed.

Lemma omega_demo' :
  forall (x y : nat),
  (x + 5 <= y) -> (y - x < 3) -> False
.
Proof.
  intros.
  info omega.
Qed.

Require Import ZArith.
Open Scope Z_scope.

Lemma ring_demo:
  forall (x y z: Z),
  x * (y + z) - z * 3 * x = x * y - 2 * x * z
.
Proof.
  intros.
  info ring.
Qed.

Open Scope nat_scope.

Lemma congruence_demo :
  forall (f : nat -> nat -> nat),
  forall (g h : nat -> nat),
  forall (x y z : nat),
  (forall a, g a = h a)
  -> f (g x) (g y) = z
  -> g x = 2
  -> f 2 (h y) = z
.
Proof.
  intros.
  info rewrite <- H1.
  rewrite <-  H.
  apply H0.
  (* congruence. *)
Qed.

Lemma congruence_demo':
  forall (f g : nat -> nat),
  (forall a, f a = g a) -> f (g (g 2) ) = g (f (f 2) )
.
Proof.
  intros.

  info congruence.
Qed.


From mathcomp
     Require Import ssreflect.

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Section Logic.
  Hypothesis ExMidLaw : forall P : Prop, P \/ ~P.

  Lemma notnotEq (P : Prop): ~~P -> P.
  Proof.
    move => HnotnotP.
    move : (ExMidLaw (~P)).
    case.
    -by move /HnotnotP.
    -by case : (ExMidLaw P).
  Qed.

  Lemma DeMorgran_1 (A B : Prop) : ~(A /\ B) -> ~A \/ ~B.
  Proof.
    move => notAandB.
    apply : notnotEq.
    move => HnotnotNAorNB.
    apply : notAandB.
    apply : conj.
    apply : notnotEq.
    move => HnotnotA.
    apply : HnotnotNAorNB.
    apply : or_introl.
    apply : HnotnotA.
    apply : notnotEq.
    move => HnotnotB.
    apply : HnotnotNAorNB.
    apply : or_intror.
    apply : HnotnotB.
  Qed.

  Lemma DeMorgran_2 (A B : Prop) :  ~A \/ ~B -> ~(A /\ B).
  Proof.
    move => Hor. (* -> 導入 *)
    move => Hand. (* not 導入 *)
    move : Hor. (* ~A \/ ~Bを仮定する *)
    case. (* \/の除去 AとBの場合分け *)
    move => notA.
    apply notA. (* not の除去 *)
    apply Hand. (* /\の除去 *)
    move => notB.
    apply notB.
    apply Hand.
  Qed.

  Lemma DeMorgran (A B : Prop) : ~(A /\ B) <-> ~A \/ ~B.
  Proof.
    rewrite /iff.
    -apply : conj => notAandB.
     +apply : notnotEq => HnotnotNAorNB.
      apply : notAandB.
      apply : conj.
      *apply : notnotEq => HnotnotA.
       apply : HnotnotNAorNB.
       apply : or_introl.
       apply : HnotnotA.
       apply : notnotEq => HnotnotB.
       apply : HnotnotNAorNB.
       apply : or_intror.
       apply : HnotnotB.
    -move : notAandB => HnotAornotB.
     move => HAandB.
     move : HnotAornotB.
     +case => notA.
      apply : notA.
      apply HAandB.
      move : notA => notB.
      apply : notB.
      apply HAandB.
  Qed.

  Lemma J_DeMorgan_0 (T : Type) (P : T -> Prop):
    ~(exists x, (P x)) -> forall x, ~(P x).
  Proof.
    move => HnotEx.
    move => x0 HPx.
    apply : HnotEx.
    exists x0.
      by [].
  Qed.

  Lemma J_DeMorgan_1 (T : Type) (P : T -> Prop):
    ~(forall x, (P x)) -> exists x, ~(P x).
  Proof.
    move => notForAll.
    apply : notnotEq.
    move => HnotnotEP.
    apply : notForAll.
    move => x0.
    apply : notnotEq.
    move => notnotP.
    apply : HnotnotEP.
    exists x0.
      by [].
  Qed.

  Lemma J_DeMorgan_2 (T : Type) (P : T -> Prop):
    (exists x, ~(P x)) -> ~(forall x, (P x)).
  Proof.
    case.
    move => x0 HnotPx0.
    apply : notnotEq.
    move => H1.
    apply : HnotPx0.
    apply : notnotEq.
    move => H2.
    apply : H1.
    move => H3.
    apply : H2.
    apply : H3.
  Qed.

  Lemma J_DeMorgan (T : Type) (P : T -> Prop):
    ~(forall x, (P x)) <-> exists x, ~(P x).
  Proof.
    rewrite /iff.
    apply conj.
    apply : J_DeMorgan_1.
    apply : J_DeMorgan_2.
  Qed.

End Logic.


Require Import Arith.
Require Import ZArith.
Require Import Bool.
Open Scope Z_scope.
Parameter max_int:Z.
Definition min_int:Z:=(1-max_int).
Print min_int.
Definition cube (z:Z):Z:=z*z*z.
Print cube.
Check cube.
Definition multi (z:Z)(x:Z):Z:=z*x.
Print multi.
Compute (multi 12 2).
Definition Z_thrice (f:Z->Z)(z:Z):=f(f(f z)).
Print Z_thrice.
Definition plus3:=Z_thrice(fun z:Z=>(z+1)%Z).
Print plus3.
Check plus3.
Compute (plus3 32).
Definition anonymous_fun:=fun (a b c d e:Z)=>a+b+c+d+e.
Print anonymous_fun.
Compute (anonymous_fun 1 2 3 4 5).
Section binomial_def.
  Variables a b:Z.
  Definition binomial (z:Z):=a*z+b.
  Print binomial.
End binomial_def.
Print binomial.

Definition p1:Z->Z:=binomial 5 2.
Print p1.
Compute (p1 3).

Section sum_5_params.
  Variables a b c d e:Z.
  Definition sum_f:=a+b+c+d+e.
End sum_5_params.

Print sum_f.
Compute (sum_f 1 2 3 4 5).

Section h_def.
  Variables a b:Z.
  Let s:Z:=a+b.
  Let d:Z:=a-b.
  Definition h:Z:=s*s+d*d.
End h_def.
Print h.
Check h.

Definition h_2:=fun (a b:Z)=>(a+b)*(a+b)+(a-b)*(a-b).
Print h_2.

(*Eval usage*)

Definition Zsqr(z:Z):Z:=z*z.
Definition my_fun(f:Z->Z)(z:Z):Z:=f (f z).
Eval cbv delta [my_fun Zsqr] in (my_fun Zsqr).
Compute ((my_fun Zsqr) 2). (*2^4*)
Eval cbv delta [my_fun] in (my_fun Zsqr).
(*Eval cbv delta in (my_fun Zsqr).*)

Eval cbv beta delta [my_fun Zsqr] in (my_fun Zsqr).

Eval cbv delta [h_2] in (h_2 32 23).
Eval cbv beta delta [h_2] in (h_2 32 23).
Eval cbv beta zeta delta [h_2] in (h_2 32 23).

Eval cbv delta [h] in (h 32 23).
Eval cbv beta delta [h] in (h 32 23).
Eval cbv beta zeta delta [h] in (h 32 23).

Definition f1:=fun x:Z=>2*x*x+3*x+3.
Eval compute in (f1 2).
Compute (f1 2).
Eval cbv iota beta zeta delta [f1] in (f1 2).

Check Z.
Check 2.
Check Z->Z.
Check nat->nat.
Check f1.
Check (f1 2).
Check Set.
Check Type.
Check (nat->nat:Type).

Section Minimal_propositional_logic.
  Variables P Q R T:Prop.
  Theorem imp_trans:(P->Q)->(Q->R)->P->R.
    Proof.
      intros H H' p.
      apply H'.
      apply H.
      (*apply p.*)
      (*assumption.*)
      exact p.
    Qed.
  Check (P->Q)->(Q->R)->P->R.

  Section example_of_assumption.
    Hypothesis H:P->Q->R.
    Lemma L1:P->Q->R.
      Proof.
        assumption.
      Qed.
    Theorem delta:(P->P->Q)->P->Q.
      Proof.
        exact (fun (H:P->P->Q)(p:P)=>H p p).
      Qed.
  End example_of_assumption.

  Theorem apply_example : (Q->R->T)->(P->Q)->P->R->T.
  Proof.
    intros H H0 p.
    apply H.
    exact (H0 p).
  Qed.

  Theorem imp_dist:(P->Q->R)->(P->Q)->(P->R).
    Proof.
      intros H H' p.
      Show 1.
      apply H.
      apply p.
      exact (H' p).
    Qed.

  Definition f:(nat->bool)->(nat->bool)->nat->bool.
    intros f1 f2.
    assumption.
  Defined.
  Print f.

End Minimal_propositional_logic.

Print imp_dist.

Section section_for_cut_example.
  Variables P Q R T:Prop.
  Hypothesis (H:P->Q) (H0:Q->R) (H1:(P->R)->T->Q) (H2:(P->R)->T).

  Theorem cut_example:Q.
    Proof.
      cut (P->R).
      intros H3.
      apply H1;[assumption|apply H2;assumption].
      intros H3.
      apply H0;apply H;assumption.
    Qed.
End section_for_cut_example.


(** Generated by coq-of-ocaml *)
Require Import OCaml.OCaml.

Local Set Primitive Projections.
Local Open Scope string_scope.
Local Open Scope Z_scope.
Local Open Scope type_scope.
Import ListNotations.

Unset Positivity Checking.
Unset Guard Checking.

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

Inductive natural : Set :=
| Zero : natural
| Succ : natural -> natural.

Fixpoint plus (plus_arg0 : natural) (plus_arg1 : natural) {struct plus_arg0}
  : natural :=
  match plus_arg0 with
  | Zero => plus_arg1
  | Succ n => Succ (plus n plus_arg1)
  end.

Fixpoint mult (mult_arg0 : natural) (mult_arg1 : natural) {struct mult_arg0}
  : natural :=
  match mult_arg0 with
  | Zero => Zero
  | Succ n => plus (mult n mult_arg1) mult_arg1
  end.

Definition synth (y : natural) (x : natural) : natural :=
  plus y (Succ (mult (Succ y) x)).


(* BEGIN FIX *)
Inductive Nat : Type :=
  | O : Nat
  | S : Nat -> Nat.

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

Notation "n + m" := (plus n m)
  (at level 50, left associativity).

Fixpoint mul (n m : Nat) {struct n} : Nat
(* END FIX *)
 := match n with
 | O => O
 | S O => m
 | S n' => (plus m (mul n' m))
end.

(* BEGIN FIX *)
Notation "n * m" := (mul n m)
  (at level 40, left associativity).

Example mul_test_1 : S (S O) * S O = S (S O).
(* END FIX *)
simpl.
reflexivity.
Qed.

(* BEGIN FIX *)
Example mul_test_2 : S (S O) * S (S (S O)) = S (S (S (S (S (S O))))).
(* END FIX *)
simpl.
reflexivity.
Qed.

(* BEGIN FIX *)
Example mul_test_3 : S (S O) * O = O.
(* END FIX *)
simpl.
reflexivity.
Qed.

(* BEGIN FIX *)
Example mul_test_4 : O * S (S O) = O.
(* END FIX *)
simpl.
reflexivity.
Qed.

(* BEGIN FIX *)
Lemma assoc (n m o : Nat) : n + (m + o) = (n + m) + o.
(* END FIX *)
induction n as [|n' H].
simpl.
reflexivity.
simpl.
rewrite <- H.
reflexivity.
Qed.


Require Import Coq.Logic.PropExtensionality.

Require Import ClassicalEnsembles.Core.
Require Import ClassicalEnsembles.Tactics.

Import SetElementNotation.

(* Defined in Coq.Sets.Ensembles.
Inductive Intersection (U : Type) (B C : Ensemble U) : Ensemble U
  := Intersection_intro : forall x : U, x ∈ B -> x ∈ C -> x ∈ B ∩ C.
Inductive Union (U : Type) (B C : Ensemble U) : Ensemble U
  := Union_introl : forall x : U, x ∈ B -> x ∈ B ∪ C
  | Union_intror : forall x : U, x ∈ C -> x ∈ B ∪ C.
Inductive Empty_set (U : Type) : Ensemble U := .
Inductive Full_set (U : Type) : Ensemble U
  := Full_intro : forall x : U, x ∈ Full_set U.
Defiition Complement (U : Type) (A : Ensemble U) : Ensemble U := fun x => ~x ∈ A.
*)
Arguments Intersection {X} A B : rename.
Arguments Union {X} A B : rename.
Arguments Empty_set {X} : rename.
Arguments Full_set {X} : rename.
Arguments Complement {X} A : rename.

Module SetAlgebraNotation.

Notation "A ∩ B" := (Intersection A B)
  (at level 67, left associativity).
Notation "A ∪ B" := (Union A B)
  (at level 68, left associativity).
Notation "'∅'" := Empty_set.
Notation "'⊤'" := Full_set.
Notation "A 'ᶜ'" := (Complement A)
  (at level 65).
Notation "A \ B" := (Intersection A (Complement _ B))
  (at level 67, left associativity, only parsing).

End SetAlgebraNotation.
Import SetAlgebraNotation.

Theorem empty_is_empty {X}
  : @is_empty X ∅.
Proof. intros ? []. Qed.

Theorem is_empty_empty {X} (A : Ensemble X)
  : is_empty A = (A = ∅).
Proof.
  apply propositional_extensionality. split.
  - intros p. rewrite <- ensemble_extensionality. split.
    + intros x ?. contradiction (p x).
    + intros ? [].
  - intros ->. apply empty_is_empty.
Qed.

Theorem full_is_full {X}
  : @is_full X ⊤.
Proof. constructor. Qed.

Theorem is_full_full {X} (A : Ensemble X)
  : is_full A = (A = ⊤).
Proof.
  apply propositional_extensionality. split.
  - intros p. rewrite <- ensemble_extensionality. split.
    + constructor.
    + intros x ?. apply (p x).
  - intros ->. apply full_is_full.
Qed.

Theorem intersection_char {X} (A B : Ensemble X) x
  : x ∈ A ∩ B = (x ∈ A /\ x ∈ B).
Proof.
  apply propositional_extensionality. split.
  - intros p. now destruct p.
  - intros []. auto with sets.
Qed.

Theorem union_char {X} (A B : Ensemble X) x
  : x ∈ A ∪ B = (x ∈ A \/ x ∈ B).
Proof.
  apply propositional_extensionality. split.
  - intros p. destruct p; auto.
  - intros []; now constructor.
Qed.

Theorem empty_char {X} (x : X)
  : x ∈ ∅ = False.
Proof.
  apply propositional_extensionality. split.
  - intros [].
  - intros [].
Qed.

Theorem full_char {X} (x : X)
  : x ∈ ⊤ = True.
Proof.
  apply propositional_extensionality. split.
  - auto.
  - constructor.
Qed.

Theorem complement_char {X} (A : Ensemble X) x
  : x ∈ A ᶜ = ~ x ∈ A.
Proof.
  reflexivity.
Qed.

Global Hint Resolve empty_is_empty : sets.
Global Hint Rewrite @is_empty_empty : sets.
Global Hint Resolve full_is_full : sets.
Global Hint Rewrite @is_full_full : sets.
Global Hint Resolve Full_intro : sets.
Global Hint Rewrite @intersection_char : sets.
Global Hint Rewrite @union_char : sets.
Global Hint Rewrite @empty_char : sets.
Global Hint Rewrite @full_char : sets.
Global Hint Rewrite @complement_char : sets.

Theorem intersection_idem {X} (A : Ensemble X)
  : A ∩ A = A.
Proof. setsolve. Qed.

Theorem intersection_comm {X} (A B : Ensemble X)
  : A ∩ B = B ∩ A.
Proof. setsolve. Qed.

Theorem intersection_assoc {X} (A B C : Ensemble X)
  : A ∩ (B ∩ C) = (A ∩ B) ∩ C.
Proof. setsolve. Qed.

Theorem intersection_subset_left {X} (A B : Ensemble X)
  : A ∩ B ⊂ A.
Proof. setsolve. Qed.

Theorem intersection_equals_left {X} (A B : Ensemble X)
  : A ⊂ B -> A ∩ B = A.
Proof. setsolve. Qed.

Theorem intersection_subset_right {X} (A B : Ensemble X)
  : A ∩ B ⊂ B.
Proof. setsolve. Qed.

Theorem intersection_equals_right {X} (A B : Ensemble X)
  : B ⊂ A -> A ∩ B = B.
Proof. setsolve. Qed.

Theorem intersection_universal {X} (A B C : Ensemble X)
  : C ⊂ A -> C ⊂ B -> C ⊂ A ∩ B.
Proof. setsolve. Qed.

Theorem union_idem {X} (A : Ensemble X)
  : A ∪ A = A.
Proof. setsolve. Qed.

Theorem union_comm {X} (A B : Ensemble X)
  : A ∪ B = B ∪ A.
Proof. setsolve. Qed.

Theorem union_assoc {X} (A B C : Ensemble X)
  : A ∪ (B ∪ C) = (A ∪ B) ∪ C.
Proof. setsolve. Qed.

Theorem union_subset_left {X} (A B : Ensemble X)
  : A ⊂ A ∪ B.
Proof. setsolve. Qed.

Theorem union_equals_left {X} (A B : Ensemble X)
  : B ⊂ A -> A ∪ B = A.
Proof. setsolve. Qed.

Theorem union_subset_right {X} (A B : Ensemble X)
  : B ⊂ A ∪ B.
Proof. setsolve. Qed.

Theorem union_equals_right {X} (A B : Ensemble X)
  : A ⊂ B -> A ∪ B = B.
Proof. setsolve. Qed.

Theorem union_universal {X} (A B C : Ensemble X)
  : A ⊂ C -> B ⊂ C -> A ∪ B ⊂ C.
Proof. setsolve. Qed.

Theorem intersection_empty_left {X} (A : Ensemble X)
  : ∅ ∩ A = ∅.
Proof. setsolve. Qed.

Theorem intersection_empty_right {X} (A : Ensemble X)
  : A ∩ ∅ = ∅.
Proof. setsolve. Qed.

Theorem union_empty_left {X} (A : Ensemble X)
  : ∅ ∪ A = A.
Proof. setsolve. Qed.

Theorem union_empty_right {X} (A : Ensemble X)
  : A ∪ ∅ = A.
Proof. setsolve. Qed.

Theorem intersection_full_left {X} (A : Ensemble X)
  : ⊤ ∩ A = A.
Proof. setsolve. Qed.

Theorem intersection_full_right {X} (A : Ensemble X)
  : A ∩ ⊤ = A.
Proof. setsolve. Qed.

Theorem union_full_left {X} (A : Ensemble X)
  : ⊤ ∪ A = ⊤.
Proof. setsolve. Qed.

Theorem union_full_right {X} (A : Ensemble X)
  : A ∪ ⊤ = ⊤.
Proof. setsolve. Qed.

Theorem empty_universal {X} (A : Ensemble X)
  : ∅ ⊂ A.
Proof. setsolve. Qed.

Theorem empty_equals {X} (A : Ensemble X)
  : A ⊂ ∅ -> A = ∅.
Proof. setsolve. Qed.

Theorem full_universal {X} (A : Ensemble X)
  : A ⊂ ⊤.
Proof. setsolve. Qed.

Theorem full_equals {X} (A : Ensemble X)
  : ⊤ ⊂ A -> A = ⊤.
Proof. setsolve. Qed.

Theorem union_intersection_distr_right {X} (A B C : Ensemble X)
  : A ∪ (B ∩ C) = (A ∪ B) ∩ (A ∪ C).
Proof. setsolve. Qed.

Theorem union_intersection_distr_left {X} (A B C : Ensemble X)
  : (A ∩ B) ∪ C = (A ∪ C) ∩ (B ∪ C).
Proof. setsolve. Qed.

Theorem intersection_union_distr_right {X} (A B C : Ensemble X)
  : A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C).
Proof. setsolve. Qed.

Theorem intersection_union_distr_left {X} (A B C : Ensemble X)
  : (A ∪ B) ∩ C = (A ∩ C) ∪ (B ∩ C).
Proof. setsolve. Qed.

Theorem complement_complement {X} (A : Ensemble X)
  : A ᶜ ᶜ = A.
Proof. setsolve. Qed.

Theorem complement_intersection {X} (A B : Ensemble X)
  : (A ∩ B)ᶜ = A ᶜ ∪ B ᶜ.
Proof. setsolve. Qed.

Theorem complement_union {X} (A B : Ensemble X)
  : (A ∪ B)ᶜ = A ᶜ ∩ B ᶜ.
Proof. setsolve. Qed.

Theorem complement_empty {X}
  : ∅ ᶜ = ⊤ :> Ensemble X.
Proof. setsolve. Qed.

Theorem complement_full {X}
  : ⊤ ᶜ = ∅ :> Ensemble X.
Proof. setsolve. Qed.

Theorem intersection_complement_left {X} (A : Ensemble X)
  : A ᶜ ∩ A = ∅.
Proof. setsolve. Qed.

Theorem intersection_complement_right {X} (A : Ensemble X)
  : A ∩ A ᶜ = ∅.
Proof. setsolve. Qed.

Theorem union_complement_left {X} (A : Ensemble X)
  : A ᶜ ∪ A = ⊤.
Proof. setsolve. Qed.

Theorem union_complement_right {X} (A : Ensemble X)
  : A ∪ A ᶜ = ⊤.
Proof. setsolve. Qed.

Theorem complement_subset {X} (A B : Ensemble X)
  : A ⊂ B = B ᶜ ⊂ A ᶜ.
Proof.
  apply propositional_extensionality. setsolve.
Qed.

Theorem subset_cartesian_adjunction {X} (A B C : Ensemble X)
  : A ∩ B ⊂ C = A ⊂ B ᶜ ∪ C.
Proof.
  apply propositional_extensionality. setsolve. firstorder.
Qed.

Theorem subset_cocartesian_adjunction {X} (A B C : Ensemble X)
  : A ⊂ B ∪ C = A ∩ B ᶜ ⊂ C.
Proof.
  apply propositional_extensionality. setsolve. firstorder.
Qed.

Theorem intersection_is_empty_left {X} (A B : Ensemble X)
  : is_empty A -> is_empty (A ∩ B).
Proof. setsolve. Qed.

Theorem intersection_is_empty_right {X} (A B : Ensemble X)
  : is_empty B -> is_empty (A ∩ B).
Proof. setsolve. Qed.

Theorem union_is_empty {X} (A B : Ensemble X)
  : is_empty A /\ is_empty B <-> is_empty (A ∪ B).
Proof. setsolve. Qed.

Theorem intersection_is_full {X} (A B : Ensemble X)
  : is_full A /\ is_full B <-> is_full (A ∩ B).
Proof. setsolve_firstorder. Qed.

Theorem union_is_full_left {X} (A B : Ensemble X)
  : is_full A -> is_full (A ∪ B).
Proof. setsolve. Qed.

Theorem union_is_full_right {X} (A B : Ensemble X)
  : is_full B -> is_full (A ∪ B).
Proof. setsolve. Qed.


(* Values of type sumor A B are either a value of type A or a proof of B        *)

(*
Print sumor.

Inductive sumor (A : Type) (B : Prop) : Type :=
    inleft : A -> A + {B} | inright : B -> A + {B}

For inleft, when applied to no more than 1 argument:
Arguments A, B are implicit and maximally inserted
For inleft, when applied to 2 arguments:
Argument A is implicit
For inright, when applied to no more than 1 argument:
Arguments A, B are implicit and maximally inserted
For inright, when applied to 2 arguments:
Argument B is implicit
For sumor: Argument scopes are [type_scope type_scope]
For inleft: Argument scopes are [type_scope type_scope _]
For inright: Argument scopes are [type_scope type_scope _]
*)

(* This is not a 'sumbool' type {A} + {B} but a 'sumor' type A + {B}            *)
Definition pred_strong (n:nat) : {m:nat | S m = n} + {n = 0} :=
    match n with
    | 0     => inright (eq_refl 0)
    | S n   => inleft (exist _ n (eq_refl (S n)))
    end.

(*
Compute pred_strong 5.
    = inleft (exist (fun m : nat => S m = 5) 4 eq_refl)
    : {m : nat | S m = 5} + {5 = 0}
*)

Definition maybe (n:nat) (def:nat) (x:{m:nat | S m = n} + {n = 0}) : nat :=
    match x with
    | inright _             => def
    | inleft (exist _ m _)  => m
    end.

Arguments maybe {n} _ _.

(*
Compute (maybe 0 (pred_strong 10)).
*)

Example pred_strong_test1 : maybe 0 (pred_strong 10) = 9.
Proof. reflexivity. Qed.

Example pred_strong_test2 : maybe 9 (pred_strong 0) = 9.
Proof. reflexivity. Qed.


Require Import Div2.
Require Import Arith.
Require Import Omega.

Goal forall n : nat, div2 (S n) < S n.
Proof.
  intros n.
  (* Hintデータベースとしてarithを指定して、Resoluitonをする。 *)
  (* debug *) auto with arith.
Qed.

Goal forall n : nat, div2 (S n) < S n.
Proof.
  intros n.
  (* 上記のautoと同内容を手動でおこなう例。 *)
  Check lt_div2 : forall n : nat, 0 < n -> Nat.div2 n < n.
  apply lt_div2.
  Check Nat.lt_0_succ : forall n : nat, 0 < S n.
  apply Nat.lt_0_succ.
Qed.

Goal forall n : nat, div2 (S n) < S n.
Proof.
  intros n.
  apply lt_div2.
  (* 0 < S n をプレスバーガー算術で解く。 *)
  omega.
Qed.


From LF Require Export Basics.

Theorem plus_n_O : forall n: nat, n = n + 0.
Proof.
  intros n. induction n.
  - reflexivity.
  - simpl. rewrite <- IHn. reflexivity.
Qed.

Theorem minus_diag : forall n,
    minus n n = 0.
Proof.
  induction n. reflexivity.
  simpl. assumption.
Qed.

Theorem mult_0_r : forall n:nat,
    n * 0 = 0.
Proof.
  induction n.
  - trivial.
  - simpl. assumption.
Qed.

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

Theorem plus_comm : forall n m : nat,
  n + m = m + n.
Proof.
  intros n m.
  induction n.
  - simpl. rewrite <- plus_n_O. reflexivity.
  - simpl. rewrite <- plus_n_Sm. rewrite <- IHn. reflexivity.
Qed.

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

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

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

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

Theorem evenb_S : forall n : nat,
  evenb (S n) = negb (evenb n).
Proof.
  induction n.
  - trivial.
  - rewrite -> IHn.  simpl. rewrite negb_involutive. reflexivity.
Qed.

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

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

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

Theorem mult_n_0 : forall n : nat,
  n * 0 = 0.
Proof.
  intros n.
  induction n. trivial. simpl. assumption.
Qed.

Theorem mult_n_Sm: forall n m : nat,
  n * S m = n + n * m.
Proof.
  intros n m.
  induction n.
  - rewrite <- mult_n_Sm. trivial.
  - simpl. rewrite -> IHn. rewrite plus_swap. reflexivity.
Qed.

Theorem mult_comm : forall m n : nat,
  m * n = n * m.
Proof.
  intros n m.
  induction m.
  - simpl. rewrite -> mult_n_0. trivial.
  - simpl. rewrite -> mult_n_Sm. rewrite IHm. trivial.
Qed.

Theorem leb_refl : forall n:nat,
  true = leb n n.
Proof.
  intros n.
  induction n as [|n' IHn].
  - (* n = 0 *)
    reflexivity.
  - simpl. rewrite <- IHn. reflexivity.
Qed.

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

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

Theorem plus_ble_compat_l : forall n m p : nat,
  leb n m = true -> leb (p + n) (p + m) = true.
Proof.
  intros n m p H.
  induction p.
  - trivial.
  - simpl. assumption.
Qed.

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

Theorem mult_1_l : forall n:nat, 1 * n = n.
Proof.
  intros n.
  simpl. rewrite <- plus_n_O. reflexivity.
Qed.

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

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

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

Theorem beq_nat_refl : forall n : nat,
  true = beq_nat n n.
Proof.
  induction n.
  trivial.
  simpl. assumption.
Qed.

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


Check nat_ind.

Theorem mult_0_r':
  forall n: nat, n * 0 = 0.
Proof.
  apply nat_ind.
  - reflexivity.
  - simpl. intros n H. apply H.
Qed.

Theorem plus_one_r': forall n: nat, n + 1 = S n.
Proof.
  apply nat_ind.
  - reflexivity.
  - intros n H.
    simpl. f_equal. apply H.
Qed.

Inductive time : Type :=
  | day
  | night.
Check time_ind.

Inductive ExSet: Type :=
| con1: bool -> ExSet
| con2: nat -> ExSet -> ExSet.

Check ExSet_ind.

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

Check list_ind.

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

Inductive mytype (X: Type) : Type :=
| constr1: X -> mytype X
| constr2: nat -> mytype X
| constr3: mytype X -> nat -> mytype X.
Check mytype_ind.

Inductive foo (X Y: Type) : Type :=
| bar: X -> foo X Y
| baz: Y -> foo X Y
| quux: (nat->foo X Y) -> foo X Y.
Check foo_ind.

Inductive foo' (X: Type): Type :=
| c1 (l: list X) (f: foo' X)
| c2.

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

Check foo'_ind.
Theorem mult_0_r'' : forall n:nat,
  P_m0r n.
Proof.
  apply nat_ind.
  - (* n = O *) reflexivity.
  - (* n = S n' *)
    (* 请注意目前的证明状态！ *)
    intros n IHn.
    unfold P_m0r in IHn. unfold P_m0r. simpl. apply IHn.
Qed.

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.


Require Import Lia.
Require Import ssreflect ssrbool ssrfun.
Require Import Arith.
Require Import List.
Import Nat.
Import ListNotations.

Require Import Lists.Streams.

(** Definitions **)

Definition sum := fold_right add 0.

Notation take := firstn.
Notation drop := skipn.
Definition rotate {A} (n : nat) (l : list A) : list A :=
  drop (n mod length l) l ++ take (n mod length l) l.

(** Proof **)

Lemma sum_app xs ys:
  sum (xs ++ ys) = sum xs + sum ys.
Proof.
  induction xs;cbn;trivial.
  rewrite IHxs;lia.
Qed.

Lemma repeat_rotate {X} (xs:list X) n m:
  concat (repeat (rotate m xs) (S n)) =
  (drop (m mod length xs) xs) ++ concat(repeat xs n) ++ (take (m mod length xs) xs).
Proof.
  induction n in m,xs |- *.
  - cbn. rewrite app_nil_r.
    reflexivity.
  - remember (S n) as n0.
    cbn.
    rewrite IHn.
    unfold rotate.
    rewrite <- app_assoc.
    f_equal.
    rewrite app_assoc.
    rewrite firstn_skipn.
    subst n0.
    cbn.
    now rewrite <- app_assoc.
Qed.

Lemma repeat_sum xs n :
  sum (concat (repeat xs n)) = n * sum xs.
Proof.
  induction n;cbn.
  - reflexivity.
  - now rewrite sum_app IHn.
Qed.

(** common functions custom properties **)

Lemma app_not_nil_r {X} (xs:list X) ys:
  ys <> [] -> xs++ys <> [].
Proof.
  destruct xs.
  - trivial.
  - intros _. cbn. congruence.
Qed.

Lemma local_mod_add n m c:
  m <> 0 ->
  n mod m = c ->
  forall k,
  k+c<m ->
  (k+n) mod m = (k+c).
Proof.
  intros.
  rewrite add_mod;[assumption|].
  rewrite H0.
  setoid_rewrite mod_small at 2. 2: lia.
  rewrite mod_small. 2: lia.
  assumption.
Qed.


Module NatPlayground.

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

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

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

Definition blt_nat (n m : nat) : bool := andb (leb n m) (not_b (beq_nat n m)).

Example test_blt_nat1: (blt_nat 2 2) = false.
Proof.
reflexivity.
Qed.

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

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

Theorem simple_minmax : forall n m, n <= m -> min n m <= max n m.
Proof.
  intros.
  rewrite min_l.
  rewrite max_r.
  assumption. assumption. assumption.
Qed.

End NatPlayground.