Require Export Basics.

Require String. Open Scope string_scope.

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

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

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

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

(* some helpful arithmetic Proofs *)

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

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

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

Definition neq_0_b (n :nat) : bool :=
  match n with
    |0 => false
    |S _ => true
end.

Theorem neq_0_dist :
  forall (n m : nat),
  neq_0_b (n + m) = orb (neq_0_b n) (neq_0_b m).
Proof.
  intros. destruct n. reflexivity. reflexivity.
Qed.

(* bin is defined here *)

Inductive bin : Type :=
| Zero : bin
| D : bin -> bin
| P : bin -> bin.

Fixpoint inc (n : bin) : bin :=
  match n with
   | Zero => P Zero
   | D n' => P n'
   | P n' => D (inc n')
  end.

Fixpoint gt_Zero (n : bin) : bool :=
  match n with
    |Zero => false
    |D n' => gt_Zero n'
    |P n' => true
  end.

Fixpoint toUnary (n : bin) : nat :=
  match n with
    |Zero => O
    |D n' => 2 * toUnary n'
    |P n' => S (2 * toUnary n')
  end.

Fixpoint fromUnary (n : nat) : bin :=
  match n with
    |O => Zero
    |S n' => inc (fromUnary n')
end.

Theorem comm_inc_binunary :
  forall (n : bin),
  toUnary (inc n) = S (toUnary n).
Proof.
  induction n. reflexivity.
  reflexivity.
  simpl. rewrite IHn.
  simpl. rewrite <- plus_n_Sm.
  reflexivity.
Qed.

Theorem leftInv :
  forall (x : nat),
  toUnary (fromUnary x) = x.
Proof.
  induction x. Case "base". reflexivity.
  simpl. rewrite comm_inc_binunary.
  rewrite IHx.
  reflexivity.
Qed.

(* Here is the definition of normalize *)

Fixpoint dropZeros (n: bin) :bin :=
  match n with
    | Zero => Zero
    | D n' => dropZeros n'
    | P n' => P n'
end.

Fixpoint conj (n: bin) (con: bin -> bin) : bin :=
  match n with
    | Zero => con Zero
    | D n' => D (conj n' con)
    | P n' => P (conj n' con)
  end.

(* this is slower than reverse with an accumulator, but easier to reason about *)
Fixpoint reverse (n : bin) : bin :=
  match n with
    | Zero => Zero
    | D n' => conj (reverse n') D
    | P n' => conj (reverse n') P
end.

Fixpoint normalize (n : bin) :bin :=
  reverse ( dropZeros ( reverse n)).

Lemma conj_revD :
  forall (b : bin),
  reverse (conj b D) = D (reverse b).
Proof.
  intros. induction b. reflexivity.
  simpl.  rewrite IHb. reflexivity.
  simpl.  rewrite IHb. reflexivity.
Qed.

Lemma conj_revP :
  forall (b : bin),
  reverse (conj b P) = P (reverse b).
Proof.
  intros. induction b. reflexivity.
  simpl.  rewrite IHb. reflexivity.
  simpl.  rewrite IHb. reflexivity.
Qed.

Theorem rev_inv_rev:
  forall (x : bin),
  reverse (reverse x) = x.
Proof.
  intros. induction x. reflexivity.
  simpl. rewrite conj_revD. rewrite IHx. reflexivity.
  simpl. rewrite conj_revP. rewrite IHx. reflexivity.
Qed.

Theorem toUnary_distD:
  forall (x : bin),
  toUnary (D x) = (toUnary x) + (toUnary x) .
Proof.
  intros. induction x. simpl. reflexivity.
  simpl. rewrite plus_0_r. rewrite plus_0_r. reflexivity.
  simpl. rewrite plus_0_r. rewrite plus_0_r. reflexivity.
Qed.

Theorem toUnary_distP:
  forall (x : bin),
  toUnary (P x) = S (toUnary x + toUnary x).
Proof.
  induction x. simpl. reflexivity.
  simpl. rewrite plus_0_r. rewrite plus_0_r. reflexivity.
  simpl. rewrite plus_0_r. rewrite plus_0_r. reflexivity.
Qed.

