import tactic.tauto

@[derive decidable_eq]
inductive mynat
| zero : mynat
| succ (n : mynat) : mynat

namespace mynat

instance : has_zero mynat := ⟨mynat.zero⟩

theorem mynat_zero_eq_zero : mynat.zero = 0 := rfl

def one : mynat := succ 0

instance : has_one mynat := ⟨mynat.one⟩

theorem one_eq_succ_zero : 1 = succ 0 := rfl

lemma zero_ne_succ (m : mynat) : (0 : mynat) ≠ succ m := λ h, by cases h

lemma succ_inj {m n : mynat} (h : succ m = succ n) : m = n := by cases h; refl

end mynat

attribute [symm] ne.symm

namespace mynat

-- definition of "addition on the natural numbers"
def add : mynat → mynat → mynat
| m 0 := m
| m (succ n) := succ (add m n)

instance : has_add mynat := ⟨mynat.add⟩

-- numerals now work
example : mynat := 37

lemma add_zero (m : mynat) : m + 0 = m := rfl

lemma add_succ (m n : mynat) : m + succ n = succ (m + n) := rfl

-- end of definition of "addition on the natural numbers"

end mynat

namespace mynat

def mul : mynat → mynat → mynat
| m zero := zero
| m (succ n) := mul m n + m

instance : has_mul mynat := ⟨mul⟩
-- notation a * b := mul a b

example : (1 : mynat) * 1 = 1 :=
begin
refl
end

lemma mul_zero (m : mynat) : m * 0 = 0 := rfl

lemma mul_succ (m n : mynat) : m * (succ n) = m * n + m := rfl

def pow : mynat → mynat → mynat
| m zero := one
| m (succ n) := pow m n * m

instance : has_pow mynat mynat := ⟨pow⟩
-- notation a ^ b := pow a b

example : (1 : mynat) ^ (1 : mynat) = 1 :=
begin
refl
end

lemma pow_zero (m : mynat) : m ^ (0 : mynat) = 1 := rfl

lemma pow_succ (m n : mynat) : m ^ (succ n) = m ^ n * m := rfl

end mynat

------------------------------------------------------------------------

namespace mynat

lemma example1 (x y z : mynat) : x + y + z = x + y + z :=
begin
refl,
end

lemma example1' (x y z : mynat) : x + y + z = x + y + z := rfl

lemma example2 (x y : mynat) (h : y = x + 7) : 2 * y = 2 * (x + 7) := by rw h

lemma example2' (x y : mynat) (h : y = x + 7) : 2 * y = 2 * (x + 7) :=
begin
  rw h,
end

lemma example2'' (x y : mynat) (h : y = x + 7) : 2 * y = 2 * (x + 7) :=
have h_two_mul : 2 * y = 2 * y, from rfl,
show 2 * y = 2 * (x + 7), from (by rw h)

lemma example3 (a b : mynat) (h : succ a = b) : succ(succ(a)) = succ(b) :=
begin
  rw h,
end

lemma zero_add (n : mynat) : 0 + n = n :=
begin
  induction n,
  {
    rw mynat_zero_eq_zero,
    rw add_zero,
  },
  {
    rw add_succ,
    rw n_ih,
  }
end

lemma add_assoc (a b c : mynat) : (a + b) + c = a + (b + c) :=
begin
  induction c,
  {
    rw mynat_zero_eq_zero,
    rw add_zero (a + b),
    rw add_zero b,
  },
  {
    rw add_succ (a + b),
    rw add_succ b,
    rw add_succ a,
    rw c_ih,
  }
end

lemma succ_add (a b : mynat) : succ a + b = succ (a + b) :=
begin
  induction b,
  {
    rw mynat_zero_eq_zero,
    rw add_zero a,
    rw add_zero (succ a),
  },
  {
    rw add_succ a,
    rw add_succ (succ a),
    rw b_ih,
  }
end

lemma add_comm (a b : mynat) : a + b = b + a :=
begin
  induction b,
  {
    rw mynat_zero_eq_zero,
    rw add_zero a,
    induction a,
    {
      rw mynat_zero_eq_zero,
      rw add_zero 0,
    },
    {
      rw add_succ 0,
      rw ← a_ih,
    }
  },
  {
    rw succ_add b_n,
    rw add_succ a,
    rw b_ih,
  }
end

theorem succ_eq_add_one (n : mynat) : succ n = n + 1 :=
begin
  rw one_eq_succ_zero,
  rw add_succ n,
  rw add_zero n,
end

lemma add_right_comm (a b c : mynat) : a + b + c = a + c + b :=
begin
  induction c,
  {
    rw mynat_zero_eq_zero,
    rw add_zero (a + b),
    rw add_zero a,
  },
  {
    rw add_succ (a + b),
    rw add_succ a,
    rw succ_add,
    rw c_ih,
  }
end

-- The proof in tactic mode
lemma zero_mul (m : mynat) : 0 * m = 0 :=
begin
induction m,
{
-- Q0: Why do I need this extra line compared to in http://wwwf.imperial.ac.uk/~buzzard/xena/natural_number_game/?world=3&level=1
  rw mynat_zero_eq_zero,
  rw mul_zero 0,
},
{
  rw mul_succ 0 m_n,
  rw add_zero (0 * m_n),
  rw m_ih,
}
end

-- The proof of a forall version of the lemma
-- ported from https://leanprover-community.github.io/mathlib_docs/core/init/data/nat/lemmas.html#nat.zero_mul
-- Q1: Why does it need an extra refl than the original proof?
lemma zero_mul_forall : ∀ (m : mynat), 0 * m = 0
| 0        := rfl
| (succ m) := begin
  rw [mul_succ, zero_mul_forall],
  refl
end

lemma zero_mul_forall_match : ∀ (m : mynat),  0 * m = 0
| zero :=
calc zero * zero
    = 0 * 0 : by rw mynat_zero_eq_zero
... = 0 : by rw mul_zero 0
| n@(succ m_n) :=
calc 0 * (succ m_n)
    = 0 * m_n + 0 : by rw mul_succ
... = 0 * m_n : by rw add_zero (0 * m_n)
... = 0 : by rw zero_mul_forall_match m_n

lemma zero_mul_forall_match_term : ∀ (m : mynat),  0 * m = 0
| zero :=
calc zero * zero
    = 0 * 0 : by rw mynat_zero_eq_zero
... = 0 : by rw mul_zero 0
| n@(succ m_n) :=
calc 0 * (succ m_n)
    = 0 * m_n + 0 : mul_succ 0 m_n
... = 0 * m_n : add_zero (0 * m_n)
... = 0 : by rw zero_mul_forall_match m_n

-- Q2: how can I refer to the lemma itself in the match proof at <marker>
lemma zero_mul_match (m : mynat) : 0 * m = 0 :=
match m with
| zero :=
calc zero * zero
    = 0 * 0 : by rw mynat_zero_eq_zero
... = 0 : by rw mul_zero 0
| n@(succ m_n) :=
calc 0 * (succ m_n)
    = 0 * m_n + 0 : by rw mul_succ
... = 0 * m_n : by rw add_zero (0 * m_n)
... = 0 : by sorry -- <marker>
end

lemma zero_mul_induction_zero : 0 * zero = 0 := rfl

lemma zero_mul_induction_m_n : ∀ (n : mynat), 0 * n = 0 → 0 * n.succ = 0 :=
λ m_n h, add_zero (0 * m_n) ▸ mul_succ 0 m_n ▸ h

-- Q3: Why `add_zero` is no longer needed?
lemma zero_mul_induction_m_n' : ∀ (n : mynat), 0 * n = 0 → 0 * n.succ = 0 :=
λ m_n h, mul_succ 0 m_n ▸ h

lemma zero_mul_rec (m : mynat) : 0 * m = 0 :=
mynat.rec_on m zero_mul_induction_zero zero_mul_induction_m_n

lemma zero_mul_rec' (m : mynat) : 0 * m = 0 :=
mynat.rec_on m rfl (λ m_n h, mul_succ 0 m_n ▸ h)

-- lemma zero_mul_rec'' (m : mynat) : 0 * m = 0 :=
-- m.rec_on zero_mul_induction_zero zero_mul_induction_m_n

-- https://leanprover.zulipchat.com/#narrow/stream/113489-new-members/topic/Natural.20Numbers.20Game/near/199964443

lemma mul_one (m : mynat) : m * 1 = m :=
begin
  induction m,
  {
    rw one_eq_succ_zero,
    rw mul_succ,
    rw mul_zero,
    refl
  },
  {
    rw one_eq_succ_zero,
    rw mul_succ,
    rw mul_zero,
    rw zero_add,
  }
end

lemma one_mul (m : mynat) : 1 * m = m :=
begin
  induction m,
  {
    rw mynat_zero_eq_zero,
    rw mul_zero,
  },
  {
    rw mul_succ,
    rw succ_eq_add_one,
    rw m_ih
  }
end

lemma mul_add (t a b : mynat) : t * (a + b) = t * a + t * b :=
begin
  induction b,
  {
    rw [mynat_zero_eq_zero, add_zero, mul_zero, add_zero],
  },
  {
    rw mul_succ,
    rw add_succ,
    rw mul_succ,
    rw b_ih,
    rw add_assoc,
  }
end

lemma mul_assoc (a b c : mynat) : (a * b) * c = a * (b * c) :=
begin
induction c,
{
  rw mynat_zero_eq_zero,
  rw mul_zero (a * b),
  rw mul_zero b,
  rw mul_zero a,
},
{
  rw mul_succ (a * b),
  rw mul_succ b,
  rw c_ih,
  rw mul_add a,
}
end

lemma succ_mul (a b : mynat) : succ a * b = a * b + b :=
begin
  induction b,
  {
    rw mynat_zero_eq_zero,
    rw mul_zero,
    rw mul_zero,
    rw add_zero,
  },
  {
    rw mul_succ,
    rw mul_succ,
    rw add_succ,
    rw add_succ,
    rw b_ih,
    rw add_assoc,
    rw add_comm b_n a,
    rw ←add_assoc,
  }
end

lemma succ_mul' (a b : mynat) : succ a * b = a * b + b :=
begin
  induction b,
  {
    rw mynat_zero_eq_zero,
    rw mul_zero,
    rw mul_zero,
    rw add_zero,
  },
  {
    rw mul_succ,
    rw mul_succ,
    rw add_succ,
    rw add_succ,
    rw b_ih,
    rw add_right_comm,
  }
end

lemma add_mul (a b t : mynat) : (a + b) * t = a * t + b * t :=
begin
  induction t,
  {
    rw mynat_zero_eq_zero,
    rw [mul_zero, mul_zero, mul_zero, add_zero],
  },
  {
    rw [mul_succ, mul_succ, mul_succ],
    rw t_ih,
    rw add_right_comm,
    rw add_comm (b * t_n) b,
    rw ←add_assoc(a * t_n) a b,
    rw add_assoc (a * t_n + a) b (b * t_n),
  }
end

lemma mul_comm (a b : mynat) : a * b = b * a :=
begin
  induction b,
  {
    rw mynat_zero_eq_zero,
    rw [mul_zero, zero_mul],
  },
  {
    rw [mul_succ, succ_mul, b_ih],
  }
end

lemma mul_left_comm (a b c : mynat) : a * (b * c) = b * (a * c) :=
begin
  rw ←mul_assoc b a c,
  rw mul_comm b a,
  rw mul_assoc a b c
end

lemma zero_pow_zero : (0 : mynat) ^ (0 : mynat) = 1 :=
begin
  rw pow_zero,
end

lemma zero_pow_succ (m : mynat) : (0 : mynat) ^ (succ m) = 0 :=
begin
  rw [pow_succ, mul_zero],
end

lemma pow_one (a : mynat) : a ^ (1 : mynat) = a :=
by rw [one_eq_succ_zero, pow_succ, pow_zero, one_mul]

lemma one_pow (m : mynat) : (1 : mynat) ^ m = 1 :=
begin
induction m with n h,
{
  rw mynat_zero_eq_zero,
  rw pow_zero,
},
{
  rw pow_succ,
  rw h,
  refl,
}
end

lemma pow_add (a m n : mynat) : a ^ (m + n) = a ^ m * a ^ n :=
begin
  induction n with k h,
  {
    rw mynat_zero_eq_zero,
    rw pow_zero,
    rw add_zero,
    rw mul_one,
  },
  {
    rw add_succ,
    rw [pow_succ, pow_succ],
    rw h,
    rw mul_assoc (a ^ m) (a ^ k) a,
  }
end

lemma mul_pow (a b n : mynat) : (a * b) ^ n = a ^ n * b ^ n :=
begin
induction n with k h,
  {
    rw mynat_zero_eq_zero,
    rw [pow_zero, pow_zero, pow_zero],
    refl,
  },
  {
    rw [pow_succ, pow_succ, pow_succ],
    rw h,
    rw mul_assoc (a ^ k) (b ^ k) (a * b),
    rw mul_left_comm (b ^ k) a b,
    rw mul_assoc (a ^ k) a (b ^ k * b),
  }
end

lemma pow_pow (a m n : mynat) : (a ^ m) ^ n = a ^ (m * n) :=
begin
  induction n with k h,
  {
    rw mynat_zero_eq_zero,
    rw [pow_zero, mul_zero, pow_zero],
  },
  {
    rw [pow_succ, mul_succ],
    rw h,
    rw pow_add a (m * k) m,
  }
end

lemma two_eq_succ_one : 2 = succ 1 := rfl

lemma add_squared (a b : mynat) :
  (a + b) ^ (2 : mynat) = a ^ (2 : mynat) + b ^ (2 : mynat) + 2 * a * b :=
begin
  rw two_eq_succ_one,
  rw one_eq_succ_zero,
  rw [pow_succ, pow_succ, pow_succ, pow_succ, pow_succ, pow_succ],
  rw [pow_zero, pow_zero, pow_zero],
  rw [one_mul, one_mul, one_mul],
  rw mul_add,
  rw add_mul,
  rw add_mul,
  rw mul_comm b a,
  rw succ_mul,
  rw ←one_eq_succ_zero,
  rw one_mul,
  rw add_mul,
  rw add_assoc (a * a) (a * b) (a * b + b * b),
  rw add_assoc (a * a) (b * b) (a * b + a * b),
  rw ←add_assoc  (b * b) (a * b) (a * b),
  rw add_comm  (b * b) (a * b),
  rw add_assoc (a * b) (b * b) (a * b),
  rw add_comm (b * b) (a * b),
end -- 28 rewrites

-- https://leanprover.zulipchat.com/#narrow/stream/113489-new-members/topic/natural.20number.20game.20questions/near/196864644
lemma add_squared' (a b : mynat) :
  (a + b) ^ (2 : mynat) = a ^ (2 : mynat) + b ^ (2 : mynat) + 2 * a * b :=
begin
  rw two_eq_succ_one,
  rw pow_succ,
  rw pow_succ,
  rw pow_succ,
  rw pow_one,
  rw pow_one,
  rw pow_one,
  rw add_mul,
  rw mul_add,
  rw mul_add,
  rw succ_mul,
  rw one_mul,
  rw add_mul,
  rw mul_comm b a,
  rw add_assoc,
  rw add_assoc,
  rw add_comm (b * b),
  rw add_assoc,
end

-- Adapted from https://leanprover.zulipchat.com/#narrow/stream/113489-new-members/topic/natural.20number.20game.20questions/near/196867894
lemma add_squared'' (a b : mynat) :
  (a + b) ^ (2 : mynat) = a ^ (2 : mynat) + b ^ (2 : mynat) + 2 * a * b :=
begin
  have two_mul: ∀ x : mynat, (2:mynat) * x = x + x := λx, by rw [two_eq_succ_one, succ_mul 1 x, one_mul],
  have pow_two: ∀ x : mynat, x ^ (2:mynat) = x * x := λx, by rw [two_eq_succ_one, pow_succ, pow_one],
  rw [pow_two, pow_two, pow_two],
  rw [add_mul, two_mul, add_right_comm, add_mul],
  rw [← add_assoc, ← mul_add, mul_add b, mul_comm b, add_assoc]
end

example (P Q : Type) (p : P) (h : P → Q) : Q :=
begin
  exact h(p),
end

example : mynat → mynat :=
begin
  intro n,
  exact 3*n+2,
end

