Inductive Z : Type :=
| Pos : nat -> Z
| Zero : Z
| Neg : nat -> Z.

Definition neg (n: Z) : Z :=
match n with
| Pos k => Neg k
| Zero => Zero
| Neg k => Pos k
end.

Definition abs (n: Z) : Z :=
match n with
| Pos k => Pos k
| Zero => Zero
| Neg k => Pos k
end.

Definition succ (n: Z) : Z :=
match n with
| Pos k => Pos (S k)
| Zero => Pos O
| Neg O => Zero
| Neg (S n) => Neg n
end.

Definition pred (n: Z) : Z :=
match n with
| Pos (S n) => Pos n
| Pos O => Zero
| Zero => Neg O
| Neg n => Neg (S n)
end.

Theorem one_is_zero_succ : Pos O = succ Zero.
Proof.
  cbn. trivial.
Qed.

Theorem succ_S : forall n: nat, Pos (S n) = succ (Pos n).
Proof.
  destruct n; cbn; trivial.
Qed.

Theorem minus_one_is_zero_pred : Neg O = pred Zero.
Proof.
  cbn. trivial.
Qed.

Theorem pred_S : forall n: nat, Neg (S n) = pred (Neg n).
Proof.
  destruct n; cbn; trivial.
Qed.

Theorem Z_ind' (P : Z -> Prop) (base: P Zero) (suc: forall z: Z, P z -> P (succ z))
  (pre: forall z: Z, P z -> P (pred z)) : forall z: Z, P z.
Proof.
  intro z. destruct z.
  - induction n.
    + rewrite one_is_zero_succ. apply suc. assumption.
    + rewrite succ_S. apply suc. assumption.
  - assumption.
  - induction n.
    + rewrite minus_one_is_zero_pred. apply pre. assumption.
    + rewrite pred_S. apply pre. assumption.
Qed.

Theorem Z_ind'' (P : Z -> Prop) (base: P Zero) (base_pos: P (Pos O)) (base_neg: P (Neg O))
  (suc: forall n: nat, P (Pos n) -> P (Pos (S n)))
  (pre: forall n: nat, P (Neg n) -> P (Neg (S n))) : forall z: Z, P z.
Proof.
  intro z. destruct z.
  - induction n.
    + assumption.
    + apply suc. assumption.
  - assumption.
  - induction n.
    + assumption.
    + apply pre. assumption.
Qed.

Theorem neg_neg: forall n : Z, neg (neg n) = n.
Proof.
  intro n. destruct n; cbn; reflexivity.
Qed.

Theorem abs_impotent: forall n : Z, abs n = abs (abs n).
Proof.
  intro n. destruct n; cbn; reflexivity.
Qed.

Theorem succ_pred : forall n: Z, succ (pred n) = n.
Proof.
  intro n. induction n.
  - destruct n; cbn; trivial.
  - cbn. trivial.
  - destruct n; cbn; trivial.
Qed.

Theorem pred_succ : forall n: Z, pred (succ n) = n.
Proof.
  intro n. induction n.
  - destruct n; cbn; trivial.
  - cbn. trivial.
  - destruct n; cbn; trivial.
Qed.

(* add *)

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

Definition add (a b : Z) : Z :=
match a with
| Pos n => map_n (S n) succ b
| Zero => b
| Neg n => map_n (S n) pred b
end.

Theorem add_r_zero : forall x: Z, add x Zero = x.
Proof.
  induction x using Z_ind''; trivial.
  - cbn; rewrite succ_S; f_equal; apply IHx.
  - cbn; rewrite pred_S; f_equal; apply IHx.
Qed.

Theorem add_r_succ : forall x y: Z, add x (succ y) = succ (add x y).
Proof.
  intros x y. revert x. induction x using Z_ind''; trivial.
  - cbn. rewrite pred_succ. rewrite succ_pred. trivial.
  - cbn in *. f_equal. apply IHx.
  - cbn in *. rewrite succ_pred. rewrite succ_pred in IHx. rewrite IHx. trivial.
Qed.

Theorem add_r_pred : forall x y: Z, add x (pred y) = pred (add x y).
Proof.
  intros x y. revert x. induction x using Z_ind''; trivial.
  - cbn. rewrite pred_succ. rewrite succ_pred. trivial.
  - cbn in *. rewrite pred_succ in *. rewrite IHx. trivial.
  - cbn in *. f_equal. apply IHx.
Qed.

Theorem add_sym: forall x y: Z, add x y = add y x.
Proof.
  intro x. induction x using Z_ind''; intro y.
  - rewrite add_r_zero. cbn. trivial.
  - cbn. rewrite one_is_zero_succ. rewrite add_r_succ. rewrite add_r_zero. trivial.
  - cbn. rewrite minus_one_is_zero_pred. rewrite add_r_pred.
    rewrite add_r_zero. trivial.
  - cbn. rewrite succ_S. rewrite add_r_succ. f_equal. apply IHx.
  - cbn. rewrite pred_S. rewrite add_r_pred. f_equal. apply IHx.
Qed.

Theorem neg_succ : forall x: Z, neg (succ x) = pred (neg x).
Proof.
  destruct x.
  - cbn. trivial.
  - cbn. trivial.
  - destruct n; cbn; trivial.
Qed.

Theorem neg_pred : forall x: Z, neg (pred x) = succ (neg x).
Proof.
  destruct x.
  - destruct n; cbn; trivial.
  - cbn. trivial.
  - cbn. trivial.
Qed.

Theorem add_pred_succ : forall x y: Z, add (pred x) (succ y) = add x y.
Proof.
  intros x y. rewrite add_r_succ. rewrite (add_sym (pred x) y). rewrite add_r_pred.
  rewrite succ_pred. rewrite add_sym. trivial.
Qed.

Theorem neg_is_add_inv : forall x: Z, add x (neg x) = Zero.
Proof.
  induction x using Z_ind''; trivial.
  - rewrite succ_S. rewrite neg_succ. rewrite add_sym. rewrite add_pred_succ.
    rewrite add_sym. assumption.
  - rewrite pred_S. rewrite neg_pred. rewrite add_pred_succ. assumption.
Qed.

Theorem add_l_succ : forall x y: Z, add (succ x) y = succ (add x y).
Proof.
  intros x y. rewrite (add_sym (succ x) y). rewrite add_r_succ. f_equal.
  apply add_sym.
Qed.

Theorem add_succ_swap : forall x y: Z,  add x (succ y) = add (succ x) y.
Proof.
  intros x y. rewrite add_r_succ. rewrite add_l_succ. trivial.
Qed.

Theorem add_l_pred : forall x y: Z, add (pred x) y = pred (add x y).
Proof.
  intros x y. rewrite (add_sym (pred x) y). rewrite add_r_pred. f_equal.
  apply add_sym.
Qed.

Theorem add_pred_swap : forall x y: Z, add x (pred y) = add (pred x) y.
Proof.
  intros x y. rewrite add_r_pred. rewrite add_l_pred. trivial.
Qed.

Theorem add_assoc : forall x y z: Z, add (add x y) z = add x (add y z).
Proof.
  intros x y z. revert y. induction x using Z_ind''; intro y.
  - cbn. trivial.
  - cbn. apply add_l_succ.
  - cbn. apply add_l_pred.
  - rewrite succ_S. rewrite add_l_succ. rewrite add_l_succ. rewrite add_l_succ. f_equal.
    apply IHx.
  - rewrite pred_S. rewrite add_l_pred. rewrite add_l_pred. rewrite add_l_pred. f_equal.
    apply IHx.
Qed.

Theorem add_one : forall x: Z, add x (Pos O) = succ x.
Proof.
  intro x. rewrite one_is_zero_succ. rewrite add_r_succ. rewrite add_r_zero. trivial.
Qed.

Theorem add_minus_one : forall x: Z, add x (Neg O) = pred x.
Proof.
  intro x. rewrite minus_one_is_zero_pred. rewrite add_r_pred.
  rewrite add_r_zero. trivial.
Qed.

Theorem add_neg : forall x y: Z, add (neg x) (neg y) =  neg (add x y).
Proof.
  intro x. induction x using Z_ind''; intro y; trivial.
  - cbn. symmetry. apply neg_succ.
  - cbn. symmetry. apply neg_pred.
  - rewrite succ_S. rewrite add_l_succ. rewrite neg_succ. rewrite neg_succ. rewrite <- IHx.
    rewrite add_l_pred. f_equal.
  - rewrite pred_S. rewrite add_l_pred, neg_pred, neg_pred. rewrite <- IHx, add_l_succ.
    f_equal.
Qed.

Theorem add_r_neg : forall x y: Z, add x (neg y) =  neg (add (neg x) y).
Proof.
  intro x. induction x using Z_ind''; intro y; trivial.
  - cbn. rewrite neg_pred. trivial.
  - cbn. rewrite neg_succ. trivial.
  - rewrite succ_S. rewrite add_l_succ. rewrite IHx. rewrite neg_succ, add_l_pred, neg_pred.
    f_equal.
  - rewrite pred_S, add_l_pred, neg_pred, add_l_succ, neg_succ.
    f_equal. apply IHx.
Qed.

Theorem add_l_neg : forall x y: Z, add (neg x) y =  neg (add x (neg y)).
Proof.
  intros x y. rewrite add_sym. rewrite add_r_neg. rewrite add_sym. trivial.
Qed.

(* mul *)

Definition mul (a b: Z) : Z :=
match a with
| Pos n => map_n (S n) (add b) Zero
| Zero => Zero
| Neg n => neg (map_n (S n) (add b) Zero)
end.

Definition id {A: Type} (x: A) := x.

Theorem mul_r_zero : forall x: Z, mul x Zero = Zero.
Proof.
  intros x. destruct x.
  - cbn. induction n; cbn; auto.
  - cbn. auto.
  - cbn. induction n; cbn; auto.
Qed.

Theorem mul_r_one : forall x: Z, mul x (Pos O) = x.
Proof.
  induction x using Z_ind''; trivial.
  - cbn. rewrite succ_S. f_equal. assumption.
  - cbn. rewrite pred_S. rewrite neg_succ. f_equal. assumption.
Qed.

Theorem mul_r_minus_one : forall x: Z, mul x (Neg O) = neg x.
Proof.
  induction x using Z_ind''; trivial.
  - cbn. rewrite pred_S. f_equal. assumption.
  - cbn. rewrite succ_S. rewrite neg_pred. f_equal. assumption.
Qed.

Theorem mul_r_succ : forall x y: Z, mul x (succ y) = add (mul x y) x.
Proof.
  intros x y. revert x. induction x using Z_ind''; trivial.
  - cbn. rewrite add_r_zero. rewrite add_r_zero. rewrite add_one. trivial.
  - cbn. rewrite add_r_zero. rewrite add_r_zero. rewrite add_minus_one. apply neg_succ.
  - cbn in *. rewrite IHx. rewrite add_l_succ. rewrite succ_S.
    rewrite add_r_succ. f_equal. rewrite add_assoc. rewrite add_assoc.
    rewrite add_assoc. trivial.
  - cbn in *. rewrite pred_S. rewrite <- add_neg, IHx, <- add_neg,  <- add_neg.
    rewrite <- add_neg. rewrite add_r_pred, neg_succ, add_l_pred. f_equal.
    rewrite add_assoc, add_assoc, add_assoc. trivial.
Qed.

