import data.set
open set

section
  variable U: Type
  variables A B C: set U

  example : ∀ x, x ∈ A ∩ C → x ∈ A ∪ B :=
    assume x,
    assume :x ∈ A ∩ C,
    have x ∈ A, from and.left this,
    show x ∈ A ∪ B, from or.inl this

  example : ∀ x, x ∈ (A ∪ B)ᶜ  → x ∈ Aᶜ :=
    assume x,
    assume :x ∈ (A ∪ B)ᶜ,
    have x ∈ Aᶜ ∩ Bᶜ, from eq.subst (compl_union A B) this,
    show x ∈ Aᶜ, from and.left this

end

section
  variable {U : Type}

  def disj (A B : set U) : Prop := ∀ ⦃x⦄, x ∈ A → x ∈ B → false

  example (A B C D : set U) (h1 : disj A B) (h2 : C ⊆ A)
      (h3 : D ⊆ B) :
    disj C D :=
  assume x,
  assume :x ∈ C,
  have x ∈ A, from h2 this,
  assume :x ∈ D,
  have x ∈ B, from h3 this,
  show false, from h1 ‹x ∈ A› ‹x ∈ B›

end

section
  variables {I U : Type}
  variables (A : I → set U) (B : I → set U) (C : set U)

  example : (⋂ i, A i) ∩ (⋂ i, B i) ⊆ (⋂ i, A i ∩ B i) :=
    assume x,
    assume h: x ∈ (⋂ i, A i) ∩ (⋂ i, B i),
    have x ∈ (⋂ i, A i), from and.left h,
    have x ∈ (⋂ i, B i), from and.right h,
    have ∀i, x ∈ A i, by simp * at *,
    have ∀i, x ∈ B i, by simp * at *,
    have ∀i, x ∈ A i ∩ B i, from
      assume i: I,
      have x ∈ A i, from ‹∀i, x ∈ A i› i,
      have x ∈ B i, from ‹∀i, x ∈ B i› i,
      show x ∈ A i ∩ B i, from and.intro ‹x ∈ A i› ‹x ∈ B i›,
    show x ∈ (⋂ i, A i ∩ B i), by simp * at *

  example : C ∩ (⋃i, A i) ⊆ ⋃i, C ∩ A i :=
    assume x,
    assume h: x ∈ C ∩ (⋃i, A i),
    have x ∈ C, from and.left h,
    have x ∈ (⋃i, A i), from and.right h,
    have ∃i, x ∈ A i, from by simp * at *,
    have ∃i, x ∈ C ∩ A i, from exists.elim this $
      assume i,
      assume :x ∈ A i,
      have x ∈ C ∩ A i, from and.intro ‹x ∈ C› this,
      exists.intro i this,
    show x ∈ ⋃i, C ∩ A i, by simp * at *

end

section
  variable  {U : Type}
  variables A B C : set U

  example (h : A ⊆ B) : powerset A ⊆ powerset B :=
    assume x,
    assume :x ∈ powerset A,
    show x ∈ powerset B, from subset.trans this h

  example (h : powerset A ⊆ powerset B) : A ⊆ B :=
    show A ⊆ B, from h (subset.refl A)
end


/-
THIS ASSIGNMENT IS DUE BEFORE 9AM
ON TUESDAY NEXT WEEK, BEFORE THE
DAY'S 2101 CLASSES BEGIN. WE WILL
REVIEW THE ANSWERS IN CLASS. THEN
WE WILL GIVE An IN-CLASS, GRADED
EXERCISE TO TEST YOUR UNDERSTANDING.

This file comes in two parts. The first
part presents an example that you are to
read and understand. It's an example of
a proof of a bi-implication between two
equivalent disjunctions. The key lesson
it teaches is proof by *case analysis*.

When you are asked to prove that P ∨ Q
implies some conclusion, you do it by
case analysis. The idea is that if P ∨ Q
is true, there are two ways in which it
can be true: either P is true, or Q is
true. You have prove the goal follows
in either case. If the goal follows in
either case,  then it follows from the
disjunction, P ∨ Q, as a whole.

We use the "cases" tactic in lean to
reason about the two possible cases of
a proof of P ∨ Q. Using this tactic
produces two subgoals. In one case, P
is assumed to have a proof, p. In the
other case, Q is assumed to have a proof,
q. The aim then is to show that the main
goal follows in each case, as that will
then prove that the goal follows from
the disjunction as a whole.

The second part of this file presents a
problem for you to solve. One again it's
a bi-implication involving a disjunction
as a premise (in one direction but not in
the other direction).

In both of these parts, we, or you will,
start by applying iff.intro to split the
bi-implication into two implications to be proved.

Then in the subproblems with disjunctions
as premises, you will use case analysis.
A hint: Remember that ¬ X means X → false,
and the way to prove this is to assume X
and show this leads to a contradiction. It
is this maneuver that gets you a disjunction
as a premise in the problem you're to solve.
-/

-- PART I: A WORKED EXAMPLE

/-
We first show you how to prove P ∨ Q ↔ Q ∨ P.
At the highest level, the proof is by showing
the implication in each direction. Within each
direction, the proof is by case analysis for
the disjunction that forms the premise of the
implication. These ideas are explained in more
detail in the proof that follows.
-/

theorem
or_commutes :
    ∀ P Q: Prop, P ∨ Q ↔ Q ∨ P
:=
begin

/-
Introduce the assumptions that P and Q
are arbitrary propositions.
-/
assume P Q: Prop,

/-
To prove a bi-implication, we prove the
implications in each direction. That is,
we break the overall goal into subgoals,
one for the forward implication and one
for its converse (in the other direction).
-/
apply iff.intro,

    -- now we prove the forward implication
    assume pq : P ∨ Q,
    show Q ∨ P,
    from
        begin
        /-
        The key proof technique for reasoning
        from a proof of a disjunction, P ∨ Q,
        is to consider two possible cases for
        this proof, that either P is true or
        Q is, and to show that the goal is
        true in either case. This shows that
        no matter why P ∨ Q is true, the goal
        follows.

        So, the proof strategy is first to
        assumes that P ∨ Q is true because P
        is true, which is to say you assume
        you have a proof of P, and then show
        that the goal follows. Then you assume
        P ∨ Q is true because Q is true, and
        you show that given an assumed proof
        of Q, the goal follows. The goal thus
        follows in either case.

        The tactic that we use in Lean to
        reason by cases from a disjunction is
        called "cases." As arguments you give
        it (1) the name of the disjunction to
        reason from, and (2) names to use for
        the assumed proofs of P and Q in the
        respective cases (after keyword "with").

        So here we go. Make sure you have the
        Lean Messages window open so that you
        can see how "cases" changes your tactic
        state. Note that it introduces two new
        subgoals. In the first, there is an
        assumed proof, p : P. In the second,
        there is an an assumed proof q : Q.
        -/
        cases pq with p q,
        -- now prove each case separately

            -- proof for case where P is true
            show Q ∨ P,
            from or.intro_right Q p,

            -- proof for case where Q is true
            show Q ∨ P,
            from or.intro_left P q,
        end,

    -- and now we prove the converse
    assume qp : Q ∨ P,
    show P ∨ Q,
    from
        begin
        cases qp with q p,
            show P ∨ Q,
            from or.intro_right P q,
            show P ∨ Q,
            from or.intro_left Q p,
        end,
end

-- PART II: YOUR HOMEWORK ASSIGNMENT

/-
Homework:

Prove, ∀ P Q: Prop, ¬ P ∧ ¬ Q ↔ ¬ (P ∨ Q)

-/

theorem aDemorganLaw :
    ∀ P Q: Prop, ¬ P ∧ ¬ Q ↔ ¬ (P ∨ Q) :=
begin
_
end


/-
Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Violeta Hernández Palacios
-/

import set_theory.game.ordinal

/-!
# Birthdays of games

The birthday of a game is an ordinal that represents at which "step" the game was constructed. We
define it recursively as the least ordinal larger than the birthdays of its left and right games. We
prove the basic properties about these.

# Main declarations

- `pgame.birthday`: The birthday of a pre-game.

# Todo

- Define the birthdays of `game`s and `surreal`s.
- Characterize the birthdays of basic arithmetical operations.
-/

universe u

open ordinal

open_locale pgame

namespace pgame

/-- The birthday of a pre-game is inductively defined as the least strict upper bound of the
birthdays of its left and right games. It may be thought as the "step" in which a certain game is
constructed. -/
noncomputable def birthday : pgame.{u} → ordinal.{u}
| ⟨xl, xr, xL, xR⟩ :=
    max (lsub.{u u} $ λ i, birthday (xL i)) (lsub.{u u} $ λ i, birthday (xR i))

theorem birthday_def (x : pgame) : birthday x = max
  (lsub.{u u} (λ i, birthday (x.move_left i)))
  (lsub.{u u} (λ i, birthday (x.move_right i))) :=
by { cases x, rw birthday, refl }

theorem birthday_move_left_lt {x : pgame} (i : x.left_moves) :
  (x.move_left i).birthday < x.birthday :=
by { cases x, rw birthday, exact lt_max_of_lt_left (lt_lsub _ i) }

theorem birthday_move_right_lt {x : pgame} (i : x.right_moves) :
  (x.move_right i).birthday < x.birthday :=
by { cases x, rw birthday, exact lt_max_of_lt_right (lt_lsub _ i) }

theorem lt_birthday_iff {x : pgame} {o : ordinal} : o < x.birthday ↔
  (∃ i : x.left_moves, o ≤ (x.move_left i).birthday) ∨
  (∃ i : x.right_moves, o ≤ (x.move_right i).birthday) :=