example (P Q R S T U: Type)
(p : P)
(h : P → Q)
(i : Q → R)
(j : Q → T)
(k : S → T)
(l : T → U)
: U :=
begin
  have q : Q := h(p),
  have t : T := j(q),
  exact l(t),
end

example (P Q R S T U: Type)
(p : P)
(h : P → Q)
(i : Q → R)
(j : Q → T)
(k : S → T)
(l : T → U)
: U :=
begin
  apply l,
  apply j,
  apply h,
  exact p,
end

example (P Q : Type) : P → (Q → P) :=
begin
  intros p q,
  exact p,
end

example (P Q R : Type) : (P → (Q → R)) → ((P → Q) → (P → R)) :=
begin
  intro pqr,
  intro pq,
  intro p,
  have q : Q := pq(p),
  exact pqr p q,
end

example (P Q F : Type) : (P → Q) → ((Q → F) → (P → F)) :=
begin
  intro pq,
  intro qf,
  intro p,
  have q : Q := pq p,
  exact qf q,
end

example (P Q : Type) : (P → Q) → ((Q → empty) → (P → empty)) :=
begin
  intro pq,
  intro qe,
  intro p,
  apply qe,
  apply pq,
  exact p,
end

example (A B C D E F G H I J K L : Type)
(f1 : A → B) (f2 : B → E) (f3 : E → D) (f4 : D → A) (f5 : E → F)
(f6 : F → C) (f7 : B → C) (f8 : F → G) (f9 : G → J) (f10 : I → J)
(f11 : J → I) (f12 : I → H) (f13 : E → H) (f14 : H → K) (f15 : I → L)
 : A → L :=
begin
  intro a,
  apply f15,
  apply f11,
  have e : E := f2 (f1 a),
  have j : J := f9 (f8 (f5 e)),
  exact j,
end

example (P Q : Prop) (p : P) (h : P → Q) : Q :=
begin
  exact h(p),
end

lemma imp_self (P : Prop) : P → P :=
begin
  intro p,
  exact p,
end

lemma maze (P Q R S T U: Prop)
(p : P)
(h : P → Q)
(i : Q → R)
(j : Q → T)
(k : S → T)
(l : T → U)
: U :=
begin
  apply l,
  have q : Q := h p,
  exact j q,
end

example (P Q : Prop) : P → (Q → P) :=
begin
  intros p q,
  exact p,
end

example (P Q R : Prop) : (P → (Q → R)) → ((P → Q) → (P → R)) :=
begin
  intros pqr pq p,
  have q : Q := pq p,
  exact pqr p q,
end

lemma imp_trans (P Q R : Prop) : (P → Q) → ((Q → R) → (P → R)) :=
begin
  intros hpq hqr p,
  exact hqr (hpq p),
end

lemma contrapositive (P Q : Prop) : (P → Q) → (¬ Q → ¬ P) :=
begin
  repeat {rw not_iff_imp_false},
  intro hpq,
  intro nq,
  intro p,
  exact nq (hpq p),
end

example (A B C D E F G H I J K L : Prop)
(f1 : A → B) (f2 : B → E) (f3 : E → D) (f4 : D → A) (f5 : E → F)
(f6 : F → C) (f7 : B → C) (f8 : F → G) (f9 : G → J) (f10 : I → J)
(f11 : J → I) (f12 : I → H) (f13 : E → H) (f14 : H → K) (f15 : I → L)
 : A → L :=
begin
  intro a,
  apply f15,
  apply f11,
  exact f9 (f8 (f5 (f2 (f1 a)))),
end

example (A B C D E F G H I J K L : Prop)
(f1 : A → B) (f2 : B → E) (f3 : E → D) (f4 : D → A) (f5 : E → F)
(f6 : F → C) (f7 : B → C) (f8 : F → G) (f9 : G → J) (f10 : I → J)
(f11 : J → I) (f12 : I → H) (f13 : E → H) (f14 : H → K) (f15 : I → L)
 : A → L :=
begin
  cc
end

example (P Q : Prop) (p : P) (q : Q) : P ∧ Q :=
begin
  split,
  exact p,
  exact q,
end

lemma and_symm (P Q : Prop) : P ∧ Q → Q ∧ P :=
begin
  intro hpq,
  cases hpq with p q,
  split,
  exact q,
  exact p,
end

lemma and_trans (P Q R : Prop) : P ∧ Q → Q ∧ R → P ∧ R :=
begin
  intro hpq,
  intro hqr,
  cases hpq with p q,
  split,
  {
    exact p,
  },
  {
    cases hqr with q' r,
    exact r,
  }
end