Theorem mul_r_pred : forall x y: Z, mul x (pred y) = add (mul x y) (neg x).
Proof.
  intros x y. revert x. induction x using Z_ind''; trivial.
  - cbn. rewrite add_r_zero. rewrite add_r_zero. rewrite add_minus_one. trivial.
  - cbn. rewrite add_r_zero, add_r_zero. rewrite add_one. apply neg_pred.
  - cbn in *. rewrite IHx. rewrite add_l_pred. rewrite pred_S.
    rewrite add_r_pred. f_equal. rewrite add_assoc. rewrite add_assoc.
    rewrite add_assoc. trivial.
  - cbn in *. rewrite succ_S. rewrite <- add_neg, IHx, <- add_neg,  <- add_neg.
    rewrite <- add_neg. rewrite add_r_succ, neg_pred, add_l_succ. f_equal.
    rewrite add_assoc, add_assoc, add_assoc. trivial.
Qed.

Theorem mul_sym : forall x y: Z, mul x y = mul y x.
Proof.
  intros x. induction x using Z_ind''; intro y.
  - rewrite mul_r_zero. cbn. trivial.
  - rewrite mul_r_one. cbn. rewrite add_r_zero. trivial.
  - rewrite mul_r_minus_one. cbn. rewrite add_r_zero. trivial.
  - rewrite succ_S. rewrite mul_r_succ. rewrite <- IHx. cbn. rewrite add_assoc.
    f_equal. apply add_sym.
  - rewrite pred_S. rewrite mul_r_pred. rewrite <- IHx. cbn.
    rewrite <- add_neg, <- add_neg. rewrite add_sym. trivial.
Qed.

Theorem mul_l_succ : forall x y: Z, mul (succ x) y = add (mul x y) y.
Proof.
  intros x y. rewrite mul_sym. rewrite mul_r_succ. rewrite (mul_sym x y). trivial.
Qed.

Theorem mul_l_pred : forall x y: Z, mul (pred x) y = add (mul x y) (neg y).
Proof.
  intros x y. rewrite mul_sym. rewrite mul_r_pred. rewrite (mul_sym x y). trivial.
Qed.

Theorem mul_r_neg : forall x y: Z, mul x (neg y) = neg (mul x y).
Proof.
  intros x. induction x using Z_ind'; intro y; trivial.
  - rewrite mul_l_succ, mul_l_succ.
    rewrite IHx. rewrite add_neg. trivial.
  - rewrite mul_l_pred, mul_l_pred, IHx.
    rewrite add_r_neg, neg_neg. trivial.
Qed.

Theorem mul_l_neg : forall x y: Z, mul (neg x) y = neg (mul x y).
Proof.
  intros x y. rewrite mul_sym, mul_r_neg, mul_sym. trivial.
Qed.

Theorem mul_neg : forall x y: Z, mul (neg x) (neg y) = mul x y.
Proof.
  intros x y. rewrite mul_r_neg, mul_l_neg, neg_neg. trivial.
Qed.

Theorem mul_neg_swap : forall x y: Z, mul (neg x) y = mul x (neg y).
Proof.
  intros x y. rewrite mul_r_neg, mul_l_neg. trivial.
Qed.

Theorem mul_dist_add : forall x y z: Z, mul x (add y z) = add (mul x y) (mul x z).
Proof.
  intros x y z. revert x. induction x using Z_ind'; trivial.
  - rewrite mul_l_succ, mul_l_succ, mul_l_succ. rewrite IHx.
    rewrite add_assoc, add_assoc. rewrite (add_sym (mul x z) (add y z)).
    rewrite (add_sym (mul x z) z). rewrite add_assoc. trivial.
  - rewrite mul_l_pred, mul_l_pred, mul_l_pred. rewrite IHx.
    rewrite add_assoc, add_assoc. rewrite (add_sym (neg y) (add (mul x z) (neg z))).
    rewrite (add_sym y z). rewrite add_assoc. rewrite add_neg. trivial.
Qed.

Theorem mul_assoc : forall x y z: Z, mul (mul x y) z = mul x (mul y z).
Proof.
  intros x y z. revert y. induction x using Z_ind'; intro y; trivial.
  - rewrite mul_l_succ. rewrite mul_l_succ.
    rewrite mul_sym, mul_dist_add. rewrite <- IHx. f_equal; apply mul_sym.
  - rewrite mul_l_pred, mul_l_pred. rewrite add_r_neg. rewrite mul_l_neg.
    rewrite add_r_neg. f_equal. rewrite mul_sym, mul_dist_add. f_equal.
    + rewrite <- IHx. rewrite mul_r_neg. f_equal. rewrite mul_sym. trivial.
    + apply mul_sym.
Qed.

(* uniqeu representation *)

Record Izomorphism (A B: Type) := Izo {
  izo_fun : A -> B;
  izo_inv : B -> A;
  izo_id  : forall x: A, izo_inv (izo_fun x) = x;
  izo_id' : forall x: B, izo_fun (izo_inv x) = x;
}.

Record Integer := Int {
  v : nat * nat;
  one_zero : let (x, y) := v in (x = O) \/ (y = O);
}.

Fixpoint norm (x y : nat) : (nat * nat) :=
match x, y with
| S x, S y => norm x y
| _, _ => (x, y)
end.

Definition norm' (p: nat * nat) : (nat * nat) :=
  let (x, y) := p in norm x y.

