import .love01_definitions_and_statements_demo

/- # LoVe Exercise 1: Definitions and Statements

Replace the placeholders (e.g., `:= sorry`) with your solutions. -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/- ## Question 1: Truncated Subtraction

1.1. Define the function `sub` that implements truncated subtraction on natural
numbers by recursion. "Truncated" means that results that mathematically would
be negative are represented by 0. For example:

    `sub 7 2 = 5`
    `sub 2 7 = 0` -/

def sub : ℕ → ℕ → ℕ
| m            0            := m
| 0            _            := 0
| (nat.succ m) (nat.succ n) := sub m n

/- 1.2. Check that your function works as expected. -/

#eval sub 0 0   -- expected: 0
#eval sub 0 1   -- expected: 0
#eval sub 0 7   -- expected: 0
#eval sub 1 0   -- expected: 1
#eval sub 1 1   -- expected: 0
#eval sub 3 0   -- expected: 3
#eval sub 2 7   -- expected: 0
#eval sub 3 1   -- expected: 2
#eval sub 3 3   -- expected: 0
#eval sub 3 7   -- expected: 0
#eval sub 7 2   -- expected: 5

/- ## Question 2: Arithmetic Expressions

Consider the type `aexp` from the lecture and the function `eval` that
computes the value of an expression. You will find the definitions in the file
`love01_definitions_and_statements_demo.lean`. One way to find them quickly is
to

1. hold the Control (on Linux and Windows) or Command (on macOS) key pressed;
2. move the cursor to the identifier `aexp` or `eval`;
3. click the identifier. -/

#check aexp
#check eval

/- 2.1. Test that `eval` behaves as expected. Make sure to exercise each
constructor at least once. You can use the following environment in your tests.
What happens if you divide by zero?

Make sure to use `#eval`. For technical reasons, `#reduce` does not work well
here. Note that `#eval` (Lean's evaluation command) and `eval` (our evaluation
function on `aexp`) are unrelated. -/

def some_env : string → ℤ
| "x" := 3
| "y" := 17
| _   := 201

#eval eval some_env (aexp.var "x")   -- expected: 3
#eval eval some_env (aexp.num 12)                              -- expected: 12
#eval eval some_env (aexp.add (aexp.var "x") (aexp.var "y"))   -- expected: 20
#eval eval some_env (aexp.sub (aexp.num 5) (aexp.var "y"))     -- expected: -12
#eval eval some_env (aexp.mul (aexp.num 11) (aexp.var "z"))    -- expected: 2211
#eval eval some_env (aexp.div (aexp.num 2) (aexp.num 0))       -- expected: 0

/- 2.2. The following function simplifies arithmetic expressions involving
addition. It simplifies `0 + e` and `e + 0` to `e`. Complete the definition so
that it also simplifies expressions involving the other three binary
operators. -/

def simplify : aexp → aexp
| (aexp.add (aexp.num 0) e₂) := simplify e₂
| (aexp.add e₁ (aexp.num 0)) := simplify e₁
| (aexp.sub e₁ (aexp.num 0)) := simplify e₁
| (aexp.mul (aexp.num 0) e₂) := aexp.num 0
| (aexp.mul e₁ (aexp.num 0)) := aexp.num 0
| (aexp.mul (aexp.num 1) e₂) := simplify e₂
| (aexp.mul e₁ (aexp.num 1)) := simplify e₁
| (aexp.div (aexp.num 0) e₂) := aexp.num 0
| (aexp.div e₁ (aexp.num 0)) := aexp.num 0
| (aexp.div e₁ (aexp.num 1)) := simplify e₁
-- catch-all cases below
| (aexp.num i)               := aexp.num i
| (aexp.var x)               := aexp.var x
| (aexp.add e₁ e₂)           := aexp.add (simplify e₁) (simplify e₂)
| (aexp.sub e₁ e₂)           := aexp.sub (simplify e₁) (simplify e₂)
| (aexp.mul e₁ e₂)           := aexp.mul (simplify e₁) (simplify e₂)
| (aexp.div e₁ e₂)           := aexp.div (simplify e₁) (simplify e₂)

/- 2.3. State (without proving it) the correctness lemma for `simplify`, namely
that the simplified expression should have the same semantics, with respect to
`eval`, as the original expression. -/

lemma simplify_correct (env : string → ℤ) (e : aexp) :
  eval env (simplify e) = eval env e :=
sorry

/- ## Question 3: λ-Terms

3.1. Complete the following definitions, by replacing the `sorry` markers by
terms of the expected type.

Hint: A procedure for doing so systematically is described in Section 1.1.4 of
the Hitchhiker's Guide. As explained there, you can use `_` as a placeholder
while constructing a term. By hovering over `_`, you will see the current
logical context. -/

def I : α → α :=
λa, a

def K : α → β → α :=
λa b, a

def C : (α → β → γ) → β → α → γ :=
λg b a, g a b

def proj_1st : α → α → α :=
λx y, x

/- Please give a different answer than for `proj_1st`. -/

def proj_2nd : α → α → α :=
λx y, y

def some_nonsense : (α → β → γ) → α → (α → γ) → β → γ :=
λg a f b, g a b

/- 3.2. Show the typing derivation for your definition of `C` above, on paper
or using ASCII or Unicode art. You might find the characters `–` (to draw
horizontal bars) and `⊢` useful. -/

/- Let `D` := `g : α → β → γ, b : β, a : α`. We have

    –––––––––––––––––– Var    –––––––––– Var
    D ⊢ g : α → β → γ         D ⊢ a : α
    –––––––––––––––––––––––––––––––––––– App    –––––––––– Var
    D ⊢ g a : β → γ                             D ⊢ b : β
    –––––––––––––––––––––––––––––––––––––––––––––––––––––– App
    D ⊢ g a b : γ
    ––––––––––––––––––––––––––––––––––––––––––– Lam
    g : α → β → γ, b : β ⊢ (λa : α, g a b) : γ
    –––––––––––––––––––––––––––––––––––––––––––––– Lam
    g : α → β → γ ⊢ (λ(b : β) (a : α), g a b) : γ
    ––––––––––––––––––––––––––––––––––––––––––––––– Lam
    ⊢ (λ(g : α → β → γ) (b : β) (a : α), g a b) : γ -/

end LoVe


/-
Homeowork 9
Sina Hazratpour
Introduction to Proof
MATH 301, Johns Hopkins University, Fall 2022
-/

import ..prooflab
import lectures.lec10_surj_inj_fact
import lectures.lec11_type_classes
import lectures.lec12_gaussian_integers

open PROOFS
open PROOFS.STR

variables {X : Type} {P : X → Prop}

/- The first question is about __unique existence__. For instance, we know not only that there exists a natural `n` such that `n` is even and prime, but such a number is unique.  -/

-- ∃! is the symbol for unique existence.

#check exists_unique

lemma uniquely_exists₁  :
  (∃! x, P x) ↔ (∃ x, P x ∧ (∀ y : X, P y → y = x)) :=
begin
  rw exists_unique,
end

/-! ## Question 1 (20 pts):
Give a proof of the following lemma.
-/

lemma uniquely_exists₂  :
  (∃! x, P x) ↔ (∃ x, P x) ∧ (∀ y z : X, P y ∧ P z → y = z) :=
begin
  sorry,
end

/- Questions 2 and 3 concern the notion of quasigroup.  In below we define __quasigroup__ structures. A quasigroup structure consists of one binary operation `op` operations and left and right divisions (with respect `op` ).
-/

class quasi_group_str (Q : Type) :=
(op : Q → Q → Q) -- a binary operation `op` on `Q`
(left_div : Q → Q → Q)
(right_div : Q → Q → Q)
(l := left_div) -- temporary notation, just inside this structure declaration
(r := right_div) -- temporary notation, just inside this structure declaration
(op_of_left_div : ∀ x y : Q, op x  (l x y) = y) -- finding column
(left_div_of_op : ∀ x y : Q, l x (op x y) = y) -- unique column
(op_of_right_div : ∀ x y : Q, op (r y x)  x = y)
(right_div_of_op : ∀ x y : Q, r (op y  x) x  = y)

local infix `#` :15 := quasi_group_str.op
local infix ` \\ ` :15 := quasi_group_str.left_div -- `l x y` is `x \\ y`
local infixl ` // ` :15 := quasi_group_str.right_div -- `r x y` is `y // x`

/-! ## Question 2 (20 pts):
Show that The integers ℤ with subtraction form a quasigroup.
-/
instance : quasi_group_str ℤ :=
{
  op := λ x, λ y, x - y,
  left_div := sorry,
  right_div := sorry,
  op_of_left_div := sorry,
  left_div_of_op := sorry,
  op_of_right_div := sorry,
  right_div_of_op := sorry,
}

/-! ## Question 3 (20 pts)
**(Part I)** :
 Prove the following simplification lemmas directly from the definitions above.
-/

