(* Euclid's proof that prime numbers are infinite.
   Frédéric Blanqui INRIA, 25 November 2014. *)

Set Implicit Arguments.

Require Import Arith Omega.

Lemma mult_gt_0 a b : a * b > 0 <-> a > 0 /\ b > 0.

Proof.
  (* We proceed by case on a and b. *)
  destruct a. omega. destruct b. omega. split. omega.
  intros _. simpl. (*omega does not work here!*) apply gt_Sn_O.
Qed.

Lemma le_mult_r a b : b > 0 -> a <= a * b.

Proof.
  intros hb. rewrite <- (mult_1_r a) at 1. apply mult_le_compat_l. omega.
Qed.

(** Divisibility. *)

Definition divide a b := exists q, b = a * q.

Infix "\" := divide (at level 70).

Lemma divide_le a b : b > 0 -> a \ b -> a <= b.

Proof.
  intros b_gt_0 [q ha]. subst. apply le_mult_r. rewrite mult_gt_0 in b_gt_0.
  tauto.
Qed.

Lemma divide_mult_l a b c : a \ b -> a \ c * b.

Proof. intros [q ha]. subst. exists (q*c). ring. Qed.

Lemma divide_minus a b c : a \ b -> a \ c -> a \ b-c.

Proof.
  intros [p hb] [q hc]. subst. exists (p-q). (* omega does not work here! *)
  rewrite <- mult_minus_distr_l. reflexivity.
Qed.

Lemma divide_trans a b c : a \ b -> b \ c -> a \ c.

Proof. intros [q h] [r g]. exists (q * r). subst. ring. Qed.

(* Product of a list of natural numbers. *)

Require Import List.

Fixpoint prod l :=
  match l with
    | nil => 1
    | a :: l' => a * prod l'
  end.

Lemma prod_gt_0 : forall l, ~In 0 l <-> prod l > 0.

Proof. induction l; simpl. omega. rewrite mult_gt_0. intuition. Qed.

Lemma in_prod {a} : forall {l}, ~In 0 l -> In a l -> a <= prod l.

Proof.
  (* We proceed by induction on l. *)
  induction l as [|b l hl]; simpl.
  omega.
  intros hb [ha|ha].
  subst. apply le_mult_r. apply prod_gt_0. tauto.
  rewrite <- (mult_1_l a) at 1. apply mult_le_compat. omega. tauto.
Qed.

Lemma divide_prod {a} : forall {l}, In a l -> a \ prod l.

Proof.
  (* We proceed by induction on l. *)
  induction l as [|b l hl]; simpl.
  tauto.
  intros [ha|ha].
  subst. exists (prod l). reflexivity.
  apply divide_mult_l. tauto.
Qed.

(* Prime numbers. *)

Definition prime b := b >= 2 /\ forall a, divide a b -> a = 1 \/ a = b.

Lemma zero_isnt_prime : ~prime 0.

Proof. unfold prime. omega. Qed.

Theorem fundamental_theorem_of_arithmetic a :
  a >= 2 -> exists p, prime p /\ p \ a.

Proof.
  (* We proceed by well-founded induction on a. *)
  pattern a; apply lt_wf_ind; clear a; intros a IHa a_ge_2.
  Require Import Classical.
  destruct (classic (prime a)) as [a_is_prime|a_isnt_prime].
  (* If a is prime, then we can take p=a. *)
  exists a. intuition. exists 1. ring.
  (* If a is not prime, then there is some b between 2 and a-1 that divides a. *)
  apply not_and_or in a_isnt_prime. intuition. apply not_all_ex_not in H.
  destruct H as [b hb]. apply imply_to_and in hb. destruct hb as [b_div_a hb].
  apply not_or_and in hb.
  assert (b_lt_a : b < a). apply divide_le in b_div_a. omega. omega.
  assert (b_ge_2 : b >= 2). destruct b_div_a as [q ha].
  destruct (eq_nat_dec b 0). 2: omega. subst. omega.
  (* By induction hypothesis on b, there is some prime p that divides b,
  and thus a by transitivity. *)
  destruct (IHa _ b_lt_a b_ge_2) as [p [p_prime p_div_b]].
  exists p. intuition. apply divide_trans with b; assumption.
Qed.

Theorem primes_are_infinite : ~ (exists l, forall a, prime a <-> In a l).

Proof.
  intros [l all_primes_in_l]. set (n := S (prod l)).
  (* We prove that n is prime. *)
  assert (n_is_prime : prime n). split.
  (* n >= 2 *)
  apply le_n_S. apply lt_le_S. apply prod_gt_0.
  rewrite <- all_primes_in_l. apply zero_isnt_prime.
  (* We now prove that assuming that there is a divider a of n that is
  different from 1 and n leads to a contradiction. *)
  intros a a_div_n. destruct (eq_nat_dec a 1). tauto.
  right. destruct (eq_nat_dec a n). assumption. apply False_rec.
  (* We prove that a is >= 2. *)
  assert (a_ge_2 : a >= 2). destruct a_div_n as [q hn].
  destruct (eq_nat_dec a 0). subst. rewrite mult_0_l in hn. omega. omega.
  (* Hence, a has a prime divider p. *)
  destruct (fundamental_theorem_of_arithmetic a_ge_2) as [p [p1 p2]].
  (* By transitivity, p divides n. *)
  generalize (divide_trans p2 a_div_n); intro p_div_n.
  (* Since all primes are in l, p is in l and p divides prod l. *)
  assert (p_in_l : In p l). rewrite <- all_primes_in_l. assumption.
  apply divide_prod in p_in_l.
  (* Thus p divides n-prod l=1. *)
  generalize (divide_minus p_div_n p_in_l).
  unfold n. rewrite <- minus_Sn_m, minus_diag. 2: reflexivity.
  (* Therefore p=1 but 1 is not prime. Hence, n is prime. *)
  intros [q hp]. symmetry in hp. apply mult_is_one in hp. destruct hp. subst.
  destruct p1. omega.
  (* We now prove that n is not in l. *)
  rewrite all_primes_in_l in n_is_prime.
  assert (zero_notin_l : ~In 0 l).
  rewrite <- all_primes_in_l. unfold prime. omega.
  generalize (in_prod zero_notin_l n_is_prime). unfold n. omega.
Qed.


Require Import Coq.ZArith.ZArith.
Require Import Coq.micromega.Lia.
Require Import Crypto.Util.ZUtil.Hints.Core.
Local Open Scope Z_scope.

Module Z.
  Definition opp_distr_if (b : bool) x y : -(if b then x else y) = if b then -x else -y.
  Proof. destruct b; reflexivity. Qed.
  Hint Rewrite opp_distr_if : push_Zopp.
  Hint Rewrite <- opp_distr_if : pull_Zopp.

  Lemma mul_r_distr_if (b : bool) x y z : z * (if b then x else y) = if b then z * x else z * y.
  Proof. destruct b; reflexivity. Qed.
  Hint Rewrite mul_r_distr_if : push_Zmul.
  Hint Rewrite <- mul_r_distr_if : pull_Zmul.

  Lemma mul_l_distr_if (b : bool) x y z : (if b then x else y) * z = if b then x * z else y * z.
  Proof. destruct b; reflexivity. Qed.
  Hint Rewrite mul_l_distr_if : push_Zmul.
  Hint Rewrite <- mul_l_distr_if : pull_Zmul.

  Lemma add_r_distr_if (b : bool) x y z : z + (if b then x else y) = if b then z + x else z + y.
  Proof. destruct b; reflexivity. Qed.
  Hint Rewrite add_r_distr_if : push_Zadd.
  Hint Rewrite <- add_r_distr_if : pull_Zadd.

  Lemma add_l_distr_if (b : bool) x y z : (if b then x else y) + z = if b then x + z else y + z.
  Proof. destruct b; reflexivity. Qed.
  Hint Rewrite add_l_distr_if : push_Zadd.
  Hint Rewrite <- add_l_distr_if : pull_Zadd.

  Lemma sub_r_distr_if (b : bool) x y z : z - (if b then x else y) = if b then z - x else z - y.
  Proof. destruct b; reflexivity. Qed.
  Hint Rewrite sub_r_distr_if : push_Zsub.
  Hint Rewrite <- sub_r_distr_if : pull_Zsub.

  Lemma sub_l_distr_if (b : bool) x y z : (if b then x else y) - z = if b then x - z else y - z.
  Proof. destruct b; reflexivity. Qed.
  Hint Rewrite sub_l_distr_if : push_Zsub.
  Hint Rewrite <- sub_l_distr_if : pull_Zsub.

  Lemma div_r_distr_if (b : bool) x y z : z / (if b then x else y) = if b then z / x else z / y.
  Proof. destruct b; reflexivity. Qed.
  Hint Rewrite div_r_distr_if : push_Zdiv.
  Hint Rewrite <- div_r_distr_if : pull_Zdiv.

  Lemma div_l_distr_if (b : bool) x y z : (if b then x else y) / z = if b then x / z else y / z.
  Proof. destruct b; reflexivity. Qed.
  Hint Rewrite div_l_distr_if : push_Zdiv.
  Hint Rewrite <- div_l_distr_if : pull_Zdiv.
End Z.


From mathcomp Require Import all_ssreflect.

(* 2 整列の証明、再び *)

Section sort.
Variable A : eqType.
Variable le : A -> A -> bool.
Variable le_trans: forall x y z, le x y -> le y z -> le x z.
Variable le_total: forall x y, ~~ le x y -> le y x.

Fixpoint insert a l := match l with
  | nil => (a :: nil)
  | b :: l' => if le a b then a :: l else b :: insert a l'
  end.

Fixpoint isort l :=
  if l is a :: l' then insert a (isort l') else nil.

Fixpoint sorted l := (* all を使って bool 上の述語を定義する *)
  if l is a :: l' then all (le a) l' && sorted l' else true.

Lemma le_seq_insert a b l :
  le a b -> all (le a) l -> all (le a) (insert b l).