(* Here I used inversion. Basically if you have an absurd
premise you can derive an absurd conclusion. *)
Theorem fromUnary_distD:
  forall (n : nat),
  neq_0_b n = true -> D (fromUnary n) = fromUnary(n + n).
Proof.
  intros. induction n. inversion H.
  simpl. rewrite <- plus_n_Sm. simpl. destruct n. reflexivity.
  rewrite <- IHn. simpl. reflexivity. reflexivity.
Qed.

Theorem fromUnary_distP:
  forall (n : nat),
  P (fromUnary n) = inc (fromUnary(n + n)).
Proof.
  induction n. reflexivity.
  simpl. rewrite <- plus_comm. simpl. rewrite <- IHn. simpl. reflexivity.
Qed.

Theorem has_P_not_zero:
  forall (x : bin),
  neq_0_b (toUnary (conj x P)) = true.
Proof.
  induction x. reflexivity.
  simpl. rewrite plus_0_r. rewrite neq_0_dist. rewrite IHx. reflexivity.
  reflexivity.
Qed.

Theorem trailing_P_is_normal:
  forall (y : bin),
  fromUnary (toUnary (conj y P)) = conj y P.
Proof.
  induction y. reflexivity.
  simpl. rewrite plus_0_r. rewrite <- fromUnary_distD. rewrite IHy. reflexivity.
  rewrite has_P_not_zero. reflexivity.
  simpl. rewrite plus_0_r. rewrite <- fromUnary_distP. rewrite IHy. reflexivity.
Qed.

Theorem toUnary_drop_trailing_D :
  forall (y : bin),
  toUnary (conj y D) = toUnary y.
Proof.
  intros. induction y. reflexivity.
  simpl. rewrite IHy. reflexivity.
  simpl. rewrite IHy. reflexivity.
Qed.

Theorem dropFront :
  forall (x : bin),
  reverse (dropZeros x) = (fromUnary (toUnary (reverse x))).
Proof.
 induction x. reflexivity.
 simpl. rewrite toUnary_drop_trailing_D. rewrite IHx. reflexivity.
 simpl. rewrite trailing_P_is_normal. reflexivity.
Qed.

Theorem rightInv:
  forall (z : bin),
  fromUnary (toUnary z) = normalize z.
Proof.
  destruct z. reflexivity.
  simpl. rewrite plus_0_r.
  rewrite dropFront. rewrite conj_revD. rewrite rev_inv_rev. rewrite toUnary_distD. reflexivity.
  simpl. rewrite plus_0_r.
  rewrite dropFront. rewrite conj_revP. rewrite rev_inv_rev. rewrite toUnary_distP. reflexivity.
Qed.

(* Things I didn't end up needing *)

Theorem fromUnary_inj :
  forall (x y: nat),
  fromUnary x = fromUnary y -> x = y.
Proof.
  intros. rewrite <- leftInv. rewrite <- H. rewrite leftInv. reflexivity.
Qed.

Fixpoint rev (n: bin) (acc : bin) : bin :=
  match n with
    | Zero => acc
    | D n' => rev n' (D acc)
    | P n' => rev n' (P acc)
end.

(* this reverse uses an accumulator and is O(n) instead of O(n^2) *)
Definition reverse_fast (n : bin) : bin :=
  rev n Zero.

(* never got around to proving this *)
Theorem rev_eq_rev_fast :
  forall (n : bin), reverse n = reverse_fast n.
Proof.
Abort.

(* this is another normalize function I defined I belive it should be a bit faster,
 but looks hard to reason about. *)

Fixpoint revpend (n: bin) (m: bin) : bin :=
  match n with
    |Zero => m
    |D n' => D (revpend n' m)
    |P n' => P (revpend n' m)
  end.

Fixpoint nml (n : bin) (acc : bin) : bin :=
  match n with
    |Zero => Zero
    |D n' => nml n' (D acc)
    |P n' => revpend (D acc) (nml n' Zero)
  end.

Definition normalize' (n : bin) : bin :=
  nml n Zero.


Require Import STLCdbj.syntax.
Require Import STLCdbj.bindings.
Require Import Utf8.

Implicit Types V: Set.