lemma iff_trans (P Q R : Prop) : (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
  intro hpq,
  intro hqr,
  split,
  {
    intro p,
    cases hpq with pq qp,
    cases hqr with qr rq,
    exact qr (pq p),
  },
  {
    intro r,
    cases hpq,
    cases hqr,
    apply hpq_mpr,
    apply hqr_mpr,
    exact r,
  }
end

lemma iff_trans' (P Q R : Prop) : (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
  intros hpq hqr,
  split,
  {
    intro p,
    exact hqr.1 (hpq.1 p),
  },
  {
    intro r,
    exact hpq.2 (hqr.2 r),
  }
end

lemma iff_trans'' (P Q R : Prop) : (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
  cc
end

lemma iff_trans''' (P Q R : Prop) : (P ↔ Q) → (Q ↔ R) → (P ↔ R) :=
begin
  intros hpq hqr,
  rw hpq,
  exact hqr,
end

example (P Q : Prop) : Q → (P ∨ Q) :=
begin
  intro q,
  right,
  exact q,
end

lemma or_symm (P Q : Prop) : P ∨ Q → Q ∨ P :=
begin
  intro hpq,
  cases hpq with p q,
  {
    right,
    exact p,
  },
  {
    left,
    exact q,
  }
end

lemma and_or_distrib_left (P Q R : Prop) : P ∧ (Q ∨ R) ↔ (P ∧ Q) ∨ (P ∧ R) :=
begin
  split,
  {
    intro pnqr,
    cases pnqr with p qr,
    cases qr with q r,
    {
      left,
      split,
      exact p,
      exact q,
    },
    {
      right,
      split,
      exact p,
      exact r,
    }
  },
  {
    intro pqnpr,
    cases pqnpr with pq pr,
    {
      cases pq with p q,
      split,
      exact p,
      left,
      exact q,
    },
    {
      cases pr with p r,
      split,
      exact p,
      right,
      exact r,
    }
  }
end

lemma contra (P Q : Prop) : (P ∧ ¬ P) → Q := by tauto

lemma contra' (P Q : Prop) : (P ∧ ¬ P) → Q :=
begin
  intro h,
  repeat {rw not_iff_imp_false at h},
  cases h with p np,
  exfalso,
  exact np p,
end

lemma contra'' (P Q : Prop) : (P ∧ ¬ P) → Q :=
begin
  intro h,
  cases h with p np,
  exfalso,
  exact np p,
end

local attribute [instance, priority 10] classical.prop_decidable -- we are mathematicians

lemma contrapositive2 (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) :=
begin
  by_cases p : P; by_cases q : Q,
  repeat {cc},
end

lemma contrapositive2' (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) :=
begin
  tauto,
end

/-

Dark mode for http://wwwf.imperial.ac.uk/~buzzard/xena/natural_number_game/:

body, button, .accordion__button,.accordion__panel {
    background-color: #202020 !important;
    color: #cdcdcd;

}

.Resizer {
    background-color: #535353 !important;
}

/*
Press F12, choose Console, copy-paste the following and hit Enter:

monaco.editor.setTheme('vs-dark');
*/

-/

end mynat


/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import analysis.normed.group.basic
import topology.metric_space.hausdorff_distance

/-!
# Properties of pointwise addition of sets in normed groups.

We explore the relationships between pointwise addition of sets in normed groups, and the norm.
Notably, we show that the sum of bounded sets remain bounded.
-/

open metric set
open_locale pointwise topological_space

section semi_normed_group

variables {E : Type*} [semi_normed_group E]

lemma bounded_iff_exists_norm_le {s : set E} :
  bounded s ↔ ∃ R, ∀ x ∈ s, ∥x∥ ≤ R :=
by simp [subset_def, bounded_iff_subset_ball (0 : E)]

alias bounded_iff_exists_norm_le ↔ metric.bounded.exists_norm_le _

lemma metric.bounded.exists_pos_norm_le {s : set E} (hs : metric.bounded s) :
  ∃ R > 0, ∀ x ∈ s, ∥x∥ ≤ R :=
begin
  obtain ⟨R₀, hR₀⟩ := hs.exists_norm_le,
  refine ⟨max R₀ 1, _, _⟩,
  { exact (by norm_num : (0:ℝ) < 1).trans_le (le_max_right R₀ 1) },
  intros x hx,
  exact (hR₀ x hx).trans (le_max_left _ _),
end

lemma metric.bounded.add
  {s t : set E} (hs : bounded s) (ht : bounded t) :
  bounded (s + t) :=
begin
  obtain ⟨Rs, hRs⟩ : ∃ (R : ℝ), ∀ x ∈ s, ∥x∥ ≤ R := hs.exists_norm_le,
  obtain ⟨Rt, hRt⟩ : ∃ (R : ℝ), ∀ x ∈ t, ∥x∥ ≤ R := ht.exists_norm_le,
  refine (bounded_iff_exists_norm_le).2 ⟨Rs + Rt, _⟩,
  rintros z ⟨x, y, hx, hy, rfl⟩,
  calc ∥x + y∥ ≤ ∥x∥ + ∥y∥ : norm_add_le _ _
  ... ≤ Rs + Rt : add_le_add (hRs x hx) (hRt y hy)
end

@[simp] lemma singleton_add_ball (x y : E) (r : ℝ) :
  {x} + ball y r = ball (x + y) r :=
by simp only [preimage_add_ball, image_add_left, singleton_add, sub_neg_eq_add, add_comm y x]

@[simp] lemma ball_add_singleton (x y : E) (r : ℝ) :
  ball x r + {y} = ball (x + y) r :=
by simp [add_comm _ {y}, add_comm y]

lemma singleton_add_ball_zero (x : E) (r : ℝ) :
  {x} + ball 0 r = ball x r :=
by simp

lemma ball_zero_add_singleton (x : E) (r : ℝ) :
  ball 0 r + {x} = ball x r :=
by simp

@[simp] lemma singleton_add_closed_ball (x y : E) (r : ℝ) :
  {x} + closed_ball y r = closed_ball (x + y) r :=
by simp only [add_comm y x, preimage_add_closed_ball, image_add_left, singleton_add, sub_neg_eq_add]

@[simp] lemma closed_ball_add_singleton (x y : E) (r : ℝ) :
  closed_ball x r + {y} = closed_ball (x + y) r :=
by simp [add_comm _ {y}, add_comm y]

lemma singleton_add_closed_ball_zero (x : E) (r : ℝ) :
  {x} + closed_ball 0 r = closed_ball x r :=
by simp

lemma closed_ball_zero_add_singleton (x : E) (r : ℝ) :
  closed_ball 0 r + {x} = closed_ball x r :=
by simp

lemma is_compact.cthickening_eq_add_closed_ball
  {s : set E} (hs : is_compact s) {r : ℝ} (hr : 0 ≤ r) :
  cthickening r s = s + closed_ball 0 r :=
begin
  rw hs.cthickening_eq_bUnion_closed_ball hr,
  ext x,
  simp only [mem_add, dist_eq_norm, exists_prop, mem_Union, mem_closed_ball,
    exists_and_distrib_left, mem_closed_ball_zero_iff, ← eq_sub_iff_add_eq', exists_eq_right],
end

end semi_normed_group


import tactic
import data.nat.gcd
import data.int.gcd
import data.int.basic
import data.nat.modeq
import data.nat.prime
import number_theory.divisors
import algebra.big_operators.basic
--import geom_sum

def divisor_sum : ℕ → ℕ := (λ n : ℕ, n.divisors.sum id)

lemma perfect_iff_sum_divisors_eq_two_mul' (n : ℕ) (hpos : n > 0) : nat.perfect n ↔ divisor_sum n = 2*n :=
begin
  split, {
    intro hn,
    rwa nat.perfect_iff_sum_divisors_eq_two_mul at hn,
    assumption,
  }, {
    intro hn,
    rwa nat.perfect_iff_sum_divisors_eq_two_mul,
    assumption,
  }
end

lemma divisor_sum_is_multiplicative (m n : ℕ) (h_coprime : nat.gcd m n = 1)
      : (divisor_sum(m*n) = divisor_sum(m) * divisor_sum(n)) :=
begin
  unfold divisor_sum,
  sorry,
end

lemma finite_power_series (a k : ℕ) : (finset.range k).sum (λ (x : ℕ), (a ^ x)) = (a^k - 1)/(a-1) :=
begin
  set S := (finset.range k).sum (λ (x : ℕ), a ^ x),
  suffices hS : S = 1 + a * (S - a^(k-1)),
  sorry,
  sorry,
end

-- lemma divisor_sum_of_prime_pow {p k : ℕ } (hk : k ≥ 1) (hp : nat.prime p) : ((nat.divisors (p^(k-1))).sum id = (p^k - 1)/(p-1)) :=
-- begin
--   rw nat.sum_divisors_prime_pow hp,
--   -- power series
--   have hs1 : k - 1 + 1 = k := by linarith,
--   rw hs1,
--   rw finite_power_series p k,
-- end

-- lemma obvious_lemma (a : ℕ) (k ≥ 1) : (2 * 2 ^ (k - 1) = 2^k) :=
-- begin
--   set n := k + 1,
--   induction n with d hd,
-- end

-- ∃ k, 2^k - 1 prime → 2^(k-1) * 2^k - 1 is perfect

lemma mersenne_to_perfect (k : ℕ) (hk : k > 0) (hp : nat.prime (2^k - 1)) : (nat.perfect ( 2^(k-1) * (2^k - 1))) :=
begin
  rw perfect_iff_sum_divisors_eq_two_mul',
  {
    rw divisor_sum_is_multiplicative,
    {
      unfold divisor_sum,
      rw nat.prime.sum_divisors hp,
      have h2 : nat.prime 2 := nat.prime_two,
      rw nat.divisors_prime_pow h2,
      simp,
      have hs : k - 1 + 1 = k := by linarith,
      rw hs,
      rw finite_power_series 2 k,

      rw ← mul_assoc,
      have hpow : 2^k ≥ 1 := nat.one_le_pow' k 1,
      have hs1: 2^k - 1 + 1 = 2^k := by linarith,
      have hs2 : 2 * 2 ^ (k - 1) = 2^k,
      {
        zify,
        sorry,
      },
      rw [hs1, hs2, mul_comm],
    },

    {
      set d : ℕ := nat.gcd (2 ^ (k - 1)) (2 ^ k - 1),

    },

  },

  { simpa using nat.one_lt_two_pow k hk, },

end

-- n is an even perfect number → n = 2^(k-1) * (2^k - 1) for some mersenne prime 2^k - 1


/-
Copyright (c) 2021 Bryan Gin-ge Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bryan Gin-ge Chen
-/
import algebra.punit_instances
import order.hom.lattice
import tactic.abel
import tactic.ring

/-!
# Boolean rings

A Boolean ring is a ring where multiplication is idempotent. They are equivalent to Boolean
algebras.

## Main declarations

* `boolean_ring`: a typeclass for rings where multiplication is idempotent.
* `boolean_ring.to_boolean_algebra`: every Boolean ring is a Boolean algebra; this definition and
  the `sup` and `inf` notations for `boolean_ring` are localized as instances in the
  `boolean_algebra_of_boolean_ring` locale.

## Tags

boolean ring, boolean algebra

-/

variables {α β γ : Type*}

/-- A Boolean ring is a ring where multiplication is idempotent. -/
class boolean_ring α extends ring α :=
(mul_self : ∀ a : α, a * a = a)

section boolean_ring
variables [boolean_ring α] (a b : α)

instance : is_idempotent α (*) := ⟨boolean_ring.mul_self⟩

@[simp] lemma mul_self : a * a = a := boolean_ring.mul_self _

@[simp] lemma add_self : a + a = 0 :=
have a + a = a + a + (a + a) :=
  calc a + a = (a+a) * (a+a)           : by rw mul_self
         ... = a*a + a*a + (a*a + a*a) : by rw [add_mul, mul_add]
         ... = a + a + (a + a)         : by rw mul_self,
by rwa self_eq_add_left at this

@[simp] lemma neg_eq : -a = a :=
calc -a = -a + 0      : by rw add_zero
    ... = -a + -a + a : by rw [←neg_add_self, add_assoc]
    ... = a           : by rw [add_self, zero_add]

lemma add_eq_zero : a + b = 0 ↔ a = b :=
calc a + b = 0 ↔ a = -b : add_eq_zero_iff_eq_neg
           ... ↔ a = b  : by rw neg_eq

@[simp] lemma mul_add_mul : a*b + b*a = 0 :=
have a + b = a + b + (a*b + b*a) :=
  calc a + b = (a + b) * (a + b)       : by rw mul_self
         ... = a*a + a*b + (b*a + b*b) : by rw [add_mul, mul_add, mul_add]
         ... = a + a*b + (b*a + b)     : by simp only [mul_self]
         ... = a + b + (a*b + b*a)     : by abel,
by rwa self_eq_add_right at this

@[simp] lemma sub_eq_add : a - b = a + b :=
by rw [sub_eq_add_neg, add_right_inj, neg_eq]

@[simp] lemma mul_one_add_self : a * (1 + a) = 0 := by rw [mul_add, mul_one, mul_self, add_self]

@[priority 100] -- Note [lower instance priority]
instance boolean_ring.to_comm_ring : comm_ring α :=
{ mul_comm := λ a b, by rw [←add_eq_zero, mul_add_mul],
  .. (infer_instance : boolean_ring α) }

end boolean_ring

instance : boolean_ring punit := ⟨λ _, subsingleton.elim _ _⟩

/-! ### Turning a Boolean ring into a Boolean algebra -/

/-- Type synonym to view a Boolean ring as a Boolean algebra. -/
def as_boolalg (α : Type*) := α

/-- The "identity" equivalence between `as_boolalg α` and `α`. -/
def to_boolalg : α ≃ as_boolalg α := equiv.refl _

/-- The "identity" equivalence between `α` and `as_boolalg α`. -/
def of_boolalg : as_boolalg α ≃ α := equiv.refl _

@[simp] lemma to_boolalg_symm_eq : (@to_boolalg α).symm = of_boolalg := rfl
@[simp] lemma of_boolalg_symm_eq : (@of_boolalg α).symm = to_boolalg := rfl
@[simp] lemma to_boolalg_of_boolalg (a : as_boolalg α) : to_boolalg (of_boolalg a) = a := rfl
@[simp] lemma of_boolalg_to_boolalg (a : α) : of_boolalg (to_boolalg a) = a := rfl
@[simp] lemma to_boolalg_inj {a b : α} : to_boolalg a = to_boolalg b ↔ a = b := iff.rfl
@[simp] lemma of_boolalg_inj {a b : as_boolalg α} : of_boolalg a = of_boolalg b ↔ a = b := iff.rfl

instance [inhabited α] : inhabited (as_boolalg α) := ‹inhabited α›

namespace boolean_ring
variables [boolean_ring α]

/-- The join operation in a Boolean ring is `x + y + x * y`. -/
def has_sup : has_sup α := ⟨λ x y, x + y + x * y⟩
/-- The meet operation in a Boolean ring is `x * y`. -/
def has_inf : has_inf α := ⟨(*)⟩

-- Note [lower instance priority]
localized "attribute [instance, priority 100] boolean_ring.has_sup" in
  boolean_algebra_of_boolean_ring
localized "attribute [instance, priority 100] boolean_ring.has_inf" in
  boolean_algebra_of_boolean_ring

lemma sup_comm (a b : α) : a ⊔ b = b ⊔ a := by { dsimp only [(⊔)], ring }
lemma inf_comm (a b : α) : a ⊓ b = b ⊓ a := by { dsimp only [(⊓)], ring }

lemma sup_assoc (a b c : α) : a ⊔ b ⊔ c = a ⊔ (b ⊔ c) := by { dsimp only [(⊔)], ring }
lemma inf_assoc (a b c : α) : a ⊓ b ⊓ c = a ⊓ (b ⊓ c) := by { dsimp only [(⊓)], ring }

lemma sup_inf_self (a b : α) : a ⊔ a ⊓ b = a :=
by { dsimp only [(⊔), (⊓)], assoc_rw [mul_self, add_self, add_zero] }
lemma inf_sup_self (a b : α) : a ⊓ (a ⊔ b) = a :=
by { dsimp only [(⊔), (⊓)], assoc_rw [mul_add, mul_add, mul_self, mul_self, add_self, add_zero] }

lemma le_sup_inf (a b c : α) : (a ⊔ b) ⊓ (a ⊔ c) ⊔ (a ⊔ b ⊓ c) = a ⊔ b ⊓ c :=
by { dsimp only [(⊔), (⊓)], rw [le_sup_inf_aux, add_self, mul_self, zero_add] }

/--
The Boolean algebra structure on a Boolean ring.

The data is defined so that:
* `a ⊔ b` unfolds to `a + b + a * b`
* `a ⊓ b` unfolds to `a * b`
* `a ≤ b` unfolds to `a + b + a * b = b`
* `⊥` unfolds to `0`
* `⊤` unfolds to `1`
* `aᶜ` unfolds to `1 + a`
* `a \ b` unfolds to `a * (1 + b)`
-/
def to_boolean_algebra : boolean_algebra α :=
boolean_algebra.of_core
{ le_sup_inf := le_sup_inf,
  top := 1,
  le_top := λ a, show a + 1 + a * 1 = 1, by assoc_rw [mul_one, add_comm, add_self, add_zero],
  bot := 0,
  bot_le := λ a, show 0 + a + 0 * a = a, by rw [zero_mul, zero_add, add_zero],
  compl := λ a, 1 + a,
  inf_compl_le_bot := λ a,
    show a*(1+a) + 0 + a*(1+a)*0 = 0,
    by norm_num [mul_add, mul_self, add_self],
  top_le_sup_compl := λ a,
    begin
      change 1 + (a + (1+a) + a*(1+a)) + 1*(a + (1+a) + a*(1+a)) = a + (1+a) + a*(1+a),
      norm_num [mul_add, mul_self],
      rw [←add_assoc, add_self],
    end,
  .. lattice.mk' sup_comm sup_assoc inf_comm inf_assoc sup_inf_self inf_sup_self }

localized "attribute [instance, priority 100] boolean_ring.to_boolean_algebra" in
  boolean_algebra_of_boolean_ring

end boolean_ring

variables [boolean_ring α] [boolean_ring β] [boolean_ring γ]

instance : boolean_algebra (as_boolalg α) := @boolean_ring.to_boolean_algebra α _

@[simp] lemma of_boolalg_top : of_boolalg (⊤ : as_boolalg α) = 1 := rfl
@[simp] lemma of_boolalg_bot : of_boolalg (⊥ : as_boolalg α) = 0 := rfl

@[simp] lemma of_boolalg_sup (a b : as_boolalg α) :
  of_boolalg (a ⊔ b) = of_boolalg a + of_boolalg b + of_boolalg a * of_boolalg b := rfl

@[simp] lemma of_boolalg_inf (a b : as_boolalg α) :
  of_boolalg (a ⊓ b) = of_boolalg a * of_boolalg b := rfl

@[simp] lemma to_boolalg_zero : to_boolalg (0 : α) = ⊥ := rfl
@[simp] lemma to_boolalg_one : to_boolalg (1 : α) = ⊤ := rfl

@[simp] lemma to_boolalg_mul (a b : α) :
  to_boolalg (a * b) = to_boolalg a ⊓ to_boolalg b := rfl

@[simp] lemma to_boolalg_add_add_mul (a b : α) :
  to_boolalg (a + b + a * b) = to_boolalg a ⊔ to_boolalg b := rfl

/-- Turn a ring homomorphism from Boolean rings `α` to `β` into a bounded lattice homomorphism
from `α` to `β` considered as Boolean algebras. -/
@[simps] protected def ring_hom.as_boolalg (f : α →+* β) :
  bounded_lattice_hom (as_boolalg α) (as_boolalg β) :=
{ to_fun := to_boolalg ∘ f ∘ of_boolalg,
  map_sup' := λ a b, begin
    dsimp,
    simp_rw [map_add f, map_mul f],
    refl,
  end,
  map_inf' := f.map_mul',
  map_top' := f.map_one',
  map_bot' := f.map_zero' }

@[simp] lemma ring_hom.as_boolalg_id : (ring_hom.id α).as_boolalg = bounded_lattice_hom.id _ := rfl

@[simp] lemma ring_hom.as_boolalg_comp (g : β →+* γ) (f : α →+* β) :
  (g.comp f).as_boolalg = g.as_boolalg.comp f.as_boolalg := rfl


import data.real.basic
import algebra.pi_instances
import tuto_lib

notation `|`x`|` := abs x

/-
In this file we manipulate the elementary definition of limits of
sequences of real numbers.
mathlib has a much more general definition of limits, but here
we want to practice using the logical operators and relations
covered in the previous files.

A sequence u is a function from ℕ to ℝ, hence Lean says
u : ℕ → ℝ
The definition we'll be using is:

-- Definition of « u tends to l »
def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

Note the use of `∀ ε > 0, ...` which is an abbreviation of
`∀ ε, ε > 0 → ... `

In particular, a statement like `h : ∀ ε > 0, ...`
can be specialized to a given ε₀ by
  `specialize h ε₀ hε₀`
where hε₀ is a proof of ε₀ > 0.

Also recall that, wherever Lean expects some proof term, we can
start a tactic mode proof using the keyword `by` (followed by curly braces
if you need more than one tactic invocation).
For instance, if the local context contains:

δ : ℝ
δ_pos : δ > 0
h : ∀ ε > 0, ...

then we can specialize h to the real number δ/2 using:
  `specialize h (δ/2) (by linarith)`
where `by linarith` will provide the proof of `δ/2 > 0` expected by Lean.

We'll take this opportunity to use two new tactics:

`norm_num` will perform numerical normalization on the goal and `norm_num at h`
will do the same in assumption `h`. This will get rid of trivial calculations on numbers,
like replacing |l - l| by zero in the next exercise.

`congr'` will try to prove equalities between applications of functions by recursively
proving the arguments are the same.
For instance, if the goal is `f x + g y = f z + g t` then congr will replace it by
two goals: `x = z` and `y = t`.
You can limit the recursion depth by specifying a natural number after `congr'`.
For instance, in the above example, `congr' 1` will give new goals
`f x = f z` and `g y = g t`, which only inspect arguments of the addition and not deeper.
-/

variables (u v w : ℕ → ℝ) (l l' : ℝ)

-- If u is constant with value l then u tends to l
-- 0033
example : (∀ n, u n = l) → seq_limit u l :=
begin
  -- sorry
  intros h ε ε_pos,
  use 0,
  intros n hn,
  rw h,
  norm_num,
  linarith,
  -- sorry
end

/- When dealing with absolute values, we'll use lemmas:

abs_le (x y : ℝ) : |x| ≤ y ↔ -y ≤ x ∧ x ≤ y

abs_add (x y : ℝ) : |x + y| ≤ |x| + |y|

abs_sub (x y : ℝ) : |x - y| = |y - x|

You should probably write them down on a sheet of paper that you keep at
hand since they are used in many exercises.
-/

-- Assume l > 0. Then u tends to l implies u n ≥ l/2 for large enough n
-- 0034
example (hl : l > 0) : seq_limit u l → ∃ N, ∀ n ≥ N, u n ≥ l/2 :=
begin
  -- sorry
  intro h,
  cases h (l/2) (by linarith) with N hN,
  use N,
  intros n hn,
  specialize hN n hn,
  rw abs_le at hN,
  linarith,
  -- sorry
end

/-
When dealing with max, you can use

ge_max_iff (p q r) : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q

le_max_left p q : p ≤ max p q

le_max_right p q : q ≤ max p q

You should probably add them to the sheet of paper where you wrote
the `abs` lemmas since they are used in many exercises.

Let's see an example.
-/

-- If u tends to l and v tends l' then u+v tends to l+l'
example (hu : seq_limit u l) (hv : seq_limit v l') :
seq_limit (u + v) (l + l') :=
begin
  intros ε ε_pos,
  cases hu (ε/2) (by linarith) with N₁ hN₁,
  cases hv (ε/2) (by linarith) with N₂ hN₂,
  use max N₁ N₂,
  intros n hn,
  cases ge_max_iff.mp hn with hn₁ hn₂,
  have fact₁ : |u n - l| ≤ ε/2,
    from hN₁ n (by linarith),  -- note the use of `from`.
                               -- This is an alias for `exact`,
                               -- but reads nicer in this context
  have fact₂ : |v n - l'| ≤ ε/2,
    from hN₂ n (by linarith),
  calc
  |(u + v) n - (l + l')| = |u n + v n - (l + l')|   : rfl
                     ... = |(u n - l) + (v n - l')| : by congr' 1 ; ring
                     ... ≤ |u n - l| + |v n - l'|   : by apply abs_add
                     ... ≤  ε                       : by linarith,
end

/-
In the above proof, we used `have` to prepare facts for `linarith` consumption in the last line.
Since we have direct proof terms for them, we can feed them directly to `linarith` as in the next proof
of the same statement.
Another variation we introduce is rewriting using `ge_max_iff` and letting `linarith` handle the
conjunction, instead of creating two new assumptions.
-/

example (hu : seq_limit u l) (hv : seq_limit v l') :
seq_limit (u + v) (l + l') :=
begin
  intros ε ε_pos,
  cases hu (ε/2) (by linarith) with N₁ hN₁,
  cases hv (ε/2) (by linarith) with N₂ hN₂,
  use max N₁ N₂,
  intros n hn,
  rw ge_max_iff at hn,
  calc
  |(u + v) n - (l + l')| = |u n + v n - (l + l')|   : rfl
                     ... = |(u n - l) + (v n - l')| : by congr' 1 ; ring
                     ... ≤ |u n - l| + |v n - l'|   : by apply abs_add
                     ... ≤  ε                       : by linarith [hN₁ n (by linarith), hN₂ n (by linarith)],
end

/- Let's do something similar: the squeezing theorem. -/
-- 0035
example (hu : seq_limit u l) (hw : seq_limit w l)
(h : ∀ n, u n ≤ v n)
(h' : ∀ n, v n ≤ w n) : seq_limit v l :=
begin
  -- sorry
  intros ε ε_pos,
  cases hu ε ε_pos with N hN,
  cases hw ε ε_pos with N' hN',
  use max N N',
  intros n hn,
  rw ge_max_iff at hn,
  specialize hN n (by linarith),
  specialize hN' n (by linarith),
  specialize h n,
  specialize h' n,
  rw abs_le at *,
  split,
  -- Here `linarith` can finish, but on paper we would write
  calc -ε ≤ u n - l : by linarith
      ... ≤ v n - l : by linarith,
  calc v n - l ≤ w n - l : by linarith
      ... ≤ ε : by linarith,
  -- sorry

end

/- What about < ε? -/
-- 0036
example (u l) : seq_limit u l ↔
 ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| < ε :=
begin
  -- sorry
  split,
  { intros hyp ε ε_pos,
    cases hyp (ε/2) (by linarith) with N hN,
    use N,
    intros n hn,
    calc |u n - l| ≤ ε/2 : by exact hN n hn
              ...  < ε   : by linarith, },
  { intros hyp ε ε_pos,
    cases hyp ε ε_pos with N hN,
    use N,
    intros n hn,
    specialize hN n hn,
    linarith, },
  -- sorry
end

/- In the next exercise, we'll use

eq_of_abs_sub_le_all (x y : ℝ) : (∀ ε > 0, |x - y| ≤ ε) → x = y
-/

-- A sequence admits at most one limit
-- 0037
example : seq_limit u l → seq_limit u l' → l = l' :=
begin
  -- sorry
  intros hl hl',
  apply eq_of_abs_sub_le_all,
  intros ε ε_pos,
  cases hl (ε/2) (by linarith) with N hN,
  cases hl' (ε/2) (by linarith) with N' hN',
  calc |l - l'| = |(l-u (max N N')) + (u (max N N') -l')| : by ring
  ... ≤ |l - u (max N N')| + |u (max N N') - l'| : by apply abs_add
  ... =  |u (max N N') - l| + |u (max N N') - l'| : by rw abs_sub
  ... ≤ ε : by linarith [hN (max N N') (le_max_left _ _), hN' (max N N') (le_max_right _ _)]
  -- sorry
end

/-
Let's now practice deciphering definitions before proving.
-/

def non_decreasing (u : ℕ → ℝ) := ∀ n m, n ≤ m → u n ≤ u m

def is_seq_sup (M : ℝ) (u : ℕ → ℝ) :=
(∀ n, u n ≤ M) ∧ ∀ ε > 0, ∃ n₀, u n₀ ≥ M - ε

-- 0038
example (M : ℝ) (h : is_seq_sup M u) (h' : non_decreasing u) :
seq_limit u M :=
begin
  -- sorry
  intros ε ε_pos,
  cases h with inf_M sup_M_ep,
  cases sup_M_ep ε ε_pos with n₀ hn₀,
  use n₀,
  intros n hn,
  rw abs_le,
  split; linarith [inf_M n, h' n₀ n hn],
  -- sorry
end


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    f '' (s ∪ t) = (f '' s) ∪ (f '' t)
-- ----------------------------------------------------------------------

import data.set.function

universes u v
variable  α : Type u
variable  β : Type v
variable  f : α → β
variables s t : set α

example : f '' (s ∪ t) = (f '' s) ∪ (f '' t) :=
begin
  ext y,
  split,
  { rintros ⟨x, xs | xt, rfl⟩,
    { left,
      use [x, xs] },
    { right,
      use [x, xt] }},
  { rintros (⟨x, xs, rfl⟩ | ⟨x, xt, rfl⟩),
    { use [x, or.inl xs] },
    { use [x, or.inr xt] }},
end

-- Prueba
-- ======

/-
α : Type u,
β : Type v,
f : α → β,
s t : set α
⊢ f '' (s ∪ t) = f '' s ∪ f '' t
  >> ext y,
y : β
⊢ y ∈ f '' (s ∪ t) ↔ y ∈ f '' s ∪ f '' t
  >> split,
| ⊢ y ∈ f '' (s ∪ t) → y ∈ f '' s ∪ f '' t
|   >> { rintros ⟨x, xs | xt, rfl⟩,
| | ⊢ f x ∈ f '' s ∪ f '' t
| |   >>   { left,
| | ⊢ f x ∈ f '' s
| |   >>     use [x, xs] },
| ⊢ f x ∈ f '' s ∪ f '' t
|   >>   { right,
| ⊢ f x ∈ f '' t
|   >>     use [x, xt] }},
⊢ y ∈ f '' s ∪ f '' t → y ∈ f '' (s ∪ t)
  >> { rintros (⟨x, xs, rfl⟩ | ⟨x, xt, rfl⟩),
| x : α,
| xs : x ∈ s
| ⊢ f x ∈ f '' (s ∪ t)
|   >>   { use [x, or.inl xs] },
xt : x ∈ t
⊢ f x ∈ f '' (s ∪ t)
  >>   { use [x, or.inr xt] }},
no goals
-/


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes

! This file was ported from Lean 3 source module data.rat.denumerable
! leanprover-community/mathlib commit dde670c9a3f503647fd5bfdf1037bad526d3397a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.SetTheory.Cardinal.Basic

/-!
# Denumerability of ℚ

This file proves that ℚ is infinite, denumerable, and deduces that it has cardinality `omega`.
-/

namespace Rat

open Denumerable

instance : Infinite ℚ :=
  Infinite.of_injective ((↑) : ℕ → ℚ) Nat.cast_injective

private def denumerable_aux : ℚ ≃ { x : ℤ × ℕ // 0 < x.2 ∧ x.1.natAbs.coprime x.2 }
    where
  toFun x := ⟨⟨x.1, x.2⟩, Nat.pos_of_ne_zero x.3, x.4⟩
  invFun x := ⟨x.1.1, x.1.2, ne_zero_of_lt x.2.1, x.2.2⟩
  left_inv := fun ⟨_, _, _, _⟩ => rfl
  right_inv := fun ⟨⟨_, _⟩, _, _⟩ => rfl

/-- **Denumerability of the Rational Numbers** -/
instance : Denumerable ℚ := by
  let T := { x : ℤ × ℕ // 0 < x.2 ∧ x.1.natAbs.coprime x.2 }
  letI : Infinite T := Infinite.of_injective _ denumerable_aux.injective
  letI : Encodable T := Encodable.Subtype.encodable
  letI : Denumerable T := ofEncodableOfInfinite T
  exact Denumerable.ofEquiv T denumerable_aux

end Rat

open Cardinal

theorem Cardinal.mkRat : (#ℚ) = ℵ₀ := by simp only [mk_eq_aleph0]
#align cardinal.mk_rat Cardinal.mkRat


/-
Copyright (c) 2021 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel

! This file was ported from Lean 3 source module measure_theory.function.ae_measurable_order
! leanprover-community/mathlib commit 951bf1d9e98a2042979ced62c0620bcfb3587cf8
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Constructions.BorelSpace

/-!
# Measurability criterion for ennreal-valued functions

Consider a function `f : α → ℝ≥0∞`. If the level sets `{f < p}` and `{q < f}` have measurable
supersets which are disjoint up to measure zero when `p` and `q` are finite numbers satisfying
`p < q`, then `f` is almost-everywhere measurable. This is proved in
`ennreal.ae_measurable_of_exist_almost_disjoint_supersets`, and deduced from an analogous statement
for any target space which is a complete linear dense order, called
`measure_theory.ae_measurable_of_exist_almost_disjoint_supersets`.

Note that it should be enough to assume that the space is a conditionally complete linear order,
but the proof would be more painful. Since our only use for now is for `ℝ≥0∞`, we keep it as simple
as possible.
-/

open MeasureTheory Set TopologicalSpace

open Classical ENNReal NNReal

/-- If a function `f : α → β` is such that the level sets `{f < p}` and `{q < f}` have measurable
supersets which are disjoint up to measure zero when `p < q`, then `f` is almost-everywhere
measurable. It is even enough to have this for `p` and `q` in a countable dense set. -/
theorem MeasureTheory.aeMeasurableOfExistAlmostDisjointSupersets {α : Type _}
    {m : MeasurableSpace α} (μ : Measure α) {β : Type _} [CompleteLinearOrder β] [DenselyOrdered β]
    [TopologicalSpace β] [OrderTopology β] [SecondCountableTopology β] [MeasurableSpace β]
    [BorelSpace β] (s : Set β) (s_count : s.Countable) (s_dense : Dense s) (f : α → β)
    (h :
      ∀ p ∈ s,
        ∀ q ∈ s,
          p < q →
            ∃ u v,
              MeasurableSet u ∧
                MeasurableSet v ∧ { x | f x < p } ⊆ u ∧ { x | q < f x } ⊆ v ∧ μ (u ∩ v) = 0) :
    AeMeasurable f μ := by
  haveI : Encodable s := s_count.to_encodable
  have h' :
    ∀ p q,
      ∃ u v,
        MeasurableSet u ∧
          MeasurableSet v ∧
            { x | f x < p } ⊆ u ∧ { x | q < f x } ⊆ v ∧ (p ∈ s → q ∈ s → p < q → μ (u ∩ v) = 0) :=
    by
    intro p q
    by_cases H : p ∈ s ∧ q ∈ s ∧ p < q
    · rcases h p H.1 q H.2.1 H.2.2 with ⟨u, v, hu, hv, h'u, h'v, hμ⟩
      exact ⟨u, v, hu, hv, h'u, h'v, fun ps qs pq => hμ⟩
    · refine'
        ⟨univ, univ, MeasurableSet.univ, MeasurableSet.univ, subset_univ _, subset_univ _,
          fun ps qs pq => _⟩
      simp only [not_and] at H
      exact (H ps qs pq).elim
  choose! u v huv using h'
  let u' : β → Set α := fun p => ⋂ q ∈ s ∩ Ioi p, u p q
  have u'_meas : ∀ i, MeasurableSet (u' i) := by
    intro i
    exact MeasurableSet.binterᵢ (s_count.mono (inter_subset_left _ _)) fun b hb => (huv i b).1
  let f' : α → β := fun x => ⨅ i : s, piecewise (u' i) (fun x => (i : β)) (fun x => (⊤ : β)) x
  have f'_meas : Measurable f' := by
    apply measurable_infᵢ
    exact fun i => Measurable.piecewise (u'_meas i) measurable_const measurable_const
  let t := ⋃ (p : s) (q : s ∩ Ioi p), u' p ∩ v p q
  have μt : μ t ≤ 0 :=
    calc
      μ t ≤ ∑' (p : s) (q : s ∩ Ioi p), μ (u' p ∩ v p q) :=
        by
        refine' (measure_Union_le _).trans _
        apply ENNReal.tsum_le_tsum fun p => _
        apply measure_Union_le _
        exact (s_count.mono (inter_subset_left _ _)).to_subtype
      _ ≤ ∑' (p : s) (q : s ∩ Ioi p), μ (u p q ∩ v p q) :=
        by
        apply ENNReal.tsum_le_tsum fun p => _
        refine' ENNReal.tsum_le_tsum fun q => measure_mono _
        exact inter_subset_inter_left _ (bInter_subset_of_mem q.2)
      _ = ∑' (p : s) (q : s ∩ Ioi p), (0 : ℝ≥0∞) :=
        by
        congr
        ext1 p
        congr
        ext1 q
        exact (huv p q).2.2.2.2 p.2 q.2.1 q.2.2
      _ = 0 := by simp only [tsum_zero]

  have ff' : ∀ᵐ x ∂μ, f x = f' x :=
    by
    have : ∀ᵐ x ∂μ, x ∉ t := by
      have : μ t = 0 := le_antisymm μt bot_le
      change μ _ = 0
      convert this
      ext y
      simp only [not_exists, exists_prop, mem_set_of_eq, mem_compl_iff, not_not_mem]
    filter_upwards [this]with x hx
    apply (infᵢ_eq_of_forall_ge_of_forall_gt_exists_lt _ _).symm
    · intro i
      by_cases H : x ∈ u' i
      swap
      · simp only [H, le_top, not_false_iff, piecewise_eq_of_not_mem]
      simp only [H, piecewise_eq_of_mem]
      contrapose! hx
      obtain ⟨r, ⟨xr, rq⟩, rs⟩ : ∃ r, r ∈ Ioo (i : β) (f x) ∩ s :=
        dense_iff_inter_open.1 s_dense (Ioo i (f x)) isOpen_Ioo (nonempty_Ioo.2 hx)
      have A : x ∈ v i r := (huv i r).2.2.2.1 rq
      apply mem_Union.2 ⟨i, _⟩
      refine' mem_Union.2 ⟨⟨r, ⟨rs, xr⟩⟩, _⟩
      exact ⟨H, A⟩
    · intro q hq
      obtain ⟨r, ⟨xr, rq⟩, rs⟩ : ∃ r, r ∈ Ioo (f x) q ∩ s :=
        dense_iff_inter_open.1 s_dense (Ioo (f x) q) isOpen_Ioo (nonempty_Ioo.2 hq)
      refine' ⟨⟨r, rs⟩, _⟩
      have A : x ∈ u' r := mem_bInter fun i hi => (huv r i).2.2.1 xr
      simp only [A, rq, piecewise_eq_of_mem, Subtype.coe_mk]
  exact ⟨f', f'_meas, ff'⟩
#align measure_theory.ae_measurable_of_exist_almost_disjoint_supersets MeasureTheory.aeMeasurableOfExistAlmostDisjointSupersets

/-- If a function `f : α → ℝ≥0∞` is such that the level sets `{f < p}` and `{q < f}` have measurable
supersets which are disjoint up to measure zero when `p` and `q` are finite numbers satisfying
`p < q`, then `f` is almost-everywhere measurable. -/
theorem ENNReal.aeMeasurableOfExistAlmostDisjointSupersets {α : Type _} {m : MeasurableSpace α}
    (μ : Measure α) (f : α → ℝ≥0∞)
    (h :
      ∀ (p : ℝ≥0) (q : ℝ≥0),
        p < q →
          ∃ u v,
            MeasurableSet u ∧
              MeasurableSet v ∧
                { x | f x < p } ⊆ u ∧ { x | (q : ℝ≥0∞) < f x } ⊆ v ∧ μ (u ∩ v) = 0) :
    AeMeasurable f μ :=
  by
  obtain ⟨s, s_count, s_dense, s_zero, s_top⟩ :
    ∃ s : Set ℝ≥0∞, s.Countable ∧ Dense s ∧ 0 ∉ s ∧ ∞ ∉ s :=
    ENNReal.exists_countable_dense_no_zero_top
  have I : ∀ x ∈ s, x ≠ ∞ := fun x xs hx => s_top (hx ▸ xs)
  apply MeasureTheory.aeMeasurableOfExistAlmostDisjointSupersets μ s s_count s_dense _
  rintro p hp q hq hpq
  lift p to ℝ≥0 using I p hp
  lift q to ℝ≥0 using I q hq
  exact h p q (ENNReal.coe_lt_coe.1 hpq)
#align ennreal.ae_measurable_of_exist_almost_disjoint_supersets ENNReal.aeMeasurableOfExistAlmostDisjointSupersets


import ring_theory.polynomial.basic

namespace polynomial
open_locale polynomial big_operators

open submodule

noncomputable def degree_le' (R : Type*) [semiring R] (n : with_bot ℕ) : submodule R R[X] :=
⨅ k : ℕ, ⨅ h : n < ↑k, (lcoeff R k).ker

theorem mem_degree_le'  {R : Type*} [semiring R] {n : with_bot ℕ} {f : R[X]} :
  f ∈ degree_le' R n ↔ degree f ≤ n :=
by simp only [ degree_le', submodule.mem_infi, degree_le_iff_coeff_zero, linear_map.mem_ker]; refl

namespace degree_le

lemma bot_eq (R : Type*) [semiring R] : degree_le R ⊥ = degree_lt R 0 :=
by simp_rw [degree_le, degree_lt, ge_iff_le, gt_iff_lt, with_bot.bot_lt_coe, zero_le']

lemma nat_eq (R : Type*) [semiring R] (n : ℕ) : degree_le R n = degree_lt R (n + 1) :=
by simp_rw [degree_le, degree_lt, ge_iff_le, gt_iff_lt, with_bot.coe_lt_coe]; refl

end degree_le

namespace degree_lt

noncomputable def to_tuple {R : Type*} [comm_ring R] {n : ℕ} (p : degree_lt R n) :
fin n → R := degree_lt_equiv _ _ p

lemma to_tuple_eq {R : Type*} [comm_ring R] {n : ℕ} (p : degree_lt R n) :
to_tuple p = (degree_lt_equiv _ _) p := rfl

lemma to_tuple_apply {R : Type*} [comm_ring R] {n : ℕ} (p : degree_lt R n) (i : fin n) :
to_tuple p i = (p : R[X]).coeff i := rfl

theorem to_tuple_eq_zero_iff {R : Type*} [comm_ring R] {n : ℕ} (p : degree_lt R n) :
to_tuple p = 0 ↔ p = 0 := by rw [to_tuple_eq, linear_equiv.map_eq_zero_iff]

theorem to_tuple_eq_iff {R : Type*} [comm_ring R] {n : ℕ} (p q : degree_lt R n) :
to_tuple p = to_tuple q ↔ p = q :=
by {  simp_rw [to_tuple_eq, (linear_equiv.injective _).eq_iff] }

theorem to_tuple_equiv_eval {R : Type*} [comm_ring R] {n : ℕ} (p : degree_lt R n) (x : R) :
∑ i, to_tuple p i * (x ^ (i : ℕ)) = (p : R[X]).eval x :=
begin
  simp_rw [to_tuple_apply, eval_eq_sum],
  exact sum_fin (λ e a, a * x ^ e) (λ i, zero_mul (x ^ i)) (mem_degree_lt.mp (coe_mem _))
end

theorem to_tuple_root {R : Type*} [comm_ring R] {n : ℕ} (p : degree_lt R n) (x : R) :
(p : R[X]).is_root x ↔ ∑ i, to_tuple p i * (x ^ (i : ℕ)) = 0
:= by rw [is_root.def, to_tuple_equiv_eval]

/-
theorem degree_lt_rank {F : Type*} [field F] {t : ℕ} : module.rank F (degree_lt F t) = t := by {rw (degree_lt_equiv' F t).dim_eq, exact dim_fin_fun _}

theorem degree_lt_finrank {F : Type*} [field F] {t : ℕ} : finite_dimensional.finrank F (degree_lt F t) = t := finite_dimensional.finrank_eq_of_dim_eq degree_lt_rank
-/

end degree_lt

end polynomial


import data.set.finite

namespace hidden

open_locale classical

lemma foo
  (s : set ℕ)
  (hs : s.finite)
  (hsn : s.nonempty)
  : ∃ k, ∀ n ∈ s, n ≤ k :=
begin
  use hs.to_finset.max' (by simpa),
  intros n hn,
  rw ←@set.finite.mem_to_finset _ _ hs at hn,
  exact finset.le_max' _ _ hn,
end

noncomputable
def max (s : set ℕ) (hs : s.finite) :=
if hsn : s.nonempty then
  nat.find $ foo s hs hsn
else
  0

lemma max_spec
  (s : set ℕ)
  (hs : s.finite)
  (n : ℕ)
  (hn : n ∈ s)
  : n ≤ max s hs :=
begin
  by_cases hsn : s.nonempty,
  { unfold max,
    rw dif_pos hsn,
    exact nat.find_spec (foo s hs hsn) _ hn },
  { rw set.not_nonempty_iff_eq_empty at hsn,
    rw hsn at hn,
    cases hn }
end

end hidden


/-
Copyright (c) 2021 Patrick Stevens. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Stevens, Thomas Browning
-/

import data.nat.choose.basic
import tactic.norm_num
import tactic.linarith

/-!
# Central binomial coefficients

This file proves properties of the central binomial coefficients (that is, `nat.choose (2 * n) n`).

## Main definition and results

* `nat.central_binom`: the central binomial coefficient, `(2 * n).choose n`.
* `nat.succ_mul_central_binom_succ`: the inductive relationship between successive central binomial
  coefficients.
* `nat.four_pow_lt_mul_central_binom`: an exponential lower bound on the central binomial
  coefficient.
-/

namespace nat

/--
The central binomial coefficient, `nat.choose (2 * n) n`.
-/
def central_binom (n : ℕ) := (2 * n).choose n

lemma central_binom_eq_two_mul_choose (n : ℕ) : central_binom n = (2 * n).choose n := rfl

lemma central_binom_pos (n : ℕ) : 0 < central_binom n :=
choose_pos (nat.le_mul_of_pos_left zero_lt_two)

lemma central_binom_ne_zero (n : ℕ) : central_binom n ≠ 0 :=
(central_binom_pos n).ne'

@[simp] lemma central_binom_zero : central_binom 0 = 1 :=
choose_zero_right _

/--
The central binomial coefficient is the largest binomial coefficient.
-/
lemma choose_le_central_binom (r n : ℕ) : choose (2 * n) r ≤ central_binom n :=
calc (2 * n).choose r ≤ (2 * n).choose (2 * n / 2) : choose_le_middle r (2 * n)
... = (2 * n).choose n : by rw nat.mul_div_cancel_left n zero_lt_two

lemma two_le_central_binom (n : ℕ) (n_pos : 0 < n) : 2 ≤ central_binom n :=
calc 2 ≤ 2 * n : le_mul_of_pos_right n_pos
... = (2 * n).choose 1 : (choose_one_right (2 * n)).symm
... ≤ central_binom n : choose_le_central_binom 1 n

/--
An inductive property of the central binomial coefficient.
-/
lemma succ_mul_central_binom_succ (n : ℕ) :
  (n + 1) * central_binom (n + 1) = 2 * (2 * n + 1) * central_binom n :=
calc (n + 1) * (2 * (n + 1)).choose (n + 1) = (2 * n + 2).choose (n + 1) * (n + 1) : mul_comm _ _
... = (2 * n + 1).choose n * (2 * n + 2) : by rw [choose_succ_right_eq, choose_mul_succ_eq]
... = 2 * ((2 * n + 1).choose n * (n + 1)) : by ring
... = 2 * ((2 * n + 1).choose n * ((2 * n + 1) - n)) :
  by rw [two_mul n, add_assoc, nat.add_sub_cancel_left]
... = 2 * ((2 * n).choose n * (2 * n + 1)) : by rw choose_mul_succ_eq
... = (2 * (2 * n + 1)) * (2 * n).choose n : by rw [mul_assoc, mul_comm (2 * n + 1)]

/--
An exponential lower bound on the central binomial coefficient.
This bound is of interest because it appears in
[Tochiori's refinement of Erdős's proof of Bertrand's postulate](https://en.wikipedia.org/w/index.php?title=Proof_of_Bertrand%27s_postulate&oldid=859165151#Proof_by_Shigenori_Tochiori).
-/
lemma four_pow_lt_mul_central_binom (n : ℕ) (n_big : 4 ≤ n) : 4 ^ n < n * central_binom n :=
begin
  induction n using nat.strong_induction_on with n IH,
  rcases lt_trichotomy n 4 with (hn|rfl|hn),
  { clear IH, dec_trivial! },
  { norm_num [central_binom, choose] },
  obtain ⟨n, rfl⟩ : ∃ m, n = m + 1 := nat.exists_eq_succ_of_ne_zero (zero_lt_four.trans hn).ne',
  calc 4 ^ (n + 1) < 4 * (n * central_binom n) :
      (mul_lt_mul_left zero_lt_four).mpr (IH n n.lt_succ_self (nat.le_of_lt_succ hn))
  ... ≤ 2 * (2 * n + 1) * central_binom n : by { rw ← mul_assoc, linarith }
  ... = (n + 1) * central_binom (n + 1) : (succ_mul_central_binom_succ n).symm,
end

/--
An exponential lower bound on the central binomial coefficient.
This bound is weaker than `four_pow_n_lt_n_mul_central_binom`, but it is of historical interest
because it appears in Erdős's proof of Bertrand's postulate.
-/
lemma four_pow_le_two_mul_self_mul_central_binom : ∀ (n : ℕ) (n_pos : 0 < n),
  4 ^ n ≤ (2 * n) * central_binom n
| 0 pr := (nat.not_lt_zero _ pr).elim
| 1 pr := by norm_num [central_binom, choose]
| 2 pr := by norm_num [central_binom, choose]
| 3 pr := by norm_num [central_binom, choose]
| n@(m + 4) _ :=
calc 4 ^ n ≤ n * central_binom n : (four_pow_lt_mul_central_binom _ le_add_self).le
... ≤ 2 * n * central_binom n    : by { rw [mul_assoc], refine le_mul_of_pos_left zero_lt_two }

end nat


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers, Manuel Candales

! This file was ported from Lean 3 source module geometry.euclidean.angle.unoriented.basic
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.InnerProductSpace.Basic
import Mathbin.Analysis.SpecialFunctions.Trigonometric.Inverse

/-!
# Angles between vectors

This file defines unoriented angles in real inner product spaces.

## Main definitions

* `inner_product_geometry.angle` is the undirected angle between two vectors.

-/

assert_not_exists has_fderiv_at

assert_not_exists conformal_at

noncomputable section

open Real Set

open BigOperators

open Real

open RealInnerProductSpace

namespace InnerProductGeometry

variable {V : Type _} [NormedAddCommGroup V] [InnerProductSpace ℝ V] {x y : V}

/-- The undirected angle between two vectors. If either vector is 0,
this is π/2. See `orientation.oangle` for the corresponding oriented angle
definition. -/
def angle (x y : V) : ℝ :=
  Real.arccos (⟪x, y⟫ / (‖x‖ * ‖y‖))
#align inner_product_geometry.angle InnerProductGeometry.angle

theorem continuousAt_angle {x : V × V} (hx1 : x.1 ≠ 0) (hx2 : x.2 ≠ 0) :
    ContinuousAt (fun y : V × V => angle y.1 y.2) x :=
  Real.continuous_arccos.ContinuousAt.comp <|
    continuous_inner.ContinuousAt.div
      ((continuous_norm.comp continuous_fst).mul (continuous_norm.comp continuous_snd)).ContinuousAt
      (by simp [hx1, hx2])
#align inner_product_geometry.continuous_at_angle InnerProductGeometry.continuousAt_angle

theorem angle_smul_smul {c : ℝ} (hc : c ≠ 0) (x y : V) : angle (c • x) (c • y) = angle x y :=
  by
  have : c * c ≠ 0 := mul_ne_zero hc hc
  rw [angle, angle, real_inner_smul_left, inner_smul_right, norm_smul, norm_smul, Real.norm_eq_abs,
    mul_mul_mul_comm _ ‖x‖, abs_mul_abs_self, ← mul_assoc c c, mul_div_mul_left _ _ this]
#align inner_product_geometry.angle_smul_smul InnerProductGeometry.angle_smul_smul

@[simp]
theorem LinearIsometry.angle_map {E F : Type _} [NormedAddCommGroup E] [NormedAddCommGroup F]
    [InnerProductSpace ℝ E] [InnerProductSpace ℝ F] (f : E →ₗᵢ[ℝ] F) (u v : E) :
    angle (f u) (f v) = angle u v := by rw [angle, angle, f.inner_map_map, f.norm_map, f.norm_map]
#align linear_isometry.angle_map LinearIsometry.angle_map

@[simp, norm_cast]
theorem Submodule.angle_coe {s : Submodule ℝ V} (x y : s) : angle (x : V) (y : V) = angle x y :=
  s.subtypeₗᵢ.angle_map x y
#align submodule.angle_coe Submodule.angle_coe

/-- The cosine of the angle between two vectors. -/
theorem cos_angle (x y : V) : Real.cos (angle x y) = ⟪x, y⟫ / (‖x‖ * ‖y‖) :=
  Real.cos_arccos (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).1
    (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).2
#align inner_product_geometry.cos_angle InnerProductGeometry.cos_angle

/-- The angle between two vectors does not depend on their order. -/
theorem angle_comm (x y : V) : angle x y = angle y x :=
  by
  unfold angle
  rw [real_inner_comm, mul_comm]
#align inner_product_geometry.angle_comm InnerProductGeometry.angle_comm

/-- The angle between the negation of two vectors. -/
@[simp]
theorem angle_neg_neg (x y : V) : angle (-x) (-y) = angle x y :=
  by
  unfold angle
  rw [inner_neg_neg, norm_neg, norm_neg]
#align inner_product_geometry.angle_neg_neg InnerProductGeometry.angle_neg_neg

/-- The angle between two vectors is nonnegative. -/
theorem angle_nonneg (x y : V) : 0 ≤ angle x y :=
  Real.arccos_nonneg _
#align inner_product_geometry.angle_nonneg InnerProductGeometry.angle_nonneg

/-- The angle between two vectors is at most π. -/
theorem angle_le_pi (x y : V) : angle x y ≤ π :=
  Real.arccos_le_pi _
#align inner_product_geometry.angle_le_pi InnerProductGeometry.angle_le_pi

/-- The angle between a vector and the negation of another vector. -/
theorem angle_neg_right (x y : V) : angle x (-y) = π - angle x y :=
  by
  unfold angle
  rw [← Real.arccos_neg, norm_neg, inner_neg_right, neg_div]
#align inner_product_geometry.angle_neg_right InnerProductGeometry.angle_neg_right

/-- The angle between the negation of a vector and another vector. -/
theorem angle_neg_left (x y : V) : angle (-x) y = π - angle x y := by
  rw [← angle_neg_neg, neg_neg, angle_neg_right]
#align inner_product_geometry.angle_neg_left InnerProductGeometry.angle_neg_left

/-- The angle between the zero vector and a vector. -/
@[simp]
theorem angle_zero_left (x : V) : angle 0 x = π / 2 :=
  by
  unfold angle
  rw [inner_zero_left, zero_div, Real.arccos_zero]
#align inner_product_geometry.angle_zero_left InnerProductGeometry.angle_zero_left

/-- The angle between a vector and the zero vector. -/
@[simp]
theorem angle_zero_right (x : V) : angle x 0 = π / 2 :=
  by
  unfold angle
  rw [inner_zero_right, zero_div, Real.arccos_zero]
#align inner_product_geometry.angle_zero_right InnerProductGeometry.angle_zero_right

/-- The angle between a nonzero vector and itself. -/
@[simp]
theorem angle_self {x : V} (hx : x ≠ 0) : angle x x = 0 :=
  by
  unfold angle
  rw [← real_inner_self_eq_norm_mul_norm, div_self (inner_self_ne_zero.2 hx : ⟪x, x⟫ ≠ 0),
    Real.arccos_one]
#align inner_product_geometry.angle_self InnerProductGeometry.angle_self

/-- The angle between a nonzero vector and its negation. -/
@[simp]
theorem angle_self_neg_of_nonzero {x : V} (hx : x ≠ 0) : angle x (-x) = π := by
  rw [angle_neg_right, angle_self hx, sub_zero]
#align inner_product_geometry.angle_self_neg_of_nonzero InnerProductGeometry.angle_self_neg_of_nonzero

/-- The angle between the negation of a nonzero vector and that
vector. -/
@[simp]
theorem angle_neg_self_of_nonzero {x : V} (hx : x ≠ 0) : angle (-x) x = π := by
  rw [angle_comm, angle_self_neg_of_nonzero hx]
#align inner_product_geometry.angle_neg_self_of_nonzero InnerProductGeometry.angle_neg_self_of_nonzero

/-- The angle between a vector and a positive multiple of a vector. -/
@[simp]
theorem angle_smul_right_of_pos (x y : V) {r : ℝ} (hr : 0 < r) : angle x (r • y) = angle x y :=
  by
  unfold angle
  rw [inner_smul_right, norm_smul, Real.norm_eq_abs, abs_of_nonneg (le_of_lt hr), ← mul_assoc,
    mul_comm _ r, mul_assoc, mul_div_mul_left _ _ (ne_of_gt hr)]
#align inner_product_geometry.angle_smul_right_of_pos InnerProductGeometry.angle_smul_right_of_pos

/-- The angle between a positive multiple of a vector and a vector. -/
@[simp]
theorem angle_smul_left_of_pos (x y : V) {r : ℝ} (hr : 0 < r) : angle (r • x) y = angle x y := by
  rw [angle_comm, angle_smul_right_of_pos y x hr, angle_comm]
#align inner_product_geometry.angle_smul_left_of_pos InnerProductGeometry.angle_smul_left_of_pos

/-- The angle between a vector and a negative multiple of a vector. -/
@[simp]
theorem angle_smul_right_of_neg (x y : V) {r : ℝ} (hr : r < 0) : angle x (r • y) = angle x (-y) :=
  by
  rw [← neg_neg r, neg_smul, angle_neg_right, angle_smul_right_of_pos x y (neg_pos_of_neg hr),
    angle_neg_right]
#align inner_product_geometry.angle_smul_right_of_neg InnerProductGeometry.angle_smul_right_of_neg

/-- The angle between a negative multiple of a vector and a vector. -/
@[simp]
theorem angle_smul_left_of_neg (x y : V) {r : ℝ} (hr : r < 0) : angle (r • x) y = angle (-x) y := by
  rw [angle_comm, angle_smul_right_of_neg y x hr, angle_comm]
#align inner_product_geometry.angle_smul_left_of_neg InnerProductGeometry.angle_smul_left_of_neg

/-- The cosine of the angle between two vectors, multiplied by the
product of their norms. -/
theorem cos_angle_mul_norm_mul_norm (x y : V) : Real.cos (angle x y) * (‖x‖ * ‖y‖) = ⟪x, y⟫ :=
  by
  rw [cos_angle, div_mul_cancel_of_imp]
  simp (config := { contextual := true }) [or_imp]
#align inner_product_geometry.cos_angle_mul_norm_mul_norm InnerProductGeometry.cos_angle_mul_norm_mul_norm

/-- The sine of the angle between two vectors, multiplied by the
product of their norms. -/
theorem sin_angle_mul_norm_mul_norm (x y : V) :
    Real.sin (angle x y) * (‖x‖ * ‖y‖) = Real.sqrt (⟪x, x⟫ * ⟪y, y⟫ - ⟪x, y⟫ * ⟪x, y⟫) :=
  by
  unfold angle
  rw [Real.sin_arccos, ← Real.sqrt_mul_self (mul_nonneg (norm_nonneg x) (norm_nonneg y)), ←
    Real.sqrt_mul' _ (mul_self_nonneg _), sq,
    Real.sqrt_mul_self (mul_nonneg (norm_nonneg x) (norm_nonneg y)),
    real_inner_self_eq_norm_mul_norm, real_inner_self_eq_norm_mul_norm]
  by_cases h : ‖x‖ * ‖y‖ = 0
  · rw [show ‖x‖ * ‖x‖ * (‖y‖ * ‖y‖) = ‖x‖ * ‖y‖ * (‖x‖ * ‖y‖) by ring, h, MulZeroClass.mul_zero,
      MulZeroClass.mul_zero, zero_sub]
    cases' eq_zero_or_eq_zero_of_mul_eq_zero h with hx hy
    · rw [norm_eq_zero] at hx
      rw [hx, inner_zero_left, MulZeroClass.zero_mul, neg_zero]
    · rw [norm_eq_zero] at hy
      rw [hy, inner_zero_right, MulZeroClass.zero_mul, neg_zero]
  · field_simp [h]
    ring_nf
#align inner_product_geometry.sin_angle_mul_norm_mul_norm InnerProductGeometry.sin_angle_mul_norm_mul_norm

/-- The angle between two vectors is zero if and only if they are
nonzero and one is a positive multiple of the other. -/
theorem angle_eq_zero_iff {x y : V} : angle x y = 0 ↔ x ≠ 0 ∧ ∃ r : ℝ, 0 < r ∧ y = r • x :=
  by
  rw [angle, ← real_inner_div_norm_mul_norm_eq_one_iff, Real.arccos_eq_zero, LE.le.le_iff_eq,
    eq_comm]
  exact (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).2
#align inner_product_geometry.angle_eq_zero_iff InnerProductGeometry.angle_eq_zero_iff

/-- The angle between two vectors is π if and only if they are nonzero
and one is a negative multiple of the other. -/
theorem angle_eq_pi_iff {x y : V} : angle x y = π ↔ x ≠ 0 ∧ ∃ r : ℝ, r < 0 ∧ y = r • x :=
  by
  rw [angle, ← real_inner_div_norm_mul_norm_eq_neg_one_iff, Real.arccos_eq_pi, LE.le.le_iff_eq]
  exact (abs_le.mp (abs_real_inner_div_norm_mul_norm_le_one x y)).1
#align inner_product_geometry.angle_eq_pi_iff InnerProductGeometry.angle_eq_pi_iff

/-- If the angle between two vectors is π, the angles between those
vectors and a third vector add to π. -/
theorem angle_add_angle_eq_pi_of_angle_eq_pi {x y : V} (z : V) (h : angle x y = π) :
    angle x z + angle y z = π :=
  by
  rcases angle_eq_pi_iff.1 h with ⟨hx, ⟨r, ⟨hr, rfl⟩⟩⟩
  rw [angle_smul_left_of_neg x z hr, angle_neg_left, add_sub_cancel'_right]
#align inner_product_geometry.angle_add_angle_eq_pi_of_angle_eq_pi InnerProductGeometry.angle_add_angle_eq_pi_of_angle_eq_pi

/-- Two vectors have inner product 0 if and only if the angle between
them is π/2. -/
theorem inner_eq_zero_iff_angle_eq_pi_div_two (x y : V) : ⟪x, y⟫ = 0 ↔ angle x y = π / 2 :=
  Iff.symm <| by simp (config := { contextual := true }) [angle, or_imp]
#align inner_product_geometry.inner_eq_zero_iff_angle_eq_pi_div_two InnerProductGeometry.inner_eq_zero_iff_angle_eq_pi_div_two

/-- If the angle between two vectors is π, the inner product equals the negative product
of the norms. -/
theorem inner_eq_neg_mul_norm_of_angle_eq_pi {x y : V} (h : angle x y = π) :
    ⟪x, y⟫ = -(‖x‖ * ‖y‖) := by simp [← cos_angle_mul_norm_mul_norm, h]
#align inner_product_geometry.inner_eq_neg_mul_norm_of_angle_eq_pi InnerProductGeometry.inner_eq_neg_mul_norm_of_angle_eq_pi

/-- If the angle between two vectors is 0, the inner product equals the product of the norms. -/
theorem inner_eq_mul_norm_of_angle_eq_zero {x y : V} (h : angle x y = 0) : ⟪x, y⟫ = ‖x‖ * ‖y‖ := by
  simp [← cos_angle_mul_norm_mul_norm, h]
#align inner_product_geometry.inner_eq_mul_norm_of_angle_eq_zero InnerProductGeometry.inner_eq_mul_norm_of_angle_eq_zero

/-- The inner product of two non-zero vectors equals the negative product of their norms
if and only if the angle between the two vectors is π. -/
theorem inner_eq_neg_mul_norm_iff_angle_eq_pi {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
    ⟪x, y⟫ = -(‖x‖ * ‖y‖) ↔ angle x y = π :=
  by
  refine' ⟨fun h => _, inner_eq_neg_mul_norm_of_angle_eq_pi⟩
  have h₁ : ‖x‖ * ‖y‖ ≠ 0 := (mul_pos (norm_pos_iff.mpr hx) (norm_pos_iff.mpr hy)).ne'
  rw [angle, h, neg_div, div_self h₁, Real.arccos_neg_one]
#align inner_product_geometry.inner_eq_neg_mul_norm_iff_angle_eq_pi InnerProductGeometry.inner_eq_neg_mul_norm_iff_angle_eq_pi

/-- The inner product of two non-zero vectors equals the product of their norms
if and only if the angle between the two vectors is 0. -/
theorem inner_eq_mul_norm_iff_angle_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
    ⟪x, y⟫ = ‖x‖ * ‖y‖ ↔ angle x y = 0 :=
  by
  refine' ⟨fun h => _, inner_eq_mul_norm_of_angle_eq_zero⟩
  have h₁ : ‖x‖ * ‖y‖ ≠ 0 := (mul_pos (norm_pos_iff.mpr hx) (norm_pos_iff.mpr hy)).ne'
  rw [angle, h, div_self h₁, Real.arccos_one]
#align inner_product_geometry.inner_eq_mul_norm_iff_angle_eq_zero InnerProductGeometry.inner_eq_mul_norm_iff_angle_eq_zero

/-- If the angle between two vectors is π, the norm of their difference equals
the sum of their norms. -/
theorem norm_sub_eq_add_norm_of_angle_eq_pi {x y : V} (h : angle x y = π) : ‖x - y‖ = ‖x‖ + ‖y‖ :=
  by
  rw [← sq_eq_sq (norm_nonneg (x - y)) (add_nonneg (norm_nonneg x) (norm_nonneg y))]
  rw [norm_sub_pow_two_real, inner_eq_neg_mul_norm_of_angle_eq_pi h]
  ring
#align inner_product_geometry.norm_sub_eq_add_norm_of_angle_eq_pi InnerProductGeometry.norm_sub_eq_add_norm_of_angle_eq_pi

/-- If the angle between two vectors is 0, the norm of their sum equals
the sum of their norms. -/
theorem norm_add_eq_add_norm_of_angle_eq_zero {x y : V} (h : angle x y = 0) : ‖x + y‖ = ‖x‖ + ‖y‖ :=
  by
  rw [← sq_eq_sq (norm_nonneg (x + y)) (add_nonneg (norm_nonneg x) (norm_nonneg y))]
  rw [norm_add_pow_two_real, inner_eq_mul_norm_of_angle_eq_zero h]
  ring
#align inner_product_geometry.norm_add_eq_add_norm_of_angle_eq_zero InnerProductGeometry.norm_add_eq_add_norm_of_angle_eq_zero

/-- If the angle between two vectors is 0, the norm of their difference equals
the absolute value of the difference of their norms. -/
theorem norm_sub_eq_abs_sub_norm_of_angle_eq_zero {x y : V} (h : angle x y = 0) :
    ‖x - y‖ = |‖x‖ - ‖y‖| :=
  by
  rw [← sq_eq_sq (norm_nonneg (x - y)) (abs_nonneg (‖x‖ - ‖y‖)), norm_sub_pow_two_real,
    inner_eq_mul_norm_of_angle_eq_zero h, sq_abs (‖x‖ - ‖y‖)]
  ring
#align inner_product_geometry.norm_sub_eq_abs_sub_norm_of_angle_eq_zero InnerProductGeometry.norm_sub_eq_abs_sub_norm_of_angle_eq_zero

/-- The norm of the difference of two non-zero vectors equals the sum of their norms
if and only the angle between the two vectors is π. -/
theorem norm_sub_eq_add_norm_iff_angle_eq_pi {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
    ‖x - y‖ = ‖x‖ + ‖y‖ ↔ angle x y = π :=
  by
  refine' ⟨fun h => _, norm_sub_eq_add_norm_of_angle_eq_pi⟩
  rw [← inner_eq_neg_mul_norm_iff_angle_eq_pi hx hy]
  obtain ⟨hxy₁, hxy₂⟩ := norm_nonneg (x - y), add_nonneg (norm_nonneg x) (norm_nonneg y)
  rw [← sq_eq_sq hxy₁ hxy₂, norm_sub_pow_two_real] at h
  calc
    ⟪x, y⟫ = (‖x‖ ^ 2 + ‖y‖ ^ 2 - (‖x‖ + ‖y‖) ^ 2) / 2 := by linarith
    _ = -(‖x‖ * ‖y‖) := by ring

#align inner_product_geometry.norm_sub_eq_add_norm_iff_angle_eq_pi InnerProductGeometry.norm_sub_eq_add_norm_iff_angle_eq_pi

/-- The norm of the sum of two non-zero vectors equals the sum of their norms
if and only the angle between the two vectors is 0. -/
theorem norm_add_eq_add_norm_iff_angle_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
    ‖x + y‖ = ‖x‖ + ‖y‖ ↔ angle x y = 0 :=
  by
  refine' ⟨fun h => _, norm_add_eq_add_norm_of_angle_eq_zero⟩
  rw [← inner_eq_mul_norm_iff_angle_eq_zero hx hy]
  obtain ⟨hxy₁, hxy₂⟩ := norm_nonneg (x + y), add_nonneg (norm_nonneg x) (norm_nonneg y)
  rw [← sq_eq_sq hxy₁ hxy₂, norm_add_pow_two_real] at h
  calc
    ⟪x, y⟫ = ((‖x‖ + ‖y‖) ^ 2 - ‖x‖ ^ 2 - ‖y‖ ^ 2) / 2 := by linarith
    _ = ‖x‖ * ‖y‖ := by ring

#align inner_product_geometry.norm_add_eq_add_norm_iff_angle_eq_zero InnerProductGeometry.norm_add_eq_add_norm_iff_angle_eq_zero

/-- The norm of the difference of two non-zero vectors equals the absolute value
of the difference of their norms if and only the angle between the two vectors is 0. -/
theorem norm_sub_eq_abs_sub_norm_iff_angle_eq_zero {x y : V} (hx : x ≠ 0) (hy : y ≠ 0) :
    ‖x - y‖ = |‖x‖ - ‖y‖| ↔ angle x y = 0 :=
  by
  refine' ⟨fun h => _, norm_sub_eq_abs_sub_norm_of_angle_eq_zero⟩
  rw [← inner_eq_mul_norm_iff_angle_eq_zero hx hy]
  have h1 : ‖x - y‖ ^ 2 = (‖x‖ - ‖y‖) ^ 2 := by
    rw [h]
    exact sq_abs (‖x‖ - ‖y‖)
  rw [norm_sub_pow_two_real] at h1
  calc
    ⟪x, y⟫ = ((‖x‖ + ‖y‖) ^ 2 - ‖x‖ ^ 2 - ‖y‖ ^ 2) / 2 := by linarith
    _ = ‖x‖ * ‖y‖ := by ring

#align inner_product_geometry.norm_sub_eq_abs_sub_norm_iff_angle_eq_zero InnerProductGeometry.norm_sub_eq_abs_sub_norm_iff_angle_eq_zero

/-- The norm of the sum of two vectors equals the norm of their difference if and only if
the angle between them is π/2. -/
theorem norm_add_eq_norm_sub_iff_angle_eq_pi_div_two (x y : V) :
    ‖x + y‖ = ‖x - y‖ ↔ angle x y = π / 2 :=
  by
  rw [← sq_eq_sq (norm_nonneg (x + y)) (norm_nonneg (x - y)), ←
    inner_eq_zero_iff_angle_eq_pi_div_two x y, norm_add_pow_two_real, norm_sub_pow_two_real]
  constructor <;> intro h <;> linarith
#align inner_product_geometry.norm_add_eq_norm_sub_iff_angle_eq_pi_div_two InnerProductGeometry.norm_add_eq_norm_sub_iff_angle_eq_pi_div_two

/-- The cosine of the angle between two vectors is 1 if and only if the angle is 0. -/
theorem cos_eq_one_iff_angle_eq_zero : cos (angle x y) = 1 ↔ angle x y = 0 :=
  by
  rw [← cos_zero]
  exact inj_on_cos.eq_iff ⟨angle_nonneg x y, angle_le_pi x y⟩ (left_mem_Icc.2 pi_pos.le)
#align inner_product_geometry.cos_eq_one_iff_angle_eq_zero InnerProductGeometry.cos_eq_one_iff_angle_eq_zero

/-- The cosine of the angle between two vectors is 0 if and only if the angle is π / 2. -/
theorem cos_eq_zero_iff_angle_eq_pi_div_two : cos (angle x y) = 0 ↔ angle x y = π / 2 :=
  by
  rw [← cos_pi_div_two]
  apply inj_on_cos.eq_iff ⟨angle_nonneg x y, angle_le_pi x y⟩
  constructor <;> linarith [pi_pos]
#align inner_product_geometry.cos_eq_zero_iff_angle_eq_pi_div_two InnerProductGeometry.cos_eq_zero_iff_angle_eq_pi_div_two

/-- The cosine of the angle between two vectors is -1 if and only if the angle is π. -/
theorem cos_eq_neg_one_iff_angle_eq_pi : cos (angle x y) = -1 ↔ angle x y = π :=
  by
  rw [← cos_pi]
  exact inj_on_cos.eq_iff ⟨angle_nonneg x y, angle_le_pi x y⟩ (right_mem_Icc.2 pi_pos.le)
#align inner_product_geometry.cos_eq_neg_one_iff_angle_eq_pi InnerProductGeometry.cos_eq_neg_one_iff_angle_eq_pi

/-- The sine of the angle between two vectors is 0 if and only if the angle is 0 or π. -/
theorem sin_eq_zero_iff_angle_eq_zero_or_angle_eq_pi :
    sin (angle x y) = 0 ↔ angle x y = 0 ∨ angle x y = π := by
  rw [sin_eq_zero_iff_cos_eq, cos_eq_one_iff_angle_eq_zero, cos_eq_neg_one_iff_angle_eq_pi]
#align inner_product_geometry.sin_eq_zero_iff_angle_eq_zero_or_angle_eq_pi InnerProductGeometry.sin_eq_zero_iff_angle_eq_zero_or_angle_eq_pi

/-- The sine of the angle between two vectors is 1 if and only if the angle is π / 2. -/
theorem sin_eq_one_iff_angle_eq_pi_div_two : sin (angle x y) = 1 ↔ angle x y = π / 2 :=
  by
  refine' ⟨fun h => _, fun h => by rw [h, sin_pi_div_two]⟩
  rw [← cos_eq_zero_iff_angle_eq_pi_div_two, ← abs_eq_zero, abs_cos_eq_sqrt_one_sub_sin_sq, h]
  simp
#align inner_product_geometry.sin_eq_one_iff_angle_eq_pi_div_two InnerProductGeometry.sin_eq_one_iff_angle_eq_pi_div_two

end InnerProductGeometry


/-
Copyright (c) 2021 Paula Neeley. All rights reserved.
Author: Paula Neeley
-/

import basicmodal.language basicmodal.syntax.syntax
import basicmodal.semantics.semantics basicmodal.paths
import data.set.basic
local attribute [instance] classical.prop_decidable

open form

---------------------- Frame Definability ----------------------

-- φ defines F (a class of frames)
def defines (φ : form) (F : set (frame)) :=
  ∀ f, f ∈ F ↔ f_valid φ f

---------------------- Definability Proofs ----------------------

variable f : frame
variables {α : Type} (r : α → α → Prop)

def euclidean       := ∀ ⦃x y z⦄, r x y → r x z → r y z
def ref_class       : set (frame) := { f : frame | reflexive (f.rel)   }
def symm_class      : set (frame) := { f : frame | symmetric (f.rel)   }
def trans_class     : set (frame) := { f : frame | transitive (f.rel)  }
def euclid_class    : set (frame) := { f : frame | euclidean (f.rel)   }
def equiv_class     : set (frame) := { f : frame | equivalence (f.rel) }
def ref_trans_class : set (frame) := ref_class ∩ trans_class

lemma equiv_ref_euclid (f : frame) : f ∈ equiv_class ↔ f ∈ (ref_class ∩ euclid_class) :=
begin
split,
intro h1, cases h1 with h1 h2, cases h2 with h2 h3,
split, exact h1,
intros x y z h4 h5, exact h3 (h2 h4) h5,
intro h1, split, cases h1, exact h1_left,
split, cases h1 with h1 h2,
intros x y h3, exact h2 h3 (h1 x),
intros x y z h2 h3, cases h1 with h1 h4,
exact h4 (h4 h2 (h1 x)) h3
end

lemma ref_helper : ∀ φ f, f ∈ ref_class → f_valid ((box φ) ⊃ φ) f :=
begin
intros φ f h v x h1,
apply h1 x, apply h x
end

theorem ref_def : defines ((□ (p 0)) ⊃ (p 0)) (ref_class) :=
begin
intro f,
split,
{exact ref_helper (p 0) f},
{intros h x, let v := λ n y, n = 0 ∧ f.rel x y,
specialize h v x,
simp [forces, v] at h, exact h}
end

lemma symm_helper : ∀ φ f, f ∈ symm_class → f_valid (φ ⊃ (□ (◇φ))) f :=
begin
dsimp, intros φ f h v x h1 y h2 h3,
by_contradiction h4,
exact ((h3 x) (h h2)) h1
end

theorem symm_def : defines ((p 0) ⊃ (□ (◇ (p 0)))) (symm_class) :=
begin
intro f, split,
{exact symm_helper (p 0) f},
{intro h1, by_contradiction h2, rw symm_class at h2,
rw set.nmem_set_of_eq at h2, rw symmetric at h2,
push_neg at h2,
cases h2 with x h2,
cases h2 with y h2,
let v := λ n x, n = 0 ∧ ¬ f.rel y x,
specialize h1 v x,
simp [forces, v] at h1,
apply h1 h2.right y h2.left,
intros y1 h3 h4, exact absurd h3 h4}
end

lemma trans_helper : ∀ φ f, f ∈ trans_class → f_valid (□ φ ⊃ □ (□ φ)) f :=
begin
intros φ f h v x h1 y h3 z h4,
exact (h1 z) ((h h3) h4)
end

lemma euclid_helper : ∀ φ f, f ∈ euclid_class → f_valid (◇ φ ⊃ □ (◇ φ)) f :=
begin
intros φ f h v x h1 y h2 h3,
apply h1, intros z h4,
exact h3 z ((h h2) h4)
end


import game.sup_inf.level01

namespace xena -- hide
-- World name : Sup and Inf

/-
# Chapter 3 : Sup and Inf

## Level 2

-/

/-
The completeness axiom on the reals states that any non-empty subset
$X \subseteq \mathbb{R}$ that is bounded above has a least upper bound.
Here we explore the converse statement: any set of reals that has a supremum is non-empty and
has an upper bound. The second part of the result is trivial, but showing that the
set is non-empty will ask you to use techniques learned in the first world.
-/

-- definition is_upper_bound' (S : set ℝ) (x : ℝ) := x ∈ upper_bounds S
-- (Definition above deprecated? GT)

definition is_lub (S : set ℝ) (x : ℝ) := is_upper_bound S x ∧
∀ y : ℝ, is_upper_bound S y → x ≤ y

definition has_lub (S : set ℝ) := ∃ x, is_lub S x

local attribute [instance] classical.prop_decidable --hide

/- Lemma
Any set of reals that has a supremum is non-empty and bounded above.
-/
theorem nonempty_and_bounded_of_has_LUB (S : set ℝ) (H : has_lub S) :
  (S ≠ ∅) ∧ (∃ x, is_upper_bound S x) :=
begin
  cases H with b Hb,
  -- b is LUB, Hb is proof it's LUB
  split,
  { -- first prove S is not empty, by contradiction as usual with empty sets
    intro Hempty,
    have H1 : (b-1) ∈ upper_bounds S,
    change ∀ x ∈ S, x ≤ (b-1),
    by_contradiction hn,
    push_neg at hn,
    cases hn with x h1,
    cases h1 with h11 h12,
    rw Hempty at h11,
    exact h11,
    unfold is_lub at Hb,
    have HH := Hb.2 (b-1) H1, -- b - 1 is an upper bound
    linarith,
  },
  {
     existsi b,
     exact Hb.1,
  },
  done
end

end xena -- hide


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

import set_theory.ordinal_arithmetic

/-!
### Principal ordinals

We define principal or indecomposable ordinals, and we prove the standard properties about them.

### Main definitions and results
* `principal`: A principal or indecomposable ordinal under some binary operation. We include 0 and
  any other typically excluded edge cases for simplicity.
* `unbounded_principal`: Principal ordinals are unbounded.
* `principal_add_iff_zero_or_omega_opow`: The main characterization theorem for additive principal
  ordinals.
* `principal_mul_iff_le_two_or_omega_opow_opow`: The main characterization theorem for
  multiplicative principal ordinals.

### Todo
* Prove that exponential principal ordinals are 0, 1, 2, ω, or epsilon numbers, i.e. fixed points
  of `λ x, ω ^ x`.
-/

universe u

noncomputable theory

namespace ordinal
local infixr ^ := @pow ordinal ordinal ordinal.has_pow

/-! ### Principal ordinals -/

/-- An ordinal `o` is said to be principal or indecomposable under an operation when the set of
ordinals less than it is closed under that operation. In standard mathematical usage, this term is
almost exclusively used for additive and multiplicative principal ordinals.

For simplicity, we break usual convention and regard 0 as principal. -/
def principal (op : ordinal → ordinal → ordinal) (o : ordinal) : Prop :=
∀ ⦃a b⦄, a < o → b < o → op a b < o

theorem principal_iff_principal_swap {op : ordinal → ordinal → ordinal} {o : ordinal} :
  principal op o ↔ principal (function.swap op) o :=
by split; exact λ h a b ha hb, h hb ha

theorem principal_zero {op : ordinal → ordinal → ordinal} : principal op 0 :=
λ a _ h, (ordinal.not_lt_zero a h).elim

@[simp] theorem principal_one_iff {op : ordinal → ordinal → ordinal} :
  principal op 1 ↔ op 0 0 = 0 :=
begin
  refine ⟨λ h, _, λ h a b ha hb, _⟩,
  { rwa ←lt_one_iff_zero,
    exact h zero_lt_one zero_lt_one },
  { rwa [lt_one_iff_zero, ha, hb] at * }
end

theorem principal.iterate_lt {op : ordinal → ordinal → ordinal} {a o : ordinal} (hao : a < o)
  (ho : principal op o) (n : ℕ) : (op a)^[n] a < o :=
begin
  induction n with n hn,
  { rwa function.iterate_zero },
  { rw function.iterate_succ', exact ho hao hn }
end

theorem op_eq_self_of_principal {op : ordinal → ordinal → ordinal} {a o : ordinal.{u}}
  (hao : a < o) (H : is_normal (op a)) (ho : principal op o) (ho' : is_limit o) : op a o = o :=
begin
  refine le_antisymm _ (H.self_le _),
  rw [←is_normal.bsup_eq.{u u} H ho', bsup_le_iff],
  exact λ b hbo, (ho hao hbo).le
end

theorem nfp_le_of_principal {op : ordinal → ordinal → ordinal}
  {a o : ordinal} (hao : a < o) (ho : principal op o) : nfp (op a) a ≤ o :=
nfp_le $ λ n, (ho.iterate_lt hao n).le

/-! ### Principal ordinals are unbounded -/

/-- The least strict upper bound of `op` applied to all pairs of ordinals less than `o`. This is
essentially a two-argument version of `ordinal.blsub`. -/
def blsub₂ (op : ordinal → ordinal → ordinal) (o : ordinal) : ordinal :=
lsub (λ x : o.out.α × o.out.α, op (typein (<) x.1) (typein (<) x.2))

theorem lt_blsub₂ (op : ordinal → ordinal → ordinal) {o : ordinal} {a b : ordinal} (ha : a < o)
  (hb : b < o) : op a b < blsub₂ op o :=
begin
  convert lt_lsub _ (prod.mk (enum (<) a (by rwa type_lt)) (enum (<) b (by rwa type_lt))),
  simp only [typein_enum]
end

theorem principal_nfp_blsub₂ (op : ordinal → ordinal → ordinal) (o : ordinal) :
  principal op (nfp (blsub₂.{u u} op) o) :=
λ a b ha hb, begin
  rw lt_nfp at *,
  cases ha with m hm,
  cases hb with n hn,
  cases le_total ((blsub₂.{u u} op)^[m] o) ((blsub₂.{u u} op)^[n] o) with h h,
  { use n + 1,
    rw function.iterate_succ',
    exact lt_blsub₂ op (hm.trans_le h) hn },
  { use m + 1,
    rw function.iterate_succ',
    exact lt_blsub₂ op hm (hn.trans_le h) },
end

theorem unbounded_principal (op : ordinal → ordinal → ordinal) :
  set.unbounded (<) {o | principal op o} :=
λ o, ⟨_, principal_nfp_blsub₂ op o, (le_nfp_self _ o).not_lt⟩

/-! #### Additive principal ordinals -/

theorem principal_add_one : principal (+) 1 :=
principal_one_iff.2 $ zero_add 0

theorem principal_add_of_le_one {o : ordinal} (ho : o ≤ 1) : principal (+) o :=
begin
  rcases le_one_iff.1 ho with rfl | rfl,
  { exact principal_zero },
  { exact principal_add_one }
end

theorem principal_add_is_limit {o : ordinal} (ho₁ : 1 < o) (ho : principal (+) o) :
  o.is_limit :=
begin
  refine ⟨λ ho₀, _, λ a hao, _⟩,
  { rw ho₀ at ho₁,
    exact not_lt_of_gt ordinal.zero_lt_one ho₁ },
  { cases eq_or_ne a 0 with ha ha,
    { rw [ha, succ_zero],
      exact ho₁ },
    { refine lt_of_le_of_lt _ (ho hao hao),
      rwa [succ_eq_add_one, add_le_add_iff_left, one_le_iff_ne_zero] } }
end

theorem principal_add_iff_add_left_eq_self {o : ordinal} :
  principal (+) o ↔ ∀ a < o, a + o = o :=
begin
  refine ⟨λ ho a hao, _, λ h a b hao hbo, _⟩,
  { cases lt_or_le 1 o with ho₁ ho₁,
    { exact op_eq_self_of_principal hao (add_is_normal a) ho (principal_add_is_limit ho₁ ho) },
    { rcases le_one_iff.1 ho₁ with rfl | rfl,
      { exact (ordinal.not_lt_zero a hao).elim },
      { rw lt_one_iff_zero at hao,
        rw [hao, zero_add] }}},
  { rw ←h a hao,
    exact (add_is_normal a).strict_mono hbo }
end

theorem exists_lt_add_of_not_principal_add {a} (ha : ¬ principal (+) a) :
  ∃ (b c) (hb : b < a) (hc : c < a), b + c = a :=
begin
  unfold principal at ha,
  push_neg at ha,
  rcases ha with ⟨b, c, hb, hc, H⟩,
  refine ⟨b, _, hb, lt_of_le_of_ne (sub_le_self a b) (λ hab, _),
    ordinal.add_sub_cancel_of_le hb.le⟩,
  rw [←sub_le, hab] at H,
  exact H.not_lt hc
end

theorem principal_add_iff_add_lt_ne_self {a} :
  principal (+) a ↔ ∀ ⦃b c⦄, b < a → c < a → b + c ≠ a :=
⟨λ ha b c hb hc, (ha hb hc).ne, λ H, begin
  by_contra' ha,
  rcases exists_lt_add_of_not_principal_add ha with ⟨b, c, hb, hc, rfl⟩,
  exact (H hb hc).irrefl
end⟩

theorem add_omega {a : ordinal} (h : a < omega) : a + omega = omega :=
begin
  rcases lt_omega.1 h with ⟨n, rfl⟩,
  clear h, induction n with n IH,
  { rw [nat.cast_zero, zero_add] },
  { rwa [nat.cast_succ, add_assoc, one_add_of_omega_le (le_refl _)] }
end

theorem principal_add_omega : principal (+) omega :=
principal_add_iff_add_left_eq_self.2 (λ a, add_omega)

theorem add_omega_opow {a b : ordinal} (h : a < omega ^ b) : a + omega ^ b = omega ^ b :=
begin
  refine le_antisymm _ (le_add_left _ _),
  revert h, refine limit_rec_on b (λ h, _) (λ b _ h, _) (λ b l IH h, _),
  { rw [opow_zero, ← succ_zero, lt_succ, ordinal.le_zero] at h,
    rw [h, zero_add] },
  { rw opow_succ at h,
    rcases (lt_mul_of_limit omega_is_limit).1 h with ⟨x, xo, ax⟩,
    refine le_trans (add_le_add_right (le_of_lt ax) _) _,
    rw [opow_succ, ← mul_add, add_omega xo] },
  { rcases (lt_opow_of_limit omega_ne_zero l).1 h with ⟨x, xb, ax⟩,
    exact (((add_is_normal a).trans (opow_is_normal one_lt_omega)).limit_le l).2 (λ y yb,
      (add_le_add_left (opow_le_opow_right omega_pos (le_max_right _ _)) _).trans
      (le_trans (IH _ (max_lt xb yb) (ax.trans_le $ opow_le_opow_right omega_pos (le_max_left _ _)))
      (opow_le_opow_right omega_pos $ le_of_lt $ max_lt xb yb))) }
end

theorem principal_add_omega_opow (o : ordinal) : principal (+) (omega ^ o) :=
principal_add_iff_add_left_eq_self.2 (λ a, add_omega_opow)

/-- The main characterization theorem for additive principal ordinals. -/
theorem principal_add_iff_zero_or_omega_opow {o : ordinal} :
  principal (+) o ↔ o = 0 ∨ ∃ a, o = omega ^ a :=
begin
  rcases eq_or_ne o 0 with rfl | ho,
  { simp only [principal_zero, or.inl] },
  { rw [principal_add_iff_add_left_eq_self],
    simp only [ho, false_or],
    refine ⟨λ H, ⟨_, ((lt_or_eq_of_le (opow_log_le _ (ordinal.pos_iff_ne_zero.2 ho)))
        .resolve_left $ λ h, _).symm⟩, λ ⟨b, e⟩, e.symm ▸ λ a, add_omega_opow⟩,
    have := H _ h,
    have := lt_opow_succ_log one_lt_omega o,
    rw [opow_succ, lt_mul_of_limit omega_is_limit] at this,
    rcases this with ⟨a, ao, h'⟩,
    rcases lt_omega.1 ao with ⟨n, rfl⟩, clear ao,
    revert h', apply not_lt_of_le,
    suffices e : omega ^ log omega o * ↑n + o = o,
    { simpa only [e] using le_add_right (omega ^ log omega o * ↑n) o },
    induction n with n IH, {simp only [nat.cast_zero, mul_zero, zero_add]},
    simp only [nat.cast_succ, mul_add_one, add_assoc, this, IH] }
end

theorem opow_principal_add_of_principal_add {a} (ha : principal (+) a) (b : ordinal) :
  principal (+) (a ^ b) :=
begin
  rcases principal_add_iff_zero_or_omega_opow.1 ha with rfl | ⟨c, rfl⟩,
  { rcases eq_or_ne b 0 with rfl | hb,
    { rw opow_zero, exact principal_add_one },
    { rwa zero_opow hb } },
  { rw ←opow_mul, exact principal_add_omega_opow _ }
end

theorem add_absorp {a b c : ordinal} (h₁ : a < omega ^ b) (h₂ : omega ^ b ≤ c) : a + c = c :=
by rw [← ordinal.add_sub_cancel_of_le h₂, ← add_assoc, add_omega_opow h₁]

theorem mul_principal_add_is_principal_add (a : ordinal.{u}) {b : ordinal.{u}} (hb₁ : b ≠ 1)
  (hb : principal (+) b) : principal (+) (a * b) :=
begin
  rcases eq_zero_or_pos a with rfl | ha,
  { rw zero_mul,
    exact principal_zero },
  { rcases eq_zero_or_pos b with rfl | hb₁',
    { rw mul_zero,
      exact principal_zero },
    { rw [← succ_le,succ_zero] at hb₁',
      intros c d hc hd,
      rw lt_mul_of_limit (principal_add_is_limit (lt_of_le_of_ne hb₁' hb₁.symm) hb) at *,
      { rcases hc with ⟨x, hx, hx'⟩,
        rcases hd with ⟨y, hy, hy'⟩,
        use [x + y, hb hx hy],
        rw mul_add,
        exact add_lt_add hx' hy' },
      assumption' } }
end

/-! #### Multiplicative principal ordinals -/

theorem principal_mul_one : principal (*) 1 :=
by { rw principal_one_iff, exact zero_mul _ }

theorem principal_mul_two : principal (*) 2 :=
λ a b ha hb, begin
  have h₂ : (1 : ordinal).succ = 2 := rfl,
  rw [←h₂, ordinal.lt_succ] at *,
  convert mul_le_mul' ha hb,
  exact (mul_one 1).symm
end

theorem principal_mul_of_le_two {o : ordinal} (ho : o ≤ 2) : principal (*) o :=
begin
  rcases lt_or_eq_of_le ho with ho | rfl,
  { have h₂ : (1 : ordinal).succ = 2 := rfl,
    rw [←h₂, ordinal.lt_succ] at ho,
    rcases lt_or_eq_of_le ho with ho | rfl,
    { rw lt_one_iff_zero.1 ho,
      exact principal_zero },
    { exact principal_mul_one } },
  { exact principal_mul_two }
end

theorem principal_add_of_principal_mul {o : ordinal} (ho : principal (*) o) (ho₂ : o ≠ 2) :
  principal (+) o :=
begin
  cases lt_or_gt_of_ne ho₂ with ho₁ ho₂,
  { change o < succ 1 at ho₁,
    rw lt_succ at ho₁,
    exact principal_add_of_le_one ho₁ },
  { refine λ a b hao hbo, lt_of_le_of_lt _ (ho (max_lt hao hbo) ho₂),
    rw mul_two,
    exact add_le_add (le_max_left a b) (le_max_right a b) }
end

theorem principal_mul_is_limit {o : ordinal.{u}} (ho₂ : 2 < o) (ho : principal (*) o) :
  o.is_limit :=
principal_add_is_limit
  ((ordinal.lt_succ_self 1).trans ho₂)
  (principal_add_of_principal_mul ho (ne_of_gt ho₂))

theorem principal_mul_iff_mul_left_eq {o : ordinal} :
  principal (*) o ↔ ∀ a, 0 < a → a < o → a * o = o :=
begin
  refine ⟨λ h a ha₀ hao, _, λ h a b hao hbo, _⟩,
  { cases le_or_gt o 2 with ho ho,
    { convert one_mul o,
      apply le_antisymm,
      { have : a < succ 1 := hao.trans_le ho,
        rwa lt_succ at this },
      { rwa [←succ_le, succ_zero] at ha₀ } },
    { exact op_eq_self_of_principal hao (mul_is_normal ha₀) h (principal_mul_is_limit ho h) } },
  { rcases eq_or_ne a 0 with rfl | ha, { rwa zero_mul },
    rw ←ordinal.pos_iff_ne_zero at ha,
    rw ←h a ha hao,
    exact (mul_is_normal ha).strict_mono hbo }
end

theorem principal_mul_omega : principal (*) omega :=
λ a b ha hb, match a, b, lt_omega.1 ha, lt_omega.1 hb with
| _, _, ⟨m, rfl⟩, ⟨n, rfl⟩ := by { rw [← nat_cast_mul], apply nat_lt_omega }
end

theorem mul_omega {a : ordinal} (a0 : 0 < a) (ha : a < omega) : a * omega = omega :=
principal_mul_iff_mul_left_eq.1 (principal_mul_omega) a a0 ha

theorem mul_lt_omega_opow {a b c : ordinal}
  (c0 : 0 < c) (ha : a < omega ^ c) (hb : b < omega) : a * b < omega ^ c :=
begin
  rcases zero_or_succ_or_limit c with rfl|⟨c,rfl⟩|l,
  { exact (lt_irrefl _).elim c0 },
  { rw opow_succ at ha,
    rcases ((mul_is_normal $ opow_pos _ omega_pos).limit_lt
      omega_is_limit).1 ha with ⟨n, hn, an⟩,
    apply (mul_le_mul_right' (le_of_lt an) _).trans_lt,
    rw [opow_succ, mul_assoc, mul_lt_mul_iff_left (opow_pos _ omega_pos)],
    exact principal_mul_omega hn hb },
  { rcases ((opow_is_normal one_lt_omega).limit_lt l).1 ha with ⟨x, hx, ax⟩,
    refine (mul_le_mul' (le_of_lt ax) (le_of_lt hb)).trans_lt _,
    rw [← opow_succ, opow_lt_opow_iff_right one_lt_omega],
    exact l.2 _ hx }
end

theorem mul_omega_opow_opow {a b : ordinal} (a0 : 0 < a) (h : a < omega ^ omega ^ b) :
  a * omega ^ omega ^ b = omega ^ omega ^ b :=
begin
  by_cases b0 : b = 0, {rw [b0, opow_zero, opow_one] at h ⊢, exact mul_omega a0 h},
  refine le_antisymm _
    (by simpa only [one_mul] using mul_le_mul_right' (one_le_iff_pos.2 a0) (omega ^ omega ^ b)),
  rcases (lt_opow_of_limit omega_ne_zero (opow_is_limit_left omega_is_limit b0)).1 h
    with ⟨x, xb, ax⟩,
  apply (mul_le_mul_right' (le_of_lt ax) _).trans,
  rw [← opow_add, add_omega_opow xb]
end

theorem principal_mul_omega_opow_opow (o : ordinal) : principal (*) (omega ^ omega ^ o) :=
principal_mul_iff_mul_left_eq.2 (λ a, mul_omega_opow_opow)

theorem principal_add_of_principal_mul_opow {o b : ordinal} (hb : 1 < b)
  (ho : principal (*) (b ^ o)) : principal (+) o :=
λ x y hx hy, begin
  have := ho ((opow_lt_opow_iff_right hb).2 hx) ((opow_lt_opow_iff_right hb).2 hy),
  rwa [←opow_add, opow_lt_opow_iff_right hb] at this
end

/-- The main characterization theorem for multiplicative principal ordinals. -/
theorem principal_mul_iff_le_two_or_omega_opow_opow {o : ordinal} :
  principal (*) o ↔ o ≤ 2 ∨ ∃ a, o = omega ^ omega ^ a :=
begin
  refine ⟨λ ho, _, _⟩,
  { cases le_or_lt o 2 with ho₂ ho₂,
    { exact or.inl ho₂ },
    rcases principal_add_iff_zero_or_omega_opow.1 (principal_add_of_principal_mul ho ho₂.ne')
      with rfl | ⟨a, rfl⟩,
    { exact (ordinal.not_lt_zero 2 ho₂).elim },
    rcases principal_add_iff_zero_or_omega_opow.1
      (principal_add_of_principal_mul_opow one_lt_omega ho) with rfl | ⟨b, rfl⟩,
    { rw opow_zero at ho₂,
      exact ((lt_succ_self 1).not_le ho₂.le).elim },
    exact or.inr ⟨b, rfl⟩ },
  { rintro (ho₂ | ⟨a, rfl⟩),
    { exact principal_mul_of_le_two ho₂ },
    { exact principal_mul_omega_opow_opow a } }
end

theorem mul_omega_dvd {a : ordinal}
  (a0 : 0 < a) (ha : a < omega) : ∀ {b}, omega ∣ b → a * b = b
| _ ⟨b, rfl⟩ := by rw [← mul_assoc, mul_omega a0 ha]

theorem mul_eq_opow_log_succ {a b : ordinal.{u}} (ha : 0 < a) (hb : principal (*) b) (hb₂ : 2 < b) :
  a * b = b ^ (log b a).succ :=
begin
  apply le_antisymm,
  { have hbl := principal_mul_is_limit hb₂ hb,
    rw [←is_normal.bsup_eq.{u u} (mul_is_normal ha) hbl, bsup_le_iff],
    intros c hcb,
    have hb₁ : 1 < b := (lt_succ_self 1).trans hb₂,
    have hbo₀ : b ^ b.log a ≠ 0 := ordinal.pos_iff_ne_zero.1 (opow_pos _ (zero_lt_one.trans hb₁)),
    apply le_trans (mul_le_mul_right' (le_of_lt (lt_mul_succ_div a hbo₀)) c),
    rw [mul_assoc, opow_succ],
    refine mul_le_mul_left' (le_of_lt (hb (hbl.2 _ _) hcb)) _,
    rw [div_lt hbo₀, ←opow_succ],
    exact lt_opow_succ_log hb₁ _ },
  { rw opow_succ,
    exact mul_le_mul_right' (opow_log_le b ha) b }
end

/-! #### Exponential principal ordinals -/

theorem principal_opow_omega : principal (^) omega :=
λ a b ha hb, match a, b, lt_omega.1 ha, lt_omega.1 hb with
| _, _, ⟨m, rfl⟩, ⟨n, rfl⟩ := by { simp_rw ←nat_cast_opow, apply nat_lt_omega }
end

theorem opow_omega {a : ordinal} (a1 : 1 < a) (h : a < omega) : a ^ omega = omega :=
le_antisymm
  ((opow_le_of_limit (one_le_iff_ne_zero.1 $ le_of_lt a1) omega_is_limit).2
    (λ b hb, (principal_opow_omega h hb).le))
  (right_le_opow _ a1)

end ordinal


/-
Seems like this should be in the standard library.
-/

lemma demorgan (p q : Prop) : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
iff.intro
(assume h : ¬(p ∨ q),
  show ¬p ∧ ¬q, from
  and.intro
    (assume hp : p, absurd (or.intro_left q hp) h)
    (assume hq : q, absurd (or.intro_right p hq) h))
(assume h : ¬p ∧ ¬q,
  show ¬(p ∨ q), from
  assume h1 : p ∨ q,
  or.elim h1
    (assume hp : p, absurd hp (and.left h))
    (assume hq : q, absurd hq (and.right h)))


import GMLInit.Data.Nat.Basic
import GMLInit.Data.Nat.IsPos
import GMLInit.Logic.Connectives
import GMLInit.Logic.Ordering
import GMLInit.Logic.Relation

namespace Nat

-- assert theorem lt_or_ge (x y : Nat) : x < y ∨ x ≥ y

protected theorem le_or_gt (x y : Nat) : x ≤ y ∨ x > y :=
  Or.elim (Nat.lt_or_ge y x) Or.inr Or.inl

-- assert theorem lt_or_eq_of_le {x y : Nat} : x ≤ y → x < y ∨ x = y

protected theorem le_iff_lt_or_eq (x y : Nat) : x ≤ y ↔ x < y ∨ x = y :=
  ⟨Nat.lt_or_eq_of_le, λ h => Or.elim h Nat.le_of_lt Nat.le_of_eq⟩

-- assert theorem le_of_lt {x y : Nat} : x < y → x ≤ y

-- assert theorem ne_of_lt {x y : Nat} : x < y → x ≠ y | h, rfl => Nat.lt_irrefl x h

-- assert theorem lt_of_le_of_ne {x y : Nat} : x ≤ y → x ≠ y → x < y

-- assert theorem lt_iff_le_and_ne (x y : Nat) : x < y ↔ x ≤ y ∧ x ≠ y

-- assert theorem le_total (x y : Nat) : x ≤ y ∨ x ≥ y := Nat.leTotal x y

protected theorem lt_connex {x y : Nat} : x ≠ y → x < y ∨ x > y :=
  λ hne => Or.elim (Nat.lt_or_ge x y) Or.inl λ h => Or.inr (Nat.lt_of_le_of_ne h hne.symm)

protected theorem lt_compare {x y : Nat} : x < y → ∀ z, x < z ∨ z < y :=
  λ hlt z => Or.elim (Nat.lt_or_ge x z) Or.inl (λ hge => Or.inr (Nat.lt_of_le_of_lt hge hlt))

-- assert theorem ge_of_not_lt {x y : Nat} : ¬ x < y → x ≥ y := Or.mtp (Nat.le_or_gt y x)

-- assert theorem gt_of_not_le {x y : Nat} : ¬ x ≤ y → x > y

protected theorem le_of_not_gt {x y : Nat} : ¬ x > y → x ≤ y := Or.mtp (Nat.le_or_gt x y)

protected theorem lt_of_not_ge {x y : Nat} : ¬ x ≥ y → x < y := Or.mtp (Nat.lt_or_ge x y)

protected theorem not_ge_of_lt {x y : Nat} : x < y → ¬ x ≥ y := Nat.not_le_of_gt

protected theorem not_gt_of_le {x y : Nat} : x ≤ y → ¬ x > y := λ hle hgt => Nat.not_ge_of_lt hgt hle

-- assert theorem not_le_of_gt {x y : Nat} : x > y → ¬ x ≤ y

protected theorem not_lt_of_ge {x y : Nat} : x ≥ y → ¬ x < y := λ hge hlt => Nat.not_gt_of_le hlt (Nat.succ_le_succ hge)

protected theorem not_le_iff_gt (x y : Nat) : ¬ x ≤ y ↔ x > y :=
  ⟨Nat.gt_of_not_le, Nat.not_ge_of_lt⟩

protected theorem lt_iff_not_ge (x y : Nat) : x < y ↔ ¬ x ≥ y :=
  ⟨Nat.not_ge_of_lt, Nat.gt_of_not_le⟩

protected theorem not_lt_iff_ge (x y : Nat) : ¬ x < y ↔ x ≥ y :=
  ⟨Nat.ge_of_not_lt, Nat.not_gt_of_le⟩

protected theorem le_iff_not_gt (x y : Nat) : x ≤ y ↔ ¬ x > y :=
  ⟨Nat.not_gt_of_le, Nat.ge_of_not_lt⟩

protected theorem ne_iff_lt_or_gt (x y : Nat) : x ≠ y ↔ x < y ∨ x > y :=
  ⟨Nat.lt_connex, λ h => Or.elim h Nat.ne_of_lt λ h => (Nat.ne_of_lt h).symm⟩

-- assert theorem zero_le (x : Nat) : 0 ≤ x

-- assert theorem not_lt_zero (x : Nat) : ¬ x < 0

-- assert theorem eq_zero_of_le_zero {x : Nat} : x ≤ 0 → x = 0

protected theorem eq_zero_iff_le_zero (x : Nat) : x = 0 ↔ x ≤ 0 :=
  ⟨Nat.le_of_eq, Nat.eq_zero_of_le_zero⟩

open Relation

local instance : Reflexive (α:=Nat) (.≤.) := ⟨Nat.le_refl⟩
local instance : Transitive (α:=Nat) (.≤.) := ⟨Nat.le_trans⟩
local instance : Antisymmetric (α:=Nat) (.≤.) := ⟨Nat.le_antisymm⟩
local instance : Total (α:=Nat) (.≤.) := ⟨Nat.le_total⟩
instance : TotalOrder (α:=Nat) (.≤.) := TotalOrder.infer _
local instance : Irreflexive (α:=Nat) (.<.) := ⟨Nat.lt_irrefl⟩
local instance : Transitive (α:=Nat) (.<.) := ⟨Nat.lt_trans⟩
local instance : Connex (α:=Nat) (.<.) := ⟨Nat.lt_connex⟩
local instance : Comparison (α:=Nat) (.<.) := ⟨Nat.lt_compare⟩
instance : LinearOrder (α:=Nat) (.<.) := LinearOrder.infer _
instance : HTransitive (α:=Nat) (β:=Nat) (γ:=Nat) (.≤.) (.<.) (.<.) := ⟨Nat.lt_of_le_of_lt⟩
instance : HTransitive (α:=Nat) (β:=Nat) (γ:=Nat) (.<.) (.≤.) (.<.) := ⟨Nat.lt_of_lt_of_le⟩

end Nat