Proof.
  elim: l => /= [-> // | c l IH].
  move=> leab /andP [leac leal].
  case: ifPn => lebc /=.
  - by rewrite leab leac.
  - by rewrite leac IH.
Qed.

Lemma le_seq_trans a b l :
  le a b -> all (le b) l -> all (le a) l.
Proof.
  move=> leab /allP lebl.
  apply/allP => x Hx.
  by apply/le_trans/lebl.
Qed.

Theorem insert_ok a l : sorted l -> sorted (insert a l).
Proof.
  elim: l => //= a0 l0 IH1 /andP[IHL IHR].
  case: ifPn => Hle /=.
  - by rewrite Hle (le_seq_trans _ _ _ Hle IHL) IHL IHR.
  - rewrite le_seq_insert => //.
    + by rewrite (IH1 IHR).
    + rewrite le_total => //.
Restart.
  elim: l => //= a0 l0 IH1 /andP[IHL IHR].
  case: ifPn => Hle /=.
  - by rewrite Hle (le_seq_trans _ _ _ Hle IHL) IHL IHR.
  - by rewrite (le_seq_insert _ _ _ (le_total _ _ Hle) IHL) (IH1 IHR).
Qed.
Theorem isort_ok l : sorted (isort l).
Proof.
  elim: l => //= a l IH.
  by apply insert_ok.
Qed.

(* perm_eq が seq で定義されているが補題だけを使う *)
Theorem insert_perm l a : perm_eq (a :: l) (insert a l).
Proof.
  elim: l => //= b l pal.
  case: ifPn => //= leab.
  by rewrite (perm_catCA [:: a] [:: b]) perm_cons.
Qed.

(* perm_trans : forall (T : eqType), transitive (seq T) perm_eq *)
Theorem isort_perm l : perm_eq l (isort l).
Proof.
  elim: l => //= a l IH. (* perm_eq_trans が perm_trans に変わった *)
  apply/perm_trans/insert_perm.
  by rewrite perm_cons.
Qed.
End sort.

Check isort.
Definition isortn : seq nat -> seq nat := isort _ leq.
Definition sortedn := sorted _ leq.
Lemma leq_total a b : ~~ (a <= b) -> b <= a.
Proof.
  move: (leq_total a b) => /orP[HL|HR] H //.
  case: ((negP H) HL).
Restart.
  Search "~~" "<=".
  rewrite -ltnNge.
  Search (_ < _ -> _ <= _).
  by apply: ltnW.
Qed.

Theorem isortn_ok l : sortedn (isortn l) && perm_eq l (isortn l).
Proof.
  apply/andP. split.
  - apply: isort_ok.
    + Check leq_trans. (* 引数の順番が違う *)
      move=>m n p. apply: leq_trans.
    + apply: leq_total.
  - apply: isort_perm.
Restart.
  apply/andP. split.
  - apply: isort_ok => m n p.
    + by apply: leq_trans.
    + by apply: leq_total.
  - by apply: isort_perm.
Qed.

Require Import Extraction.
Extraction "isort.ml" isortn. (* コードが分かりにくい *)

(*
% ocaml -c isort.ml (* .mlだと思う *)
% ocaml
# #load"isort.cmo";;
# open Isort;;
# isortn (Cons (S O, Cons (O, Cons (S (S O), Nil))));;
- : Isort.nat Isort.list = Cons (O, Cons (S O, Cons (S (S O), Nil)))
*)

Section even_odd.
Notation even n := (~~ odd n). (* 単なる表記なので，展開が要らない *)

Theorem even_double n : even (n + n).
Proof. elim: n => // n. by rewrite addnS /= negbK. Qed.

(* 等式を使って n に対する通常の帰納法を可能にする *)
Theorem even_plus m n : even m -> even n = even (m + n).
Proof.
  elim: n => /= [|n IH] Hm.
  - by rewrite addn0.
  - by rewrite addnS IH.
Qed.

Theorem one_not_even : ~~ even 1.
Proof. reflexivity. Qed.

Theorem even_not_odd n : even n -> ~~ odd n.
Proof. done. Qed.

Theorem even_odd n : even n -> odd n.+1.
Proof.
  elim: n => //.
Restart.
  done.
Qed.
Theorem odd_even n : odd n -> even n.+1.
Proof.
  elim: n => //= n IH.
  rewrite negbK => //.
Restart.
  elim: n => //= _ _ -> //.
Qed.
Theorem even_or_odd n : even n || odd n.
Proof.
  by rewrite orbC orbN.
Restart.
  rewrite orbC.
  rewrite orbN.
  done.
Qed.
Theorem odd_odd_even m n : odd m -> odd n = even (m+n).
Proof.
  elim: m => //= n0 IH1 IH2.
  by rewrite -(even_plus n0 _ IH2) negbK.
Restart.
  elim: m => //= n0 IH1 IH2.
  rewrite -(even_plus n0).
  - rewrite negbK. reflexivity.
  - exact IH2.
Qed.
End even_odd.


(* This file should be tested by loaded from `ring_examples_check.v` and      *)
(* `ring_examples_no_check.v`. To edit this file, uncomment `Require Import`s *)
(* below: *)
(* From mathcomp Require Import all_ssreflect ssralg ssrnum ssrint rat. *)
(* From mathcomp Require Import ring. *)

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

Import GRing.Theory.

Local Open Scope ring_scope.

Section AbstractCommutativeRing.

Variables (R : comRingType) (a b c : R) (n : nat).

(* Examples from the Coq Reference Manual, but for an instance of MathComp's
   (abstract) commutative ring. *)

(* Using the _%:R embedding from nat to R *)
Goal (a + b + c) ^+ 2 =
     a * a + b ^+ 2 + c * c + 2%:R * a * b + 2%:R * a * c + 2%:R * b * c.
Proof. ring. Qed.

Goal (a + b + c) ^+ 2 =
     a * a + b ^+ 2 + c * c + 2%:R * a * b + 2%:R * a * c + 2%:R * b * c.
Proof. (#[verbose] ring). Qed.

(* Using the _%:~R embedding from int to R : 2 is coerced to (Posz 2) : int *)
Goal (a + b + c) ^+ 2 =
     a * a + b ^+ 2 + c * c + 2%:~R * a * b + 2%:~R * a * c + 2%:~R * b * c.
Proof. ring. Qed.

(* With an identity hypothesis *)
(* Using the _%:R embedding from nat to R *)
Goal 2%:R * a * b = 30%:R -> (a + b) ^+ 2 = a ^+ 2 + b ^+ 2 + 30%:R.
Proof. move=> H; ring: H. Qed.

(* With an identity hypothesis *)
(* Using the _%:~R embedding from int to R *)
Goal 2%:~R * a * b = 30%:~R -> (a + b) ^+ 2 = a ^+ 2 + b ^+ 2 + 30%:~R.
Proof. move=> H; ring: H. Qed.

Goal (n.+1)%:R = n%:R + 1 :> R.
Proof. ring. Qed.

End AbstractCommutativeRing.

Section AbstractRingMorphism.

Variables (R : ringType) (S : comRingType) (f : {rmorphism R -> S}) (a b : R).

Goal f ((a + b) ^+ 2) = f a ^+ 2 + f b ^+ 2 + 2%:R * f a * f b.
Proof. ring. Qed.

End AbstractRingMorphism.

Section AbstractAdditiveFunction.

Variables (U V : zmodType) (R : comRingType).
Variables (g : {additive U -> V}) (f : {additive V -> R}) (a : U) (b : V).

Goal f (g a + b) ^+ 2 = f (g a) ^+ 2 + f b ^+ 2 + f (g (a *+ 2)) * f b.
Proof. ring. Qed.

End AbstractAdditiveFunction.

Section NumeralExamples.

Variable (R : comRingType).

(* With numeral constants *)
Goal 20%:R * 3%:R = 60%:R :> R.
Proof. ring. Qed.

Goal 20%:~R * 3%:~R = 60%:~R :> R.
Proof. ring. Qed.

Goal 200%:~R * 30%:~R = 6000%:~R :> R.
Proof. ring. Qed.

Goal 2%:~R * 10%:~R ^+ 2 * 3%:~R * 10%:~R ^+ 2 = 6%:~R * 10%:~R ^+ 4:> R.
Proof. ring. Qed.

Goal 200%:R * 30%:R = 6000%:R :> R.
Proof.
Time ring. (* 0.186 secs *)
Qed.

Goal 200%:R * 30%:R = 6000%:R :> int.
Proof.
Time ring. (* 0.343 secs *)
Qed.

Goal 20%:R * 3%:R = 60%:R :> rat.
Proof.
Time ring. (* 0.018 secs *)
Qed.

Goal 200%:R * 30%:R = 6000%:R :> rat.
Proof.
Time ring. (* 0.208 secs *)
Qed.

End NumeralExamples.

Section MoreVariables.

Variables (q w e r t y u i o p a s d f g h j k l : int).

Lemma test_vars :
  q * w * e * r * t * y * u * i * o * p * a * s * d * f * g * h * j * k * l =
  l * w * e * r * t * y * u * i * o * p * a * s * d * f * g * h * j * k * q.
Proof. Time ring. Qed. (* 0.049 secs *)

End MoreVariables.


Set Warnings "-notation-overridden,-parsing".
Require Export Tactics.
Require Export Logic.
Require Export Lists.
Require Coq.omega.Omega.

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

Fail Inductive wrong_ev (n : nat) : Prop :=
| wrong_ev_0 : wrong_ev 0
| wrong_ev_SS : forall n, wrong_ev n -> wrong_ev (S (S n)).

Theorem ev_4 : ev 4.
Proof. apply ev_SS. apply ev_SS. apply ev_0. Qed.

Theorem ev_4' : ev 4.
Proof. apply (ev_SS 2 (ev_SS 0 ev_0)). Qed.

Theorem ev_plus4 : forall n, ev n -> ev (4 + n).
Proof.
  intros n. simpl. intros Hn.
  apply ev_SS. apply ev_SS. apply Hn.
Qed.

(* Exercise: 1 star (ev_double) *)
Theorem ev_double : forall n,
  ev (double n).
Proof.
  intros. rewrite double_plus. induction n.
  - simpl. apply ev_0.
  - simpl. rewrite <- plus_n_Sm. apply ev_SS. apply IHn.
Qed.

(* Using Evidence in Proofs *)

Theorem ev_minus2 : forall n,
  ev n -> ev (pred (pred n)).
Proof.
  intros n E.
  inversion E as [| n' E'].
  - (* E = ev_0 *) simpl. apply ev_0.
  - (* E = ev_SS n' E' *) simpl. apply E'.
Qed.

Theorem ev_minus2' : forall n,
  ev n -> ev (pred (pred n)).
Proof.
  intros n E.
  destruct E.
  - simpl. apply ev_0.
  - simpl. apply E.
Qed.

Theorem evSS_ev : forall n,
  ev (S (S n)) -> ev n.
Proof.
  intros n E.
  inversion E as [| n' E'].
  apply E'.
Qed.

Theorem one_not_even : ~ ev 1.
Proof.
  intros H. inversion H. Qed.

(* Exercise: 1 star (SSSSev_even) *)
Theorem SSSSev_even : forall n,
  ev (S (S (S (S n)))) -> ev n.
Proof.
  intros n E.
  inversion E as [| n' E'].
  inversion E'. apply H1.
Qed.

(* Exercise: 1 star (even5_nonsense) *)
Theorem even5_nonsense :
  ev 5 -> 2 + 2 = 9.
Proof.
  intros. inversion H.
  inversion H1. inversion H3.
Qed.

Lemma ev_even_firsttry : forall n,
    ev n -> exists k, n = double k.
Proof.
  intros n E.
  inversion E as [| p E'].
  - (* E = ev_0 *) exists 0. reflexivity.
  - (* E = ev_SS n' E' *)
    assert (I : (exists r, p = double r) ->
                (exists k, S (S p) = double k)).
    { intros [r Hr]. rewrite Hr. exists (S r). reflexivity. }
    apply I.
Abort.

Lemma ev_even : forall n,
  ev n -> exists k, n = double k.
Proof.
  intros n E.
  induction E as [| n' E' IH].
  - (* E = ev_0 *)
    exists 0. reflexivity.
  - (* E = ev_SS n' E'
       with IH : exists k', n' = double k' *)
    destruct IH as [k' Hk'].
    rewrite Hk'. exists (S k'). simpl. reflexivity.
Qed.

Theorem ev_even_iff : forall n,
  ev n <-> exists k, n = double k.
Proof.
  intros. unfold iff. split.
  - apply ev_even.
  - intros [k' Hk']. rewrite Hk'. apply ev_double.
Qed.

(* Exercise: 2 stars (ev_sum) *)
Theorem ev_sum : forall n m, ev n -> ev m -> ev (n + m).
Proof.
  intros n m En Em. induction En.
  - simpl. apply Em.
  - simpl. apply ev_SS. apply IHEn.
Qed.

(* Exercise: 4 stars, advanced, optional (ev' ev) *)
Inductive ev' : nat -> Prop :=
| ev'_0 : ev' 0
| ev'_1 : ev' 2
| ev'_sum : forall n m, ev' n -> ev' m -> ev' (n + m).

Theorem ev'_ev : forall n, ev' n <-> ev n.
Proof.
  intros. split.
  - intros E. induction E.
    + apply ev_0.
    + apply ev_SS. apply ev_0.
    + apply ev_sum.
      * apply IHE1.
      * apply IHE2.
  - intros E. induction E.
    + apply ev'_0.
    + assert (I : forall n, S (S n) = n + 2).
      { - intros. induction n0.
          + reflexivity.
          + simpl. rewrite IHn0. reflexivity. }
      rewrite I. apply ev'_sum.
        * apply IHE.
        * apply ev'_1.
Qed.

(* Exercise: 3 stars, advanced, recommended (ev_ev__ev) *)

Theorem ev_ev__ev : forall n m,
  ev (n + m) -> ev n -> ev m.
Proof.
  intros n m Enm En. induction En.
  - simpl in Enm. apply Enm.
  - simpl in Enm. apply IHEn. apply evSS_ev in Enm. apply Enm.
Qed.

(* Exercise: 3 stars, optional (ev_plus_plus) *)
Theorem ev_plus_plus : forall n m p,
  ev (n+m) -> ev (n+p) -> ev (m+p).
Proof.
  intros. apply ev_sum with (n + m) (n + p) in H.
  - rewrite plus_swap in H. rewrite <- plus_assoc in H.
    rewrite plus_assoc with n n (m + p) in H.
    apply ev_ev__ev with (n + n) (m + p) in H.
    + apply H.
    + rewrite <- double_plus. apply ev_double.
  - apply H0.
Qed.

Module Playground.

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

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

Theorem test_le1 :
  3 <= 3.
Proof. apply le_n. Qed.

Theorem test_le2 :
  3 <= 6.
Proof. apply le_S. apply le_S. apply le_S. apply le_n. Qed.

Theorem test_le3 :
  (2 <= 1) -> 2 + 2 = 5.
Proof.
  intros H.
  inversion H.
  inversion H2.
Qed.

End Playground.

Definition lt (n m:nat) := le (S n) m.

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

Inductive square_of : nat -> nat -> Prop :=
  | sq : forall n:nat, square_of n (n * n).

Inductive next_nat : nat -> nat -> Prop :=
  | nn : forall n:nat, next_nat n (S n).

Inductive next_even : nat -> nat -> Prop :=
  | ne_1 : forall n, ev (S n) -> next_even n (S n)
  | ne_2 : forall n, ev (S (S n)) -> next_even n (S (S n)).

(* Exercise: 3 stars, optional (le_exercises) *)
Lemma le_trans : forall m n o, m <= n -> n <= o -> m <= o.
Proof.
  intros m n o Hmn Hmo.
  induction Hmo.
  - apply Hmn.
  - apply le_S. apply IHHmo.
Qed.

Theorem O_le_n : forall n,
  0 <= n.
Proof.
  induction n.
  - apply le_n.
  - apply le_S. apply IHn.
Qed.

Theorem n_le_m__Sn_le_Sm : forall n m,
  n <= m -> S n <= S m.
Proof.
  intros n m H.
  induction H.
  - apply le_n.
  - apply le_S. apply IHle.
Qed.

Theorem le_Sn_le : forall n m,
  S n <= m -> n <= m.
Proof.
  intros.
  apply le_trans with (S n).
  - apply le_S. apply le_n.
  - apply H.
Qed.

Theorem Sn_le_Sm__n_le_m : forall n m,
  S n <= S m -> n <= m.
Proof.
  intros n m H.
  inversion H.
  - apply le_n.
  - apply le_trans with (S n).
    + apply le_S. apply le_n.
    + apply H1.
Qed.

Theorem le_plus_l : forall a b,
  a <= a + b.
Proof.
  intros.
  induction a.
  - simpl. apply O_le_n.
  - simpl. apply n_le_m__Sn_le_Sm. apply IHa.
Qed.

Theorem le_plus_r : forall a b,
  b <= a + b.
Proof.
  intros.
  induction a.
  - simpl. apply le_n.
  - simpl. apply le_S. apply IHa.
Qed.

Theorem plus_lt : forall n1 n2 m,
  n1 + n2 < m ->
  n1 < m /\ n2 < m.
Proof.
  unfold lt.
  intros n1 n2 m H.
  split.
  - apply le_trans with (S (n1 + n2)).
    + apply n_le_m__Sn_le_Sm. apply le_plus_l.
    + apply H.
  - apply le_trans with (S (n1 + n2)).
    + apply n_le_m__Sn_le_Sm. apply le_plus_r.
    + apply H.
Qed.

Theorem lt_S : forall n m,
  n < m ->
  n < S m.
Proof.
  unfold lt.
  intros.
  apply le_Sn_le in H.
  apply n_le_m__Sn_le_Sm. apply H.
Qed.

Theorem ble_n_Sn : forall n,
  leb n (S n) = true.
Proof.
  intros n. induction n.
  - reflexivity.
  - simpl. rewrite -> IHn. reflexivity.
Qed.

Theorem n_ble_m__Sn_ble_Sm : forall n m,
  leb n m = true -> leb (S n) (S m) = true.
Proof.
  intros. simpl. apply H. Qed.

Theorem Sn_ble_Sm__n_ble_m : forall n m,
  leb (S n) (S m) = true -> leb n m = true.
Proof.
  intros.
  simpl in H. apply H. Qed.

(*
  if (S 4) <= 5 then 4 <= 5. YES
  if 4 <= (S 3) then 4 <= 3. NO
  if 4 <= 4 then (S 4) <= 5 NO
  if 4 <= 4 then 4 <= (S 4) YES
  if (S 4) <= (S 5) then 4 <= 5 YES
  if (S 4) <= (S 4) then (S 4) <= 4 NO
  if (S 4) <= (S 4) then 4 <= (S 4) YES
  if 4 <= 5 then (S 4) <= (S 5) YES

  if leb 4 (S 3) = true then leb 4 3 = true NO
  if leb (S 3) 4 = true then leb 3 4 = true YES
  if leb 4 4 = true then leb 4 (S 4) = true YES
  if leb (S 4) (S 5) = true then leb 4 5 = true YES
  if leb 4 5 = true then leb (S 4) (S 5) = true YES

  O_le_n : 0 <= n.
  le_n_Sm_le : n <= m -> n <= (S m)
  n_le_m__Sn_le_Sm: n ≤ m → S n ≤ S m.
  Sn_le_Sm__n_le_m: S n ≤ S m → n ≤ m.
*)

Theorem ble_Sn_m_n_m : forall n m,
  leb (S n) m = true ->
  leb n m = true.
Proof.
  intros.
  generalize dependent n.
  induction m.
  - intros n contra. inversion contra.
  - intros n H. induction n.
    + reflexivity.
    + simpl. apply IHm. apply Sn_ble_Sm__n_ble_m in H. apply H.
Qed.

Theorem ble_n_m_n_Sm : forall n m,
  leb n m = true ->
  leb n (S m) = true.
Proof.
  intros.
  apply ble_Sn_m_n_m. simpl. apply H. Qed.

Theorem le_n_Sm_le : forall n m,
  n <= m -> n <= (S m).
Proof.
  intros.
  apply le_trans with (S n).
  - apply le_S. apply le_n.
  - apply n_le_m__Sn_le_Sm. apply H.
Qed.

Theorem le_Sn_m_le : forall n m,
  (S n) <= m -> n <= m.
Proof.
  intros.
  induction m.
  - inversion H.
  - apply le_S. apply Sn_le_Sm__n_le_m in H. apply H.
Qed.

Theorem leb_complete : forall n m,
  leb n m = true -> n <= m.
Proof.
  intros.
  generalize dependent m.
  induction n.
  - intros. apply O_le_n.
  - intros m H. induction m.
    + inversion H.
    + apply n_le_m__Sn_le_Sm. apply IHn. simpl in H. apply H.
Qed.

Theorem leb_correct : forall n m,
  n <= m ->
  leb n m = true.
Proof.
  intros.
  induction m.
  - inversion H. reflexivity.
  - inversion H.
    + simpl. symmetry. apply leb_refl.
    + apply ble_n_m_n_Sm. apply IHm. apply H1.
Qed.

Theorem leb_true_trans : forall n m o,
  leb n m = true -> leb m o = true -> leb n o = true.
Proof.
  intros.
  apply leb_correct.
  apply leb_complete in H.
  apply leb_complete in H0.
  apply le_trans with m.
  - apply H.
  - apply H0.
Qed.

(* Exercise: 2 stars, optional (leb_iff) *)
Theorem leb_iff : forall n m,
  leb n m = true <-> n <= m.
Proof.
  intros n m. split.
  - intros H. apply leb_complete. apply H.
  - intros H. apply leb_correct. apply H.
Qed.

(* Exercise: 3 stars, recommended (R_provability) *)
Inductive R : nat -> nat -> nat -> Prop :=
  | c1 : R 0 0 0
  | c2 : forall m n o, R m n o -> R (S m) n (S o)
  | c3 : forall m n o, R m n o -> R m (S n) (S o)
  | c4 : forall m n o, R (S m) (S n) (S (S o)) -> R m n o
  | c5 : forall m n o, R m n o -> R n m o.

Lemma c2_inverse : forall m n o,
  R (S m) n (S o) ->
  R m n o.
Proof.
  intros.
  apply c3 in H. apply c4 in H. apply H.
Qed.

Lemma c3_inverse : forall m n o,
  R m (S n) (S o) ->
  R m n o.
Proof.
  intros.
  apply c2 in H. apply c4 in H. apply H.
Qed.

Lemma c4_inverse : forall m n o,
  R m n o ->
  R (S m) (S n) (S (S o)).
Proof.
  intros.
  apply c2 in H. apply c3 in H. apply H.
Qed.

Theorem test_R1 :
  R 1 1 2.
Proof.
  apply c2. apply c3. apply c1.
Qed.

Theorem test_R2 :
  R 2 2 6.
Proof.
  apply c2.
  apply c3.
  apply c2.
  apply c3.
Abort. (* Not Provable *)

(* If we dropped constructor c5 from the definition of R, would the set of provable propositions change? Briefly (1 sentence) explain your answer.

No it wouldn't because proposition c2 and c3 already cover that scenario
*)

(* If we dropped constructor c4 from the definition of R, would the set of provable propositions change? Briefly (1 sentence) explain your answer.

Not it wouldn't because proposition c4 increments m, n and o and the set of the rest of the proposition do not offer any convergence on o.
*)

Lemma R_m_n_O : forall o,
  R 0 0 o ->
  o = 0.
Proof.
Admitted.

(* Exercise: 3 stars, optional (R_fact) *)
Definition fR : nat -> nat -> nat :=
  plus.

Example test_R_fR_equ1:
  R 2 3 5 <-> fR 2 3 = 5.
Proof.
  split.
  - reflexivity.
  - intros. apply c2. apply c3. apply c2. apply c3. apply c3. apply c1.
Qed.

Lemma fR_O_n : forall n,
  fR O n = n.
Proof.
  intros. reflexivity.
Qed.

Lemma fR_n_O : forall n,
  fR n O = n.
Proof. intros. induction n.
  - reflexivity.
  - simpl. apply eq_S. apply IHn.
Qed.

Lemma fR_m_Sn : forall m n,
  fR m (S n) = S(fR m n).
Proof.
  intros.
  induction m.
  - reflexivity.
  - simpl. apply eq_S. apply IHm.
Qed.

Lemma fR_n_m_O : forall m n,
  fR m n = 0 ->
  m = 0 /\ n = 0.
Proof.
  intros. induction n.
  - split.
    + induction m.
      * reflexivity.
      * inversion H.
    + reflexivity.
  - split.
    + induction m.
      * reflexivity.
      * inversion H.
    + rewrite fR_m_Sn in H. inversion H.
Qed.

Lemma n_m_O_fR : forall m n,
  m = 0 /\ n = 0 ->
  fR m n = 0.
Proof.
  intros. induction n.
  - destruct H. rewrite H. reflexivity.
  - rewrite fR_m_Sn. inversion H. inversion H1.
Qed.

Theorem R_equiv_fR : forall m n o,
  R m n o <-> fR m n = o.
Proof.
Abort.

(* Exercise: 4 stars, advanced (subsequence) *)
Inductive subseq {X}: list X -> list X -> Prop :=
  | sc_nil : forall l : list X, subseq [] l
  | sc_eq : forall (x : X) (l1 l2:list X), subseq l1 l2 -> subseq (x :: l1) (x::l2)
  | sc_eatl2 : forall (x : X) (l1 l2:list X), subseq l1 l2 -> subseq l1 (x :: l2).

Theorem subseq_test1 :
  subseq [1;2;3] [1;2;3].
Proof.
  apply sc_eq. apply sc_eq. apply sc_eq. apply sc_nil.
Qed.

Theorem subseq_test2 :
  subseq [1;2;3] [1;1;1;2;2;3].
Proof.
  apply sc_eq. apply sc_eatl2. apply sc_eatl2. apply sc_eq. apply sc_eatl2. apply sc_eq. apply sc_nil.
Qed.

Theorem subseq_test3 :
  subseq [1;2;3] [1;2;7;3].
Proof.
  apply sc_eq. apply sc_eq. apply sc_eatl2. apply sc_eq. apply sc_nil.
Qed.

Theorem subseq_test4 :
  subseq [1;2;3] [5;6;1;9;9;2;7;3;8].
Proof.
  apply sc_eatl2. apply sc_eatl2. apply sc_eq.
  apply sc_eatl2. apply sc_eatl2. apply sc_eq.
  apply sc_eatl2. apply sc_eq. apply sc_eatl2.
  apply sc_nil.
Qed.

Theorem subseq_test5 :
  subseq [1;2;3] [1;2].
Proof.
  apply sc_eq. apply sc_eq.
Abort.

Theorem subseq_test6 :
  subseq [1;2;3] [].
Proof.
Abort.

Theorem subseq_test7 :
  subseq [] [1;2].
Proof.
  apply sc_nil.
Qed.

Theorem subseq_refl {X:Type}: forall l : list X,
  subseq l l.
Proof.
  intros l.
  induction l.
  - apply sc_nil.
  - apply sc_eq. apply IHl.
Qed.

Lemma sc_eatl2_inverse : forall (x : nat) (l1 l2 : list nat),
  subseq l1 l2 ->
  subseq l1 (x :: l2).
Proof.
  intros. apply sc_eatl2. apply H.
Qed.

Theorem subseq_app {X}: forall l1 l2 l3 : list X,
  subseq l1 l2 ->
  subseq l1 (l2 ++ l3).
Proof.
  intros.
  induction H.
  - apply sc_nil.
  - simpl. apply sc_eq. apply IHsubseq.
  - simpl. apply sc_eatl2. apply IHsubseq.
Qed.

Theorem subseq_shrink : forall (x : nat) (l1 l2 : list nat),
  subseq (x :: l1) l2 -> subseq l1 l2.
Proof.
  intros.
  generalize dependent x.
  generalize dependent l1.
  induction l2.
  - intros. inversion H.
  - intros. apply sc_eatl2. inversion H.
    + apply H1.
    + apply IHl2 with x0. apply H2.
Qed.

Theorem subseq_trans {X}: forall l1 l2 l3 : list X,
  subseq l1 l2 -> subseq l2 l3 -> subseq l1 l3.
Proof.
  intros l1 l2 l3 H1 H2.
  generalize dependent l1.
  induction H2.
  - intros. inversion H1. apply sc_nil.
  - intros. inversion H1.
    + intros. apply sc_nil.
    + apply sc_eq. apply IHsubseq. apply H3.
    + rewrite <- H0. apply sc_eatl2. apply IHsubseq. rewrite H0. apply H3.
  - intros. apply IHsubseq in H1. apply sc_eatl2. apply H1.
Qed.

Theorem subseq_nil {X}: forall l : list X,
  subseq l [] -> l = [].
Proof.
  intros.
  induction l.
  - reflexivity.
  - inversion H.
Qed.

(* Exercise: 2 stars, optional (R_provability2) *)

Inductive R' : nat -> list nat -> Prop :=
  | c'1 : R' 0 []
  | c'2 : forall n l, R' n l -> R' (S n) (n :: l)
  | c'3 : forall n l, R' (S n) l -> R' n l.

Example test_R'1 : R' 2 [1;0].
Proof.
  apply c'2. apply c'2. apply c'1.
Qed.

Example test_R'2 : R' 1 [1;2;1;0].
Proof.
  apply c'3. apply c'2.
  apply c'3. apply c'3. apply c'2.
  apply c'2.
  apply c'2.
  apply c'1.
Qed.

Example test_R'3 : R' 6 [3;2;1;0].
Proof.
  apply c'3.
Abort.

(* Case Study: Regular Experssions *)
Inductive reg_exp {T : Type} : Type :=
| EmptySet : reg_exp
| EmptyStr : reg_exp
| Char     : T -> reg_exp
| App      : reg_exp -> reg_exp -> reg_exp
| Union    : reg_exp -> reg_exp -> reg_exp
| Star     : reg_exp -> reg_exp.

Inductive exp_match {T} : list T -> reg_exp -> Prop :=
| MEmpty  : exp_match [] EmptyStr
| MChar   : forall x, exp_match [x] (Char x)
| MApp    : forall s1 re1 s2 re2,
              exp_match s1 re1 ->
              exp_match s2 re2 ->
              exp_match (s1 ++ s2) (App re1 re2)
| MUnionL  : forall s1 re1 re2,
              exp_match s1 re1 ->
              exp_match s1 (Union re1 re2)
| MUnionR  : forall s1 re1 re2,
              exp_match s1 re2 ->
              exp_match s1 (Union re1 re2)
| MStar0  : forall re, exp_match [] (Star re)
| MStarApp: forall s1 s2 re,
              exp_match s1 re ->
              exp_match s2 (Star re) ->
              exp_match (s1 ++ s2) (Star re).

Notation "s =~ re" := (exp_match s re) (at level 80).

Example reg_exp_ex1 : [1] =~ Char 1.
Proof. apply MChar. Qed.

Example reg_exp_ex12 : [1; 2] =~ App (Char 1) (Char 2).
Proof.
  apply (MApp [1] _ [2]).
  - apply MChar.
  - apply MChar.
Qed.

Example reg_exp_ex3 : ~ ([1; 2] =~ Char 1).
Proof.
  intros contra.
  inversion contra.
Qed.

Fixpoint reg_exp_of_list {T} (l : list T) :=
  match l with
  | [] => EmptyStr
  | x :: l' => App (Char x) (reg_exp_of_list l')
  end.

Example reg_exp_ex4 : [1; 2; 3] =~ reg_exp_of_list [1; 2; 3].
Proof.
  simpl.
  apply (MApp [1]).
  { apply MChar. }
  apply (MApp [2]).
  { apply MChar. }
  apply (MApp [3]).
  { apply MChar. }
  apply MEmpty.
Qed.

Lemma MStar1 :
  forall T s (re : @reg_exp T) ,
         s =~ re ->
         s =~ Star re.
Proof.
  intros.
  rewrite <- app_nil_r with (l:=s).
  apply (MStarApp s [] re).
  - apply H.
  - apply MStar0.
Qed.

(* Exercise: 3 stars (exp_match ex1) *)
Lemma empty_is_empty : forall T (s : list T),
  ~ (s =~ EmptySet).
Proof.
  unfold not.
  intros T s contra.
  inversion contra.
Qed.

Lemma MUnion' : forall T (s : list T) (re1 re2 : @reg_exp T),
  s =~ re1 \/ s =~ re2 ->
  s =~ Union re1 re2.
Proof.
  intros T s re1 re2 [H1 | H2].
  - apply MUnionL. apply H1.
  - apply MUnionR. apply H2.
Qed.

Lemma MApp' : forall T (s1 s2 : list T) (re1 re2 : @reg_exp T),
  s1 =~ re1 /\ s2 =~ re2 ->
  s1 ++ s2 =~ App re1 re2.
Proof.
  intros T s1 s2 re1 re2 [H1 H2].
  apply MApp.
  - apply H1.
  - apply H2.
Qed.

Lemma MStar' : forall T (ss : list (list T)) (re : reg_exp),
  (forall s, In s ss -> s =~ re) ->
  fold app ss [] =~ Star re.
Proof.
  intros.
  induction ss.
  - simpl. simpl in H. apply MStar0.
  - simpl. apply MStarApp.
    + simpl in H. apply H. left. reflexivity.
    + simpl in H. apply IHss. intros. apply H. right. apply H0.
Qed.

Lemma app_plus : forall T x (l : list T),
  x :: l = [x] ++ l.
Proof.
  reflexivity.
Qed.

Lemma reg_exp_of_list_refl : forall T (s : list T),
  s =~ reg_exp_of_list s.
Proof.
  intros. induction s.
  - simpl. apply MEmpty.
  - simpl. rewrite app_plus. apply MApp.
    + apply MChar.
    + apply IHs.
Qed.

(* Exercise: 4 stars, optional (reg_exp_of_list_spec) *)

Lemma reg_exp_of_list_empty : forall T (s : list T),
  s = [] ->
  [] =~ reg_exp_of_list s.
Proof.
  intros. induction s.
  - simpl. apply MEmpty.
  - simpl. inversion H.
Qed.

Lemma reg_exp_of_list_basic : forall T (s1 s2 : list T),
  s1 = s2 ->
  s1 =~ reg_exp_of_list s2.
Proof.
  intros.
  generalize dependent s1.
  induction s2.
   - intros. simpl. rewrite H. apply MEmpty.
   - intros. simpl. rewrite H. rewrite app_plus. apply (MApp [x] _ _).
      + apply MChar.
      + apply reg_exp_of_list_refl.
Qed.

Lemma reg_exp_of_list_basic_inv : forall T (s1 s2 : list T),
  s1 =~ reg_exp_of_list s2 ->
  s1 = s2.
Proof.
  intros.
  generalize dependent s1.
  induction s2 as [| x2].
  - intros. simpl in H. inversion H. reflexivity.
  - intros. inversion H. inversion H3. apply f_equal. apply IHs2. apply H4.
Qed.

Lemma reg_exp_of_list_spec : forall T (s1 s2 : list T),
  s1 =~ reg_exp_of_list s2 <-> s1 = s2.
Proof.
  split.
  - apply reg_exp_of_list_basic_inv.
  - apply reg_exp_of_list_basic.
Qed.

Fixpoint re_chars {T} (re : reg_exp) : list T :=
  match re with
  | EmptySet => []
  | EmptyStr => []
  | Char x => [x]
  | App re1 re2 => re_chars re1 ++ re_chars re2
  | Union re1 re2 => re_chars re1 ++ re_chars re2
  | Star re => re_chars re
  end.

Theorem in_re_match : forall T (s : list T) (re : reg_exp) (x : T),
  s =~ re ->
  In x s ->
  In x (re_chars re).
Proof.
  intros T s re x Hmatch Hin.
  induction Hmatch
    as [| x'
        | s1 re1 s2 re2 Hmatch1 IH1 Hmatch2 IH2
        | s1 re1 re2 Hmatch IH | re1 s2 re2 Hmatch IH
        | re | s1 s2 re Hmatch1 IH1 Hmatch2 IH2].
  - apply Hin.
  - apply Hin.
  - simpl. rewrite In_app_iff in *.
    destruct Hin as [Hin | Hin].
    + left. apply (IH1 Hin).
    + right. apply (IH2 Hin).
  - simpl. rewrite In_app_iff. left. apply (IH Hin).
  - simpl. rewrite In_app_iff. right. apply (IH Hin).
  - destruct Hin.
  - simpl. apply In_app_iff in Hin.
    destruct Hin as [Hin | Hin].
    + apply (IH1 Hin).
    + apply (IH2 Hin).
Qed.

(* Exercise: 4 stars (re_not_empty) *)
Fixpoint re_not_empty {T : Type} (re : @reg_exp T) : bool :=
  match re with
  | EmptySet => false
  | EmptyStr => true
  | Char _ => true
  | App re1 re2 => andb (re_not_empty re1) (re_not_empty re2)
  | Union re1 re2 => orb (re_not_empty re1) (re_not_empty re2)
  | Star _ => true
  end.

(* Compute (re_not_empty (Star (EmptySet))). *)
Compute (re_not_empty (Char [1;2;3;4])).
Compute (re_not_empty (App (Char 1) (EmptySet))).

Lemma re_not_empty_correct : forall T (re : @reg_exp T),
  (exists s, s =~ re) <-> re_not_empty re = true.
Proof.
  intros T re. split.
  { intros H. induction re.
    - (* EmptySet *) inversion H. inversion H0.
    - (* EmptyStr *) reflexivity.
    - (* Char _ *) reflexivity.
    - (* App _ _ *) simpl. rewrite andb_true_iff. split.
      + (* re1 *) apply IHre1. inversion H. inversion H0. exists s1. apply H4.
      + (* re2 *) apply IHre2. inversion H. inversion H0. exists s2. apply H5.
    - (* Union _ _ *) simpl. apply orb_true_iff. inversion H. inversion H0.
      + left. apply IHre1. exists x. apply H3.
      + right. apply IHre2. exists x. apply H3.
    - (* Star *) reflexivity. }
    { induction re.
      - (* EmptySet *) intros. inversion H.
      - (* EmptyStr *) exists []. apply MEmpty.
      - (* Char _ *) exists [t]. apply MChar.
      - (* App _ _ *) intros. inversion H. apply andb_true_iff in H1.
        destruct H1. apply IHre1 in H0. apply IHre2 in H1.
        inversion H0. inversion H1. exists (x ++ x0). apply MApp.
        + apply H2.
        + apply H3.
      - (* Union _ _ *) intros. inversion H. apply orb_true_iff in H1.
        destruct H1.
        + apply IHre1 in H0. inversion H0. exists x. apply MUnionL. apply H1.
        + apply IHre2 in H0. inversion H0. exists x. apply MUnionR. apply H1.
      - (* Star _ *) intros. exists []. apply MStar0. }
Qed.

(* The remember tactic *)

Lemma star_app': forall T (s1 s2 : list T) (re re' : reg_exp),
  re' = Star re ->
  s1 =~ re' ->
  s2 =~ Star re ->
  s1 ++ s2 =~ Star re.
Proof.
  induction re'.
  - intros. inversion H.
  - intros. inversion H.
  - intros. inversion H.
  - intros. inversion H.
  - intros. inversion H.
  - intros. inversion H. inversion H0.
    + simpl. apply H1.
    + subst. apply IHre'.
Abort.

Lemma star_app: forall T (s1 s2 : list T) (re : @reg_exp T),
  s1 =~ Star re ->
  s2 =~ Star re ->
  s1 ++ s2 =~ Star re.
Proof.
  intros T s1 s2 re H1.
  remember (Star re) as re'.
  generalize dependent s2.
  induction H1.
  - (* MEmpty *) inversion Heqre'.
  - (* MChar *) inversion Heqre'.
  - (* MApp *) inversion Heqre'.
  - (* MUnionL *) inversion Heqre'.
  - (* MUnionR *) inversion Heqre'.
  - (* MStar0 *) intros. simpl. apply H.
  - (* MStarApp *) inversion Heqre'. intros. rewrite H0 in IHexp_match1. rewrite H0 in IHexp_match2. rewrite <- app_assoc. apply MStarApp.
    + rewrite H0 in H1_. apply H1_.
    + apply IHexp_match2.
      * reflexivity.
      * apply H.
Qed.

Lemma MStar'' : forall T (s : list T) (re : reg_exp),
  s =~ Star re ->
  exists ss : list (list T),
    s = fold app ss []
    /\ forall s', In s' ss -> s' =~ re.
Proof.
  intros.
  remember (Star re) as re'.
  generalize dependent re.
  induction H.
  - intros. inversion Heqre'.
  - intros. inversion Heqre'.
  - intros. inversion Heqre'.
  - intros. inversion Heqre'.
  - intros. inversion Heqre'.
  - intros. exists []. split.
    + reflexivity.
    + intros. inversion H.
  - intros. remember (s1 ++ s2) as ss. Admitted.

(*
  - intros. induction (s1 ++ s2).
    + exists []. split.
      * reflexivity.
      * simpl. intros. inversion H1.
    + exists [x :: l]. split.
      * simpl. rewrite app_nil_r. reflexivity.
      * simpl. destruct IHl. destruct H1. intros. apply H2. simpl in H3. destruct H3.
        { -

  intros. remember (s1 ++ s2) as ss. induction re.
    + intros. inversion Heqre'. exists [s1 ++ s2]. split.
      * simpl. symmetry. apply app_nil_r.
      * rewrite H2.

    exists [s1 ++ s2]. split.
    + simpl. symmetry. apply app_nil_r.
    +
      intros. simpl in H1. destruct H1.
      *

*)
(*
  intros T s re.
  remember (Star re) as re'.
  generalize dependent re'.
  induction re.
  - intros. induction s.
    + exists []. split.
      * reflexivity.
      * intros. inversion H0.
    + exists ([x :: s]). split.
      * simpl. rewrite app_nil_r. reflexivity.
      * intros. simpl in H0. destruct H0.
        { - inversion H0.

    exists [s]. split.
    + simpl. symmetry. apply app_nil_r.
    + intros.
    inversion H.
    + exists [s]. simpl. split.
      * rewrite app_nil_r. apply H0.
      * intros. induction Heqre'. apply MEmpty.

  intros T s re.
  remember (Star re) as re'.
  generalize dependent re.
  induction re'.
  - intros. inversion Heqre'.
  - intros. inversion Heqre'.
  - intros. inversion Heqre'.
  - intros. inversion Heqre'.
  - intros. inversion Heqre'.
  - intros. inversion Heqre'.
    exists [s]. split.
    + simpl. symmetry. apply app_nil_r.
    + intros. inversion H.
      * rewrite <- H2 in H. simpl in H0.
      intros. simpl in H0. destruct H0.
      *
        rewrite Heqre' in H. apply MStar0. in H.

  - intros. inversion Heqre'.
  - intros. inversion Heqre'.
  - intros. inversion Heqre'.
  - intros. inversion Heqre'.
  - intros. inversion Heqre'.
  - intros. exists [s]. split.
    + simpl. rewrite app_nil_r. reflexivity.
    + apply IHre'. intros. simpl in H0. destruct H0.
      *

*)
(* Almost succeeded
  intros T s re H.
  remember (Star re) as re'.
  generalize dependent re.
  induction H.
  - intros. inversion Heqre'.
  - intros. inversion Heqre'.
  - intros. inversion Heqre'.
  - intros. inversion Heqre'.
  - intros. inversion Heqre'.
  - intros. exists []. split.
    + reflexivity.
    + intros. inversion H.
  - intros. exists [s1 ++ s2]. split.
    + simpl. symmetry. apply app_nil_r.
    + simpl.
      inversion Heqre'.
      intros. simpl in H1. destruct H1.
      *
      apply IHexp_match2. rewrite <- H1.

  - simpl. rewrite app_nil_r. reflexivity.
  - apply MStar1 in H. induction H.
    + intros. simpl in H. inversion H
    + rewrite <- H0. Search Star.

  induction re'.
    + inversion Heqre'.
    + inversion Heqre'.
    + inversion Heqre'.
    + inversion Heqre'.
    + inversion Heqre'.
    + inversion Heqre'. rewrite H1 in IHre'. apply IHre'.
      { Search Star. induction re.
        - inversion H.
        Search MStar'. inversion Heqre'.
*)

(* Exercise: 5 stars, advanced (pumping) *)
Module Pumping.

Fixpoint pumping_constant {T} (re : @reg_exp T) : nat :=
  match re with
  | EmptySet => 0
  | EmptyStr => 1
  | Char _ => 2
  | App re1 re2 =>
      pumping_constant re1 + pumping_constant re2
  | Union re1 re2 =>
      pumping_constant re1 + pumping_constant re2
  | Star _ => 1
  end.

Fixpoint napp {T} (n : nat) (l : list T) : list T :=
  match n with
  | 0 => []
  | S n' => l ++ napp n' l
  end.

Lemma napp_plus : forall T (n m : nat) (l : list T),
  napp (n + m) l = napp n l ++ napp m l.
Proof.
  intros.
  induction n.
  - reflexivity.
  - simpl. rewrite IHn. apply app_assoc.
Qed.

Lemma pumping: forall T (re : @reg_exp T) s,
  s =~ re ->
  pumping_constant re <= length s ->
  exists s1 s2 s3,
    s = s1 ++ s2 ++ s3 /\
    s2 <> [] /\
    forall m, s1 ++ napp m s2 ++ s3 =~ re.
  Import Coq.omega.Omega.
Proof.
  intros T re s Hmatch.
  induction Hmatch
    as [ | x | s1 re1 s2 re2 Hmatch1 IH1 Hmatch2 IH2
       | s1 re1 re2 Hmatch IH | re1 s2 re2 Hmatch IH
       | re | s1 s2 re Hmatch1 IH1 Hmatch2 IH2 ].
  - (* MEmpty *) simpl. omega.
  - (* MChar *) simpl. omega.
  - (* MApp *) simpl. intros. exists s1. exists s2. exists []. simpl. split.
    + rewrite app_nil_r. reflexivity.
    + split.
Abort.

End Pumping.

Theorem filter_not_empty_In : forall n l,
  filter (beq_nat n) l <> [] ->
  In n l.
Proof.
  intros n l. induction l as [|m l' IHl'].
  - simpl. intros. apply H. reflexivity.
  - simpl. destruct (beq_nat n m) eqn:H.
    + intros. left. apply beq_nat_true_iff in H. rewrite H. reflexivity.
    + intros. right. apply IHl'. apply H0.
Qed.

Inductive reflect (P : Prop) : bool -> Prop :=
  | ReflectT : P -> reflect P true
  | ReflectF : ~P -> reflect P false.

Theorem iff_reflect : forall P b,
  (P <-> b = true) -> reflect P b.
Proof.
  intros. destruct b.
  - apply ReflectT. rewrite H. reflexivity.
  - apply ReflectF. rewrite H. unfold not. intros. inversion H0.
Qed.

(* Exercise: 2 stars, recommended (reflect_iff) *)
Theorem reflect_iff : forall P b,
  reflect P b -> (P <-> b = true).
Proof.
  intros P b H.
  destruct b.
  - split.
    + intros. reflexivity.
    + intros. inversion H. apply H1.
  - split.
    + intros. inversion H. exfalso. apply H1. apply H0.
    + intros. inversion H0.
Qed.

Lemma beq_natP : forall n m, reflect (n = m) (beq_nat n m).
Proof.
  intros n m. apply iff_reflect. rewrite beq_nat_true_iff. reflexivity.
Qed.

Theorem filter_not_empty_In' : forall n l,
  filter (beq_nat n) l <> [] ->
  In n l.
Proof.
  intros n l. induction l as [| m l' IHl'].
  - simpl. intros H. apply H. reflexivity.
  - simpl. destruct (beq_natP n m) as [H | H].
    + intros _. rewrite H. left. reflexivity.
    + intros. unfold not in H. right. apply IHl'. apply H0.
Qed.

(* Exercise: 3 stars, recommended (beq_natP_practice) *)
Fixpoint count n l :=
  match l with
  | [] => 0
  | m :: l' => (if beq_nat n m then 1 else 0) + count n l'
  end.

Theorem beq_natP_practice : forall n l,
  count n l = 0 -> ~(In n l).
Proof.
  intros. induction l as [|m l' IHl'].
  - simpl. unfold not. intros contra. apply contra.
  - simpl. unfold not. intros. simpl in H. destruct (beq_natP n m) as [H1 | H1].
    + inversion H.
    + simpl in H. unfold not in H1. destruct H0.
      * symmetry in H0. apply H1 in H0. apply H0.
      * apply IHl' in H0.
        { - apply H0. }
        { - apply H. }
Qed.

(* Additional Exercises *)
(*Exercise: 3 stars, recommended (nostutter_defn) *)

Inductive nostutter {X:Type} : list X -> Prop :=
  | NSEmpty : nostutter []
  | NSSingleEl : forall n : X, nostutter [n]
  | NSRepeated : forall (m n : X) (xs : list X),
      m <> n -> nostutter (n :: xs) -> nostutter (m :: n :: xs).

Example test_nostutter_1: nostutter [3;1;4;1;5;6].
Proof.
  repeat constructor; apply beq_nat_false_iff; auto.
Qed.

Example test_nostutter_2: nostutter (@nil nat).
Proof.
  repeat constructor.
Qed.

Example test_nostutter_3: nostutter [5].
Proof.
  repeat constructor; apply beq_nat_false; auto.
Qed.

Example test_nostutter_4: not (nostutter [3;1;1;4]).
Proof.
  intro.
  repeat match goal with
    h: nostutter _|- _ => inversion h; clear h; subst
  end.
  contradiction H1; auto.
Qed.

(* Exercise: 4 stars, advanced (filter_challenge) *)
Inductive inordermerge {X:Type} : list X -> list X -> list X -> Prop :=
  | IOMEmpty : inordermerge [] [] []
  | IOMMatchesL1 : forall (n : X) (l1 l2 l : list X),
      inordermerge l1 l2 l -> inordermerge (n :: l1) l2 (n :: l)
  | IOMMatchesL2 : forall (n : X) (l1 l2 l : list X),
      inordermerge l1 l2 l -> inordermerge l1 (n :: l2) (n :: l).

Example test_inordermerge_1 : inordermerge [1;6;2] [4;3] [1;4;6;2;3].
Proof.
  repeat constructor.
Qed.

Example test_inordermerge_2 : inordermerge [1;6;2] [] [1;6;2].
Proof.
  repeat constructor.
Qed.

Example test_inordermerge_3 : not (inordermerge [1;2;3] [4;5;6] [1;4;6]).
Proof.
  intro.
  inversion H. clear H. subst.
  inversion H3. clear H3. subst.
  inversion H1.
Qed.

Lemma head_same {X:Type}: forall (x:X) (l1 l2 : list X),
  l1 = l2 ->
  x :: l1 = x :: l2.
Proof.
  intros. simpl. inversion H. reflexivity.
Qed.

(** **** Exercise: 3 stars (all_forallb) *)
(** Inductively define a property [all] of lists, parameterized by a
    type [X] and a property [P : X -> Prop], such that [all X P l]
    asserts that [P] is true for every element of the list [l]. *)
Inductive all {X:Type} : (X -> Prop) -> list X -> Prop :=
  | all_nil : forall (P:X -> Prop), all P []
  | all_match : forall (x:X) (l:list X) (P:X -> Prop), P x -> all P l -> all P (x::l).

Example test_all_1 : all ev [0;2;4].
Proof.
  repeat constructor.
Qed.

Example test_all_2: ~(all ev [2;3;4;5]).
Proof.
  intro.
  inversion H. clear H. subst.
  inversion H4. clear H4. subst.
  inversion H2. inversion H0.
Qed.

(** Recall the function [forallb], from the exercise
    [forall_exists_challenge] in chapter [Poly]: *)
Fixpoint forallb X (test : X -> bool) (l : list X) : bool :=
  match l with
  | [] => true
  | x :: l' => test x && forallb X test l'
  end.

Lemma all_app {X:Type}: forall (x:X) (l:list X) (P: X -> Prop),
  all P (x :: l) ->
  P x /\ all P l.
Proof.
  intros. split.
  - inversion H. apply H3.
  - inversion H. apply H4.
Qed.

(** Using the property [all], write down a specification for [forallb],
    and prove that it satisfies the specification. Try to make your
    specification as precise as possible.
    Are there any important properties of the function [forallb] which
    are not captured by your specification? *)
Theorem all_forallb {X:Type} :
  forall (test : X -> bool) (P: X -> Prop) (l : list X),
  (forall n, test n = true /\ P n) ->
  all P l ->
  forallb X test l = true.
Proof.
  intros.
  induction H0.
  - reflexivity.
  - simpl. apply andb_true_iff. split.
    + destruct H with (n:=x). apply H2.
    + apply IHall. apply H.
Qed.

Theorem filter_challenge {X:Type} :
  forall (l l1 l2: list X) (test:X->bool),
  (forall x, In x l1 -> test x = true) ->
  (forall x, In x l2 -> test x = false) ->
  inordermerge l1 l2 l ->
  filter test l = l1.
Proof.
  intros l l1 l2 test Hl1 Hl2 H.
  induction H.
  - reflexivity.
  - simpl. assert (test n = true) as C.
    + apply Hl1. simpl. left. reflexivity.
    + rewrite C. apply head_same. apply IHinordermerge.
      * intros. apply Hl1. simpl. right. trivial.
      * intros. apply Hl2. trivial.
  - simpl. assert (test n = false) as C.
    + apply Hl2. simpl. left. reflexivity.
    + rewrite C. apply IHinordermerge.
      * apply Hl1.
      * intros. apply Hl2. simpl. right. apply H0.
Qed.

Theorem subseq_pad_l2 : forall (x : nat) (l1 l2 : list nat),
  subseq l1 l2 -> subseq l1 (x :: l2).
Proof.
  intros.
  generalize dependent x.
  generalize dependent l2.
  induction l1.
  - intros. apply sc_nil.
  - intros. simpl in *. apply sc_eatl2. apply H.
Qed.

(* Exercise: 5 stars, advanced (filter_challenge_2) *)
Theorem filter_challenge_2 {X} :
  forall (ls l : list X) (test:X->bool),
  subseq ls l ->
  (forall n, In n ls -> test n = true) ->
  length ls <= length (filter test l).
Proof.
  intros ls l test Hsubseq G.
  induction Hsubseq.
  - apply O_le_n.
  - simpl. assert (test x = true) as C.
    + apply G. simpl. left. reflexivity.
    + rewrite C. simpl. apply n_le_m__Sn_le_Sm. apply IHHsubseq.
      intros. apply G. simpl. right. apply H.
  - simpl. destruct (test x) eqn:C.
    + simpl. apply le_S. apply IHHsubseq. intros. apply G. apply H.
    + apply IHHsubseq. intros. apply G. apply H.
Qed.

(* Exercise: 4 stars, optional (palindromes) *)

Inductive matchlast {X} : X -> list X -> list X -> Prop :=
  | match_same : forall (x:X), matchlast x [x] []
  | match_tail : forall (x y:X) (l m:list X),
      matchlast x l m -> matchlast x (y :: l) (y :: m).

Inductive pal {X} : list X -> Prop :=
  | pal_nil : pal []
  | pal_single : forall x, pal [x]
  | pal_match : forall (x:X) (l m:list X),
      pal l -> matchlast x m l -> pal (x :: m).

Inductive pal2 {X} : list X -> Prop :=
  | c : forall l, l = rev l -> pal2 l.

Lemma matchx_last {X} : forall (x:X) (m:list X),
  matchlast x (m ++ [x]) m.
Proof.
  induction m.
  - simpl. apply match_same.
  - simpl. apply match_tail. apply IHm.
Qed.

Theorem pal_app_rev {X}: forall (l:list X),
  pal (l ++ rev l).
Proof.
  induction l.
  - simpl. apply pal_nil.
  - simpl. rewrite app_plus. apply pal_match with (l0:=(l ++ rev l)).
    + apply IHl.
    + rewrite app_assoc. inversion IHl.
      * simpl. apply match_same.
      * apply match_tail. apply match_same.
      * simpl. apply match_tail. apply matchx_last.
Qed.

Lemma rev_l {X}: forall (x:X) (l:list X),
  l = rev l ->
  x :: l = rev l ++ [x].
Proof.
  intros.
  rewrite app_plus. symmetry. rewrite <- rev_involutive.
  rewrite rev_app_distr. rewrite <- H. simpl.
  symmetry. rewrite <- rev_involutive.
Abort.

Theorem pal2_rev {X}: forall (l:list X),
  pal2 l -> l = rev l.
Proof.
  induction l.
  - intros. reflexivity.
  - intros. simpl. rewrite app_plus. inversion H. simpl in H0.
    rewrite <- H0. reflexivity.
Qed.

Lemma tail_same {X:Type}: forall (x:X) (l1 l2 : list X),
  l1 = l2 ->
  l1 ++ [x] = l2 ++ [x].
Proof.
  intros. rewrite H. reflexivity.
Qed.

Theorem pal2_app_rev {X}: forall (l:list X),
  pal2 (l ++ rev l).
Proof.
  intros. induction l.
  - simpl. apply c. reflexivity.
  - simpl. rewrite app_plus. apply c.
    inversion IHl. rewrite rev_app_distr.
    rewrite rev_app_distr. rewrite rev_app_distr.
    rewrite rev_involutive. simpl. rewrite app_plus. symmetry.
    rewrite app_plus. rewrite <- app_assoc. reflexivity.
Qed.

Lemma pal_prefix {X} : forall (x:X) (l1 l2:list X),
  pal ([x] ++ l1) -> l1 = l2 ++ [x].
Proof.
  Admitted.

Theorem pal_rev {X}: forall (l:list X),
  pal l -> l = rev l.
Proof.
  intros.
  inversion H.
  - reflexivity.
  - reflexivity.
  - inversion H1.
    + reflexivity.
    + subst. simpl in *.
Abort.

Theorem test_pal_1 : pal [1].
Proof.
  apply pal_single.
Qed.

Hint Resolve pal_nil pal_single pal_match match_same match_tail.

Theorem test_pal_2 : pal [1;2;1].
Proof.
  apply pal_match with (l:=[2]).
  - apply pal_single.
  - apply match_tail. apply match_same.
Qed.

Theorem test_pal_3 : pal [1;2;3;2;1].
Proof.
  apply pal_match with (l:=[2;3;2]).
  - apply pal_match with (l:=[3]).
    + apply pal_single.
    + apply match_tail. apply match_same.
  - apply match_tail. apply match_tail. apply match_tail. apply match_same.
Qed.

Theorem test_pal_4 : pal [1;2;3;3;2;1].
Proof.
  apply pal_match with (l:=[2;3;3;2]).
  - apply pal_match with (l:=[3;3]).
    + apply pal_match with (l:=[]).
      * apply pal_nil.
      * apply match_same.
    + apply match_tail. apply match_tail. apply match_same.
  - apply match_tail. apply match_tail. apply match_tail. apply match_tail. apply match_same.
Qed.

Lemma rev_eq_pal_length: forall (X: Type) (n: nat) (l: list X),
  length l <= n -> l = rev l -> pal l.
Proof.
  intros.
  induction n.
  - inversion H.
    assert (G: l = []).
    { - induction l.
        + reflexivity.
        + inversion H2. }
    rewrite G. apply pal_nil.
  - induction l.
    + apply pal_nil.
    + simpl in *. inversion H.
Abort.

(* Exercise: 5 stars, optional (palindrome_converse) *)
Theorem palindrome_converse {X} : forall (l:list X),
  l = rev l -> pal l.
Proof.
  intros.
Abort.

(* Exercise: 4 stars, advanced, optional (NoDup) *)
(* Fixpoint In (A : Type) (x : A) (l : list A) : Prop :=
   match l with
   | [] => False
   | x' :: l' => x' = x \/ In A x l'
   end *)

Inductive NoDup {X}: list X -> Prop :=
  | NoDup_nil : NoDup []
  | NoDup_element : forall (x:X) (l:list X), NoDup l -> ~ In x l -> NoDup (x :: l).

Example tests_nodup_1 : NoDup [1;2;3;4].
Proof.
  apply NoDup_element.
  - apply NoDup_element.
    + apply NoDup_element.
      * apply NoDup_element.
        { - apply NoDup_nil. }
        { - auto. }
      * simpl. unfold not. intros. destruct H. inversion H. apply H.
    + simpl. unfold not. intros. destruct H.
      * inversion H.
      * destruct H.
        { - inversion H. }
        { - apply H. }
  - unfold not. intros. destruct H.
    + inversion H.
    + destruct H.
      * inversion H.
      * simpl in H. destruct H.
        { - inversion H. }
        { - apply H. }
Qed.

Example tests_nodup_2 : NoDup [1;2;1].
Proof.
  apply NoDup_element.
  - apply NoDup_element.
    + apply NoDup_element.
      * apply NoDup_nil.
      * simpl. auto.
    + unfold not. intros. destruct H. inversion H. apply H.
 - unfold not. intros. destruct H. inversion H. Abort.

Fixpoint disjoint {X} (l1 l2: list X) : Prop :=
  ~ exists x, In x l1 /\ In x l2.

Lemma disjoint_empty {X:Type} : forall (l:list X),
  disjoint l [].
Proof.
  intros. induction l.
  - simpl. unfold not. intros. destruct H. destruct H. apply H.
  - simpl. unfold not. intros. destruct H. destruct H. apply H0.
Qed.

Lemma disjoint_refl_false {X} : forall (l:list X),
  l <> [] ->
  ~ disjoint l l.
Proof.
  intros.
  induction l.
  - simpl. unfold not. intros. apply H. reflexivity.
  - simpl. unfold not. intros. apply H0. exists x. split.
    + left. reflexivity.
    + left. reflexivity.
Qed.

Lemma In_empty {X:Type} : forall x:X,
  ~ In x [].
Proof.
  intros. unfold not. intros.
  inversion H.
Qed.

Theorem NoDup_disjoint_app {X} : forall l1 l2 : list X,
  disjoint l1 l2 ->
  NoDup (l1 ++ l2).
Proof.
  intros. induction l2.
  - induction l1.
    + simpl. apply NoDup_nil.
    + simpl. rewrite app_nil_r in *. apply NoDup_element.
      * apply IHl1. apply disjoint_empty.
      * unfold not. intros. induction IHl1.
        { - inversion H0. }
        { - apply IHn.
            + apply disjoint_empty.
            + unfold not in H1.
      exists x. split.
        { - simpl. left. reflexivity. }
        { - simpl.

  intros. induction l1.
  - induction l2.
    + apply NoDup_nil.
    + apply NoDup_element.
      * simpl in *. apply IHl2. unfold not in *. intros. destruct H0. destruct H0. apply H0.
      * admit.
  - induction l2.
    + simpl. rewrite app_nil_r in *. apply NoDup_element.
      * apply IHl1. apply disjoint_empty.
      * destruct IHl1.
        { - apply disjoint_empty. }
        { - unfold not. intros. inversion H0. }
        { - simpl. unfold not in *. intros. apply H0. destruct H1.
            + rewrite H1. admit.
            +

  intros.
  induction (l1 ++ l2).
  - apply NoDup_nil.
  - apply NoDup_element.
    + apply IHl.
    + unfold not. intros. induction l1.
      *

  intros. induction l2.
  - induction l1.
    + simpl. apply NoDup_nil.
    + simpl. rewrite app_nil_r in *. apply NoDup_element.
      * apply IHl1. apply disjoint_empty.
      * unfold not. intros. induction H. exists x. split.
        { - simpl. left. reflexivity. }
        { -

        simpl. rewrite app_nil_r in IHl1. destruct IHl1.
            + apply disjoint_empty.
            + simpl in H0. apply H0.
            + unfold not in H. apply H. inversion H0.
              * inversion n.
                { - apply In_empty.

                 rewrite H1 in H0. rewrite app_plus in H0. Search In. apply In_app_iff in H0. destruct H0.
                { - apply H. rewrite H1.

              Search In. inversion H0. apply H. rewrite <- H1 in H0. inversion H0.
                { - rewrite <- H1 in *. inversion H0. rewrite H2. apply In_empty.

            destruct H. simpl in H0. destruct H0.
              * rewrite H. apply

  intros. induction l1.
  - simpl in *. induction l2.
    + apply NoDup_nil.
    + apply NoDup_element.
      * apply IHl2. unfold not in *. intros. destruct H0. destruct H0. apply H0.
      * destruct H. exists x. split.
        { -
        unfold not in *. intros. apply H. exists x. split.
        { -

  unfold not in H. destruct H. exists
Qed.


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

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

Compute (next_weekday friday).
(* ==> monday : day *)

Compute (next_weekday (next_weekday saturday)).
(* ==> tuesday : day *)

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

Proof. simpl. reflexivity.  Qed.

Inductive bool : Type :=
  | true
  | false.

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

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

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

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.

(** We can also introduce some familiar syntax for the boolean
    operations we have just defined. The [Notation] command defines a new
    symbolic notation for an existing definition. *)

Notation "x && y" := (andb x y).
Notation "x || y" := (orb x y).

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

(** **** Exercise: 1 star, standard (nandb)   *)
Definition ref (b1:bool): bool:=
  match b1 with
  |true => false
  |false => true
  end.
Definition nandb (b1:bool) (b2:bool):bool:=
   match b2 with
   |true =>ref b1
   |false =>true
   end.
Example test_nandb1:               (nandb true false) = true.
(* FILL IN HERE *)Proof. simpl. reflexivity. Qed.
Example test_nandb2:               (nandb false false) = true.
(* FILL IN HERE *)Proof. simpl. reflexivity. Qed.
Example test_nandb3:               (nandb false true) = true.
(* FILL IN HERE *)Proof. simpl. reflexivity. Qed.
Example test_nandb4:               (nandb true true) = false.
(* FILL IN HERE *)Proof. simpl. reflexivity. Qed.
(** [] *)

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

Definition andb3 (b1:bool) (b2:bool) (b3:bool) : bool:=
    match b1 with
    |false =>false
    |true =>(andb b2 b3)
    end.
Example test_andb31: (andb3 true true true) = true.
(* FILL IN HERE *)Proof. simpl. reflexivity. Qed.
Example test_andb32:(andb3 false true true) = false.
(* FILL IN HERE *)Proof. simpl. reflexivity. Qed.
Example test_andb33:(andb3 true false true) = false.
(* FILL IN HERE *)Proof. simpl. reflexivity. Qed.
Example test_andb34:(andb3 true true false) = false.
(* FILL IN HERE *)Proof. simpl. reflexivity. Qed.
(** [] *)

(* ================================================================= *)
(** ** Types *)

Check true.
(* ===> true : bool *)
Check (negb true).
(* ===> negb true : bool *)

Check negb.
(* ===> negb : bool -> bool *)

(* ================================================================= *)
(** ** New Types from Old *)

Inductive rgb : Type :=
  | red
  | green
  | blue.

Inductive color : Type :=
  | black
  | white
  | primary (p : rgb).

Definition monochrome (c : color) : bool :=
  match c with
  | black => true
  | white => true
  | primary q => false
  end.

Definition isred (c : color) : bool :=
  match c with
  | black => false
  | white => false
  | primary red => true
  | primary _ => false
  end.

(* ================================================================= *)
(** ** Tuples *)

Inductive bit : Type :=
  | B0
  | B1.

Inductive nybble : Type :=
  | bits (b0 b1 b2 b3 : bit).

Check (bits B1 B0 B1 B0).
(* ==> bits B1 B0 B1 B0 : nybble *)

Definition all_zero (nb : nybble) : bool :=
  match nb with
    | (bits B0 B0 B0 B0) => true
    | (bits _ _ _ _) => false
  end.

Compute (all_zero (bits B1 B0 B1 B0)).
(* ===> false : bool *)
Compute (all_zero (bits B0 B0 B0 B0)).
(* ===> true : bool *)

(* ================================================================= *)
(** ** Modules *)

Module NatPlayground.

(* ================================================================= *)
(** ** Numbers *)

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

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

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

End NatPlayground.

(** Because natural numbers are such a pervasive form of data,
    Coq provides a tiny bit of built-in magic for parsing and printing
    them: ordinary decimal numerals can be used as an alternative to
    the "unary" notation defined by the constructors [S] and [O].  Coq
    prints numbers in decimal form by default: *)

Check (S (S (S (S O)))).
  (* ===> 4 : nat *)

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

Compute (minustwo 4).
  (* ===> 2 : nat *)

(** The constructor [S] has the type [nat -> nat], just like
    [pred] and functions like [minustwo]: *)

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.

(** We can define [oddb] by a similar [Fixpoint] declaration, but here
    is a simpler definition: *)

Definition oddb (n:nat) : bool   :=   negb (evenb n).
Example test_oddb1:    oddb 1 = true.
Proof. simpl. reflexivity.  Qed.
Example test_oddb2:    oddb 4 = false.
Proof. simpl. reflexivity.  Qed.

(** (You will notice if you step through these proofs that
    [simpl] actually has no effect on the goal -- all of the work is
    done by [reflexivity].  We'll see more about why that is shortly.)

    Naturally, we can also define multi-argument functions by
    recursion.  *)

Module NatPlayground2.

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

(** Adding three to two now gives us five, as we'd expect. *)

Compute (plus 3 2).

(** The simplification that Coq performs to reach this conclusion can
    be visualized as follows: *)

(*  [plus (S (S (S O))) (S (S O))]
==> [S (plus (S (S O)) (S (S O)))]
      by the second clause of the [match]
==> [S (S (plus (S O) (S (S O))))]
      by the second clause of the [match]
==> [S (S (S (plus O (S (S O)))))]
      by the second clause of the [match]
==> [S (S (S (S (S O))))]
      by the first clause of the [match]
*)

(** As a notational convenience, if two or more arguments have
    the same type, they can be written together.  In the following
    definition, [(n m : nat)] means just the same as if we had written
    [(n : nat) (m : nat)]. *)

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

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

(** You can match two expressions at once by putting a comma
    between them: *)

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

End NatPlayground2.

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

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

    Recall the standard mathematical factorial function:

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

    Translate this into 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.
(** [] *)

(** Again, we can make numerical expressions easier to read and write
    by introducing notations for addition, multiplication, and
    subtraction. *)

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

Check ((0 + 1) + 1).

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

(** Similarly, the [leb] function tests whether its first argument is
    less than or equal to its second argument, yielding a boolean. *)

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

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

(** Since we'll be using these (especially [eqb]) a lot, let's give
    them infix notations. *)

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

Example test_leb3':             (4 <=? 2) = false.
Proof. simpl. reflexivity.  Qed.

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

    The [ltb] function tests natural numbers for [l]ess-[t]han,
    yielding a [b]oolean.  Instead of making up a new [Fixpoint] for
    this one, define it in terms of a previously defined
    function.  (It can be done with just one previously defined
    function, but you can use two if you need to.) *)

Definition ltb (n m : nat) : bool:=(n<=?m)&&ref(n=?m).

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

Example test_ltb1:             (ltb 2 2) = false.
  Proof. simpl. reflexivity. Qed.
Example test_ltb2:             (ltb 2 4) = true.
  Proof. simpl. reflexivity. Qed.
Example test_ltb3:             (ltb 4 2) = false.
  Proof. simpl. reflexivity. Qed.
(** [] *)

(* ################################################################# *)
(** * Proof by Simplification *)

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

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

(** Other similar theorems can be proved with the same pattern. *)

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.

(** The [_l] suffix in the names of these theorems is
    pronounced "on the left." *)

(** It is worth stepping through these proofs to observe how the
    context and the goal change.  You may want to add calls to [simpl]
    before [reflexivity] to see the simplifications that Coq performs
    on the terms before checking that they are equal. *)

(* ################################################################# *)
(** * Proof by Rewriting *)

(** This theorem is a bit more interesting than the others we've
    seen: *)

Theorem plus_id_example : forall n m:nat,
  n = m ->
  n + n = m + m.
Proof.
  (* move both quantifiers into the context: *)
  intros n m.
  (* move the hypothesis into the context: *)
  intros H.
  (* rewrite the goal using the hypothesis: *)
  rewrite -> H.
  reflexivity.  Qed.

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

    Remove "[Admitted.]" and fill in the proof. *)

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

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

(** **** Exercise: 2 stars, standard (mult_S_1)  *)
Theorem mult_S_1 : forall n m : nat,
  m = S n ->
  m * (1 + n) = m * m.
Proof.
  intros n m.
  intros H1.
  rewrite -> plus_1_l.
  rewrite <- H1.
  reflexivity. Qed.

  (* (N.b. This proof can actually be completed with tactics other than
     [rewrite], but please do use [rewrite] for the sake of the exercise.)

    [] *)

(* ################################################################# *)
(** * Proof by Case Analysis *)

Theorem plus_1_neq_0_firsttry : forall n : nat,
  (n + 1) =? 0 = false.
Proof.
  intros n.
  simpl.  (* does nothing! *)
Abort.

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

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

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

Theorem andb_commutative' : forall b c, andb b c = andb c b.
Proof.
  intros b c. destruct b eqn:Eb.
  { destruct c eqn:Ec.
    { reflexivity. }
    { reflexivity. } }
  { destruct c eqn:Ec.
    { reflexivity. }
    { reflexivity. } }
Qed.

(** Since curly braces mark both the beginning and the end of a
    proof, they can be used for multiple subgoal levels, as this
    example shows. Furthermore, curly braces allow us to reuse the
    same bullet shapes at multiple levels in a proof: *)

Theorem andb3_exchange :
  forall b c d, andb (andb b c) d = andb (andb b d) c.
Proof.
  intros b c d. destruct b eqn:Eb.
  - destruct c eqn:Ec.
    { destruct d eqn:Ed.
      - reflexivity.
      - reflexivity. }
    { destruct d eqn:Ed.
      - reflexivity.
      - reflexivity. }
  - destruct c eqn:Ec.
    { destruct d eqn:Ed.
      - reflexivity.
      - reflexivity. }
    { destruct d eqn:Ed.
      - reflexivity.
      - reflexivity. }
Qed.

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

(** If there are no arguments to name, we can just write [[]]. *)

Theorem andb_commutative'' :
  forall b c, andb b c = andb c b.
Proof.
  intros [] [].
  - reflexivity.
  - reflexivity.
  - reflexivity.
  - reflexivity.
Qed.

(** **** Exercise: 2 stars, standard (andb_true_elim2)

    Prove the following claim, marking cases (and subcases) with
    bullets when you use [destruct]. *)

Theorem andb_true_elim2 : forall b c : bool,
  andb b c = true -> c = true.
Proof.
   intros b c.
   intros H1.
Abort.
(** [] *)

(** **** Exercise: 1 star, standard (zero_nbeq_plus_1)  *)
Theorem zero_nbeq_plus_1 : forall n : nat,
  0 =? (n + 1) = false.
Proof.
  intros n. destruct n as [|n'] eqn:E.
  -reflexivity.
Abort.
(** [] *)

(* ================================================================= *)
(** ** More on Notation (Optional) *)

(** (In general, sections marked Optional are not needed to follow the
    rest of the book, except possibly other Optional sections.  On a
    first reading, you might want to skim these sections so that you
    know what's there for future reference.)

    Recall the notation definitions for infix plus and times: *)

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

(* ================================================================= *)
(** ** Fixpoints and Structural Recursion (Optional) *)

(** Here is a copy of the definition of addition: *)

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

(* ################################################################# *)
(** * More Exercises *)

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

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

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

Theorem negation_fn_applied_twice :
  forall (f :bool -> bool),
  (forall (x : bool), f x = negb x) ->
  forall (b :bool), f(f b)=b.

Proof.
  intros f.
  intros H.
  intros b. destruct b eqn: Eb.
  -rewrite -> H. simpl. rewrite ->H. reflexivity.
  -rewrite -> H. simpl. rewrite ->H. reflexivity.
Qed.
From Coq Require Export String.

(* Do not modify the following line: *)
Definition manual_grade_for_negation_fn_applied_twice : option (nat*string) := None.
(** [] *)

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

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

(** [] *)

(** **** Exercise: 3 stars, standard (binary) *)

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

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

Fixpoint bin_to_nat (m:bin) : nat :=
  match m with
  |Z => 0
  |A m' => 2*( bin_to_nat m')
  |B m' => 1+ 2* (bin_to_nat m')
  end.
Example test_bin_incr1 : (incr (B Z)) = A (B Z).
Proof. reflexivity. Qed.
Example test_bin_incr2 : (incr (A (B Z))) = B (B Z).
Proof. reflexivity. Qed.
Example test_bin_incr3 : (incr (B (B Z))) = A (A (B Z)).
Proof. reflexivity. Qed.
Example test_bin_incr4 : bin_to_nat (A (B Z)) = 2.
Proof. reflexivity. Qed.
Example test_bin_incr5 :
        bin_to_nat (incr (B Z)) = 1 + bin_to_nat (B Z).
Proof. reflexivity. Qed.
Example test_bin_incr6 :
        bin_to_nat (incr (incr (B Z))) = 2 + bin_to_nat (B Z).
Proof. reflexivity. Qed.
Definition manual_grade_for_binary : option (nat*string) := None.
(** [] *)


Inductive Dec (p:Prop) : Type :=
| isTrue : p  -> Dec p
| isFalse: ~p -> Dec p
.

Arguments isTrue {p}.
Arguments isFalse {p}.

Class Decidable (p:Prop) := { dec : Dec p }.

Definition check (p:Prop) (d:Decidable p) : bool :=
    if dec then true else false.

Arguments check _ {d}.

Instance decTrue   : Decidable True   := { dec := isTrue I  }.
Instance decFalse  : Decidable False  := { dec := isFalse (fun x => x) }.

Definition L1 : check True = true.
Proof. reflexivity. Qed.

Definition L2 : check False = false.
Proof. reflexivity. Qed.

Instance decImp (p q:Prop) (d1:Decidable p) (d2:Decidable q) : Decidable (p -> q)
    := { dec :=
            match dec with
            | isTrue y  => isTrue (fun _ => y)
            | isFalse y =>
                match dec with
                | isTrue x  => isFalse (fun f => y (f x))
                | isFalse x => isTrue  (fun z => match x z with end)
                end
            end
}.

Definition L3 : check (~True) = false.
Proof. reflexivity. Qed.

Definition L4 : check (~False) = true.
Proof. reflexivity. Qed.

Definition L5 : check (True -> True) = true.
Proof. reflexivity. Qed.

Definition L6 : check (False -> True) = true.
Proof. reflexivity. Qed.

Instance decAnd (p q:Prop) (d1:Decidable p) (d2:Decidable q) : Decidable (p /\ q)
    := { dec :=
            match dec with
            | isTrue x  =>
                match dec with
                | isTrue y  => isTrue (conj x y)
                | isFalse y => isFalse
                    (fun (H:p /\ q) =>
                        match H with
                        | conj _ y' => y y'
                        end)
                end
            | isFalse x => isFalse
                (fun (H:p /\ q) =>
                    match H with
                    | conj x' _ => x x'
                    end)
            end
}.

Definition L8 : check (True /\ True) = true.
Proof. reflexivity. Qed.

Definition L9 : check (True /\ False) = false.
Proof. reflexivity. Qed.

Definition L10 : check (False /\ True) = false.
Proof. reflexivity. Qed.

Definition L11 : check (False /\ False) = false.
Proof. reflexivity. Qed.

Instance decOr (p q:Prop) (d1:Decidable p) (d2:Decidable q) : Decidable (p \/ q)
    := { dec :=
            match dec with
            | isTrue x  => isTrue (or_introl x)
            | isFalse x =>
                match dec with
                | isTrue y  => isTrue (or_intror y)
                | isFalse y => isFalse
                    (fun (H:p \/q) =>
                        match H with
                        | or_introl x'  => x x'
                        | or_intror y'  => y y'
                        end)
                end
            end
}.

Definition L12 : check (True \/ True) = true.
Proof. reflexivity. Qed.

Definition L13 : check (True \/ False) = true.
Proof. reflexivity. Qed.

Definition L14 : check (False \/ True) = true.
Proof. reflexivity. Qed.

Definition L15 : check (False \/ False) = false.
Proof. reflexivity. Qed.

(* Should be able to import this from Peano_dec, not some name conflict appears *)
Definition eq_nat_dec : forall (m n:nat), {m = n} + {m <> n}.
Proof.
    induction m as [|m IH]; destruct n as [|n].
    - left. reflexivity.
    - right. intros H. inversion H.
    - right. intros H. inversion H.
    - destruct (IH n) as [H|H].
        + subst. left. reflexivity.
        + right. intros H'. inversion H'. subst. apply H.
          reflexivity.
Defined. (* do  not use 'Qed' here, as we need to compute check                 *)

Instance decEqNat (m n:nat) : Decidable (m = n) := { dec :=
    match eq_nat_dec m n with
    | left H    => isTrue H
    | right H   => isFalse H
    end
}.

Definition L16 : check (0 = 0) = true.
Proof. reflexivity. Qed.

Definition L17 : check (0 <> 0) = false.
Proof. reflexivity. Qed.

Definition L18 : check (0 = 1) = false.
Proof. reflexivity. Qed.

Definition L19 : check (0 <> 1) = true.
Proof. reflexivity. Qed.

Definition L20 : check (3 <> 5) = true.
Proof. reflexivity. Qed.

Definition le_dec : forall (m n:nat), {m <= n} + {~ m <= n}.
Proof.
    induction m as [|m IH]; intro n.
    - left. revert n. induction n as [|n IH].
        + apply le_n.
        + apply le_S. assumption.
    - destruct n as [|n].
        + right. intros H. inversion H.
        + destruct (IH n) as [H|H].
            { left. apply le_n_S. assumption. }
            { right. intros H'. apply H. apply le_S_n. assumption. }
Defined. (* not 'Qed' !!  *)

Instance decLeqNat (m n:nat) : Decidable (m <= n) := { dec :=
    match le_dec m n with
    | left H    => isTrue H
    | right H   => isFalse H
    end
}.

Definition L21 : check (0 <= 0) = true.
Proof. reflexivity. Qed.

Definition L22 : check (~ 0 <= 0) = false.
Proof. reflexivity. Qed.

Definition L23 : check (3 <= 5) = true.
Proof. reflexivity. Qed.

Definition L24 : check (~ 3 <= 5) = false.
Proof. reflexivity. Qed.

Definition L25 : check (5 <= 3) = false.
Proof. reflexivity. Qed.

Definition L26 : check (~ 5 <= 3) = true.
Proof. reflexivity. Qed.

Definition eqb (m n:nat) (d:Decidable (m = n)) : bool :=
    if dec then true else false.

Arguments eqb _ _ {d}.

Definition L27 : eqb 5 5 = true.
Proof. reflexivity. Qed.

Definition lt_dec : forall (m n:nat), {m < n} + {~ m < n}.
Proof. intros m n. unfold lt. apply le_dec. Defined.

Instance decLtNat (m n:nat) : Decidable (m < n) := { dec :=
    match lt_dec m n with
    | left H    => isTrue H
    | right H   => isFalse H
    end
}.

(*
Compute check (False -> False) _.
Compute check (False -> True) _.
Compute check (True -> True) _.
Compute check (True -> False) _.
Compute check ((True -> False) -> False) _.
*)

Definition asTrueFalse (c:Prop) (d:Decidable c) : Prop :=
    if dec then True else False.

Arguments asTrueFalse _ {d}.

Definition fromAsTrueFalse (c:Prop) (d:Decidable c) (q:asTrueFalse c) : c.
Proof.
    unfold asTrueFalse in q. destruct dec as [H|H].
    - exact H.
    - contradiction.
Defined.

Arguments fromAsTrueFalse _ {d}.

Definition fromAsTrueFalse2 : forall (c:Prop) (d:Decidable c) (q:asTrueFalse c), c.
Proof.
refine (
    fun (c:Prop) (d:Decidable c) =>
        match dec as d return (if d then True else False) -> c with
        | isTrue H  => fun _      => H
        | isFalse H => fun pFalse =>
            match pFalse with end
        end
).
Qed.

Notation "£ c" := (fromAsTrueFalse c I) (at level 50).

Definition L28 : 0 <> 1 := £ (0 <> 1).
Definition L29 : check (0 <> 1 /\ (5 < 2 \/ 3 < 7)) = true.
Proof. reflexivity. Qed.
Definition L30 : (0 <> 1 /\ (5 < 2 \/ 3 < 7)) := £ (0 <> 1 /\ (5 < 2 \/ 3 < 7)).


Require Export Poly.
Require Export Basics.

Check (2 + 2 = 4).

Definition plus_fact : Prop := 2 + 2 = 4.
Check plus_fact.

Theorem plus_fact_is_true : plus_fact.
Proof. reflexivity. Qed.

Definition strange_prop1 : Prop :=
  (2 + 2 = 5) -> (99 + 26 = 42).
Definition strange_prop2 : Prop :=
  forall n, (ble_nat n 17 = true) -> (ble_nat n 99 =true).

Definition even (n:nat) : Prop :=
  evenb n = true.

Check even.
Check (even 4).
Check (even 3).

Definition even_n__even_SSn (n:nat) : Prop :=
  (even n) -> (even (S (S n))).

Definition between (n m o:nat) : Prop :=
  andb (ble_nat n o) (ble_nat o m) = true.

Definition teen : nat->Prop := between 13 19.

Definition true_for_zero (P:nat->Prop) : Prop :=
  P 0.

Definition true_for_n__true_for_Sn (P:nat->Prop) (n:nat) : Prop :=
  P n -> P (S n).

Definition preserved_by_S (P:nat->Prop) : Prop :=
  forall n', P n' -> P (S n').

Definition true_for_all_numbers (P:nat->Prop) : Prop :=
  forall n, P n.

Definition our_nat_induction (P:nat->Prop) : Prop :=
  (true_for_zero P) ->
  (preserved_by_S P) ->
  (true_for_all_numbers P).

Inductive good_day : day -> Prop :=
| gd_sat : good_day saturday
| gd_sun : good_day sunday.

Theorem gds : good_day sunday.
Proof. apply gd_sun. Qed.

Inductive day_before : day -> day -> Prop :=
| db_tue : day_before tuesday monday
| db_wed : day_before wednesday tuesday
| db_thu : day_before thursday wednesday
| db_fri : day_before friday thursday
| db_sat : day_before saturday friday
| db_sun : day_before sunday saturday
| db_mon : day_before monday sunday.

Inductive fine_day_for_singing : day -> Prop :=
| fdfs_any : forall d:day, fine_day_for_singing d.

Theorem fdfs_wed : fine_day_for_singing wednesday.
Proof. apply fdfs_any. Qed.

Definition fdfs_wed' : fine_day_for_singing wednesday :=
  fdfs_any wednesday.

Check fdfs_wed.
Check fdfs_wed'.

Inductive ok_day : day -> Prop :=
| okd_gd : forall d,
    good_day d ->
    ok_day d
| okd_before : forall d1 d2,
    ok_day d2 ->
    day_before d2 d1 ->
    ok_day d1.

Definition okdw : ok_day wednesday :=
  okd_before wednesday thursday
             (okd_before thursday friday
                         (okd_before friday saturday
                                     (okd_gd saturday gd_sat)
                                     db_sat)
                         db_fri)
             db_thu.

Theorem okdw' : ok_day wednesday.
Proof.
  apply okd_before with (d2:=thursday).
  apply okd_before with (d2:=friday).
  apply okd_before with (d2:=saturday).
  apply okd_gd. apply gd_sat.
  apply db_sat. apply db_fri.
  apply db_thu.
Qed.

Print okdw'.

Definition okd_before2 := forall d1 d2 d3,
    ok_day d3 ->
    day_before d2 d1 ->
    day_before d3 d2 ->
    ok_day d1.

Theorem okd_before2_valid : okd_before2.
Proof.
  unfold okd_before2. intros d1 d2 d3 H1 H2 H3.
  apply okd_before with d2.
  apply okd_before with d3.
  apply H1. apply H3. apply H2.
Qed.

Definition okd_before2_valid' : okd_before2 :=
  fun (d1 d2 d3 : day) =>
  fun (H : ok_day d3) =>
  fun (H0 : day_before d2 d1) =>
  fun (H1 : day_before d3 d2) =>
  okd_before d1 d2 (okd_before d2 d3 H H1) H0.

Print okd_before2_valid.

Check nat_ind.

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

Theorem plus_one_r' : forall n:nat,
    n + 1 = S n.
Proof.
  apply nat_ind.
  Case "O". reflexivity.
  Case "S". simpl. intros n IHn. rewrite -> IHn.
    reflexivity.
Qed.

Inductive yesno : Type :=
| yes : yesno
| no : yesno.

Check yesno_ind.

Inductive rgb : Type :=
| red : rgb
| green : rgb
| blue : rgb.

Check rgb_ind.

Inductive natlist : Type :=
| nnil : natlist
| ncons : nat -> natlist -> natlist.

Check natlist_ind.

Inductive natlist1 : Type :=
| nnil1 : natlist1
| nsnoc1 : natlist1 -> nat -> natlist1.

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

Check ExSet_ind.

Inductive tree (X:Type) : Type :=
| leaf : X -> tree X
| node : tree X -> tree X -> 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 : list X -> foo' X -> foo' X
| C2 : foo' X.

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

*)

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

Theorem four_ev' :
  ev 4.
Proof.
  apply ev_SS. apply ev_SS. apply ev_0.
Qed.

Definition four_ev : ev 4 := ev_SS 2 (ev_SS 0 ev_0).

Definition ev_plus4 : forall n, ev n -> ev (4+n) :=
  fun (n:nat) =>
    fun (e:ev n) =>
       ev_SS (2+n) (ev_SS n e).

Theorem ev_plus4' : forall n,
    ev n -> ev (4 + n).
Proof.
  intros. induction n as [| n'].
  (*Case "n = 0".*) simpl. apply four_ev.
  (*Case "n = S n'".*) simpl. apply ev_SS. apply ev_SS. apply H.
Qed.

Print ev_plus4'.

Theorem double_even : forall n,
    ev (double n).
Proof.
  intros. induction n as [| n'].
  (*Case "n = 0".*) simpl. apply ev_0.
  (*Case "n = S n'".*) simpl. apply ev_SS. apply IHn'.
Qed.

(*わかりませんですた*)
Print double_even.

Theorem ev_minus2 : forall n,
    ev n -> ev (pred (pred n)).
Proof.
  intros n E.
  destruct E as [| n' E'].
  Case "E = ev_0". simpl. apply ev_0.
  Case "E = ev_SS n' E'". simpl. apply E'.
Qed.

Theorem ev_minus2_n : forall n,
    ev n -> ev (pred (pred n)).
Proof.
  intros n E. destruct n as [| n'].
  Case "n = 0". simpl. apply ev_0.
  Case "n = S n'". simpl. (*保留*)
Admitted.

Theorem ev_even : forall n,
    ev n -> even n.
Proof.
  intros n E. induction E as [| n' E'].
  Case "E = ev_0".
    unfold even. reflexivity.
  Case "E = ev_SS n' E'".
    unfold even. apply IHE'.
Qed.

Theorem ev_even_n : forall n,
    ev n -> even n.
Proof.
  intros n E. induction n as [| n'].
  Case "n = 0".
    unfold even. reflexivity.
  Case "n = S n'".
    unfold even. (*保留*)
Admitted.

(*
Theorem l : forall n,
    ev n.
Proof.
  intros n. induction n.
  Case "O". simpl. apply ev_0.
  Case "S".
すべてのnについてev nは成り立たない
*)

Theorem ev_sum : forall n m,
    ev n -> ev m -> ev (n+m).
Proof.
  intros n m E F. induction E as [| n' E'].
  Case "E = ev_0". simpl. apply F.
  Case "E = ev_SS n' E'".
    simpl. apply ev_SS. apply IHE'.
Qed.

Theorem SSev_even : forall n,
    ev (S (S n)) -> ev n.
Proof.
  intros n E. inversion E as [| n' E']. apply E'.
Qed.

Theorem SSSSev_even : forall n,
    ev (S (S (S (S n)))) -> ev n.
Proof.
  intros n E. inversion E as [| n' E'].
  inversion E' as [| n'' E'']. apply E''.
Qed.

Theorem even5_nonsense :
  ev 5 -> 2+2=9.
Proof.
  intros. inversion H.
  inversion H1. inversion H3.
Qed.

Theorem ev_minus2' : forall n,
    ev n -> ev (pred (pred n)).
Proof.
  intros n E. inversion E as [| n' E'].
  Case "E = ev_0". simpl. apply ev_0.
  Case "E = ev_SS n' E'". simpl. apply E'.
Qed.

Theorem ev_ev_even : forall n m,
    ev (n+m) -> ev n -> ev m.
Proof.
  intros n m E F. generalize dependent m.
  induction F as [| n' F'].
  Case "F = ev_0". intros. apply E.
  Case "F = ev_SS n' F'". intros.
    inversion E. apply IHF'. apply H0.
Qed.

Theorem ev_plus_plus : forall n m p,
    ev (n+m) -> ev (n+p) -> ev (m+p).
Proof.
  intros n m p E F.
(*わからん
恐らくev_ev_evenとev_sumを利用するのだとは思う
*)
Admitted.

Inductive MyProp : nat -> Prop :=
| MyProp1 : MyProp 4
| MyProp2 : forall n:nat, MyProp n -> MyProp (4 + n)
| MyProp3 : forall n:nat, MyProp (2 + n) -> MyProp n.

Theorem MyProp_ten : MyProp 10.
Proof.
  apply MyProp3. simpl.
  assert (12 = 4 + 8) as H12.
    Case "Proof of assertion". reflexivity.
  rewrite -> H12.
  apply MyProp2.
  assert (8 = 4 + 4) as H8.
    Case "Proof of assertion". reflexivity.
  rewrite -> H8.
  apply MyProp2.
  apply MyProp1.
Qed.

Theorem MyProp_0 : MyProp 0.
Proof.
  apply MyProp3. apply MyProp3. simpl.
  apply MyProp1.
Qed.

Theorem MyProp_plustwo : forall n:nat, MyProp n -> MyProp (S (S n)).
Proof.
  intros. apply MyProp3. simpl.
  apply MyProp2. apply H.
Qed.

Theorem MyProp_ev : forall n:nat,
    ev n -> MyProp n.
Proof.
  intros n E.
  induction E as [| n' E'].
  Case "E = ev_0".
    apply MyProp_0.
  Case "E = ev_SS n' E'".
    apply MyProp_plustwo. apply IHE'.
Qed.

Theorem ev_MyProp : forall n:nat,
    MyProp n -> ev n.
Proof.
  intros n M. induction M.
  Case "M = MyProp1". apply ev_SS. apply ev_SS. apply ev_0.
  Case "M = MyProp2". apply ev_SS. apply ev_SS. apply IHM.
  Case "M = MyProp3". apply ev_sum with (m:=2) in IHM.
    rewrite -> plus_comm in IHM. simpl in IHM.
    inversion IHM. inversion H0. apply H2.
    apply ev_SS. apply ev_0.
Qed.

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

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

Check ev_ind.

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

Check list_ind.

(*
MyProp_ind
  : forall P : nat -> Prop,
  P 4 ->
  (forall n : nat, MyProp n -> P n -> P (4 + n)) ->
  (forall n : nat, MyProp (2 + n) -> P (2 + n) -> P n) ->
  forall n : nat, MyProp n -> P n
*)

Check MyProp_ind.

Theorem ev_MyProp' : forall n:nat,
    MyProp n -> ev n.
Proof.
  apply MyProp_ind.
  Case "MyProp1". apply ev_SS. apply ev_SS. apply ev_0.
  Case "MyProp2". intros. apply ev_SS. apply ev_SS. apply H0.
  Case "MyProp3". intros. apply SSev_even in H0. apply H0.
Qed.

(*Definition MyProp_ev' : forall n:nat, ev n -> MyProp n :=*)

Module P.

Inductive p : (tree nat) -> nat -> Prop :=
  | c1 : forall n, p (leaf _ n) 1
  | c2 : forall t1 t2 n1 n2,
      p t1 n1 -> p t2 n2 -> p (node _ t1 t2) (n1 + n2)
  | c3 : forall t n, p t n -> p t (S n).

End P.

Inductive pal {X:Type} : list X -> Prop :=
| p_n : pal []
| p_c : forall v l, pal l -> pal (v :: (snoc l v))
| p_r : forall v l, v :: l = snoc (rev l) v -> pal (v :: l)
.
(*
１つ目と２つ目までは分かった３つ目がよくわからない
現状はコレだけど，l = rev l -> pal l と特に大差無いしダメだと思う
*)

Theorem rev_cons : forall (X:Type) (l:list X),
    pal (l ++ rev l).
Proof.
  intros. induction l as [| v l'].
  Case "l = []". simpl. apply p_n.
  Case "l = v :: l'".
    simpl. rewrite <- snoc_with_append.
    apply p_c. apply IHl'.
Qed.

Theorem pal_equal_rev : forall (X:Type) (l:list X),
    pal l -> l = rev l.
Proof.
  intros X l P. induction P.
  Case "p_n". simpl. reflexivity.
  Case "p_c". simpl. rewrite -> rev_snoc.
    simpl. rewrite <- IHP. reflexivity.
  Case "p_r".
    simpl. apply H.
Qed.

Theorem rev_pal : forall (X:Type) (l:list X),
    l = rev l -> pal l.
Proof.
  intros. induction l as [| v l'].
  Case "l = []". apply p_n.
  Case "l = v : l'". simpl in H.
    apply p_r. apply H.
Qed.

Inductive subseq : list nat -> list nat -> Prop :=
| s_1 : forall l, subseq l []
| s_2 : forall (n:nat) (l1 l2:list nat),
    subseq l1 l2 -> subseq (n :: l1) (n :: l2)
| s_3 : forall (n:nat) (l1 l2:list nat),
    subseq l1 l2 -> subseq (n :: l1) l2
. (*解けない->疲れた->保留する*)

Theorem subseq_relf : forall l,
    subseq l l.
Proof.
  intros. induction l as [| n l'].
  Case "l = []". apply s_1.
  Case "l = n :: l'". apply s_2. apply IHl'.
Qed.

(*元の練習問題ではfoo*)
Inductive foo'' (X : Set) (Y : Set) : Set :=
  | foo1 : X -> foo'' X Y
  | foo2 : Y -> foo'' X Y
  | foo3 : foo'' X Y -> foo'' X Y.
(*
foo_ind
     : forall (X Y : Set) (P : foo'' X Y -> Prop),
       (forall x : X, P (foo1 X Y x)) ->
       (forall y : Y, P (foo2 X Y y)) ->
       (forall f : foo'' X Y, P f -> P (foo3 X Y f)) ->
        forall f : foo'' X Y, P f
*)

Check foo''_ind.

(*
bar_ind
     : forall P : bar -> Prop,
       (forall n : nat, P (bar1 n)) ->
       (forall b : bar, P b -> P (bar2 b)) ->
       (forall (b : bool) (b0 : bar), P b0 -> P (bar3 b b0)) ->
       forall b : bar, P b
*)
(*元はbar*)
Inductive bar' : Set :=
| bar1 : nat -> bar'
| bar2 : bar' -> bar'
| bar3 : bool -> bar' -> bar'.

Check bar'_ind.

Inductive no_longer_than (X : Set) : (list X) -> nat -> Prop :=
| nlt_nil  : forall n, no_longer_than X [] n
| nlt_cons : forall x l n, no_longer_than X l n ->
                           no_longer_than X (x::l) (S n)
| nlt_succ : forall l n, no_longer_than X l n ->
                         no_longer_than X l (S n).

(*
no_longer_than_ind
     : forall (X : Set) (P : list X -> nat -> Prop),
       (forall n : nat, P [] n) ->
       (forall (x : X) (l : list X) (n : nat),
        no_longer_than X l n -> P l n ->
                                P (x::l) (S n)) ->
       (forall (l : list X) (n : nat),
        no_longer_than X l n -> P l n ->
                                P l (S n)) ->
       forall (l : list X) (n : nat), no_longer_than X l n ->
         P l n
*)

Check no_longer_than_ind.

Inductive R : nat -> list nat -> Prop :=
  | c1 : R 0 []
  | c2 : forall n l, R n l -> R (S n) (n :: l)
  | c3 : forall n l, R (S n) l -> R n l.
(*
R 2 [1,0]     well-formed
R 1 [1,2,1,0] ill-formed
R 6 [3,2,1,0] ill-formed
*)