begin
  split,
  { rw birthday_def,
    intro h,
    cases lt_max_iff.1 h with h' h',
    { left,
      rwa lt_lsub_iff at h' },
    { right,
      rwa lt_lsub_iff at h' } },
  { rintro (⟨i, hi⟩ | ⟨i, hi⟩),
    { exact hi.trans_lt (birthday_move_left_lt i) },
    { exact hi.trans_lt (birthday_move_right_lt i) } }
end

theorem relabelling.birthday_congr : ∀ {x y : pgame.{u}}, x ≡r y → birthday x = birthday y
| ⟨xl, xr, xL, xR⟩ ⟨yl, yr, yL, yR⟩ ⟨L, R, hL, hR⟩ := begin
  rw [birthday, birthday],
  congr' 1,
  all_goals
  { apply lsub_eq_of_range_eq.{u u u},
    ext i,
    split },
  { rintro ⟨j, rfl⟩,
    exact ⟨L j, (hL j).birthday_congr.symm⟩ },
  { rintro ⟨j, rfl⟩,
    refine ⟨L.symm j, relabelling.birthday_congr _⟩,
    convert hL (L.symm j),
    rw L.apply_symm_apply },
  { rintro ⟨j, rfl⟩,
    refine ⟨R j, (relabelling.birthday_congr _).symm⟩,
    convert hR (R j),
    rw R.symm_apply_apply },
  { rintro ⟨j, rfl⟩,
    exact ⟨R.symm j, (hR j).birthday_congr⟩ }
end
using_well_founded { dec_tac := pgame_wf_tac }

@[simp] theorem birthday_add_zero (x : pgame) : birthday (x + 0) = birthday x :=
(add_zero_relabelling x).birthday_congr

@[simp] theorem birthday_zero_add (x : pgame) : birthday (0 + x) = birthday x :=
(zero_add_relabelling x).birthday_congr

@[simp] theorem birthday_eq_zero (x : pgame) :
  birthday x = 0 ↔ is_empty x.left_moves ∧ is_empty x.right_moves :=
by rw [birthday_def, max_eq_zero, lsub_eq_zero_iff, lsub_eq_zero_iff]

@[simp] theorem birthday_zero : birthday 0 = 0 :=
by simp [pempty.is_empty]

@[simp] theorem birthday_one : birthday 1 = 1 :=
by { rw birthday_def, simp }

@[simp] theorem birthday_star : birthday star = 1 :=
by { rw birthday_def, simp }

@[simp] theorem neg_birthday : ∀ x : pgame, (-x).birthday = x.birthday
| ⟨xl, xr, xL, xR⟩ := begin
  rw [birthday_def, birthday_def, max_comm],
  congr; funext; apply neg_birthday
end

@[simp]

theorem le_birthday : ∀ x : pgame, x ≤ x.birthday.to_pgame
| ⟨xl, _, xL, _⟩ :=
le_def.2 ⟨λ i, or.inl ⟨to_left_moves_to_pgame ⟨_, birthday_move_left_lt i⟩,
  by simp [le_birthday (xL i)]⟩, is_empty_elim⟩

theorem neg_birthday_le (x : pgame) : -x.birthday.to_pgame ≤ x :=
let h := le_birthday (-x) in by rwa [neg_birthday, neg_le_iff] at h

end pgame


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
import algebra.group.pi
import algebra.group_power.lemmas
import logic.function.iterate

/-!
# The group of permutations (self-equivalences) of a type `α`

This file defines the `group` structure on `equiv.perm α`.
-/
universes u v

namespace equiv

variables {α : Type u} {β : Type v}

namespace perm

instance perm_group : group (perm α) :=
{ mul := λ f g, equiv.trans g f,
  one := equiv.refl α,
  inv := equiv.symm,
  mul_assoc := λ f g h, (trans_assoc _ _ _).symm,
  one_mul := trans_refl,
  mul_one := refl_trans,
  mul_left_inv := self_trans_symm }

theorem mul_apply (f g : perm α) (x) : (f * g) x = f (g x) :=
equiv.trans_apply _ _ _

theorem one_apply (x) : (1 : perm α) x = x := rfl

@[simp] lemma inv_apply_self (f : perm α) (x) : f⁻¹ (f x) = x := f.symm_apply_apply x

@[simp] lemma apply_inv_self (f : perm α) (x) : f (f⁻¹ x) = x := f.apply_symm_apply x

lemma one_def : (1 : perm α) = equiv.refl α := rfl

lemma mul_def (f g : perm α) : f * g = g.trans f := rfl

lemma inv_def (f : perm α) : f⁻¹ = f.symm := rfl

@[simp] lemma coe_mul (f g : perm α) : ⇑(f * g) = f ∘ g := rfl

@[simp] lemma coe_one : ⇑(1 : perm α) = id := rfl

lemma eq_inv_iff_eq {f : perm α} {x y : α} : x = f⁻¹ y ↔ f x = y := f.eq_symm_apply

lemma inv_eq_iff_eq {f : perm α} {x y : α} : f⁻¹ x = y ↔ x = f y := f.symm_apply_eq

lemma zpow_apply_comm {α : Type*} (σ : perm α) (m n : ℤ) {x : α} :
  (σ ^ m) ((σ ^ n) x) = (σ ^ n) ((σ ^ m) x) :=
by rw [←equiv.perm.mul_apply, ←equiv.perm.mul_apply, zpow_mul_comm]

@[simp] lemma iterate_eq_pow (f : perm α) : ∀ n, f^[n] = ⇑(f ^ n)
| 0       := rfl
| (n + 1) := by { rw [function.iterate_succ, pow_add, iterate_eq_pow], refl }

/-! Lemmas about mixing `perm` with `equiv`. Because we have multiple ways to express
`equiv.refl`, `equiv.symm`, and `equiv.trans`, we want simp lemmas for every combination.
The assumption made here is that if you're using the group structure, you want to preserve it after
simp. -/

@[simp] lemma trans_one {α : Sort*} {β : Type*} (e : α ≃ β) : e.trans (1 : perm β) = e :=
equiv.trans_refl e

@[simp] lemma mul_refl (e : perm α) : e * equiv.refl α = e := equiv.trans_refl e

@[simp] lemma one_symm : (1 : perm α).symm = 1 := equiv.refl_symm

@[simp] lemma refl_inv : (equiv.refl α : perm α)⁻¹ = 1 := equiv.refl_symm

@[simp] lemma one_trans {α : Type*} {β : Sort*} (e : α ≃ β) : (1 : perm α).trans e = e :=
equiv.refl_trans e

@[simp] lemma refl_mul (e : perm α) : equiv.refl α * e = e := equiv.refl_trans e

@[simp] lemma inv_trans_self (e : perm α) : e⁻¹.trans e = 1 := equiv.symm_trans_self e

@[simp] lemma mul_symm (e : perm α) : e * e.symm = 1 := equiv.symm_trans_self e

@[simp] lemma self_trans_inv (e : perm α) : e.trans e⁻¹ = 1 := equiv.self_trans_symm e

@[simp] lemma symm_mul (e : perm α) : e.symm * e = 1 := equiv.self_trans_symm e

/-! Lemmas about `equiv.perm.sum_congr` re-expressed via the group structure. -/

@[simp] lemma sum_congr_mul {α β : Type*} (e : perm α) (f : perm β) (g : perm α) (h : perm β) :
  sum_congr e f * sum_congr g h = sum_congr (e * g) (f * h) :=
sum_congr_trans g h e f

@[simp] lemma sum_congr_inv {α β : Type*} (e : perm α) (f : perm β) :
  (sum_congr e f)⁻¹ = sum_congr e⁻¹ f⁻¹ :=
sum_congr_symm e f

@[simp] lemma sum_congr_one {α β : Type*} :
  sum_congr (1 : perm α) (1 : perm β) = 1 :=
sum_congr_refl

/-- `equiv.perm.sum_congr` as a `monoid_hom`, with its two arguments bundled into a single `prod`.

This is particularly useful for its `monoid_hom.range` projection, which is the subgroup of
permutations which do not exchange elements between `α` and `β`. -/
@[simps]
def sum_congr_hom (α β : Type*) :
  perm α × perm β →* perm (α ⊕ β) :=
{ to_fun := λ a, sum_congr a.1 a.2,
  map_one' := sum_congr_one,
  map_mul' := λ a b, (sum_congr_mul _ _ _ _).symm}

lemma sum_congr_hom_injective {α β : Type*} :
  function.injective (sum_congr_hom α β) :=
begin
  rintros ⟨⟩ ⟨⟩ h,
  rw prod.mk.inj_iff,
  split; ext i,
  { simpa using equiv.congr_fun h (sum.inl i), },
  { simpa using equiv.congr_fun h (sum.inr i), },
end

@[simp] lemma sum_congr_swap_one {α β : Type*} [decidable_eq α] [decidable_eq β] (i j : α) :
  sum_congr (equiv.swap i j) (1 : perm β) = equiv.swap (sum.inl i) (sum.inl j) :=
sum_congr_swap_refl i j

@[simp] lemma sum_congr_one_swap {α β : Type*} [decidable_eq α] [decidable_eq β] (i j : β) :
  sum_congr (1 : perm α) (equiv.swap i j) = equiv.swap (sum.inr i) (sum.inr j) :=
sum_congr_refl_swap i j

/-! Lemmas about `equiv.perm.sigma_congr_right` re-expressed via the group structure. -/

@[simp] lemma sigma_congr_right_mul {α : Type*} {β : α → Type*}
  (F : Π a, perm (β a)) (G : Π a, perm (β a)) :
  sigma_congr_right F * sigma_congr_right G = sigma_congr_right (F * G) :=
sigma_congr_right_trans G F

@[simp] lemma sigma_congr_right_inv {α : Type*} {β : α → Type*} (F : Π a, perm (β a)) :
  (sigma_congr_right F)⁻¹ = sigma_congr_right (λ a, (F a)⁻¹) :=
sigma_congr_right_symm F

@[simp] lemma sigma_congr_right_one {α : Type*} {β : α → Type*} :
  (sigma_congr_right (1 : Π a, equiv.perm $ β a)) = 1 :=
sigma_congr_right_refl

/-- `equiv.perm.sigma_congr_right` as a `monoid_hom`.

This is particularly useful for its `monoid_hom.range` projection, which is the subgroup of
permutations which do not exchange elements between fibers. -/
@[simps]
def sigma_congr_right_hom {α : Type*} (β : α → Type*) :
  (Π a, perm (β a)) →* perm (Σ a, β a) :=
{ to_fun := sigma_congr_right,
  map_one' := sigma_congr_right_one,
  map_mul' := λ a b, (sigma_congr_right_mul _ _).symm }

lemma sigma_congr_right_hom_injective {α : Type*} {β : α → Type*} :
  function.injective (sigma_congr_right_hom β) :=
begin
  intros x y h,
  ext a b,
  simpa using equiv.congr_fun h ⟨a, b⟩,
end

/-- `equiv.perm.subtype_congr` as a `monoid_hom`. -/
@[simps] def subtype_congr_hom (p : α → Prop) [decidable_pred p] :
  (perm {a // p a}) × (perm {a // ¬ p a}) →* perm α :=
{ to_fun := λ pair, perm.subtype_congr pair.fst pair.snd,
  map_one' := perm.subtype_congr.refl,
  map_mul' := λ _ _, (perm.subtype_congr.trans _ _ _ _).symm }

lemma subtype_congr_hom_injective (p : α → Prop) [decidable_pred p] :
  function.injective (subtype_congr_hom p) :=
begin
  rintros ⟨⟩ ⟨⟩ h,
  rw prod.mk.inj_iff,
  split;
  ext i;
  simpa using equiv.congr_fun h i
end

/-- If `e` is also a permutation, we can write `perm_congr`
completely in terms of the group structure. -/
@[simp] lemma perm_congr_eq_mul (e p : perm α) :
  e.perm_congr p = e * p * e⁻¹ := rfl

section extend_domain

/-! Lemmas about `equiv.perm.extend_domain` re-expressed via the group structure. -/

variables (e : perm α) {p : β → Prop} [decidable_pred p] (f : α ≃ subtype p)

@[simp] lemma extend_domain_one : extend_domain 1 f = 1 :=
extend_domain_refl f

@[simp] lemma extend_domain_inv : (e.extend_domain f)⁻¹ = e⁻¹.extend_domain f := rfl

@[simp] lemma extend_domain_mul (e e' : perm α) :
  (e.extend_domain f) * (e'.extend_domain f) = (e * e').extend_domain f :=
extend_domain_trans _ _ _

/-- `extend_domain` as a group homomorphism -/
@[simps] def extend_domain_hom : perm α →* perm β :=
{ to_fun := λ e, extend_domain e f,
  map_one' := extend_domain_one f,
  map_mul' := λ e e', (extend_domain_mul f e e').symm }

lemma extend_domain_hom_injective : function.injective (extend_domain_hom f) :=
(injective_iff_map_eq_one (extend_domain_hom f)).mpr (λ e he, ext (λ x, f.injective (subtype.ext
  ((extend_domain_apply_image e f x).symm.trans (ext_iff.mp he (f x))))))

@[simp]

end extend_domain

/-- If the permutation `f` fixes the subtype `{x // p x}`, then this returns the permutation
  on `{x // p x}` induced by `f`. -/
def subtype_perm (f : perm α) {p : α → Prop} (h : ∀ x, p x ↔ p (f x)) : perm {x // p x} :=
⟨λ x, ⟨f x, (h _).1 x.2⟩, λ x, ⟨f⁻¹ x, (h (f⁻¹ x)).2 $ by simpa using x.2⟩,
  λ _, by simp only [perm.inv_apply_self, subtype.coe_eta, subtype.coe_mk],
  λ _, by simp only [perm.apply_inv_self, subtype.coe_eta, subtype.coe_mk]⟩

@[simp] lemma subtype_perm_apply (f : perm α) {p : α → Prop} (h : ∀ x, p x ↔ p (f x))
  (x : {x // p x}) : subtype_perm f h x = ⟨f x, (h _).1 x.2⟩ := rfl

@[simp] lemma subtype_perm_one (p : α → Prop) (h : ∀ x, p x ↔ p ((1 : perm α) x)) :
  @subtype_perm α 1 p h = 1 :=
equiv.ext $ λ ⟨_, _⟩, rfl

/-- The inclusion map of permutations on a subtype of `α` into permutations of `α`,
  fixing the other points. -/
def of_subtype {p : α → Prop} [decidable_pred p] : perm (subtype p) →* perm α :=
{ to_fun := λ f,
  ⟨λ x, if h : p x then f ⟨x, h⟩ else x, λ x, if h : p x then f⁻¹ ⟨x, h⟩ else x,
  λ x, have h : ∀ h : p x, p (f ⟨x, h⟩), from λ h, (f ⟨x, h⟩).2,
    by { simp only [], split_ifs at *;
         simp only [perm.inv_apply_self, subtype.coe_eta, subtype.coe_mk, not_true, *] at * },
  λ x, have h : ∀ h : p x, p (f⁻¹ ⟨x, h⟩), from λ h, (f⁻¹ ⟨x, h⟩).2,
    by { simp only [], split_ifs at *;
         simp only [perm.apply_inv_self, subtype.coe_eta, subtype.coe_mk, not_true, *] at * }⟩,
  map_one' := begin ext, dsimp, split_ifs; refl, end,
  map_mul' := λ f g, equiv.ext $ λ x, begin
  by_cases h : p x,
  { have h₁ : p (f (g ⟨x, h⟩)), from (f (g ⟨x, h⟩)).2,
    have h₂ : p (g ⟨x, h⟩), from (g ⟨x, h⟩).2,
    simp only [h, h₂, coe_fn_mk, perm.mul_apply, dif_pos, subtype.coe_eta] },
  { simp only [h, coe_fn_mk, perm.mul_apply, dif_neg, not_false_iff] }
end }

lemma of_subtype_subtype_perm {f : perm α} {p : α → Prop} [decidable_pred p]
  (h₁ : ∀ x, p x ↔ p (f x)) (h₂ : ∀ x, f x ≠ x → p x) :
  of_subtype (subtype_perm f h₁) = f :=
equiv.ext $ λ x, begin
  rw [of_subtype, subtype_perm],
  by_cases hx : p x,
  { simp only [hx, coe_fn_mk, dif_pos, monoid_hom.coe_mk, subtype.coe_mk]},
  { haveI := classical.prop_decidable,
    simp only [hx, not_not.mp (mt (h₂ x) hx), coe_fn_mk, dif_neg, not_false_iff,
      monoid_hom.coe_mk] }
end

lemma of_subtype_apply_of_mem {p : α → Prop} [decidable_pred p]
  (f : perm (subtype p)) {x : α} (hx : p x) :
  of_subtype f x = f ⟨x, hx⟩ :=
dif_pos hx

@[simp] lemma of_subtype_apply_coe {p : α → Prop} [decidable_pred p]
  (f : perm (subtype p)) (x : subtype p)  :
  of_subtype f x = f x :=
subtype.cases_on x $ λ _, of_subtype_apply_of_mem f

lemma of_subtype_apply_of_not_mem {p : α → Prop} [decidable_pred p]
  (f : perm (subtype p)) {x : α} (hx : ¬ p x) :
  of_subtype f x = x :=
dif_neg hx

lemma mem_iff_of_subtype_apply_mem {p : α → Prop} [decidable_pred p]
  (f : perm (subtype p)) (x : α) :
  p x ↔ p ((of_subtype f : α → α) x) :=
if h : p x then by simpa only [of_subtype, h, coe_fn_mk, dif_pos, true_iff, monoid_hom.coe_mk]
  using (f ⟨x, h⟩).2
else by simp [h, of_subtype_apply_of_not_mem f h]

@[simp] lemma subtype_perm_of_subtype {p : α → Prop} [decidable_pred p] (f : perm (subtype p)) :
  subtype_perm (of_subtype f) (mem_iff_of_subtype_apply_mem f) = f :=
equiv.ext $ λ ⟨x, hx⟩, by { dsimp [subtype_perm, of_subtype],
  simp only [show p x, from hx, dif_pos, subtype.coe_eta] }

@[simp] lemma default_perm {n : Type*} : (default : perm n) = 1 := rfl

/-- Permutations on a subtype are equivalent to permutations on the original type that fix pointwise
the rest. -/
@[simps] protected def subtype_equiv_subtype_perm (p : α → Prop) [decidable_pred p] :
  perm (subtype p) ≃ {f : perm α // ∀ a, ¬p a → f a = a} :=
{ to_fun := λ f, ⟨f.of_subtype, λ a, f.of_subtype_apply_of_not_mem⟩,
  inv_fun := λ f, (f : perm α).subtype_perm
    (λ a, ⟨decidable.not_imp_not.1 $ λ hfa, (f.val.injective (f.prop _ hfa) ▸ hfa),
    decidable.not_imp_not.1 $ λ ha hfa, ha $ f.prop a ha ▸ hfa⟩),
  left_inv := equiv.perm.subtype_perm_of_subtype,
  right_inv := λ f,
    subtype.ext (equiv.perm.of_subtype_subtype_perm _ $ λ a, not.decidable_imp_symm $ f.prop a) }

lemma subtype_equiv_subtype_perm_apply_of_mem {α : Type*} {p : α → Prop}
  [decidable_pred p] (f : perm (subtype p)) {a : α} (h : p a) :
  perm.subtype_equiv_subtype_perm p f a = f ⟨a, h⟩ :=
f.of_subtype_apply_of_mem h

lemma subtype_equiv_subtype_perm_apply_of_not_mem {α : Type*} {p : α → Prop}
  [decidable_pred p] (f : perm (subtype p)) {a : α} (h : ¬ p a) :
  perm.subtype_equiv_subtype_perm p f a = a :=
f.of_subtype_apply_of_not_mem h

variables (e : perm α) (ι : α ↪ β)

open_locale classical

/-- Noncomputable version of `equiv.perm.via_fintype_embedding` that does not assume `fintype` -/
noncomputable def via_embedding : perm β :=
extend_domain e (of_injective ι.1 ι.2)

lemma via_embedding_apply (x : α) : e.via_embedding ι (ι x) = ι (e x) :=
extend_domain_apply_image e (of_injective ι.1 ι.2) x

lemma via_embedding_apply_of_not_mem (x : β) (hx : x ∉ _root_.set.range ι) :
  e.via_embedding ι x = x :=
extend_domain_apply_not_subtype e (of_injective ι.1 ι.2) hx

/-- `via_embedding` as a group homomorphism -/
noncomputable def via_embedding_hom : perm α →* perm β:=
extend_domain_hom (of_injective ι.1 ι.2)

lemma via_embedding_hom_apply : via_embedding_hom ι e = via_embedding e ι := rfl

lemma via_embedding_hom_injective : function.injective (via_embedding_hom ι) :=
extend_domain_hom_injective (of_injective ι.1 ι.2)

end perm

section swap
variables [decidable_eq α]

@[simp] lemma swap_inv (x y : α) : (swap x y)⁻¹ = swap x y := rfl

@[simp] lemma swap_mul_self (i j : α) : swap i j * swap i j = 1 := swap_swap i j

lemma swap_mul_eq_mul_swap (f : perm α) (x y : α) : swap x y * f = f * swap (f⁻¹ x) (f⁻¹ y) :=
equiv.ext $ λ z, begin
  simp only [perm.mul_apply, swap_apply_def],
  split_ifs;
  simp only [perm.apply_inv_self, *, perm.eq_inv_iff_eq, eq_self_iff_true, not_true] at *
end

lemma mul_swap_eq_swap_mul (f : perm α) (x y : α) : f * swap x y = swap (f x) (f y) * f :=
by rw [swap_mul_eq_mul_swap, perm.inv_apply_self, perm.inv_apply_self]

lemma swap_apply_apply (f : perm α) (x y : α) : swap (f x) (f y) = f * swap x y * f⁻¹ :=
by rw [mul_swap_eq_swap_mul, mul_inv_cancel_right]

/-- Left-multiplying a permutation with `swap i j` twice gives the original permutation.

  This specialization of `swap_mul_self` is useful when using cosets of permutations.
-/
@[simp]
lemma swap_mul_self_mul (i j : α) (σ : perm α) : equiv.swap i j * (equiv.swap i j * σ) = σ :=
by rw [←mul_assoc, swap_mul_self, one_mul]

/-- Right-multiplying a permutation with `swap i j` twice gives the original permutation.

  This specialization of `swap_mul_self` is useful when using cosets of permutations.
-/
@[simp]
lemma mul_swap_mul_self (i j : α) (σ : perm α) : (σ * equiv.swap i j) * equiv.swap i j = σ :=
by rw [mul_assoc, swap_mul_self, mul_one]

/-- A stronger version of `mul_right_injective` -/
@[simp]
lemma swap_mul_involutive (i j : α) : function.involutive ((*) (equiv.swap i j)) :=
swap_mul_self_mul i j

/-- A stronger version of `mul_left_injective` -/
@[simp]
lemma mul_swap_involutive (i j : α) : function.involutive (* (equiv.swap i j)) :=
mul_swap_mul_self i j

@[simp] lemma swap_eq_one_iff {i j : α} : swap i j = (1 : perm α) ↔ i = j :=
swap_eq_refl_iff

lemma swap_mul_eq_iff {i j : α} {σ : perm α} : swap i j * σ = σ ↔ i = j :=
⟨(assume h, have swap_id : swap i j = 1 := mul_right_cancel (trans h (one_mul σ).symm),
  by {rw [←swap_apply_right i j, swap_id], refl}),
(assume h, by erw [h, swap_self, one_mul])⟩

lemma mul_swap_eq_iff {i j : α} {σ : perm α} : σ * swap i j = σ ↔ i = j :=
⟨(assume h, have swap_id : swap i j = 1 := mul_left_cancel (trans h (one_mul σ).symm),
  by {rw [←swap_apply_right i j, swap_id], refl}),
(assume h, by erw [h, swap_self, mul_one])⟩

lemma swap_mul_swap_mul_swap {x y z : α} (hwz: x ≠ y) (hxz : x ≠ z) :
  swap y z * swap x y * swap y z = swap z x :=
equiv.ext $ λ n, by { simp only [swap_apply_def, perm.mul_apply], split_ifs; cc }

end swap

end equiv


/-
Copyright (c) 2022 Michael Stoll. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Stoll
-/
import data.fin.tuple.sort
import data.fintype.perm
import order.well_founded

/-!
# "Bubble sort" induction

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

We implement the following induction principle `tuple.bubble_sort_induction`
on tuples with values in a linear order `α`.

Let `f : fin n → α` and let `P` be a predicate on `fin n → α`. Then we can show that
`f ∘ sort f` satisfies `P` if `f` satisfies `P`, and whenever some `g : fin n → α`
satisfies `P` and `g i > g j` for some `i < j`, then `g ∘ swap i j` also satisfies `P`.

We deduce it from a stronger variant `tuple.bubble_sort_induction'`, which
requires the assumption only for `g` that are permutations of `f`.

The latter is proved by well-founded induction via `well_founded.induction_bot'`
with respect to the lexicographic ordering on the finite set of all permutations of `f`.
-/

namespace tuple

/-- *Bubble sort induction*: Prove that the sorted version of `f` has some property `P`
if `f` satsifies `P` and `P` is preserved on permutations of `f` when swapping two
antitone values. -/
lemma bubble_sort_induction' {n : ℕ} {α : Type*} [linear_order α] {f : fin n → α}
  {P : (fin n → α) → Prop} (hf : P f)
  (h : ∀ (σ : equiv.perm (fin n)) (i j : fin n),
              i < j → (f ∘ σ) j < (f ∘ σ) i → P (f ∘ σ) → P (f ∘ σ ∘ equiv.swap i j)) :
  P (f ∘ sort f) :=
begin
  letI := @preorder.lift _ (lex (fin n → α)) _ (λ σ : equiv.perm (fin n), to_lex (f ∘ σ)),
  refine @well_founded.induction_bot' _ _ _
    (@finite.preorder.well_founded_lt (equiv.perm (fin n)) _ _)
    (equiv.refl _) (sort f) P (λ σ, f ∘ σ) (λ σ hσ hfσ, _) hf,
  obtain ⟨i, j, hij₁, hij₂⟩ := antitone_pair_of_not_sorted' hσ,
  exact ⟨σ * equiv.swap i j, pi.lex_desc hij₁ hij₂, h σ i j hij₁ hij₂ hfσ⟩,
end

/-- *Bubble sort induction*: Prove that the sorted version of `f` has some property `P`
if `f` satsifies `P` and `P` is preserved when swapping two antitone values. -/
lemma bubble_sort_induction {n : ℕ} {α : Type*} [linear_order α] {f : fin n → α}
  {P : (fin n → α) → Prop} (hf : P f)
  (h : ∀ (g : fin n → α) (i j : fin n), i < j → g j < g i → P g → P (g ∘ equiv.swap i j)) :
  P (f ∘ sort f) :=
bubble_sort_induction' hf (λ σ, h _)

end tuple


import .love09_hoare_logic_demo

/-! # LoVe Exercise 9: Hoare Logic -/

set_option pp.beta true

namespace LoVe

/-! ## Question 1: Program Verification

The following WHILE program is intended to compute the Gaussian sum up to `n`,
leaving the result in `r`. -/

def GAUSS : stmt :=
stmt.assign "r" (λs, 0) ;;
stmt.while (λs, s "n" ≠ 0)
  (stmt.assign "r" (λs, s "r" + s "n") ;;
   stmt.assign "n" (λs, s "n" - 1))

/-! The summation function: -/

def sum_upto : ℕ → ℕ
| 0       := 0
| (n + 1) := n + 1 + sum_upto n

/-! 1.1. Prove the correctness of `GAUSS` using `vcg`. The main challenge is to
figure out which invariant to use for the while loop. The invariant should
capture both the work that has been done already (the intermediate result) and
the work that remains to be done. -/

lemma GAUSS_correct (n₀ : ℕ) :
    {* λs, s "n" = n₀ *} GAUSS {* λs, s "r" = sum_upto n₀ *} :=
show {* λs, s "n" = n₀ *}
  stmt.assign "r" (λs, 0) ;;
  stmt.while_inv (λ s, (sum_upto (s "n")) + s "r" ==  sum_upto n₀ )
    (λs, s "n" ≠ 0)
    (stmt.assign "r" (λs, s "r" + s "n") ;;
    stmt.assign "n" (λs, s "n" - 1))
    {* λs, s "r" = sum_upto n₀ *}, from
begin
  vcg; simp {contextual := tt},
  {
    intros s hinv hloop,
    rw <- hinv,
    have h: (sum_upto (s "n" - 1)) + s "n" = sum_upto (s "n"), by {
      cases (s "n"),
      { triv,},
      {
        have h2: sum_upto(n.succ - 1) == sum_upto n, by {
            simp,
        },
        simp [h2, sum_upto],
        have h3: (sum_upto n) + n.succ = (sum_upto n) + (n + 1), by {
          have h4: n.succ = n + 1, by { simp },
          simp [h4],
        },
        simp [h3],
        cc,
      }
    },
    rw <- h,
    cc,
  },
  {
    intros s hinv hloop,
    rw <- hloop,
    unfold sum_upto,
    finish,
  }
end

/-! 1.2. The following WHILE program is intended to compute the product of `n`
and `m`, leaving the result in `r`. Prove its correctness using `vcg`.

Hint: If a variable `x` does not change in a program, it might be useful to
record this in the invariant, by adding a conjunct `s "x" = x₀`. -/

def MUL : stmt :=
stmt.assign "r" (λs, 0) ;;
stmt.while (λs, s "n" ≠ 0)
  (stmt.assign "r" (λs, s "r" + s "m") ;;
   stmt.assign "n" (λs, s "n" - 1))

lemma MUL_correct (n₀ m₀ : ℕ) :
  {* λs, s "n" = n₀ ∧ s "m" = m₀ *} MUL {* λs, s "r" = n₀ * m₀ *} :=
sorry

/-! ## Question 2: Hoare Triples for Total Correctness -/

def total_hoare (P : state → Prop) (S : stmt) (Q : state → Prop) : Prop :=
∀s, P s → ∃t, (S, s) ⟹ t ∧ Q t
#print total_hoare

notation `[* ` P : 1 ` *] ` S : 1 ` [* ` Q : 1 ` *]` :=
total_hoare P S Q

namespace total_hoare

/-! 2.1. Prove the consequence rule. -/

lemma consequence {P P' Q Q' : state → Prop} {S}
    (hS : [* P *] S [* Q *]) (hP : ∀s, P' s → P s) (hQ : ∀s, Q s → Q' s) :
  [* P' *] S [* Q' *] :=
begin
    intro s,
    intro hps,
    cases hS s (hP s hps),
    use w,
    cases h,
    tautology,
end

/-! 2.2. Prove the rule for `skip`. -/

lemma skip_intro {P} :
  [* P *] stmt.skip [* P *] :=
sorry

/-! 2.3. Prove the rule for `assign`. -/

lemma assign_intro {P : state → Prop} {x} {a : state → ℕ} :
  [* λs, P (s{x ↦ a s}) *] stmt.assign x a [* P *] :=
sorry

/-! 2.4. Prove the rule for `seq`. -/

lemma seq_intro {P Q R S T} (hS : [* P *] S [* Q *]) (hT : [* Q *] T [* R *]) :
  [* P *] S ;; T [* R *] :=
sorry

/-! 2.5. Complete the proof of the rule for `ite`.

Hint: This requires a case distinction on the truth value of `b s`. -/

lemma ite_intro {b P Q : state → Prop} {S T}
    (hS : [* λs, P s ∧ b s *] S [* Q *])
    (hT : [* λs, P s ∧ ¬ b s *] T [* Q *]) :
  [* P *] stmt.ite b S T [* Q *] :=
sorry

/-! 2.6 (**optional**). Try to prove the rule for `while`.

The rule is parameterized by a loop invariant `I` and by a variant `V` that
decreases with each iteration of the loop body.

Before we prove the desired lemma, we introduce an auxiliary lemma. Its proof
requires well-founded induction. When using `while_intro.aux` as induction
hypothesis we recommend to do it directly after proving that the argument is
less than `v₀`:

    have ih : ∃u, (stmt.while b S, t) ⟹ u ∧ I u ∧ ¬ b u :=
      have V t < v₀ :=
        …,
      while_intro.aux (V t) …,

Similarly to `ite`, the proof requires a case distinction on `b s ∨ ¬ b s`. -/

lemma while_intro.aux {b : state → Prop} (I : state → Prop) (V : state → ℕ) {S}
  (h_inv : ∀v₀, [* λs, I s ∧ b s ∧ V s = v₀ *] S [* λs, I s ∧ V s < v₀ *]) :
  ∀v₀ s, V s = v₀ → I s → ∃t, (stmt.while b S, s) ⟹ t ∧ I t ∧ ¬ b t
| v₀ s V_eq hs :=
sorry

lemma while_intro {b : state → Prop} (I : state → Prop) (V : state → ℕ) {S}
  (hinv : ∀v₀, [* λs, I s ∧ b s ∧ V s = v₀ *] S [* λs, I s ∧ V s < v₀ *]) :
  [* I *] stmt.while b S [* λs, I s ∧ ¬ b s *] :=
sorry

end total_hoare

end LoVe


import data.real.basic
import data.set.basic
import tactic

namespace mth1001

/-
We'll only deal with real-valued sequences. Such a sequence is merely a function from `ℕ` to `ℝ`
We'll use the Lean built-in real number type rather than the type we've constructed.
-/

section convergence

-- `convergesto f a` means
def convergesto (f : ℕ → ℝ) (a : ℝ) := ∀ ε > 0, ∃ N, ∀ n ≥ N, abs (f n - a) < ε

/-
We'll prove that the sequence `f₁ : ℕ → R` given by `f₁(n) = 5` converges to `5`.
-/

def f₁ : ℕ → ℝ := λ n, (5 : ℝ)

example : convergesto f₁ 5 :=
begin
  assume ε : ℝ,
  assume εpos : ε > 0, -- It suffices to prove `∃ N, ∀ n ≥ N, abs (f₁ n - 5) < ε`.
  use 1, -- Take `N := 1`.
  assume n : ℕ,
  assume hn : n ≥ 1,
  unfold f₁, -- By unfolding, it suffices to show `abs (5 - 5) < ε`.
  norm_num, -- That is, to prove `abs 0 < ε`.
  linarith, -- This is proven by the `linarith` tactic.
end

/-
More generally, we'll show a constant sequence converges.
-/

-- Exercise 075:
lemma convergesto_const (c : ℝ) : convergesto (λ n, c) c :=
begin
  assume ε : ℝ,
  assume εpos : ε > 0,
  sorry
end

end convergence

section uniqueness_of_limits

variables {f : ℕ → ℝ} {a b : ℝ}

lemma convergesto_unique (h₁ : convergesto f a) (h₂ : convergesto f b) : a = b :=
begin
  sorry
end

end uniqueness_of_limits

section algebra_of_limits

variables (f g : ℕ → ℝ) -- `f` and `g` are sequences
variables (a b c : ℝ)

-- The following result will often come in handy!
lemma div_abs_pos_of_pos_of_non_zero {ε c : ℝ} (εpos : ε > 0) (h : c ≠ 0) : ε / abs c > 0 :=
begin
  have h₂ : 0 < abs c, from  abs_pos_iff.mpr h,
  have h₃ : 0 < (abs c)⁻¹, from inv_pos.mpr h₂,
  exact mul_pos εpos h₃,
end

example (a b c : ℝ) (h₁ : a < b / c) (h₂ : 0 < c): a * c < b := (lt_div_iff h₂).mp h₁

example (a b : ℝ) : abs (a*b) = abs a * abs b := abs_mul a b

example (x y : ℝ) : x ≤ max x y := le_max_left x y

example (x y : ℝ) : y ≤ max x y := le_max_right x y

-- Exercise 076:
theorem convergesto_scalar_mul (h : convergesto f a) : convergesto (λ n, c * (f n)) (c * a) :=
begin
  by_cases h₂ : c = 0,
  { sorry, },
  { sorry, },
end

-- Here is the triangle inequality in Lean.
example (x y : ℝ) : abs (x + y) ≤ abs x + abs y := abs_add x y

-- Exercise 077:
theorem convergesto_add (h₁ : convergesto f a) (h₂ : convergesto g b )
: convergesto (λ n, f n + g n) (a + b) :=
begin
  sorry
end

-- Exercise 078:
-- The same proof can be written more briefly using `congr'` and by giving arguments to `linarith`.
example (h₁ : convergesto f a) (h₂ : convergesto g b ) : convergesto (λ n, f n + g n) (a + b) :=
begin
  sorry
end

end algebra_of_limits

section specific_example

/-
In Lean, it's often harder to work with particular examples than with general theorems.
Here, we show convergence of a particular sequence.

We'll need the corollorary to the Archimedean property. In Lean,this is `exists_nat_one_div_lt`.
Note the use of `↑n` to indicate the embedding (or coercion) of the natural number `n`
as a real number.
-/

example (ε : ℝ) (h : 0 < ε) : ∃ n : ℕ, 1/(↑n + 1) < ε := exists_nat_one_div_lt h

example (x : ℝ) (h : x > 0) : abs x = x := abs_of_pos h

example (x : ℝ) (h : 0 < x) : 0 < x⁻¹ := by {rwa inv_pos}

example (x : ℝ) (h : 0 < x) : x⁻¹ = (1 : ℝ) / x := inv_eq_one_div x

-- Now we'll show the sequence given by `λ n, 3 + 1/n` converges to `3`.
example : convergesto (λ n, 3 + 1/n) 3 :=
begin
  unfold convergesto,
  assume ε εpos,
  have h : ∃ N : ℕ, 1/(↑N + 1) < ε, from exists_nat_one_div_lt εpos,
  cases h with N hN, -- By `∃` elim. on `h`, STP the goal assuming `N : ℕ` and `hN : 1/(↑N+1) < ε`.
  use N + 1, -- By `∃` intro on `N + 1`, it suffices to prove
  -- `∀ n ≥ N + 1, n ≥ N + 1 → abs (3 + 1/↑n - 3) < ε`.
  assume n hn, -- assume `n : ℕ` and `hn : n ≥ N`.
  have h₂ : abs ((3 : ℝ) + 1 / ↑n - 3)  = abs (↑n)⁻¹, ring,
  rw h₂,
  have : N + 1 > 0, linarith,
  have : n > 0, linarith,
  have :  (0 : ℝ) < ↑n, { rwa nat.cast_pos },
  have : (0 : ℝ) < N + 1, {change (0 : ℝ) < ↑(N + 1), rw nat.cast_pos, linarith, },
  have : (0 : ℝ) < (↑n)⁻¹, { rwa inv_pos },
  rw abs_of_pos this,
  have : (↑n)⁻¹ ≤ (↑N + (1 : ℝ))⁻¹,
  { rw inv_le_inv,
    change ↑(N + 1) ≤ ↑n,
    rwa nat.cast_le,
    repeat { assumption }, },
  apply lt_of_le_of_lt,
  { assumption, },
  { rwa inv_eq_one_div, },
end

end specific_example

end mth1001


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl
Ported by: Scott Morrison

! This file was ported from Lean 3 source module algebra.order.group.order_iso
! leanprover-community/mathlib commit a95b16cbade0f938fc24abd05412bde1e84bab9b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Group.Defs
import Mathlib.Algebra.Hom.Equiv.Units.Basic

/-!
# Inverse and multiplication as order isomorphisms in ordered groups

-/

open Function

universe u

variable {α : Type u}

section Group

variable [Group α]

section TypeclassesLeftRightLE

variable [LE α] [CovariantClass α α (· * ·) (· ≤ ·)] [CovariantClass α α (swap (· * ·)) (· ≤ ·)]
  {a b c d : α}

section

variable (α)

/-- `x ↦ x⁻¹` as an order-reversing equivalence. -/
@[to_additive (attr := simps!) "`x ↦ -x` as an order-reversing equivalence."]
def OrderIso.inv : α ≃o αᵒᵈ where
  toEquiv := (Equiv.inv α).trans OrderDual.toDual
  map_rel_iff' {_ _} := @inv_le_inv_iff α _ _ _ _ _ _
#align order_iso.inv OrderIso.inv
#align order_iso.neg OrderIso.neg
#align order_iso.inv_apply OrderIso.inv_apply
#align order_iso.inv_symm_apply OrderIso.inv_symm_apply

end

@[to_additive neg_le]
theorem inv_le' : a⁻¹ ≤ b ↔ b⁻¹ ≤ a :=
  (OrderIso.inv α).symm_apply_le
#align inv_le' inv_le'
#align neg_le neg_le

alias inv_le' ↔ inv_le_of_inv_le' _
#align inv_le_of_inv_le' inv_le_of_inv_le'

attribute [to_additive neg_le_of_neg_le] inv_le_of_inv_le'
#align neg_le_of_neg_le neg_le_of_neg_le

@[to_additive le_neg]
theorem le_inv' : a ≤ b⁻¹ ↔ b ≤ a⁻¹ :=
  (OrderIso.inv α).le_symm_apply
#align le_inv' le_inv'
#align le_neg le_neg

end TypeclassesLeftRightLE

end Group

alias le_inv' ↔ le_inv_of_le_inv _
#align le_inv_of_le_inv le_inv_of_le_inv

attribute [to_additive] le_inv_of_le_inv
#align le_neg_of_le_neg le_neg_of_le_neg

section Group

variable [Group α] [LE α]

section Right

variable [CovariantClass α α (swap (· * ·)) (· ≤ ·)] {a b c d : α}

/-- `Equiv.mulRight` as an `OrderIso`. See also `OrderEmbedding.mulRight`. -/
@[to_additive (attr := simps! (config := { simpRhs := true }) toEquiv apply)
  "`Equiv.addRight` as an `OrderIso`. See also `OrderEmbedding.addRight`."]
def OrderIso.mulRight (a : α) : α ≃o α where
  map_rel_iff' {_ _} := mul_le_mul_iff_right a
  toEquiv := Equiv.mulRight a
#align order_iso.mul_right OrderIso.mulRight
#align order_iso.add_right OrderIso.addRight
#align order_iso.mul_right_apply OrderIso.mulRight_apply
#align order_iso.mul_right_to_equiv OrderIso.mulRight_toEquiv

@[to_additive (attr := simp)]
theorem OrderIso.mulRight_symm (a : α) : (OrderIso.mulRight a).symm = OrderIso.mulRight a⁻¹ := by
  ext x
  rfl
#align order_iso.mul_right_symm OrderIso.mulRight_symm
#align order_iso.add_right_symm OrderIso.addRight_symm

end Right

section Left

variable [CovariantClass α α (· * ·) (· ≤ ·)]

/-- `Equiv.mulLeft` as an `OrderIso`. See also `OrderEmbedding.mulLeft`. -/
@[to_additive (attr := simps! (config := { simpRhs := true }) toEquiv apply)
  "`Equiv.addLeft` as an `OrderIso`. See also `OrderEmbedding.addLeft`."]
def OrderIso.mulLeft (a : α) : α ≃o α where
  map_rel_iff' {_ _} := mul_le_mul_iff_left a
  toEquiv := Equiv.mulLeft a
#align order_iso.mul_left OrderIso.mulLeft
#align order_iso.add_left OrderIso.addLeft
#align order_iso.mul_left_apply OrderIso.mulLeft_apply
#align order_iso.add_left_apply OrderIso.addLeft_apply
#align order_iso.add_left_to_equiv OrderIso.addLeft_toEquiv

@[to_additive (attr := simp)]
theorem OrderIso.mulLeft_symm (a : α) : (OrderIso.mulLeft a).symm = OrderIso.mulLeft a⁻¹ := by
  ext x
  rfl
#align order_iso.mul_left_symm OrderIso.mulLeft_symm
#align order_iso.add_left_symm OrderIso.addLeft_symm

end Left

end Group


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import analysis.asymptotics.asymptotics
import analysis.normed_space.ordered

/-!
# Asymptotic equivalence

In this file, we define the relation `is_equivalent l u v`, which means that `u-v` is little o of
`v` along the filter `l`.

Unlike `is_[oO]` relations, this one requires `u` and `v` to have the same codomain `β`. While the
definition only requires `β` to be a `normed_group`, most interesting properties require it to be a
`normed_field`.

## Notations

We introduce the notation `u ~[l] v := is_equivalent l u v`, which you can use by opening the
`asymptotics` locale.

## Main results

If `β` is a `normed_group` :

- `_ ~[l] _` is an equivalence relation
- Equivalent statements for `u ~[l] const _ c` :
  - If `c ≠ 0`, this is true iff `tendsto u l (𝓝 c)` (see `is_equivalent_const_iff_tendsto`)
  - For `c = 0`, this is true iff `u =ᶠ[l] 0` (see `is_equivalent_zero_iff_eventually_zero`)

If `β` is a `normed_field` :

- Alternative characterization of the relation (see `is_equivalent_iff_exists_eq_mul`) :

  `u ~[l] v ↔ ∃ (φ : α → β) (hφ : tendsto φ l (𝓝 1)), u =ᶠ[l] φ * v`

- Provided some non-vanishing hypothesis, this can be seen as `u ~[l] v ↔ tendsto (u/v) l (𝓝 1)`
  (see `is_equivalent_iff_tendsto_one`)
- For any constant `c`, `u ~[l] v` implies `tendsto u l (𝓝 c) ↔ tendsto v l (𝓝 c)`
  (see `is_equivalent.tendsto_nhds_iff`)
- `*` and `/` are compatible with `_ ~[l] _` (see `is_equivalent.mul` and `is_equivalent.div`)

If `β` is a `normed_linear_ordered_field` :

- If `u ~[l] v`, we have `tendsto u l at_top ↔ tendsto v l at_top`
  (see `is_equivalent.tendsto_at_top_iff`)

## Implementation Notes

Note that `is_equivalent` takes the parameters `(l : filter α) (u v : α → β)` in that order.
This is to enable `calc` support, as `calc` requires that the last two explicit arguments are `u v`.

-/

namespace asymptotics

open filter function
open_locale topological_space

section normed_group

variables {α β : Type*} [normed_group β]

/-- Two functions `u` and `v` are said to be asymptotically equivalent along a filter `l` when
    `u x - v x = o(v x)` as x converges along `l`. -/
def is_equivalent (l : filter α) (u v : α → β) := (u - v) =o[l] v

localized "notation u ` ~[`:50 l:50 `] `:0 v:50 := asymptotics.is_equivalent l u v" in asymptotics

variables {u v w : α → β} {l : filter α}

lemma is_equivalent.is_o (h : u ~[l] v) : (u - v) =o[l] v := h

lemma is_equivalent.is_O (h : u ~[l] v) : u =O[l] v :=
(is_O.congr_of_sub h.is_O.symm).mp (is_O_refl _ _)

lemma is_equivalent.is_O_symm (h : u ~[l] v) : v =O[l] u :=
begin
  convert h.is_o.right_is_O_add,
  ext,
  simp
end

@[refl] lemma is_equivalent.refl : u ~[l] u :=
begin
  rw [is_equivalent, sub_self],
  exact is_o_zero _ _
end

@[symm] lemma is_equivalent.symm (h : u ~[l] v) : v ~[l] u :=
(h.is_o.trans_is_O h.is_O_symm).symm

@[trans] lemma is_equivalent.trans {l : filter α} {u v w : α → β}
  (huv : u ~[l] v) (hvw : v ~[l] w) : u ~[l] w :=
(huv.is_o.trans_is_O hvw.is_O).triangle hvw.is_o

lemma is_equivalent.congr_left {u v w : α → β} {l : filter α} (huv : u ~[l] v)
  (huw : u =ᶠ[l] w) : w ~[l] v :=
huv.congr' (huw.sub (eventually_eq.refl _ _)) (eventually_eq.refl _ _)

lemma is_equivalent.congr_right {u v w : α → β} {l : filter α} (huv : u ~[l] v)
  (hvw : v =ᶠ[l] w) : u ~[l] w :=
(huv.symm.congr_left hvw).symm

lemma is_equivalent_zero_iff_eventually_zero : u ~[l] 0 ↔ u =ᶠ[l] 0 :=
begin
  rw [is_equivalent, sub_zero],
  exact is_o_zero_right_iff
end

lemma is_equivalent_zero_iff_is_O_zero : u ~[l] 0 ↔ u =O[l] (0 : α → β) :=
begin
  refine ⟨is_equivalent.is_O, λ h, _⟩,
  rw [is_equivalent_zero_iff_eventually_zero, eventually_eq_iff_exists_mem],
  exact ⟨{x : α | u x = 0}, is_O_zero_right_iff.mp h, λ x hx, hx⟩,
end

lemma is_equivalent_const_iff_tendsto {c : β} (h : c ≠ 0) : u ~[l] const _ c ↔ tendsto u l (𝓝 c) :=
begin
  rw [is_equivalent, is_o_const_iff h],
  split; intro h;
  [ { have := h.sub tendsto_const_nhds, rw zero_sub (-c) at this },
    { have := h.sub tendsto_const_nhds, rw ← sub_self c} ];
  convert this; try { ext }; simp
end

lemma is_equivalent.tendsto_const {c : β} (hu : u ~[l] const _ c) : tendsto u l (𝓝 c) :=
begin
  rcases (em $ c = 0) with ⟨rfl, h⟩,
  { exact (tendsto_congr' $ is_equivalent_zero_iff_eventually_zero.mp hu).mpr tendsto_const_nhds },
  { exact (is_equivalent_const_iff_tendsto h).mp hu }
end

lemma is_equivalent.tendsto_nhds_iff {c : β} (huv : u ~[l] v) :
  tendsto u l (𝓝 c) ↔ tendsto v l (𝓝 c) := ⟨huv.tendsto_nhds, huv.symm.tendsto_nhds⟩

lemma is_equivalent.add_is_o (huv : u ~[l] v) (hwv : w =o[l] v) : (w + u) ~[l] v :=
by simpa only [is_equivalent, pi.sub_apply, add_sub] using hwv.add huv

lemma is_o.add_is_equivalent (hu : u =o[l] w) (hv : v ~[l] w) : (u + v) ~[l] w :=
add_comm u v ▸ hv.add_is_o hu

lemma is_o.is_equivalent (huv : (u - v) =o[l] v) : u ~[l] v := huv

lemma is_equivalent.neg (huv : u ~[l] v) : (λ x, - u x) ~[l] (λ x, - v x) :=
begin
  rw is_equivalent,
  convert huv.is_o.neg_left.neg_right,
  ext,
  simp,
end

end normed_group

open_locale asymptotics

section normed_field

variables {α β : Type*} [normed_field β] {t u v w : α → β} {l : filter α}

lemma is_equivalent_iff_exists_eq_mul : u ~[l] v ↔
  ∃ (φ : α → β) (hφ : tendsto φ l (𝓝 1)), u =ᶠ[l] φ * v :=
begin
  rw [is_equivalent, is_o_iff_exists_eq_mul],
  split; rintros ⟨φ, hφ, h⟩; [use (φ + 1), use (φ - 1)]; split,
  { conv in (𝓝 _) { rw ← zero_add (1 : β) },
    exact hφ.add (tendsto_const_nhds) },
  { convert h.add (eventually_eq.refl l v); ext; simp [add_mul] },
  { conv in (𝓝 _) { rw ← sub_self (1 : β) },
    exact hφ.sub (tendsto_const_nhds) },
  { convert h.sub (eventually_eq.refl l v); ext; simp [sub_mul] }
end

lemma is_equivalent.exists_eq_mul (huv : u ~[l] v) :
  ∃ (φ : α → β) (hφ : tendsto φ l (𝓝 1)), u =ᶠ[l] φ * v :=
is_equivalent_iff_exists_eq_mul.mp huv

lemma is_equivalent_of_tendsto_one (hz : ∀ᶠ x in l, v x = 0 → u x = 0)
  (huv : tendsto (u/v) l (𝓝 1)) : u ~[l] v :=
begin
  rw is_equivalent_iff_exists_eq_mul,
  refine ⟨u/v, huv, hz.mono $ λ x hz', (div_mul_cancel_of_imp hz').symm⟩,
end

lemma is_equivalent_of_tendsto_one' (hz : ∀ x, v x = 0 → u x = 0) (huv : tendsto (u/v) l (𝓝 1)) :
  u ~[l] v :=
is_equivalent_of_tendsto_one (eventually_of_forall hz) huv

lemma is_equivalent_iff_tendsto_one (hz : ∀ᶠ x in l, v x ≠ 0) :
  u ~[l] v ↔ tendsto (u/v) l (𝓝 1) :=
begin
  split,
  { intro hequiv,
    have := hequiv.is_o.tendsto_div_nhds_zero,
    simp only [pi.sub_apply, sub_div] at this,
    have key : tendsto (λ x, v x / v x) l (𝓝 1),
    { exact (tendsto_congr' $ hz.mono $ λ x hnz, @div_self _ _ (v x) hnz).mpr tendsto_const_nhds },
    convert this.add key,
    { ext, simp },
    { norm_num } },
  { exact is_equivalent_of_tendsto_one (hz.mono $ λ x hnvz hz, (hnvz hz).elim) }
end

end normed_field

section smul

lemma is_equivalent.smul {α E 𝕜 : Type*} [normed_field 𝕜] [normed_group E]
  [normed_space 𝕜 E] {a b : α → 𝕜} {u v : α → E} {l : filter α} (hab : a ~[l] b) (huv : u ~[l] v) :
  (λ x, a x • u x) ~[l] (λ x, b x • v x) :=
begin
  rcases hab.exists_eq_mul with ⟨φ, hφ, habφ⟩,
  have : (λ (x : α), a x • u x) - (λ (x : α), b x • v x) =ᶠ[l] λ x, b x • ((φ x • u x) - v x),
  { convert (habφ.comp₂ (•) $ eventually_eq.refl _ u).sub (eventually_eq.refl _ (λ x, b x • v x)),
    ext,
    rw [pi.mul_apply, mul_comm, mul_smul, ← smul_sub] },
  refine (is_o_congr this.symm $ eventually_eq.rfl).mp ((is_O_refl b l).smul_is_o _),

  rcases huv.is_O.exists_pos with ⟨C, hC, hCuv⟩,
  rw is_equivalent at *,
  rw is_o_iff at *,
  rw is_O_with at hCuv,
  simp only [metric.tendsto_nhds, dist_eq_norm] at hφ,
  intros c hc,
  specialize hφ ((c/2)/C) (div_pos (by linarith) hC),
  specialize huv (show 0 < c/2, by linarith),
  refine hφ.mp (huv.mp $ hCuv.mono $ λ x hCuvx huvx hφx, _),

  have key :=
    calc ∥φ x - 1∥ * ∥u x∥
            ≤ (c/2) / C * ∥u x∥ : mul_le_mul_of_nonneg_right hφx.le (norm_nonneg $ u x)
        ... ≤ (c/2) / C * (C*∥v x∥) : mul_le_mul_of_nonneg_left hCuvx (div_pos (by linarith) hC).le
        ... = c/2 * ∥v x∥ : by {field_simp [hC.ne.symm], ring},

  calc ∥((λ (x : α), φ x • u x) - v) x∥
          = ∥(φ x - 1) • u x + (u x - v x)∥ : by simp [sub_smul, sub_add]
      ... ≤ ∥(φ x - 1) • u x∥ + ∥u x - v x∥ : norm_add_le _ _
      ... = ∥φ x - 1∥ * ∥u x∥ + ∥u x - v x∥ : by rw norm_smul
      ... ≤ c / 2 * ∥v x∥ + ∥u x - v x∥ : add_le_add_right key _
      ... ≤ c / 2 * ∥v x∥ + c / 2 * ∥v x∥ : add_le_add_left huvx _
      ... = c * ∥v x∥ : by ring,
end

end smul

section mul_inv

variables {α β : Type*} [normed_field β] {t u v w : α → β} {l : filter α}

lemma is_equivalent.mul (htu : t ~[l] u) (hvw : v ~[l] w) : t * v ~[l] u * w :=
htu.smul hvw

lemma is_equivalent.inv (huv : u ~[l] v) : (λ x, (u x)⁻¹) ~[l] (λ x, (v x)⁻¹) :=
begin
  rw is_equivalent_iff_exists_eq_mul at *,
  rcases huv with ⟨φ, hφ, h⟩,
  rw ← inv_one,
  refine ⟨λ x, (φ x)⁻¹, tendsto.inv₀ hφ (by norm_num) , _⟩,
  convert h.inv,
  ext,
  simp [mul_inv]
end

lemma is_equivalent.div (htu : t ~[l] u) (hvw : v ~[l] w) :
  (λ x, t x / v x) ~[l] (λ x, u x / w x) :=
by simpa only [div_eq_mul_inv] using htu.mul hvw.inv

end mul_inv

section normed_linear_ordered_field

variables {α β : Type*} [normed_linear_ordered_field β] {u v : α → β} {l : filter α}

lemma is_equivalent.tendsto_at_top [order_topology β] (huv : u ~[l] v) (hu : tendsto u l at_top) :
  tendsto v l at_top :=
let ⟨φ, hφ, h⟩ := huv.symm.exists_eq_mul in
tendsto.congr' h.symm ((mul_comm u φ) ▸ (hu.at_top_mul zero_lt_one hφ))

lemma is_equivalent.tendsto_at_top_iff [order_topology β] (huv : u ~[l] v) :
  tendsto u l at_top ↔ tendsto v l at_top := ⟨huv.tendsto_at_top, huv.symm.tendsto_at_top⟩

lemma is_equivalent.tendsto_at_bot [order_topology β] (huv : u ~[l] v) (hu : tendsto u l at_bot) :
  tendsto v l at_bot :=
begin
  convert tendsto_neg_at_top_at_bot.comp
    (huv.neg.tendsto_at_top $ tendsto_neg_at_bot_at_top.comp hu),
  ext,
  simp
end

lemma is_equivalent.tendsto_at_bot_iff [order_topology β] (huv : u ~[l] v) :
  tendsto u l at_bot ↔ tendsto v l at_bot := ⟨huv.tendsto_at_bot, huv.symm.tendsto_at_bot⟩

end normed_linear_ordered_field

end asymptotics

open filter asymptotics
open_locale asymptotics

variables {α β : Type*} [normed_group β]

lemma filter.eventually_eq.is_equivalent {u v : α → β} {l : filter α} (h : u =ᶠ[l] v) : u ~[l] v :=
is_equivalent.congr_right (is_o_refl_left _ _) h


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.calculus.mean_value
import Mathlib.data.nat.parity
import Mathlib.analysis.special_functions.pow
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Collection of convex functions

In this file we prove that the following functions are convex:

* `convex_on_exp` : the exponential function is convex on $(-∞, +∞)$;
* `convex_on_pow_of_even` : given an even natural number $n$, the function $f(x)=x^n$
  is convex on $(-∞, +∞)$;
* `convex_on_pow` : for a natural $n$, the function $f(x)=x^n$ is convex on $[0, +∞)$;
* `convex_on_fpow` : for an integer $m$, the function $f(x)=x^m$ is convex on $(0, +∞)$.
* `convex_on_rpow : ∀ p : ℝ, 1 ≤ p → convex_on (Ici 0) (λ x, x ^ p)`
* `concave_on_log_Ioi` and `concave_on_log_Iio`: log is concave on `Ioi 0` and `Iio 0` respectively.
-/

/-- `exp` is convex on the whole real line -/
theorem convex_on_exp : convex_on set.univ real.exp := sorry

/-- `x^n`, `n : ℕ` is convex on the whole real line whenever `n` is even -/
theorem convex_on_pow_of_even {n : ℕ} (hn : even n) : convex_on set.univ fun (x : ℝ) => x ^ n := sorry

/-- `x^n`, `n : ℕ` is convex on `[0, +∞)` for all `n` -/
theorem convex_on_pow (n : ℕ) : convex_on (set.Ici 0) fun (x : ℝ) => x ^ n := sorry

theorem finset.prod_nonneg_of_card_nonpos_even {α : Type u_1} {β : Type u_2} [linear_ordered_comm_ring β] {f : α → β} [decidable_pred fun (x : α) => f x ≤ 0] {s : finset α} (h0 : even (finset.card (finset.filter (fun (x : α) => f x ≤ 0) s))) : 0 ≤ finset.prod s fun (x : α) => f x := sorry

theorem int_prod_range_nonneg (m : ℤ) (n : ℕ) (hn : even n) : 0 ≤ finset.prod (finset.range n) fun (k : ℕ) => m - ↑k := sorry

/-- `x^m`, `m : ℤ` is convex on `(0, +∞)` for all `m` -/
theorem convex_on_fpow (m : ℤ) : convex_on (set.Ioi 0) fun (x : ℝ) => x ^ m := sorry

theorem convex_on_rpow {p : ℝ} (hp : 1 ≤ p) : convex_on (set.Ici 0) fun (x : ℝ) => x ^ p := sorry

theorem concave_on_log_Ioi : concave_on (set.Ioi 0) real.log := sorry

theorem concave_on_log_Iio : concave_on (set.Iio 0) real.log := sorry


import Sets.Basic
import Functions.Basic
import Relations.Basic

open Set
open Func
open Relations

variable { α : Type }

-- Problem 1

theorem subset_refl : Reflexive (@Subset α) := sorry

theorem subset_antisymm : AntiSymmetric (@Subset α) := sorry

theorem subset_trans : Transitive (@Subset α) := sorry

-- Problem 2

def Rel (f : α → α) (a₁ a₂ : α) : Prop := sorry

theorem refl_id (f : α → α) (h : Reflexive (Rel f) ) : f = id := sorry

theorem symm_involution (f : α → α) (h : Symmetric (Rel f)) : f ∘ f = id := sorry

theorem trans_idempotent (f : α → α) (h : Transitive (Rel f)) : f ∘ f = f := sorry


-- ---------------------------------------------------------------------
-- Ejercicio 1. Importar la teoría de anillos.
-- ----------------------------------------------------------------------

import algebra.ring

-- ---------------------------------------------------------------------
-- Ejercicio 2. Crear el espacio de nombre my_ring
-- ----------------------------------------------------------------------

namespace my_ring

-- ---------------------------------------------------------------------
-- Ejercicio 3. Declarar R como una variable sobre anillos.
-- ----------------------------------------------------------------------

variables {R : Type*} [ring R]

-- ---------------------------------------------------------------------
-- Ejercicio 5. Demostrar que para todo a, b ∈ R,
--    -a + (a + b) = b
-- ----------------------------------------------------------------------

-- 1ª demostración
-- ===============

example
  (a b : R)
  : -a + (a + b) = b :=
calc -a + (a + b)
     = (-a + a) + b : by rw ← add_assoc
 ... = 0 + b        : by rw add_left_neg
 ... = b            : by rw zero_add

-- 2ª demostración
-- ===============

theorem neg_add_cancel_left
  (a b : R)
  : -a + (a + b) = b :=
by rw [←add_assoc, add_left_neg, zero_add]

-- El desarrollo de la prueba es
--
--    R : Type u_1,
--    _inst_1 : ring R,
--    a b : R
--    ⊢ -a + (a + b) = b
-- rw ← add_assoc,
--    ⊢ -a + a + b = b
-- rw add_left_neg,
--    ⊢ 0 + b = b
-- rw zero_add,
--    no goals

-- ---------------------------------------------------------------------
-- Ejercicio 6. Cerrar el espacio de nombre my_ring.
-- ----------------------------------------------------------------------

end my_ring


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# Logic in Lean, example sheet 5 : "iff" (`↔`)

We learn about how to manipulate `P ↔ Q` in Lean.

## Tactics

You'll need to know about the tactics from the previous sheets,
and also the following two new tactics:

* `refl`
* `rw`

### The `refl` tactic

If your goal is `P ↔ P` then `refl,` will solve it.

### The `rw` tactic

If `h : P ↔ Q` is a hypothesis, you can decompose it
using `cases h with hPQ hQP,`. However, if you keep
it around then you can do `rw h,` which changes all `P`s in the goal to `Q`s.
Variant: `rw h at h2,` will change all `P`s to `Q`s in hypothesis `h2`.

-/

variables (P Q R S : Prop)

example : P ↔ P :=
begin
  sorry
end

example : (P ↔ Q) → (Q ↔ P) :=
begin
  sorry
end

example : (P ↔ Q) ↔ (Q ↔ P) :=
begin
  sorry
end

example : (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
  sorry
end

example : P ∧ Q ↔ Q ∧ P :=
begin
  sorry
end

example : ((P ∧ Q) ∧ R) ↔ (P ∧ (Q ∧ R)) :=
begin
  sorry
end

example : P ↔ (P ∧ true) :=
begin
  sorry
end

example : false ↔ (P ∧ false) :=
begin
  sorry
end

example : (P ↔ Q) → (R ↔ S) → (P ∧ R ↔ Q ∧ S) :=
begin
  sorry
end

example : ¬ (P ↔ ¬ P) :=
begin
  sorry,
end


/-
Copyright (c) 2014 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.int.cast.defs

/-!
# Characteristic zero

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

A ring `R` is called of characteristic zero if every natural number `n` is non-zero when considered
as an element of `R`. Since this definition doesn't mention the multiplicative structure of `R`
except for the existence of `1` in this file characteristic zero is defined for additive monoids
with `1`.

## Main definition

`char_zero` is the typeclass of an additive monoid with one such that the natural homomorphism
from the natural numbers into it is injective.

## TODO

* Unify with `char_p` (possibly using an out-parameter)
-/

/-- Typeclass for monoids with characteristic zero.
  (This is usually stated on fields but it makes sense for any additive monoid with 1.)

*Warning*: for a semiring `R`, `char_zero R` and `char_p R 0` need not coincide.
* `char_zero R` requires an injection `ℕ ↪ R`;
* `char_p R 0` asks that only `0 : ℕ` maps to `0 : R` under the map `ℕ → R`.

For instance, endowing `{0, 1}` with addition given by `max` (i.e. `1` is absorbing), shows that
`char_zero {0, 1}` does not hold and yet `char_p {0, 1} 0` does.
This example is formalized in `counterexamples/char_p_zero_ne_char_zero`.
 -/
class char_zero (R : Type*) [add_monoid_with_one R] : Prop :=
(cast_injective : function.injective (coe : ℕ → R))

theorem char_zero_of_inj_zero {R : Type*} [add_group_with_one R]
  (H : ∀ n:ℕ, (n:R) = 0 → n = 0) : char_zero R :=
⟨λ m n h, begin
  induction m with m ih generalizing n, { rw H n, rw [← h, nat.cast_zero] },
  cases n with n, { apply H, rw [h, nat.cast_zero], },
  simp_rw [nat.cast_succ, add_right_cancel_iff] at h, rwa ih,
end⟩

namespace nat
variables {R : Type*} [add_monoid_with_one R] [char_zero R]

theorem cast_injective : function.injective (coe : ℕ → R) :=
char_zero.cast_injective

@[simp, norm_cast] theorem cast_inj {m n : ℕ} : (m : R) = n ↔ m = n :=
cast_injective.eq_iff

@[simp, norm_cast] theorem cast_eq_zero {n : ℕ} : (n : R) = 0 ↔ n = 0 :=
by rw [← cast_zero, cast_inj]

@[norm_cast] theorem cast_ne_zero {n : ℕ} : (n : R) ≠ 0 ↔ n ≠ 0 :=
not_congr cast_eq_zero

lemma cast_add_one_ne_zero (n : ℕ) : (n + 1 : R) ≠ 0 :=
by exact_mod_cast n.succ_ne_zero

@[simp, norm_cast]

@[norm_cast] theorem cast_ne_one {n : ℕ} : (n : R) ≠ 1 ↔ n ≠ 1 :=
cast_eq_one.not

end nat

namespace ne_zero

instance char_zero {M} {n : ℕ}
  [ne_zero n] [add_monoid_with_one M] [char_zero M] : ne_zero (n : M) :=
⟨nat.cast_ne_zero.mpr out⟩

end ne_zero


import data.set
open set

-- 1. Replace "sorry" in these examples.
section
  variable {U : Type}
  variables A B C : set U

  example : ∀ x, x ∈ A ∩ C → x ∈ A ∪ B :=
  assume x,
  assume h : x ∈ A ∩ C,
  have h1 : x ∈ A, from and.left h,
  show x ∈ A ∪ B, from or.inl h1

  example : ∀ x, x ∈ (A ∪ B)ᶜ → x ∈ Aᶜ :=
  assume x,
  assume h : x ∈ (A ∪ B)ᶜ,
  have h1 : ¬ x ∈ (A ∪ B), from h,
    assume h2 : x ∈ A,
    show false, from h1 (or.inl h2)

end

-- 2. Replace "sorry" in the last example.
section
  variable {U : Type}

  /- defining "disjoint" -/
  def disj (A B : set U) : Prop := ∀ ⦃x⦄, x ∈ A → x ∈ B → false

  example (A B : set U) (h : ∀ x, ¬ (x ∈ A ∧ x ∈ B)) : disj A B :=
  assume x,
  assume h1 : x ∈ A,
  assume h2 : x ∈ B,
  have h3 : x ∈ A ∧ x ∈ B, from and.intro h1 h2,
  show false, from h x h3

  -- notice that we do not have to mention x when applying
  --   h : disj A B
  example (A B : set U) (h1 : disj A B) (x : U) (h2 : x ∈ A) (h3 : x ∈ B) : false :=
  h1 h2 h3

  -- the same is true of ⊆
  example (A B : set U) (x : U) (h : A ⊆ B) (h1 : x ∈ A) : x ∈ B :=
  h h1

  example (A B C D : set U) (h1 : disj A B) (h2 : C ⊆ A) (h3 : D ⊆ B) : disj C D :=
  assume x,
  assume h4: x ∈ C,
  assume h5: x ∈ D,
  have h6: x ∈ A, from h2 h4,
  have h7: x ∈ B, from h3 h5,
  show false, from h1 h6 h7

end

-- 3. Prove the following facts about indexed unions and
-- intersections, using the theorems Inter.intro, Inter.elim,
-- Union.intro, and Union.elim listed above.
section
  variables {I U : Type}
  variables {A : I → set U} {B : I → set U} {C : set U}

  theorem Inter.intro {x : U} (h : ∀ i, x ∈ A i) : x ∈ ⋂ i, A i :=
  by simp; assumption

  @[elab_simple]
  theorem Inter.elim {x : U} (h : x ∈ ⋂ i, A i) (i : I) : x ∈ A i :=
  by simp at h; apply h

  theorem Union.intro {x : U} (i : I) (h : x ∈ A i) : x ∈ ⋃ i, A i :=
  by {simp, existsi i, exact h}

  theorem Union.elim {P : Prop} {x : U} (h₁ : x ∈ ⋃ i, A i) (h₂ : ∀ (i : I), x ∈ A i → P) : P :=
  by {simp at h₁, cases h₁ with i h, exact h₂ i h}

  example : (⋂ i, A i) ∩ (⋂ i, B i) ⊆ (⋂ i, A i ∩ B i) :=
  assume x,
  assume h3 : x ∈ ((⋂ i, A i) ∩ (⋂ i, B i)),
  have h4 : x ∈ (⋂ i, A i), from h3.left,
  have h5 : x ∈ (⋂ i, B i), from h3.right,
  show x ∈ (⋂ i, A i ∩ B i), from
  Inter.intro
    (assume i : I,
     have h1: x ∈ A i, from Inter.elim h4 i,
     have h2: x ∈ B i, from Inter.elim h5 i,
     show x ∈ A i ∩ B i, from and.intro h1 h2)

  example : C ∩ (⋃i, A i) ⊆ ⋃i, C ∩ A i :=
  assume x : U,
  assume h : x ∈ C ∩ (⋃i, A i),
  show x ∈ ⋃ i, C ∩ A i, from
  Union.elim h.right
    (assume i : I,
     assume h1: x ∈ A i,
     show  x ∈ ⋃ i, C ∩ A i, from
     Union.intro i (and.intro h.left h1))

end

-- 4. Prove the following fact about power sets. You can use the
-- theorems subset.trans and subset.refl
section
  variable  {U : Type}
  variables A B C : set U

  -- For this exercise these two facts are useful
  example (h1 : A ⊆ B) (h2 : B ⊆ C) : A ⊆ C :=
  subset.trans h1 h2

  example : A ⊆ A :=
  subset.refl A

  example (h : A ⊆ B) : powerset A ⊆ powerset B :=
  assume X : set U,
  assume h1 : X ∈ powerset A,
  show X ∈ powerset B, from subset.trans h1 h

  example (h : powerset A ⊆ powerset B) : A ⊆ B :=
  assume x: U,
  assume h1 : x ∈ A,
  have h2: {y|x = y} ∈ powerset A, from
    assume z,
    assume : z ∈ {y| x = y},
    have x = z, from this,
      show z ∈ A, from eq.subst this h1,
      have h3: {y| x = y} ∈ powerset B, from h h2,
      have h4: x ∈ {y| x = y}, from eq.refl x,
      h3 h4
end

-- 5. Replace the sorry commands in the following proofs to show that
-- we can create a partial order R' out of a strict partial order R.
section
  parameters {A : Type} {R : A → A → Prop}
  parameter (irreflR : irreflexive R)
  parameter (transR : transitive R)

  local infix < := R

  def R' (a b : A) : Prop := R a b ∨ a = b
  local infix ≤ := R'

  theorem reflR' (a : A) : a ≤ a :=
  have h1: a = a, from eq.refl a,
  show a ≤ a, from or.inr h1

  theorem transR' {a b c : A} (h1 : a ≤ b) (h2 : b ≤ c): a ≤ c :=
  or.elim h1
    (assume h3: a < b, or.elim h2
      (assume h4: b < c, or.inl (transR h3 h4))
      (assume h5: b = c, eq.subst h5 h1))
      (assume h6: a = b, eq.subst (eq.symm h6) h2)

  theorem antisymmR' {a b : A} (h1 : a ≤ b) (h2 : b ≤ a) : a = b :=
  or.elim h1
    (assume h: a < b, or.elim h2
        (assume h3: b < a, false.elim ((irreflR b) (transR h3 h)))
        (assume h4: b = a, eq.symm h4))
        (assume h5: a = b, h5)

end

-- 6
section
  parameters {A : Type} {R : A → A → Prop}
  parameter (reflR : reflexive R)
  parameter (transR : transitive R)

  def S (a b : A) : Prop := R a b ∧ R b a

  example : transitive S :=
  assume x y z,
  assume h1 : S x y,
  assume h2 : S y z,
  and.intro (transR h1.left h2.left) (transR h2.right h1.right)

end

-- 7. Only one of the following two theorems is provable. Figure out
-- which one is true, and replace the sorry command with a complete
-- proof.
section
  parameters {A : Type} {a b c : A} {R : A → A → Prop}
  parameter (Rab : R a b)
  parameter (Rbc : R b c)
  parameter (nRac : ¬ R a c)

  --theorem R_is_strict_partial_order : irreflexive R ∧ transitive R :=
  -- this theorem is not provable
  --sorry

  theorem R_is_not_strict_partial_order : ¬(irreflexive R ∧ transitive R) :=
  assume h: irreflexive R ∧ transitive R,
  show false, from nRac (h.right Rab Rbc)

end

-- 8
section
  open nat

  example : 1 ≤ 4 :=
  have l1: 1 + 1 = 2, by simp,
  have h1: 1 <  2, from lt_succ_self 1,
  have l2 : 2 + 1 = 3, by simp,
  have h2: (1 + 1) < 3, from lt_succ_self (1 + 1),
  have l3 : 3 + 1 = 4, by simp,
  have h3: (1 + 1 + 1) < 4, from lt_succ_self (1 + 1 + 1),
  have h4: 1 ≤ 4, from le_of_lt (lt_trans h1 (lt_trans h2 h3)),
  show 1 ≤ 4, from eq.subst l3 h4

end


import data.real.basic

variables {x y : ℝ}

#check le_refl
#check le_refl y
#check @le_abs
#check @abs_le
#check neg_add
#check add_le_add

namespace my_abs

-- BEGIN
theorem le_abs_self : x ≤ abs x :=
begin
  rw le_abs,
  left,
  apply le_refl,
end

theorem neg_le_abs_self : -x ≤ abs x :=
begin
  rw le_abs,
  right,
  apply le_refl,
end
-- END

#check @le_abs_self
#check @neg_le_abs_self

end my_abs


open function int algebra

def f (x : ℤ) : ℤ := x + 3
def g (x : ℤ) : ℤ := -x
def h (x : ℤ) : ℤ := 2 * x + 3

example : injective f :=
assume x1 x2,
assume h1 : x1 + 3 = x2 + 3,   -- Lean knows this is the same as f x1 = f x2
show x1 = x2, from eq_of_add_eq_add_right h1

example : surjective f :=
assume y,
have h1 : f (y - 3) = y, from calc
  f (y - 3) = (y - 3) + 3 : rfl
        ... = y           : by rw sub_add_cancel,
show ∃ x, f x = y, from exists.intro (y - 3) h1

example (x y : ℤ) (h : 2 * x = 2 * y) : x = y :=
have h1 : 2 ≠ (0 : ℤ), from dec_trivial,  -- this tells Lean to figure it out itself
show x = y, from eq_of_mul_eq_mul_left h1 h

example (x : ℤ) : -(-x) = x := neg_neg x

example (A B : Type) (u : A → B) (v : B → A) (h : left_inverse u v) :
  ∀ x, u (v x) = x :=
h

example (A B : Type) (u : A → B) (v : B → A) (h : left_inverse u v) :
  right_inverse v u :=
h

-- fill in the sorry's in the following proofs

example : injective h :=
assume x₁ x₂,
assume : 2 * x₁ + 3 = 2 * x₂ + 3,
have 2 * x₁ = 2 * x₂ , from eq_of_add_eq_add_right this,
have 2 ≠ (0 : ℤ), from dec_trivial,
show x₁ = x₂ , from eq_of_mul_eq_mul_left this ‹ 2 * x₁ = 2 * x₂ ›

example : surjective g :=
assume y,
have h₁ : g (-y) = y, from calc
  g (-y) = -(-y): rfl
     ... =     y: by rw neg_neg,
show ∃ x, g x = y, from exists.intro (-y) h₁

example (A B : Type) (u : A → B) (v1 : B → A) (v2 : B → A)
  (h1 : left_inverse v1 u) (h2 : right_inverse v2 u) : v1 = v2 :=
funext
  (assume x,
    calc
      v1 x = v1 (u (v2 x)) : by rw (h2 x)
       ... = v2 x          : by rw (h1 (v2 x)))

---

import data.set
open function set

variables {X Y : Type}
variable  f : X → Y
variables A B : set X

example : f '' (A ∪ B) = f '' A ∪ f '' B :=
eq_of_subset_of_subset
  (assume y,
    assume h1 : y ∈ f '' (A ∪ B),
    exists.elim h1 $
    assume x h,
    have h2 : x ∈ A ∪ B, from h.left,
    have h3 : f x = y, from h.right,
    or.elim h2
      (assume h4 : x ∈ A,
        have h5 : y ∈ f '' A, from ⟨x, h4, h3⟩,
        show y ∈ f '' A ∪ f '' B, from or.inl h5)
      (assume h4 : x ∈ B,
        have h5 : y ∈ f ''  B, from ⟨x, h4, h3⟩,
        show y ∈ f '' A ∪ f '' B, from or.inr h5))
  (assume y,
    assume h2 : y ∈ f '' A ∪ f '' B,
    or.elim h2
      (assume h3 : y ∈ f '' A,
        exists.elim h3 $
        assume x h,
        have h4 : x ∈ A, from h.left,
        have h5 : f x = y, from h.right,
        have h6 : x ∈ A ∪ B, from or.inl h4,
        show y ∈ f '' (A ∪ B), from ⟨x, h6, h5⟩)
      (assume h3 : y ∈ f '' B,
        exists.elim h3 $
        assume x h,
        have h4 : x ∈ B, from h.left,
        have h5 : f x = y, from h.right,
        have h6 : x ∈ A ∪ B, from or.inr h4,
        show y ∈ f '' (A ∪ B), from ⟨x, h6, h5⟩))

-- remember, x ∈ A ∩ B is the same as x ∈ A ∧ x ∈ B
example (x : X) (h1 : x ∈ A) (h2 : x ∈ B) : x ∈ A ∩ B :=
and.intro h1 h2

example (x : X) (h1 : x ∈ A ∩ B) : x ∈ A :=
and.left h1

-- Fill in the proof below.
-- (It should take about 8 lines.)

example : f '' (A ∩ B) ⊆ f '' A ∩ f '' B :=
assume y,
assume h1 : y ∈ f '' (A ∩ B),
show y ∈ f '' A ∩ f '' B, from
  exists.elim h1 $
    assume x h,
    have y ∈ f '' A, from ⟨ x, h.left.left, h.right ⟩,
    have y ∈ f '' B, from ⟨ x, h.left.right, h.right ⟩,
    ⟨ ‹ y ∈ f '' A › , ‹ y ∈ f '' B › ⟩


-- Notes/exercises from:
-- https://leanprover.github.io/theorem_proving_in_lean/index.html
-- Section 3 (Propositions and Proofs)

open classical

variables p q r s : Prop

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
  iff.intro
  -- Written out a little more verbosely so I can test some things:
  (assume h : p ∧ q,
    have hp : p, from and.left h,
    have hq : q, from and.right h,
    show q ∧ p, from and.intro hq hp)
  (assume h : q ∧ p,
    have hq : q, from and.left h,
    have hp : p, from and.right h,
    show p ∧ q, from and.intro hp hq)

example : p ∨ q ↔ q ∨ p :=
  iff.intro
  (assume h : p ∨ q,
    or.elim h (assume hp : p, show q ∨ p, from or.inr hp)
              (assume hq : q, show q ∨ p, from or.inl hq))
  (assume h : q ∨ p,
    or.elim h (assume hq : q, show p ∨ q, from or.inr hq)
              (assume hp : p, show p ∨ q, from or.inl hp))

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
  iff.intro
    (assume hpqr : (p ∧ q) ∧ r,
      have hr : r, from and.right hpqr,
      have hpq : p ∧ q, from and.left hpqr,
      have hp : p, from and.left hpq,
      have hq : q, from and.right hpq,
      show p ∧ (q ∧ r), from and.intro hp (and.intro hq hr))
    (assume hpqr : p ∧ (q ∧ r),
      have hp : p, from and.left hpqr,
      have hqr : q ∧ r, from and.right hpqr,
      have hq : q, from and.left hqr,
      have hr : r, from and.right hqr,
      show (p ∧ q) ∧ r, from and.intro (and.intro hp hq) hr)

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
  iff.intro
    (assume hpqr : (p ∨ q) ∨ r,
      or.elim hpqr
        (assume hpq : p ∨ q,
          or.elim hpq
            (assume hp : p, or.inl hp)
            -- Now I see how 'show' is just an annotation:
            (assume hq : q, show p ∨ (q ∨ r), from or.inr (or.inl hq)))
        (assume hr : r, or.inr (or.inr hr)))
    (assume hpqr : p ∨ (q ∨ r),
      or.elim hpqr
        (assume hp : p, or.inl (or.inl hp))
        (assume hqr : q ∨ r,
          or.elim hqr
            (assume hq : q, or.inl (or.inr hq))
            (assume hr : r, or.inr hr)))

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  iff.intro
    (assume h : p ∧ (q ∨ r),
      (show (p ∧ q) ∨ (p ∧ r), from
        and.elim h
          (assume hp : p, assume hqr : q ∨ r,
            or.elim hqr
              (assume hq : q, or.inl (and.intro hp hq))
              (assume hr : r, or.inr (and.intro hp hr)))))
    (assume h : (p ∧ q) ∨ (p ∧ r),
      (show p ∧ (q ∨ r), from
        or.elim h
          (assume hpq : (p ∧ q),
            have hp : p, from and.left hpq,
            have hqr : q ∨ r, from or.inl (and.right hpq),
            and.intro hp hqr)
          (assume hpr : (p ∧ r),
            have hp : p, from and.left hpr,
            have hqr : q ∨ r, from or.inr (and.right hpr),
            and.intro hp hqr)))

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
  iff.intro
    (assume h : p ∨ (q ∧ r),
      (show (p ∨ q) ∧ (p ∨ r), from
        or.elim h
          (assume hp : p,
            and.intro (or.inl hp) (or.inl hp))
          (assume hqr : q ∧ r,
            and.elim hqr
              (assume hq : q, assume hr : r,
                and.intro (or.inr hq) (or.inr hr)))))
    (assume h : (p ∨ q) ∧ (p ∨ r),
      (show (p ∨ (q ∧ r)), from
        and.elim h
          (assume pq : p ∨ q, assume pr : p ∨ r,
            or.elim pq
              (assume hp : p, or.inl hp)
              (assume hq : q,
                or.elim pr
                  -- I feel like this part could possibly be simpler,
                  -- but then, this branch of or.elim doesn't
                  -- guarantee ¬p (it's not exclusive or)
                  (assume hp2 : p, or.inl hp2)
                  (assume hr : r, or.inr (and.intro hq hr))))))

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
  iff.intro
    (assume h : p → (q → r),
      assume hpq : p ∧ q,
        have hp : p, from and.left hpq,
        have hq : q, from and.right hpq,
        (h hp) hq)
    (assume h : p ∧ q → r,
      assume hp : p,
      assume hq : q,
      have pq : p ∧ q, from and.intro hp hq,
      h pq)

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
  iff.intro
    (assume h : (p ∨ q) → r,
      and.intro
        (assume hp : p, h (or.inl hp))
        (assume hq : q, h (or.inr hq)))
    (assume h : (p → r) ∧ (q → r),
      and.elim h
        (assume pr : p → r, assume qr : q → r,
          assume pq : p ∨ q, or.elim pq pr qr))

-- Below is just a special case of the above theorem but I'm not sure
-- how to express it:
example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
  iff.intro
    (assume h : ¬(p ∨ q),
      and.intro
        (assume hp : p, h (or.inl hp))
        (assume hq : q, h (or.inr hq)))
    (assume h : ¬p ∧ ¬q,
      and.elim h
        (assume np : ¬p, assume nq : ¬q,
          not.intro
            (assume pq : p ∨ q, or.elim pq np nq)))

theorem dm1 : ¬p ∨ ¬q → ¬(p ∧ q) :=
  assume npq : ¬p ∨ ¬q,
    or.elim npq
      (assume np : ¬p,
        not.intro
          (assume pq : p ∧ q, np (and.elim_left pq)))
      (assume nq : ¬q,
        not.intro
          (assume pq : p ∧ q, nq (and.elim_right pq)))

example : ¬(p ∧ ¬ p) :=
  assume pnp : p ∧ ¬p,
    and.elim pnp (assume hp : p, assume hnp : ¬p, hnp hp)

example : p ∧ ¬q → ¬(p → q) :=
  assume pnq : p ∧ ¬q,
    not.intro (assume pq : p → q,
      and.elim pnq (assume hp : p, assume hnq : ¬q,
        hnq (pq hp)))

example : ¬p → (p → q) :=
  assume hnp : ¬p, assume hp : p, absurd hp hnp

example : (¬p ∨ q) → (p → q) :=
  assume npq : ¬p ∨ q, assume hp : p,
    or.elim npq
      (assume hnp : ¬p, absurd hp hnp)
      (assume hq : q, hq)

example : p ∨ false ↔ p :=
  iff.intro
    (assume pf : p ∨ false,
      or.elim pf (assume hp : p, hp) false.elim)
    (assume hp : p, or.inl hp)

example : p ∧ false ↔ false :=
  iff.intro (assume pf : p ∧ false, and.right pf) false.elim

theorem thm1 : (p → ¬p) → ¬p :=
  assume h : p → ¬p,
  assume h2 : p,
  (h h2) h2

-- "If (p → ¬p), then (p → (p → false)), so in particular (p →
-- false). Put another way, (p → ¬p) → ¬p is an intuitionistically
-- valid theorem. From this, you have ¬p and ¬p → p from the
-- assumptions, so p, so false."

example : ¬(p ↔ ¬p) :=
  not.intro
    (assume impl : p ↔ ¬p,
     have hnp : ¬p, from thm1 p (iff.mp impl),
     have hp : p, from (iff.mpr impl) hnp,
     hnp hp)

theorem cp : (p → q) → (¬q → ¬p) :=
  assume pq : p → q,
  assume nq : ¬q,
  show p → false, from
    assume hp : p, nq (pq hp)

-- these require classical reasoning
example : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
  assume rps : p → r ∨ s,
  by_cases
    (assume hp : p,
      or.elim (rps hp)
        (assume hr : r, or.inl (assume hp2 : p, hr))
        (assume hs : s, or.inr (assume hp2 : p, hs)))
    (assume hnp : ¬p,
      or.inl (assume hp : p, absurd hp hnp))

example : ¬(p ∧ q) → ¬p ∨ ¬q :=
  assume npq : ¬(p ∧ q),
  by_cases
    (assume hp : p,
      by_cases
        (assume hq : q,
          have pq : p ∧ q, from and.intro hp hq,
          absurd pq npq)
        (assume hnq : ¬q, or.inr hnq))
    (assume hnp : ¬p, or.inl hnp)

example : ¬(p → q) → p ∧ ¬q :=
  assume npq : ¬(p → q),
  by_cases
    (assume hq : q, absurd (assume p, hq) npq)
    (assume hnq : ¬q,
      by_cases
        (assume hp : p, and.intro hp hnq)
        (assume hnp : ¬p,
          have pq : p → q, from (assume hp : p, absurd hp hnp),
          absurd pq npq))

example : (p → q) → (¬p ∨ q) :=
  assume pq : p → q, by_cases
    (assume hp : p, or.inr (pq hp))
    (assume hnp : ¬p, or.inl hnp)

theorem dne {p : Prop} (h : ¬¬p) : p :=
or.elim (em p)
  (assume hp : p, hp)
  (assume hnp : ¬p, absurd hnp h)

-- How is this so simple?
theorem dne2 {p : Prop} (hp : p) : ¬¬p :=
  (assume hnp : ¬p, hnp hp)

theorem cp2 : (¬q → ¬p) → (p → q) :=
  assume npnq : ¬q → ¬p,
  have pq2 : ¬¬p → ¬¬q, from cp (¬q) (¬p) npnq,
  assume hp : p, dne (pq2 (dne2 hp))

-- Is this cheating?
example : p ∨ ¬p := em p

example : (((p → q) → p) → p) :=
  assume pqp : ((p → q) → p),
  by_cases
    (assume hq : q,
      have pq : p → q, from (assume p, hq), pqp pq)
    (assume hnq : ¬q,
      by_cases
        (assume hp : p, hp)
        (assume hnp : ¬p,
          have pq : p → q, from cp2 p q (assume hnq : ¬q, hnp),
          have hp : p, from pqp pq,
          absurd hp hnp))
  -- Is there a simpler way to show the above?  Maybe proof by
  -- contradiction or something?