Definition Ctx V := V → ty.

Definition DV_extend {V} {K:Type} (f: V -> K) (T : K) : inc V -> K :=
  fun t =>
    match t with
    | VZ => T
    | VS k => f k
    end.

Notation ctx_append Γ T := (DV_extend Γ T).

(*
Inductive val (V: Set) : Set :=
  | v_var  : V -> val V
  | v_true : val V
  | v_false : val V
  | v_abs  : exp (inc V) -> val V
with exp (V : Set) : Set :=
  | e_val  : val V -> exp V
  | e_if   : exp V -> exp V -> exp V -> exp V
  | e_app  : exp V -> exp V -> exp V.
   *)

Inductive val_has_type {V} : Ctx V -> val V -> ty -> Prop :=
  | htv_var : forall Γ x T,
    Γ x = T ->
    val_has_type Γ (v_var x) T
  | htv_true : forall Γ,
    val_has_type Γ v_true ty_bool
  | htv_false : forall Γ,
    val_has_type Γ v_false ty_bool
  | htv_abs : forall Γ exp_body Ti To,
    exp_has_type (ctx_append Γ Ti) exp_body To ->
    val_has_type Γ (v_abs Ti exp_body) (ty_arrow Ti To)
with exp_has_type {V} : Ctx V -> exp V -> ty -> Prop :=
  | hte_val : forall Γ x T,
    val_has_type Γ x T ->
    exp_has_type Γ (e_val x) T
  | hte_if : forall Γ cond a b T,
    exp_has_type Γ cond ty_bool ->
    exp_has_type Γ a T ->
    exp_has_type Γ b T ->
    exp_has_type Γ (e_if cond a b) T
  | hte_app : forall Γ a b Ti To,
    exp_has_type Γ a (ty_arrow Ti To) ->
    exp_has_type Γ b Ti ->
    exp_has_type Γ (e_app a b) To.

Notation "Gamma '⊢ᵛ' t '∈' T" := (val_has_type Gamma t T)
(at level 101).

Notation "Gamma '⊢ᵉ' t '∈' T" := (exp_has_type Gamma t T)
(at level 101).


Require Export Omega.
Require Export matroid_axioms.

