(* We start with a boring input of 2 standard-library modules that we'll use. *)
Require Import Coq.Unicode.Utf8 Arith String.

(** * A good example of general inductive types: syntax trees for a small programming language *)

(** Specifically, here's a type of simple trees of arithmetic operations on natural numbers.
  * [nat] is Coq's type for natural numbers, defined in the standard library.
  * (More on those below!) *)
Inductive exp : Set :=
| Constant : nat -> exp
| Plus : exp -> exp -> exp
| Times : exp -> exp -> exp.

(** Recursive function to evaluate an arithmetic expression to a number. *)
Fixpoint eval (e : exp) : nat :=
  match e with
  | Constant n => n
  | Plus e1 e2 => eval e1 + eval e2
  | Times e1 e2 => eval e1 * eval e2
  end.

(** A mischievous function to swap the operands of all operators *)
Fixpoint commuter (e : exp) : exp :=
  match e with
    | Constant _ => e
    | Plus e1 e2 => Plus (commuter e2) (commuter e1)
    | Times e1 e2 => Times (commuter e2) (commuter e1)
  end.

(** We of course want to be *proving* theorems about these definitions,
  * but let's back up and look at a more basic type first. *)

(** * The most basic inductive type that actually deserves the name: natural numbers *)

(** Let's define these with different names than usual, to avoid clashing with the standard library. *)
Inductive natural : Set :=
| Zero : natural
| Succ : natural -> natural.
(* [Succ] for "successor".  Any number [n] is represented as [Succ^n(Zero)]. *)

(** Addition is easy to define recursively.  Here's we're working from first principles, instead of using a built-in type of machine numbers as in most programming languages. *)
Fixpoint add (n m : natural) : natural :=
  match n with
  | Zero => m
  | Succ n' => Succ (add n' m)
  end.

(** Our first example of a proof!  Addition is associative. *)
Theorem add_assoc : forall n m o, add (add n m) o = add n (add m o).
Proof.
  (** Here we are writing *tactics*, or commands for reducing one proof goal into zero or more new goals.  In general, we use semicolon to sequence tactics, with each step run on all goals left over after the previous steps.  We use periods to terminate tactics that we want to run interactively to see the results. *)
  induction n; simpl; intros.
  (**
    * You can guess what [induction] means.
    * [simpl] triggers algebraic simplification.
    * [intros] replaces [forall] quantifiers with new free variables. *)

  reflexivity.
  (** [reflexivity] proves any goal of the form [E = E]. *)

  rewrite IHn.
  (** [rewrite H] uses hypothesis or lemma [H] establishing some fact [E1 = E2] to replace all occurrences of [E1] in the goal with [E2]. *)
  reflexivity.
Qed.
(** If the [Qed] command succeeds, then we know that the theorem is really true, regardless of which tactics we chose. *)

(** ** Proving commutativity of addition *)

(** Sometimes it's useful to prove some lemmas, which formally are the same as theorems, but using the name "lemma" signifies that they just play a supporting role. *)

(** Lemma #1: zero is a right identity of addition. *)
Lemma add_Zero : forall n, add n Zero = n.
Proof.
  induction n; simpl.

  reflexivity.

  rewrite IHn.
  reflexivity.
Qed.

(** Lemma #2: we can pull a [Succ] from the 2nd operand to the front. *)
Lemma add_Succ : forall n m, add n (Succ m) = Succ (add n m).
Proof.
  induction n; simpl; intros.

  reflexivity.

  rewrite IHn.
  reflexivity.
Qed.

(** The main event! *)
Theorem add_comm : forall n m, add n m = add m n.
Proof.
  induction n; simpl; intros.

  rewrite add_Zero.
  reflexivity.

  rewrite add_Succ.
  rewrite IHn.
  reflexivity.
Qed.

(** In the other examples, we'll show both these more manual proofs and more automated proofs.  For natural numbers, it's not even worth doing the automated proofs, since Coq has built-in automation for goals like these, when we use the [nat] type from the standard library. *)

(** * Now we're ready to go back and prove properties of expressions. *)

(** [commuter] has no effect on the meaning of an expression. *)
Theorem eval_commuter : forall e, eval (commuter e) = eval e.
Proof.
  induction e; simpl; intros.

  reflexivity.

  rewrite IHe1.
  rewrite IHe2.
  rewrite plus_comm.
  reflexivity.

  rewrite IHe1.
  rewrite IHe2.
  rewrite mult_comm.
  reflexivity.
Qed.

(** ** Let's see how we can automate that proof more thoroughly using Coq's language Ltac for scripted proof automation.  In general, Ltac details are beyond the scope of these lectures, so think of these automated examples as an advertisement for learning more, say via Adam's book "Certified Programming with Dependent Types," and/or the Coq reference manual. *)

Ltac exp_solver := simpl; intuition;
                   repeat match goal with
                          | [ H : _ = _ |- _ ] => rewrite H
                          end; intuition.

Theorem eval_commuter_automated : forall e, eval (commuter e) = eval e.
Proof.
  induction e; exp_solver.
Qed.

(** * Next (and final) example: lambda terms *)

(** Here's the syntax of the untyped lambda calculus, using the library type of strings. *)
Inductive term : Set :=
| Var : string -> term
| Abs : string -> term -> term
| App : term -> term -> term.

(** At this point, we might be tempted to begin by writing an interpreter, but we can't, since Coq only allows *terminating* functional programs!  Let's work with substitution instead. *)
Fixpoint subst (rep : term) (x : string) (e : term) : term :=
  match e with
  | Var y => if string_dec y x then rep else Var y
  | Abs y e1 => Abs y (if string_dec y x then e1 else subst rep x e1)
  | App e1 e2 => App (subst rep x e1) (subst rep x e2)
  end.
(** Warning: this version is only designed for [rep] that are *closed*, with no free variables! *)

(** In Coq, [Prop] is the type of propositions, or mathematical statements.  It's subtlely different from the type [bool] of Booleans, in a way that may be clear from the OPLSS lectures on type-theory foundations, but it's also fine (for now) to pretend that [Prop] is just a peculiar kind of truth value or Boolean, with its own distinctive operators.  Let's define what it means for a variable not to appear free in a term.  We write [<>] for not-equal, [\/] for logical "or," and [/\] for logical "and." *)
Fixpoint notFreeIn (x : string) (e : term) : Prop :=
  match e with
  | Var y => y <> x
  | Abs y e1 => y = x \/ notFreeIn x e1
  | App e1 e2 => notFreeIn x e1 /\ notFreeIn x e2
  end.

(** We'd like to prove that the order of substitution operations doesn't matter, when the terms we are substituting ([rep] parameter in the [subst] definition) have no free variables.  A useful first lemma is that substitution has no effect on a term without free occurrences of the variable. *)
Lemma subst_notFree : forall rep x e,
  notFreeIn x e
  -> subst rep x e = e.
Proof.
  induction e; simpl; intros.

  destruct (string_dec s x).
  (** [destruct] is for case analysis on the ways some term might be constructed.
    * In this case, [string_dec] has a funny expressive Boolean type that we won't dwell on.
    * The two cases considered are basically "true" and "false," extending the context with information on what the case implies logically about the arguments to [string_dec]. *)
  congruence.
  (** [congruence] is a general decision procedure for the theory of equality.
    * For instance, it knows that [a = b] and [b <> a] together are inconsistent, establishing any goal by contradiction.
    * Though [congruence] subsumes [reflexivity], we'll keep using the latter where applicable, for clarity. *)
  reflexivity.

  destruct (string_dec s x).
  reflexivity.
  (** [destruct] also does double-duty when applied to an [\/] ("or") hypothesis, splitting out two goals, one for each branch of the "or." *)
  destruct H.
  congruence.

  rewrite IHe.
  reflexivity.
  assumption.

  (** [destruct] will also split an [/\] ("and") hypothesis into two. *)
  destruct H.
  rewrite IHe1.
  rewrite IHe2.
  reflexivity.
  assumption.
  assumption.
Qed.

(** Now we prove the main fact about commutativity of substitution. *)
Theorem subst_comm : forall rep1 x1 rep2 x2 e,
  (* The two replacements have no free variables: *)
  (forall x, notFreeIn x rep1)
  -> (forall x, notFreeIn x rep2)

  (* It's important to require that the two variables are different! *)
  -> x1 <> x2

  -> subst rep1 x1 (subst rep2 x2 e) = subst rep2 x2 (subst rep1 x1 e).
Proof.
  induction e; simpl; intros.

  destruct (string_dec s x1), (string_dec s x2); simpl.
  congruence.
  destruct (string_dec s x1).
  rewrite subst_notFree.
  reflexivity.
  apply H.
  (* [apply H] works to prove [P] when [H] is a hypothesis or lemma that establishes [P], perhaps given some other premises.  Those premises become new goals. *)
  congruence.
  destruct (string_dec s x2).
  rewrite subst_notFree.
  reflexivity.
  apply H0.
  congruence.

  destruct (string_dec s x1), (string_dec s x2); simpl.
  congruence.
  congruence.
  congruence.
  reflexivity.

  destruct (string_dec s x1), (string_dec s x2); simpl.
  congruence.
  congruence.
  congruence.
  rewrite IHe.
  reflexivity.
  assumption.
  (* It's probably not hard to guess what [assumption] does. :-) *)
  assumption.
  assumption.

  rewrite IHe1.
  rewrite IHe2.
  reflexivity.
  assumption.
  assumption.
  assumption.
  assumption.
  assumption.
  assumption.
Qed.

(** That was painfully repetitive proving.  Here's an Ltac script that can eat the whole thing for breakfast. *)

Ltac subst_solver := simpl; intuition;
                     repeat (match goal with
                             | [ H : _ = _ |- _ ] => rewrite H
                             | [ |- context[string_dec ?X ?Y] ] => destruct (string_dec X Y)
                             end; simpl in *; intuition; try congruence).

Lemma subst_notFree_automated : forall rep x e,
  notFreeIn x e
  -> subst rep x e = e.
Proof.
  induction e; subst_solver.
Qed.

Hint Resolve subst_notFree_automated.
(** We register a proved lemma as a hint, to be used automatically by the tactics we call in [subst_solver].  (It turns out to be [intuition] that is using the hints here; details are beyond the scope of these lectures.) *)

(** It will be helpful to prove a mirror-image hint, too. *)
Lemma subst_notFree_automated_sym : forall rep x e,
  notFreeIn x e
  -> e = subst rep x e.
Proof.
  intros; symmetry; auto.
Qed.

Hint Resolve subst_notFree_automated_sym.

(** Now the main theorem is a piece of cake. *)
Theorem subst_comm_automated : forall rep1 x1 rep2 x2 e,
  (forall x, notFreeIn x rep1)
  -> (forall x, notFreeIn x rep2)
  -> x1 <> x2
  -> subst rep1 x1 (subst rep2 x2 e) = subst rep2 x2 (subst rep1 x1 e).
Proof.
  induction e; subst_solver.
Qed.


(** * Lists: Working with Structured Data *)

(*Require Export Induction.*)
Require Export Basics.
Module NatList.

(* ################################################################# *)
(** * Pairs of Numbers *)

(** In an [Inductive] type definition, each constructor can take
    any number of arguments -- none (as with [true] and [O]), one (as
    with [S]), or more than one, as here: *)

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

(** This declaration can be read: "There is one way to construct
    a pair of numbers: by applying the constructor [pair] to two
    arguments of type [nat]." *)

Check (pair 3 5).

(** Here are two simple functions for extracting the first and
    second components of a pair.  The definitions also illustrate how
    to do pattern matching on two-argument constructors. *)

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)).
(* ===> 3 *)

(** Since pairs are used quite a bit, it is nice to be able to
    write them with the standard mathematical notation [(x,y)] instead
    of [pair x y].  We can tell Coq to allow this with a [Notation]
    declaration. *)

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

(** The new notation can be used both in expressions and in
    pattern matches (indeed, we've seen it already in the previous
    chapter -- this works because the pair notation is actually
    provided as part of the standard library): *)

Compute (fst (3,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.

(** Let's try to prove a few simple facts about pairs.

    If we state things in a particular (and slightly peculiar) way, we
    can complete 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 [reflexivity] is not enough if we state the lemma in a more
    natural way: *)

Theorem surjective_pairing_stuck : forall (p : natprod),
  p = (fst p, snd p).
Proof.
  simpl. (* Doesn't reduce anything! *)
Abort.

(** We have 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 [nat]s, [destruct]
    doesn't generate an extra subgoal here.  That's because [natprod]s
    can only be constructed in one way. *)

(** **** Exercise: 1 star (snd_fst_is_swap)  *)
Theorem snd_fst_is_swap : forall (p : natprod),
  (snd p, fst p) = swap_pair p.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 1 star, optional (fst_swap_is_snd)  *)
Theorem fst_swap_is_snd : forall (p : natprod),
  fst (swap_pair p) = snd p.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ################################################################# *)
(** * Lists of Numbers *)

(** Generalizing the definition of pairs, we can describe the
    type of _lists_ of numbers like this: "A list is either the empty
    list or else a pair of a number and another list." *)

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

(** For example, here is a three-element list: *)

Definition mylist := cons 1 (cons 2 (cons 3 nil)).

(** As with pairs, it is more convenient to write lists in
    familiar programming notation.  The following declarations
    allow us to use [::] as an infix [cons] operator and square
    brackets as an "outfix" notation for constructing lists. *)

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

(** It is not necessary to understand the details of these
    declarations, but in case you are interested, here is roughly
    what's going on.  The [right associativity] annotation tells Coq
    how to parenthesize expressions involving several uses of [::] so
    that, for example, the next three declarations mean exactly the
    same thing: *)

Definition mylist1 := 1 :: (2 :: (3 :: nil)).
Definition mylist2 := 1 :: 2 :: 3 :: nil.
Definition mylist3 := [1;2;3].

(** The [at level 60] part tells Coq how to parenthesize
    expressions that involve both [::] and some other infix operator.
    For example, since we defined [+] as infix notation for the [plus]
    function at level 50,

  Notation "x + y" := (plus x y)
                      (at level 50, left associativity).

   the [+] operator will bind tighter than [::], so [1 + 2 :: [3]]
   will be parsed, as we'd expect, as [(1 + 2) :: [3]] rather than [1
   + (2 :: [3])].

   (Expressions like "[1 + 2 :: [3]]" can be a little confusing when
   you read them in a .v file.  The inner brackets, around 3, indicate
   a list, but the outer brackets, which are invisible in the HTML
   rendering, are there to instruct the "coqdoc" tool that the bracketed
   part should be displayed as Coq code rather than running text.)

   The second and third [Notation] declarations above introduce the
   standard square-bracket notation for lists; the right-hand side of
   the third one illustrates Coq's syntax for declaring n-ary
   notations and translating them to nested sequences of binary
   constructors. *)

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

(** A number of functions are useful for manipulating lists.
    For example, the [repeat] function takes a number [n] and a
    [count] and returns a list of length [count] where every element
    is [n]. *)

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

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

(** The [length] function calculates the length of a list. *)

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

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

(** The [app] function concatenates (appends) two lists. *)

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

(** Actually, [app] will be used a lot in some parts of what
    follows, so it is convenient to have an infix operator for it. *)

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.

(* ----------------------------------------------------------------- *)
(** *** Head (with default) and Tail *)

(** Here are two smaller examples of programming with lists.
    The [hd] function returns the first element (the "head") of the
    list, while [tl] returns everything but the first
    element (the "tail").
    Of course, the empty list has no first element, so we
    must pass a default value to be returned in that case.  *)

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 [] = 0.
Proof. reflexivity.  Qed.
Example test_tl:              tl [1;2;3] = [2;3].
Proof. reflexivity.  Qed.

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

(** **** Exercise: 2 stars, recommended (list_funs)  *)
(** Complete the definitions of [nonzeros], [oddmembers] and
    [countoddmembers] below. Have a look at the tests to understand
    what these functions should do. *)

Fixpoint nonzeros (l:natlist) : natlist
  (* REPLACE THIS LINE WITH   := _your_definition_ . *) . Admitted.

Example test_nonzeros:
  nonzeros [0;1;0;2;3;0;0] = [1;2;3].
  (* FILL IN HERE *) Admitted.

Fixpoint oddmembers (l:natlist) : natlist
  (* REPLACE THIS LINE WITH   := _your_definition_ . *) . Admitted.

Example test_oddmembers:
  oddmembers [0;1;0;2;3;0;0] = [1;3].
  (* FILL IN HERE *) Admitted.

Fixpoint countoddmembers (l:natlist) : nat
  (* REPLACE THIS LINE WITH   := _your_definition_ . *) . Admitted.

Example test_countoddmembers1:
  countoddmembers [1;0;3;1;4;5] = 4.
  (* FILL IN HERE *) Admitted.

Example test_countoddmembers2:
  countoddmembers [0;2;4] = 0.
  (* FILL IN HERE *) Admitted.

Example test_countoddmembers3:
  countoddmembers nil = 0.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 3 stars, advanced (alternate)  *)
(** Complete the definition of [alternate], which "zips up" two lists
    into one, alternating between elements taken from the first list
    and elements from the second.  See the tests below for more
    specific examples.

    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 requires
    defining a new kind of pairs, but this is not the only way.)  *)

Fixpoint alternate (l1 l2 : natlist) : natlist
  (* REPLACE THIS LINE WITH   := _your_definition_ . *) . Admitted.

Example test_alternate1:
  alternate [1;2;3] [4;5;6] = [1;4;2;5;3;6].
  (* FILL IN HERE *) Admitted.

Example test_alternate2:
  alternate [1] [4;5;6] = [1;4;5;6].
  (* FILL IN HERE *) Admitted.

Example test_alternate3:
  alternate [1;2;3] [4] = [1;4;2;3].
  (* FILL IN HERE *) Admitted.

Example test_alternate4:
  alternate [] [20;30] = [20;30].
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ----------------------------------------------------------------- *)
(** *** Bags via Lists *)

(** A [bag] (or [multiset]) is like a set, except that each element
    can appear multiple times rather than just once.  One possible
    implementation is to represent a bag of numbers as a list. *)

Definition bag := natlist.

(** **** Exercise: 3 stars, recommended (bag_functions)  *)
(** Complete the following definitions for the functions
    [count], [sum], [add], and [member] for bags. *)
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 count (v:nat) (s:bag) : nat :=
  match s with
    | nil => 0
    | h :: t =>
      match beq_nat h v with
        | true => 1 + count v t
        | false => count v t
      end
  end.

(** All these proofs can be done just by [reflexivity]. *)

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.

(** 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, which
    is why we don't use that name for this operation.)
    For [sum] we're giving you a header that does not give explicit
    names to the arguments.  Moreover, it uses the keyword
    [Definition] instead of [Fixpoint], so even if you had names for
    the arguments, you wouldn't be able to process them recursively.
    The point of stating the question this way is to encourage you to
    think about whether [sum] can be implemented in another way --
    perhaps by using functions that have already been defined.  *)

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 :=
  match count v s with
    | 0 => false
    | _ => true
  end.

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

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

(** **** Exercise: 3 stars, optional (bag_more_functions)  *)
(** Here are some more bag functions for you to practice with. *)

(** When remove_one is applied to a bag without the number to remove,
   it should return the same bag unchanged. *)

Fixpoint remove_one (v:nat) (s:bag) : bag :=
  match s with
    | nil => nil
    | h :: t => match (beq_nat 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. reflexivity. Qed.

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

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

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

Fixpoint remove_all (v:nat) (s:bag) : bag :=
 match s with
    | nil => nil
    | h::t => if (beq_nat 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.

Fixpoint subset (s1:bag) (s2:bag) : bool :=
  match s1 with
			| nil => true
			| h :: t => andb (member h s2)
											 (subset t (remove_one h s2))
		end.

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

(** [] *)

(** **** Exercise: 3 stars, recommended (bag_theorem)  *)
(** Write down an interesting theorem [bag_theorem] about bags
    involving the functions [count] and [add], and prove it.  Note
    that, since this problem is somewhat open-ended, it's possible
    that you may come up with a theorem which is true, but whose proof
    requires techniques you haven't learned yet.  Feel free to ask for
    help if you get stuck! *)

(*
Theorem bag_theorem : ...
Proof.
  ...
Qed.
*)

(** [] *)

(* ################################################################# *)
(** * Reasoning About Lists *)

(** As with numbers, simple facts about list-processing
    functions can sometimes be proved entirely by simplification.  For
    example, the simplification performed by [reflexivity] is enough
    for this theorem... *)

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

(** ... because the [[]] is substituted into the match
    "scrutinee" in the definition of [app], allowing the match itself
    to be simplified. *)

(** Also, as with numbers, it is sometimes helpful to perform case
    analysis on the possible shapes (empty or non-empty) of an unknown
    list. *)

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.

(** Here, the [nil] case works because we've chosen to define
    [tl nil = nil]. Notice that the [as] annotation on the [destruct]
    tactic here introduces two names, [n] and [l'], corresponding to
    the fact that the [cons] constructor for lists takes two
    arguments (the head and tail of the list it is constructing). *)

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

(* ----------------------------------------------------------------- *)
(** *** Micro-Sermon *)

(** Simply reading example proof scripts will not get you very far!
    It is important to work through the details of each one, using Coq
    and thinking about what each step achieves.  Otherwise it is more
    or less guaranteed that the exercises will make no sense when you
    get to them.  'Nuff said. *)

(* ================================================================= *)
(** ** Induction on Lists *)

(** Proofs by induction over datatypes like [natlist] are a
    little less familiar than standard natural number induction, but
    the idea is equally simple.  Each [Inductive] declaration defines
    a set of data values that can be built up using the declared
    constructors: a boolean can be either [true] or [false]; a number
    can be either [O] or [S] applied to another number; a list can be
    either [nil] or [cons] applied to a number and a list.

    Moreover, applications of the declared constructors to one another
    are the _only_ possible shapes that elements of an inductively
    defined set can have, and this fact directly gives rise to a way
    of reasoning about inductively defined sets: a number is either
    [O] or else it is [S] applied to some _smaller_ number; a list is
    either [nil] or else it is [cons] applied to some number and some
    _smaller_ list; etc. So, if we have in mind some proposition [P]
    that mentions a list [l] and we want to argue that [P] holds for
    _all_ lists, we can reason as follows:

      - First, show that [P] is true of [l] when [l] is [nil].

      - Then show that [P] is true of [l] when [l] is [cons n l'] for
        some number [n] and some smaller list [l'], assuming that [P]
        is true for [l'].

    Since larger lists can only be built up from smaller ones,
    eventually reaching [nil], these two arguments together establish
    the truth of [P] for all lists [l].  Here's a concrete example: *)

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.

(** Notice that, as when doing induction on natural numbers, the
    [as...] clause provided to the [induction] tactic gives a name to
    the induction hypothesis corresponding to the smaller list [l1']
    in the [cons] case. Once again, this Coq proof is not especially
    illuminating as a static written 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. *)

(** For comparison, here is an informal proof of the same theorem. *)

(** _Theorem_: For all lists [l1], [l2], and [l3],
   [(l1 ++ l2) ++ l3 = l1 ++ (l2 ++ l3)].

   _Proof_: By induction on [l1].

   - First, suppose [l1 = []].  We must show

       ([] ++ l2) ++ l3 = [] ++ (l2 ++ l3),

     which follows directly from the definition of [++].

   - Next, suppose [l1 = n::l1'], with

       (l1' ++ l2) ++ l3 = l1' ++ (l2 ++ l3)

     (the induction hypothesis). We must show

       ((n :: l1') ++ l2) ++ l3 = (n :: l1') ++ (l2 ++ l3).

     By the definition of [++], this follows from

       n :: ((l1' ++ l2) ++ l3) = n :: (l1' ++ (l2 ++ l3)),

     which is immediate from the induction hypothesis.  [] *)

(* ----------------------------------------------------------------- *)
(** *** Reversing a list *)

(** For a slightly more involved example of inductive proof over
    lists, suppose we use [app] to define a list-reversing function
    [rev]: *)

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.

(* ----------------------------------------------------------------- *)
(** *** Proofs about reverse *)

(** Now let's prove some theorems about our newly defined [rev].
    For something a bit more challenging than what we've seen, let's
    prove that reversing a list does not change its length.  Our first
    attempt gets stuck in the successor case... *)

Theorem rev_length_firsttry : forall l : natlist,
  length (rev l) = length l.
Proof.
  intros l. induction l as [| n l' IHl'].
  - (* l = [] *)
    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.

(** So let's take the equation relating [++] and [length] that
    would have enabled us to make progress and prove it as a separate
    lemma. *)

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

(** Note that, to make the lemma as general as possible, we
    quantify over _all_ [natlist]s, not just those that result from an
    application of [rev].  This should seem natural, because the truth
    of the goal clearly doesn't depend on the list having been
    reversed.  Moreover, it is easier to prove the more general
    property. *)

(** Now we can complete the original proof. *)

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

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

(** For comparison, here are informal proofs of these two theorems:

    _Theorem_: For all lists [l1] and [l2],
       [length (l1 ++ l2) = length l1 + length l2].

    _Proof_: By induction on [l1].

    - First, suppose [l1 = []].  We must show

        length ([] ++ l2) = length [] + length l2,

      which follows directly from the definitions of
      [length] and [++].

    - Next, suppose [l1 = n::l1'], with

        length (l1' ++ l2) = length l1' + length l2.

      We must show

        length ((n::l1') ++ l2) = length (n::l1') + length l2).

      This follows directly from the definitions of [length] and [++]
      together with the induction hypothesis. [] *)

(** _Theorem_: For all lists [l], [length (rev l) = length l].

    _Proof_: By induction on [l].

      - First, suppose [l = []].  We must show

          length (rev []) = length [],

        which follows directly from the definitions of [length]
        and [rev].

      - Next, suppose [l = n::l'], with

          length (rev l') = length l'.

        We must show

          length (rev (n :: l')) = length (n :: l').

        By the definition of [rev], this follows from

          length ((rev l') ++ [n]) = S (length l')

        which, by the previous lemma, is the same as

          length (rev l') + length [n] = S (length l').

        This follows directly from the induction hypothesis and the
        definition of [length]. [] *)

(** The style of these proofs is rather longwinded and pedantic.
    After the first few, we might find it easier to follow proofs that
    give fewer details (which can easily work out in our own minds or
    on scratch paper if necessary) and just highlight the non-obvious
    steps.  In this more compressed style, the above proof might look
    like this: *)

(** _Theorem_:
     For all lists [l], [length (rev l) = length l].

    _Proof_: First, observe that [length (l ++ [n]) = S (length l)]
     for any [l] (this follows by a straightforward 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']. [] *)

(** Which style is preferable in a given situation depends on
    the sophistication of the expected audience and how similar the
    proof at hand is to ones that the audience will already be
    familiar with.  The more pedantic style is a good default for our
    present purposes. *)

(* ================================================================= *)
(** ** [SearchAbout] *)

(** We've seen that proofs can make use of other theorems we've
    already proved, e.g., using [rewrite].  But in order to refer to a
    theorem, we need to know its name!  Indeed, it is often hard even
    to remember what theorems have been proven, much less what they
    are called.

    Coq's [SearchAbout] command is quite helpful with this.  Typing
    [SearchAbout foo] will cause Coq to display a list of all theorems
    involving [foo].  For example, try uncommenting the following line
    to see a list of theorems that we have proved about [rev]: *)

(*  SearchAbout rev. *)

(** Keep [SearchAbout] in mind as you do the following exercises and
    throughout the rest of the book; it can save you a lot of time!

    If you are using ProofGeneral, you can run [SearchAbout] with [C-c
    C-a C-a]. Pasting its response into your buffer can be
    accomplished with [C-c C-;]. *)

(* ================================================================= *)
(** ** List Exercises, Part 1 *)

(** **** Exercise: 3 stars (list_exercises)  *)
(** More practice with lists: *)

Theorem app_nil_r : forall l : natlist,
  l ++ [] = l.
Proof.
  (* FILL IN HERE *) Admitted.

Theorem rev_involutive : forall l : natlist,
  rev (rev l) = l.
Proof.
  (* FILL IN HERE *) Admitted.

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

Theorem app_assoc4 : forall l1 l2 l3 l4 : natlist,
  l1 ++ (l2 ++ (l3 ++ l4)) = ((l1 ++ l2) ++ l3) ++ l4.
Proof.
  (* FILL IN HERE *) Admitted.

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

Lemma nonzeros_app : forall l1 l2 : natlist,
  nonzeros (l1 ++ l2) = (nonzeros l1) ++ (nonzeros l2).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 2 stars (beq_natlist)  *)
(** Fill in the definition of [beq_natlist], which compares
    lists of numbers for equality.  Prove that [beq_natlist l l]
    yields [true] for every list [l]. *)

Fixpoint beq_natlist (l1 l2 : natlist) : bool
  (* REPLACE THIS LINE WITH   := _your_definition_ . *) . Admitted.

Example test_beq_natlist1 :
  (beq_natlist nil nil = true).
 (* FILL IN HERE *) Admitted.

Example test_beq_natlist2 :
  beq_natlist [1;2;3] [1;2;3] = true.
(* FILL IN HERE *) Admitted.

Example test_beq_natlist3 :
  beq_natlist [1;2;3] [1;2;4] = false.
 (* FILL IN HERE *) Admitted.

Theorem beq_natlist_refl : forall l:natlist,
  true = beq_natlist l l.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(* ================================================================= *)
(** ** List Exercises, Part 2 *)

(** **** Exercise: 3 stars, advanced (bag_proofs)  *)
(** Here are a couple of little theorems to prove about your
    definitions about bags earlier in the file. *)
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.
Theorem count_member_nonzero : forall (s : bag),
  leb 1 (count 1 (1 :: s)) = true.
Proof.
  intros s.
	induction s as [|s'].
		- reflexivity.
		- reflexivity.
Qed.

(** The following lemma about [leb] might help you in the next proof. *)

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

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

(** [] *)

(** **** Exercise: 3 stars, optional (bag_count_sum)  *)
(** Write down an interesting theorem [bag_count_sum] about bags
    involving the functions [count] and [sum], and prove it.*)

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

(** **** Exercise: 4 stars, advanced (rev_injective)  *)
(** Prove that the [rev] function is injective -- that is,

    forall (l1 l2 : natlist), rev l1 = rev l2 -> l1 = l2.

(There is a hard way and an easy way to do this.) *)

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

(* ################################################################# *)
(** * Options *)

(** Suppose we want to write a function that returns the [n]th
    element of some list.  If we give it type [nat -> natlist -> nat],
    then we'll have to choose some number to return when the list is
    too short... *)

Fixpoint nth_bad (l:natlist) (n:nat) : nat :=
  match l with
  | nil => 42  (* arbitrary! *)
  | a :: l' => match beq_nat n O with
               | true => a
               | false => nth_bad l' (pred n)
               end
  end.

(** This solution is not so good: If [nth_bad] returns [42], we
    can't tell whether that value actually appears on the input
    without further processing. A better alternative is to change the
    return type of [nth_bad] to include an error value as a possible
    outcome. We call this type [natoption]. *)

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

(** We can then change the above definition of [nth_bad] to
    return [None] when the list is too short and [Some a] when the
    list has enough members and [a] appears at position [n]. We call
    this new function [nth_error] to indicate that it may result in an
    error. *)

Fixpoint nth_error (l:natlist) (n:nat) : natoption :=
  match l with
  | nil => None
  | a :: l' => match beq_nat 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.

(** (In the HTML version, the boilerplate proofs of these
    examples are elided.  Click on a box if you want to see one.)

    This example is also an opportunity to introduce one more small
    feature of Coq's programming language: conditional
    expressions... *)

Fixpoint nth_error' (l:natlist) (n:nat) : natoption :=
  match l with
  | nil => None
  | a :: l' => if beq_nat n O then Some a
               else nth_error' l' (pred n)
  end.

(** Coq's conditionals are exactly like those found in any other
    language, with one small generalization.  Since the boolean type
    is not built in, Coq actually allows conditional expressions over
    _any_ inductively defined type with exactly two constructors.  The
    guard is considered true if it evaluates to the first constructor
    in the [Inductive] definition and false if it evaluates to the
    second. *)

(** The function below pulls the [nat] out of a [natoption], returning
    a supplied default in the [None] case. *)

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

(** **** Exercise: 2 stars (hd_error)  *)
(** Using the same idea, fix the [hd] function from earlier so we don't
    have to pass a default element for the [nil] case.  *)

Definition hd_error (l : natlist) : natoption
  (* REPLACE THIS LINE WITH   := _your_definition_ . *) . Admitted.

Example test_hd_error1 : hd_error [] = None.
 (* FILL IN HERE *) Admitted.

Example test_hd_error2 : hd_error [1] = Some 1.
 (* FILL IN HERE *) Admitted.

Example test_hd_error3 : hd_error [5;6] = Some 5.
 (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 1 star, optional (option_elim_hd)  *)
(** This exercise relates your new [hd_error] to the old [hd]. *)

Theorem option_elim_hd : forall (l:natlist) (default:nat),
  hd default l = option_elim default (hd_error l).
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

End NatList.

(* ################################################################# *)
(** * Partial Maps *)

(** As a final illustration of how data structures can be defined in
    Coq, here is a simple _partial map_ data type, analogous to the
    map or dictionary data structures found in most programming
    languages. *)

(** First, we define a new inductive datatype [id] to serve as the
    "keys" of our partial maps. *)

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

(** 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 the flexibility to change representations
    later if we wish.

    We'll also need an equality test for [id]s: *)

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

(** **** Exercise: 1 star (beq_id_refl)  *)
Theorem beq_id_refl : forall x, true = beq_id x x.
Proof.
  (* FILL IN HERE *) Admitted.
(** [] *)

(** Now we define the type of partial maps: *)

Module PartialMap.
Import NatList.

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

(** This declaration can be read: "There are two ways to construct a
    [partial_map]: either using the constructor [empty] to represent an
    empty partial map, or by applying the constructor [record] to
    a key, a value, and an existing [partial_map] to construct a
    [partial_map] with an additional key-to-value mapping." *)

(** The [update] function overrides the entry for a given key in a
    partial map (or adds a new entry if the given key is not already
    present). *)

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

(** Last, the [find] function searches a [partial_map] for a given
    key.  It returns [None] if the key was not found and [Some val] if
    the key was associated with [val]. If the same key is mapped to
    multiple values, [find] will return the first one it
    encounters. *)

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.

(** **** Exercise: 1 star (update_eq)  *)
Theorem update_eq :
  forall (d : partial_map) (k : id) (v: nat),
    find k (update d k v) = Some v.
Proof.
 (* FILL IN HERE *) Admitted.
(** [] *)

(** **** Exercise: 1 star (update_neq)  *)
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.
 (* FILL IN HERE *) Admitted.
(** [] *)

End PartialMap.

(** **** Exercise: 2 stars (baz_num_elts)  *)
(** Consider the following inductive definition: *)

Inductive baz : Type :=
  | Baz1 : baz -> baz
  | Baz2 : baz -> bool -> baz.

(** How _many_ elements does the type [baz] have?  (Answer in English
    or the natural language of your choice.)

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

(** $Date: 2016-07-11 21:31:32 -0400 (Mon, 11 Jul 2016) $ *)


Require Export P01.

Lemma mult_0_l :
  forall n, 0 * n = 0.
Proof.
  intros [|n].
  - reflexivity.
  - reflexivity.
Qed.

Lemma mult_0_r :
  forall n, n * 0 = 0.
Proof.
  intros n. induction n as [| n'].
  - reflexivity.
  - simpl. rewrite IHn'. reflexivity.
Qed.

Lemma mult_eq_0 :
  forall n m, n * m = 0 -> n = 0 \/ m = 0.
Proof.
  intros [|n].
  - intros m H. rewrite mult_0_l in H. left. apply H.
  - intros [|m].
    + intros H. rewrite mult_0_r in H. right. apply H.
    + intros H. inversion H.
Qed.


Require Import Le.
Require Import List.

Require Import Logic.Nat.Max.

Fixpoint maximum (ns:list nat) : nat :=
    match ns with
    | nil       => 0
    | cons n ns => max n (maximum ns)
    end.

Lemma maximum_lub : forall (ns:list nat) (N:nat),
    (forall (n:nat), In n ns -> n <= N) -> maximum ns <= N.
Proof.
    intros ns N. induction ns as [|n ns IH].
    - intros _. apply le_0_n.
    - intros H. simpl. apply max_lub.
        + apply H. left. reflexivity.
        + apply IH. intros m Hm. apply H. right. assumption.
Qed.

Lemma maximum_ubound : forall (ns:list nat) (n:nat),
    In n ns -> n <= maximum ns.
Proof.
    induction ns as [|n' ns IH].
    - intros n H. inversion H.
    - intros n [H|H].
        + subst. apply n_le_max.
        + apply le_trans with (maximum ns).
            { apply IH. assumption. }
            { apply m_le_max. }
Qed.


Require Import
  Coq.Classes.Morphisms
  Sigma.Algebra.Hierarchy
  Sigma.Algebra.Monoid.

Section Group.

  Context
    {T : Type}
    {eq : T -> T -> Prop}
    {op : T -> T -> T}
    {id : T}
    {inv : T -> T}
    {Hgroup : @group T eq op id inv}.

    Local Infix "=" := eq : type_scope.
    Local Notation "a <> b" := (not (a = b)) : type_scope.
    Local Infix "*" := op.

    Lemma group_cancel_right :
      forall z x y, x * z = y * z <-> x = y.
    Proof.
      intros ? ? ?; split; intro H.
      eapply monoid_cancel_right with (iz := inv z).
      instantiate (1 := z).
      apply right_inverse.
      exact H.
      rewrite H; reflexivity.
    Qed.

    Lemma group_cancel_left :
      forall z x y, z * x = z * y <-> x = y.
    Proof.
      intros ? ? ?; split; intro H.
      eapply monoid_cancel_left with (iz := inv z).
      instantiate (1 := z).
      apply left_inverse.
      exact H.
      rewrite H; reflexivity.
    Qed.

    Lemma group_inv_inv : forall x,
      inv (inv x) = x.
    Proof.
      intros ?.
      eapply monoid_inv_inv;
      try instantiate (1 := inv x);
      apply left_inverse.
    Qed.

    Lemma group_inv_op_ext :
      forall x y, (inv y * inv x) * (x * y) = id.
    Proof.
      intros ? ?.
      eapply monoid_inv_op;
      apply left_inverse.
    Qed.

    Lemma group_inv_flip :
      forall x y, inv (x * y) = inv y * inv x.
    Proof.
      intros ? ?.
      pose proof (group_cancel_right x (inv (x * y)) (inv y * inv x)) as Hg.
      apply Hg; clear Hg.
      assert (Ht : inv y * inv x * x = inv y * (inv x * x)) by
       (rewrite associative; reflexivity).
      rewrite Ht, left_inverse, right_identity.
      pose proof (group_cancel_right y (inv (x * y) * x) (inv y)) as Hg.
      apply Hg; clear Hg.
      rewrite left_inverse.
      assert (H : inv (x * y) * x * y = inv (x * y) * (x * y)) by
        (rewrite associative; reflexivity).
      rewrite H.
      apply left_inverse.
    Qed.

    Lemma group_inv_unique :
      forall x y, y * x = id <-> y = inv x.
    Proof.
      intros ? ?; split; intros H.
      pose proof (group_cancel_right (inv x) (y * x) id) as Hg.
      apply Hg in H.
      rewrite left_identity in H.
      rewrite <- associative, right_inverse,
        right_identity in H.
      exact H.
      rewrite H, left_inverse; reflexivity.
    Qed.

    Lemma group_inv_bijective :
      forall x y, inv x = inv y <-> x = y.
    Proof.
      intros ? ?; split; intros H.
      apply group_cancel_right with (z := x) in H.
      rewrite left_inverse in H.
      apply group_cancel_left with (z := y) in H.
      rewrite
        associative,
        right_inverse,
        right_identity,
        left_identity in H.
      symmetry in H.
      exact H.
      rewrite H; reflexivity.
    Qed.

    Lemma group_inv_id : inv id = id.
    Proof.
      symmetry;
      apply group_inv_unique,
      right_identity.
    Qed.

    Lemma group_inv_id_iff :
      forall x, inv x = id <-> x = id.
    Proof.
      intros ?; split; intros H.
      apply group_inv_bijective.
      rewrite group_inv_id.
      exact H.
      rewrite H;
      apply group_inv_id.
    Qed.

    Lemma group_inv_nonzero_nonzero :
      forall x, x <> id <-> inv x <> id.
    Proof.
      intros ?.
      rewrite group_inv_id_iff; reflexivity.
    Qed.

    Lemma group_eq_r_opp_r_inv :
      forall x y z, x = op z (inv y) <-> op x y = z.
    Proof.
      intros ? ? ?; split; intros H.
      apply group_cancel_right with (z := y) in H.
      rewrite
        <- associative,
        left_inverse,
        right_identity in H.
      exact H.
      apply group_cancel_right with (z := inv y) in H.
      rewrite
        <- associative,
        right_inverse,
        right_identity in H.
      exact H.
    Qed.

    Section ZeroNeqOne.
      Context
        {one : T}
        {Hn : @is_zero_neq_one T eq id one}.

      Lemma opp_one_neq_zero : inv one <> id.
      Proof.
        intro Ht.
        rewrite group_inv_id_iff in Ht.
        pose proof zero_neq_one as H.
        unfold not in H.
        symmetry in Ht.
        apply H in Ht.
        exact Ht.
      Qed.
    End ZeroNeqOne.
End Group.


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

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

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

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

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

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

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

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

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

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

(*
練習問題: ★ (nandb)

次の定義を完成させ、Exampleで記述された確認内容がCoqのチェックをすべて通過することを確認しなさい。

この関数はどちらか、もしくは両方がfalseになったときにtrueを返すものである。
 *)

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

(* 下の定義からAdmitted.を取り去り、代わりに"Proof. simpl. reflexivity. Qed."で検証できるようなコードを記述しなさい。 *)

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

(* 練習問題: ★ (andb3) *)

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

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

Check (negb true).
Check negb.

Module Playground1.

Require Import Coq.Unicode.Utf8_core.

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

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

End Playground1.

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

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

Check S.
Check pred.
Check minustwo.

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

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

Example test_oddb1: (oddb (S O)) = true.
Proof. simpl. reflexivity. Qed.

Example test_oddb2: (oddb (S (S (S (S O))))) = false.
Proof. simpl. reflexivity. Qed.

Module Playground2.

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

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

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

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

End Playground2.

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

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

(* Example test_exp99: (exp 3 3) = 27. *)
(* Proof. simpl. reflexivity. Qed. *)

(* 演習問題: ★ (factorial) *)

(* 再帰を使用した、一般的なfactorical（階乗）の定義を思い出してください : *)

(*     factorial(0)  =  1 *)
(*     factorial(n)  =  n * factorial(n-1)     (if n>0) *)

(* これをCoqでの定義に書き直しなさい。 *)

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

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

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

(* Module Playground20. *)

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

Check ((0 + 1) + 1).

(* End Playground20. *)

(* Check (0%nat). *)

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

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

(* 練習問題: ★★ (blt_nat) *)

(* blt_nat関数は、自然数を比較して小さい、ということを調べてbool *)
(* 値を生成します（ natural numbers for less-than）。Fixpointを *)
(* 使用して１から作成するのではなく、すでにこれまで定義した関数 *)
(* を利用して定義しなさい。 *)

(* 注：simplタクティックを使ってうまくいかない場合は、代わりに *)
(* computeを試してください。それはよりうまく作られたsimplと言え *)
(* るものですが、そもそもシンプルでエレガントな解が書けていれば *)
(* 、simplで十分に評価できるはずです。 *)

Definition blt_nat (n m : nat) : bool :=
  andb (negb (beq_nat n m)) (ble_nat n m).

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

Require Import Coq.Unicode.Utf8_core.

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

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

(* 練習問題: ★, optional (simpl_plus) *)

(* この問い合わせの結果、Coqが返す応答はなにか？ *)

Eval simpl in (forall n:nat, n + 0 = n). (* 右単位元が証明されていない *)

(* また次のものの場合はどうか？ *)

Eval simpl in (forall n:nat, 0 + n = n). (* 左単位元は証明されている *)

(* この二つの違いを示せ。 ☐ *)

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

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

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

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

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

(*
練習問題: ★ (plus_id_exercise)

Admitted.を削除し、証明を完成させなさい。
 *)

Theorem plus_id_exercise : forall n m o : nat,
  n = m -> m = o -> n + m = m + o.
Proof.
  intros n m o.
  intros H0 H1.
  rewrite -> H0, <- H1.
  reflexivity.
Qed.
(* ☐ *)

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

(* 練習問題: ★★, recommended (mult_1_plus) *)

Theorem mult_1_plus : forall n m : nat,
  (1 + n) * m = m + (n * m).
Proof.
  intros n m.
  rewrite -> plus_1_l.
  reflexivity. Qed.
(* ☐ *)

Theorem plus_1_neq_0_firsttry : forall n : nat,
  beq_nat (n + 1) 0 = false.
Proof.
  intros n. simpl. Admitted.

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

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

(* 練習問題: ★ (zero_nbeq_plus_1) *)

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

Require String. Open Scope string_scope.

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

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

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

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

Theorem andb_true_elim1 : forall b c : bool,
  andb b c = true -> b = true.
Proof.
  intros b c H.
  destruct b.
  Case "b = true".
    reflexivity.
  Case "b = false".
    rewrite <- H. reflexivity. Qed.

(*
練習問題: ★★ (andb_true_elim2)

destructを使い、case（もしくはsubcase）を作成して、以下の証明andb_true_elim2を完成させなさい
。
*)

Theorem andb_true_elim2 : forall b c : bool,
  andb b c = true -> c = true.
Proof.
  intros b c H.
  destruct c.
  Case "c = true".
    reflexivity.
  Case "c = false".
    rewrite <- H.
    destruct b.
    SCase "b = true".
      reflexivity.
    SCase "b = false".
      reflexivity. Qed.

(*
  destruct b.
  Case "b = true".
    rewrite <- H.
    reflexivity.
  Case "b = false".
    inversion H. Qed.
*)

(* ☐ *)

Theorem plus_0_r_firsttry : forall n : nat,
  n + 0 = n.
Proof.
  intros n.
  simpl. Admitted.

Theorem plus_0_r_secondtry : forall n : nat,
  n + 0 = n.
Proof.
  intros n. destruct n as [| n'].
  Case "n = 0".
    reflexivity.
  Case "n = S n'".
    simpl. Admitted.

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

Theorem minus_diag : forall n,
  minus n n = 0.
Proof.
  intros n. induction n as [| n'].
  Case "n = 0".
    simpl. reflexivity.
  Case "n = S n'".
    simpl. rewrite -> IHn'. reflexivity. Qed.

(* 練習問題: ★★, recommended (basic_induction) *)

Theorem mult_0_r : forall n:nat,
  n * 0 = 0.
Proof.
  intros n. induction n as [| n'].
  Case "n = 0".
    reflexivity.
  Case "n = S n'".
    simpl. rewrite -> IHn'. reflexivity. Qed.

Theorem plus_n_Sm : forall n m : nat,
  S (n + m) = n + (S m).
Proof.
  intros n m. induction n as [| n'].
  Case "n = 0".
    simpl. reflexivity.
  Case "n = S n'".
    simpl. rewrite -> IHn'. reflexivity. Qed.

Theorem plus_comm : forall n m : nat,
  n + m = m + n.
Proof.
  intros n m. induction n as [| n'].
  Case "n = 0".
    simpl. rewrite -> plus_0_r. reflexivity.
  Case "n = S n'".
    simpl. rewrite -> IHn'. rewrite -> plus_n_Sm. reflexivity. Qed.

(* ☐ *)

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

(* 練習問題: ★★ (double_plus) *)

Lemma double_plus : ∀ n, double n = n + n .
Proof.
  intros n. induction n as [| n'].
  Case "n = 0".
    reflexivity.
  Case "n = S n'".
   simpl. rewrite -> IHn'. rewrite -> plus_n_Sm. reflexivity. Qed.
(* ☐ *)

(*
練習問題: ★ (destruct_induction)

destructとinductionの違いを短く説明しなさい。
*)

(* induction だけ Induction Hypothesis を使える。 *)

(* ☐ *)

Theorem plus_assoc' : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  intros n m p. induction n as [| n']. reflexivity.
  simpl. 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 as [| n'].
  Case "n = 0".
    reflexivity.
  Case "n = Sn'".
    simpl. rewrite -> IHn'. reflexivity. Qed.

(*
練習問題: ★★ (plus_comm_informal)

plus_commの証明を、非形式的な証明に書き換えなさい。

定理：加法は可換である。
Proof: ☐
 *)

(*
定理 : 任意の n m について以下が成り立つ
  n + m = m + n

証明 : n について帰納法を適用する。
  ☐ まず n = 0 と置くと以下のようになる
       0 + m = m + 0
     + の定義から
          m = m + 0
     加法+ の右単位元の定理(plus_0_r)から示される
  ☐ 次に n = S n' と置き、帰納法の仮定を
       n' + m = m + n'
     とすると、以下のような式が成り立つ。
       S (n' + m) = S (m + n')
     また加法の左+1の定理(plus_n_Sm)から
       S (m + n') = m + S n'
     したがって、
       S (n' + m) = m + S n'
     ここで加法+ の定義より、以下のように変形できる。
       S n' + m = m + S n'
     これは、直後の値について帰納法の仮定が成り立つことを示している。 ☐
 *)

(*
練習問題: ★★, optional (beq_nat_refl_informal)

次の証明を、plus_assoc の非形式的な証明を参考に書き換えなさい。Coqのタクティックを単に言い換えただけにならないように！

定理：true=beq_nat n n forany n.（任意のnについて、nはnと等しいという命題がtrueとなる）
Proof: ☐
*)

(*
定理 : true = beq_nat n n forany n.
証明 : n について帰納法を適用する。
  ☐ まず n = 0 と置くと以下のようになる
       true = beq_nat 0 0
     これは beq_nat の定義から示される
  ☐ 次に n = S n' と置き、帰納法の仮定を
       true = beq_nat n' n'
     とする。
     ここで beq_nat の定義により、以下のように変形できる。
       true = beq_nat (S n') (S n')
     これは、直後の値について帰納法の仮定が成り立つことを示している。 ☐
 *)

(*
練習問題: ★, optional (beq_nat_refl)
*)

Theorem beq_nat_refl : forall n : nat,
  true = beq_nat n n.
Proof.
  intros n. induction n as [| n'].
  Case "n = 0".
    simpl. reflexivity.
  Case "n = S n'".
    simpl. rewrite <- IHn'. reflexivity. Qed.
(* ☐ *)

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

Theorem plus_rearrange_firsttry :
  forall n m p q : nat,
    (n + m) + (p + q) = (m + n) + (p + q).
Proof.
  intros n m p q.
  rewrite -> plus_comm.
Admitted.

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).
    Case "Proof of assertion".
    rewrite -> plus_comm. reflexivity.
  rewrite -> H. reflexivity. Qed.

(* Print plus_rearrange. *)

(*
練習問題: ★★★★ (mult_comm)

assertを使用して以下の証明を完成させなさい。ただしinduction（帰納法）を使用しないこと。
 *)

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

(*
では、乗法が可換であることを証明しましょう。おそらく、補助的な定理を定義し、それを使って全体を証明することになると思います。先ほど証明したplus_swapが便利に使えるでしょう。
 *)

Theorem mult_succ_r :
  forall n m : nat,
    n * S m = n + n * m.
Proof.
  intros n m.
  induction n as [| n'].
  Case "n = 0". reflexivity.
  Case "n = S n'".
    simpl.
    rewrite -> plus_swap.
    rewrite <- IHn'.
    reflexivity.
  Qed.

Theorem mult_comm : forall m n : nat,
 m * n = n * m.
Proof.
  intros n m.
  induction n as [| n'].
    induction m as [| m'].
    Case "n = 0, m = 0".
      reflexivity.
    Case "n = 0, m = S m'".
      rewrite -> mult_0_r.
      reflexivity.
    induction m as [| m'].
    Case "n = S n', m = 0".
      rewrite -> mult_0_r.
      reflexivity.
    Case "n = S n', m = S m'".
      simpl.
      rewrite -> IHn'.
      rewrite -> mult_succ_r.
      rewrite -> plus_swap.
      simpl.
      reflexivity.
    Qed.

(* ☐ *)

(* 練習問題: ★★, optional (evenb_n__oddb_Sn) *)

Theorem evenb_n__oddb_Sn : forall n : nat,
  evenb n = negb (evenb (S n)).
Proof.
  intros n.
  induction n as [| n'].
  Case "n = 0". reflexivity.
  Case "n = S n'".
    simpl.
    assert (H: forall b:bool, negb (negb b) = b).
      intros b. destruct b. reflexivity. reflexivity.
    rewrite -> IHn'.
    rewrite -> H.
    simpl.
    reflexivity.
  Qed.
(* ☐ *)

(*
さらなる練習問題

練習問題: ★★★, optional (more_exercises)

紙を何枚か用意して、下に続く定理が(a)簡約と書き換えだけで証明可能か、(b)destructを使ったcase分割が必
要になるか、(c)帰納法が必要となるか、のいずれに属すかを、紙の上だけで考えなさい。予測を紙に書いたら
、実際に証明を完成させなさい。証明にはCoqを用いてかまいません。最初に紙を使ったのは「初心忘れるべか
らず」といった理由です。
*)

(*
引数にデータコンストラクタが無いので簡約できない。
また、destruct しても再帰的に仮定が必要になる。
 (c)
 *)
Theorem ble_nat_refl : forall n:nat,
  true = ble_nat n n.
Proof.
  intros.
  induction n as [| n'].
  Case "n = 0". reflexivity.
  Case "n = S n'".
    simpl. rewrite <- IHn'. reflexivity. Qed.

(*
簡約の時点でデータコンストラクタの区別で判定できる。
 (a)
 *)
Theorem zero_nbeq_S : forall n:nat,
  beq_nat 0 (S n) = false.
Proof.
  intros n. reflexivity. Qed.

(*
左側の引数にデータコンストラクタがあらわれていないので場合分けする必要がある。
bool は有限データなので帰納法は必要ない。
 (b)
 *)
Theorem andb_false_r : forall b : bool,
  andb b false = false.
Proof.
  intros b. destruct b. reflexivity. reflexivity. Qed.

(*
引数にデータコンストラクタが無いので簡約できない。
また、destruct しても再帰的に仮定が必要になる。
 (c)
 *)
Theorem plus_ble_compat_l : forall n m p : nat,
  ble_nat n m = true → ble_nat (p + n) (p + m) = true.
Proof.
  intros n m p H. induction p as [| p'].
  Case "p = 0".
    simpl. rewrite -> H. reflexivity.
  Case "p = S p'".
    simpl. rewrite -> IHp'. reflexivity. Qed.

(*
簡約の時点でデータコンストラクタの区別で判定できる。
 (a)
 *)
Theorem S_nbeq_0 : forall n:nat,
  beq_nat (S n) 0 = false.
Proof.
  intros n. reflexivity. Qed.

(*
簡約できるが、その後、加法で帰納法が必要になる。
 (c)
 *)
Theorem mult_1_l : forall n:nat, 1 * n = n.
Proof.
  intros n. simpl. induction n as [| n'].
  Case "n = 0". reflexivity.
  Case "n = S n'".
    simpl. rewrite -> IHn'. reflexivity. Qed.

(*
引数にデータコンストラクタが無いので簡約できない。
bool は有限データなので帰納法は必要ない。
 (b)
 *)
Theorem all3_spec : forall b c : bool,
    orb
      (andb b c)
      (orb (negb b)
               (negb c))
  = true.
Proof.
  intros b c. destruct b. destruct c.
  reflexivity. reflexivity. reflexivity. Qed.

(*
引数にデータコンストラクタが無いので簡約できない。
また、destruct しても再帰的に仮定が必要になる。
 (c)
 *)
Theorem mult_plus_distr_r : forall n m p : nat,
  (n + m) * p = (n * p) + (m * p).
Proof.
  intros n m p. induction p as [| p'].
  Case "p = 0".
    rewrite -> mult_0_r. rewrite -> mult_0_r. rewrite -> mult_0_r.
    reflexivity.
  Case "p = S p'".
    rewrite -> mult_succ_r.
    rewrite -> mult_succ_r.
    rewrite -> mult_succ_r.
    rewrite -> plus_swap.
    rewrite <- plus_assoc.
    rewrite <- plus_assoc.
    rewrite <- IHp'.
    rewrite -> plus_swap.
    reflexivity.
  Qed.

(*
引数にデータコンストラクタが無いので簡約できない。
また、destruct しても再帰的に仮定が必要になる。
 (c)
 *)
Theorem mult_assoc : forall n m p : nat,
  n * (m * p) = (n * m) * p.
Proof.
  intros n m p. induction n as [| n'].
  Case "n = 0". reflexivity.
  Case "n = S n'".
    simpl. rewrite -> mult_plus_distr_r. rewrite -> IHn'.
    reflexivity. Qed.
(* ☐ *)

(*
練習問題: ★★, optional (plus_swap')

replaceタクティックは、特定のサブタームを置き換えたいものと置き換えることができます。もう少し正確に
言うと、replace (t) with (u)は、ゴールにあるtという式を全てuにかきかえ、t = uというサブゴールを追加
します。この機能は、通常のrewriteがゴールの思い通りの場所に作用してくれない場合に有効です。

replaceタクティックを使用してplus_swap'の証明をしなさい。ただしplus_swapのようにassert (n + m = m +
n)を使用しないで証明を完成させなさい。
*)

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

(* ☐ *)

(*
練習問題: ★★★★, recommended (binary)

これまでとは異なる、通常表記の自然数ではなく2進のシステムで、自然数のより効率的な表現を考えなさい。
それは自然数をゼロとゼロに1を加える加算器からなるものを定義する代わりに、以下のような2進の形で表すも
のです。2進数とは、

 ・ ゼロであるか,
 ・ 2進数を2倍したものか,
 ・ 2進数を2倍したものに1を加えたもの.

(a) まず、以下のnatの定義に対応するような2進型binの帰納的な定義を完成させなさい。 (ヒント: nat型の定
義を思い出してください。
    Inductive nat : Type :=
      | O : nat
      | S : nat → nat.
nat型の定義OやSの意味が何かを語るものではなく、（Oが実際に何であろうが）Oがnatであって、nがnatならS
が何であろうとS nはnatである、ということを示しているだけです。「Oがゼロで、Sは1を加える」という実装
がそれを自然数としてみて実際に関数を書き、実行したり証明したりしてみてはじめて実際に意識されます。こ
こで定義するbinも同様で、次に書く関数が書かれてはじめて型binに実際の数学的な意味が与えられます。)
 *)

Inductive bin : Type :=
  | B0 : bin
  | Be : bin -> bin
  | Bo : bin -> bin
.

(*
(b) 先に定義したbin型の値をインクリメントする関数を作成しなさい。また、bin型をnat型に変換する関数も
作成しなさい。
 *)

Fixpoint inc_bin (b : bin) : bin :=
  match b with
    | B0 => Bo B0
    | Be b' => Bo b'
    | Bo b' => Be (inc_bin b')
  end.

Fixpoint bin2nat (b : bin) : nat :=
  match b with
    | B0 => O
    | Be b' => 2 * bin2nat b'
    | Bo b' => 1 + 2 * bin2nat b'
  end.

Example bin2nat_sixteen : bin2nat (Be (Be (Be (Be (Bo B0))))) = 16.
Proof. reflexivity. Qed.

Example bin2nat_twenty_one : bin2nat (Bo (Be (Bo (Be (Bo B0))))) = 21.
Proof. reflexivity. Qed.

(*
(c) 最後にbで作成したインクリメント関数と、2進→自然数関数が可換であることを証明しなさい。これを証明
するには、bin値をまずインクリメントしたものを自然数に変換したものが、先に自然数変換した後にインクリ
メントしたものの値と等しいことを証明すればよい。
 *)

Theorem bin2nat_inc_bin_comm :
  forall b : bin, bin2nat (inc_bin b) = S (bin2nat b).
Proof.
  intros b.
  induction b as [| be | bo].
    Case "b = B0". reflexivity.
    Case "b = Be be".
      simpl. reflexivity.
    Case "b = Bo bo".
      simpl.
      rewrite -> plus_0_r.
      rewrite -> plus_0_r.
      rewrite -> IHbo.
      rewrite <- plus_n_Sm.
      simpl.
      reflexivity.
    Qed.
(* ☐ *)

(*
練習問題: ★★★★★ (binary_inverse)

この練習問題は前の問題の続きで、2進数に関するものである。前の問題で作成された定義や定理をここで用い
てもよい。

(a) まず自然数を2進数に変換する関数を書きなさい。そして「任意の自然数からスタートし、それを2進数にコ
ンバートし、それをさらに自然数にコンバートすると、スタート時の自然数に戻ることを証明しなさい。
*)

Fixpoint nat2bin (n:nat) : bin :=
  match n with
    | O => B0
    | S n' => inc_bin (nat2bin n')
  end.

Theorem nat_bin_nat : forall n:nat, bin2nat (nat2bin n) = n.
Proof.
  intros n. induction n as [| n'].
  Case "n = 0". reflexivity.
  Case "n = S n'".
    simpl. rewrite -> bin2nat_inc_bin_comm. rewrite -> IHn'.
    reflexivity. Qed.

(*
(b) あなたはきっと、逆方向についての証明をしたほうがいいのでは、と考えているでしょう。それは、任意の
2進数から始まり、それを自然数にコンバートしてから、また2進数にコンバートし直したものが、元の自然数と
一致する、という証明です。しかしながら、この結果はtrueにはなりません。！！その原因を説明しなさい。
*)

(* 数値に対して nat 一通りに表現が決定されるが、bin は複数の表現がありうるため。 *)

(*
(c) 2進数を引数として取り、それを一度自然数に変換した後、また2進数に変換したものを返すnormalize関数
を作成し、証明しなさい。
*)

Definition normalize (b:bin) : bin := nat2bin (bin2nat b).

Theorem normalize_refl : forall b:bin, normalize b = nat2bin (bin2nat b).
Proof. reflexivity. Qed.

Theorem normalized_idempotent : forall b:bin, normalize (normalize b) = normalize b.
Proof.
  intros b.
  rewrite -> normalize_refl.
  rewrite -> normalize_refl.
  rewrite -> nat_bin_nat.
  reflexivity. Qed.

(*
練習問題: ★★, optional (decreasing)

各関数の引数のいくつかが"減少的"でなければならない、という要求仕様は、Coqのデザインにおいて基礎とな
っているものです。特に、そのことによって、Coq上で作成された関数が、どんな入力を与えられても必ずいつ
か終了する、ということが保障されています。しかし、Coqの"減少的な解析"が「とても洗練されているとまで
はいえない」ため、時には不自然な書き方で関数を定義しなければならない、ということもあります。

これを具体的に感じるため、Fixpointで定義された、より「微妙な」関数の書き方を考えてみましょう（自然数
に関する簡単な関数でかまいません）。それが全ての入力で停止することと、Coqがそれを、この制限のため受
け入れてくれないことを確認しなさい。
*)

Fixpoint down_to_zero (n:nat) : nat :=
  match oddb n with
    | true => (* down_to_zero (S n) *)
              match n with
                | S n' => down_to_zero n'
                | n'   => n'
              end
    | false => match n with
                 | S (S n') => down_to_zero n'
                 | n'       => n'
               end
  end.

(*
奇数だったら 1を加え、偶数だったら 2以上なら2引く。0 なら終了する関数。
Coqを通すために 1 を加える代わりに 1を引いている。
 *)

Eval simpl in (down_to_zero 15).

(* ☐ *)