@[simp]
lemma mul_of_left_div_def {Q : Type} [quasi_group_str Q] (a b : Q) :
  (a # (a \\ b)) = b :=
begin
  sorry,
end

@[simp]
lemma left_div_of_mul_def {Q : Type} [quasi_group_str Q] (a b : Q) :
  (a \\ (a # b)) = b :=
begin
  sorry,
end

lemma mul_of_right_div_def {Q : Type} [quasi_group_str Q] (a b : Q) :
  ((b // a) # a) = b :=
begin
  sorry,
end

lemma right_div_of_mul_def {Q : Type} [quasi_group_str Q] (a b : Q) :
  ((b # a) // a) = b :=
begin
  sorry,
end

/-
## Question 3 (Part II):
 Prove the Latin square property of quasigroups. A __Latin square__ is an array filled with different symbols, each occurring exactly once in each row and exactly once in each column.
An example of a `3×3` Latin square with symbols `A B C` is

                      A	B	C
                      C	A	B
                      B	C	A

Hint : Q1 should help you here.
-/

theorem Latin_square_property {Q : Type} [quasi_group_str Q] :
  ∀ a b : Q, (∃! x : Q, (a # x) = b) ∧ (∃! y : Q, (y # a) = b) :=
begin
  sorry,
end

/- The notion of __monoid__ strucutre (`mult_monoid_str` and `additive_monoid_str`) was defined in lecture 12. -/

@[ext]
structure positive_nat :=
(num : ℕ)
(pos : 0 < num)

local notation ` ℕ₊ `: 15 := positive_nat

/- Fill in `sorry` placeholder in below.-/
instance : has_one ℕ₊ := sorry

@[simp]
lemma pos_nat_one_val : (1 : ℕ₊).num = 1 :=
begin
  sorry,
end

/- Fill in `sorry` placeholder in below.-/
instance : has_mul ℕ₊ := sorry

/-! ## Question 4 (20 pts):
Show that the positive natural numbers admit a multiplicative monoid structure fy filling in the `sorry` placeholders in below. You should use the instances of type classes `has_one ℕ₊` and `has_mul ℕ₊` in above. Feel free to prove your own simplification lemmas if needed.
-/

instance : mult_monoid_str ℕ₊ :=
{ mul :=  sorry,
  mul_assoc := sorry,
  one := sorry,
  mul_one := sorry,
  one_mul := sorry,
}

/-!  In below we define the __group__ structure. A group structure on a type `X` consists of a binary operation (e.g. multiplication, addition) and a unary operation of taking __inverse__.
-/

class additive_group_str (X : Type) extends additive_monoid_str X :=
(inv : X → X)
(left_inv : ∀ x : X,  (inv x) + x =  0)
(right_inv : ∀ x : X,  x + (inv x) = 0)

class mult_group_str (X : Type) extends mult_monoid_str X :=
(inv : X → X)
(left_inv : ∀ x : X,  (inv x) * x =  1)
(right_inv : ∀ x : X,  x * (inv x) = 1)

-- our notation for inverse of an element.
postfix `ⁱ` :std.prec.max_plus := mult_group_str.inv

section
variables (G : Type) [mult_group_str G] (x : G)
#check x
#check xⁱ
end

/-! ## Question 5 (20 pts) :
Show that the Gaussian integers with the opeation of addition form an additive group. -/

-- instance : additive_group_str ℤ[i] :=
-- { inv := has_neg.neg,
--   left_inv := by {intro x, ext; simp [gaussian_int.add_def]; simp [gaussian_int.neg_def],  },
--   right_inv := by {intro x, ext; simp [gaussian_int.add_def]; simp [gaussian_int.neg_def],  }, }

@[simp]
theorem add_im_def (x y : ℤ[i]) :
  (x + y).im = x.im + y.im :=
begin
  refl,
end

lemma gaussian_add_opposite {x : ℤ[i]} : -x + x = 0 :=
begin
ext,
rw gaussian_int.add_re_def,
rw gaussian_int.neg_def,
ring_nf,
rw gaussian_int.add_im_def,
rw gaussian_int.neg_def,
ring_nf,
end

instance : additive_group_str ℤ[i] :=
{ inv := has_neg.neg,
  left_inv := by { intro z,  rw gaussian_add_opposite,  },
  right_inv := by {intro x, ext; simp [gaussian_int.add_def]; simp [gaussian_int.neg_def],  }, }

/-
In below we define the notion of __monoid morphism__. A monoid morphism between monoids `M` and `N` is given by a function `f : M → N` which preserves the multiplication operation.
-/

class mult_monoid.morphism (M : Type) (N : Type) [mult_monoid_str M] [mult_monoid_str N] :=
(to_fun : M → N)
(resp_one : to_fun 1 = 1)
(resp_mul : ∀ x y : M, to_fun (x * y) = to_fun x * to_fun y)

infixr ` →ₘ* `:25 := mult_monoid.morphism

/-! ## Question 6 (20 pts):
Show that the function from ℕ₊ → ℤ[i] which maps `n` to `n + 0i` is a multiplicative monoid morphism.
-/

instance : ℕ₊ →ₘ* ℤ[i] := sorry

/-! ## Question 7 (20 pts):
Show that for a type `X` the automorphisms of `X` admits a group strucuture where the multiplication operation is given by the composition of functions. You might like to use some stuff we proved about `auto` in Lecture on unbundled strucutres. -/

def group_of_auto : mult_group_str (auto X) :=
sorry

/-! ## Question 8 (20 pts):
Show that the endomorphisms of any type form a monoid with composition of functions as monoid multiplication.
-/

instance monoid_of_endo : mult_monoid_str (endo X) :=
sorry

/-! ## Question 9 (20 pts):
**Part I :** Prove the following lemma.
-/
lemma inv_cancel_left {G : Type} [mult_group_str G] :
  ∀ a b : G, (aⁱ) * (a * b) = b :=
begin
  sorry
end

/-
**Part II :** Use the previous lemma to prove the following cancellation property of multiplication for groups.
-/

lemma mul_left_cancel_group {G : Type} [mult_group_str G] :
  ∀ a b c : G, (a * b = a * c) → b = c :=
begin
  sorry,
end

/-
In below we define the __action__ of a monoid on a type.
-/

class mult_monoid_action (M A : Type) [mult_monoid_str M] :=
(smul : M → A → A) -- the scalar multiplication of `M` on `A`.
(one_smul : ∀ (x : A), smul (1 : M) x = x)
(mul_smul : ∀ (r s : M) (x : A),
smul (r * s)  x = smul r (smul s x))

/- ## Question 10 (20 pts):
Given a monoid `M` and an action of `M` on a type `A` construct a monoid morphism from `M` to `endo A`.
-/

def monoid_morphism_of_monoid_action  (M A : Type) [mult_monoid_str M] [mult_monoid_action M A] :
M →ₘ* (endo A) :=
{ to_fun := mult_monoid_action.smul ,
  resp_one := by {funext, rw mult_monoid_action.one_smul,  },
  resp_mul := sorry, }


open classical
#check Prop

variables P Q R : Prop
#check P

-- Capítulo 3, Ejemplo 3.8.1, página 20
theorem T1 (h1 : P) (h2 : Q) : P ∧ Q :=
begin
  exact and.intro h1 h2,
end

-- Capítulo 3, Ejemplo 3.8.2, página 20
theorem T2 (h1:P) (h2:P → Q) : Q  :=
begin
exact h2 h1,
end

-- Capítulo 3, Ejemplo 3.8.3, página 21
theorem T3: ¬¬P ↔ P:=
begin
split,
-- de izquierda a derecha
assume h1,
by_contradiction h2,
exact h1 h2,
-- de derecha a izquierda
assume h1,
by_contradiction h2,
exact h2 h1,
end

-- Capítulo 3, Lema 3.11.1 reflexividad, página 22
theorem T4: P ↔ P :=
begin
split,
-- de izquierda a derecha
assume h1,
exact h1,
-- de derecha a izquierda
assume h1,
exact h1,
end

-- Capítulo 3, Lema 3.11.2 simetría, página 22
theorem T5 (h1: P ↔ Q) : Q ↔ P :=
begin
split,
exact iff.elim_right h1,
exact iff.elim_left h1,
end

-- Capítulo 3, Lema 3.11.3 transitividad, página 22
theorem T6 (h1: P ↔ Q) (h2: Q ↔  R) : P ↔ R:=
begin
split,
-- de izquierda a derecha
have h3: P → Q, exact iff.elim_left h1,
have h4: Q → R, exact iff.elim_left h2,
assume h5,
have h6: Q, exact h3 h5,
exact h4 h6,
-- de derecha a izquierda
have h3: Q → P, exact iff.elim_right h1,
have h4: R → Q, exact iff.elim_right h2,
assume h5,
have h6: Q, exact h4 h5,
exact h3 h6,
end

-- Capítulo 3, Lema 3.12.1
theorem T7 (h1: P → Q) : P ∧ Q ↔ P:=
begin
split,
-- de izquierda a derecha
assume h2,
exact and.elim_left h2,
-- de derecha a izquierda
assume h2,
have h3: Q, exact h1 h2,
exact and.intro h2 h3,
end

-- Capítulo 3, Lema 3.12.2
theorem T8 (h1: P → Q) : P ∨ Q ↔ Q:=
begin
split,
--de izquierda a derecha
assume h2,
cases h2 with hP hQ,
--Caso hP
have h3: Q, exact h1 hP,
exact h3,
--Caso hQ
exact hQ,
-- de derecha a izquierda
assume h2,
exact or.inr h2,
end

-- Capítulo 3, Lema 3.12.3
theorem T9 (h1: P) : P ∧ Q ↔ Q:=
begin
split,
-- de izquierda a derecha
assume h2,
exact and.elim_right h2,
-- de derecha a izquierda
assume h2,
exact and.intro h1 h2,
end

-- Capítulo 3, Lema 3.12.4
theorem T10 (h1: P) : ¬ P ∨ Q ↔ Q:=
begin
split,
--de izquierda a derecha
assume h2,
cases h2 with hNP hQ,
--caso hNP
have h3: false, exact hNP h1,
exact false.elim h3,
--caso hQ
exact hQ,
-- de derecha a izquierda
assume h2,
exact or.inr h2,
end

-- Capítulo 5, Ejemplo 5.3, página 29
theorem T11: (P → Q) ↔ (¬P ∨ Q):=
begin
split,
--de izquierda a derecha
assume h1,
have h2: P ∨ ¬ P , exact em P,
cases h2 with hP hnP,
-- caso 1
have h3: Q, exact h1 hP,
exact or.inr h3,
-- caso 2
exact or.inl hnP,
-- de derecha a izquierda
assume h1,
cases h1 with hnP hQ,
--caso 1
assume h2,
have h3: false, exact hnP h2,
exact false.elim h3,
--caso 2
assume h2,
exact hQ,
end

-- Capítulo 5 Teorema 5.5.1, página 30
theorem T12 : (P ↔ Q) ↔ ((P → Q) ∧ (Q → P)) :=
begin
split,
-- de izquierda a derecha
assume h1,
have h2: P → Q, exact iff.elim_left h1,
have h3: Q → P, exact iff.elim_right h1,
exact and.intro h2 h3,
--de derecha a izquierda
assume h1,
have h2: P → Q, exact and.elim_left h1,
have h3: Q → P, exact and.elim_right h1,
split,
-- de izquierda a derecha
exact h2,
-- de derecha a izquierda
exact h3,
end

-- Capítulo 5 Teorema 5.5.2, página 31
theorem T13: (P → Q) ↔ (¬P ∨ Q):=
begin
split,
--de izquierda a derecha
assume h1,
have h2: P ∨ ¬ P , exact em P,
cases h2 with hP hnP,
-- caso 1
have h3: Q, exact h1 hP,
exact or.inr h3,
-- caso 2
exact or.inl hnP,
-- de derecha a izquierda
assume h1,
cases h1 with hnP hQ,
--caso 1
assume h2,
have h3: false, exact hnP h2,
exact false.elim h3,
--caso 2
assume h2,
exact hQ,
end

-- Capítulo 5 Teorema 5.5.3, página 31
theorem T14: (P ∨ Q) ↔ (¬ P → Q) :=
begin
split,
--de izquierda a derecha
assume h1,
cases h1 with hP hQ,
--caso hP
have h2: P ∨ ¬ P, exact em P,
assume h3,
have h4: false, exact h3 hP,
exact false.elim h4,
--caso hQ
assume h1,
exact hQ,
-- de derecha a izquierda
assume h1,
have h2: P ∨ ¬ P, exact em P,
cases h2 with hP hnP,
--caso hP
exact or.inl hP,
--caso hnP
have h1: Q, exact h1 hnP,
exact or.inr h1,
end

-- Capítulo 5 Teorema 5.5.4, página 31
theorem T15: (P ∨ Q) ↔ ¬ (¬ P ∧ ¬ Q) :=
begin
split,
-- de izquierda a derecha
assume h1,
by_contradiction h2,
have h3: ¬ P, exact and.elim_left h2,
have h4: ¬ Q, exact and.elim_right h2,
cases h1 with hP hQ,
-- caso 1
exact h3 hP,
--caso 2
exact h4 hQ,
-- de derecha a izquierda
assume h1,
have h2: P ∨ ¬ P, exact em P,
cases h2 with hP hnP,
exact or.inl hP,
have h3: Q ∨ ¬ Q, exact em Q,
cases h3 with hQ hnQ,
exact or.inr hQ,
have h4: ¬ P ∧ ¬ Q , exact and.intro hnP hnQ,
have h5: false, exact h1 h4,
exact false.elim h5,
end

-- Capítulo 5 Teorema 5.5.5, página 31
theorem T16: (P ∧ Q) ↔ ¬ (¬ Q ∨ ¬ P):=
begin
split,
-- de izquierda a derecha
assume h1,
by_contradiction h2,
cases h2 with hnQ hnP,
have h3: Q, exact and.elim_right h1,
exact hnQ h3,
have h4: P, exact and.elim_left h1,
exact hnP h4,
-- de derecha a izquierda
assume h1,
have h2: P ∨ ¬ P, exact em P,
cases h2 with hP hnP,
have h3: Q ∨ ¬ Q, exact em Q,
cases h3 with hQ hnQ,
exact and.intro hP hQ,
have h4: ¬ Q ∨ ¬ P, exact or.inl hnQ,
have h5: false, exact h1 h4,
exact false.elim h5,
have h2: Q ∨ ¬ Q, exact em Q,
cases h2 with hQ hnQ,
have h3: ¬ Q ∨ ¬ P , exact or.inr hnP,
have h5: false, exact h1 h3,
exact false.elim h5,
have h2: ¬ Q ∨ ¬ P, exact or.inr hnP,
have h3: false, exact h1 h2,
exact false.elim h3,
end

-- Capítulo 5 Teorema 5.5.6, página 31
theorem T17: (¬ P) ↔ P → false  :=
begin
split,
-- de izquierda a derecha
assume h1,
assume h2,
exact h1 h2,
-- de derecha a izquierda
assume h1,
exact h1,
end

-- Capítulo 5 Teorema 5.5.7, página 31
theorem T18: false ↔ (P ∧ ¬ P):=
begin
split,
-- de izquierda a derecha
assume h1,
exact false.elim h1,
-- de derecha a izquierda
assume h1,
cases h1 with hP hnP,
exact hnP hP,
end

-- Capítulo 6, Teorema 6.1, 1.1 Asociatividad de ∧
theorem T19: ((P ∧ Q) ∧ R) ↔ (P ∧ (Q ∧ R)):=
begin
split,
assume h1,
have h2: R, exact and.elim_right h1,
have h3: P ∧ Q, exact and.elim_left h1,
have h4: P, exact and.elim_left h3,
have h5: Q, exact and.elim_right h3,
have h6: Q ∧ R, exact and.intro h5 h2,
exact and.intro h4 h6,
assume h1,
have h2: P, exact and.elim_left h1,
have h3: Q ∧ R, exact and.elim_right h1,
have h4: Q, exact and.elim_left h3,
have h5: R, exact and.elim_right h3,
have h6: P ∧ Q, exact and.intro h2 h4,
exact and.intro h6 h5,
end

-- Capítulo 6, Teorema 6.1, 1.2 Asociatividad de ∨
theorem T20: ((P ∨ Q) ∨ R) ↔ (P ∨ (Q ∨ R)):=
begin
split,
assume h1,
cases h1 with hPQ hR,
cases hPQ with hP hQ,
exact or.inl hP,
have h1: Q ∨ R, exact or.inl hQ,
exact or.inr h1,
have h1: Q ∨ R, exact or.inr hR,
exact or.inr h1,
assume h1,
cases h1 with hP hQR,
have h1: P ∨ Q, exact or.inl  hP,
exact or.inl h1,
cases hQR with hQ hR,
have h1: P ∨ Q, exact or.inr hQ,
exact or.inl h1,
exact or.inr hR,
end

-- Capítulo 6, Teorema 6.1, 2.1 Neutro para ∧
theorem T21: (P ∧ ¬ false) ↔ P:=
begin
split,
assume h1,
exact and.elim_left h1,
assume h1,
have h2: ¬ false, by_contradiction h3,
exact h3,
exact and.intro h1 h2,
end

-- Capítulo 6, Teorema 6.1, 2.2 Neutro para ∨
theorem T22: (P ∨ false) ↔ P:=
begin
split,
-- de izquierda a derecha
assume h1,
cases h1 with hP hF,
--caso 1
exact hP,
--caso 2
exact false.elim hF,
-- de derecha a izquierda
assume h1,
exact or.inl h1,
end

-- Capítulo 6, Teorema 6.1, 3.1 Commutatividad de ∧
theorem T23: (P ∧ Q) ↔ (Q ∧ P):=
begin
split,
-- de izquierda a derecha
assume h1,
have h2: P, exact and.elim_left h1,
have h3: Q, exact and.elim_right h1,
exact and.intro h3 h2,
-- de derecha a izquierda
assume h1,
have h2: Q, exact and.elim_left h1,
have h3: P, exact and.elim_right h1,
exact and.intro h3 h2,
end

-- Capítulo 6, Teorema 6.1, 3.2 Commutatividad de ∨
theorem T24: (P ∨ Q) ↔ (Q ∨ P):=
begin
split,
-- de izquierda a derecha
assume h1,
cases h1 with hP hQ,
--caso 1
exact or.inr hP,
--caso 2
exact or.inl hQ,
-- de derecha a izquierda
assume h1,
cases h1 with hQ hP,
--caso 1
exact or.inr hQ,
--caso 2
exact or.inl hP,
end

-- Capítulo 6, Teorema 6.1, 4.1 Distributividad de ∧
theorem T25: P ∨ (Q ∧ R) ↔ (P ∨ Q) ∧ (P ∨ R):=
begin
split,
assume h1,
cases h1 with h1 h2,
have h2: P ∨ Q, exact or.inl h1,
have h3: P ∨ R, exact or.inl h1,
exact and.intro h2 h3,
have h3: Q, exact and.elim_left h2,
have h4: R, exact and.elim_right h2,
have h5: P ∨ Q, exact or.inr h3,
have h6: P ∨ R, exact or.inr h4,
exact and.intro h5 h6,
assume h1,
have h2: P ∨ Q, exact and.elim_left h1,
have h3: P ∨ R, exact and.elim_right h1,
cases h2 with hP hQ,
exact or.inl hP,
cases h3 with hP hR,
exact or.inl hP,
exact or.inr (and.intro hQ hR),
end

-- Capítulo 6, Teorema 6.1, 4.2 Distributividad de ∨
theorem T26: P ∧ (Q ∨ R) ↔ (P ∧ Q) ∨ (P ∧ R):=
begin
split,
assume h1,
have hP: P, exact and.elim_left h1,
have hQR: Q ∨ R, exact and.elim_right h1,
cases hQR with hQ hR,
exact or.inl (and.intro hP hQ),
exact or.inr (and.intro hP hR),
assume h1,
cases h1 with hPQ hPR,
have hP: P, exact and.elim_left hPQ,
have hQ: Q, exact and.elim_right hPQ,
have hQR: Q ∨ R, exact or.inl hQ,
exact and.intro hP hQR,
have hP: P, exact and.elim_left hPR,
have hR: R, exact and.elim_right hPR,
have hQR: Q ∨ R, exact or.inr hR,
exact and.intro hP hQR,
end

-- Capítulo 6, Teorema 6.1, 5.1 Leyes de De Morgan
theorem T27: ¬ (P ∧ Q) ↔ (¬ P ∨ ¬ Q):=
begin
split,
assume h1,
have h2: P ∨ ¬ P, exact em P,
cases h2 with h2,
have h3: Q ∨ ¬ Q, exact em Q,
cases h3 with h3,
have h4: P ∧ Q, exact and.intro h2 h3,
have h5 : false, exact h1 h4,
exact false.elim h5,
exact or.inr h3,
exact or.inl h2,
assume h1,
by_contradiction h2,
have h3: P, exact and.elim_left h2,
have h4: Q, exact and.elim_right h2,
cases h1 with h1,
exact h1 h3,
exact h1 h4,
end

-- Capítulo 6, Teorema 6.1, 5.2 Leyes de De Morgan
theorem T28: ¬ (P ∨ Q) ↔ (¬ P ∧ ¬ Q):=
begin
split,
assume h1,
have hP: ¬ P, by_contradiction hP,
have hPQ: P ∨ Q, exact or.inl hP,
exact h1 hPQ,
have hQ: ¬ Q, by_contradiction hQ,
have hPQ: P ∨ Q, exact or.inr hQ,
exact h1 hPQ,
exact and.intro hP hQ,
assume h1,
have h2: ¬ P, exact and.elim_left h1,
have h3: ¬ Q, exact and.elim_right h1,
by_contradiction h4,
cases h4 with hP hQ,
exact h2 hP,
exact h3 hQ,
end

-- Capítulo 6, Teorema 6.1, 6.1 Idempotencia de ∧
theorem T29: P ∧ P ↔ P:=
begin
split,
--de izquierda a derecha
assume h1,
exact and.elim_left h1,
-- de derecha a izquierda
assume h1,
exact and.intro h1 h1,
end

-- Capítulo 6, Teorema 6.1, 6.2 Idempotencia de ∨
theorem T30: P ∨ P ↔ P:=
begin
split,
-- de izquierda a derecha
assume h1,
cases h1 with hP hiP,
exact hP,
exact hiP,
-- de derecha a izquierda
assume h1,
exact or.inl h1,
end

-- Capítulo 6, Teorema 6.1, 7 Doble negación
theorem T31: ¬ ¬ P ↔ P:=
begin
split,
-- de izquierda a derecha
assume h1,
by_contradiction h2,
exact h1 h2,
-- de derecha a izquierda
assume h1,
by_contradiction h2,
exact h2 h1,
end

-- Capítulo 6, Teorema 6.2, 1 Exportación e importación
theorem T32: P → (Q → R) ↔ P ∧ Q → R:=
begin
split,
assume h1,
assume h2,
have h3: P, exact and.elim_left h2,
have h4: Q, exact and.elim_right h2,
have h5: Q→ R, exact h1 h3,
exact h5 h4,
assume h1,
assume h2,
assume h3,
have h4: P ∧ Q , exact and.intro h2 h3,
exact h1 h4,
end

-- Capítulo 6, Teorema 6.2, 2 Contraposición
theorem T33: P → Q ↔ ¬ Q → ¬ P:=
begin
split,
-- de izquierda a derecha
assume h1,
assume h2,
have h3: ¬ P, by_contradiction hP,
have h4: Q, exact h1 hP,
exact h2 h4,
exact h3,
-- de derecha a izquierda
assume h1,
assume h2,
have h2: Q, by_contradiction hQ,
have h3: ¬P, exact h1 hQ,
exact h3 h2,
exact h2,
end

-- Capítulo 6, Teorema 6.2, 3 Implicación de una disjuntiva
theorem T34: ((P ∨ Q) → R) ↔ (P → R) ∧ (Q → R):=
begin
split,
-- de izquierda a derecha
assume h1,
have h2: P → R,
assume h3,
have h4: P ∨ Q, exact or.inl h3,
exact h1 h4,
have h3: Q → R,
assume h4,
have h5: P ∨ Q, exact or.inr h4,
exact h1 h5,
exact and.intro h2 h3,
-- de derecha a izquierda
assume h1,
have h2: P → R, exact and.elim_left h1,
have h3: Q → R, exact and.elim_right h1,
assume h4,
cases h4 with hP hQ,
--caso hP
exact h2 hP,
--caso hQ
exact h3 hQ,
end

-- Capítulo 6, Teorema 6.2, 4 Implicación a una disjuntiva
theorem T35: R → (P ∧ Q) ↔ (R → P) ∧ (R → Q):=
begin
split,
-- de izquierda a derecha
assume h1,
have h2: R → P,
assume h3,
have h4: P ∧ Q, exact h1 h3,
exact and.elim_left h4,
have h7: R → Q,
assume h3,
have h4: P ∧ Q, exact h1 h3,
exact and.elim_right h4,
exact and.intro h2 h7,
-- de derecha a izquierda
assume h1,
assume h2,
have h3: R → P, exact and.elim_left h1,
have h4: R → Q, exact and.elim_right h1,
have h5: P, exact h3 h2,
have h6: Q, exact h4 h2,
exact and.intro h5 h6,
end


/-
Copyright (c) 2022 Hans Parshall. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Hans Parshall
-/
import analysis.matrix
import analysis.normed_space.basic
import data.complex.is_R_or_C
import linear_algebra.unitary_group

/-!
# Unitary matrices

This file collects facts about the unitary matrices over `𝕜` (either `ℝ` or `ℂ`).
-/

open_locale big_operators matrix

variables {𝕜 m n E : Type*}

section entrywise_sup_norm
variables [is_R_or_C 𝕜] [fintype n] [decidable_eq n]

lemma entry_norm_bound_of_unitary {U : matrix n n 𝕜} (hU : U ∈ matrix.unitary_group n 𝕜) (i j : n):
  ∥U i j∥ ≤ 1 :=
begin
  -- The norm squared of an entry is at most the L2 norm of its row.
  have norm_sum : ∥ U i j ∥^2 ≤ (∑ x, ∥ U i x ∥^2),
  { apply multiset.single_le_sum,
    { intros x h_x,
      rw multiset.mem_map at h_x,
      cases h_x with a h_a,
      rw ← h_a.2,
      apply sq_nonneg },
    { rw multiset.mem_map,
      use j,
      simp only [eq_self_iff_true, finset.mem_univ_val, and_self, sq_eq_sq] } },
  -- The L2 norm of a row is a diagonal entry of U ⬝ Uᴴ
  have diag_eq_norm_sum : (U ⬝ Uᴴ) i i = ∑ (x : n), ∥ U i x ∥^2,
  { simp only [matrix.mul_apply, matrix.conj_transpose_apply, ←star_ring_end_apply,
               is_R_or_C.mul_conj, is_R_or_C.norm_sq_eq_def', is_R_or_C.of_real_pow] },
  -- The L2 norm of a row is a diagonal entry of U ⬝ Uᴴ, real part
  have re_diag_eq_norm_sum : is_R_or_C.re ((U ⬝ Uᴴ) i i) = ∑ (x : n), ∥ U i x ∥^2,
  { rw is_R_or_C.ext_iff at diag_eq_norm_sum,
    rw diag_eq_norm_sum.1,
    norm_cast },
  -- Since U is unitary, the diagonal entries of U ⬝ Uᴴ are all 1
  have mul_eq_one : (U ⬝ Uᴴ) = 1, from unitary.mul_star_self_of_mem hU,
  have diag_eq_one : is_R_or_C.re ((U ⬝ Uᴴ) i i) = 1,
  { simp only [mul_eq_one, eq_self_iff_true, matrix.one_apply_eq, is_R_or_C.one_re] },
  -- Putting it all together
  rw [← sq_le_one_iff (norm_nonneg (U i j)), ← diag_eq_one, re_diag_eq_norm_sum],
  exact norm_sum,
end

local attribute [instance] matrix.normed_group

/-- The entrywise sup norm of a unitary matrix is at most 1. -/
lemma entrywise_sup_norm_bound_of_unitary {U : matrix n n 𝕜} (hU : U ∈ matrix.unitary_group n 𝕜) :
  ∥ U ∥ ≤ 1 :=
begin
  simp_rw pi_norm_le_iff zero_le_one,
  intros i j,
  exact entry_norm_bound_of_unitary hU _ _
end

end entrywise_sup_norm


import tactic --hide

-- Level name : Boss level

/- Hint : Hint 1
 Notice we have three implications, so we need to introduce all of them using `intros`.

-/

/-Hint : Hint 2
When using `apply` we need to make sure that we use an assumption that contains our goal.

-/

/-Hint : Hint 3
If we have more than one goal to prove, then we need to do them in order. By default the lean
applies the tactics to the first goal until complete and then moves on to the next.

-/

/-Lemma
If $P,Q,R$ are logical statements and
 $(P \implies Q \implies R)$  then $((P \implies Q) \implies (P \implies R)$.
-/
lemma lemma_5 (P Q R : Prop) : (P → Q → R) → (P → Q) → (P → R) :=
begin
  intros hPQR hPQ hP,
  apply hPQR,
  { exact hP },
  { apply hPQ,
    exact hP }

end

/- Hint : Tip
To skip proving a goal you can  write `sorry,`. But don't forget to go back and prove it to solve the
level.

-/


/-
The plan for this week is to tackle the typeclass system in Lean, which is the last

We will do this by working through a few extended examples of some "real mathematics". In
particular, we'll be talking about _monoids_ and _groups_.
-/
import tactic

/-
If you asked a mathematican what a monoid is they'd say something like "It's a set, together with
a binary map which is associative and has two-sided identities." Before we try to implement this
definition we'll begin by making 1 modification:

Lean can talk about sets, but it is a lot more natural to define monoid structures on types instead.
Not much is lost in making this modification, and in fact there is a lot to be gained (if we go the
further step in making our types universe polymorphic)

Without further ado, we then would arrive at the following definition:
-/

#check mul_assoc

universe u

#check mul_assoc

structure mymonoid :=
(carrier : Type u)
(id' : carrier)
(mul' : carrier → carrier → carrier)
(mul_assoc' : ∀(a b c : carrier), mul' (mul' a b) c = mul' a (mul' b c))
(id_mul' : ∀a, mul' id' a = a)
(mul_id' : ∀a, mul' a id' = a)

namespace mymonoid

/-
Writing `mul` all over the place is annoying, so we can do this. Note we're secretly doing some
typeclass stuff here
-/
instance (M : mymonoid) : has_mul M.carrier := { mul := M.mul' }
instance (M : mymonoid) : has_one M.carrier := { one := M.id' }

@[simp] lemma mul_assoc {M : mymonoid} : ∀(a b c : M.carrier), a * b * c = a * (b * c) := sorry

@[simp] lemma id_mul {M : mymonoid} : ∀(a : M.carrier), 1 * a = a := sorry

@[simp] lemma mul_id {M : mymonoid} : ∀(a : M.carrier), a * 1 = a := sorry

theorem unique_id {M : mymonoid} {e : M.carrier} (hid : ∀a, e * a = a) : e = 1 :=
begin
  specialize hid 1,
  simp at hid,
  exact hid,
end

end mymonoid

/-
The way we construct some new examples of these objects is by defining things of the appropriate
types. For example
-/

def mynat : mymonoid :=
{ carrier := ℕ,
  id' := 0,
  mul' := (+),
  mul_assoc' := add_assoc,
  id_mul' := zero_add,
  mul_id' := add_zero }

/-
As you can see from dealing with mymonoid, we're running into some annoying issues. The first of
which is that we have to constantly talk about the underlying type of a `M : mymonoid` by calling it
with `M.carrier`, when in principle it doesn't have any more information than a type `M` anyway.

The solution to this is to **un-bundle** the type from the structure. In some sense, we're taking
our algebraic objects and turning them into function types...
-/

structure mymonoid' (M : Type u) :=
(id' : M)
(mul' : M → M → M)
(mul_assoc' : ∀(a b c : M), mul' (mul' a b) c = mul' a (mul' b c))
(id_mul' : ∀a, mul' id' a = a)
(mul_id' : ∀a, mul' a id' = a)

/-
Of course these two constructures are equivalent to each other.
-/

example (M : Type u) : mymonoid' M → mymonoid := λh, { carrier := M,
  id' := h.id',
  mul' := h.mul',
  mul_assoc' := h.mul_assoc',
  id_mul' := h.id_mul',
  mul_id' := h.mul_id' }

example : Π(M : mymonoid), mymonoid' M.carrier := λM, { id' := M.id', -- note the dependent type!
  mul' := M.mul',
  mul_assoc' := M.mul_assoc',
  id_mul' := M.id_mul',
  mul_id' := M.mul_id' }

/-
You may have noticed a little bit of an annoying feature in the above arguments: Because everything
was named exactly the same between the two different

We can actually simplify the above kinds of arguments into really simple 1 or 2 line arguments:
-/

example (M : Type u) : mymonoid' M → mymonoid := λh, { carrier := M,
 ..h }

example : Π(M : mymonoid), mymonoid' M.carrier := λM, { ..M }

/-
The `..h` and `..M` say "Look at all the records defining this structure, and unfold them all and
provide." It's important that the names actually matched between the two structures, as otherwise
this wouldn't work.

There is still something annoying about this construction, and it will become most obvious if we
want to define an extension of our object:
-/

structure mygroup' (G : Type u) extends mymonoid' G :=
(inv': G → G)
(mul_inv' : ∀g, mul' g (inv' g) = id')

def int_group' : mygroup' ℤ := { id' := 0,
  mul' := (+),
  mul_assoc' :=add_assoc,
  id_mul' := zero_add,
  mul_id' := add_zero,
  inv' := λz, -z,
  mul_inv' :=  add_neg_self }

/-
Great! We've got a `mygroup'`. But a `mygroup'` extends a `mymonoid'`... But we have no way to
access all the results we may have proven about `mymonoid'` to `int_group'`!
-/

/-
This problem, and many others are solved entirely by the **type class** system in Lean... You may
have seen the `[   ]` variable declarations, and these are exactly type classes! Lets see how
groups in Lean are actually implemented:
-/

#check group

/-
That was a trip! But it was classes all the way down! has_mul, semigroup, monoid, and finally group.
The great thing is that if we prove something about monoids, then we get the results for free for
any group because of the typeclass inheritance.

It also solves the issue of having all those annoying structure declarations having to be explicit,
Lean has a **type class inference** system which can deduce instances of a typeclass based off
rules available to it. Lets do some examples:
-/

class mymonoid'' (M : Type u) extends has_mul M, has_one M:= -- `extends` is not unique to classes
(mul_assoc : ∀(a b c : M), a * b * c = a * (b * c))
(id_mul : ∀a, 1 * a = a)
(mul_id : ∀a, a * 1 = a)

namespace mymonoid''

universe v

variables {M : Type u} {N : Type v} [mymonoid'' M] [mymonoid'' N]

/-
We can now provide _instances_ for the typeclass system to start inhabiting. These can be as simple
as showing previously defined structures are monoids:
-/

instance nat_is_monoid: mymonoid'' ℕ := { mul := (+),
  one := 0,
  mul_assoc := add_assoc,
  id_mul := sorry,
  mul_id := sorry }

/-
We can even define instances in terms of other instances
-/

instance monoid_prod : mymonoid'' (M × N) := { mul := λp q, ⟨p.1 * q.1, p.2 * q.2⟩,
  one := ⟨1, 1⟩,
  mul_assoc :=
  begin
    intros a b c,
    ext,
    exact mul_assoc a.1 b.1 c.1,
    exact mul_assoc a.2 b.2 c.2,
  end,
  id_mul := sorry,
  mul_id := sorry }

variables (g h : M × N)

#check g * h

end mymonoid''

/-
This is a synonym for `class`!
-/
@[class] structure mygroup'' (G : Type u) extends mymonoid'' G, has_inv G:=
(mul_inv : ∀(g : G), g * g⁻¹ = 1)

instance int_mygroup : mygroup'' ℤ :=
{ mul := (+),
  one := 0,
  mul_assoc := add_assoc,
  id_mul := sorry,
  mul_id := sorry,
  inv := has_neg.neg,
  mul_inv := add_neg_self}

variables (G H : Type) [mygroup'' G] [mygroup'' H]
variables (g h : G × H)

#check g * h

#print instances mygroup''

/-
Finally, let me just say a few words about where type classes are helpful in your day to day life as
a programmer.

Typeclasses give you a way of defining polymorphic functions!
-/

class printable (T : Type) :=
(print: T → string)

class foldable (T : Type → Type) :=
(fold (α β : Type) : (α → β → β) → β → T α → β)

#check list

instance : foldable list :=
{ fold := λα β m b L, begin
  cases L,
  exact b,
  exact m L_hd b,
end }


/-
Copyright (c) 2021 Yourong Zang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yourong Zang
-/
import analysis.normed_space.conformal_linear_map
import analysis.inner_product_space.basic

/-!
# Conformal maps between inner product spaces

In an inner product space, a map is conformal iff it preserves inner products up to a scalar factor.
-/

variables {E F : Type*} [inner_product_space ℝ E] [inner_product_space ℝ F]

open linear_isometry continuous_linear_map
open_locale real_inner_product_space

lemma is_conformal_map_iff (f' : E →L[ℝ] F) :
  is_conformal_map f' ↔ ∃ (c : ℝ), 0 < c ∧
  ∀ (u v : E), ⟪f' u, f' v⟫ = (c : ℝ) * ⟪u, v⟫ :=
begin
  split,
  { rintros ⟨c₁, hc₁, li, h⟩,
    refine ⟨c₁ * c₁, mul_self_pos.2 hc₁, λ u v, _⟩,
    simp only [h, pi.smul_apply, inner_map_map,
               real_inner_smul_left, real_inner_smul_right, mul_assoc], },
  { rintros ⟨c₁, hc₁, huv⟩,
    let c := real.sqrt c₁⁻¹,
    have hc : c ≠ 0 := λ w, by {simp only [c] at w;
      exact (real.sqrt_ne_zero'.mpr $ inv_pos.mpr hc₁) w},
    let f₁ := c • f',
    have minor : (f₁ : E → F) = c • f' := rfl,
    have minor' : (f' : E → F) = c⁻¹ • f₁ := by ext;
      simp_rw [minor, pi.smul_apply]; rw [smul_smul, inv_mul_cancel hc, one_smul],
    refine ⟨c⁻¹, inv_ne_zero hc, f₁.to_linear_map.isometry_of_inner (λ u v, _), minor'⟩,
    simp_rw [to_linear_map_eq_coe, continuous_linear_map.coe_coe, minor, pi.smul_apply],
    rw [real_inner_smul_left, real_inner_smul_right,
        huv u v, ← mul_assoc, ← mul_assoc,
        real.mul_self_sqrt $ le_of_lt $ inv_pos.mpr hc₁,
        inv_mul_cancel $ ne_of_gt hc₁, one_mul], },
end


import algebra.group_power
/-
M1F 2017-18 Sheet 1 Question 1
Author : Kevin Buzzard

This file should work with any version of lean -- whether you installed it yourself
or are running the version on https://leanprover.github.io/live/latest/

-/

-- Ignore the next 4 lines -- they are just defining the power notation :-)
--@[reducible] definition pow : int -> nat -> int
--| _ 0 := (1:int)
--| x (nat.succ n) := x * (pow x n)
--notation x `^` n := pow x n
-- Power notation is in the maths library but then you have to figure out
-- how to import the maths library. Now we have this definition, this
-- file *just works*, with any recent version of lean.

-- The rest of this file is the six parts of M1F Sheet 1 Q1.

-- part (a): which one of these is provable? Prove one, delete
-- the other.

theorem m1f_sheet01_q01a_is_T : ∀ x : ℤ, x^2 - 3*x + 2 = 0 → x=1 := sorry
theorem m1f_sheet01_q01a_is_F : ¬ (∀ x : ℤ, x^2 - 3*x + 2 = 0 → x=1) := sorry

-- part (b) etc etc.

theorem m1f_sheet01_q01b_is_T : ∀ x : ℤ, x=1 → x^2-3*x+2=0 := sorry
theorem m1f_sheet01_q01b_is_F : ¬ (∀ x : ℤ, x=1 → x^2-3*x+2=0) := sorry

-- part (c)

theorem m1f_sheet01_q01c_is_T : ∀ x : ℤ, x^2 - 3*x + 2 = 0 ↔ x=1 := sorry
theorem m1f_sheet01_q01c_is_F : ¬ (∀ x : ℤ, x^2 - 3*x + 2 = 0 ↔ x=1) := sorry

-- part (d)

theorem m1f_sheet01_q01d_is_T : ∀ x : ℤ, x^2 - 3*x + 2 = 0 ↔ (x=1 ∨ x=2) := sorry
theorem m1f_sheet01_q01d_is_F : ¬ (∀ x : ℤ, x^2 - 3*x + 2 = 0 ↔ (x=1 ∨ x=2)) := sorry

-- part (e)

theorem m1f_sheet01_q01e_is_T : ∀ x : ℤ, x^2 - 3*x + 2 = 0 → (x=1 ∨ x=2 ∨ x=3) := sorry
theorem m1f_sheet01_q01e_is_F : ¬ (∀ x : ℤ, x^2 - 3*x + 2 = 0 → (x=1 ∨ x=2 ∨ x=3)) := sorry

-- part (f)

theorem m1f_sheet01_q01f_is_T : ∀ x : ℤ, (x=1 ∨ x=2 ∨ x=3) → x^2 - 3*x + 2 = 0  := sorry
theorem m1f_sheet01_q01f_is_F : ¬ (∀ x : ℤ, (x=1 ∨ x=2 ∨ x=3) → x^2 - 3*x + 2 = 0)  := sorry


import tactic.ring
import tactic.linarith

-- Testing ground for theorems

theorem contrapositive
  (P Q : Prop) (HPQ : P → Q) : ¬ Q → ¬ P :=
by {intros hnq hp, from hnq (HPQ hp)}

theorem and_transitive (P Q R : Prop) :
  (P ∧ Q) ∧ (Q ∧ R) → (P ∧ R) :=
by {intro h, from ⟨h.left.left, h.right.right⟩}

theorem iff_symmetric
    (P Q : Prop) : (P ↔ Q) ↔ (Q ↔ P) :=
by {split,
  {intro h, rw h},
  {intro h, rw h}
}

example
  (P Q R : Prop) : (P ↔ Q) ∧ (Q ↔ R) → (P ↔ R) :=
by {
  intro h, split,
  {intro hp, rwa [←h.right, ←h.left]},
  {intro hr, rwa [h.left, h.right]}
}

example
  (P : Prop) : ¬ (¬ P) ↔ P :=
by {
  split,
  {intro h,
  cases classical.em P,
    {assumption},
    {contradiction} },
  {intros hp hnp, contradiction}
}

example
  (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) :=
by {
  intros h hp,
  apply classical.by_contradiction,
  intro hnq,
  from (h hnq) hp
}

example (P Q R : Prop) : (P → Q) ∧ (Q → R) → (P → R) :=
by {intros h hp, from h.right (h.left hp)}

example
  (X : Type) (P Q : X → Prop) (a : X) (HP : ∀ x : X, P x) (HQ : ∀ x : X, Q x): P a ∧ Q a :=
by {from ⟨HP a, HQ a⟩}

example (P Q : Prop) : ¬ P → ¬ (P ∧ Q) :=
by {intro h, push_neg, left, assumption}

example
  (P Q R : Prop) : P ∧ (Q ∨ R) ↔ (P ∧ Q) ∨ (P ∧ R) :=
by {
  split,
  {intro h, cases h.right with Q R,
  all_goals { {left, from ⟨h.left, Q⟩}  <|> {right, from ⟨h.left, R⟩} } },
  {intro h, cases h,
  all_goals {split, from h.left},
  {left, from h.right},
  {right, from h.right}  }
}

example
    (P Q : Prop) : ¬ (P ∧ Q) → ¬ P ∨ ¬ Q :=
by {push_neg, intro, assumption}

example
  (P Q : Prop) : ¬ (P ∧ ¬ Q) → (P → Q) :=
by {
  push_neg, intros h hp, cases h,
  {contradiction},
  {assumption}
}

example
  (P Q : Prop) : ¬ (P → Q) → (P ∧ ¬ Q) :=
by {push_neg, intro, assumption}

example
  (P Q : Prop) : (P ∧ ¬ Q) → ¬ (P → Q) :=
by {push_neg, intro, assumption}

variables p q r : Prop

example : p ∨ q → q ∨ p :=
by {intro h, cases h, all_goals{{left, assumption} <|> {right, assumption}}}

example : ¬ (p ↔ ¬ p) :=
by {
  intro h,
  cases classical.em p with hp hnp,
  {from (h.mp hp) hp},
  {from hnp (h.mpr hnp)}
}

example : p ∨ ¬ p :=
by {
  cases classical.em p,
  all_goals { {left, assumption} <|> {right, assumption} }
}

example : (p → q) ↔ (¬ q → ¬ p) :=
by {
  split,
  all_goals {intros a b},
  {intro h, from b (a h)},
  {apply classical.by_contradiction, intro h, from (a h) b}
}

variables (X : Type) (P Q : X → Prop)

example : (∀ x, P x ∧ Q x) → (∀ x, Q x ∧ P x) :=
by {
  intros h x,
  split, all_goals {  {from (h x).right} <|>  {from (h x).left} }
}

example : (∃ x, P x ∨ Q x) → (∃ x, Q x ∨ P x) :=
by {
  rintro ⟨x, hx⟩, existsi x,
  cases hx,
  all_goals { {left, assumption} <|> {right, assumption}}
}

example : (∀ x, P x) ∧ (∀ x, Q x) ↔ (∀ x, P x ∧ Q x) :=
by {
  split,
  {rintros ⟨hp, hq⟩ x, from ⟨hp x, hq x⟩},
  {intro h, split,
  all_goals {intro x, from (h x).left <|> from (h x).right} }
}

example : (∃ x, P x) ∨ (∃ x, Q x) ↔ (∃ x, P x ∨ Q x) :=
by {
  split,
  {intro h, repeat {rcases h with ⟨x, hx⟩},
  all_goals {existsi x, {left, assumption} <|> {right, assumption}  }
  },
  {rintro ⟨x, hx⟩, cases hx,
  {left, existsi x, assumption},
  {right, existsi x, assumption} }
}

example (α : Type) (p q : α → Prop) : (∀ x : α, p x ∧ q x) → ∀ x : α, p x  :=
by {intros h x, from (h x).left}

example : ¬ (∀ x, P x) ↔ ∃ x, ¬ P x :=
by {push_neg, refl}

def even (a : ℤ) := ∃ b : ℤ, a = 2 * b
def odd (a : ℤ) := ∃ b : ℤ, a = 2 * b + 1

theorem timeseven
  (a : ℤ) : even a → even (a * a) :=
begin
  intro h,
  have h1 : ∃ b : ℤ, a = 2 * b, exact h,
  have h2 : ∃ b : ℤ, a * a = 2 * b,
  cases h1 with hz ha,
  existsi 2 * hz * hz,
  rw ha,
  have hc : 2 * hz = hz * 2,
    rw mul_comm,
  rw [hc, mul_assoc, mul_assoc, hc, mul_left_comm],
  exact h2,
end

theorem timesodd
  (a : ℤ) : odd a → odd (a * a) :=
begin
  intro h,
  have h1 : ∃ b : ℤ, a = 2 * b + 1, exact h,
  have h2 : ∃ b : ℤ, a * a = 2 * b + 1,
  cases h1 with x ha,
  existsi 2 * x * x + 2 * x,
  rw ha,
  ring,
  exact h2,
end

theorem eventimesodd
  (a b : ℤ) : odd a ∧ even b → even (a * b) :=
begin
  intro h,
  cases h with ha hb,
  have h1 : ∃ c : ℤ, a = 2 * c + 1, exact ha,
  have h2 : ∃ c : ℤ, b = 2 * c, exact hb,
  have h3 : ∃ c : ℤ, a * b = 2 * c,
  cases h1 with x0 hk,
  cases h2 with x1 hm,
  existsi x1 * (2 * x0 + 1),
  rw hk, rw hm,
  ring,
  exact h3,
end

theorem orderx (x y z : ℕ) (h : z > 0) : x > y → x * z > y * z :=
by {from (mul_lt_mul_right h).mpr}

theorem orderone (a b : ℕ) (ha : a > 1) : b > 1 → a * b > a :=
begin
  intro h,
  have hb : b > 0,
    have h0 : 1 > 0,
      simp,
    exact trans h h0,
  have hc : a = a * 1, simp,
  rw hc,
  have hd : 1 * b = b, simp,
  rw mul_assoc,
  rw hd,
  rw mul_comm,
  have he : a * 1 = 1 * a, simp,
  rw he,
  apply orderx,
  have hf : 1 > 0, simp,
  exact trans ha hf,
  exact h,
end

theorem ordermul
  (a b n : ℕ) (h1 : a > 1) (h2 : b > 1): n > a * b → n > a ∧ n > b :=
begin
  intro h,
  split,
  have hab : a * b > a,
    apply orderone, exact h1, exact h2,
  exact trans h hab,
  have hba : a * b > b,
    rw mul_comm, apply orderone, exact h2, exact h1,
  exact trans h hba,
end

example (P Q : Prop) : ((P → Q) → P) → P :=
begin
  intro h,
  cases classical.em P with hp hnp,
  assumption,

  have ha : ¬ P → ¬ (P → Q),
    apply contrapositive,
    assumption,
  have hb : ¬ (P → Q) := ha hnp,
  revert hb,
  push_neg,
  intro hc,
  exact hc.left,
end

example (a b : ℕ) : a + a = b + b → a = b :=
by{ring, rw nat.mul_left_inj, intro; assumption, simp}


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yury Kudryashov
-/
import data.set.intervals.basic

/-!

# Upper / lower bounds

In this file we define:

* `upper_bounds`, `lower_bounds` : the set of upper bounds (resp., lower bounds) of a set;
* `bdd_above s`, `bdd_below s` : the set `s` is bounded above (resp., below), i.e., the set of upper
  (resp., lower) bounds of `s` is nonempty;
* `is_least s a`, `is_greatest s a` : `a` is a least (resp., greatest) element of `s`;
  for a partial order, it is unique if exists;
* `is_lub s a`, `is_glb s a` : `a` is a least upper bound (resp., a greatest lower bound)
  of `s`; for a partial order, it is unique if exists.

We also prove various lemmas about monotonicity, behaviour under `∪`, `∩`, `insert`, and provide
formulas for `∅`, `univ`, and intervals.
-/
open set order_dual (to_dual of_dual)

universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {ι : Sort x}

section
variables [preorder α] [preorder β] {s t : set α} {a b : α}

/-!
### Definitions
-/

/-- The set of upper bounds of a set. -/
def upper_bounds (s : set α) : set α := { x | ∀ ⦃a⦄, a ∈ s → a ≤ x }
/-- The set of lower bounds of a set. -/
def lower_bounds (s : set α) : set α := { x | ∀ ⦃a⦄, a ∈ s → x ≤ a }

/-- A set is bounded above if there exists an upper bound. -/
def bdd_above (s : set α) := (upper_bounds s).nonempty
/-- A set is bounded below if there exists a lower bound. -/
def bdd_below (s : set α) := (lower_bounds s).nonempty

/-- `a` is a least element of a set `s`; for a partial order, it is unique if exists. -/
def is_least (s : set α) (a : α) : Prop := a ∈ s ∧ a ∈ lower_bounds s
/-- `a` is a greatest element of a set `s`; for a partial order, it is unique if exists -/
def is_greatest (s : set α) (a : α) : Prop := a ∈ s ∧ a ∈ upper_bounds s

/-- `a` is a least upper bound of a set `s`; for a partial order, it is unique if exists. -/
def is_lub (s : set α) : α → Prop := is_least (upper_bounds s)
/-- `a` is a greatest lower bound of a set `s`; for a partial order, it is unique if exists. -/
def is_glb (s : set α) : α → Prop := is_greatest (lower_bounds s)

lemma mem_upper_bounds : a ∈ upper_bounds s ↔ ∀ x ∈ s, x ≤ a := iff.rfl

lemma mem_lower_bounds : a ∈ lower_bounds s ↔ ∀ x ∈ s, a ≤ x := iff.rfl

/-- A set `s` is not bounded above if and only if for each `x` there exists `y ∈ s` such that `x`
is not greater than or equal to `y`. This version only assumes `preorder` structure and uses
`¬(y ≤ x)`. A version for linear orders is called `not_bdd_above_iff`. -/
lemma not_bdd_above_iff' : ¬bdd_above s ↔ ∀ x, ∃ y ∈ s, ¬(y ≤ x) :=
by simp [bdd_above, upper_bounds, set.nonempty]

/-- A set `s` is not bounded below if and only if for each `x` there exists `y ∈ s` such that `x`
is not less than or equal to `y`. This version only assumes `preorder` structure and uses
`¬(x ≤ y)`. A version for linear orders is called `not_bdd_below_iff`. -/
lemma not_bdd_below_iff' : ¬bdd_below s ↔ ∀ x, ∃ y ∈ s, ¬(x ≤ y) :=
@not_bdd_above_iff' (order_dual α) _ _

/-- A set `s` is not bounded above if and only if for each `x` there exists `y ∈ s` that is greater
than `x`. A version for preorders is called `not_bdd_above_iff'`. -/
lemma not_bdd_above_iff {α : Type*} [linear_order α] {s : set α} :
  ¬bdd_above s ↔ ∀ x, ∃ y ∈ s, x < y :=
by simp only [not_bdd_above_iff', not_le]

/-- A set `s` is not bounded below if and only if for each `x` there exists `y ∈ s` that is less
than `x`. A version for preorders is called `not_bdd_below_iff'`. -/
lemma not_bdd_below_iff {α : Type*} [linear_order α] {s : set α} :
  ¬bdd_below s ↔ ∀ x, ∃ y ∈ s, y < x :=
@not_bdd_above_iff (order_dual α) _ _

lemma bdd_above.dual (h : bdd_above s) : bdd_below (of_dual ⁻¹' s) := h

lemma bdd_below.dual (h : bdd_below s) : bdd_above (of_dual ⁻¹' s) := h

lemma is_least.dual (h : is_least s a) : is_greatest (of_dual ⁻¹' s) (to_dual a) := h

lemma is_greatest.dual (h : is_greatest s a) : is_least (of_dual ⁻¹' s) (to_dual a) := h

lemma is_lub.dual (h : is_lub s a) : is_glb (of_dual ⁻¹' s) (to_dual a) := h

lemma is_glb.dual (h : is_glb s a) : is_lub (of_dual ⁻¹' s) (to_dual a) := h

/-!
### Monotonicity
-/

lemma upper_bounds_mono_set ⦃s t : set α⦄ (hst : s ⊆ t) :
  upper_bounds t ⊆ upper_bounds s :=
λ b hb x h, hb $ hst h

lemma lower_bounds_mono_set ⦃s t : set α⦄ (hst : s ⊆ t) :
  lower_bounds t ⊆ lower_bounds s :=
λ b hb x h, hb $ hst h

lemma upper_bounds_mono_mem ⦃a b⦄ (hab : a ≤ b) : a ∈ upper_bounds s → b ∈ upper_bounds s :=
λ ha x h, le_trans (ha h) hab

lemma lower_bounds_mono_mem ⦃a b⦄ (hab : a ≤ b) : b ∈ lower_bounds s → a ∈ lower_bounds s :=
λ hb x h, le_trans hab (hb h)

lemma upper_bounds_mono ⦃s t : set α⦄ (hst : s ⊆ t) ⦃a b⦄ (hab : a ≤ b) :
  a ∈ upper_bounds t → b ∈ upper_bounds s :=
λ ha, upper_bounds_mono_set hst $ upper_bounds_mono_mem hab ha

lemma lower_bounds_mono ⦃s t : set α⦄ (hst : s ⊆ t) ⦃a b⦄ (hab : a ≤ b) :
  b ∈ lower_bounds t → a ∈ lower_bounds s :=
λ hb, lower_bounds_mono_set hst $ lower_bounds_mono_mem hab hb

/-- If `s ⊆ t` and `t` is bounded above, then so is `s`. -/
lemma bdd_above.mono ⦃s t : set α⦄ (h : s ⊆ t) : bdd_above t → bdd_above s :=
nonempty.mono $ upper_bounds_mono_set h

/-- If `s ⊆ t` and `t` is bounded below, then so is `s`. -/
lemma bdd_below.mono ⦃s t : set α⦄ (h : s ⊆ t) : bdd_below t → bdd_below s :=
nonempty.mono $ lower_bounds_mono_set h

/-- If `a` is a least upper bound for sets `s` and `p`, then it is a least upper bound for any
set `t`, `s ⊆ t ⊆ p`. -/
lemma is_lub.of_subset_of_superset {s t p : set α} (hs : is_lub s a) (hp : is_lub p a)
  (hst : s ⊆ t) (htp : t ⊆ p) : is_lub t a :=
⟨upper_bounds_mono_set htp hp.1, lower_bounds_mono_set (upper_bounds_mono_set hst) hs.2⟩

/-- If `a` is a greatest lower bound for sets `s` and `p`, then it is a greater lower bound for any
set `t`, `s ⊆ t ⊆ p`. -/
lemma is_glb.of_subset_of_superset {s t p : set α} (hs : is_glb s a) (hp : is_glb p a)
  (hst : s ⊆ t) (htp : t ⊆ p) : is_glb t a :=
hs.dual.of_subset_of_superset hp hst htp

lemma is_least.mono (ha : is_least s a) (hb : is_least t b) (hst : s ⊆ t) : b ≤ a :=
hb.2 (hst ha.1)

lemma is_greatest.mono (ha : is_greatest s a) (hb : is_greatest t b) (hst : s ⊆ t) : a ≤ b :=
hb.2 (hst ha.1)

lemma is_lub.mono (ha : is_lub s a) (hb : is_lub t b) (hst : s ⊆ t) : a ≤ b :=
hb.mono ha $ upper_bounds_mono_set hst

lemma is_glb.mono (ha : is_glb s a) (hb : is_glb t b) (hst : s ⊆ t) : b ≤ a :=
hb.mono ha $ lower_bounds_mono_set hst

lemma subset_lower_bounds_upper_bounds (s : set α) : s ⊆ lower_bounds (upper_bounds s) :=
λ x hx y hy, hy hx

lemma subset_upper_bounds_lower_bounds (s : set α) : s ⊆ upper_bounds (lower_bounds s) :=
λ x hx y hy, hy hx

lemma set.nonempty.bdd_above_lower_bounds (hs : s.nonempty) : bdd_above (lower_bounds s) :=
hs.mono (subset_upper_bounds_lower_bounds s)

lemma set.nonempty.bdd_below_upper_bounds (hs : s.nonempty) : bdd_below (upper_bounds s) :=
hs.mono (subset_lower_bounds_upper_bounds s)

/-!
### Conversions
-/

lemma is_least.is_glb (h : is_least s a) : is_glb s a := ⟨h.2, λ b hb, hb h.1⟩

lemma is_greatest.is_lub (h : is_greatest s a) : is_lub s a := ⟨h.2, λ b hb, hb h.1⟩

lemma is_lub.upper_bounds_eq (h : is_lub s a) : upper_bounds s = Ici a :=
set.ext $ λ b, ⟨λ hb, h.2 hb, λ hb, upper_bounds_mono_mem hb h.1⟩

lemma is_glb.lower_bounds_eq (h : is_glb s a) : lower_bounds s = Iic a := h.dual.upper_bounds_eq

lemma is_least.lower_bounds_eq (h : is_least s a) : lower_bounds s = Iic a :=
h.is_glb.lower_bounds_eq

lemma is_greatest.upper_bounds_eq (h : is_greatest s a) : upper_bounds s = Ici a :=
h.is_lub.upper_bounds_eq

lemma is_lub_le_iff (h : is_lub s a) : a ≤ b ↔ b ∈ upper_bounds s :=
by { rw h.upper_bounds_eq, refl }

lemma le_is_glb_iff (h : is_glb s a) : b ≤ a ↔ b ∈ lower_bounds s :=
by { rw h.lower_bounds_eq, refl }

lemma is_lub_iff_le_iff : is_lub s a ↔ ∀ b, a ≤ b ↔ b ∈ upper_bounds s :=
⟨λ h b, is_lub_le_iff h, λ H, ⟨(H _).1 le_rfl, λ b hb, (H b).2 hb⟩⟩

lemma is_glb_iff_le_iff : is_glb s a ↔ ∀ b, b ≤ a ↔ b ∈ lower_bounds s :=
@is_lub_iff_le_iff (order_dual α) _ _ _

/-- If `s` has a least upper bound, then it is bounded above. -/
lemma is_lub.bdd_above (h : is_lub s a) : bdd_above s := ⟨a, h.1⟩

/-- If `s` has a greatest lower bound, then it is bounded below. -/
lemma is_glb.bdd_below (h : is_glb s a) : bdd_below s := ⟨a, h.1⟩

/-- If `s` has a greatest element, then it is bounded above. -/
lemma is_greatest.bdd_above (h : is_greatest s a) : bdd_above s := ⟨a, h.2⟩

/-- If `s` has a least element, then it is bounded below. -/
lemma is_least.bdd_below (h : is_least s a) : bdd_below s := ⟨a, h.2⟩

lemma is_least.nonempty (h : is_least s a) : s.nonempty := ⟨a, h.1⟩

lemma is_greatest.nonempty (h : is_greatest s a) : s.nonempty := ⟨a, h.1⟩

/-!
### Union and intersection
-/

@[simp] lemma upper_bounds_union : upper_bounds (s ∪ t) = upper_bounds s ∩ upper_bounds t :=
subset.antisymm
  (λ b hb, ⟨λ x hx, hb (or.inl hx), λ x hx, hb (or.inr hx)⟩)
  (λ b hb x hx, hx.elim (λ hs, hb.1 hs) (λ ht, hb.2 ht))

@[simp] lemma lower_bounds_union : lower_bounds (s ∪ t) = lower_bounds s ∩ lower_bounds t :=
@upper_bounds_union (order_dual α) _ s t

lemma union_upper_bounds_subset_upper_bounds_inter :
  upper_bounds s ∪ upper_bounds t ⊆ upper_bounds (s ∩ t) :=
union_subset
  (upper_bounds_mono_set $ inter_subset_left _ _)
  (upper_bounds_mono_set $ inter_subset_right _ _)

lemma union_lower_bounds_subset_lower_bounds_inter :
  lower_bounds s ∪ lower_bounds t ⊆ lower_bounds (s ∩ t) :=
@union_upper_bounds_subset_upper_bounds_inter (order_dual α) _ s t

lemma is_least_union_iff {a : α} {s t : set α} :
  is_least (s ∪ t) a ↔ (is_least s a ∧ a ∈ lower_bounds t ∨ a ∈ lower_bounds s ∧ is_least t a) :=
by simp [is_least, lower_bounds_union, or_and_distrib_right, and_comm (a ∈ t), and_assoc]

lemma is_greatest_union_iff :
  is_greatest (s ∪ t) a ↔ (is_greatest s a ∧ a ∈ upper_bounds t ∨
    a ∈ upper_bounds s ∧ is_greatest t a) :=
@is_least_union_iff (order_dual α) _ a s t

/-- If `s` is bounded, then so is `s ∩ t` -/
lemma bdd_above.inter_of_left (h : bdd_above s) : bdd_above (s ∩ t) :=
h.mono $ inter_subset_left s t

/-- If `t` is bounded, then so is `s ∩ t` -/
lemma bdd_above.inter_of_right (h : bdd_above t) : bdd_above (s ∩ t) :=
h.mono $ inter_subset_right s t

/-- If `s` is bounded, then so is `s ∩ t` -/
lemma bdd_below.inter_of_left (h : bdd_below s) : bdd_below (s ∩ t) :=
h.mono $ inter_subset_left s t

/-- If `t` is bounded, then so is `s ∩ t` -/
lemma bdd_below.inter_of_right (h : bdd_below t) : bdd_below (s ∩ t) :=
h.mono $ inter_subset_right s t

/-- If `s` and `t` are bounded above sets in a `semilattice_sup`, then so is `s ∪ t`. -/
lemma bdd_above.union [semilattice_sup γ] {s t : set γ} :
  bdd_above s → bdd_above t → bdd_above (s ∪ t) :=
begin
  rintros ⟨bs, hs⟩ ⟨bt, ht⟩,
  use bs ⊔ bt,
  rw upper_bounds_union,
  exact ⟨upper_bounds_mono_mem le_sup_left hs,
    upper_bounds_mono_mem le_sup_right ht⟩
end

/-- The union of two sets is bounded above if and only if each of the sets is. -/
lemma bdd_above_union [semilattice_sup γ] {s t : set γ} :
  bdd_above (s ∪ t) ↔ bdd_above s ∧ bdd_above t :=
⟨λ h, ⟨h.mono $ subset_union_left s t, h.mono $ subset_union_right s t⟩,
  λ h, h.1.union h.2⟩

lemma bdd_below.union [semilattice_inf γ] {s t : set γ} :
  bdd_below s → bdd_below t → bdd_below (s ∪ t) :=
@bdd_above.union (order_dual γ) _ s t

/--The union of two sets is bounded above if and only if each of the sets is.-/
lemma bdd_below_union [semilattice_inf γ] {s t : set γ} :
  bdd_below (s ∪ t) ↔ bdd_below s ∧ bdd_below t :=
@bdd_above_union (order_dual γ) _ s t

/-- If `a` is the least upper bound of `s` and `b` is the least upper bound of `t`,
then `a ⊔ b` is the least upper bound of `s ∪ t`. -/
lemma is_lub.union [semilattice_sup γ] {a b : γ} {s t : set γ}
  (hs : is_lub s a) (ht : is_lub t b) :
  is_lub (s ∪ t) (a ⊔ b) :=
⟨λ c h, h.cases_on (λ h, le_sup_of_le_left $ hs.left h) (λ h, le_sup_of_le_right $ ht.left h),
  assume c hc, sup_le
    (hs.right $ assume d hd, hc $ or.inl hd) (ht.right $ assume d hd, hc $ or.inr hd)⟩

/-- If `a` is the greatest lower bound of `s` and `b` is the greatest lower bound of `t`,
then `a ⊓ b` is the greatest lower bound of `s ∪ t`. -/
lemma is_glb.union [semilattice_inf γ] {a₁ a₂ : γ} {s t : set γ}
  (hs : is_glb s a₁) (ht : is_glb t a₂) :
  is_glb (s ∪ t) (a₁ ⊓ a₂) :=
hs.dual.union ht

/-- If `a` is the least element of `s` and `b` is the least element of `t`,
then `min a b` is the least element of `s ∪ t`. -/
lemma is_least.union [linear_order γ] {a b : γ} {s t : set γ}
  (ha : is_least s a) (hb : is_least t b) : is_least (s ∪ t) (min a b) :=
⟨by cases (le_total a b) with h h; simp [h, ha.1, hb.1],
  (ha.is_glb.union hb.is_glb).1⟩

/-- If `a` is the greatest element of `s` and `b` is the greatest element of `t`,
then `max a b` is the greatest element of `s ∪ t`. -/
lemma is_greatest.union [linear_order γ] {a b : γ} {s t : set γ}
  (ha : is_greatest s a) (hb : is_greatest t b) : is_greatest (s ∪ t) (max a b) :=
⟨by cases (le_total a b) with h h; simp [h, ha.1, hb.1],
  (ha.is_lub.union hb.is_lub).1⟩

lemma is_lub.inter_Ici_of_mem [linear_order γ] {s : set γ} {a b : γ} (ha : is_lub s a)
  (hb : b ∈ s) : is_lub (s ∩ Ici b) a :=
⟨λ x hx, ha.1 hx.1, λ c hc, have hbc : b ≤ c, from hc ⟨hb, le_rfl⟩,
  ha.2 $ λ x hx, (le_total x b).elim (λ hxb, hxb.trans hbc) $ λ hbx, hc ⟨hx, hbx⟩⟩

lemma is_glb.inter_Iic_of_mem [linear_order γ] {s : set γ} {a b : γ} (ha : is_glb s a)
  (hb : b ∈ s) : is_glb (s ∩ Iic b) a :=
ha.dual.inter_Ici_of_mem hb

/-!
### Specific sets

#### Unbounded intervals
-/

lemma is_least_Ici : is_least (Ici a) a := ⟨left_mem_Ici, λ x, id⟩

lemma is_greatest_Iic : is_greatest (Iic a) a := ⟨right_mem_Iic, λ x, id⟩

lemma is_lub_Iic : is_lub (Iic a) a := is_greatest_Iic.is_lub

lemma is_glb_Ici : is_glb (Ici a) a := is_least_Ici.is_glb

lemma upper_bounds_Iic : upper_bounds (Iic a) = Ici a := is_lub_Iic.upper_bounds_eq

lemma lower_bounds_Ici : lower_bounds (Ici a) = Iic a := is_glb_Ici.lower_bounds_eq

lemma bdd_above_Iic : bdd_above (Iic a) := is_lub_Iic.bdd_above

lemma bdd_below_Ici : bdd_below (Ici a) := is_glb_Ici.bdd_below

lemma bdd_above_Iio : bdd_above (Iio a) := ⟨a, λ x hx, le_of_lt hx⟩

lemma bdd_below_Ioi : bdd_below (Ioi a) := ⟨a, λ x hx, le_of_lt hx⟩

section

variables [linear_order γ] [densely_ordered γ]

lemma is_lub_Iio {a : γ} : is_lub (Iio a) a :=
⟨λ x hx, le_of_lt hx, λ y hy, le_of_forall_ge_of_dense hy⟩

lemma is_glb_Ioi {a : γ} : is_glb (Ioi a) a := @is_lub_Iio (order_dual γ) _ _ a

lemma upper_bounds_Iio {a : γ} : upper_bounds (Iio a) = Ici a := is_lub_Iio.upper_bounds_eq

lemma lower_bounds_Ioi {a : γ} : lower_bounds (Ioi a) = Iic a := is_glb_Ioi.lower_bounds_eq

end

/-!
#### Singleton
-/

lemma is_greatest_singleton : is_greatest {a} a :=
⟨mem_singleton a, λ x hx, le_of_eq $ eq_of_mem_singleton hx⟩

lemma is_least_singleton : is_least {a} a :=
@is_greatest_singleton (order_dual α) _ a

lemma is_lub_singleton : is_lub {a} a := is_greatest_singleton.is_lub

lemma is_glb_singleton : is_glb {a} a := is_least_singleton.is_glb

lemma bdd_above_singleton : bdd_above ({a} : set α) := is_lub_singleton.bdd_above

lemma bdd_below_singleton : bdd_below ({a} : set α) := is_glb_singleton.bdd_below

@[simp] lemma upper_bounds_singleton : upper_bounds {a} = Ici a := is_lub_singleton.upper_bounds_eq

@[simp] lemma lower_bounds_singleton : lower_bounds {a} = Iic a := is_glb_singleton.lower_bounds_eq

/-!
#### Bounded intervals
-/

lemma bdd_above_Icc : bdd_above (Icc a b) := ⟨b, λ _, and.right⟩

lemma bdd_below_Icc : bdd_below (Icc a b) := ⟨a, λ _, and.left⟩

lemma bdd_above_Ico : bdd_above (Ico a b) := bdd_above_Icc.mono Ico_subset_Icc_self

lemma bdd_below_Ico : bdd_below (Ico a b) := bdd_below_Icc.mono Ico_subset_Icc_self

lemma bdd_above_Ioc : bdd_above (Ioc a b) := bdd_above_Icc.mono Ioc_subset_Icc_self

lemma bdd_below_Ioc : bdd_below (Ioc a b) := bdd_below_Icc.mono Ioc_subset_Icc_self

lemma bdd_above_Ioo : bdd_above (Ioo a b) := bdd_above_Icc.mono Ioo_subset_Icc_self

lemma bdd_below_Ioo : bdd_below (Ioo a b) := bdd_below_Icc.mono Ioo_subset_Icc_self

lemma is_greatest_Icc (h : a ≤ b) : is_greatest (Icc a b) b :=
⟨right_mem_Icc.2 h, λ x, and.right⟩

lemma is_lub_Icc (h : a ≤ b) : is_lub (Icc a b) b := (is_greatest_Icc h).is_lub

lemma upper_bounds_Icc (h : a ≤ b) : upper_bounds (Icc a b) = Ici b :=
(is_lub_Icc h).upper_bounds_eq

lemma is_least_Icc (h : a ≤ b) : is_least (Icc a b) a :=
⟨left_mem_Icc.2 h, λ x, and.left⟩

lemma is_glb_Icc (h : a ≤ b) : is_glb (Icc a b) a := (is_least_Icc h).is_glb

lemma lower_bounds_Icc (h : a ≤ b) : lower_bounds (Icc a b) = Iic a :=
(is_glb_Icc h).lower_bounds_eq

lemma is_greatest_Ioc (h : a < b) : is_greatest (Ioc a b) b :=
⟨right_mem_Ioc.2 h, λ x, and.right⟩

lemma is_lub_Ioc (h : a < b) : is_lub (Ioc a b) b :=
(is_greatest_Ioc h).is_lub

lemma upper_bounds_Ioc (h : a < b) : upper_bounds (Ioc a b) = Ici b :=
(is_lub_Ioc h).upper_bounds_eq

lemma is_least_Ico (h : a < b) : is_least (Ico a b) a :=
⟨left_mem_Ico.2 h, λ x, and.left⟩

lemma is_glb_Ico (h : a < b) : is_glb (Ico a b) a :=
(is_least_Ico h).is_glb

lemma lower_bounds_Ico (h : a < b) : lower_bounds (Ico a b) = Iic a :=
(is_glb_Ico h).lower_bounds_eq

section

variables [semilattice_sup γ] [densely_ordered γ]

lemma is_glb_Ioo {a b : γ} (h : a < b) :
  is_glb (Ioo a b) a :=
⟨λ x hx, hx.1.le, λ x hx,
begin
  cases eq_or_lt_of_le (le_sup_right : a ≤ x ⊔ a) with h₁ h₂,
  { exact h₁.symm ▸ le_sup_left },
  obtain ⟨y, lty, ylt⟩ := exists_between h₂,
  apply (not_lt_of_le (sup_le (hx ⟨lty, ylt.trans_le (sup_le _ h.le)⟩) lty.le) ylt).elim,
  obtain ⟨u, au, ub⟩ := exists_between h,
  apply (hx ⟨au, ub⟩).trans ub.le,
end⟩

lemma lower_bounds_Ioo {a b : γ} (hab : a < b) : lower_bounds (Ioo a b) = Iic a :=
(is_glb_Ioo hab).lower_bounds_eq

lemma is_glb_Ioc {a b : γ} (hab : a < b) : is_glb (Ioc a b) a :=
(is_glb_Ioo hab).of_subset_of_superset (is_glb_Icc hab.le) Ioo_subset_Ioc_self Ioc_subset_Icc_self

lemma lower_bound_Ioc {a b : γ} (hab : a < b) : lower_bounds (Ioc a b) = Iic a :=
(is_glb_Ioc hab).lower_bounds_eq

end

section

variables [semilattice_inf γ] [densely_ordered γ]

lemma is_lub_Ioo {a b : γ} (hab : a < b) : is_lub (Ioo a b) b :=
by simpa only [dual_Ioo] using is_glb_Ioo hab.dual

lemma upper_bounds_Ioo {a b : γ} (hab : a < b) : upper_bounds (Ioo a b) = Ici b :=
(is_lub_Ioo hab).upper_bounds_eq

lemma is_lub_Ico {a b : γ} (hab : a < b) : is_lub (Ico a b) b :=
by simpa only [dual_Ioc] using is_glb_Ioc hab.dual

lemma upper_bounds_Ico {a b : γ} (hab : a < b) : upper_bounds (Ico a b) = Ici b :=
(is_lub_Ico hab).upper_bounds_eq

end

lemma bdd_below_iff_subset_Ici : bdd_below s ↔ ∃ a, s ⊆ Ici a := iff.rfl

lemma bdd_above_iff_subset_Iic : bdd_above s ↔ ∃ a, s ⊆ Iic a := iff.rfl

lemma bdd_below_bdd_above_iff_subset_Icc : bdd_below s ∧ bdd_above s ↔ ∃ a b, s ⊆ Icc a b :=
by simp only [Ici_inter_Iic.symm, subset_inter_iff, bdd_below_iff_subset_Ici,
  bdd_above_iff_subset_Iic, exists_and_distrib_left, exists_and_distrib_right]

/-!
#### Univ
-/

lemma is_greatest_univ [preorder γ] [order_top γ] : is_greatest (univ : set γ) ⊤ :=
⟨mem_univ _, λ x hx, le_top⟩

@[simp] lemma order_top.upper_bounds_univ [partial_order γ] [order_top γ] :
  upper_bounds (univ : set γ) = {⊤} :=
by rw [is_greatest_univ.upper_bounds_eq, Ici_top]

lemma is_lub_univ [preorder γ] [order_top γ] : is_lub (univ : set γ) ⊤ :=
is_greatest_univ.is_lub

@[simp] lemma order_bot.lower_bounds_univ [partial_order γ] [order_bot γ] :
  lower_bounds (univ : set γ) = {⊥} :=
@order_top.upper_bounds_univ (order_dual γ) _ _

lemma is_least_univ [preorder γ] [order_bot γ] : is_least (univ : set γ) ⊥ :=
@is_greatest_univ (order_dual γ) _ _

lemma is_glb_univ [preorder γ] [order_bot γ] : is_glb (univ : set γ) ⊥ :=
is_least_univ.is_glb

@[simp] lemma no_top_order.upper_bounds_univ [no_top_order α] : upper_bounds (univ : set α) = ∅ :=
eq_empty_of_subset_empty $ λ b hb, let ⟨x, hx⟩ := no_top b in
not_le_of_lt hx (hb trivial)

@[simp] lemma no_bot_order.lower_bounds_univ [no_bot_order α] : lower_bounds (univ : set α) = ∅ :=
@no_top_order.upper_bounds_univ (order_dual α) _ _

@[simp] lemma not_bdd_above_univ [no_top_order α] : ¬bdd_above (univ : set α) :=
by simp [bdd_above]

@[simp] lemma not_bdd_below_univ [no_bot_order α] : ¬bdd_below (univ : set α) :=
@not_bdd_above_univ (order_dual α) _ _

/-!
#### Empty set
-/

@[simp] lemma upper_bounds_empty : upper_bounds (∅ : set α) = univ :=
by simp only [upper_bounds, eq_univ_iff_forall, mem_set_of_eq, ball_empty_iff, forall_true_iff]

@[simp] lemma lower_bounds_empty : lower_bounds (∅ : set α) = univ :=
@upper_bounds_empty (order_dual α) _

@[simp] lemma bdd_above_empty [nonempty α] : bdd_above (∅ : set α) :=
by simp only [bdd_above, upper_bounds_empty, univ_nonempty]

@[simp] lemma bdd_below_empty [nonempty α] : bdd_below (∅ : set α) :=
by simp only [bdd_below, lower_bounds_empty, univ_nonempty]

lemma is_glb_empty [preorder γ] [order_top γ] : is_glb ∅ (⊤:γ) :=
by simp only [is_glb, lower_bounds_empty, is_greatest_univ]

lemma is_lub_empty [preorder γ] [order_bot γ] : is_lub ∅ (⊥:γ) :=
@is_glb_empty (order_dual γ) _ _

lemma is_lub.nonempty [no_bot_order α] (hs : is_lub s a) : s.nonempty :=
let ⟨a', ha'⟩ := no_bot a in
ne_empty_iff_nonempty.1 $ assume h,
have a ≤ a', from hs.right $ by simp only [h, upper_bounds_empty],
not_le_of_lt ha' this

lemma is_glb.nonempty [no_top_order α] (hs : is_glb s a) : s.nonempty := hs.dual.nonempty

lemma nonempty_of_not_bdd_above [ha : nonempty α] (h : ¬bdd_above s) : s.nonempty :=
nonempty.elim ha $ λ x, (not_bdd_above_iff'.1 h x).imp $ λ a ha, ha.fst

lemma nonempty_of_not_bdd_below [ha : nonempty α] (h : ¬bdd_below s) : s.nonempty :=
@nonempty_of_not_bdd_above (order_dual α) _ _ _ h

/-!
#### insert
-/

/-- Adding a point to a set preserves its boundedness above. -/
@[simp] lemma bdd_above_insert [semilattice_sup γ] (a : γ) {s : set γ} :
  bdd_above (insert a s) ↔ bdd_above s :=
by simp only [insert_eq, bdd_above_union, bdd_above_singleton, true_and]

lemma bdd_above.insert [semilattice_sup γ] (a : γ) {s : set γ} (hs : bdd_above s) :
  bdd_above (insert a s) :=
(bdd_above_insert a).2 hs

/--Adding a point to a set preserves its boundedness below.-/
@[simp] lemma bdd_below_insert [semilattice_inf γ] (a : γ) {s : set γ} :
  bdd_below (insert a s) ↔ bdd_below s :=
by simp only [insert_eq, bdd_below_union, bdd_below_singleton, true_and]

lemma bdd_below.insert [semilattice_inf γ] (a : γ) {s : set γ} (hs : bdd_below s) :
  bdd_below (insert a s) :=
(bdd_below_insert a).2 hs

lemma is_lub.insert [semilattice_sup γ] (a) {b} {s : set γ} (hs : is_lub s b) :
  is_lub (insert a s) (a ⊔ b) :=
by { rw insert_eq, exact is_lub_singleton.union hs }

lemma is_glb.insert [semilattice_inf γ] (a) {b} {s : set γ} (hs : is_glb s b) :
  is_glb (insert a s) (a ⊓ b) :=
by { rw insert_eq, exact is_glb_singleton.union hs }

lemma is_greatest.insert [linear_order γ] (a) {b} {s : set γ} (hs : is_greatest s b) :
  is_greatest (insert a s) (max a b) :=
by { rw insert_eq, exact is_greatest_singleton.union hs }

lemma is_least.insert [linear_order γ] (a) {b} {s : set γ} (hs : is_least s b) :
  is_least (insert a s) (min a b) :=
by { rw insert_eq, exact is_least_singleton.union hs }

@[simp] lemma upper_bounds_insert (a : α) (s : set α) :
  upper_bounds (insert a s) = Ici a ∩ upper_bounds s :=
by rw [insert_eq, upper_bounds_union, upper_bounds_singleton]

@[simp] lemma lower_bounds_insert (a : α) (s : set α) :
  lower_bounds (insert a s) = Iic a ∩ lower_bounds s :=
by rw [insert_eq, lower_bounds_union, lower_bounds_singleton]

/-- When there is a global maximum, every set is bounded above. -/
@[simp] protected lemma order_top.bdd_above [preorder γ] [order_top γ] (s : set γ) : bdd_above s :=
⟨⊤, assume a ha, order_top.le_top a⟩

/-- When there is a global minimum, every set is bounded below. -/
@[simp] protected lemma order_bot.bdd_below [preorder γ] [order_bot γ] (s : set γ) : bdd_below s :=
⟨⊥, assume a ha, order_bot.bot_le a⟩

/-!
#### Pair
-/

lemma is_lub_pair [semilattice_sup γ] {a b : γ} : is_lub {a, b} (a ⊔ b) :=
is_lub_singleton.insert _

lemma is_glb_pair [semilattice_inf γ] {a b : γ} : is_glb {a, b} (a ⊓ b) :=
is_glb_singleton.insert _

lemma is_least_pair [linear_order γ] {a b : γ} : is_least {a, b} (min a b) :=
is_least_singleton.insert _

lemma is_greatest_pair [linear_order γ] {a b : γ} : is_greatest {a, b} (max a b) :=
is_greatest_singleton.insert _

/-!
#### Lower/upper bounds
-/

@[simp] lemma is_lub_lower_bounds : is_lub (lower_bounds s) a ↔ is_glb s a :=
⟨λ H, ⟨λ x hx, H.2 $ subset_upper_bounds_lower_bounds s hx, H.1⟩, is_greatest.is_lub⟩

@[simp] lemma is_glb_upper_bounds : is_glb (upper_bounds s) a ↔ is_lub s a :=
@is_lub_lower_bounds (order_dual α) _ _ _

end

/-!
### (In)equalities with the least upper bound and the greatest lower bound
-/

section preorder
variables [preorder α] {s : set α} {a b : α}

lemma lower_bounds_le_upper_bounds (ha : a ∈ lower_bounds s) (hb : b ∈ upper_bounds s) :
  s.nonempty → a ≤ b
| ⟨c, hc⟩ := le_trans (ha hc) (hb hc)

lemma is_glb_le_is_lub (ha : is_glb s a) (hb : is_lub s b) (hs : s.nonempty) : a ≤ b :=
lower_bounds_le_upper_bounds ha.1 hb.1 hs

lemma is_lub_lt_iff (ha : is_lub s a) : a < b ↔ ∃ c ∈ upper_bounds s, c < b :=
⟨λ hb, ⟨a, ha.1, hb⟩, λ ⟨c, hcs, hcb⟩, lt_of_le_of_lt (ha.2 hcs) hcb⟩

lemma lt_is_glb_iff (ha : is_glb s a) : b < a ↔ ∃ c ∈ lower_bounds s, b < c := is_lub_lt_iff ha.dual

lemma le_of_is_lub_le_is_glb {x y} (ha : is_glb s a) (hb : is_lub s b) (hab : b ≤ a)
  (hx : x ∈ s) (hy : y ∈ s) : x ≤ y :=
calc x ≤ b : hb.1 hx
   ... ≤ a : hab
   ... ≤ y : ha.1 hy

end preorder

section partial_order
variables [partial_order α] {s : set α} {a b : α}

lemma is_least.unique (Ha : is_least s a) (Hb : is_least s b) : a = b :=
le_antisymm (Ha.right Hb.left) (Hb.right Ha.left)

lemma is_least.is_least_iff_eq (Ha : is_least s a) : is_least s b ↔ a = b :=
iff.intro Ha.unique (assume h, h ▸ Ha)

lemma is_greatest.unique (Ha : is_greatest s a) (Hb : is_greatest s b) : a = b :=
le_antisymm (Hb.right Ha.left) (Ha.right Hb.left)

lemma is_greatest.is_greatest_iff_eq (Ha : is_greatest s a) : is_greatest s b ↔ a = b :=
iff.intro Ha.unique (assume h, h ▸ Ha)

lemma is_lub.unique (Ha : is_lub s a) (Hb : is_lub s b) : a = b :=
Ha.unique Hb

lemma is_glb.unique (Ha : is_glb s a) (Hb : is_glb s b) : a = b :=
Ha.unique Hb

lemma set.subsingleton_of_is_lub_le_is_glb (Ha : is_glb s a) (Hb : is_lub s b) (hab : b ≤ a) :
  s.subsingleton :=
λ x hx y hy, le_antisymm (le_of_is_lub_le_is_glb Ha Hb hab hx hy)
  (le_of_is_lub_le_is_glb Ha Hb hab hy hx)

lemma is_glb_lt_is_lub_of_ne (Ha : is_glb s a) (Hb : is_lub s b)
  {x y} (Hx : x ∈ s) (Hy : y ∈ s) (Hxy : x ≠ y) :
  a < b :=
lt_iff_le_not_le.2
  ⟨lower_bounds_le_upper_bounds Ha.1 Hb.1 ⟨x, Hx⟩,
    λ hab, Hxy $ set.subsingleton_of_is_lub_le_is_glb Ha Hb hab Hx Hy⟩

end partial_order

section linear_order
variables [linear_order α] {s : set α} {a b : α}

lemma lt_is_lub_iff (h : is_lub s a) : b < a ↔ ∃ c ∈ s, b < c :=
by simp only [← not_le, is_lub_le_iff h, mem_upper_bounds, not_forall]

lemma is_glb_lt_iff (h : is_glb s a) : a < b ↔ ∃ c ∈ s, c < b := lt_is_lub_iff h.dual

lemma is_lub.exists_between (h : is_lub s a) (hb : b < a) :
  ∃ c ∈ s, b < c ∧ c ≤ a :=
let ⟨c, hcs, hbc⟩ := (lt_is_lub_iff h).1 hb in ⟨c, hcs, hbc, h.1 hcs⟩

lemma is_lub.exists_between' (h : is_lub s a) (h' : a ∉ s) (hb : b < a) :
  ∃ c ∈ s, b < c ∧ c < a :=
let ⟨c, hcs, hbc, hca⟩ := h.exists_between hb
in ⟨c, hcs, hbc, hca.lt_of_ne $ λ hac, h' $ hac ▸ hcs⟩

lemma is_glb.exists_between (h : is_glb s a) (hb : a < b) :
  ∃ c ∈ s, a ≤ c ∧ c < b :=
let ⟨c, hcs, hbc⟩ := (is_glb_lt_iff h).1 hb in ⟨c, hcs, h.1 hcs, hbc⟩

lemma is_glb.exists_between' (h : is_glb s a) (h' : a ∉ s) (hb : a < b) :
  ∃ c ∈ s, a < c ∧ c < b :=
let ⟨c, hcs, hac, hcb⟩ := h.exists_between hb
in ⟨c, hcs, hac.lt_of_ne $ λ hac, h' $ hac.symm ▸ hcs, hcb⟩

end linear_order

/-!
### Least upper bound and the greatest lower bound in linear ordered additive commutative groups
-/

section linear_ordered_add_comm_group

variables [linear_ordered_add_comm_group α] {s : set α} {a ε : α}

lemma is_glb.exists_between_self_add (h : is_glb s a) (hε : 0 < ε) :
  ∃ b ∈ s, a ≤ b ∧ b < a + ε :=
h.exists_between $ lt_add_of_pos_right _ hε

lemma is_glb.exists_between_self_add' (h : is_glb s a) (h₂ : a ∉ s) (hε : 0 < ε) :
  ∃ b ∈ s, a < b ∧ b < a + ε :=
h.exists_between' h₂ $ lt_add_of_pos_right _ hε

lemma is_lub.exists_between_sub_self  (h : is_lub s a) (hε : 0 < ε) : ∃ b ∈ s, a - ε < b ∧ b ≤ a :=
h.exists_between $ sub_lt_self _ hε

lemma is_lub.exists_between_sub_self' (h : is_lub s a) (h₂ : a ∉ s) (hε : 0 < ε) :
  ∃ b ∈ s, a - ε < b ∧ b < a :=
h.exists_between' h₂ $ sub_lt_self _ hε

end linear_ordered_add_comm_group

/-!
### Images of upper/lower bounds under monotone functions
-/

namespace monotone

variables [preorder α] [preorder β] {f : α → β} (Hf : monotone f) {a : α} {s : set α}

lemma mem_upper_bounds_image (Ha : a ∈ upper_bounds s) :
  f a ∈ upper_bounds (f '' s) :=
ball_image_of_ball (assume x H, Hf (Ha ‹x ∈ s›))

lemma mem_lower_bounds_image (Ha : a ∈ lower_bounds s) :
  f a ∈ lower_bounds (f '' s) :=
ball_image_of_ball (assume x H, Hf (Ha ‹x ∈ s›))

lemma image_upper_bounds_subset_upper_bounds_image (hf : monotone f) :
  f '' upper_bounds s ⊆ upper_bounds (f '' s) :=
begin
  rintro _ ⟨a, ha, rfl⟩,
  exact hf.mem_upper_bounds_image ha,
end

lemma image_lower_bounds_subset_lower_bounds_image (hf : monotone f) :
  f '' lower_bounds s ⊆ lower_bounds (f '' s) :=
hf.dual.image_upper_bounds_subset_upper_bounds_image

/-- The image under a monotone function of a set which is bounded above is bounded above. -/
lemma map_bdd_above (hf : monotone f) : bdd_above s → bdd_above (f '' s)
| ⟨C, hC⟩ := ⟨f C, hf.mem_upper_bounds_image hC⟩

/-- The image under a monotone function of a set which is bounded below is bounded below. -/
lemma map_bdd_below (hf : monotone f) : bdd_below s → bdd_below (f '' s)
| ⟨C, hC⟩ := ⟨f C, hf.mem_lower_bounds_image hC⟩

/-- A monotone map sends a least element of a set to a least element of its image. -/
lemma map_is_least (Ha : is_least s a) : is_least (f '' s) (f a) :=
⟨mem_image_of_mem _ Ha.1, Hf.mem_lower_bounds_image Ha.2⟩

/-- A monotone map sends a greatest element of a set to a greatest element of its image. -/
lemma map_is_greatest (Ha : is_greatest s a) : is_greatest (f '' s) (f a) :=
⟨mem_image_of_mem _ Ha.1, Hf.mem_upper_bounds_image Ha.2⟩

lemma is_lub_image_le (Ha : is_lub s a) {b : β} (Hb : is_lub (f '' s) b) :
  b ≤ f a :=
Hb.2 (Hf.mem_upper_bounds_image Ha.1)

lemma le_is_glb_image (Ha : is_glb s a) {b : β} (Hb : is_glb (f '' s) b) :
  f a ≤ b :=
Hb.2 (Hf.mem_lower_bounds_image Ha.1)

end monotone

namespace antitone
variables [preorder α] [preorder β] {f : α → β} (hf : antitone f) {a : α} {s : set α}

lemma mem_upper_bounds_image (ha : a ∈ lower_bounds s) :
  f a ∈ upper_bounds (f '' s) :=
hf.dual_right.mem_lower_bounds_image ha

lemma mem_lower_bounds_image (ha : a ∈ upper_bounds s) :
  f a ∈ lower_bounds (f '' s) :=
hf.dual_right.mem_upper_bounds_image ha

lemma image_lower_bounds_subset_upper_bounds_image (hf : antitone f) :
  f '' lower_bounds s ⊆ upper_bounds (f '' s) :=
hf.dual_right.image_lower_bounds_subset_lower_bounds_image

lemma image_upper_bounds_subset_lower_bounds_image (hf : antitone f) :
  f '' upper_bounds s ⊆ lower_bounds (f '' s) :=
hf.dual_right.image_upper_bounds_subset_upper_bounds_image

/-- The image under an antitone function of a set which is bounded above is bounded below. -/
lemma map_bdd_above (hf : antitone f) : bdd_above s → bdd_below (f '' s) :=
hf.dual_right.map_bdd_above

/-- The image under an antitone function of a set which is bounded below is bounded above. -/
lemma map_bdd_below (hf : antitone f) : bdd_below s → bdd_above (f '' s) :=
hf.dual_right.map_bdd_below

/-- An antitone map sends a greatest element of a set to a least element of its image. -/
lemma map_is_greatest (ha : is_greatest s a) : is_least (f '' s) (f a) :=
hf.dual_right.map_is_greatest ha

/-- An antitone map sends a least element of a set to a greatest element of its image. -/
lemma map_is_least (ha : is_least s a) : is_greatest (f '' s) (f a) :=
hf.dual_right.map_is_least ha

lemma is_lub_image_le (ha : is_glb s a) {b : β} (hb : is_lub (f '' s) b) : b ≤ f a :=
hf.dual_left.is_lub_image_le ha hb

lemma le_is_glb_image (ha : is_lub s a) {b : β} (hb : is_glb (f '' s) b) : f a ≤ b :=
hf.dual_left.le_is_glb_image ha hb

end antitone

lemma is_glb.of_image [preorder α] [preorder β] {f : α → β} (hf : ∀ {x y}, f x ≤ f y ↔ x ≤ y)
  {s : set α} {x : α} (hx : is_glb (f '' s) (f x)) :
  is_glb s x :=
⟨λ y hy, hf.1 $ hx.1 $ mem_image_of_mem _ hy,
  λ y hy, hf.1 $ hx.2 $ monotone.mem_lower_bounds_image (λ x y, hf.2) hy⟩

lemma is_lub.of_image [preorder α] [preorder β] {f : α → β} (hf : ∀ {x y}, f x ≤ f y ↔ x ≤ y)
  {s : set α} {x : α} (hx : is_lub (f '' s) (f x)) :
  is_lub s x :=
@is_glb.of_image (order_dual α) (order_dual β) _ _ f (λ x y, hf) _ _ hx

lemma is_lub_pi {π : α → Type*} [Π a, preorder (π a)] {s : set (Π a, π a)} {f : Π a, π a} :
  is_lub s f ↔ ∀ a, is_lub (function.eval a '' s) (f a) :=
begin
  classical,
  refine ⟨λ H a, ⟨(function.monotone_eval a).mem_upper_bounds_image H.1, λ b hb, _⟩, λ H, ⟨_, _⟩⟩,
  { suffices : function.update f a b ∈ upper_bounds s,
      from function.update_same a b f ▸ H.2 this a,
    refine λ g hg, le_update_iff.2 ⟨hb $ mem_image_of_mem _ hg, λ i hi, H.1 hg i⟩ },
  { exact λ g hg a, (H a).1 (mem_image_of_mem _ hg) },
  { exact λ g hg a, (H a).2 ((function.monotone_eval a).mem_upper_bounds_image hg) }
end

lemma is_glb_pi {π : α → Type*} [Π a, preorder (π a)] {s : set (Π a, π a)} {f : Π a, π a} :
  is_glb s f ↔ ∀ a, is_glb (function.eval a '' s) (f a) :=
@is_lub_pi α (λ a, order_dual (π a)) _ s f

lemma is_lub_prod [preorder α] [preorder β] {s : set (α × β)} (p : α × β) :
  is_lub s p ↔ is_lub (prod.fst '' s) p.1 ∧ is_lub (prod.snd '' s) p.2 :=
begin
  refine ⟨λ H, ⟨⟨monotone_fst.mem_upper_bounds_image H.1, λ a ha, _⟩,
    ⟨monotone_snd.mem_upper_bounds_image H.1, λ a ha, _⟩⟩, λ H, ⟨_, _⟩⟩,
  { suffices : (a, p.2) ∈ upper_bounds s, from (H.2 this).1,
    exact λ q hq, ⟨ha $ mem_image_of_mem _ hq, (H.1 hq).2⟩ },
  { suffices : (p.1, a) ∈ upper_bounds s, from (H.2 this).2,
    exact λ q hq, ⟨(H.1 hq).1, ha $ mem_image_of_mem _ hq⟩ },
  { exact λ q hq, ⟨H.1.1 $ mem_image_of_mem _ hq, H.2.1 $ mem_image_of_mem _ hq⟩ },
  { exact λ q hq, ⟨H.1.2 $ monotone_fst.mem_upper_bounds_image hq,
      H.2.2 $ monotone_snd.mem_upper_bounds_image hq⟩ }
end

lemma is_glb_prod [preorder α] [preorder β] {s : set (α × β)} (p : α × β) :
  is_glb s p ↔ is_glb (prod.fst '' s) p.1 ∧ is_glb (prod.snd '' s) p.2 :=
@is_lub_prod (order_dual α) (order_dual β) _ _ _ _

namespace order_iso

variables [preorder α] [preorder β] (f : α ≃o β)

lemma upper_bounds_image {s : set α} :
  upper_bounds (f '' s) = f '' upper_bounds s :=
subset.antisymm
  (λ x hx, ⟨f.symm x, λ y hy, f.le_symm_apply.2 (hx $ mem_image_of_mem _ hy), f.apply_symm_apply x⟩)
  f.monotone.image_upper_bounds_subset_upper_bounds_image

lemma lower_bounds_image {s : set α} :
  lower_bounds (f '' s) = f '' lower_bounds s :=
@upper_bounds_image (order_dual α) (order_dual β) _ _ f.dual _

@[simp] lemma is_lub_image {s : set α} {x : β} :
  is_lub (f '' s) x ↔ is_lub s (f.symm x) :=
⟨λ h, is_lub.of_image (λ _ _, f.le_iff_le) ((f.apply_symm_apply x).symm ▸ h),
  λ h, is_lub.of_image (λ _ _, f.symm.le_iff_le) $ (f.symm_image_image s).symm ▸ h⟩

lemma is_lub_image' {s : set α} {x : α} :
  is_lub (f '' s) (f x) ↔ is_lub s x :=
by rw [is_lub_image, f.symm_apply_apply]

@[simp] lemma is_glb_image {s : set α} {x : β} :
  is_glb (f '' s) x ↔ is_glb s (f.symm x) :=
f.dual.is_lub_image

lemma is_glb_image' {s : set α} {x : α} :
  is_glb (f '' s) (f x) ↔ is_glb s x :=
f.dual.is_lub_image'

@[simp] lemma is_lub_preimage {s : set β} {x : α} :
  is_lub (f ⁻¹' s) x ↔ is_lub s (f x) :=
by rw [← f.symm_symm, ← image_eq_preimage, is_lub_image]

lemma is_lub_preimage' {s : set β} {x : β} :
  is_lub (f ⁻¹' s) (f.symm x) ↔ is_lub s x :=
by rw [is_lub_preimage, f.apply_symm_apply]

@[simp] lemma is_glb_preimage {s : set β} {x : α} :
  is_glb (f ⁻¹' s) x ↔ is_glb s (f x) :=
f.dual.is_lub_preimage

lemma is_glb_preimage' {s : set β} {x : β} :
  is_glb (f ⁻¹' s) (f.symm x) ↔ is_glb s x :=
f.dual.is_lub_preimage'

end order_iso


import MyNat.Addition -- imports addition.
namespace MyNat
open MyNat

/-!
# Addition World.

## Level 1: the `induction` tactic.

OK so let's see induction in action. We're going to prove

  `zero_add (n : MyNat) : 0 + n = n`.

That is: for all natural numbers `n`, `0+n=n`. Wait - what is going on here? Didn't you already prove
that adding zero to `n` gave us `n`? No you didn't! You proved `n + 0 = n`, and that proof was called
`add_zero`. We're now trying to establish `zero_add`, the proof that `0 + n = n`. But aren't these
two theorems the same? No they're not! It is *true* that `x + y = y + x`, but you haven't *proved* it
yet, and in fact you will need both `add_zero` and `zero_add` in order to prove this. In fact
`x + y = y + x` is the boss level for addition world, and `induction` is the only other tactic you'll
need to beat it.

Now `add_zero` is one of Peano's axioms, so you don't need to prove it, you already have it (indeed,
if you've used Goto Definition (F12) on this theorem you can even see it). To prove `0 + n = n` we
need to use induction on `n`. While we're here, note that `zero_add` is about zero add something,
and `add_zero` is about something add zero. The names of the proofs tell you what the theorems are.

**Lemma**

For all natural numbers `n`, we have `0 + n = n.`
-/
lemma zero_add (n : MyNat) : 0 + n = n := by
  induction n with
  | zero => rfl
  | succ n ih =>
      rw [add_succ]
      rw [ih]

/-!

Notice that the [induction tactic](../Tactics/induction.lean.md) has created *two sub-goals*
which you can match using vertical bar pattern patching.

The induction tactic has generated for us a base case with `n = zero` (the goal at the top)
and an inductive step (the goal underneath). The golden rule: **Tactics operate on the first goal**
- the goal at the top. So let's just worry about that top goal now, the base case.
If you place the cursor right after the `=>` symbol you will see the goal listed in
the InfoView as `⊢ 0 + zero = zero`.

Remember that `add_zero` (the proof we have already) is the proof of `x + 0 = x`
(for any `x`) so you can try `rw [add_zero]` here but what do you think the goal will change to?
Remember to just keep focussing on the top goal, ignore
the other one for now, it's not changing and in fact, the InfoView tells you why:
```
tactic 'rewrite' failed, did not find instance of the pattern in the target expression
```

But as you can see `rfl` can solve the first case. You should now see `Goals accomplished 🎉` when
your cursor is placed on the right of the `rfl` which means you have solved this base case sub-goal,
and you are ready to tackle the next sub-goal -- the inductive step. Take a look at the text below
the lemma to see an explanation of this goal.

In the successor case the InfoView tactic state should look something like this:

```
case succ
n: MyNat
ih: 0 + n = n
⊢ 0 + succ n = succ n
```

*Important:* make sure that you only have one goal at this point. You should have proved `0 + 0 = 0`
by now. Tactics only operate on the top goal.

The first line just reminds you you're doing the inductive step. You have a fixed natural number `n`,
and the inductive hypothesis `ih : 0 + n = n` which means this hypothesis proves `0 + n = n`. Your
goal is to prove `0 + succ n = succ n`. In other words, we're showing that if the lemma is true for
`n`, then it's also true for `n + 1`. That's the inductive step that you might be familiar with in
proof by induction. Once we've proved this inductive step, you will have proved `zero_add` by the
principle of mathematical induction.

To prove your goal, you need to use `add_succ` which you proved in
[Tutorial World Level 4](../TutorialWorld/Level4.lean.md). Note that `add_succ 0 d`
is the result that `0 + succ d = succ (0 + d)`, so the first thing
you need to do is to replace the left hand side `0 + succ d` of your
goal with the right hand side. You do this with the `rw` command: `rw [add_succ]`
(or even `rw [add_succ 0 n]` if you want to give Lean all the inputs instead of making it
figure them out itself). Notice goal changes to `⊢ succ (0 + n) = succ n`.

Now remember the inductive hypothesis `ih : 0 + d = d`. This `0 + d` matches
the `(0 + n)` in the goal, so you can write that using `rw [ih]`.
The goal will now change to

`⊢ succ d = succ d`

and the `rw` tactic will automatically finish our proof using the `rfl` tactic.
After you apply it, Lean will inform you that there are no goals left. You are done!

Remember that you can write `rw [add_succ, ih]` also, but notice that rewriting is
order dependent and that `rw [ih, add_succ]` does not work.

## Now venture off on your own

Those three tactics --

* `induction n with ...`
* `rw [h]`
* `rfl`

will get you quite a long way through this tutorial. Using only these tactics
do all of Addition World,
all of [Multiplication World](../MultiplicationWorld.lean.md) including the boss level `a * b = b * a`,
and even all of [Power World](../PowerWorld.lean.md) including the fiendish final boss. This route will
give you a good grounding in these three basic tactics; after that, if you
are still interested, there are other worlds to master, where you can learn
more tactics.

But we're getting ahead of ourselves, you still have to read the rest of Addition World.
We're going to stop explaining stuff carefully now. If you get stuck or want
to know more about Lean (e.g. how to do much harder maths in Lean),
ask in `#new members` at [the Lean chat](https://leanprover.zulipchat.com).
(login required, real name preferred, github account id is handy).
Kevin or Mohammad or one of the other people there might be able to help.

On to [level 2](./Level2.lean.md).

-/


import MyNat.Definition
import MultiplicationWorld.Level1 -- zero_mul
import AdvancedMultiplicationWorld.Level2 -- eq_zero_or_eq_zero_of_mul_eq_zero
import Mathlib.Tactic.LeftRight
namespace MyNat
open MyNat

/-!
# Advanced Multiplication World

## Level 3: `mul_eq_zero_iff`

Now you have `eq_zero_or_eq_zero_of_mul_eq_zero` this is pretty straightforward.

## Theorem
`ab = 0`, if and only if at least one of `a` or `b` is equal to zero.
-/
theorem mul_eq_zero_iff (a b : MyNat): a * b = 0 ↔ a = 0 ∨ b = 0 := by
  constructor
  {
     intro h
     exact eq_zero_or_eq_zero_of_mul_eq_zero a b h
  }
  {
    intro hab
    cases hab with
    | inl ha =>
      rw [ha]
      rw [zero_mul]
    | inr hb =>
      rw [hb]
      rw [mul_zero]
  }

/-!

Next up [Level 4](./Level4.lean.md)
-/


import tactic

-- References: Schmidt, G. (2010) Relational Mathematics. Cambridge: Cambridge University Press (Encyclopedia of Mathematics and its Applications). doi: 10.1017/CBO9780511778810.

namespace myrelation
variables {α β γ A B C: Type*}
variable (R : A → A → Prop)

def union (r : α → β → Prop) (s : α → β → Prop) (a : α) (b : β) : Prop := r a b ∨ s a b
def intersect (r : α → β → Prop) (s : α → β → Prop) (a : α) (b : β) : Prop := r a b ∧ s a b
def transpose (r : α → β → Prop) (b : β) (a : α) : Prop := r a b
def complement (r : α → β → Prop) (a : α) (b : β) : Prop := ¬(r a b)
def comp (r : α → β → Prop) (p : β → γ → Prop) (a : α) (c : γ) : Prop := ∃ (b : β), r a b ∧ p b c

def reflexive (R : A → A → Prop) : Prop := ∀ x, R x x
def irreflexive (R : A → A → Prop) : Prop := ∀ x, ¬ R x x
def symmetric (R : A → A → Prop) : Prop := ∀ x y, R x y → R y x
def asymmetric (R : A → A → Prop) : Prop := ∀ (a b : A), R a b → ¬(R b a)
def transitive (R : A → A → Prop) : Prop := ∀ x y z, R x y → R y z → R x z
def anti_symmetric (R : A → A → Prop) : Prop := ∀ x y, R x y → R y x → x = y

def preorder (R : A → A → Prop) : Prop := reflexive R ∧ transitive R
def total (R : A → A → Prop) : Prop := ∀ x y, R x y ∨ R y x
def partial_order (R : A → A → Prop) : Prop := preorder R ∧ anti_symmetric R
def total_order (R : A → A → Prop) : Prop := partial_order R ∧ total R
def strict_order (R : A → A → Prop) : Prop := transitive R ∧ asymmetric R

-- Section 4: Equivalence relations
def equivalence (R : A → A → Prop) := reflexive R ∧ symmetric R ∧ transitive R

-- Using preorder, we describe a partial order as an antisymmetric preorder,
-- and an equivalence relation as a symmetric preorder

example (R : A → A → Prop):
  equivalence R ↔ preorder R ∧ symmetric R :=
begin
  split,
  { intro equivR,
    cases equivR with reflR h1,
    split,
    split,
    exact reflR,
    exact h1.2, -- transitive R
    exact h1.1}, -- symmetric R
  { intro h,
    cases h with h1 symmR,
    split,
    exact h1.1, -- reflexive R
    split,
    exact symmR,
    exact h1.2}, -- transitive R
end

-- another way of defining equivalence relations
example (R : A → A → Prop) (reflR : reflexive R) (h : ∀ (a b c : A), R a b ∧ R c b → R a c) : equivalence R :=
begin
  split,
  -- prove reflexivity
  exact reflR,

  split,
  -- prove symmetry
  intros a b hRab,
  have h1 : R b b := reflR b,
  specialize h b b a,
  apply h,
  split,
  exact h1, exact hRab,

  -- prove transitivity
  intros a b c hRab hRbc,
  have h2 : R a b ∧ R c b → R a c := h a b c,
  have h3 : R c c ∧ R b c → R c b := h c c b,
  apply h2,
  split,
  exact hRab,
  apply h3,
  split,
  exact reflR c,
  exact hRbc,
end

-- If E is a equivalence relation, then E ∘ ((E ∘ R) ∩ S) = (E ∘ R) ∩ (E ∘ S)
example (E : A → A → Prop) (R : A → A → Prop) (S : A → A → Prop) (equivE : equivalence E) : comp E (intersect (comp E R) S) = intersect (comp E R) (comp E S) :=
begin
  cases equivE with reflE equivE,
  cases equivE with symmE transE,

  ext a b,
  split,
  { intro h,
    cases h with c hc,
    cases hc with hEac hc,
    cases hc with hER hScb,
    cases hER with d hcd,
    split,
    { use d,
      split,
      apply transE a c d hEac hcd.1,
      exact hcd.2},
    { use c,
      split,
      exact hEac,
      exact hScb},
    },
  { intro h,
    cases h with hER hES,
    cases hER with c hc,
    cases hES with d hd,
    use d,
    split,
    exact hd.1,
    split,
    { use c,
      split,
      have hEda : E d a, apply symmE a d hd.1,
      apply transE d a c hEda hc.1,
      exact hc.2},
    exact hd.2,
    },
end
-- Since R, S are arbitrary, we can use similar arguments to show `E ∘ ((E ∘ S) ∩ R) = (E ∘ R) ∩ (E ∘ S)`.

-- Section 5: Compositions
namespace composition_relations
/-
Define composition of relations (analogous to friend of a friend):
For relations R,S on set A, the composition `R ∘ S` is the relation that, for a,b ∈ A,
(R ∘ S)(a,b) is the proposition that `∃ (y : A), R a y ∧ S y b`.

If R = S, we write the composition as R₂.
-/
def R₂ (a b : A) : Prop := ∃ (y : A), R a y ∧ R y b
-- ∃ (y : A), R a y ∧ R y b
-- (∀ (a b : A), (∃ (y : A), R a y ∧ R y b) → R a b)

-- The composition operation on binary relations is associative.
lemma relation_comp_assoc (R : A → A → Prop) (S : A → A → Prop) (T : A → A → Prop) : comp (comp R S) T = comp R (comp S T) :=
begin
  ext a b,
  split,
  { intro h,
    cases h with y h, -- unfold relation.comp & let such element be y
    cases h with h1 h2, -- split conjunction ∧
    cases h1 with z h1, -- unfold relation.comp & let such element be z
    use z,
    split,
    exact h1.1,
    { use y,
      split,
      exact h1.2,
      exact h2},
    },
  { intro h,
    rw comp at *,
    cases h with y h, -- unfold relation.comp & let such element be y
    cases h with h1 h2,
    cases h2 with z h2, -- unfold relation.comp & let such element be y
    use z,
    split,
    { use y,
      split,
      exact h1,
      exact h2.1},
    exact h2.2,
  },
end

-- A relation R is transitive iff R_2 is transitive.
lemma trans_iff_closure (R : A → A → Prop) : transitive R ↔ (∀ (a b : A), (∃ (y : A), R a y ∧ R y b) → R a b) :=
begin
  split,
  { intros transR a b h1,
    cases h1 with y h1,
    apply transR a y b h1.1 h1.2,
    },
  { intro h,
    intros a b c hRab hRbc,
    specialize h a c,
    apply h,
    use b,
    split,
    exact hRab,
    exact hRbc,
    },
end

def idempotent (R : A → A → Prop) : Prop :=
∀ (a b : A), (∃ (y : A), R a y ∧ R y b) ↔ R a b

lemma refl_trans_implies_idempotence (reflR : reflexive R) (transR : transitive R) : idempotent R :=
begin
  intros a b,
  split,
  { intro h,
    cases h with y h,
    apply transR a y b h.1 h.2},
  { intro Rab,
    use a,
    split,
    apply reflR a,
    exact Rab},
end

def R_transpose (a b : A) : Prop := R b a

end composition_relations

namespace relations_2
--variables {a b : A}

/- Schröder's rule
For binary relations (a : A → B → Prop) (b : B → C → Prop) (c : A → C → Prop), the following are equivalent:
1)  a ∘ b ⊆ c
2)  a.transpose ∘ c.complement ⊆ b.complement
3)  c.complement ∘ b.transpose ⊆ a.complement
-/

theorem schroder_rule_1 (a : A → B → Prop) (b : B → C → Prop) (c : A → C → Prop) :
(∀ (x : A) (z : C), relation.comp a b x z → c x z) ↔ (∀ (y : B) (z : C), relation.comp (transpose a) (complement c) y z → complement b y z) :=
begin
  split,
  { intro h,
    intros y z h1, -- fix y ∈ B and z ∈ C
    --rw relation.comp at h1, -- unfold relation composition
    cases h1 with x h1, -- let such element be x ∈ A
    cases h1 with haxy hncxz, -- simplify `and` conjunction
    specialize h x z,
    intro hbyz, -- change complement def into `b y z → false`
    apply hncxz,
    apply h,
    use y, -- y is the required intermediate element
    split,
    exact haxy,
    exact hbyz,
    },
  { intro h,
    intros x z h1, -- fix x ∈ A and z ∈ C
    cases h1 with y h1, -- let such intermediate element be y
    cases h1 with haxy hbyz, -- simplify `and` conjunction
    specialize h y z,
    by_contra hncxz,
    apply h,
    { use x, -- x is the required intermediate element
      split,
      exact haxy,
      exact hncxz},
    exact hbyz,
    },
end

theorem schroder_rule_2 (a : A → B → Prop) (b : B → C → Prop) (c : A → C → Prop) : (∀ (x : A) (z : C), comp a b x z → c x z) ↔ (∀ (x : A) (y : B), comp (complement c) (transpose b) x y → complement a x y) :=
begin
  split,
  { intro h,
    intros x y h1, -- fix x ∈ A and y ∈ B
    cases h1 with z h1, -- let such element be z ∈ C
    cases h1 with hncxz hbzy, -- simplify `and` conjunction
    specialize h x z,
    intro haxy,
    apply hncxz,
    apply h,
    use y, -- y is the required intermediate element
    split,
    exact haxy,
    exact hbzy},
  { intro h,
    intros x z h1, -- fix x ∈ A and z ∈ C
    cases h1 with y h1, -- let such element be y ∈ B
    cases h1 with haxy hbyz,
    specialize h x y,
    by_contra hncxz,
    apply h,
    { use z,  -- z is the required intermediate element
      split,
      exact hncxz,
      exact hbyz},
    exact haxy},
end

lemma transpose_comp (a : A → B → Prop) (b : B → C → Prop) : transpose (comp a b) = comp (transpose b) (transpose a) :=
begin
  ext z x,
  split,
  { intro h,
    -- rw relation_transpose at h,
    cases h with y hy, -- let such element in the composition be y ∈ B
    use y,
    split,
    exact hy.2,
    exact hy.1},
  { intro h,
    cases h with y hy,
    use y,
    split,
    exact hy.2,
    exact hy.1},
end

/- Dedekind rule
For binary relations (a : A → B → Prop) (b : B → C → Prop) (c : A → C → Prop), x ∈ A, y ∈ B,
((a ∘ b) ∩ c) x y → ((a ∩ (c ∘ b.transpose)) ∘ (b ∩ (a.transpose ∘ c))) x y
-/

theorem dedekind_rule (a : A → B → Prop) (b : B → C → Prop) (c : A → C → Prop) : ∀ (x : A) (z : C), intersect (comp a b) c x z → comp (intersect a (comp c (transpose b))) (intersect b (comp (transpose a) c)) x z :=
begin
  intros x z h,
  cases h with h1 hcxz,
  cases h1 with y h1_y,
  use y,
  split,
  { split,
    { exact h1_y.1},
    { use z,
      split,
      exact hcxz,
      exact h1_y.2},
    },
  { split,
    { exact h1_y.2},
    { use x,
      split,
      exact h1_y.1,
      exact hcxz},
    },
end

-- Exercise 4.3.1 (Relational Mathematics) (R ⊆ R ∘ R.transpose ∘ R)
example (r : A → B → Prop) (x : A) (y : B): r x y → comp (comp r (transpose r)) r x y :=
begin
  intro rxy,
  use x,
  split,
  { use y,
    split,
    exact rxy,
    exact rxy},
  { exact rxy},
end

-- Exercise 4.3.2 (Relational Mathematics) (A.transpose ∘ C ⊆ D → (A ∘ B) ∩ C ⊆ A ∘ (B ∩ D))
example (a : A → B → Prop) (b : B → C → Prop) (c : A → C → Prop) (d : B → C → Prop) :
(∀ (y : B) (z : C), comp (transpose a) c y z → d y z) → (∀ (x : A) (z : C), intersect (comp a b) c x z  → comp a (intersect b d) x z) :=
begin
  intro h,
  intros x z h1,
  cases h1 with h2 hcxz,
  cases h2 with y h2,
  cases h2 with haxy hbyz,
  specialize h y z,
  use y,
  split,
  exact haxy,
  split,
  { exact hbyz},
  { apply h,
    use x,
    split,
    exact haxy,
    exact hcxz},
end

end relations_2

end myrelation