(*****************************************************************************)
(** Proof of matroid' to matroid **)

Section s_matroid'ToMatroid.

Context `{M : Matroid'}.

Lemma rk_compat:
  forall x x', Equal x x' ->
     rk x = rk x'.
Proof.
intros;apply rk_compat;assumption.
Qed.

(*
Global Add Morphism rk : rk_mor.
Proof.
 exact rk_compat.
Qed.
*)

Global Instance rk_mor : Proper (Equal ==> Logic.eq) rk.
Proof.
 exact rk_compat.
Qed.

Lemma matroid1_a : forall X, rk X >= 0.
Proof.
apply set_induction.
intros.
setoid_replace s with empty.
generalize matroid1';omega.
fsetdecide.
intros.
assert (rk s <= rk (add x s) <= rk s + 1).
apply matroid2'.
omega.
Qed.

Lemma matroid1_b : forall X, rk X <= cardinal X.
Proof.
apply set_induction.
intros.
setoid_replace s with empty by fsetdecide.
rewrite matroid1';auto.
omega.

intros.
assert (rk s <= rk (add x s) <= rk s + 1).
apply matroid2'.
assert (cardinal s' = S (cardinal s)).
eapply cardinal_2;eauto.
rewrite H4.
setoid_replace s' with (add x s).
omega.
rewrite <- Add_Equal;auto.
Qed.

Lemma singleton_eq : forall x y, In y (singleton x) -> x [==] y.
Proof.
intros.
fsetdecide.
Qed.

Hint Resolve singleton_eq.

Lemma set_fact_1 : forall x E A E' , ~ In x A -> ~ In x E ->
Equal (union E (add x A)) E' ->
Equal (union E A) (diff E' (singleton x)).
Proof.
intros.
assert(HH : ~ (In x (A ++ E))).
fsetdec.
rewrite <-H2.
clear H0 H1 H2.
fsetdecide.
Qed.

Lemma set_fact_2 : forall E E' x,
 Subset E E' ->
 ~ In x E ->
 Subset E (diff E' (singleton x)).
Proof.
intros.
fsetdecide.
Qed.

Lemma set_fact_3: forall e', forall x : Point,
In x e'  -> Equal (add x (diff e' (singleton x))) e'.
Proof.
intros.
assert(HH := add_remove H0).
fsetdecide.
Qed.

Lemma matroid2:
   forall e e',Subset e e' -> rk(e)<=rk(e').
Proof.
intros.
elim (subset_exists e e' H0).
intros e'' He.

generalize H0; clear H0.
generalize He; clear He.
generalize e; clear e.
generalize e'; clear e'.
generalize e''; clear e''.

apply (set_induction (P:= fun e'' => forall (e' e : Set_of_points),
Equal (union e e'') e' -> Subset e e' -> rk e <= rk e')).
intros.
assert (Equal e e').
fsetdecide.
rewrite H3;auto.

intros.

elim (In_dec x e);intro.
apply (H0 e' e).
setoid_replace (union e s') with (union e s) in H3.
auto.
setoid_replace s' with (add x s) in H3 by (apply -> Add_Equal;auto).
setoid_replace s' with (add x s) by (apply -> Add_Equal;auto).
clear H0 H1 H2 H3 H4.
fsetdecide.
auto.

assert (Equal (union e s) (diff e' (singleton x))).
apply set_fact_1;auto.
setoid_replace s' with (add x s) in H3 by (apply -> Add_Equal;auto).
auto.

assert (Subset e (diff e' (singleton x))).
apply set_fact_2;auto.
assert (T:= H0 (diff e' (singleton x)) e H5 H6).

assert (rk (diff e' (singleton x)) <= rk (add x (diff e' (singleton x))))
by (generalize (matroid2' (diff e' (singleton x)) x); intros;intuition).
assert (Equal (add x (diff e' (singleton x))) e').
apply set_fact_3.
setoid_replace s' with (add x s) in H3 by (apply -> Add_Equal;auto).
rewrite <- H3.
clear H0 H1 H2 H3 H4 H5 H6 H7.
fsetdecide.

rewrite H8 in H7.
omega.
Qed.

Lemma matroid3:
forall e e', rk(union e e') + rk(inter e e') <= rk(e) + rk(e').
Proof.
apply (set_induction (P:= fun e => forall e' : set Point,
rk (e ++ e')%set + rk (inter e e') <= rk e + rk e')).

intros.
assert(HH : Equal (s ++ e') e').
fsetdecide.
assert(HH0 : Equal (inter s e') s).
fsetdecide.
rewrite HH.
rewrite HH0.
omega.

intros.
assert(HH := Add_Equal x s s').
assert(HH0 : Equal s' {x; s}).
intuition.
rewrite HH0.

case_eq(In_dec x e').
intros.
assert(HH1 : Equal ({x;s} ++ e') (s ++ e')).
clear H1 H2 HH HH0.
fsetdecide.
assert(HH2 : Equal ({x;inter s e'}) (inter {x;s} e')).
clear H1 H2 HH HH0 H3 HH1.
fsetdecide.
rewrite HH1.
rewrite <-HH2.
assert(HH3 := matroid2' s x).
assert(HH4 := matroid2' (inter s e') x).

(*

apply le_trans with(m:= rk s + rk e').
2:omega.
apply le_trans with (m:= rk (union s e') + rk ((inter s e') + 1)).
admit.
omega.

intros.
assert(HH2 : Equal (inter {x;s} e') (inter s e')).
clear H0 H2 HH HH0.
apply inter_add_2.
assumption.
rewrite HH2.
*)

(*
apply le_trans with (m:= rk ( union s e') + rk (inter s e')).
fsetdec.
*)

(*
generalize s'.
apply (set_induction (P:= fun e' => forall s'0: set Point,
rk (s'0 ++ e')%set + rk (inter s'0 e') <= rk s'0 + rk e')).

intros.
assert(HH : Equal (s'0 ++ s0) s'0).
fsetdecide.
assert(HH0 : Equal (inter s'0 s0) s0).
fsetdecide.
rewrite HH.
rewrite HH0.
omega.

intros.
assert(HH := matroid3').

intros.
apply (set_induction (P:= fun e' =>
rk (s' ++ e')%set + rk (inter s' e') <= rk s' + rk e')).

intros.
assert(HH : Equal (s' ++ s0) s').
fsetdecide.
assert(HH0 : Equal (inter s' s0) s0).
fsetdecide.
rewrite HH.
rewrite HH0.
omega.

intros.

*)

Admitted.

End s_matroid'ToMatroid.


Require Import init.

Require Import zorn.

Require Export set.

Section ZornSet.

Context {U : Type}.

Local Instance subset_order : Order (U → Prop) := {le := subset}.

Variable SS : (U → Prop) → Prop.
Hypothesis SS_union : ∀ F : (set_type SS) → Prop, is_chain le F →
    SS (⋃ (image_under (λ S, [S|]) F)).

Theorem set_zorn : ∃ S : set_type SS, ∀ A : set_type SS, ¬([S|] ⊂ [A|]).
Proof.
    pose proof (zorn (le (U := set_type SS))) as S_ex.
    prove_parts S_ex.
    {
        intros F F_chain.
        specialize (SS_union F F_chain).
        exists [_|SS_union].
        intros A FA.
        unfold le; cbn.
        apply union_sub.
        exact (image_under_in FA).
    }
    destruct S_ex as [S S_max].
    exists S.
    intros A.
    specialize (S_max A).
    setoid_rewrite <- set_type_lt in S_max.
    exact S_max.
Qed.

End ZornSet.


Require Import Bignums.BigZ.BigZ CRArith model.totalorder.QposMinMax
        ARbigD ARbigQ ARQ ARtrans ARsign.

Definition myAR := ARbigD.

Definition answer (n : positive) (r : ARbigD) : bigZ :=
 let m := iter_pos _ (Pmult 10) 1%positive n in
 let (a, b) := (approximate r (Qpos2QposInf (1#m)) : bigD) * 'Zpos m in
 BigZ.shiftl a b.

(* To avoid timing the printing mechanism *)
Definition no_answer (n : positive) (r : myAR) :=
  let m := iter_pos _ (Pmult 10) 1%positive n in
  let _ := approximate r (Qpos2QposInf (1#m)) in
  tt.

(* xkcd.org/217 *)
Definition xkcd : myAR := (ARexp ARpi)-ARpi.

Time Eval vm_compute in (answer 10 xkcd).

Example xkcd217A : ARltT xkcd ('20%Z).
Proof. Time AR_solve_ltT (-8)%Z. Defined.

(* Many of the following expressions are taken from the "Many Digits friendly competition" problem set *)

(* Instance resolution takes 3s *)
Time Definition P01 : myAR := ARsin (ARsin (AQsin 1)).

Time Eval vm_compute in (answer 500 P01).
Time Eval vm_compute in (no_answer 500 P01).
Definition P02 : myAR := ARsqrt (ARcompress ARpi).
Time Eval vm_compute in (answer 500 P02).

Definition P03 : myAR := ARsin (AQexp 1).
Time Eval vm_compute in (answer 500 P03).

Definition P04 : myAR := ARexp (ARcompress (ARpi * AQsqrt ('163%Z))).
Time Eval vm_compute in (answer 500 P04).

Definition P05 : myAR := ARexp (ARexp (AQexp 1)).
Time Eval vm_compute in (answer 500 P05).

Definition P07 : myAR := AQexp ('1000%Z).
Time Eval vm_compute in (answer 2000 P07).

Definition P08 : myAR := AQcos ('(10^50)%Z).
Time Eval vm_compute in (answer 2000 P08).

Definition C02_prf : ARapartT (ARpi : myAR) (0 : myAR).
Proof. AR_solve_apartT (-8)%Z. Defined.

Definition C02 : myAR := ARsqrt (AQexp 1 * ARinvT ARpi C02_prf).
Time Eval vm_compute in (answer 250 C02).

Definition C03 : myAR := ARsin (ARcompress ((AQexp 1 + 1) ^ (3:N))).
Time Eval vm_compute in (answer 500 C03).

Definition C04 : myAR := ARexp (ARcompress (ARpi * AQsqrt ('2011%Z))).
Time Eval vm_compute in (answer 500 C04).

Definition C05 : myAR := ARexp (ARexp (ARsqrt (AQexp 1))).
Time Eval vm_compute in (answer 500 C05).

(* slow *) (*
Definition C07 : myAR := ARpi ^ 1000%N.
Time Eval vm_compute in (answer 50 C07).
*)
Definition ARtest1 : myAR := ARpi.
Time Eval vm_compute in (answer 1500 ARtest1).

Definition ARtest2 : myAR := ARarctan (ARcompress ARpi).
Time Eval vm_compute in (answer 100 ARtest2).

Definition ARtest3 : myAR := ARsqrt 2.
Time Eval vm_compute in (answer 1000 ARtest3).

Definition ARtest4 : myAR := ARsin ARpi.
Time Eval vm_compute in (answer 500 ARtest4).


Set Implicit Arguments.
Unset Strict Implicit.
Require Import Coq.micromega.Lia.
Require Import List.
Import ListNotations.

Definition surjective (X Y : Type) (f : X -> Y) : Prop :=
  forall y, exists x, f x = y.

Theorem Cantor X : ~ exists f : X -> X -> Prop,
  surjective f.
Proof.
  intros [f A].
  pose (g := fun x => ~ f x x).
  destruct (A g) as [x B].
  assert (C : g x <-> f x x).
  { rewrite B. intuition. }
  unfold g in C.
  intuition.
Qed.


(*
I hereby assign copyright in my past and future contributions
to the Software Foundations project to the Author of Record of
each volume or component, to be licensed under the same terms
as the rest of Software Foundations. I understand that, at present,
the Authors of Record are as follows: For Volumes 1 and 2, known
until 2016 as "Software Foundations" and from 2016 as (respectively)
"Logical Foundations" and "Programming Foundations," and for Volume 4,
"QuickChick: Property-Based Testing in Coq," the Author of Record is
Benjamin C. Pierce. For Volume 3, "Verified Functional Algorithms",
the Author of Record is Andrew W. Appel. For components outside of
designated volumes (e.g., typesetting and grading tools and other
software infrastructure), the Author of Record is Benjamin Pierce.
*)

From LF Require Export Poly.

(*Exercise 1*)
(** Define two recursive [Fixpoints], [forallb] and [existsb].  The
    first checks whether every element in a list satisfies a given
    predicate:

      forallb oddb [1;3;5;7;9] = true

      forallb negb [false;false] = true

      forallb evenb [0;2;4;5] = false

      forallb (beq_nat 5) [] = true

    The second checks whether there exists an element in the list that
    satisfies a given predicate:

      existsb (beq_nat 5) [0;2;3;6] = false

      existsb (andb true) [true;true;false] = true

      existsb oddb [1;0;0;0;0;3] = true

      existsb evenb [] = false

    Next, define a _nonrecursive_ version of [existsb] -- call it
    [existsb'] -- using [forallb] and [negb].

    Finally, prove a theorem [existsb_existsb'] stating that
    [existsb'] and [existsb] have the same behavior. *)

(* FILL IN HERE *)

Require Export Tactics.

Check 3 = 3.
Check forall n m : nat, n + m = m + n.
Check 2 = 2.
Check forall n : nat, n = 2.
Check 3 = 4.

Theorem plus_2_2_is_4 :
  2 + 2 = 4.
Proof. reflexivity.  Qed.

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

Theorem plus_fact_is_true :
  plus_fact.
Proof. reflexivity.  Qed.

Definition is_three (n : nat) : Prop :=
  n = 3.
Check is_three.

Definition injective {A B} (f : A -> B) :=
  forall x y : A, f x = f y -> x = y.

Lemma succ_inj : injective S.
Proof.
  intros n m H. inversion H. reflexivity.
Qed.

Check @eq.

Check and.

Example and_example : 3 + 4 = 7 /\ 2 * 2 = 4.

Proof.
  (* WORKED IN CLASS *)
  split.
  - (* 3 + 4 = 7 *) reflexivity.
  - (* 2 + 2 = 4 *) reflexivity.
Qed.

Lemma and_intro : forall A B : Prop, A -> B -> A /\ B.
Proof.
  intros A B HA HB. split.
  - apply HA.
  - apply HB.
Qed.

Example and_example' : 3 + 4 = 7 /\ 2 * 2 = 4.
Proof.
  apply and_intro.
  - (* 3 + 4 = 7 *) reflexivity.
  - (* 2 + 2 = 4 *) reflexivity.
Qed.

(*Exercise 2*)
Example and_exercise :
  forall n m : nat, n + m = 0 -> n = 0 /\ m = 0.
Proof.
  intros. split.
  - destruct n.
    + reflexivity.
    + inversion H.
  - destruct m.
    + reflexivity.
    + rewrite plus_comm in H.
      * inversion H.
Qed.

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

Lemma and_example2' :
  forall n m : nat, n = 0 /\ m = 0 -> n + m = 0.
Proof.
  intros n m [Hn Hm].
  rewrite Hn. rewrite Hm.
  reflexivity.
Qed.

Lemma and_example2'' :
  forall n m : nat, n = 0 -> m = 0 -> n + m = 0.
Proof.
  intros n m Hn Hm.
  rewrite Hn. rewrite Hm.
  reflexivity.
Qed.

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

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

(*Exercise 3*)
Lemma proj2 : forall P Q : Prop,
  P /\ Q -> Q.
Proof.
  intros. destruct H.
  - assumption.
Qed.

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

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

Check or.

Lemma or_example :
  forall n m : nat, n = 0 \/ m = 0 -> n * m = 0.
Proof.
  intros n m [Hn | Hm].
  - (* Here, [n = 0] *)
    rewrite Hn. reflexivity.
  - (* Here, [m = 0] *)
    rewrite Hm. rewrite <- mult_n_O.
    reflexivity.
Qed.

Lemma or_intro : forall A B : Prop, A -> A \/ B.
Proof.
  intros A B HA.
  left.
  apply HA.
Qed.

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

(*Exercise 5*)
Lemma mult_eq_0 :
  forall n m, n * m = 0 -> n = 0 \/ m = 0.
Proof.
  intros [].
  - left. reflexivity.
  - right. destruct m.
    + reflexivity.
    + inversion H.
Qed.

(*Exercise 6*)
Theorem or_commut : forall P Q : Prop,
  P \/ Q  -> Q \/ P.
Proof.
  intros. destruct H.
  - right. apply H.
  - left. apply H.
Qed.

Module MyNot.

Definition not (P:Prop) := P -> False.

Notation "~ x" := (not x) : type_scope.

Check not.

End MyNot.

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

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

Theorem zero_not_one : ~(0 = 1).
Proof.
  intros contra. inversion contra.
Qed.

Check (0 <> 1).

Theorem zero_not_one' : 0 <> 1.
Proof.
  intros H. inversion H.
Qed.

Theorem not_False :
  ~ False.
Proof.
  unfold not. intros H. destruct H. Qed.

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

Theorem double_neg : forall P : Prop,
  P -> ~~P.
Proof.
  (* WORKED IN CLASS *)
  intros P H. unfold not. intros G. apply G. apply H.  Qed.

(*Exercise 8*)
Theorem contrapositive : forall (P Q : Prop),
  (P -> Q) -> (~Q -> ~P).
Proof.
  intros. unfold not. unfold not in H0. intros. apply H0 in H. assumption. assumption.
Qed.

(*Exercise 9*)
Theorem not_both_true_and_false : forall P : Prop,
  ~ (P /\ ~P).
Proof.
  intros. unfold not. intros. destruct H.
  - apply H0 in H. assumption.
Qed.

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

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

(*Exercise 10*)
Theorem xxx:
  forall (P Q R: Prop),
  (P -> Q -> R) -> (P /\ Q -> R).

Proof.
  intros. destruct H0.
  - apply H.
    + apply H0.
    + apply H1.
Qed.

(*Exercise 11*)
Theorem yyy:
  forall (P Q R: Prop),
  (P /\ Q -> R) -> (P -> Q -> R).
Proof.
  intros. apply H. split.
  - apply H0.
  - apply H1.
Qed.