Theorem norm_is_normal (p: nat * nat) : let (x, y) := (norm' p) in (x = O) \/ (y = O).
Proof.
  destruct p. revert n0. induction n.
  - cbn. left. reflexivity.
  - destruct n0.
    + cbn. right. reflexivity.
    + cbn. apply IHn.
Qed.

Theorem norm_is_impotent : forall p: nat * nat, norm' p = norm' (norm' p).
Proof.
  intro p. destruct p. revert n0. induction n; intro n'.
  - cbn. reflexivity.
  - destruct n'; cbn.
    + reflexivity.
    + apply IHn.
Qed.

Definition get_integer (p: nat * nat) : Integer := {|
  v := norm' p;
  one_zero := norm_is_normal p;
|}.

Definition Z_to_Integer' (z : Z) : nat*nat :=
match z with
| Pos n => (S n, O)
| Zero => (O, O)
| Neg n => (O, S n)
end.

Theorem Z_to_Integer_proof : forall z: Z, let (x, y) := (Z_to_Integer' z) in (x = O) \/ (y = O).
Proof.
  intro z. destruct z; cbn; auto.
Defined.

Definition Z_to_Integer (z : Z) : Integer := {|
  v := Z_to_Integer' z;
  one_zero := Z_to_Integer_proof z;
|}.

Definition Integer_to_Z (i : Integer) : Z :=
match v i with
| (O, O) => Zero
| (S n, O) => Pos n
| (O, S n) => Neg n
| (S n, S n') => Zero
end.


Require Export Arith.EqNat.

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

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

Definition new_bob (a:bool)(b:bool):bool := if a then b else false.

Fixpoint beq_natlist (l : natlist) (m : natlist) : bool :=
match l,m with
|[] , [] => true
| _ , [] => false
|[] , _ => false
|h :: t , h'::t' =>  new_bob (beq_nat h h') (beq_natlist t t')
end.

Check new_bob.

Eval compute in (beq_natlist [1;2;3] [4;5;6]).
Eval compute in (beq_natlist [1;1;1] [1;1;1]).

SearchAbout beq_nat.

Theorem beq_nat_refl : forall n: nat, true = beq_nat n n.
Proof.
intros.
induction n.
simpl. reflexivity.
simpl. rewrite IHn.
simpl. reflexivity.
Qed.

Theorem beq_natlist_refl : forall l:natlist, true = beq_natlist l l.
Proof.
simpl.
induction l.
simpl. reflexivity.
simpl. rewrite <- IHl.
simpl. rewrite <- beq_nat_refl.
simpl. reflexivity.
Qed.


Section Sets.
  (* Extensional: Explicitly spell out all the members of a set.
     I.e. The set of states in the US is "Alabama, Alaska, ...." *)
  (* Seen this style of definition before... *)
  Definition Set' (A : Type) := list A.

  (* Intensional: Characteristic 'Function' approach: every input to a
     boolean valued function which returns true is a member of the
     set, and is not an element otherwise. *)

  Definition Bool_Set (A : Type) := A -> bool.

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

  Definition evens : Bool_Set nat := evenb.
  Definition In_b {A} (a : A) (e : Bool_Set A) : Prop :=
    e a = true.

  Example even_4 : In_b 4 evens. Proof. unfold In_b. simpl. reflexivity. Qed.

  Definition Same_Set' {A} (e1 e2 : Bool_Set A) : Prop :=
    forall x, e1 x = e2 x.

  (* How to define Intersection, Union, Subset ? *)
  Definition Union' {A} (e1 e2 : Bool_Set A) : Bool_Set A :=
    fun x => orb (e1 x) (e2 x).

  Definition Intersection' {A} (e1 e2 : Bool_Set A)
    : Bool_Set A :=
    fun x => andb (e1 x) (e2 x).

  Definition Subset' {A} (e1 e2 : Bool_Set A) : Prop :=
    forall x, In_b e1 x -> In_b e2 x.
  (* This encoding of sets means membership is always decideable! *)
End Sets.

Section Fixpoints.

  (* Propositional analogues to Characteristic Function from above.  A
     set is a property (propositional-valued function), and an object
     is an element if there is some proof that it satisfies that property. *)
  Definition PSet (A : Type) := A -> Prop.
  Definition In {A} (a : A) (e : PSet A) : Prop := e a.
  Notation "x '∈' e" := (In x e) (at level 60).

  Definition even x := exists n : nat, x = 2 * n.

  Example even_6 : 6 ∈ even. Proof. unfold In. exists 3. reflexivity. Qed.

  Definition Subset {A} (e1 e2 : PSet A) : Prop :=
    forall x, x ∈ e1 -> x ∈ e2.

  Notation "s1 ⊆ s2" := (Subset s1 s2) (at level 60).

  Lemma Subset_trans {A} : forall (s1 s2 s3 : PSet A),
      s1 ⊆ s2 -> s2 ⊆ s3 -> s1 ⊆ s3.
  Proof.
    unfold Subset; intros.
    apply H0.
    apply H.
    assumption.
  Qed.

  Lemma Subset_refl {A} : forall (s1 : PSet A), s1 ⊆ s1.
  Proof.
    unfold Subset; intros.
    assumption.
  Qed.

  Definition Same_set {A} (s1 s2 : PSet A) := s1 ⊆ s2 /\ s2 ⊆ s1.

  Lemma Same_set_refl {A} : forall (s1 : PSet A), Same_set s1 s1.
  Proof.
    unfold Same_set; split.
    - apply Subset_refl.
    - apply Subset_refl.
  Qed.

  Lemma Same_set_sym {A} : forall (s1 s2 : PSet A), Same_set s1 s2 -> Same_set s2 s1.
  Proof.
    unfold Same_set; intros s1 s2 [? ?]; split; assumption.
  Qed.

  Lemma Same_set_trans {A} : forall (s1 s2 s3 : PSet A),
      Same_set s1 s2 ->
      Same_set s2 s3 ->
      Same_set s1 s3.
  Proof.
    unfold Same_set; intros s1 s2 s3 [? ?] [? ?]; split.
    - eapply Subset_trans; eassumption.
    - eapply Subset_trans; eassumption.
  Qed.

  Context {U : Type}. (* The type of elements of our set. *)
  Variable F : PSet U -> PSet U. (* Our generating function-- takes a set of Us and builds a new set.*)

  (* A generator function is monotone if it preserves the subset
  relation on its argument. *)
  Definition Monotone (F : PSet U -> PSet U) : Prop :=
    forall (S S' : PSet U),
      S ⊆ S' -> F S ⊆ F S'.

  Variable Monotone_F : Monotone F.

  Definition FClosed (S : PSet U) : Prop := F S ⊆ S.

  Definition FConsistent (S : PSet U) : Prop := S ⊆ F S.

  Definition FixedPoint (S : PSet U) : Prop :=
    FClosed S /\ FConsistent S.

  Lemma FixedPoint_unfold FP : FixedPoint FP -> Same_set FP (F FP).
  Proof.
    unfold Same_set; intros [? ?]; split.
    - apply H0.
    - apply H.
  Qed.

  (* LFP is defined as the intersection of all F-closed sets. An
     element is in LFP iff it is a member of every F-Closed set. *)
  Definition LFP : PSet U :=
    fun a => forall S, FClosed S -> a ∈ S.

  Theorem LFP_is_FClosed
    : FClosed LFP.
  Proof.
    unfold FClosed.
    (* By the definition of LFP, it is a subset of every F-Closed set. *)
    assert (forall (X : PSet U), FClosed X -> LFP ⊆ X).
    { unfold Subset; intros. apply H0.  assumption. }
    (* Since F is monotone, the previous fact entails that [F LFP ⊆ F X]
       for every F-Closed set X.*)
    assert (forall (X : PSet U), FClosed X -> F LFP ⊆ F X).
    { intros. apply Monotone_F. apply H. assumption. }
    (* By transitivity of the subset relation, it follows that [F LFP ⊆ X]
       for every F-Closed set X.  *)
    assert (forall (X : PSet U), FClosed X -> F LFP ⊆ X).
    { intros. apply Subset_trans with (s2 := F X).
      - apply H0. assumption.
      - apply H1. }
    (* Now we just need to show that every element of [F LFP] is an
       element of [LFP], By definition, this is equivalent to showing
       that every element of [F LFP] is also a member of every
       F-Closed set. This follows from the fact that [F LFP] is a
       the previously proof that [F LFP] is a subset of every F-Closed set! *)
    unfold Subset; intros ? ? S FClosed_S.
    apply H1.
    assumption.
    assumption.
  Qed.

  Theorem LFP_is_FConsistent
    : FConsistent LFP.
  Proof.
    unfold FConsistent; intros.
    (*By the previous lemma, we know that F LFP ⊆ LFP. By monotonicity of
       F, F (F LFP) ⊆ F LFP. *)
    assert (F (F LFP) ⊆ F LFP).
    { apply Monotone_F. apply LFP_is_FClosed. }
    (* By definition, this means [F LFP] is F-Closed. *)
    assert (FClosed (F LFP)) by apply H.
    (* Since [F LFP] is F-Closed, it is a superset of LFP. *)
    intros x In_x.
    apply In_x.
    assumption.
  Qed.

  Theorem LFP_is_FixedPoint
    : FixedPoint LFP.
  Proof.
    unfold FixedPoint.
    split.
    - apply LFP_is_FClosed; eauto.
    - apply LFP_is_FConsistent; eauto.
  Qed.

  Theorem LFP_is_LeastFixedPoint :
    forall FP, FixedPoint FP -> LFP ⊆ FP.
  Proof.
    unfold FixedPoint; intros FP [? ?].
    intros x In_x.
    apply In_x.
    apply H.
  Qed.

  Corollary LFP_unfold : Same_set LFP (F LFP).
  Proof. apply FixedPoint_unfold. apply LFP_is_FixedPoint. Qed.

  Corollary LFP_fold : Same_set (F LFP) LFP.
  Proof. apply Same_set_sym. apply LFP_unfold. Qed.

  (* This admits the principle of Induction-- if we can show a set is
     F-Closed, it follows that every element of LFP is in that set. *)

  Lemma Ind
    : forall (Ind : PSet U),
      FClosed Ind -> forall a, LFP a -> Ind a.
  Proof.
    unfold LFP, FClosed; intros; eapply H0; eauto.
  Qed.

  (* GFP is defined as the union of all F-consistent sets.  An
     element is in GFP iff it is a member of /some/ F-Consistent set.*)
  Definition GFP : PSet U :=
    fun a => exists S, FConsistent S /\ a ∈ S.

  Lemma GFP_is_FConsistent
    : FConsistent GFP.
  Proof.
    unfold FConsistent.
    intros ? ?.
    (* By the definition of GFP, there must be some F-consistent set, X, that contains x *)
    destruct H as [X [? ?] ].
    (* Since X is F-consistent, by definition x is a member of F X. *)
    apply H in H0.
    (* We have now established that F X ⊆ F GFP: *)
    revert x H0; fold (Subset (F X) (F GFP)).
    (* Since F is monotone, it suffices to show that X ⊆ GFP *)
    eapply Monotone_F.
    (* To show X ⊆ GFP, we just need to show that every x in X is in GFP *)
    intros ? ?.
    (* By definition, x is an element of GFP if it is a member of an
    F-consistent set. By assumption, x is in X and F is F-consistent,
    so we're done!*)
    unfold In, GFP.
    eexists X.
    eauto.
  Qed.

  Lemma GFP_is_FClosed
    : FClosed GFP.
  Proof.
    intros ? ?.
    (* By our previous lemma, we know that GFP ⊆ F GFP. By monotonicity of
       F, F GFP ⊆ F (F GFP). *)
    assert (F GFP ⊆ F (F GFP)).
    { apply Monotone_F.
      apply GFP_is_FConsistent. }
    (* By definition, this means [F GFP] is F-consistent. *)
    assert (FConsistent (F GFP)).
    { intros ? ?.
      apply H0.
      assumption. }
    (* Since F is a member of an F-consistent set, it must be a member
    of GFP.*)
    unfold In, GFP.
    exists (F GFP).
    split; assumption.
  Qed.

  Theorem GFP_is_FixedPoint
    : FixedPoint GFP.
  Proof.
    unfold FixedPoint.
    split.
    - apply GFP_is_FClosed; eauto.
    - apply GFP_is_FConsistent; eauto.
  Qed.

  Theorem GFP_is_Greatest_FixedPoint
    : forall FP, FixedPoint FP -> FP ⊆ GFP.
  Proof.
    intros ? [? ?].
    intros x In_x.
    exists FP; split; assumption.
  Qed.

  (* This admits the principle of Co-Induction-- if we can show a set is
     F-Consistent, every element of that set is also in GFP. *)

  Lemma CoInd
    : forall (Ind : PSet U),
      FConsistent Ind -> forall a, Ind a -> GFP a.
  Proof.
    unfold GFP, FConsistent; intros; eauto.
  Qed.

End Fixpoints.

(*A quick example of the principle of Induction *)
Inductive isEven : nat -> Prop :=
| isEvenZero : isEven 0
| isEvenSS : forall (n : nat), isEven n -> isEven (S (S n)).

Definition isEven_F : PSet nat -> PSet nat :=
  fun X n => (n = 0) \/ (exists n', X n' /\ n = S (S n')).

Definition isEven' := LFP isEven_F.

Theorem isEven_eqv : forall n,
    isEven n <-> isEven' n.
Proof.
  split; intro.
  - induction H.
    + unfold isEven', LFP.
      intros.
      apply H.
      unfold isEven_F, In; intuition.
    + unfold isEven', LFP.
      intros.
      apply H0.
      unfold isEven_F, In; right.
      eexists; intuition.
      unfold isEven' in IHisEven.
      apply IHisEven in H0; eauto.
  - unfold LFP in H. eapply Ind; try eassumption.
    intros ? ?; unfold In in *.
    destruct H0 as [ | [n' [? ?] ] ]; subst.
    + econstructor.
    + econstructor.
      eassumption.
Qed.

Notation "x '∈' e" := (In x e) (at level 60).
Notation "s1 ⊆ s2" := (Subset s1 s2) (at level 60).

Lemma In_pair_inv {A B} :
  forall ab (s : PSet (Datatypes.prod A B)),
    ab ∈ s -> exists a b, ab = Datatypes.pair a b /\ s (Datatypes.pair a b).
Proof.
  destruct ab; eauto.
Qed.

Ltac In_inversion :=
  repeat match goal with
           H : @In (Datatypes.prod ?A ?B) ?ab _ |- _ =>
           apply In_pair_inv in H;
           destruct H as [? [? [? H] ] ]; subst ab
         | H : @In _ _ _ |- _ => unfold In in H
         | H : _ /\ _ |- _ => destruct H
         | H : _ \/ _ |- _ => destruct H
         | H : exists _, _ |- _ => destruct H
         | H : _ = _ |- _ => solve [discriminate]
         end.

Ltac In_intro :=
  repeat match goal with
         | |- In _ _ => unfold In
         | |- _ = _ => solve [intuition]
         end.


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

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

(* Exercise: 1 star (andb3) *)
Definition andb3 (b1 : bool) (b2 : bool) (b3 : bool) : bool :=
  match b1 with
    | true => match b2 with
                | true => b3
                | false => false
              end
    | false => false
  end.

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

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

Example test_factorial1: (factorial 3) = 6.
Proof. reflexivity. Qed.
Example test_factorial2: (factorial 5) = (mult 10 12).
Proof. reflexivity. Qed.

(* Exercise: 2 star (blt_nat) *)
Fixpoint ble_nat (n m : nat) : bool :=
  match n with
    | 0 =>  true
    | S n' =>  match m with
                | 0 => false
                | S m' => ble_nat n' m'
              end
  end.

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

Definition blt_nat (n m : nat) : bool := ble_nat (n + 1) m.

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

(* Exercise: 1 star (plus_id_exercise) *)
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.

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

(* Exercise: 1 star (zero_nbeq_plus_1) *)
Fixpoint beq_nat (n m : nat) : bool :=
  match n with
  | 0 => match m with
         | 0 => true
         | S m' => false
         end
  | S n' => match m with
            | 0 => false
            | S m' => beq_nat n' m'
            end
  end.

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

(* Exercise: 2 stars (boolean functions) *)
Theorem identity_fn_applied_twice :
  forall (f : bool -> bool),
  (forall (x : bool), f x = x) ->
  forall (b : bool), f (f b) = b.
Proof.
  intros f.
  intros H.
  intros b.
  rewrite -> H.
  rewrite -> H.
  reflexivity.
Qed.

(* Exercise: 2 stars (andb_eq_orb) *)
Lemma andb_t_f : andb true false = false.
Proof. reflexivity. Qed.

Lemma andb_f_t : andb false true = false.
Proof. reflexivity. Qed.

Theorem andb_eq_orb :
  forall (b c : bool),
  (andb b c = orb b c) -> b = c.
Proof.
  intros b c H. destruct b.
  (* CASE b = true *)
    destruct c.
    (* CASE c = true *)
      reflexivity.
    (* CASE c = false *)
      rewrite <- andb_t_f.
      rewrite H.
      reflexivity.
  (* CASE b = false *)
    destruct c.
    (* CASE c = true *)
      rewrite <- andb_f_t.
      rewrite H.
      reflexivity.
    (* CASE C = false *)
      reflexivity.
Qed.

(* Exercise: 3 stars (binary) *)
Inductive bin : Type :=
  | O : bin
  | twice : bin -> bin
  | one_more_twice : bin -> bin.

Fixpoint add1_bin (b : bin) : bin :=
  match b with
    | O => one_more_twice O
    | twice b' => one_more_twice b'
    | one_more_twice b' => twice (add1_bin b')
  end.

Fixpoint bin_to_nat (b : bin) : nat :=
  match b with
    | O => 0
    | twice b' => 2 * (bin_to_nat b')
    | one_more_twice b' => S (2 * (bin_to_nat b'))
  end.

Example test_add1_bin0 : bin_to_nat (add1_bin O) = S (bin_to_nat O).
Proof. reflexivity. Qed.
Example test_add1_bin1 : bin_to_nat (add1_bin (one_more_twice O)) = S (bin_to_nat (one_more_twice O)).
Proof. reflexivity. Qed.
Example test_add1_bin5 : bin_to_nat (add1_bin (one_more_twice (twice (one_more_twice O)))) =
  S (bin_to_nat (one_more_twice (twice (one_more_twice O)))).
Proof. reflexivity. Qed.

(* Exercise: 2 stars, optional (decreasing) *)
(*
Fixpoint terminating_but_unacceptable (x : nat) : nat :=
  match x with
    | 0 => 0
    | S x' => terminating_but_unacceptable ((x' * 2) - (x' * 3))
  end.
*)


Require Import List.
Import ListNotations.
Require Import PeanoNat.
Require Import Lia.
Require Import Bool.

(* ----- Definition of insertion sort ----- *)

(* Inserts integer i into the list l, as part of insertion sort.
isSorted l should hold. *)
Fixpoint insert (n : nat) (l : list nat) : list nat :=
  match l with
    nil => [n]
  | head :: tail => if n <=? head then n :: l else head :: insert n tail
  end.

(* Insertion sort of list l *)
Fixpoint sort (l : list nat) : list nat :=
  match l with
    nil => nil
  | head :: tail => insert head (sort tail)
  end.

(* Example test *)
Compute sort [10;8;3;5;6;7;1;2;4;9].

(* ----- Definition of sorted lists ----- *)

Fixpoint isSorted (l : list nat) : Prop :=
  match l with
    | nil => True
    | [x] => True
    | x :: ((y :: _) as tail) => x <= y /\ isSorted tail
  end.

(* ----- Definition of permutations ----- *)

Fixpoint count (x : nat) (l : list nat) : nat :=
  match l with
    nil => 0 |
    head :: tail => if x =? head then S (count x tail) else count x tail
  end.

Definition isPermutation (l1 l2 : list nat) :=
forall x : nat, count x l1 = count x l2.

(* ----- Proof of sortedness ----- *)

(* Insertion of an element keeps a sorted list still sorted *)
Lemma insert_keepsListSorted: forall x : nat, forall l : list nat,
isSorted l -> isSorted (insert x l).
Proof.
intros x l H. induction l; simpl.
  - trivial.
  - case_eq (x <=? a); intros; simpl.
    + apply Nat.leb_le in H0. split.
      * trivial.
      * assumption.
    + apply Nat.leb_gt in H0. destruct l; simpl.
      * lia.
      * firstorder. case_eq (x <=? n).
        ** intro. firstorder.
           *** lia.
           *** apply Nat.leb_le. assumption.
        ** firstorder. replace (n :: insert x l) with (insert x (n :: l)).
           *** assumption.
           *** simpl. case_eq (x <=? n); intro; simpl.
             **** absurd ((x <=? n) = true); auto. rewrite <- not_false_iff_true in H4. auto.
             **** trivial.
Qed.

Theorem sort_createsSortedness : forall l : list nat, isSorted (sort l).
Proof.
intros l. induction l.
  - compute. trivial.
  - simpl. apply insert_keepsListSorted. trivial.
Qed.

(* ----- Proof of permutation ----- *)

Lemma insert_sameXIncreasesCount:
forall x : nat, forall l : list nat, count x (insert x l) = S (count x l).
Proof.
intros x l.
induction l.
  - simpl. rewrite Nat.eqb_refl. trivial.
  - simpl. case_eq (x <=? a); intro; simpl.
    + replace (x =? x) with true. trivial. rewrite Nat.eqb_refl. trivial.
    + case_eq (x =? a); intro; simpl; rewrite IHl; trivial.
Qed.

Lemma insert_differentXDoesNotChangeCount:
forall x y : nat, forall l : list nat, (x =? y) = false -> count x (insert y l) = count x l.
Proof.
intros x y l H0. induction l; simpl.
  - rewrite H0. trivial.
  - case_eq (x =? a); intro; simpl.
    + case (y <=? a); simpl.
      * rewrite H0. rewrite H. trivial.
      * rewrite H. rewrite IHl. trivial.
    + case_eq (y <=? a); intro; simpl.
      * rewrite H0. rewrite H. trivial.
      * rewrite H. rewrite IHl. trivial.
Qed.

Theorem sort_createsPermutation: forall l : list nat, isPermutation l (sort l).
Proof.
intros l.
induction l; simpl; intro.
  - reflexivity.
  - simpl. case_eq (x =? a); intro; simpl.
    + replace a with x.
      * rewrite insert_sameXIncreasesCount. rewrite IHl. trivial.
      * apply Nat.eqb_eq. assumption.
    + rewrite insert_differentXDoesNotChangeCount.
      * rewrite IHl. trivial.
      * assumption.
Qed.

(* ----- Full definition of total correctness ----- *)

(* Beware that sort is defined structurally inductive on lists and it is primitive recursive.
In Coq's calculus of inductive constructions, sort is terminating.*)
Theorem sort_correctness: forall l : list nat,
isPermutation l (sort l) /\ isSorted (sort l).
Proof.
intros l. split.
  - apply sort_createsPermutation.
  - apply sort_createsSortedness.
Qed.


Module Playground1.

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

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

End Playground1.

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

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

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

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

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

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

Module Playground2.

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

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

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

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

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

End Playground2.

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Inductive even : nat -> Prop :=
| zero_is_even : even 0
| S_of_odd_is_even : (forall n : nat, odd n -> even (S n))
with odd : nat -> Prop :=
| S_of_even_is_odd : (forall n : nat, even n -> odd (S n)).


Require Export Basics.

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

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

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

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

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

Theorem plus_assoc : forall n m p : nat,
  n + (m + p) = (n + m) + p.
Proof.
  intros n m p.
  induction n as [| n'].
  - simpl. reflexivity.
  - simpl. rewrite <- IHn'. reflexivity.
Qed.

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

Lemma double_plus : forall n, double n = n + n.
Proof.
  intros n.
  unfold double.
  induction n as [| n'].
  - simpl. reflexivity.
  - rewrite -> IHn'. simpl. rewrite -> plus_n_Sm. reflexivity.
Qed.

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

Theorem nnb : forall b : bool, negb (negb b) = b.
Proof.
  intros b.
  induction b.
  - simpl. reflexivity.
  - simpl. reflexivity.
Qed.

Theorem evenb_S : forall n : nat, evenb (S n) = negb (evenb n).
Proof.
  intros n.
  unfold evenb.
  induction n as [| n'].
  - simpl. reflexivity.
  - rewrite -> IHn'. rewrite -> nnb. reflexivity.
Qed.

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

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

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

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

Theorem mult_comm : forall m n : nat,
  m * n = n * m.
Proof.
  intros m n.
  induction m as [| m'].
  - simpl. rewrite -> mult_0_r. reflexivity.
  - simpl. rewrite -> IHm'. rewrite mult_n_Sm. reflexivity.
Qed.

(* first think about whether
     (a) it can be proved using only simplification and rewriting,
     (b) it also requires case analysis (destruct), or
     (c) it also requires induction.
*)

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

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

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

Theorem plus_ble_compat_l : forall n m p : nat,
  leb n m = true -> leb (p + n) (p + m) = true.
Proof.
  intros n m p.
  intros H.
  induction p as [| p'].
  - simpl. rewrite H. reflexivity.
  - simpl. rewrite IHp'. reflexivity.
Qed.

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

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

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

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

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

Theorem beq_nat_refl : forall n : nat,
  true = beq_nat n n.
Proof.
  intros n.
  induction n.
  - simpl. reflexivity.
  - simpl. rewrite <- IHn. reflexivity.
Qed.

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

(* TODO: bin_to_nat_pres_incr *)

(* TODO: binary_inverse *)


Require Import ZArith.

Definition pow2_p p := Zpos (iter_pos positive xO xH p).

Definition mersenne p := (pow2_p p - 1)%Z.

Definition next_s mp s := (((s*s) - 2) mod mp)%Z.

Definition lucas_residue p :=
  let mp := mersenne p in
  let pm2 := (p-2)%positive in
  iter_pos Z (next_s mp) 4%Z pm2.

Definition lucas_test p :=
  Zeq_bool (lucas_residue p) 0.

Definition p89 := 89%positive.
Definition p521 := 521%positive.

Definition res := lucas_test p521.

Time Eval native_compute in res. (* p521 *)


(* Software Foundations Chapter 6 : Propositions and Evidence *)
Add LoadPath "./sf".
(* Add LoadPath "./bin". *)
Require Export MoreCoq.
Require Export Lists.
Require Import lesson3_Lists.

(**************************************************
  Exercise: 2 stars (b_timesm)
**************************************************)

Inductive beautiful : nat -> Prop :=
  b_0 : beautiful 0
| b_3 : beautiful 3
| b_5 : beautiful 5
| b_sum : forall n m, beautiful n -> beautiful m -> beautiful (n+m).

Theorem b_timesm: forall n m,
                    beautiful n ->  beautiful (m*n).
Proof.
  intros n m.
  induction m as [|mm].
  Case "m is zero".
  simpl.
  intros H.
  apply b_0.
  Case "m is some S mm".
  rewrite -> mult_comm.
  rewrite <- mult_n_Sm.
  intro H.
  apply b_sum.
  rewrite -> mult_comm.
  apply IHmm.
  apply H.
  apply H.
Qed.

(**************************************************
  Exercise: 1 star (gorgeous_tree)
  Write out the definition of gorgeous numbers using inference rule notation.
**************************************************)

(**
                    ------------ (g_0)
                     gorgeous n

      gorgeous n                 gorgeous n
  ------------------ (g_3)    ----------------- (g_5)
   gorgeous (3 + n)            gorgeous (5 + n)

**)

(**************************************************
  Exercise: 1 star (gorgeous_plus13)
 **************************************************)

Inductive gorgeous : nat -> Prop :=
  g_0 : gorgeous 0
| g_plus3 : forall n, gorgeous n -> gorgeous (3+n)
| g_plus5 : forall n, gorgeous n -> gorgeous (5+n).

Theorem gorgeous_plus13: forall n,
                           gorgeous n -> gorgeous (13+n).
Proof.
  intros n E.
  induction E as [|nn|nn].
  Case "n is zero".
  simpl.
  apply g_plus3.
  apply g_plus5.
  apply g_plus5.
  apply g_0.
  rewrite plus_comm with (n:=3) (m:=nn).
  rewrite plus_assoc.
  rewrite plus_comm.
  apply g_plus3.
  apply IHE.
  rewrite plus_comm with (n:=5) (m:=nn).
  rewrite plus_assoc.
  rewrite plus_comm.
  apply g_plus5.
  apply IHE.
Qed.

(**************************************************
  Exercise: 2 stars (gorgeous_sum)
 **************************************************)

Theorem gorgeous_sum : forall n m,
                         gorgeous n -> gorgeous m -> gorgeous (n + m).
Proof.
  intros n m E1 E2.
  induction E1 as [|nn|nn].
  Case "gorgeous n base case : n is zero".
  simpl.
  apply E2.
  Case "gorgeous n IStep1 -> n is 3 + nn".
  rewrite <- plus_assoc.
  apply g_plus3.
  apply IHE1.
  Case "gorgeous n IStep2 -> n is 5 + nn".
  rewrite <- plus_assoc.
  apply g_plus5.
  apply IHE1.
Qed.

(**************************************************
  Exercise: 3 stars, advanced (beautiful__gorgeous)
 **************************************************)
Theorem beautiful__gorgeous : forall n,
                                beautiful n -> gorgeous n.
Proof.
  intros n E.
  induction E as [ | | |nn].
  Case "n is zero".
  apply g_0.
  Case "n is three".
  rewrite <- plus_0_r.
  apply g_plus3.
  apply g_0.
  Case "n is five".
  rewrite <- plus_0_r.
  apply g_plus5.
  apply g_0.
  Case "beautiful (nn + m)".
  apply gorgeous_sum.
  apply IHE1.
  apply IHE2.
Qed.

(**************************************************
  Exercise: 3 stars, optional (g_times2)
  Prove the g_times2 theorem below without using gorgeous__beautiful. You might find the following helper lemma useful.
**************************************************)

Lemma helper_g_times2 : forall x y z,
                          x + (z + y)= z + x + y.
Proof.
  intros x y z.
  rewrite plus_assoc.
  rewrite plus_comm with (n:=x) (m:=z).
  reflexivity.
Qed.

Theorem g_times2: forall n,
                    gorgeous n -> gorgeous (2*n).
Proof.
   intros n H. simpl.
   induction H.
   Case "gorgeous 0".
   simpl.
   apply g_0.
   Case "gorgeous (3+n)".
   rewrite plus_0_r in IHgorgeous.
   rewrite plus_0_r.
   rewrite <- plus_assoc.
   apply g_plus3.
   rewrite helper_g_times2.
   rewrite <- plus_assoc.
   apply g_plus3.
   apply IHgorgeous.
   Case "gorgeous (5+n)".
   rewrite plus_0_r in IHgorgeous.
   rewrite plus_0_r.
   rewrite <- plus_assoc.
   apply g_plus5.
   rewrite helper_g_times2.
   rewrite <- plus_assoc.
   apply g_plus5.
   apply IHgorgeous.
Qed.

(**************************************************
  Exercise: 1 star (double_even)
 **************************************************)

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

Theorem double_even : forall n,
                        ev (double n).
Proof.
  intros n.
  induction n as [|nn].
  simpl.
  apply ev_0.
  simpl.
  apply ev_SS.
  apply IHnn.
Qed.

(**************************************************
  Exercise: 1 star (ev__even)
  Here is a proof that the inductive definition of evenness implies the computational one.
 **************************************************)

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

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.

(**
  Could this proof also be carried out by induction on n instead of E? If not, why not?
**)

(**
  No - if we use induction on n, we end up having to consider ev (S n). We cannot determine whether S n is even or odd from the form given and have no further evidence for it. Furthermore, we have no mechanism for pulling out the S from ev (S n), and so we cannot apply the inductive hypothesis in any way.
**)

(**************************************************
  Exercise: 1 star (l_fails)
  The following proof attempt will not succeed.
     Theorem l : ∀n,
       ev n.
     Proof.
       intros n. induction n.
         Case "O". simpl. apply ev_0.
         Case "S".
           ...
  Intuitively, we expect the proof to fail because not every number is even. However, what exactly causes the proof to fail?
 **************************************************)

(**
  This fails for the same reason as the previous problem.
**)

(**************************************************
Exercise: 2 stars (ev_sum)
Here's another exercise requiring induction.
**************************************************)
Theorem ev_sum : forall n m,
   ev n -> ev m -> ev (n+m).
Proof.
  intros n m E1 E2.
  induction E1 as [| nn E].
  Case "ev n is ev_0".
  destruct E2 as [|mm E'].
  SCase "ev m is ev_0".
  simpl.
  apply ev_0.
  SCase "ev m is some ev mm, called E'".
  simpl.
  apply ev_SS.
  apply E'.
  Case "ev_n is some ev nn, called E".
  destruct E2 as [|mm E'].
  rewrite plus_0_r.
  rewrite plus_0_r in IHE.
  apply ev_SS.
  apply IHE.
  rewrite plus_comm.
  rewrite <- plus_n_Sm.
  rewrite <- plus_n_Sm.
  apply ev_SS.
  rewrite plus_comm.
  apply IHE.
Qed.

(**************************************************
  Exercise: 1 star, optional (ev_minus2_n)
  What happens if we try to use destruct on n instead of inversion on E?
 **************************************************)
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.

(**
  inversion on E gives us some S (S n) to work with. If we destruct, we only get some S n. We can strip the first S with pred, but we will be left with an extra pred and have no way of reducing it to something over which we can apply evidence.
**)

(**************************************************
  Exercise: 1 star (inversion_practice)
 **************************************************)
Theorem SSSSev__even : forall n,
                         ev (S (S (S (S n)))) -> ev n.
Proof.
  intros n E.
  inversion E as [|nn E1].
  inversion E1 as [|nn' E2].
  apply E2.
Qed.

(**
  The inversion tactic can also be used to derive goals by showing the absurdity of a hypothesis.
**)

Theorem even5_nonsense : ev 5 -> 2 + 2 = 9.
Proof.
  intro E.
  inversion E as [|n0 E1].
  inversion E1 as [|n1 E2].
  inversion E2 as [|n2 E3].
Qed.

(**************************************************
  Exercise: 3 stars, advanced (ev_ev__ev)
  Finding the appropriate thing to do induction on is a bit tricky here:
 **************************************************)
Theorem ev_ev__ev : forall n m,
                      ev (n+m) -> ev n -> ev m.
Proof.
  intros n m Enm En.
  induction En.
  Case "ev n is ev 0".
  simpl in Enm.
  apply Enm.
  Case "ev n is ev (S (S n))".
  apply IHEn.
  rewrite plus_comm in Enm.
  rewrite <- plus_n_Sm in Enm.
  rewrite <- plus_n_Sm in Enm.
  apply ev_minus2 in Enm.
  simpl in Enm.
  rewrite <- plus_comm in Enm.
  apply Enm.
Qed.

(**************************************************
  Exercise: 3 stars, optional (ev_plus_plus)
  Here's an exercise that just requires applying existing lemmas. No induction or even case analysis is needed, but some of the rewriting may be tedious.
**************************************************)

Theorem ev_plus_plus : forall n m p,
                         ev (n+m) -> ev (n+p) -> ev (m+p).
Proof.
  intros n m p Enm Enp.
  generalize Enm.
  apply ev_ev__ev.
  rewrite plus_comm.
  rewrite <- plus_assoc.
  rewrite plus_comm.
  rewrite plus_assoc.
  rewrite <- plus_assoc with (n:=p+n) (m:=m) (p:=m).
  rewrite plus_comm with (n:=p) (m:=n).
  rewrite plus_comm with (n:=n+p) (m:=m+m).
  generalize Enp.
  apply ev_sum with (m:=n+p) (n:=m+m).
  rewrite <- double_plus.
  apply double_even.
Qed.

(**************************************************
  Exercise: 4 stars (palindromes)
  A palindrome is a sequence that reads the same backwards as forwards.

  Define an inductive proposition pal on list X that captures what it means to be a palindrome. (Hint: You'll need three cases. Your definition should be based on the structure of the list; just having a single constructor

  c : ∀l, l = rev l → pal l

  may seem obvious, but will not work very well.)

Prove that

  ∀l, pal (l ++ rev l).

Prove that

  ∀l, pal l → l = rev l.
**************************************************)

Inductive pal_1 {X : Type} : list X -> Prop :=
| even_seed : pal_1 []
| odd_seed : forall x, pal_1 [x]
| tack_one : forall x l, pal_1 l -> pal_1 (rev l) -> pal_1 (x::(snoc l x)).

Inductive pal_2 {X:Type} : list X -> Prop :=
| empty : pal_2 []
| one : forall x, pal_2 [x]
| more : forall x l, pal_2 (l ++ (rev l)) -> pal_2 (x::(snoc (l ++ (rev l)) x)).

Theorem app_nil_end : forall X (l : list X),
                        l ++ [] = l.
Proof.
  intros X l. induction l as [|h t].
  simpl. reflexivity.
  simpl. rewrite IHt. reflexivity.
Qed.

Theorem distr_rev : forall X (l1 l2 : list X),
                      rev (l1 ++ l2) = (rev l2) ++ (rev l1).
Proof.
  intros X l1 l2.
  induction l1 as [| h1 t1].
  simpl. rewrite app_nil_end. reflexivity.
  simpl. rewrite IHt1. rewrite snoc_with_append. reflexivity.
Qed.

Theorem pal_app_rev_1 : forall X (l:list X) ,
                        pal_1 (l++(rev l)).
Proof.
  intros X l. induction l as [|h t].
  simpl. apply even_seed.
  simpl. rewrite <- snoc_with_append.
  apply tack_one.
  apply IHt.
  rewrite distr_rev. rewrite rev_involutive. apply IHt.
Qed.

Theorem pal_app_rev_2 : forall X (l : list X),
                          pal_2 (l++(rev l)).
Proof.
  intros X l. induction l as [|h t].
  simpl. apply empty.
  simpl. rewrite <- snoc_with_append. generalize IHt.
  apply more with (x:=h).
Qed.

Theorem pal_to_rev_1 : forall X (l : list X),
                       pal_1 l -> l = rev l.
Proof.
  intros X l H.
  induction H as [|x|x ll].
  Case "l is empty".
  simpl. reflexivity.
  Case "l has a single element".
  simpl. reflexivity.
  Case "l is some arbitrary length palindrome".
  simpl. rewrite rev_snoc.
  simpl. rewrite <- IHpal_1_1.
  reflexivity.
Qed.

Theorem rev_pal : forall X (l : list X),
                    l ++ (rev l) = rev (l ++ (rev l)).
Proof.
  intros X l. induction l as [|h t].
  simpl. reflexivity.
  simpl. rewrite <- snoc_with_append. rewrite rev_snoc. rewrite <- IHt.
  simpl. reflexivity.
Qed.

Theorem pal_to_rev_2 : forall X (l : list X),
                         pal_2 l -> l = rev l.
Proof.
  intros X l H.
  inversion H as [|x|x ll].
  simpl. reflexivity.
  simpl. reflexivity.
  simpl. rewrite rev_snoc.
  rewrite <- rev_pal.
  simpl. reflexivity.
Qed.

(**************************************************
  Exercise: 5 stars, optional (palindrome_converse)
  Using your definition of pal from the previous exercise, prove that
     ∀l, l = rev l → pal l.
**************************************************)

Theorem cons_app : forall X (x : X) (l : list X),
                     x::l = [x] ++ l.
Proof.
  intros X x l. destruct l as [|h t].
  simpl. reflexivity.
  simpl. reflexivity.
Qed.

Theorem snoc_app : forall X (x : X) (l : list X),
                     snoc l x = l ++ [x].
Proof.
  intros X x l. induction l as [|h t].
  simpl. reflexivity.
  simpl. rewrite IHt. reflexivity.
Qed.

Theorem app_ass_3 : forall X (l1 l2 l3 : list X),
                    (l1 ++ l2) ++ l3 = l1 ++ l2 ++ l3.
Proof.
  intros X l1 l2 l3.
  induction l1 as [|h t].
  simpl. reflexivity.
  simpl. rewrite IHt. reflexivity.
Qed.

Definition tail {X : Type} (l : list X) :=
  match l with
    | [] => []
    | _::t => t
  end.

Definition head {X : Type} (l : list X) :=
  match l with
    | [] => None
    | h::_ => Some h
  end.

Theorem rev_first_last_head : forall X (l : list X),
                           l = rev l -> head l = head (rev l).
Proof.
  intros X l H. induction l as [|h t].
  simpl. reflexivity.
  simpl. simpl in H. rewrite <- H. simpl. reflexivity.
Qed.

Theorem rev_first_last_tail : forall X (l : list X),
                                l = rev l -> tail (rev (tail l)) = tail (rev (tail (rev l))).
Proof.
  intros X l H. rewrite <- H. reflexivity.
Qed.

Theorem rev_first_last_equal : forall X (x: X) (l : list X),
                                 x::l = rev(x::l) -> Some x = head (rev (x::l)).
Proof.
  intros X x l H. rewrite <- H. simpl. reflexivity.
Qed.

Theorem palindrome_converse_1 : forall X (l : list X),
                                l = rev l -> pal_1 l.
Proof.
  intros X l. induction l as [|h t].
  Case "l is empty".
  intros H. apply even_seed.
  Case "l is not empty".
  intros H. rewrite H. simpl.
  induction t as [|hh tt].
  simpl. apply odd_seed.

Theorem palindrome_converse : forall l,
                                l = rev l -> pal_1 l.
Proof.
  intros l H.

  rewrite tail_inv with (x:=h).
  rewrite rev_snoc.
  assert (tail_rev : forall X (h : X) t,  tail (h :: rev t) = rev (tail (h::t))).
   intros X h0 t0. simpl. reflexivity.
  rewrite tail_rev.
  rewrite <- rev_involutive.
  rewrite rev_snoc.

  inversion H.
  induction l as [|h t].
  Case "l is empty".
  apply even_seed.
  Case "l is not empty".
  simpl in H. rewrite H.

  apply pal_to_rev in IHt.

  apply tack_one in IHt.

Theorem snoc_rev : forall X (h : X) t,
                    snoc t h = rev (h::rev t).
Proof.
  intros X h t.
  simpl.
  rewrite rev_involutive.
  reflexivity.
Qed.

Theorem pal_add_one : forall l x,
                       pal l -> pal (x :: (snoc l x)).
Proof.
  intros l x H.
  inversion H as [E| xx ll odd| ll even].
  Case "l is the empty palindrome".
  simpl.
  assert (Lem1 : forall X (h : X) t,
                   h::t = [h] ++ t).
   intros X h t.
   simpl.
   reflexivity.
  rewrite Lem1.
  apply even_list.
  Case "l is the odd palindrome".
  rewrite snoc_with_append.
  simpl.
  rewrite snoc_rev.
  rewrite rev_involutive.
  apply odd_list with (x:=xx) (l:=x::ll).
  Case "l is the even palindrome".
  rewrite snoc_with_append.
  rewrite snoc_rev.
  rewrite rev_involutive.
  apply even_list with (l:=x::ll).
Qed.

Theorem pal_remove_one : forall (X : Type) (l : list X),
                           l = rev l -> l = match l with
                                              | [] => []
                                              | h::t => match (rev t) with
                                                          | [] => [h]
                                                          | _::m => h::(snoc (rev m) h)
                                                        end
                                            end.
Proof.
  intros X l H.
  destruct l as [|h t].
  Case "l is empty".
  reflexivity.
  Case "l is some h::t".
  destruct (rev t) as [|h' t'] eqn:revt.
  SCase "t is empty".
  simpl in H.
  rewrite revt in H.
  simpl in H.
  apply H.
  SCase "t is some h'::t'".
  inversion H.
  rewrite revt in H1.
  simpl in H1.
Admitted.

Theorem palindrome_converse : forall l,
                                l = rev l -> pal l.
Proof.
  intros l H.
  destruct l as [|h t].
  Case "l is the empty list".
  apply empty.
  Case "l is some h::t".
Admitted.

(**************************************************
Exercise: 4 stars, advanced (subsequence)
A list is a subsequence of another list if all of the elements in the first list occur in the same order in the second list, possibly with some extra elements in between. For example,
    [1,2,3]
is a subsequence of each of the lists
    [1,2,3]
    [1,1,1,2,2,3]
    [1,2,7,3]
    [5,6,1,9,9,2,7,3,8]
but it is not a subsequence of any of the lists
    [1,2]
    [1,3]
    [5,6,2,1,7,3,8]
Define an inductive proposition subseq on list nat that captures what it means to be a subsequence. (Hint: You'll need three cases.)
Prove that subsequence is reflexive, that is, any list is a subsequence of itself.
Prove that for any lists l1, l2, and l3, if l1 is a subsequence of l2, then l1 is also a subsequence of l2 ++ l3.
(Optional, harder) Prove that subsequence is transitive — that is, if l1 is a subsequence of l2 and l2 is a subsequence of l3, then l1 is a subsequence of l3. Hint: choose your induction carefully!
**************************************************)

(**************************************************
Exercise: 2 stars, optional (R_provability)
Suppose we give Coq the following definition:
**************************************************)

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.

(**
  Which of the following propositions are provable?
  R 2 [1,0]
   c2 : R 2 [1,0] -> R (S 2) 2::[1,0]
        c2 : R 3 [2,1,0]
   c3 : R (S 1) [1,0] -> R 1 [1,0]
  R 1 [1,2,1,0]
  R 6 [3,2,1,0]
**)


Require Export NArith.
Open Scope N_scope.

Definition pos_log2 (p:positive) : N :=
N.log2 (Npos p).

(** Write a function that given any positive number p, returns a pair
   of type (n, q) : N * positive such that p = 2^n * q

*)

Fixpoint decompose2 (p:positive) : N * positive :=
match p with xH => (0,xH)
           | xI q => (0, p)
           | xO q => let d := decompose2 q in (fst d + 1, snd d)
end.

Compute decompose2 (88%positive).
Compute decompose2 (1024%positive).

(** binary exponentiation *)

Definition sqr_pos (p:positive) := (p * p)%positive.

Fixpoint binary_pow_aux (x:N)(a:N)(p:positive) : N :=
 match p with xH => a * x
            | xO q  => binary_pow_aux (x * x) a q
            | xI q  => binary_pow_aux (x * x)  (a * x ) q

end.

Definition pow  (x:N) (n : N) :=
  match n with 0 => 1
             | Npos 1 => x
             | Npos p => binary_pow_aux x x (Pos.pred p)
 end.

Compute pow 2 5.
Compute pow 2 10.

(** Comparison with N.pow *)

Time Compute 1 ^ 55556666.

Time Compute pow 1 55556666.

Definition pow_test (x n:N) :=
  N.eqb (pow x n) (N.pow x n).

Compute pow_test 2  555.

Fixpoint exp2_pos  (p:positive) : positive :=
(match p with 1 => 2
           | p~0 => sqr_pos (exp2_pos p)
           | p~1 => (sqr_pos (exp2_pos p))~0
 end)%positive.

Definition exp2 (n:N) : positive :=
match n with N0 => xH
           | Npos p =>  (exp2_pos p)
end.

Compute exp2 10.

Compute exp2 7.

Compute pos_log2 63%positive.
Compute pos_log2 1023%positive.

Definition test_exp2 (p:positive) := N.eqb (Npos p)  (pos_log2 (exp2 (Npos p))).
Compute test_exp2 45%positive.


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

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

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

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

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

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

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

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

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

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

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

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

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

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

Definition bag := natlist.

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

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

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

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

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

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

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

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

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

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

Example test_hd_error1 : hd_error nil = None.
reflexivity. Qed.

Example test_hd_error2 : hd_error [1] = Some 1.
reflexivity. Qed.

Example test_hd_error3 : hd_error [5;6] = Some 5.
reflexivity. Qed.

Theorem option_elim_hd : forall (l: natlist) (default: nat),
  hd default l = option_elim default (hd_error l).
Proof.
intros l default.
destruct l.
reflexivity.
reflexivity.
Qed.

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

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

Theorem beq_id_refl : forall x, true = beq_id x x.
Proof.
intros x.
destruct x.
simpl.
induction n.
reflexivity.
simpl.
rewrite <- IHn.
reflexivity.
Qed.

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

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

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

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

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

Module OptionPlayground.

Inductive option (X:Type) : Type :=
  | Some : X -> option X
  | None : option X.
Arguments Some {X} _.
Arguments None {X}.

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

Definition hd_error {X : Type} (l : list X) : option X :=
  match l with
    | nil _ => None
    | cons _ h t => Some h
  end.

Check @hd_error.
Check @nil.

Arguments nil {X}.
Arguments cons {X} _ _.

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

Example test_hd_error1 : hd_error [1; 2] = Some 1.
simpl.
reflexivity.
Qed.

Example test_hd_error2 : hd_error [[1];[2]] = Some [1].
simpl.
reflexivity.
Qed.

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

Example inversion_ex3 : forall (X : Type) (x y z w : X) (l j : list X),
  x :: y :: l = w :: z :: j ->
  x :: l = z :: j ->
  x = y.
Proof.
intros X x y z w l j.
intros H.
intros G.
inversion G.
inversion H.
reflexivity.
Qed.

Example inversion_ex6 : forall (X : Type) (x y z : X) (l j : list X),
  x :: y :: l = nil ->
  y :: l = z :: j ->
  x = z.
Proof.
intros X x y z l j.
intros H.
inversion H.
Qed.

Lemma proj2 : forall P Q : Prop,
  P /\ Q -> Q.
Proof.
intros P Q.
intros H.
apply H.
Qed.

Theorem contradiction_implies_anything : forall P Q : Prop,
  (P /\ ~P) -> Q.
Proof.
  intros P Q [HP HNA]. unfold not in HNA.
  apply HNA in HP. destruct HP. Qed.

Theorem not_both_true_and_false : forall P : Prop,
  ~(P /\ ~P).
Proof.
intros P contra.
apply contradiction_implies_anything with (P := P).
apply contra.
Qed.

Theorem dist_not_exists : forall (X: Type) (P: X -> Prop),
  (forall x, P x) -> ~ (exists x, ~ P x).
Proof.
intros X P x H.
unfold not.
destruct H as [y E].
apply E.
apply x.
Qed.

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

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

Theorem ev_double : forall n,
  ev (double n).
Proof.
intros.
induction n.
apply ev_0.
apply ev_SS.
apply IHn.
Qed.

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

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


Check True.
Check False.

Check 3.

Check (3+4).

Check (3=4).

Check (forall x:nat, x < 3 \/ (exists y:nat, x = y + 3)).

Locate "_ <= _".

Check fun a b c d e => (a + b + c + d + e).

Compute let f := fun a b c d e => a + b + c + d + e in f 1 2 3 4 5.

Definition example1 := fun x : nat => x * x+2 * x+1.

Check example1.

Compute example1 1.

Require Import Bool.

Compute if true then 3 else 5.

SearchPattern bool.

Require Import Arith.

Fixpoint sum_n n :=
  match n with
    0 => 0
  | S p => p + sum_n p
  end.

Fixpoint evenb n :=
  match n with
    0 => true
  | 1 => false
  | S (S p) => evenb p
  end.

Require Import List.

(* Exercise on lists *)
Fixpoint numlist n :=
  match n with
    0 => nil
  | S p => p :: numlist p
  end.

Compute numlist 1.
Compute numlist 3.

Definition sorted_aux := fun list =>
  match list with
    nil => true
  | x1::nil => true
  | x1::x2::xs => x1 <=? x2
  end.

Check sorted_aux.

Fixpoint sorted list :=
  match list with
    x::xs => sorted_aux list && sorted xs
  | _ => sorted_aux list
  end.

Check sorted.

Compute sorted (1::3::nil).
Compute sorted (3::1::nil).
Compute sorted (1::3::2::nil).

Fixpoint countn n list :=
  match list with
    nil => 0
  | x::xs => let
      next := countn n xs
    in if Nat.eqb n x then next + 1 else next
  end.

Check countn.

Compute countn 3 (nil).
Compute countn 3 (3::nil).
Compute countn 3 (3::1::3::nil).

Search True.
SearchPattern (_ <= _).
Search (_ <= _) (_ + _).
SearchPattern (_ + _ <= _ + _).
SearchRewrite (_ + (_ - _)).

Lemma example2 : forall a b:Prop, a /\ b -> b /\ a.
Proof.
  intros a b H.
  split.
  destruct H as [H1 H2].
  exact H2.
  intuition.
Qed.

Lemma example3 : forall A B, A \/ B -> B \/ A.
Proof.
  intros A B H.
  destruct H as [H1 | H2].
  right; assumption.
  left; assumption.
Qed.

Check le_n.
Check le_S.

Lemma example4 : 3 <= 5.
Proof.
  apply le_S.
  apply le_S.
  apply le_n.
Qed.

Check le_trans.

Lemma example5 : forall x y, x <= 10 -> 10 <= y -> x <= y.
Proof.
  intros x y x10 y10.
  apply le_trans with (m := 10).
  assumption.
  assumption.
Qed.

Lemma example6 : forall x y, (x + y) * (x + y) = x*x + 2*x*y + y*y.
Proof.
  intros x y.
  SearchRewrite (_ * (_ + _)).
  rewrite Nat.mul_add_distr_l.
  SearchRewrite ((_ + _) * _).
  rewrite Nat.mul_add_distr_r.
  rewrite Nat.mul_add_distr_r.
  SearchRewrite (_ + (_ + _)).
  rewrite Nat.add_assoc.
  rewrite <- Nat.add_assoc with (n := x * x).
  SearchPattern (?x * ?y = ?y * ?x).
  rewrite Nat.mul_comm with (n := y) (m := x).
  SearchRewrite (S _ * _).
  rewrite <- (Nat.mul_1_l (x * y)) at 1.
  rewrite <- Nat.mul_succ_l.
  SearchRewrite (_ * (_ * _)).
  rewrite Nat.mul_assoc.
  reflexivity.
  Qed.

Lemma exercise1 : forall A B C : Prop, A/\(B/\C)->(A/\B)/\C.
Proof.
  intros A B C H.
  destruct H as [H1 H2].
  destruct H2 as [H21 H22].
  split.
  split.
  exact H1.
  exact H21.
  exact H22.
Qed.

Lemma exercise2 : forall A B C D : Prop, (A->B)/\(C->D)/\A/\C -> B/\D.
Proof.
  intros A B C D H.
  destruct H as [H1 H2].
  destruct H2 as [H21 H22].
  destruct H22 as [H221 H222].
  split.
  apply H1.
  exact H221.
  apply H21.
  exact H222.
Qed.

Lemma exercise3 : forall A : Prop, ~(A /\ ~A).
Proof.
  intros A H.
  destruct H as [H1 H2].
  elim H2.
  exact H1.
Qed.

Lemma exercise4 : forall A B C : Prop, A\/(B\/C)->(A\/B)\/C.
Proof.
  intros A B C H.
  destruct H as [H1 | H2].
  left.
  left.
  exact H1.
  destruct H2 as [H21 | H22].
  left.
  right.
  exact H21.
  right.
  exact H22.
Qed.

(*
Lemma exercise5 : forall A B : Prop, (A\/B)/\ ~A->B.
Proof.
  intros A B H.
  destruct H as [H1 H2].
  apply H2.
*)

Lemma universal_quant : forall A : Type, forall P Q : A->Prop,
    (forall x, P x) \/ (forall y, Q y) -> forall x, P x \/ Q x.
Proof.
  intros P Q A x y.
  destruct x as [x1 | x2].
  left.
  apply x1.
  right.
  apply x2.
Qed.

Lemma sum_n_p : forall n, 2 * sum_n n + n = n * n.
Proof.
  induction n.
  reflexivity.
  assert (SnSn : S n * S n = n * n + 2 * n + 1).
  ring.
  rewrite SnSn.
  rewrite <- IHn.
  simpl.
  ring.
Qed.

Lemma evenb_p : forall n, evenb n = true -> exists x, n = 2 * x.
Proof.
  assert (Main : forall n, (evenb n = true -> exists x, n = 2 * x) /\
           (evenb (S n) = true -> exists x, S n = 2 * x)).
  induction n.
  split.
    exists 0; ring.
  simpl; intros H; discriminate H.
  split.
    destruct IHn as [_ IHn']; exact IHn'.
  simpl evenb; intros H; destruct IHn as [IHn' _].
  assert (H' : exists x, n = 2 * x).
    apply IHn'; exact H.
  destruct H' as [x q]; exists (x + 1); rewrite q; ring.
  intros n ev.
  destruct (Main n) as [H _]; apply H; exact ev.
Qed.

Fixpoint add n m :=
  match n with
    0 => m
  | S p => add p (S m)
  end.

Lemma exercise6 : forall n m, add n (S m) = S (add n m).
Proof.
  induction n; intros m; simpl.
    reflexivity.
  rewrite IHn; reflexivity.
Qed.

Lemma exercise7 : forall n m, add (S n) m = S (add n m).
Proof.
  intros n; induction m; simpl.
  apply exercise6;
  reflexivity.
  rewrite <- exercise6.
  reflexivity.
Qed.

Lemma exercise8 : forall n m, add n m = n + m.
Proof.
  induction n; intros m; simpl.
  reflexivity.
  rewrite <- IHn.
  apply exercise6.
Qed.


Add LoadPath "C:/Coq/buffer".
Require Export Logic.

Inductive ev : nat -> Prop :=
  | ev_0 : ev 0
  | ev_SS : forall n : nat, ev n -> 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 H. apply (ev_SS (2 + n) (ev_SS n H)).
Qed.

Theorem ev_double : forall n, ev (double n).
Proof. intros n. induction n as [| n' In'].
  - apply ev_0.
  - simpl. apply ((ev_SS (double n')) In').
Qed.

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

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

Theorem SSSSev_even : forall n,
  ev (S (S (S (S n)))) -> ev n.
Proof.
 intros n E. inversion E as [| n' E'].
  apply ev_minus2 in E'. simpl in E'. apply E'.
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).
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)).

Lemma le_trans : forall m n o, m <= n -> n <= o -> m <= o.
Proof. intros n m o H H'. induction H' as [| m' o' IH].
  - apply H.
  - apply le_S. apply IH.
Qed.

Theorem O_le_n : forall n,
  0 <= n.
Proof.
  intros n. induction n as [| n' Hn'].
  - apply le_n.
  - apply le_S. apply Hn'.
Qed.

Theorem n_le_m__Sn_le_Sm : forall n m,
  n <= m -> S n <= S m.
Proof.
  intros n m H. induction H as [| n' m' H'].
  - apply le_n.
  - apply le_S in H'. 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 (n:=S n).
    + apply le_S. apply le_n.
    + apply H1.
Qed.

Theorem le_plus_l : forall a b,
  a <= a + b.
Proof.
  intros a b. induction a as [| a' Ha'].
  -apply O_le_n.
  -simpl. apply n_le_m__Sn_le_Sm. apply Ha'.
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 (m:=S n1) (n:= S (n1 + n2)) (o:=m).
  - apply n_le_m__Sn_le_Sm. apply le_plus_l.
  - apply H.
 + apply le_trans with (m:=S n2) (n:= S (n1 + n2)) (o:=m).
  - apply n_le_m__Sn_le_Sm. rewrite -> plus_comm. apply le_plus_l.
  - apply H.
Qed.

Lemma le_Sn__n : forall n m, le (S n) m -> le n m.
Proof. intros. apply le_trans with (m:=n) (n:=S n) (o:=m).
  - apply le_S. apply le_n.
  - apply H.
Qed.

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

Lemma leb_Sn_r : forall (n m : nat),
   leb n m = true -> leb n (S m) = true.
Proof. intros n. induction n as [| n' Hn'].
  - intros m H. reflexivity.
  - intros m H. simpl. destruct m as [| m'].
    + inversion H.
    + simpl in H. apply Hn' in H. apply H.
Qed.

Lemma leb_Sn_l : forall (n m : nat),
   leb (S n) m = true -> leb n m = true.
Proof. intros n. induction n as [| n' Hn'].
  - intros m H. reflexivity.
  - intros m H. simpl. destruct m as [| m'].
    + inversion H.
    + simpl in H. apply Hn' in H. apply H.
Qed.

Lemma leb_extended_refl : forall n m, leb n (n + m) = true.
Proof. intros n m. induction n as [| n' Hn'].
  - reflexivity.
  - simpl. apply Hn'.
Qed.

Lemma leb_plus : forall n m,
  leb n m = true <-> (exists k, n + k = m).
Proof. intros n. induction n as [| n' Hn'].
  - intros m. split.
    + intros H. exists m. reflexivity.
    + intros H. reflexivity.
  - intros [| m']; split.
    + intros H. inversion H.
    + intros H. inversion H as [x H0]. inversion H0.
    + simpl. intros H. apply Hn' in H. destruct H. exists x. rewrite H. reflexivity.
    + simpl. intros H. inversion H as [x H0]. inversion H0. apply leb_extended_refl.
Qed.

Theorem leb_complete : forall n m,
  leb n m = true -> n <= m.
Proof.
  intros n m H. apply leb_plus in H. destruct H. rewrite <- H. apply le_plus_l.
Qed.

Theorem leb_correct : forall n m,
  n <= m -> leb n m = true.
Proof. intros n. induction n as [| n' Hn'].
  - intros [| m']. reflexivity. reflexivity.
  - intros [| m'] H.
    + inversion H.
    + simpl. apply Sn_le_Sm__n_le_m in H. apply Hn' in H.
      apply H.
Qed.

(* there must be an easier way to do this, still
   I like how this proof feels like a written proof *)
Theorem leb_true_trans : forall n m o,
  leb n m = true -> leb m o = true -> leb n o = true.
Proof. intros n m o H H'. apply leb_plus in H.
       apply leb_plus in H'. destruct H. destruct H'.
       rewrite <- H0. rewrite <- H. rewrite <- plus_assoc.
       apply leb_extended_refl.
Qed.

Theorem leb_iff : forall n m,
  leb n m = true <-> n <= m.
Proof. split. apply leb_complete. apply leb_correct.
Qed.

Module R.

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.

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

Definition fR : nat -> nat -> nat := plus.
Search plus.

Theorem R_equiv_fR : forall n m o, R n m o <-> fR m n = o.
Proof. intros n m o. split.
  - intros H. induction H; unfold fR.
    + reflexivity.
    + unfold fR in IHR. rewrite <- plus_n_Sm.
      rewrite IHR. reflexivity.
    + unfold fR in IHR. simpl. rewrite IHR. reflexivity.
    + unfold fR in IHR. simpl in IHR. rewrite <- plus_n_Sm in IHR.
      inversion IHR. reflexivity.
    + rewrite -> plus_comm. apply IHR.
  - intros H. induction H.
    + unfold fR. generalize dependent n. induction m as [| m' IHm'].
    ++ induction n as [| n' IHn']. apply c1. apply c2. apply IHn'.
    ++ intros n. simpl. apply c3. apply IHm'.
Qed.

End R.

Inductive reg_exp (T : Type) : Type :=
| EmptySet : reg_exp T
| EmptyStr : reg_exp T
| Char : T -> reg_exp T
| App : reg_exp T -> reg_exp T -> reg_exp T
| Union : reg_exp T -> reg_exp T -> reg_exp T
| Star : reg_exp T -> reg_exp T.

Arguments EmptySet {T}.
Arguments EmptyStr {T}.
Arguments Char {T} _.
Arguments App {T} _ _.
Arguments Union {T} _ _.
Arguments Star {T} _.

Inductive exp_match {T} : list T -> reg_exp T -> 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 re1 s2 re2,
              exp_match s2 re2 ->
              exp_match s2 (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 =~ r" := (exp_match s r) (at level 80).

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

Example reg_exp_ex2 : [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 H. inversion H.
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.

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

Lemma empty_is_empty : forall T (s : list T),
  ~ (s =~ EmptySet).
Proof.
  unfold not. intros T s H. inversion H.
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 H. destruct H.
  - apply (MUnionL _ _). apply H.
  - apply (MUnionR _ _). apply H.
Qed.

Lemma fold_app_distr : forall T (x x0 : list (list T)),
    fold app (x ++ x0) [] = fold app x [] ++ fold app x0 [].
Proof. induction x.
           -reflexivity.
           -simpl. intros. rewrite IHx. apply app_assoc.
Qed.

Lemma In_or : forall T (s : list T) (x x0 : list (list T)),
    In s (x ++ x0) -> In s x \/ In s x0.
Proof. intros. induction x. simpl in H. right. apply H. simpl in H.
       destruct H. left. rewrite H. left. reflexivity. destruct IHx.
       apply H. left. right. apply H0. right. apply H0.
Qed.

Lemma MStar' : forall T (ss : list (list T)) (re : reg_exp T),
  (forall s, In s ss -> s =~ re) ->
  fold app ss [] =~ Star re.
Proof.
  intros T ss re H. apply All_In in H. induction ss as [| h t Ht ].
  - simpl. apply MStar0.
  - simpl. simpl in H. destruct H. apply Ht in H0. apply (MStarApp h (fold app t []) re).
    + apply H.
    + apply H0.
Qed.

Lemma MStar'' : forall T (s : list T) (re : reg_exp T),
  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'. induction H.
       -inversion Heqre'.
       -inversion Heqre'.
       -inversion Heqre'.
       -inversion Heqre'.
       -inversion Heqre'.
       -exists []. intros. split. reflexivity. intros. inversion H.
       -apply IHexp_match2 in Heqre' as HH. destruct HH. destruct H1.
        exists (s1::x). split.
        +simpl. rewrite <- H1. reflexivity.
        +intros. simpl in H3. destruct H3. rewrite <- H3. inversion Heqre'.
         rewrite <- H5. apply H. apply H2. apply H3.
Qed.

Lemma reg_exp_of_list_spec : forall T (s1 s2 : list T),
  s1 =~ reg_exp_of_list s2 <-> s1 = s2.
Proof. split.
  - intros. generalize dependent s1. induction s2.
    + intros. simpl in H. inversion H. reflexivity.
    + intros. simpl in H. inversion H. apply IHs2 in H4. inversion H3. rewrite H4. reflexivity.
  - intros. rewrite H. generalize dependent s1. induction s2.
    + intros. simpl. apply MEmpty.
    + intros. simpl. replace (x :: s2) with ([x] ++ s2). apply MApp. apply MChar.
      apply IHs2 with (s1 := s2). reflexivity. reflexivity.
Qed.

Fixpoint re_chars {T} (re : reg_exp T) : 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 T) (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].
  (* WORKED IN CLASS *)
  - (* MEmpty *)
    apply Hin.
  - (* MChar *)
    apply Hin.
  - simpl. rewrite In_app_iff in *.
    destruct Hin as [Hin | Hin].
    + (* In x s1 *)
      left. apply (IH1 Hin).
    + (* In x s2 *)
      right. apply (IH2 Hin).
  - (* MUnionL *)
    simpl. rewrite In_app_iff.
    left. apply (IH Hin).
  - (* MUnionR *)
    simpl. rewrite In_app_iff.
    right. apply (IH Hin).
  - (* MStar0 *)
    destruct Hin.
    - (* MStarApp *)
    simpl. rewrite In_app_iff in Hin.
    destruct Hin as [Hin | Hin].
    + (* In x s1 *)
      apply (IH1 Hin).
    + (* In x s2 *)
      apply (IH2 Hin).
Qed.

Fixpoint re_not_empty {T : Type} (re : reg_exp T) : bool :=
  match re with
  | EmptySet => false
  | EmptyStr => true
  | Char _ => true
  | App r1 r2 => andb (re_not_empty r1) (re_not_empty r2)
  | Union r1 r2 => orb (re_not_empty r1) (re_not_empty r2)
  | Star r => true
  end.

Lemma re_not_empty_correct : forall T (re : reg_exp T),
  (exists s, s =~ re) <-> re_not_empty re = true.
Proof.
  split.
  - intros. destruct H. induction  H.
    + reflexivity.
    + reflexivity.
    + simpl. rewrite IHexp_match1. rewrite IHexp_match2. reflexivity.
    + simpl. rewrite IHexp_match. reflexivity.
    + simpl. rewrite orb_true_iff. right. rewrite IHexp_match. reflexivity.
    + reflexivity.
    + reflexivity.
  - intros. induction re.
    + inversion H.
    + exists []. apply MEmpty.
    + exists [t]. apply MChar.
    + simpl in H. apply andb_true_iff in H. destruct H. apply IHre1 in H. destruct H.
      apply IHre2 in H0. destruct H0. exists (x ++ x0). apply MApp. apply H. apply H0.
    + simpl in H. apply orb_true_iff in H. destruct H.
      ++ apply IHre1 in H. destruct H. exists x. apply MUnionL. apply H.
      ++ apply IHre2 in H. destruct H. exists x. apply MUnionR. apply H.
    + exists []. apply MStar0.
Qed.

Inductive nostutter {X : Type} : list X -> Prop :=
  | NoStutO : nostutter []
  | NoStutChar : forall c : X, nostutter [c]
  | NoStutApp : forall (c h : X) (l : list X),
      c <> h -> nostutter (h::l) -> nostutter (c::h::l).

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; apply beq_nat_false_iff; auto.
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.

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.
  - inversion Heqre'.
  - inversion Heqre'.
  - inversion Heqre'.
  - inversion Heqre'.
  - inversion Heqre'.
  - intros.  apply H.
  - intros. apply IHexp_match2 in H. rewrite <- app_assoc. apply MStarApp. apply H1_. apply H.
    apply Heqre'.
Qed.

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 T n m l.
    induction n as [| n IHn].
    -reflexivity.
    -simpl. rewrite IHn, app_assoc. reflexivity.
   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.
            Require Import Coq.omega.Omega.
            Proof.
              Admitted.
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 H. apply H. reflexivity.
  -simpl. destruct (beq_nat n m) eqn:H.
   + intros _. rewrite beq_nat_true_iff in H. rewrite H.
     left. reflexivity.
   + intros H'.  right. apply IHl'. apply H'.
Qed.

Module FirstTry.

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

End FirstTry.

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 P b H. destruct b.
       -apply ReflectT. rewrite H. reflexivity.
       -apply ReflectF. rewrite H. intros H'. inversion H'.
Qed.

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.
       -intros. inversion H. apply H1 in H0. inversion 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.

(*this generates n = m (P) and n <> m (~P) as hypothesis directly
  making the proof more streamlined than before *)
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 H'. right. apply IHl'. apply H'.
Qed.

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 n l H. induction l as [| m l' IH].
  -unfold not. intros. inversion H0.
  -simpl in H. destruct (beq_natP n m) in H.
   +inversion H.
   +apply IH in H. unfold not. intros. simpl in H1. destruct H1.
    ++symmetry in H1. apply H0 in H1. inversion H1.
    ++apply H in H1. inversion H1.
Qed.


(* Software Foundations *)
(* Exercice 1 star, double_even *)

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

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

Theorem double_even: forall n: nat, ev (double n).
Proof.
    induction n as [|n'].
    simpl. apply ev_0.
    simpl. apply ev_ss. apply IHn'.
Qed.


Require Import Arith.
Require Import Omega.

(* Inductive predicate *)
Inductive even : nat -> Prop :=
| even_0 : even 0
| even_SS : forall n, even n -> even (S (S n)).

Inductive odd : nat -> Prop :=
| odd_1 : odd 1
| odd_SS : forall n, odd n -> odd (S (S n)).

Theorem even_double : forall n, even (n + n).
Proof.
induction n.
(* Proof *)
Qed.

Theorem even_plus : forall m n, even m -> even n -> even (m + n).
Proof.
intros m n Hm Hn.
induction Hm.
(* Proof *)
Qed.

Theorem not_even_1 : ~even 1.
Proof.
intro. inversion H.
Qed.

Theorem even_SS_inv : forall n, even (S (S n)) -> even n.
Proof.
intros n H.
(* Proof *)
Qed.

Theorem even_odd : forall n, even n -> odd (S n).
Proof.
intros n H.
induction H.
(* Proof *)
Qed.

Theorem odd_even : forall n, odd n -> even (S n).
Proof.
(* Proof *)
Qed.

Theorem even_not_odd : forall n, even n -> ~odd n.
Proof.
(* Proof *)
Qed.

Theorem even_or_odd : forall n, even n \/ odd n.
Proof.
intro n.
induction n.
 left. apply even_0.
induction n.
(* Proof. even_odd and odd_even are useful. *)
Qed.

Theorem odd_odd_even : forall m n, odd m -> odd n -> even (m + n).
Proof.
intros m n Hm Hn.
induction Hm.
 induction Hn.
(* Proof. *)
Qed.

Section List_inversion.

Require Import List.

Variable A:Type.

Theorem app_inv_l : forall l l1 l2:list A,
  l ++ l1 = l ++ l2 -> l1 = l2.
Proof.
(* Proof. *)
Qed.

Check app_nil_r.
Check app_cons_not_nil.

Lemma app_cons_assoc : forall (a:A)(l1 l2:list A),
  l1 ++ a::l2 = (l1 ++ a::nil) ++ l2.
Proof.
(* Proof. *)
Qed.

Lemma app_snoc_inv : forall (a:A)(l1 l2:list A),
  l1 ++ a::nil = l2 ++ a::nil -> l1 = l2.
Proof.
(* Proof. *)
Qed.

Theorem app_inv_r : forall l l1 l2:list A,
  l1 ++ l = l2 ++ l -> l1 = l2.
Proof.
(* Proof. *)
Qed.

Check app_inv_l.
End List_inversion.
Check app_inv_l.