/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.nat.basic
import Mathlib.PostPort

namespace Mathlib

/-!
# Definitions and properties of `gcd`, `lcm`, and `coprime`

-/

namespace nat

/-! ### `gcd` -/

theorem gcd_dvd (m : ℕ) (n : ℕ) : gcd m n ∣ m ∧ gcd m n ∣ n := sorry

theorem gcd_dvd_left (m : ℕ) (n : ℕ) : gcd m n ∣ m :=
  and.left (gcd_dvd m n)

theorem gcd_dvd_right (m : ℕ) (n : ℕ) : gcd m n ∣ n :=
  and.right (gcd_dvd m n)

theorem gcd_le_left {m : ℕ} (n : ℕ) (h : 0 < m) : gcd m n ≤ m :=
  le_of_dvd h (gcd_dvd_left m n)

theorem gcd_le_right (m : ℕ) {n : ℕ} (h : 0 < n) : gcd m n ≤ n :=
  le_of_dvd h (gcd_dvd_right m n)

theorem dvd_gcd {m : ℕ} {n : ℕ} {k : ℕ} : k ∣ m → k ∣ n → k ∣ gcd m n := sorry

theorem dvd_gcd_iff {m : ℕ} {n : ℕ} {k : ℕ} : k ∣ gcd m n ↔ k ∣ m ∧ k ∣ n := sorry

theorem gcd_comm (m : ℕ) (n : ℕ) : gcd m n = gcd n m :=
  dvd_antisymm (dvd_gcd (gcd_dvd_right m n) (gcd_dvd_left m n)) (dvd_gcd (gcd_dvd_right n m) (gcd_dvd_left n m))

theorem gcd_eq_left_iff_dvd {m : ℕ} {n : ℕ} : m ∣ n ↔ gcd m n = m := sorry

theorem gcd_eq_right_iff_dvd {m : ℕ} {n : ℕ} : m ∣ n ↔ gcd n m = m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (m ∣ n ↔ gcd n m = m)) (gcd_comm n m))) gcd_eq_left_iff_dvd

theorem gcd_assoc (m : ℕ) (n : ℕ) (k : ℕ) : gcd (gcd m n) k = gcd m (gcd n k) := sorry

@[simp] theorem gcd_one_right (n : ℕ) : gcd n 1 = 1 :=
  Eq.trans (gcd_comm n 1) (gcd_one_left n)

theorem gcd_mul_left (m : ℕ) (n : ℕ) (k : ℕ) : gcd (m * n) (m * k) = m * gcd n k := sorry

theorem gcd_mul_right (m : ℕ) (n : ℕ) (k : ℕ) : gcd (m * n) (k * n) = gcd m k * n := sorry

theorem gcd_pos_of_pos_left {m : ℕ} (n : ℕ) (mpos : 0 < m) : 0 < gcd m n :=
  pos_of_dvd_of_pos (gcd_dvd_left m n) mpos

theorem gcd_pos_of_pos_right (m : ℕ) {n : ℕ} (npos : 0 < n) : 0 < gcd m n :=
  pos_of_dvd_of_pos (gcd_dvd_right m n) npos

theorem eq_zero_of_gcd_eq_zero_left {m : ℕ} {n : ℕ} (H : gcd m n = 0) : m = 0 :=
  or.elim (eq_zero_or_pos m) id fun (H1 : 0 < m) => absurd (Eq.symm H) (ne_of_lt (gcd_pos_of_pos_left n H1))

theorem eq_zero_of_gcd_eq_zero_right {m : ℕ} {n : ℕ} (H : gcd m n = 0) : n = 0 :=
  eq_zero_of_gcd_eq_zero_left (eq.mp (Eq._oldrec (Eq.refl (gcd m n = 0)) (gcd_comm m n)) H)

theorem gcd_div {m : ℕ} {n : ℕ} {k : ℕ} (H1 : k ∣ m) (H2 : k ∣ n) : gcd (m / k) (n / k) = gcd m n / k := sorry

theorem gcd_dvd_gcd_of_dvd_left {m : ℕ} {k : ℕ} (n : ℕ) (H : m ∣ k) : gcd m n ∣ gcd k n :=
  dvd_gcd (dvd.trans (gcd_dvd_left m n) H) (gcd_dvd_right m n)

theorem gcd_dvd_gcd_of_dvd_right {m : ℕ} {k : ℕ} (n : ℕ) (H : m ∣ k) : gcd n m ∣ gcd n k :=
  dvd_gcd (gcd_dvd_left n m) (dvd.trans (gcd_dvd_right n m) H)

theorem gcd_dvd_gcd_mul_left (m : ℕ) (n : ℕ) (k : ℕ) : gcd m n ∣ gcd (k * m) n :=
  gcd_dvd_gcd_of_dvd_left n (dvd_mul_left m k)

theorem gcd_dvd_gcd_mul_right (m : ℕ) (n : ℕ) (k : ℕ) : gcd m n ∣ gcd (m * k) n :=
  gcd_dvd_gcd_of_dvd_left n (dvd_mul_right m k)

theorem gcd_dvd_gcd_mul_left_right (m : ℕ) (n : ℕ) (k : ℕ) : gcd m n ∣ gcd m (k * n) :=
  gcd_dvd_gcd_of_dvd_right m (dvd_mul_left n k)

theorem gcd_dvd_gcd_mul_right_right (m : ℕ) (n : ℕ) (k : ℕ) : gcd m n ∣ gcd m (n * k) :=
  gcd_dvd_gcd_of_dvd_right m (dvd_mul_right n k)

theorem gcd_eq_left {m : ℕ} {n : ℕ} (H : m ∣ n) : gcd m n = m :=
  dvd_antisymm (gcd_dvd_left m n) (dvd_gcd (dvd_refl m) H)

theorem gcd_eq_right {m : ℕ} {n : ℕ} (H : n ∣ m) : gcd m n = n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (gcd m n = n)) (gcd_comm m n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (gcd n m = n)) (gcd_eq_left H))) (Eq.refl n))

@[simp] theorem gcd_mul_left_left (m : ℕ) (n : ℕ) : gcd (m * n) n = n :=
  dvd_antisymm (gcd_dvd_right (m * n) n) (dvd_gcd (dvd_mul_left n m) (dvd_refl n))

@[simp] theorem gcd_mul_left_right (m : ℕ) (n : ℕ) : gcd n (m * n) = n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (gcd n (m * n) = n)) (gcd_comm n (m * n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (gcd (m * n) n = n)) (gcd_mul_left_left m n))) (Eq.refl n))

@[simp] theorem gcd_mul_right_left (m : ℕ) (n : ℕ) : gcd (n * m) n = n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (gcd (n * m) n = n)) (mul_comm n m)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (gcd (m * n) n = n)) (gcd_mul_left_left m n))) (Eq.refl n))

@[simp] theorem gcd_mul_right_right (m : ℕ) (n : ℕ) : gcd n (n * m) = n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (gcd n (n * m) = n)) (gcd_comm n (n * m))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (gcd (n * m) n = n)) (gcd_mul_right_left m n))) (Eq.refl n))

@[simp] theorem gcd_gcd_self_right_left (m : ℕ) (n : ℕ) : gcd m (gcd m n) = gcd m n :=
  dvd_antisymm (gcd_dvd_right m (gcd m n)) (dvd_gcd (gcd_dvd_left m n) (dvd_refl (gcd m n)))

@[simp] theorem gcd_gcd_self_right_right (m : ℕ) (n : ℕ) : gcd m (gcd n m) = gcd n m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (gcd m (gcd n m) = gcd n m)) (gcd_comm n m)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (gcd m (gcd m n) = gcd m n)) (gcd_gcd_self_right_left m n))) (Eq.refl (gcd m n)))

@[simp] theorem gcd_gcd_self_left_right (m : ℕ) (n : ℕ) : gcd (gcd n m) m = gcd n m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (gcd (gcd n m) m = gcd n m)) (gcd_comm (gcd n m) m)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (gcd m (gcd n m) = gcd n m)) (gcd_gcd_self_right_right m n))) (Eq.refl (gcd n m)))

@[simp] theorem gcd_gcd_self_left_left (m : ℕ) (n : ℕ) : gcd (gcd m n) m = gcd m n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (gcd (gcd m n) m = gcd m n)) (gcd_comm m n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (gcd (gcd n m) m = gcd n m)) (gcd_gcd_self_left_right m n))) (Eq.refl (gcd n m)))

theorem gcd_add_mul_self (m : ℕ) (n : ℕ) (k : ℕ) : gcd m (n + k * m) = gcd m n := sorry

theorem gcd_eq_zero_iff {i : ℕ} {j : ℕ} : gcd i j = 0 ↔ i = 0 ∧ j = 0 := sorry

/-! ### `lcm` -/

theorem lcm_comm (m : ℕ) (n : ℕ) : lcm m n = lcm n m :=
  id
    (eq.mpr (id (Eq._oldrec (Eq.refl (m * n / gcd m n = n * m / gcd n m)) (mul_comm m n)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (n * m / gcd m n = n * m / gcd n m)) (gcd_comm m n))) (Eq.refl (n * m / gcd n m))))

@[simp] theorem lcm_zero_left (m : ℕ) : lcm 0 m = 0 :=
  id
    (eq.mpr (id (Eq._oldrec (Eq.refl (0 * m / gcd 0 m = 0)) (zero_mul m)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 / gcd 0 m = 0)) (nat.zero_div (gcd 0 m)))) (Eq.refl 0)))

@[simp] theorem lcm_zero_right (m : ℕ) : lcm m 0 = 0 :=
  lcm_comm 0 m ▸ lcm_zero_left m

@[simp] theorem lcm_one_left (m : ℕ) : lcm 1 m = m := sorry

@[simp] theorem lcm_one_right (m : ℕ) : lcm m 1 = m :=
  lcm_comm 1 m ▸ lcm_one_left m

@[simp] theorem lcm_self (m : ℕ) : lcm m m = m := sorry

theorem dvd_lcm_left (m : ℕ) (n : ℕ) : m ∣ lcm m n :=
  dvd.intro (n / gcd m n) (Eq.symm (nat.mul_div_assoc m (gcd_dvd_right m n)))

theorem dvd_lcm_right (m : ℕ) (n : ℕ) : n ∣ lcm m n :=
  lcm_comm n m ▸ dvd_lcm_left n m

theorem gcd_mul_lcm (m : ℕ) (n : ℕ) : gcd m n * lcm m n = m * n := sorry

theorem lcm_dvd {m : ℕ} {n : ℕ} {k : ℕ} (H1 : m ∣ k) (H2 : n ∣ k) : lcm m n ∣ k := sorry

theorem lcm_assoc (m : ℕ) (n : ℕ) (k : ℕ) : lcm (lcm m n) k = lcm m (lcm n k) := sorry

theorem lcm_ne_zero {m : ℕ} {n : ℕ} (hm : m ≠ 0) (hn : n ≠ 0) : lcm m n ≠ 0 := sorry

/-!
### `coprime`

See also `nat.coprime_of_dvd` and `nat.coprime_of_dvd'` to prove `nat.coprime m n`.
-/

protected instance coprime.decidable (m : ℕ) (n : ℕ) : Decidable (coprime m n) :=
  eq.mpr sorry (nat.decidable_eq (gcd m n) 1)

theorem coprime.gcd_eq_one {m : ℕ} {n : ℕ} : coprime m n → gcd m n = 1 :=
  id

theorem coprime.symm {m : ℕ} {n : ℕ} : coprime n m → coprime m n :=
  Eq.trans (gcd_comm m n)

theorem coprime.dvd_of_dvd_mul_right {m : ℕ} {n : ℕ} {k : ℕ} (H1 : coprime k n) (H2 : k ∣ m * n) : k ∣ m := sorry

theorem coprime.dvd_of_dvd_mul_left {m : ℕ} {n : ℕ} {k : ℕ} (H1 : coprime k m) (H2 : k ∣ m * n) : k ∣ n :=
  coprime.dvd_of_dvd_mul_right H1 (eq.mp (Eq._oldrec (Eq.refl (k ∣ m * n)) (mul_comm m n)) H2)

theorem coprime.gcd_mul_left_cancel {k : ℕ} (m : ℕ) {n : ℕ} (H : coprime k n) : gcd (k * m) n = gcd m n := sorry

theorem coprime.gcd_mul_right_cancel (m : ℕ) {k : ℕ} {n : ℕ} (H : coprime k n) : gcd (m * k) n = gcd m n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (gcd (m * k) n = gcd m n)) (mul_comm m k)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (gcd (k * m) n = gcd m n)) (coprime.gcd_mul_left_cancel m H))) (Eq.refl (gcd m n)))

theorem coprime.gcd_mul_left_cancel_right {k : ℕ} {m : ℕ} (n : ℕ) (H : coprime k m) : gcd m (k * n) = gcd m n := sorry

theorem coprime.gcd_mul_right_cancel_right {k : ℕ} {m : ℕ} (n : ℕ) (H : coprime k m) : gcd m (n * k) = gcd m n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (gcd m (n * k) = gcd m n)) (mul_comm n k)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (gcd m (k * n) = gcd m n)) (coprime.gcd_mul_left_cancel_right n H)))
      (Eq.refl (gcd m n)))

theorem coprime_div_gcd_div_gcd {m : ℕ} {n : ℕ} (H : 0 < gcd m n) : coprime (m / gcd m n) (n / gcd m n) := sorry

theorem not_coprime_of_dvd_of_dvd {m : ℕ} {n : ℕ} {d : ℕ} (dgt1 : 1 < d) (Hm : d ∣ m) (Hn : d ∣ n) : ¬coprime m n :=
  fun (co : gcd m n = 1) =>
    not_lt_of_ge (le_of_dvd zero_lt_one (eq.mpr (id (Eq._oldrec (Eq.refl (d ∣ 1)) (Eq.symm co))) (dvd_gcd Hm Hn))) dgt1

theorem exists_coprime {m : ℕ} {n : ℕ} (H : 0 < gcd m n) : ∃ (m' : ℕ), ∃ (n' : ℕ), coprime m' n' ∧ m = m' * gcd m n ∧ n = n' * gcd m n := sorry

theorem exists_coprime' {m : ℕ} {n : ℕ} (H : 0 < gcd m n) : ∃ (g : ℕ), ∃ (m' : ℕ), ∃ (n' : ℕ), 0 < g ∧ coprime m' n' ∧ m = m' * g ∧ n = n' * g := sorry

theorem coprime.mul {m : ℕ} {n : ℕ} {k : ℕ} (H1 : coprime m k) (H2 : coprime n k) : coprime (m * n) k :=
  Eq.trans (coprime.gcd_mul_left_cancel n H1) H2

theorem coprime.mul_right {k : ℕ} {m : ℕ} {n : ℕ} (H1 : coprime k m) (H2 : coprime k n) : coprime k (m * n) :=
  coprime.symm (coprime.mul (coprime.symm H1) (coprime.symm H2))

theorem coprime.coprime_dvd_left {m : ℕ} {k : ℕ} {n : ℕ} (H1 : m ∣ k) (H2 : coprime k n) : coprime m n := sorry

theorem coprime.coprime_dvd_right {m : ℕ} {k : ℕ} {n : ℕ} (H1 : n ∣ m) (H2 : coprime k m) : coprime k n :=
  coprime.symm (coprime.coprime_dvd_left H1 (coprime.symm H2))

theorem coprime.coprime_mul_left {k : ℕ} {m : ℕ} {n : ℕ} (H : coprime (k * m) n) : coprime m n :=
  coprime.coprime_dvd_left (dvd_mul_left m k) H

theorem coprime.coprime_mul_right {k : ℕ} {m : ℕ} {n : ℕ} (H : coprime (m * k) n) : coprime m n :=
  coprime.coprime_dvd_left (dvd_mul_right m k) H

theorem coprime.coprime_mul_left_right {k : ℕ} {m : ℕ} {n : ℕ} (H : coprime m (k * n)) : coprime m n :=
  coprime.coprime_dvd_right (dvd_mul_left n k) H

theorem coprime.coprime_mul_right_right {k : ℕ} {m : ℕ} {n : ℕ} (H : coprime m (n * k)) : coprime m n :=
  coprime.coprime_dvd_right (dvd_mul_right n k) H

theorem coprime.coprime_div_left {m : ℕ} {n : ℕ} {a : ℕ} (cmn : coprime m n) (dvd : a ∣ m) : coprime (m / a) n := sorry

theorem coprime.coprime_div_right {m : ℕ} {n : ℕ} {a : ℕ} (cmn : coprime m n) (dvd : a ∣ n) : coprime m (n / a) :=
  coprime.symm (coprime.coprime_div_left (coprime.symm cmn) dvd)

theorem coprime_mul_iff_left {k : ℕ} {m : ℕ} {n : ℕ} : coprime (m * n) k ↔ coprime m k ∧ coprime n k := sorry

theorem coprime_mul_iff_right {k : ℕ} {m : ℕ} {n : ℕ} : coprime k (m * n) ↔ coprime k m ∧ coprime k n := sorry

theorem coprime.gcd_left (k : ℕ) {m : ℕ} {n : ℕ} (hmn : coprime m n) : coprime (gcd k m) n :=
  coprime.coprime_dvd_left (gcd_dvd_right k m) hmn

theorem coprime.gcd_right (k : ℕ) {m : ℕ} {n : ℕ} (hmn : coprime m n) : coprime m (gcd k n) :=
  coprime.coprime_dvd_right (gcd_dvd_right k n) hmn

theorem coprime.gcd_both (k : ℕ) (l : ℕ) {m : ℕ} {n : ℕ} (hmn : coprime m n) : coprime (gcd k m) (gcd l n) :=
  coprime.gcd_right l (coprime.gcd_left k hmn)

theorem coprime.mul_dvd_of_dvd_of_dvd {a : ℕ} {n : ℕ} {m : ℕ} (hmn : coprime m n) (hm : m ∣ a) (hn : n ∣ a) : m * n ∣ a := sorry

theorem coprime_one_left (n : ℕ) : coprime 1 n :=
  gcd_one_left

theorem coprime_one_right (n : ℕ) : coprime n 1 :=
  gcd_one_right

theorem coprime.pow_left {m : ℕ} {k : ℕ} (n : ℕ) (H1 : coprime m k) : coprime (m ^ n) k :=
  nat.rec_on n (coprime_one_left k) fun (n : ℕ) (IH : coprime (m ^ n) k) => coprime.mul H1 IH

theorem coprime.pow_right {m : ℕ} {k : ℕ} (n : ℕ) (H1 : coprime k m) : coprime k (m ^ n) :=
  coprime.symm (coprime.pow_left n (coprime.symm H1))

theorem coprime.pow {k : ℕ} {l : ℕ} (m : ℕ) (n : ℕ) (H1 : coprime k l) : coprime (k ^ m) (l ^ n) :=
  coprime.pow_right n (coprime.pow_left m H1)

theorem coprime.eq_one_of_dvd {k : ℕ} {m : ℕ} (H : coprime k m) (d : k ∣ m) : k = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (k = 1)) (Eq.symm (coprime.gcd_eq_one H))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (k = gcd k m)) (gcd_eq_left d))) (Eq.refl k))

@[simp] theorem coprime_zero_left (n : ℕ) : coprime 0 n ↔ n = 1 := sorry

@[simp] theorem coprime_zero_right (n : ℕ) : coprime n 0 ↔ n = 1 := sorry

@[simp] theorem coprime_one_left_iff (n : ℕ) : coprime 1 n ↔ True := sorry

@[simp] theorem coprime_one_right_iff (n : ℕ) : coprime n 1 ↔ True := sorry

@[simp] theorem coprime_self (n : ℕ) : coprime n n ↔ n = 1 := sorry

/-- Represent a divisor of `m * n` as a product of a divisor of `m` and a divisor of `n`. -/
def prod_dvd_and_dvd_of_dvd_prod {m : ℕ} {n : ℕ} {k : ℕ} (H : k ∣ m * n) : Subtype fun (d : (Subtype fun (m' : ℕ) => m' ∣ m) × Subtype fun (n' : ℕ) => n' ∣ n) => k = ↑(prod.fst d) * ↑(prod.snd d) :=
  (fun (_x : ℕ) (h0 : gcd k m = _x) =>
      nat.cases_on _x
        (fun (h0 : gcd k m = 0) =>
          Eq._oldrec
            (fun (H : 0 ∣ m * n) (h0 : gcd 0 m = 0) =>
              Eq._oldrec
                (fun (H : 0 ∣ 0 * n) (h0 : gcd 0 0 = 0) =>
                  { val := ({ val := 0, property := sorry }, { val := n, property := dvd_refl n }), property := sorry })
                sorry H h0)
            sorry H h0)
        (fun (n_1 : ℕ) (h0 : gcd k m = Nat.succ n_1) =>
          (fun (h0 : gcd k m = Nat.succ n_1) =>
              { val := ({ val := gcd k m, property := gcd_dvd_right k m }, { val := k / gcd k m, property := sorry }),
                property := sorry })
            h0)
        h0)
    (gcd k m) sorry

theorem gcd_mul_dvd_mul_gcd (k : ℕ) (m : ℕ) (n : ℕ) : gcd k (m * n) ∣ gcd k m * gcd k n := sorry

theorem coprime.gcd_mul (k : ℕ) {m : ℕ} {n : ℕ} (h : coprime m n) : gcd k (m * n) = gcd k m * gcd k n :=
  dvd_antisymm (gcd_mul_dvd_mul_gcd k m n)
    (coprime.mul_dvd_of_dvd_of_dvd (coprime.gcd_both k k h) (gcd_dvd_gcd_mul_right_right k m n)
      (gcd_dvd_gcd_mul_left_right k n m))

theorem pow_dvd_pow_iff {a : ℕ} {b : ℕ} {n : ℕ} (n0 : 0 < n) : a ^ n ∣ b ^ n ↔ a ∣ b := sorry

theorem gcd_mul_gcd_of_coprime_of_mul_eq_mul {a : ℕ} {b : ℕ} {c : ℕ} {d : ℕ} (cop : coprime c d) (h : a * b = c * d) : gcd a c * gcd b c = c := sorry


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem amc12b_2002_p6
  (a b : ℝ)
  (h₀ : a ≠ 0 ∧ b ≠ 0)
  (h₁ : ∀ x, x^2 + a * x + b = (x - a) * (x - b)) :
  a = 1 ∧ b = -2 :=
begin
  have h₂ := h₁ a,
  have h₃ := h₁ b,
  have h₄ := h₁ 0,
  simp at *,
  have h₅ : b * (1 - a) = 0, linarith,
  simp at h₅,
  cases h₅ with h₅ h₆,
  exfalso,
  exact absurd h₅ h₀.2,
  have h₆ : a = 1, linarith,
  split,
  exact h₆,
  rw h₆ at h₂,
  linarith,
end


/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri
-/
import geometry.manifold.algebra.lie_group

/-!
# Smooth structures

In this file we define smooth structures that build on Lie groups. We prefer using the term smooth
instead of Lie mainly because Lie ring has currently another use in mathematics.
-/

open_locale manifold

section smooth_ring
variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{H : Type*} [topological_space H]
{E : Type*} [normed_group E] [normed_space 𝕜 E]

set_option default_priority 100 -- see Note [default priority]

/-- A smooth (semi)ring is a (semi)ring `R` where addition and multiplication are smooth.
If `R` is a ring, then negation is automatically smooth, as it is multiplication with `-1`. -/
-- See note [Design choices about smooth algebraic structures]
class smooth_ring (I : model_with_corners 𝕜 E H)
  (R : Type*) [semiring R] [topological_space R] [charted_space H R]
  extends has_smooth_add I R : Prop :=
(smooth_mul : smooth (I.prod I) I (λ p : R×R, p.1 * p.2))

instance smooth_ring.to_has_smooth_mul (I : model_with_corners 𝕜 E H)
  (R : Type*) [semiring R] [topological_space R] [charted_space H R] [h : smooth_ring I R] :
  has_smooth_mul I R := { ..h }

instance smooth_ring.to_lie_add_group (I : model_with_corners 𝕜 E H)
  (R : Type*) [ring R] [topological_space R] [charted_space H R] [smooth_ring I R] :
  lie_add_group I R :=
{ compatible := λ e e', has_groupoid.compatible (times_cont_diff_groupoid ⊤ I),
  smooth_add := smooth_add I,
  smooth_neg := by simpa only [neg_one_mul] using @smooth_mul_left 𝕜 _ H _ E _ _ I R _ _ _ _ (-1) }

end smooth_ring

instance field_smooth_ring {𝕜 : Type*} [nondiscrete_normed_field 𝕜] :
  smooth_ring 𝓘(𝕜) 𝕜 :=
{ smooth_mul :=
  begin
    rw smooth_iff,
    refine ⟨continuous_mul, λ x y, _⟩,
    simp only [prod.mk.eta] with mfld_simps,
    rw times_cont_diff_on_univ,
    exact times_cont_diff_mul,
  end,
  ..normed_space_lie_add_group }

variables {𝕜 R E H : Type*} [topological_space R] [topological_space H]
  [nondiscrete_normed_field 𝕜] [normed_group E] [normed_space 𝕜 E]
  [charted_space H R] (I : model_with_corners 𝕜 E H)

/-- A smooth (semi)ring is a topological (semi)ring. This is not an instance for technical reasons,
see note [Design choices about smooth algebraic structures]. -/
lemma topological_ring_of_smooth [semiring R] [smooth_ring I R] :
  topological_ring R :=
{ .. has_continuous_mul_of_smooth I, .. has_continuous_add_of_smooth I }


/-
Copyright (c) 2021 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying
-/
import measure_theory.measure.vector_measure
import order.symm_diff

/-!
# Hahn decomposition

This file prove the Hahn decomposition theorem (signed version). The Hahn decomposition theorem
states that, given a signed measure `s`, there exist complement, measurable sets `i` and `j`,
such that `i` is positive and `j` is negative with repsect to `s`; that is, `s` restricted on `i`
is non-negative and `s` restricted on `j` is non-positive.

The Hahn decomposition theorem leads to many other results in measure theory, most notably,
the Jordan decomposition theorem, the Lebesgue decomposition theorem and the Radon-Nikodym theorem.

## Main results

* `measure_theory.signed_measure.exists_is_compl_positive_negative` : the Hahn decomposition
  theorem.
* `measure_theory.signed_measure.exists_subset_restrict_nonpos` : A measurable set of negative
  measure contains a negative subset.

## Notation

We use the notations `0 ≤[i] s` and `s ≤[i] 0` to denote the usual definitions of a set `i`
being positive/negative with respect to the signed measure `s`.

## Tags

Hahn decomposition theorem
-/

noncomputable theory
open_locale classical big_operators nnreal ennreal measure_theory

variables {α β : Type*} [measurable_space α]
variables {M : Type*} [add_comm_monoid M] [topological_space M] [ordered_add_comm_monoid M]

namespace measure_theory

namespace signed_measure

open filter vector_measure

variables {s : signed_measure α} {i j : set α}

section exists_subset_restrict_nonpos

/-! ### exists_subset_restrict_nonpos

In this section we will prove that a set `i` whose measure is negative contains a negative subset
`j` with respect to the signed measure `s` (i.e. `s ≤[j] 0`), whose measure is negative. This lemma
is used to prove the Hahn decomposition theorem.

To prove this lemma, we will construct a sequence of measurable sets $(A_n)_{n \in \mathbb{N}}$,
such that, for all $n$, $s(A_{n + 1})$ is close to maximal among subsets of
$i \setminus \bigcup_{k \le n} A_k$.

This sequence of sets does not necessarily exist. However, if this sequence terminates; that is,
there does not exists any sets satisfying the property, the last $A_n$ will be a negative subset
of negative measure, hence proving our claim.

In the case that the sequence does not terminate, it is easy to see that
$i \setminus \bigcup_{k = 0}^\infty A_k$ is the required negative set.

To implement this in Lean, we define several auxilary definitions.

- given the sets `i` and the natural number `n`, `exists_one_div_lt s i n` is the property that
  there exists a measurable set `k ⊆ i` such that `1 / (n + 1) < s k`.
- given the sets `i` and that `i` is not negative, `find_exists_one_div_lt s i` is the
  least natural number `n` such that `exists_one_div_lt s i n`.
- given the sets `i` and that `i` is not negative, `some_exists_one_div_lt` chooses the set
  `k` from `exists_one_div_lt s i (find_exists_one_div_lt s i)`.
- lastly, given the set `i`, `restrict_nonpos_seq s i` is the sequence of sets defined inductively
  where
  `restrict_nonpos_seq s i 0 = some_exists_one_div_lt s (i \ ∅)` and
  `restrict_nonpos_seq s i (n + 1) = some_exists_one_div_lt s (i \ ⋃ k ≤ n, restrict_nonpos_seq k)`.
  This definition represents the sequence $(A_n)$ in the proof as described above.

With these definitions, we are able consider the case where the sequence terminates separately,
allowing us to prove `exists_subset_restrict_nonpos`.
-/

/-- Given the set `i` and the natural number `n`, `exists_one_div_lt s i j` is the property that
there exists a measurable set `k ⊆ i` such that `1 / (n + 1) < s k`. -/
private def exists_one_div_lt (s : signed_measure α) (i : set α) (n : ℕ) : Prop :=
∃ k : set α, k ⊆ i ∧ measurable_set k ∧ (1 / (n + 1) : ℝ) < s k

private lemma exists_nat_one_div_lt_measure_of_not_negative (hi : ¬ s ≤[i] 0) :
  ∃ (n : ℕ), exists_one_div_lt s i n :=
let ⟨k, hj₁, hj₂, hj⟩ := exists_pos_measure_of_not_restrict_le_zero s hi in
let ⟨n, hn⟩ := exists_nat_one_div_lt hj in ⟨n, k, hj₂, hj₁, hn⟩

/-- Given the set `i`, if `i` is not negative, `find_exists_one_div_lt s i` is the
least natural number `n` such that `exists_one_div_lt s i n`, otherwise, it returns 0. -/
private def find_exists_one_div_lt (s : signed_measure α) (i : set α) : ℕ :=
if hi : ¬ s ≤[i] 0 then nat.find (exists_nat_one_div_lt_measure_of_not_negative hi) else 0

private lemma find_exists_one_div_lt_spec (hi : ¬ s ≤[i] 0) :
  exists_one_div_lt s i (find_exists_one_div_lt s i) :=
begin
  rw [find_exists_one_div_lt, dif_pos hi],
  convert nat.find_spec _,
end

private lemma find_exists_one_div_lt_min (hi : ¬ s ≤[i] 0) {m : ℕ}
  (hm : m < find_exists_one_div_lt s i) : ¬ exists_one_div_lt s i m :=
begin
  rw [find_exists_one_div_lt, dif_pos hi] at hm,
  exact nat.find_min _ hm
end

/-- Given the set `i`, if `i` is not negative, `some_exists_one_div_lt` chooses the set
`k` from `exists_one_div_lt s i (find_exists_one_div_lt s i)`, otherwise, it returns the
empty set. -/
private def some_exists_one_div_lt (s : signed_measure α) (i : set α) : set α :=
if hi : ¬ s ≤[i] 0 then classical.some (find_exists_one_div_lt_spec hi) else ∅

private lemma some_exists_one_div_lt_spec (hi : ¬ s ≤[i] 0) :
  (some_exists_one_div_lt s i) ⊆ i ∧ measurable_set (some_exists_one_div_lt s i) ∧
  (1 / (find_exists_one_div_lt s i + 1) : ℝ) < s (some_exists_one_div_lt s i) :=
begin
  rw [some_exists_one_div_lt, dif_pos hi],
  exact classical.some_spec (find_exists_one_div_lt_spec hi),
end

private lemma some_exists_one_div_lt_subset : some_exists_one_div_lt s i ⊆ i :=
begin
  by_cases hi : ¬ s ≤[i] 0,
  { exact let ⟨h, _⟩ := some_exists_one_div_lt_spec hi in h },
  { rw [some_exists_one_div_lt, dif_neg hi],
    exact set.empty_subset _ },
end

private lemma some_exists_one_div_lt_subset' : some_exists_one_div_lt s (i \ j) ⊆ i :=
set.subset.trans some_exists_one_div_lt_subset (set.diff_subset _ _)

private

private lemma some_exists_one_div_lt_lt (hi : ¬ s ≤[i] 0) :
  (1 / (find_exists_one_div_lt s i + 1) : ℝ) < s (some_exists_one_div_lt s i) :=
let ⟨_, _, h⟩ := some_exists_one_div_lt_spec hi in h

/-- Given the set `i`, `restrict_nonpos_seq s i` is the sequence of sets defined inductively where
`restrict_nonpos_seq s i 0 = some_exists_one_div_lt s (i \ ∅)` and
`restrict_nonpos_seq s i (n + 1) = some_exists_one_div_lt s (i \ ⋃ k ≤ n, restrict_nonpos_seq k)`.

For each `n : ℕ`,`s (restrict_nonpos_seq s i n)` is close to maximal among all subsets of
`i \ ⋃ k ≤ n, restrict_nonpos_seq s i k`. -/
private def restrict_nonpos_seq (s : signed_measure α) (i : set α) : ℕ → set α
| 0 := some_exists_one_div_lt s (i \ ∅) -- I used `i \ ∅` instead of `i` to simplify some proofs
| (n + 1) := some_exists_one_div_lt s (i \ ⋃ k ≤ n,
  have k < n + 1 := nat.lt_succ_iff.mpr H,
  restrict_nonpos_seq k)

private lemma restrict_nonpos_seq_succ (n : ℕ) :
  restrict_nonpos_seq s i n.succ =
  some_exists_one_div_lt s (i \ ⋃ k ≤ n, restrict_nonpos_seq s i k) :=
by rw restrict_nonpos_seq

private lemma restrict_nonpos_seq_subset (n : ℕ) :
  restrict_nonpos_seq s i n ⊆ i :=
begin
  cases n;
  { rw restrict_nonpos_seq, exact some_exists_one_div_lt_subset' }
end

private lemma restrict_nonpos_seq_lt
  (n : ℕ) (hn : ¬ s ≤[i \ ⋃ k ≤ n, restrict_nonpos_seq s i k] 0) :
  (1 / (find_exists_one_div_lt s (i \ ⋃ k ≤ n, restrict_nonpos_seq s i k) + 1) : ℝ)
  < s (restrict_nonpos_seq s i n.succ) :=
begin
  rw restrict_nonpos_seq_succ,
  apply some_exists_one_div_lt_lt hn,
end

private lemma measure_of_restrict_nonpos_seq (hi₂ : ¬ s ≤[i] 0)
  (n : ℕ) (hn : ¬ s ≤[i \ ⋃ k < n, restrict_nonpos_seq s i k] 0) :
  0 < s (restrict_nonpos_seq s i n) :=
begin
  cases n,
  { rw restrict_nonpos_seq, rw ← @set.diff_empty _ i at hi₂,
    rcases some_exists_one_div_lt_spec hi₂ with ⟨_, _, h⟩,
    exact (lt_trans nat.one_div_pos_of_nat h) },
  { rw restrict_nonpos_seq_succ,
    have h₁ : ¬ s ≤[i \ ⋃ (k : ℕ) (H : k ≤ n), restrict_nonpos_seq s i k] 0,
    { refine mt (restrict_le_zero_subset _ _ (by simp [nat.lt_succ_iff])) hn,
      convert measurable_of_not_restrict_le_zero _ hn,
      exact funext (λ x, by rw nat.lt_succ_iff) },
    rcases some_exists_one_div_lt_spec h₁ with ⟨_, _, h⟩,
    exact (lt_trans nat.one_div_pos_of_nat h) }
end

private lemma restrict_nonpos_seq_measurable_set (n : ℕ) :
  measurable_set (restrict_nonpos_seq s i n) :=
begin
  cases n;
  { rw restrict_nonpos_seq,
    exact some_exists_one_div_lt_measurable_set },
end

private lemma restrict_nonpos_seq_disjoint' {n m : ℕ} (h : n < m) :
  restrict_nonpos_seq s i n ∩ restrict_nonpos_seq s i m = ∅ :=
begin
  rw set.eq_empty_iff_forall_not_mem,
  rintro x ⟨hx₁, hx₂⟩,
  cases m, { linarith },
  { rw restrict_nonpos_seq at hx₂,
    exact (some_exists_one_div_lt_subset hx₂).2
      (set.mem_Union.2 ⟨n, set.mem_Union.2 ⟨nat.lt_succ_iff.mp h, hx₁⟩⟩) }
end

private lemma restrict_nonpos_seq_disjoint : pairwise (disjoint on (restrict_nonpos_seq s i)) :=
begin
  intros n m h,
  rcases lt_or_gt_of_ne h with (h | h),
  { intro x,
    rw [set.inf_eq_inter, restrict_nonpos_seq_disjoint' h],
    exact id },
  { intro x,
    rw [set.inf_eq_inter, set.inter_comm, restrict_nonpos_seq_disjoint' h],
    exact id }
end

private lemma exists_subset_restrict_nonpos' (hi₁ : measurable_set i) (hi₂ : s i < 0)
  (hn : ¬ ∀ n : ℕ, ¬ s ≤[i \ ⋃ l < n, restrict_nonpos_seq s i l] 0) :
  ∃ j : set α, measurable_set j ∧ j ⊆ i ∧ s ≤[j] 0 ∧ s j < 0 :=
begin
  by_cases s ≤[i] 0, { exact ⟨i, hi₁, set.subset.refl _, h, hi₂⟩ },
  push_neg at hn,
  set k := nat.find hn with hk₁,
  have hk₂ : s ≤[i \ ⋃ l < k, restrict_nonpos_seq s i l] 0 := nat.find_spec hn,
  have hmeas : measurable_set (⋃ (l : ℕ) (H : l < k), restrict_nonpos_seq s i l) :=
    (measurable_set.Union $ λ _, measurable_set.Union_Prop
      (λ _, restrict_nonpos_seq_measurable_set _)),
  refine ⟨i \ ⋃ l < k, restrict_nonpos_seq s i l, hi₁.diff hmeas, set.diff_subset _ _, hk₂, _⟩,
  rw [of_diff hmeas hi₁, s.of_disjoint_Union_nat],
  { have h₁ : ∀ l < k, 0 ≤ s (restrict_nonpos_seq s i l),
    { intros l hl,
      refine le_of_lt (measure_of_restrict_nonpos_seq h _ _),
      refine mt (restrict_le_zero_subset _ (hi₁.diff _) (set.subset.refl _)) (nat.find_min hn hl),
      exact (measurable_set.Union $ λ _, measurable_set.Union_Prop
        (λ _, restrict_nonpos_seq_measurable_set _)) },
    suffices : 0 ≤ ∑' (l : ℕ), s (⋃ (H : l < k), restrict_nonpos_seq s i l),
    { rw sub_neg,
      exact lt_of_lt_of_le hi₂ this },
    refine tsum_nonneg _,
    intro l, by_cases l < k,
    { convert h₁ _ h,
      ext x,
      rw [set.mem_Union, exists_prop, and_iff_right_iff_imp],
      exact λ _, h },
    { convert le_of_eq s.empty.symm,
      ext, simp only [exists_prop, set.mem_empty_eq, set.mem_Union, not_and, iff_false],
      exact λ h', false.elim (h h') } },
  { intro, exact measurable_set.Union_Prop (λ _, restrict_nonpos_seq_measurable_set _) },
  { intros a b hab x hx,
    simp only [exists_prop, set.mem_Union, set.mem_inter_eq, set.inf_eq_inter] at hx,
    exact let ⟨⟨_, hx₁⟩, _, hx₂⟩ := hx in restrict_nonpos_seq_disjoint a b hab ⟨hx₁, hx₂⟩ },
  { apply set.Union_subset,
    intros a x,
    simp only [and_imp, exists_prop, set.mem_Union],
    intros _ hx,
    exact restrict_nonpos_seq_subset _ hx },
  { apply_instance }
end

/-- A measurable set of negative measure has a negative subset of negative measure. -/
theorem exists_subset_restrict_nonpos (hi : s i < 0) :
  ∃ j : set α, measurable_set j ∧ j ⊆ i ∧ s ≤[j] 0 ∧ s j < 0 :=
begin
  have hi₁ : measurable_set i :=
    classical.by_contradiction (λ h, ne_of_lt hi $ s.not_measurable h),
  by_cases s ≤[i] 0, { exact ⟨i, hi₁, set.subset.refl _, h, hi⟩ },
  by_cases hn : ∀ n : ℕ, ¬ s ≤[i \ ⋃ l < n, restrict_nonpos_seq s i l] 0,
  swap, { exact exists_subset_restrict_nonpos' hi₁ hi hn },
  set A := i \ ⋃ l, restrict_nonpos_seq s i l with hA,
  set bdd : ℕ → ℕ := λ n,
    find_exists_one_div_lt s (i \ ⋃ k ≤ n, restrict_nonpos_seq s i k) with hbdd,
  have hn' : ∀ n : ℕ, ¬ s ≤[i \ ⋃ l ≤ n, restrict_nonpos_seq s i l] 0,
  { intro n,
    convert hn (n + 1);
    { ext l,
      simp only [exists_prop, set.mem_Union, and.congr_left_iff],
      exact λ _, nat.lt_succ_iff.symm } },
  have h₁ : s i = s A + ∑' l, s (restrict_nonpos_seq s i l),
  { rw [hA, ← s.of_disjoint_Union_nat, add_comm, of_add_of_diff],
    exact measurable_set.Union (λ _, restrict_nonpos_seq_measurable_set _),
    exacts [hi₁, set.Union_subset (λ _, restrict_nonpos_seq_subset _), λ _,
            restrict_nonpos_seq_measurable_set _, restrict_nonpos_seq_disjoint] },
  have h₂ : s A ≤ s i,
  { rw h₁,
    apply le_add_of_nonneg_right,
    exact tsum_nonneg (λ n, le_of_lt (measure_of_restrict_nonpos_seq h _ (hn n))) },
  have h₃' : summable (λ n, (1 / (bdd n + 1) : ℝ)),
  { have : summable (λ l, s (restrict_nonpos_seq s i l)) :=
      has_sum.summable (s.m_Union (λ _, restrict_nonpos_seq_measurable_set _)
        restrict_nonpos_seq_disjoint),
    refine summable_of_nonneg_of_le (λ n, _) (λ n, _)
      (summable.comp_injective this nat.succ_injective),
    { exact le_of_lt nat.one_div_pos_of_nat },
    { exact le_of_lt (restrict_nonpos_seq_lt n (hn' n)) } },
  have h₃ : tendsto (λ n, (bdd n : ℝ) + 1) at_top at_top,
  { simp only [one_div] at h₃',
    exact summable.tendsto_top_of_pos h₃' (λ n, nat.cast_add_one_pos (bdd n)) },
  have h₄ : tendsto (λ n, (bdd n : ℝ)) at_top at_top,
  { convert at_top.tendsto_at_top_add_const_right (-1) h₃, simp },
  have A_meas : measurable_set A :=
    hi₁.diff (measurable_set.Union (λ _, restrict_nonpos_seq_measurable_set _)),
  refine ⟨A, A_meas, set.diff_subset _ _, _, h₂.trans_lt hi⟩,
  by_contra hnn,
  rw restrict_le_restrict_iff _ _ A_meas at hnn, push_neg at hnn,
  obtain ⟨E, hE₁, hE₂, hE₃⟩ := hnn,
  have : ∃ k, 1 ≤ bdd k ∧ 1 / (bdd k : ℝ) < s E,
  { rw tendsto_at_top_at_top at h₄,
    obtain ⟨k, hk⟩ := h₄ (max (1 / s E + 1) 1),
    refine ⟨k, _, _⟩,
    { have hle := le_of_max_le_right (hk k le_rfl),
      norm_cast at hle,
      exact hle },
    { have : 1 / s E < bdd k,
      { linarith [le_of_max_le_left (hk k le_rfl)] {restrict_type := ℝ} },
      rw one_div at this ⊢,
      rwa inv_lt (lt_trans (inv_pos.2 hE₃) this) hE₃ } },
  obtain ⟨k, hk₁, hk₂⟩ := this,
  have hA' : A ⊆ i \ ⋃ l ≤ k, restrict_nonpos_seq s i l,
  { apply set.diff_subset_diff_right,
    intro x, simp only [set.mem_Union],
    rintro ⟨n, _, hn₂⟩,
    exact ⟨n, hn₂⟩ },
  refine find_exists_one_div_lt_min (hn' k)
    (buffer.lt_aux_2 hk₁) ⟨E, set.subset.trans hE₂ hA', hE₁, _⟩,
  convert hk₂, norm_cast,
  exact tsub_add_cancel_of_le hk₁
end

end exists_subset_restrict_nonpos

/-- The set of measures of the set of measurable negative sets. -/
def measure_of_negatives (s : signed_measure α) : set ℝ :=
s '' { B | measurable_set B ∧ s ≤[B] 0 }

lemma zero_mem_measure_of_negatives : (0 : ℝ) ∈ s.measure_of_negatives :=
⟨∅, ⟨measurable_set.empty, le_restrict_empty _ _⟩, s.empty⟩

lemma bdd_below_measure_of_negatives :
  bdd_below s.measure_of_negatives :=
begin
  simp_rw [bdd_below, set.nonempty, mem_lower_bounds],
  by_contra, push_neg at h,
  have h' : ∀ n : ℕ, ∃ y : ℝ, y ∈ s.measure_of_negatives ∧ y < -n := λ n, h (-n),
  choose f hf using h',
  have hf' : ∀ n : ℕ, ∃ B, measurable_set B ∧ s ≤[B] 0 ∧ s B < -n,
  { intro n,
    rcases hf n with ⟨⟨B, ⟨hB₁, hBr⟩, hB₂⟩, hlt⟩,
    exact ⟨B, hB₁, hBr, hB₂.symm ▸ hlt⟩ },
  choose B hmeas hr h_lt using hf',
  set A := ⋃ n, B n with hA,
  have hfalse : ∀ n : ℕ, s A ≤ -n,
  { intro n,
    refine le_trans _ (le_of_lt (h_lt _)),
    rw [hA, ← set.diff_union_of_subset (set.subset_Union _ n),
        of_union (disjoint.comm.1 set.disjoint_diff) _ (hmeas n)],
    { refine add_le_of_nonpos_left _,
      have : s ≤[A] 0 := restrict_le_restrict_Union _ _ hmeas hr,
      refine nonpos_of_restrict_le_zero _ (restrict_le_zero_subset _ _ (set.diff_subset _ _) this),
      exact measurable_set.Union hmeas },
    { apply_instance },
    { exact (measurable_set.Union hmeas).diff (hmeas n) } },
  rcases exists_nat_gt (-(s A)) with ⟨n, hn⟩,
  exact lt_irrefl _ ((neg_lt.1 hn).trans_le (hfalse n)),
end

/-- Alternative formulation of `measure_theory.signed_measure.exists_is_compl_positive_negative`
(the Hahn decomposition theorem) using set complements. -/
lemma exists_compl_positive_negative (s : signed_measure α) :
  ∃ i : set α, measurable_set i ∧ 0 ≤[i] s ∧ s ≤[iᶜ] 0 :=
begin
  obtain ⟨f, _, hf₂, hf₁⟩ := exists_seq_tendsto_Inf
    ⟨0, @zero_mem_measure_of_negatives _ _ s⟩ bdd_below_measure_of_negatives,
  choose B hB using hf₁,
  have hB₁ : ∀ n, measurable_set (B n) := λ n, (hB n).1.1,
  have hB₂ : ∀ n, s ≤[B n] 0 := λ n, (hB n).1.2,
  set A := ⋃ n, B n with hA,
  have hA₁ : measurable_set A := measurable_set.Union hB₁,
  have hA₂ : s ≤[A] 0 := restrict_le_restrict_Union _ _ hB₁ hB₂,
  have hA₃ : s A = Inf s.measure_of_negatives,
  { apply le_antisymm,
    { refine le_of_tendsto_of_tendsto tendsto_const_nhds hf₂ (eventually_of_forall (λ n, _)),
      rw [← (hB n).2, hA, ← set.diff_union_of_subset (set.subset_Union _ n),
          of_union (disjoint.comm.1 set.disjoint_diff) _ (hB₁ n)],
      { refine add_le_of_nonpos_left _,
        have : s ≤[A] 0 :=
          restrict_le_restrict_Union _ _ hB₁ (λ m, let ⟨_, h⟩ := (hB m).1 in h),
        refine nonpos_of_restrict_le_zero _
          (restrict_le_zero_subset _ _ (set.diff_subset _ _) this),
        exact measurable_set.Union hB₁ },
      { apply_instance },
      { exact (measurable_set.Union hB₁).diff (hB₁ n) } },
    { exact cInf_le bdd_below_measure_of_negatives ⟨A, ⟨hA₁, hA₂⟩, rfl⟩ } },
  refine ⟨Aᶜ, hA₁.compl, _, (compl_compl A).symm ▸ hA₂⟩,
  rw restrict_le_restrict_iff _ _ hA₁.compl,
  intros C hC hC₁,
  by_contra hC₂, push_neg at hC₂,
  rcases exists_subset_restrict_nonpos hC₂ with ⟨D, hD₁, hD, hD₂, hD₃⟩,
  have : s (A ∪ D) < Inf s.measure_of_negatives,
  { rw [← hA₃, of_union (set.disjoint_of_subset_right (set.subset.trans hD hC₁)
        disjoint_compl_right) hA₁ hD₁],
    linarith, apply_instance },
  refine not_le.2 this _,
  refine cInf_le bdd_below_measure_of_negatives ⟨A ∪ D, ⟨_, _⟩, rfl⟩,
  { exact hA₁.union hD₁ },
  { exact restrict_le_restrict_union _ _ hA₁ hA₂ hD₁ hD₂ },
end

/-- **The Hahn decomposition thoerem**: Given a signed measure `s`, there exist
complement measurable sets `i` and `j` such that `i` is positive, `j` is negative. -/
theorem exists_is_compl_positive_negative (s : signed_measure α) :
  ∃ i j : set α, measurable_set i ∧ 0 ≤[i] s ∧ measurable_set j ∧ s ≤[j] 0 ∧ is_compl i j :=
let ⟨i, hi₁, hi₂, hi₃⟩ := exists_compl_positive_negative s in
  ⟨i, iᶜ, hi₁, hi₂, hi₁.compl, hi₃, is_compl_compl⟩

/-- The symmetric difference of two Hahn decompositions have measure zero. -/
lemma of_symm_diff_compl_positive_negative {s : signed_measure α}
  {i j : set α} (hi : measurable_set i) (hj : measurable_set j)
  (hi' : 0 ≤[i] s ∧ s ≤[iᶜ] 0) (hj' : 0 ≤[j] s ∧ s ≤[jᶜ] 0) :
  s (i Δ j) = 0 ∧ s (iᶜ Δ jᶜ) = 0 :=
begin
  rw [restrict_le_restrict_iff s 0, restrict_le_restrict_iff 0 s] at hi' hj',
  split,
  { rw [symm_diff_def, set.diff_eq_compl_inter, set.diff_eq_compl_inter,
        set.sup_eq_union, of_union,
        le_antisymm (hi'.2 (hi.compl.inter hj) (set.inter_subset_left _ _))
          (hj'.1 (hi.compl.inter hj) (set.inter_subset_right _ _)),
        le_antisymm (hj'.2 (hj.compl.inter hi) (set.inter_subset_left _ _))
          (hi'.1 (hj.compl.inter hi) (set.inter_subset_right _ _)),
        zero_apply, zero_apply, zero_add],
    { exact set.disjoint_of_subset_left (set.inter_subset_left _ _)
        (set.disjoint_of_subset_right (set.inter_subset_right _ _)
        (disjoint.comm.1 (is_compl.disjoint is_compl_compl))) },
    { exact hj.compl.inter hi },
    { exact hi.compl.inter hj } },
  { rw [symm_diff_def, set.diff_eq_compl_inter, set.diff_eq_compl_inter,
        compl_compl, compl_compl, set.sup_eq_union, of_union,
        le_antisymm (hi'.2 (hj.inter hi.compl) (set.inter_subset_right _ _))
          (hj'.1 (hj.inter hi.compl) (set.inter_subset_left _ _)),
        le_antisymm (hj'.2 (hi.inter hj.compl) (set.inter_subset_right _ _))
          (hi'.1 (hi.inter hj.compl) (set.inter_subset_left _ _)),
        zero_apply, zero_apply, zero_add],
    { exact set.disjoint_of_subset_left (set.inter_subset_left _ _)
        (set.disjoint_of_subset_right (set.inter_subset_right _ _)
        (is_compl.disjoint is_compl_compl)) },
    { exact hj.inter hi.compl },
    { exact hi.inter hj.compl } },
  all_goals { measurability },
end

end signed_measure

end measure_theory


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import algebra.char_p.basic

/-!
# Lemmas about rings of characteristic two

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

This file contains results about `char_p R 2`, in the `char_two` namespace.

The lemmas in this file with a `_sq` suffix are just special cases of the `_pow_char` lemmas
elsewhere, with a shorter name for ease of discovery, and no need for a `[fact (prime 2)]` argument.
-/

variables {R ι : Type*}

namespace char_two

section semiring
variables [semiring R] [char_p R 2]

lemma two_eq_zero : (2 : R) = 0 :=
by rw [← nat.cast_two, char_p.cast_eq_zero]

@[simp] lemma add_self_eq_zero (x : R) : x + x = 0 :=
by rw [←two_smul R x, two_eq_zero, zero_smul]

@[simp] lemma bit0_eq_zero : (bit0 : R → R) = 0 :=
by { funext, exact add_self_eq_zero _ }

lemma bit0_apply_eq_zero (x : R) : (bit0 x : R) = 0 :=
by simp

@[simp] lemma bit1_eq_one : (bit1 : R → R) = 1 :=
by { funext, simp [bit1] }

lemma bit1_apply_eq_one (x : R) : (bit1 x : R) = 1 :=
by simp

end semiring

section ring
variables [ring R] [char_p R 2]

@[simp] lemma neg_eq (x : R) : -x = x :=
by rw [neg_eq_iff_add_eq_zero, ←two_smul R x, two_eq_zero, zero_smul]

lemma neg_eq' : has_neg.neg = (id : R → R) :=
funext neg_eq

@[simp] lemma sub_eq_add (x y : R) : x - y = x + y :=
by rw [sub_eq_add_neg, neg_eq]

lemma sub_eq_add' : has_sub.sub = ((+) : R → R → R) :=
funext $ λ x, funext $ λ y, sub_eq_add x y

end ring

section comm_semiring
variables [comm_semiring R] [char_p R 2]

lemma add_sq (x y : R) : (x + y) ^ 2 = x ^ 2 + y ^ 2 :=
add_pow_char _ _ _

lemma add_mul_self (x y : R) : (x + y) * (x + y) = x * x + y * y :=
by rw [←pow_two, ←pow_two, ←pow_two, add_sq]

open_locale big_operators

lemma list_sum_sq (l : list R) : l.sum ^ 2 = (l.map (^ 2)).sum :=
list_sum_pow_char _ _

lemma list_sum_mul_self (l : list R) : l.sum * l.sum = (list.map (λ x, x * x) l).sum :=
by simp_rw [←pow_two, list_sum_sq]

lemma multiset_sum_sq (l : multiset R) : l.sum ^ 2 = (l.map (^ 2)).sum :=
multiset_sum_pow_char _ _

lemma multiset_sum_mul_self (l : multiset R) : l.sum * l.sum = (multiset.map (λ x, x * x) l).sum :=
by simp_rw [←pow_two, multiset_sum_sq]

lemma sum_sq (s : finset ι) (f : ι → R) :
  (∑ i in s, f i) ^ 2 = ∑ i in s, f i ^ 2 :=
sum_pow_char _ _ _

lemma sum_mul_self (s : finset ι) (f : ι → R) :
  (∑ i in s, f i) * (∑ i in s, f i) = ∑ i in s, f i * f i :=
by simp_rw [←pow_two, sum_sq]

end comm_semiring

end char_two

section ring_char
variables [ring R]

lemma neg_one_eq_one_iff [nontrivial R]: (-1 : R) = 1 ↔ ring_char R = 2 :=
begin
  refine ⟨λ h, _, λ h, @@char_two.neg_eq _ (ring_char.of_eq h) 1⟩,
  rw [eq_comm, ←sub_eq_zero, sub_neg_eq_add, ← nat.cast_one, ← nat.cast_add] at h,
  exact ((nat.dvd_prime nat.prime_two).mp (ring_char.dvd h)).resolve_left char_p.ring_char_ne_one
end

@[simp] lemma order_of_neg_one [nontrivial R] :
  order_of (-1 : R) = if ring_char R = 2 then 1 else 2 :=
begin
  split_ifs,
  { rw [neg_one_eq_one_iff.2 h, order_of_one] },
  apply order_of_eq_prime,
  { simp },
  simpa [neg_one_eq_one_iff] using h
end

end ring_char


/-
Copyright (c) 2019 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import algebra.continued_fractions.basic
/-!
# Basic Translation Lemmas Between Functions Defined for Continued Fractions

## Summary

Some simple translation lemmas between the different definitions of functions defined in
`algebra.continued_fractions.basic`.
-/

namespace generalized_continued_fraction

section general
/-!
### Translations Between General Access Functions

Here we give some basic translations that hold by definition between the various methods that allow
us to access the numerators and denominators of a continued fraction.
-/

variables {α : Type*} {g : generalized_continued_fraction α} {n : ℕ}

lemma terminated_at_iff_s_terminated_at : g.terminated_at n ↔ g.s.terminated_at n := by refl

lemma terminated_at_iff_s_none : g.terminated_at n ↔ g.s.nth n = none := by refl

lemma part_num_none_iff_s_none : g.partial_numerators.nth n = none ↔ g.s.nth n = none :=
by cases s_nth_eq : (g.s.nth n); simp [partial_numerators, s_nth_eq]

lemma terminated_at_iff_part_num_none : g.terminated_at n ↔ g.partial_numerators.nth n = none :=
by rw [terminated_at_iff_s_none, part_num_none_iff_s_none]

lemma part_denom_none_iff_s_none : g.partial_denominators.nth n = none ↔ g.s.nth n = none :=
by cases s_nth_eq : (g.s.nth n); simp [partial_denominators, s_nth_eq]

lemma terminated_at_iff_part_denom_none : g.terminated_at n ↔ g.partial_denominators.nth n = none :=
by rw [terminated_at_iff_s_none, part_denom_none_iff_s_none]

lemma part_num_eq_s_a {gp : pair α} (s_nth_eq : g.s.nth n = some gp) :
  g.partial_numerators.nth n = some gp.a :=
by simp [partial_numerators, s_nth_eq]

lemma part_denom_eq_s_b {gp : pair α} (s_nth_eq : g.s.nth n = some gp) :
  g.partial_denominators.nth n = some gp.b :=
by simp [partial_denominators, s_nth_eq]

lemma exists_s_a_of_part_num {a : α} (nth_part_num_eq : g.partial_numerators.nth n = some a) :
  ∃ gp, g.s.nth n = some gp ∧ gp.a = a :=
by simpa [partial_numerators, seq.map_nth] using nth_part_num_eq

lemma exists_s_b_of_part_denom {b : α} (nth_part_denom_eq : g.partial_denominators.nth n = some b) :
  ∃ gp, g.s.nth n = some gp ∧ gp.b = b :=
by simpa [partial_denominators, seq.map_nth] using nth_part_denom_eq

end general

section with_division_ring
/-!
### Translations Between Computational Functions

Here we  give some basic translations that hold by definition for the computational methods of a
continued fraction.
-/

variables {K : Type*} {g : generalized_continued_fraction K} {n : ℕ} [division_ring K]

lemma nth_cont_eq_succ_nth_cont_aux : g.continuants n = g.continuants_aux (n + 1) := rfl
lemma num_eq_conts_a : g.numerators n = (g.continuants n).a := rfl
lemma denom_eq_conts_b : g.denominators n = (g.continuants n).b := rfl
lemma convergent_eq_num_div_denom : g.convergents n = g.numerators n / g.denominators n := rfl
lemma convergent_eq_conts_a_div_conts_b :
  g.convergents n = (g.continuants n).a / (g.continuants n).b := rfl

lemma exists_conts_a_of_num {A : K} (nth_num_eq : g.numerators n = A) :
  ∃ conts, g.continuants n = conts ∧ conts.a = A :=
by simpa

lemma exists_conts_b_of_denom {B : K} (nth_denom_eq : g.denominators n = B) :
  ∃ conts, g.continuants n = conts ∧ conts.b = B :=
by simpa

@[simp]
lemma zeroth_continuant_aux_eq_one_zero : g.continuants_aux 0 = ⟨1, 0⟩ := rfl
@[simp]
lemma first_continuant_aux_eq_h_one : g.continuants_aux 1 = ⟨g.h, 1⟩ := rfl
@[simp]
lemma zeroth_continuant_eq_h_one : g.continuants 0 = ⟨g.h, 1⟩ := rfl
@[simp]
lemma zeroth_numerator_eq_h : g.numerators 0 = g.h := rfl
@[simp]
lemma zeroth_denominator_eq_one : g.denominators 0 = 1 := rfl
@[simp]
lemma zeroth_convergent_eq_h : g.convergents 0 = g.h :=
by simp [convergent_eq_num_div_denom, num_eq_conts_a, denom_eq_conts_b, div_one]

lemma second_continuant_aux_eq {gp : pair K} (zeroth_s_eq : g.s.nth 0 = some gp) :
  g.continuants_aux 2 = ⟨gp.b * g.h + gp.a, gp.b⟩ :=
by simp [zeroth_s_eq, continuants_aux, next_continuants, next_denominator, next_numerator]

lemma first_continuant_eq {gp : pair K} (zeroth_s_eq : g.s.nth 0 = some gp) :
  g.continuants 1 = ⟨gp.b * g.h + gp.a, gp.b⟩ :=
by simp [nth_cont_eq_succ_nth_cont_aux, (second_continuant_aux_eq zeroth_s_eq)]

lemma first_numerator_eq {gp : pair K} (zeroth_s_eq : g.s.nth 0 = some gp) :
  g.numerators 1 = gp.b * g.h + gp.a :=
by simp[num_eq_conts_a, (first_continuant_eq zeroth_s_eq)]

lemma first_denominator_eq {gp : pair K} (zeroth_s_eq : g.s.nth 0 = some gp) :
  g.denominators 1 = gp.b :=
by simp[denom_eq_conts_b, (first_continuant_eq zeroth_s_eq)]

@[simp]
lemma zeroth_convergent'_aux_eq_zero {s : seq $ pair K} : convergents'_aux s 0 = 0 := rfl
@[simp]
lemma zeroth_convergent'_eq_h : g.convergents' 0 = g.h := by simp [convergents']

end with_division_ring
end generalized_continued_fraction


import tactic
import data.set
import logic.basic

open set

namespace mth1001

section intersection_and_union

-- We'll deal with sets on a type `U`.
variable U : Type*
variables A B C : set U

/-
Typing set notation in Lean:

`∪` is `\cup`
`∩` is `\cap`
`∈` is `\in`
`∉` is `\notin`
`∅` is `\empty`
-/

/-
Throughout this file, we use `mem_inter_iff` and `mem_union_eq` to rewrite intersections and
unions as conjunctions and disjunctions.
-/
example (x : U) : x ∈ A ∩ B ↔ x ∈ A ∧ x ∈ B := by rw mem_inter_iff
example (x : U) : x ∈ A ∪ B ↔ x ∈ A ∨ x ∈ B := by rw mem_union_eq

/-
We prove right distributivity of intersection over union.
-/
example : (A ∪ B) ∩ C = (A ∩ C) ∪ (B ∩ C) :=
begin
  ext, -- Assume `x : U`. It suffices to show `x ∈ (A ∪ B) ∩ C ↔ x ∈ (A ∩ C) ∪ (B ∩ C)`.
  -- Repeatedly apply the basic theorems on membership of intersections and unions.
  -- `or_and_distrib_right` is the distributive law, `(P ∨ Q) ∧ R ↔ (P ∧ Q) ∨ (Q ∧ R)`.
  calc x ∈ (A ∪ B) ∩ C
        ↔ x ∈ (A ∪ B) ∧ x ∈ C                : by rw mem_inter_iff
    ... ↔ (x ∈ A ∨ x ∈ B) ∧ x ∈ C            : by rw mem_union_eq
    ... ↔ (x ∈ A ∧ x ∈ C) ∨ (x ∈ B ∧ x ∈ C)  : by rw or_and_distrib_right
    ... ↔ x ∈ A ∩ C ∨ x ∈ B ∩ C              : by rw [mem_inter_iff, mem_inter_iff]
    ... ↔ x ∈ (A ∩ C) ∪ (B ∩ C)              : by rw mem_union_eq,
end

-- Alternatively, we can just rewrite the goal many times.
example : (A ∪ B) ∩ C = (A ∩ C) ∪ (B ∩ C) :=
begin
  ext, -- Assume `x : U`. It suffices to show `x ∈ (A ∪ B) ∩ C ↔ x ∈ (A ∩ C) ∪ (B ∩ C)`.
  repeat { rw mem_inter_iff },
  repeat { rw mem_union_eq, },
  repeat { rw mem_inter_iff },
  rw or_and_distrib_right,
end

/-  ***************************
    Laws of propositional logic
    *************************** -/

-- Feel free to use the following laws in the proofs below.

variables p q r : Prop

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := by rw or_and_distrib_left
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by rw and_or_distrib_left
example : (p ∨ q) ∧ r ↔ (p ∧ r) ∨ (q ∧ r) := by rw or_and_distrib_right
example : (p ∧ q) ∨ r ↔ (p ∨ r) ∧ (q ∨ r) := by rw and_or_distrib_right
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r)       := by rw and_assoc
example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r)       := by rw or_assoc
example : p ∨ false ↔ p                   := by rw or_false
example : p ∧ false ↔ false               := by rw and_false
example : p ∧ p ↔ p                       := by rw and_self
example : p ∨ p ↔ p                       := by rw or_self

-- Exercise 131:
-- Adapt either of the proofs above to give the following distributive law.
example : A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
begin
  sorry
end

-- Exercise 132:
example : A ∩ B = B ∩ A :=
begin
  sorry  end

-- Exercise 133:
example : A ∪ B = B ∪ A :=
begin
  sorry
end

-- Exercise 134:
example : (A ∩ B) ∩ C = A ∩ (B ∩ C) :=
begin
  sorry
end

-- Exercise 135:
example : (A ∪ B) ∪ C = A ∪ (B ∪ C) :=
begin
  sorry
end

-- Exercise 136:
example : A ∩ A = A :=
begin
  sorry
end

/-
For the next result, we use `empty_def` and `mem_set_of_eq`, statements that are equivalent to our
mathematical definitions of empty set and set membership, respectively.
-/
example : ∅ = {x : U | false}                            := by rw empty_def
example (P : U → Prop) (z : U) : z ∈ {x : U | P x} = P z := by rw mem_set_of_eq

example : A ∩ ∅ = ∅ :=
begin
  ext x, -- Assume `x : U`. It remains to prove `x ∈ A ∩ ∅ ↔ x ∈ ∅`.
  rw mem_inter_iff, -- Rewrite `x ∈ A ∩ ∅` as `x ∈ A ∧ x ∈ ∅`.
  rw empty_def, -- Rewrite `∅` as `{x : U | ⊥}`.
  rw mem_set_of_eq, -- Rewrite `x ∈ {x : U | ⊥}` as `⊥`.
  rw and_false, -- Complete the goal using the result `P ∧ ⊥ ↔ ⊥` and reflexivity of `↔`.
end

-- Exercise 137:
example : A ∪ ∅ = A :=
begin
  sorry
end

end intersection_and_union

end mth1001


/- Homework 2.3: Functional Programming — Monads -/

namespace homework

/- Question 1: `map` for monads

Define `map` for monads. This is the generalization of `map` on lists. Use the monad operations to
define `map`. The _functorial properties_ (`map_id` and `map_map`) are derived from the monad laws.

This time, we use Lean's monad definition. In combination, `monad` and `is_lawful_monad` include the
same constants, laws, and syntactic sugar as the `monad` type class from the lecture. -/

section map

variables {M : Type → Type} [monad M] [is_lawful_monad M]

/- 1.1. Define `map` on `M`.

**Hint:** The challenge is to find a way to create `M β`. Follow the types. -/

def map {α β} (f : α → β) (m : M α) : M β:=
do a <- m,
   return (f a)
/- 1.2. Prove the identity law for `map`. -/

lemma map_id {α} (m : M α) : map id m = m := by simp[map]

/- 1.3. Prove the composition law for `map`. -/

lemma map_map {α β γ} (f : α → β) (g : β → γ) (m : M α) :
  map g (map f m) = map (g ∘ f) m :=
begin
simp[map, return],

end

end map

/- Question 2: Monadic structure on lists -/

/- `list` can be seen as a monad, similar to `option` but with several possible outcomes. It is also
similar to `set`, but the results are ordered and finite. The code below sets `list` up as a
monad. -/

namespace list

protected def bind {α β : Type} : list α → (α → list β) → list β
| []       f := []
| (a :: l) f := f a ++ bind l f

protected def pure {α : Type} (a : α) : list α := [a]

lemma pure_eq_singleton {α} (a : α) : pure a = [a] :=
by refl

instance : monad list :=
{ pure := @list.pure,
  bind := @list.bind }

/- 2.1. Prove the following properties of `bind` under the empty list (`[]`), the list constructor
(`::`), and `++`. -/

@[simp] lemma bind_nil {α β} (f : α → list β) : [] >>= f = [] := by refl

@[simp] lemma bind_cons {α β} (f : α → list β) (a : α) (l : list α) :
  (a :: l) >>= f = f a ++ (l >>= f) := by simp[bind]

@[simp] lemma bind_append {α β} (f : α → list β) :
  ∀l l':list α, (l ++ l') >>= f = (l >>= f) ++ (l' >>= f):=
  begin
  intros a b,
  simp[bind]
  end

/- 2.2. Prove the monadic laws for `list`.

**Hint:** The simplifier cannot see through the type class definition of `pure`. You can use
`pure_eq_singleton` to unfold the definition or `show` to state the lemma statement using `bind` and
`[...]`. -/

lemma pure_bind {α β} (a : α) (f : α → list β) : (pure a >>= f) = f a := by simp[pure_eq_singleton]

lemma bind_pure {α} : ∀l : list α, l >>= pure = l := by simp[pure_eq_singleton]

lemma bind_assoc {α β γ} (f : α → list β) (g : β → list γ) :
  ∀l : list α, (l >>= f) >>= g = l >>= (λa, f a >>= g)
| [] := by refl
| (x :: xs) := by simp[bind_assoc xs]

lemma bind_pure_comp_eq_map {α β} {f : α → β} :
  ∀l : list α, l >>= (pure ∘ f) = list.map f l
| [] := by refl
| (x :: xs) := begin simp[bind_pure_comp_eq_map xs], simp[pure], simp[list.ret] end

/- 2.3 **optional**. Register `list` as a lawful monad. This may be a challenge. -/

instance : is_lawful_monad list :=
sorry

end list

end homework


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import measure_theory.constructions.borel_space

/-!
# Measurability of `⌊x⌋` etc

In this file we prove that `int.floor`, `int.ceil`, `int.fract`, `nat.floor`, and `nat.ceil` are
measurable under some assumptions on the (semi)ring.
-/

open set

section floor_ring

variables {α R : Type*} [measurable_space α] [linear_ordered_ring R] [floor_ring R]
  [topological_space R] [order_topology R] [measurable_space R]

lemma int.measurable_floor [opens_measurable_space R] :
  measurable (int.floor : R → ℤ) :=
measurable_to_encodable $ λ x, by simpa only [int.preimage_floor_singleton]
  using measurable_set_Ico

@[measurability] lemma measurable.floor [opens_measurable_space R]
  {f : α → R} (hf : measurable f) : measurable (λ x, ⌊f x⌋) :=
int.measurable_floor.comp hf

lemma int.measurable_ceil [opens_measurable_space R] :
  measurable (int.ceil : R → ℤ) :=
measurable_to_encodable $ λ x,
  by simpa only [int.preimage_ceil_singleton] using measurable_set_Ioc

@[measurability] lemma measurable.ceil [opens_measurable_space R]
  {f : α → R} (hf : measurable f) : measurable (λ x, ⌈f x⌉) :=
int.measurable_ceil.comp hf

lemma measurable_fract [borel_space R] : measurable (int.fract : R → R) :=
begin
  intros s hs,
  rw int.preimage_fract,
  exact measurable_set.Union (λ z, measurable_id.sub_const _ (hs.inter measurable_set_Ico))
end

@[measurability] lemma measurable.fract [borel_space R]
  {f : α → R} (hf : measurable f) : measurable (λ x, int.fract (f x)) :=
measurable_fract.comp hf

lemma measurable_set.image_fract [borel_space R] {s : set R} (hs : measurable_set s) :
  measurable_set (int.fract '' s) :=
begin
  simp only [int.image_fract, sub_eq_add_neg, image_add_right'],
  exact measurable_set.Union (λ m, (measurable_add_const _ hs).inter measurable_set_Ico)
end

end floor_ring

section floor_semiring

variables {α R : Type*} [measurable_space α] [linear_ordered_semiring R] [floor_semiring R]
  [topological_space R] [order_topology R] [measurable_space R] [opens_measurable_space R]
  {f : α → R}

lemma nat.measurable_floor : measurable (nat.floor : R → ℕ) :=
measurable_to_encodable $ λ n, by cases eq_or_ne ⌊n⌋₊ 0; simp [*, nat.preimage_floor_of_ne_zero]

@[measurability] lemma measurable.nat_floor (hf : measurable f) : measurable (λ x, ⌊f x⌋₊) :=
nat.measurable_floor.comp hf

lemma nat.measurable_ceil : measurable (nat.ceil : R → ℕ) :=
measurable_to_encodable $ λ n, by cases eq_or_ne ⌈n⌉₊ 0; simp [*, nat.preimage_ceil_of_ne_zero]

@[measurability] lemma measurable.nat_ceil (hf : measurable f) : measurable (λ x, ⌈f x⌉₊) :=
nat.measurable_ceil.comp hf

end floor_semiring


import data.real.basic

import for_mathlib.decimal_expansions
import zero_point_seven_one -- "obvious" proof that 0.71 has no 8's in decimal expansion!
/-

M1F May exam 2018, question 2.

-/

universe u
local attribute [instance, priority 0] classical.prop_decidable

-- Q2(a)(i)
def ub (S : set ℝ) (x : ℝ) := ∀ s ∈ S, s ≤ x ---ans

-- Q2(a)(ii)
-- iba: is bounded above
def iba (S : set ℝ) := ∃ x, ub S x ---ans

-- Q2(a)(iii)
def lub (S : set ℝ) (b : ℝ) := ub S b ∧ ∀ y : ℝ, (ub S y → b ≤ y) ---ans

-- Q2(b)
theorem lub_duh (S : set ℝ) : (∃ x, lub S x) → S ≠ ∅ ∧ iba S := ---ans
    begin
        intro Hexlub, cases Hexlub with x Hlub,
        split,
            intro Hemp, rw set.empty_def at Hemp,
            cases Hlub with Hub Hl,
            have Hallub : ∀ y : ℝ, ub S y,
                unfold ub, rw Hemp, change (∀ (y s : ℝ), false → s ≤ y),
                intros y s Hf, exfalso, exact Hf,
            have Hneginf : ∀ y : ℝ, x ≤ y,
                intro y, apply Hl, apply Hallub,
            have Hcontr := Hneginf (x - 1),
            revert Hcontr, norm_num,
            existsi x, exact Hlub.left,
    end

-- Q2(c)(i) preparation
def S1 := {x : ℝ | x < 59}

lemma between_bounds (x y : ℝ) (H : x < y) : x < (x + y) / 2 ∧ (x + y) / 2 < y :=
⟨by linarith, by linarith⟩

-- Q2(c)(i)
theorem S1_lub : lub S1 59 := ---ans
    begin
        split,
            intro, change (s < 59 → s ≤ 59), exact le_of_lt,
        intro y, change ((∀ (s : ℝ), s < 59 → s ≤ y) → 59 ≤ y), intro Hbub,
        apply le_of_not_gt, intro Hbadub,
        have Houtofbounds := between_bounds y 59 Hbadub,
        apply not_le_of_gt Houtofbounds.1 (Hbub ((y + 59) / 2) Houtofbounds.2),
    end

-- Q2(c)(ii) preparations

definition S2 : set ℝ := {x | 7/10 < x ∧ x < 9/10 ∧
  ∀ n : ℕ, decimal.expansion_nonneg x n ≠ 8}

lemma S2_nonempty_and_bounded : (∃ s : ℝ, s ∈ S2) ∧ ∀ (s : ℝ), s ∈ S2 → s ≤ 9/10 :=
begin
  split,
  { -- 0.71 ∈ S
    use (71 / 100 : ℝ),
    split, norm_num, split, norm_num,
    exact no_eights_in_0_point_71
  },
  rintro s ⟨hs1, hs2, h⟩,
  exact le_of_lt hs2
end

-- Q2(c)(ii)
theorem S2_has_lub : ∃ b : ℝ, lub S2 b :=
begin
  cases S2_nonempty_and_bounded with Hne Hbd,
  have H := real.exists_sup S2 Hne ⟨(9/10 : ℝ), Hbd⟩,
  cases H with b Hb,
  use b,
  split,
  { intros s2 Hs2,
    exact (Hb b).mp (le_refl _) s2 Hs2,
  },
  { intros y Hy,
    exact (Hb y).mpr Hy,
  }
end

-- Q2(d)(i)
theorem ublub_the_first (S : set ℝ) (b : ℝ) (hub : ub S b) (hin : b ∈ S) : lub S b := ---ans
    begin
        split,
            exact hub,
            intros y huby,
            exact huby b hin,
    end

-- Q2(d)(ii)
theorem adlub_the_second (S T : set ℝ) (b c : ℝ) (hlubb : lub S b) (hlubc : lub T c) ---ans
: lub ({x : ℝ | ∃ s t : ℝ, s ∈ S ∧ t ∈ T ∧ x = s + t}) (b + c) :=
    begin
        split,
            unfold ub, simp, intros x s hss t htt hxst, rw hxst,
            apply add_le_add (hlubb.1 s hss) (hlubc.1 t htt),
            unfold ub, simp, intros x Hx,
            apply le_of_not_gt, intro Hcontr,
            let ε := b + c - x,
            have Hcontr' : ε > 0 := (by linarith : b + c - x > 0),
            have rwx : x = (b - ε / 2) + (c - ε / 2)
            := (by linarith : x = (b - (b + c - x) / 2) + (c - (b + c - x) / 2)),
            have hnbub : ∃ s' ∈ S, b - ε / 2 < s',
                by_contradiction,
                have a' : (¬∃ (s' : ℝ), s' ∈ S ∧ b - ε / 2 < s'),
                    intro b, apply a, cases b with σ Hσ, existsi σ, existsi Hσ.1, exact Hσ.2,
                have a'' : ∀ (x : ℝ), x ∈ S → ¬(b - ε / 2 < x),
                    intros x Hx Hb, rw not_exists at a', apply a' x, exact ⟨Hx, Hb⟩,
                simp only [not_lt] at a'', rw ←ub at a'',
                have a''' := hlubb.2 _ a'',
                linarith,
            have hnbuc : ∃ t' ∈ T, c - ε / 2 < t',
                by_contradiction,
                have a' : (¬∃ (t' : ℝ), t' ∈ T ∧ c - ε / 2 < t'),
                    intro b, apply a, cases b with σ Hσ, existsi σ, existsi Hσ.1, exact Hσ.2,
                have a'' : ∀ (x : ℝ), x ∈ T → ¬(c - ε / 2 < x),
                    intros x Hx Hc, rw not_exists at a', apply a' x, exact ⟨Hx, Hc⟩,
                simp only [not_lt] at a'', rw ←ub at a'',
                have a''' := hlubc.2 _ a'',
                linarith,
            cases hnbub with s' hnbub', cases hnbub' with Hs' hnbub'',
            cases hnbuc with t' hnbuc', cases hnbuc' with Ht' hnbuc'',
            have Hx' := Hx (s' + t') s' Hs' t' Ht' rfl,
            have Haha : x < x
            := lt_of_lt_of_le (by { rw rwx, apply add_lt_add hnbub'' hnbuc'' } : x < s' + t') Hx',
            linarith,
    end


import game.world9.level3 -- hide
namespace mynat -- hide

/-
# Advanced Multiplication World

## Level 4: `mul_left_cancel`

This is the last of the bonus multiplication levels.
`mul_left_cancel` will be useful in inequality world.

People find this level hard. I have probably had more questions about this
level than all the other levels put together, in fact. Many levels in this
game can just be solved by "running at it" -- do induction on one of the
variables, keep your head, and you're done. In fact, if you like a challenge,
it might be instructive if you stop reading after the end of this paragraph and try solving this level now by induction,
seeing the trouble you run into, and reading the rest of these comments afterwards. This level
has a sting in the tail. If you are a competent mathematician, try
and figure out what is going on. Write down a maths proof of the
theorem in this level. Exactly what statement do you want to prove
by induction? It is subtle.

Ok so here are some spoilers. The problem with naively running at it, is that if you try induction on,
say, $c$, then you are imagining a and b as fixed, and your inductive
hypothesis $P(c)$ is $ab=ac \implies b=c$. So for your inductive step
you will be able to assume $ab=ad \implies b=d$ and your goal will
be to show $ab=a(d+1) \implies b=d+1$. When you also assume $ab=a(d+1)$
you will realise that your inductive hypothesis is *useless*, because
$ab=ad$ is not true! The statement $P(c)$ (with $a$ and $b$ regarded
as constants) is not provable by induction.

What you *can* prove by induction is the following *stronger* statement.
Imagine $a\not=0$ as fixed, and then prove "for all $b$, if $ab=ac$ then $b=c$"
by induction on $c$. This gives us the extra flexibility we require.
Note that we are quantifying over all $b$ in the inductive hypothesis -- it
is essential that $b$ is not fixed.

You can do this in two ways in Lean -- before you start the induction
you can write `revert b,`. The `revert` tactic is the opposite of the `intro`
tactic; it replaces the `b` in the hypotheses with "for all $b$" in the goal.

Alternatively, you can write `induction c with d hd
generalizing b` as the first line of the proof.

If you do not modify your technique in this way, then this level seems
to be impossible (judging by the comments I've had about it!)
-/

/- Theorem
If $a \neq 0$, $b$ and $c$ are natural numbers such that
$ ab = ac, $
then $b = c$.
-/
theorem mul_left_cancel (a b c : mynat) (ha : a ≠ 0) : a * b = a * c → b = c :=
begin [nat_num_game]
  induction c with d hd generalizing b,
  { rw mul_zero,
    intro h,
    cases (eq_zero_or_eq_zero_of_mul_eq_zero _ _ h) with h1 h2,
      exfalso,
      apply ha,
      assumption,
    assumption
  },
  { intro hb,
    cases b with c,
    { rw mul_zero at hb,
      exfalso,
      apply ha,
      symmetry at hb,
      cases (eq_zero_or_eq_zero_of_mul_eq_zero _ _ hb) with h h,
        exact h,
      exfalso,
      exact succ_ne_zero _ h,
    },
    { have h : c = d,
        apply hd,
        rw mul_succ at hb,
        rw mul_succ at hb,
        apply add_right_cancel _ _ _ hb,
      rw h,
      refl,
    }
  }
end

end mynat -- hide

/-
You should now be ready for inequality world.
-/

/- Tactic : revert

## Summary

`revert x` is the opposite to `intro x`.

## Details

If the tactic state looks like this

```
P Q : Prop,
h : P
⊢ Q
```

then `revert h` will change it to

```
P Q : Prop
⊢ P → Q
```

`revert` also works with things like natural numbers: if
the tactic state looks like this

```
m : mynat
⊢ m + 1 = succ m
```

then `revert m` will turn it into

```
⊢ ∀ (m : mynat), m + 1 = mynat.succ m
```

-/


import topologia

open topological_space
open set

variables (X : Type) [topological_space X]

def is_dense {X : Type} [topological_space X] (A : set X) : Prop := closure A = univ

lemma dense_iff (A : set X) : is_dense A ↔ (interior (A.compl) = ∅) := -- why not Aᶜ?, then the refl, line it's not necesary
begin
  rw is_dense,
  rw closure_eq_compl_of_interior_compl,
  rw compl_univ_iff,
  refl,
end

lemma dense_iff' (A : set X) : is_dense A ↔
  ∀ x : X, ∀ U : set X, is_neighborhood U x → U ∩ A ≠ ∅ :=
begin
  unfold is_dense,
  split; intro h,
  {
    intros x U hUx,
    have hx : x ∈ closure A,
    {
      rw h,
      exact mem_univ x,
    },
    exact hx U hUx,
  },
  {
    simp only [closure_eq_compl_of_interior_compl, compl_univ_iff,
      set.eq_empty_iff_forall_not_mem, interior],
    intro x,
    intro hx,
    refine h x Aᶜ hx _,
    norm_num,
  },
end

def boundary {X : Type} [topological_space X] (A : set X) := closure A ∩ closure Aᶜ

lemma boundary_def (A : set X) : boundary A = (closure A) \ (interior A) :=
begin
  rw boundary,
  rw closure_eq_compl_of_interior_compl Aᶜ,
  rw compl_compl,
  refl,
end

lemma mem_boundary_iff (A : set X) (x : X) :
  x ∈ boundary A ↔ ∀ U : set X, is_neighborhood U x → (U ∩ A ≠ ∅ ∧ U ∩ A.compl ≠ ∅) :=
begin
  split; intro h,
  {
    intros U hU,
    exact ⟨h.1 U hU, h.2 U hU⟩,
  },
  {
    have hx: (is_adherent_point A x) ∧ (is_adherent_point Aᶜ x),
    {
      split; intros U hU,
        exact (h U hU).1,
        exact (h U hU).2,
    },
    exact ⟨hx.1, hx.2⟩,
  }
end

class kolmogorov_space : Prop :=
(t0 : ∀ (x y : X) (h : y ≠ x) , ∃ (U : set X) (hU : is_open U), ((x ∈ U) ∧ (y ∉ U)) ∨ ((x ∉ U) ∧ (y ∈ U)))

class frechet_space : Prop :=
(t1 : ∀ (x y : X) (h : y ≠ x), ∃ (U : set X) (hU : is_open U), (x ∈ U) ∧ (y ∉ U)) -- Marc : look up what's the best way to do this

namespace frechet_space

instance T1_is_T0 [frechet_space X] : kolmogorov_space X :=
{ t0 :=
begin
  intros x y hxy,
  obtain ⟨U, hU, hh⟩ := t1 x y hxy,
  use U,
  split,
  { exact hU },
  {
    left,
    exact hh,
  },
end
}

lemma T1_characterisation : frechet_space X ↔ (∀ (x : X), is_closed ({x} : set X)) :=
begin
  split,
  {
    intros h x,
    unfold is_closed,
    let I := {U : set X | (x ∉ U) ∧ (is_open U)},
    have p : ⋃₀ I = {x}ᶜ,
    {
      apply subset.antisymm; intros t ht,
      {
        rcases ht with ⟨A,⟨hxA, hA⟩, htA⟩,
        simp,
        intro htx,
        rw htx at htA,
        exact hxA htA,
      },
      {
        have htx := (mem_compl_singleton_iff.mp ht).symm,
        replace h := h.t1,
        obtain ⟨U, hU, hh⟩ := h t x htx,
        exact ⟨U, ⟨hh.2, hU⟩, hh.1⟩,
      }
    },
    rw ← p,
    have c : ∀ B ∈ I, is_open B,
      finish,
    exact topological_space.union I c,
  },
  {
    intros h,
    fconstructor,
    intros x y hxy,
    exact ⟨{y}ᶜ,h y, mem_compl_singleton_iff.mpr (ne.symm hxy), not_not.mpr rfl⟩,
  }
end

end frechet_space

class hausdorff_space :=
(t2 : ∀ (x y : X) (h : y ≠ x), ∃ (U V: set X) (hU : is_open U) (hV : is_open V) (hUV : U ∩ V = ∅), (x ∈ U) ∧ (y ∈ V))

namespace hausdorff_space

instance T2_is_T1 [hausdorff_space X] : frechet_space X :=
{ t1 :=
begin
  intros x y hxy,
  obtain ⟨U, V, hU, hV, hUV, hh⟩ := t2 x y hxy,
  rw inter_comm at hUV,
  exact ⟨U, hU, ⟨hh.1, (inter_is_not_is_empty_intersection hh.2 hUV)⟩⟩,
end }

end hausdorff_space

class T2_5_space : Prop :=
(t2_5 : ∀ (x y : X) (h : y ≠ x), ∃ (U V: set X), is_open U ∧  is_open V
  ∧ (closure U) ∩ (closure V) = ∅ ∧ x ∈ U ∧ y ∈ V)

namespace T2_5_space

instance T2_5_is_T2 [T2_5_space X] : hausdorff_space X :=
{ t2 :=
begin
  intros x y hxy,
  obtain ⟨U, V, hU, hV, hUV, hh⟩ := t2_5 x y hxy,
  have hUV₂ : U ∩ V = ∅,
  {
    apply subset.antisymm,
    {
      intros t h,
      rw ← hUV,
      exact ⟨(closure_supset_self U) h.1, (closure_supset_self V) h.2 ⟩,
    },
    {
      exact (U ∩ V).empty_subset,
    },
  },
  exact ⟨U, V, hU, hV, hUV₂, hh⟩,
end }

end T2_5_space

def topology_is_regular := ∀ (x : X) (F : set X) (hF : is_closed F) (hxF: x ∉ F),
  ∃ (U V : set X) (hU : is_open U) (hV : is_open V) (hUV : U ∩ V = ∅), (x ∈ U) ∧ (F ⊆ V)

class T3_space extends frechet_space X : Prop :=
(regular : topology_is_regular X)

namespace T3_space
open frechet_space
open hausdorff_space

instance T3_is_T2 [T3_space X] : hausdorff_space X :=
{ t2 :=
begin
  intros x y hxy,
  have H := (T1_characterisation X).1 _inst_2.to_frechet_space y,
  have x_notin_y : x ∉ ({y} : set X), by tauto,
  obtain ⟨U, V, hU, hV, hUV, hh⟩ := regular x ({y} : set X) H x_notin_y,
  rw singleton_subset_iff at hh,
  exact ⟨U, V, hU, ⟨hV, ⟨hUV, ⟨hh.1, hh.2⟩⟩⟩⟩,
end}

instance T3_is_T2_5 [T3_space X] : T2_5_space X :=
{ t2_5 :=
begin
  intros x y hxy,
  obtain ⟨U, V, hU, hV, hUV, hh⟩  := t2 x y hxy,
  have hxcV : x ∉ closure V,
  {
    rw closure_eq_compl_of_interior_compl V,
    have hxint := (interior_maximal Vᶜ U hU (subset_compl_iff_disjoint.mpr hUV)),
    tauto,
  },
  obtain ⟨A, B, hA, hB, hAB, hh2 ⟩ := regular x (closure V) (closure_is_closed V) hxcV,
  have t : closure A ∩ closure V = ∅,
  {
    have hBc : is_closed Bᶜ, by simp[hB],
    have hcA := subset.trans (subset_closed_inclusion_closure'  hBc (subset_compl_iff_disjoint.mpr hAB)) (compl_subset_compl.2 hh2.2),
    apply subset.antisymm,
    {
      rw ← compl_inter_self (closure V),
      exact (closure V).inter_subset_inter_left hcA,
    },
    exact (closure A ∩ closure V).empty_subset,
  },
  exact ⟨A, V, hA, hV, t, hh2.1, hh.2⟩,
end }

lemma T0_and_regular_is_T3 [kolmogorov_space X] (h: topology_is_regular X) :
  T3_space X :=
{
  t1 :=
  begin
    intros x y hxy,
    obtain ⟨U, hU, hh⟩ := kolmogorov_space.t0 x y hxy,
    cases hh,
      exact ⟨U, hU, hh⟩,
    {
      have hUc : is_closed Uᶜ,
      {
        rw [is_closed, compl_compl],
        exact hU,
      },
      have hy_not_Uc : y ∉ Uᶜ,
      {
        intro t,
        exact (not_mem_of_mem_compl t) hh.2,
      },
      obtain ⟨A, B, hA, hB, hAB, hhAB⟩ := h y Uᶜ hUc hy_not_Uc,
      exact ⟨B, hB, hhAB.2 hh.1, inter_is_not_is_empty_intersection hhAB.1 hAB⟩,
    }
  end,
  regular := h,
}

lemma T0_and_regular_if_only_if_T3 : (kolmogorov_space X) ∧ (topology_is_regular X) ↔ T3_space X :=
begin
  split; intro h,
    exact @T0_and_regular_is_T3 X _inst_1 h.1 h.2,
    exact ⟨@frechet_space.T1_is_T0 X _inst_1 (@hausdorff_space.T2_is_T1 X _inst_1 (@T3_space.T3_is_T2 X _inst_1 h)), h.regular⟩,
end

end T3_space

def is_normal (X : Type) [topological_space X] :=
  ∀ (F E : set X) (hF : is_closed F) (hE : is_closed E) (hEF : F ∩ E = ∅),
  ∃ (U V : set X) (hU : is_open U) (hV : is_open V) (hUV : U ∩ V = ∅), (F ⊆ U) ∧ (E ⊆ V)

class T4_space extends frechet_space X : Prop :=
(normal : is_normal X)

namespace T4_space
open frechet_space

instance T4_is_T3 [T4_space X] : T3_space X :=
{ regular :=
begin
  intros x F hF hxF,
  obtain ⟨U, V, hU, hV, hUV, hh ⟩ := normal F {x} hF ((T1_characterisation X).1 _inst_2.to_frechet_space x)
  (inter_singleton_eq_empty.mpr hxF),
  rw inter_comm U V at hUV,
  exact ⟨V, U, hV, hU, hUV, hh.2 (mem_singleton x), hh.1⟩,
end
}

end T4_space

class T5_space extends frechet_space X : Prop :=
(t5 : ∀ (A B : set X) (hAB : A ∩ (closure B) = ∅) (hBA : (closure A) ∩ B = ∅), ∃ (U V : set X) (hU : is_open U) (hV : is_open V) (hUV : U ∩ V = ∅), A ⊆ U ∧ B ⊆ V)

namespace T5_space
open frechet_space

instance T5_is_T4 [T5_space X] : T4_space X :=
{ normal :=
  begin
    intros F E hF hE hFE,
    have h₁ : (closure F) ∩ E = ∅,
      rwa ← ((eq_closure_iff_is_closed F).2 hF),
    have h₂ : F ∩ (closure E) = ∅,
      rwa ← ((eq_closure_iff_is_closed E).2 hE),
    exact t5 F E h₂ h₁,
  end}

end T5_space


/-
Copyright (c) 2022 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz

! This file was ported from Lean 3 source module ring_theory.valuation.extend_to_localization
! leanprover-community/mathlib commit 64b3576ff5bbac1387223e93988368644fcbcd7e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Localization.AtPrime
import Mathbin.RingTheory.Valuation.Basic

/-!

# Extending valuations to a localization

We show that, given a valuation `v` taking values in a linearly ordered commutative *group*
with zero `Γ`, and a submonoid `S` of `v.supp.prime_compl`, the valuation `v` can be naturally
extended to the localization `S⁻¹A`.

-/

variable {A : Type _} [CommRing A] {Γ : Type _} [LinearOrderedCommGroupWithZero Γ]
  (v : Valuation A Γ) {S : Submonoid A} (hS : S ≤ v.supp.primeCompl) (B : Type _) [CommRing B]
  [Algebra A B] [IsLocalization S B]

/-- We can extend a valuation `v` on a ring to a localization at a submonoid of
the complement of `v.supp`. -/
noncomputable def Valuation.extendToLocalization : Valuation B Γ :=
  let f := IsLocalization.toLocalizationMap S B
  let h : ∀ s : S, IsUnit (v.1.toMonoidHom s) := fun s => isUnit_iff_ne_zero.2 (hS s.2)
  { f.lift h with
    map_zero' := by convert f.lift_eq _ 0 <;> simp
    map_add_le_max' := fun x y =>
      by
      obtain ⟨a, b, s, rfl, rfl⟩ : ∃ (a b : A)(s : S), f.mk' a s = x ∧ f.mk' b s = y :=
        by
        obtain ⟨a, s, rfl⟩ := f.mk'_surjective x
        obtain ⟨b, t, rfl⟩ := f.mk'_surjective y
        use a * t, b * s, s * t
        constructor <;>
          · rw [f.mk'_eq_iff_eq, Submonoid.coe_mul]
            ring_nf
      convert_to f.lift h (f.mk' (a + b) s) ≤ max (f.lift h _) (f.lift h _)
      · refine' congr_arg (f.lift h) (IsLocalization.eq_mk'_iff_mul_eq.2 _)
        rw [add_mul, map_add]
        iterate 2 erw [IsLocalization.mk'_spec]
      iterate 3 rw [f.lift_mk']
      rw [max_mul_mul_right]
      apply mul_le_mul_right' (v.map_add a b) }
#align valuation.extend_to_localization Valuation.extendToLocalization

@[simp]
theorem Valuation.extendToLocalization_apply_map_apply (a : A) :
    v.extendToLocalization hS B (algebraMap A B a) = v a :=
  Submonoid.LocalizationMap.lift_eq _ _ a
#align valuation.extend_to_localization_apply_map_apply Valuation.extendToLocalization_apply_map_apply


import category_theory.basic
import misc.function

universes u v w y

class comm_ring (R: Type u) extends has_add R, has_mul R, has_one R, has_zero R, has_neg R :=
  (add_assoc : ∀ a b c : R, a + (b + c) = (a + b) + c)
  (add_comm : ∀ a b : R, a + b = b + a)
  (add_zero : ∀ a : R, a + 0 = a)
  (minus_inverse : ∀ a : R, a + (-a) = 0)
  (mul_assoc : ∀ a b c : R, a * (b * c) = (a * b) * c)
  (mul_comm : ∀ a b : R, a * b = b * a)
  (mul_one : ∀ a : R, a * 1 = a)
  (mul_dis : ∀ a b c : R, a * (b + c) = a * b + a * c)

namespace comm_ring

open list
open function

instance comm_ring_inhabited (R : Type u) [comm_ring R] : inhabited R := ⟨(0:R)⟩

/-
  Trival algebraic identities.
-/

def unit {R: Type u} [comm_ring R] (x : R) : Prop := ∃ a : R,  a * x = 1

theorem one_is_unit {R: Type u} [l:comm_ring R] : unit l.one :=
begin
  existsi l.one,
  rw mul_one,
end

theorem zero_unquie {R: Type u} [comm_ring R] : ∀ a : R, (∀ b : R, b + a = b) → a = 0 :=
begin
  intros a h,
  exact calc a = a + 0 : by rw add_zero
        ...    = 0 + a : by rw add_comm
        ...    = 0      : h 0
end

theorem one_unquie {R: Type u} [comm_ring R] : ∀ a : R, (∀ b : R, b * a = b) → a = 1 :=
begin
  intros a h,
  exact calc a = a * 1 : by rw mul_one
        ...    = 1 * a : by rw mul_comm
        ...    = 1      : h 1
end

theorem minus_unquie {R: Type u} [comm_ring R] : ∀ a b : R, a + b = 0 → b = -a :=
begin
  intros a b h,
  rw ← minus_inverse a at h,
  exact calc b = b + 0          : by rw  add_zero b
           ... = b + (a + (-a)) : by rw ← minus_inverse a
           ... = (b + a) + -a   : by rw add_assoc
           ... = (a + b) + -a   : by rw add_comm a b
           ... = (a + -a) + -a  : by rw ← h
           ... = (-a + a) + -a  : by simp [add_comm]
           ... = -a + 0         : by rw [← add_assoc,minus_inverse]
           ... = -a             : add_zero (-a)
end

theorem mul_zero {R : Type u} [l:comm_ring R] : ∀ a : R, a * 0 = 0 :=
begin
  intro a,
  have sub : (a * 0) + (a * 0) = a * 0,
  simp [←mul_dis,add_zero],
  exact calc a * 0 = (a * 0 + a * 0) + -(a * 0) : by simp [add_zero,minus_inverse,←add_assoc]
               ... = 0                          : by simp [sub,minus_inverse]
end

theorem mul_minus_one {R : Type u} [comm_ring R] : ∀ a : R, a * (-1) = -a :=
begin
  intro a,
  apply minus_unquie,
  exact calc a + a * -1 = a * (1 + (-1)) : by simp [mul_one,mul_dis]
                    ... = 0              : by simp [minus_inverse,mul_zero],
end

theorem minus_dis {R : Type u} [comm_ring R] : ∀ a b : R , -(a + b) = -a + -b :=
begin
  intros a b,
  symmetry,
  apply minus_unquie,
  exact calc (a + b) + (-a + -b) = a + (b + -a) + -b   : by simp [add_assoc]
                             ... = (a + -a) + (b + -b) : by {rw add_comm b (-a), simp [add_assoc]}
                             ... = 0                   : by rw [minus_inverse,minus_inverse,add_zero],
end

theorem minus_zero_zero {R : Type u} [l:comm_ring R] : -l.zero = l.zero :=
begin
  symmetry,
  apply minus_unquie,
  exact add_zero 0,
end

theorem minus_mul {R : Type u} [comm_ring R] : ∀ a b : R, -(a * b) = (-a) * b :=
begin
  intros a b,
  symmetry,
  apply minus_unquie,
  rw [mul_comm a b,mul_comm (-a) b,← mul_dis,minus_inverse,mul_zero],
end

lemma mul_assoc₄ {R : Type u} [comm_ring R]: ∀ r₁ r₂ r₃ r₄ : R ,
   r₁ * r₂ * (r₃ * r₄) = r₁ * (r₂ * r₃) * r₄ :=
begin
  intros r₁ r₂ r₃ r₄,
  simp[mul_assoc],
end

lemma add_assoc₄ {R : Type u} [comm_ring R]: ∀ r₁ r₂ r₃ r₄ : R ,
   r₁ + r₂ + (r₃ + r₄) = r₁ + (r₂ + r₃) + r₄ :=
begin
  intros r₁ r₂ r₃ r₄,
  simp[add_assoc],
end

theorem minus_minus {R : Type u} [comm_ring R] : ∀ x : R , -(-x) = x :=
begin
  intro x,
  symmetry,
  apply minus_unquie,
  rw add_comm,
  rw minus_inverse,
end

theorem zero_diff_equal {R : Type u} [comm_ring R] : ∀ {x y : R}, x + (-y) = 0 → x = y :=
begin
  intros x y h,
  exact calc x = x + 0        : by rw add_zero
           ... = x + (y + -y) : by rw minus_inverse
           ... = x + (-y + y) : by rw add_comm y (-y)
           ... = (x + -y) + y : by rw add_assoc
           ... = 0 + y        : by rw ←h
           ... = y            : by simp [add_comm,add_zero],
end

def pow {R : Type u} [comm_ring R] : R → ℕ → R
  | r nat.zero     := 1
  | r (nat.succ n) := r * (pow r n)

instance ring_has_pow {R: Type u} [comm_ring R] : has_pow R ℕ := ⟨pow⟩

lemma power_of_one {R : Type u} [comm_ring R] : ∀ a : R, a^1 = a :=
begin
  intro a,
  have trv : a^1 = a * 1 := rfl,
  rw [trv,mul_one],
end

lemma power_of_zero {R : Type u} [comm_ring R] : ∀ a : R, a^0 = 1 :=
begin
  intro a,
  refl,
end

lemma power_of_succ {R : Type u} [comm_ring R] (a : R) : ∀ n : ℕ, a^n.succ = a^n * a :=
begin
  intro n,
  rw mul_comm,
  refl,
end

lemma power_of_add {R : Type u} [comm_ring R] (a : R) : ∀ n m : ℕ, a^(n + m) = (a^n) * (a^m) :=
begin
  intros n m,
  induction m with m hm,
  rw [nat.add_zero n,power_of_zero,mul_one],
  rw [nat.add_succ,power_of_succ,power_of_succ,hm],
  rw mul_assoc,
end

lemma power_of_power {R : Type u} [comm_ring R] (a : R) : ∀ n m : ℕ, (a^n)^m = a^(n*m) :=
begin
  intros n m,
  induction m with m hm,
  rw [nat.mul_zero,power_of_zero,power_of_zero],
  rw [power_of_succ,nat.mul_succ,hm,power_of_add],
end

def nat_to_ring (R :Type u) [comm_ring R] : ℕ → R
  | 0            := 0
  | (nat.succ n) := 1 + nat_to_ring n

theorem minus_inj {R : Type u} [comm_ring R] : ∀ {x y : R}, -x = -y → x = y :=
begin
  intros x y h,
  exact calc x = x + 0 : by rw add_zero
           ... = x + (y + -y) : by rw ← minus_inverse
           ... = x + (-y + y) : by rw add_comm y
           ... = (x + -x) + y : by rw [← h, add_assoc]
           ... = 0 + y        : by rw [minus_inverse]
           ... = y            : by rw [add_comm,add_zero],
end

theorem add_midpoint {R : Type u} [comm_ring R] : ∀ (y x z : R), x + -z = (x + -y) + (y + -z) :=
begin
  intros y x z,
  rw [add_assoc₄,add_comm (-y),minus_inverse,add_zero],
end

def sum_list {R : Type u} [comm_ring R] : list R → R := foldr (λ a b : R, a + b) 0

def scale_list {R : Type u} [comm_ring R] : R → list R → list R := λ a, map (λ b: R, a * b)

def add_lists {R : Type u} [comm_ring R] : list R → list R → list R
  | (a :: as) (b :: bs) := (a + b) :: (add_lists as bs)
  | [] bs               := bs
  | as []               := as

notation `Σ₀` : 110 := sum_list

theorem mul_dis_finite_sum {R : Type u} [comm_ring R] : ∀ (a : R) (l : list R), a * (Σ₀ l) = Σ₀ (scale_list a l) :=
begin
  intros a l,
  induction l with b l hl,
  have trv₁ : (Σ₀ (@nil R)) = 0 := rfl,
  have trv₂ : scale_list a nil = nil := rfl,
  rw [trv₂,trv₁,mul_zero],
  have trv₁ : Σ₀ (b::l) = b + Σ₀ l := rfl,
  rw [trv₁,mul_dis,hl],
  refl,
end

inductive linear_combination {R : Type u} [comm_ring R] (S₁ : set R) (S₂ : set R): R → Prop
  | empty_sum : linear_combination 0
  | add_term (x : R) : ∀ s₁ s₂ l : R, s₁ ∈ S₁ → s₂ ∈ S₂ → linear_combination l → x = s₁ * s₂ + l → linear_combination x

structure ring_hom (R₁: Type u) (R₂ : Type v) [comm_ring R₁] [comm_ring R₂] : Type max u v :=
  (map : R₁ → R₂)
  (prevs_one : map 1 = 1)
  (prevs_mul : ∀ a b : R₁, map (a * b) = map a * map b)
  (prevs_add : ∀ a b : R₁, map (a + b) = map a + map b)

infixr `→ᵣ`:25 := ring_hom

instance ring_hom_to_function {R₁ : Type u} {R₂ : Type v} [comm_ring R₁] [comm_ring R₂] : has_coe_to_fun (R₁ →ᵣ R₂) (λ _, R₁ → R₂) := ⟨λ φ, φ.map⟩

def idᵣ {R : Type u} [comm_ring R] : R →ᵣ R :=
  {
    map := id,
    prevs_one := rfl,
    prevs_mul := λ _ _, rfl,
    prevs_add := λ _ _, rfl,
  }

lemma compose_prevs_mul {R₁ : Type u} {R₂ : Type v} {R₃ : Type w}[comm_ring R₁] [comm_ring R₂] [comm_ring R₃] (φ₁ : R₂ →ᵣ R₃) (φ₂ : R₁ →ᵣ R₂)
  : ∀ a b : R₁, (⇑φ₁ ∘ ⇑φ₂) (a * b) = (⇑φ₁ ∘ ⇑φ₂) a * (⇑φ₁ ∘ ⇑φ₂) b :=
begin
  intros a b,
  exact calc (⇑φ₁ ∘ ⇑φ₂) (a * b) = φ₁.map (φ₂.map (a * b))               : rfl
                             ... = φ₁.map (φ₂.map a) * φ₁.map (φ₂.map b) : by simp [φ₂.prevs_mul ,φ₁.prevs_mul]
                             ... = (⇑φ₁ ∘ ⇑φ₂) a * (⇑φ₁ ∘ ⇑φ₂) b         : rfl
end

lemma compose_prevs_add {R₁ : Type u} {R₂ : Type v} {R₃ : Type w}[comm_ring R₁] [comm_ring R₂] [comm_ring R₃] (φ₁ : R₂ →ᵣ R₃) (φ₂ : R₁ →ᵣ R₂)
  : ∀ a b : R₁, (⇑φ₁ ∘ ⇑φ₂) (a + b) = (⇑φ₁ ∘ ⇑φ₂) a + (⇑φ₁ ∘ ⇑φ₂) b :=
begin
  intros a b,
  exact calc (⇑φ₁ ∘ ⇑φ₂) (a + b) = φ₁.map (φ₂.map (a + b))               : rfl
                             ... = φ₁.map (φ₂.map a) + φ₁.map (φ₂.map b) : by simp [φ₂.prevs_add ,φ₁.prevs_add]
                             ... = (⇑φ₁ ∘ ⇑φ₂) a + (⇑φ₁ ∘ ⇑φ₂) b         : rfl
end

lemma compose_prevs_one {R₁ : Type u} {R₂ : Type v} {R₃ : Type w}[comm_ring R₁] [comm_ring R₂] [comm_ring R₃] (φ₁ : R₂ →ᵣ R₃) (φ₂ : R₁ →ᵣ R₂)
  : (⇑φ₁ ∘ ⇑φ₂) (1) = 1 :=
begin
  exact calc (⇑φ₁ ∘ ⇑φ₂) (1) = φ₁.map (φ₂.map (1)) : rfl
                         ... = 1                   : by simp [φ₂.prevs_one ,φ₁.prevs_one]
end

def ring_hom_comp {R₁ : Type u} {R₂ : Type v} {R₃ : Type w}[comm_ring R₁] [comm_ring R₂] [comm_ring R₃] (φ₁ : R₂ →ᵣ R₃) (φ₂ : R₁ →ᵣ R₂)
  : R₁ →ᵣ R₃ :=
  {
    map := ⇑φ₁ ∘ ⇑φ₂,
    prevs_one := compose_prevs_one φ₁ φ₂,
    prevs_add := compose_prevs_add φ₁ φ₂,
    prevs_mul := compose_prevs_mul φ₁ φ₂,
  }

infixr ` ∘ᵣ ` : 25 := ring_hom_comp

theorem ring_hom_preserves_zero {R₁ : Type u} {R₂ : Type v} [l₁ :comm_ring R₁] [l₂:comm_ring R₂] (φ : R₁ →ᵣ R₂) : φ 0 = 0 :=
begin
  have sub : φ 0 = φ 0 + φ 0,
    exact calc φ 0 = φ (0 + 0) : by rw add_zero
               ... = φ 0 + φ 0 : φ.prevs_add 0 0,
  symmetry,
  exact calc 0 = φ 0 + - φ 0        : by rw ← minus_inverse
           ... = (φ 0 + φ 0) + -φ 0 : by rw ← sub
           ... = φ 0                : by rw [← add_assoc, minus_inverse, add_zero],
end

lemma minus_commutes_with_hom {R₁ : Type u} {R₂ : Type v} [comm_ring R₁] [comm_ring R₂] (φ : R₁ →ᵣ R₂) : ∀ x : R₁, φ (-x) = - φ x :=
begin
  intro x,
  apply minus_unquie,
  have trv : φ.map = ⇑φ := rfl,
  rw [←trv, ← φ.prevs_add, minus_inverse,trv,ring_hom_preserves_zero],
end

theorem ring_hom_prevs_pow {R₁ : Type u} {R₂ : Type v} [comm_ring R₁] [comm_ring R₂] (φ : R₁ →ᵣ R₂) (n :ℕ)
  : ∀ x : R₁, φ (x^n) = (φ x)^n :=
begin
  intro x,
  induction n with n hn,
  simp [power_of_zero],
  exact φ.prevs_one,
  rw power_of_succ,
  have trv: ⇑φ = φ.map := rfl,
  simp [trv],
  rw φ.prevs_mul,
  simp [←trv],
  rw hn,
  rw ← power_of_succ,
end

theorem ring_hom_equality_hack {R₁ : Type u} [comm_ring R₁] {R₂ : Type v} [comm_ring R₂] {φ₁ φ₂: R₁ →ᵣ R₂}
: (⇑φ₁) = (φ₂.map) → φ₁ = φ₂ :=
begin
  intro h,
  cases φ₁,
  cases φ₂,
  rw ring_hom.mk.inj_eq,
  exact h,
end

theorem ring_hom_equality {R₁ : Type u} [comm_ring R₁] {R₂ : Type v} [comm_ring R₂] {φ₁ φ₂: R₁ →ᵣ R₂}
: (φ₁.map) = (φ₂.map) → φ₁ = φ₂ :=
begin
  intro h,
  cases φ₁,
  cases φ₂,
  rw ring_hom.mk.inj_eq,
  exact h,
end

def ring_isomorphism {R₁ : Type u} {R₂ : Type v} [comm_ring R₁] [comm_ring R₂] (φ : R₁ →ᵣ R₂) : Prop := ∃ ψ : R₂ →ᵣ R₁, (ψ ∘ᵣ φ) = idᵣ ∧ (φ ∘ᵣ ψ) = idᵣ

theorem ring_comp_assoc {R₁ : Type u} {R₂ : Type v} {R₃ : Type w} {R₄ : Type y} [comm_ring R₁]
  [comm_ring R₂] [comm_ring R₃] [comm_ring R₄] (φ₁ : R₃ →ᵣ R₄) (φ₂ : R₂ →ᵣ R₃) (φ₃ : R₁ →ᵣ R₂)
  : (φ₁ ∘ᵣ (φ₂ ∘ᵣ φ₃)) = ((φ₁ ∘ᵣ φ₂) ∘ᵣ φ₃) :=
begin
  apply ring_hom_equality,
  refl,
end

theorem id_hom_left_comp {R₁ : Type u} {R₂ : Type v} [comm_ring R₁] [comm_ring R₂] (φ : R₁ →ᵣ R₂)
  : (idᵣ ∘ᵣ φ) = φ :=
begin
  apply ring_hom_equality,
  refl,
end

theorem id_hom_right_comp {R₁ : Type u} {R₂ : Type v} [comm_ring R₁] [comm_ring R₂] (φ : R₁ →ᵣ R₂)
  : (φ ∘ᵣ idᵣ) = φ :=
begin
  apply ring_hom_equality,
  refl,
end

/-
  showing that a bijective ring hom is an isomorphism.
-/

theorem inverse_prevs_one {R₁ : Type u} {R₂ : Type v} [comm_ring R₁] [comm_ring R₂] {φ : R₁ →ᵣ R₂} {g : R₂ → R₁}
  : inverse g ⇑φ → g 1 = 1 :=
begin
  intro h,
  cases h with h₁ h₂,
  rw ←φ.prevs_one,
  have trv : φ.map = ⇑φ := rfl,
  rw [trv,← comp_app g (⇑φ), h₂],
  refl,
end

theorem inverse_prevs_mul {R₁ : Type u} {R₂ : Type v} [comm_ring R₁] [comm_ring R₂] {φ : R₁ →ᵣ R₂} {g : R₂ → R₁}
  : inverse g ⇑φ → ∀ a b : R₂, g (a * b) = (g a) * (g b) :=
begin
  intro h,
  have φinj : injective ⇑φ := inverse.injective h,
  cases h with h₁ h₂,
  intros a b,
  apply φinj,
  have trv : φ.map = ⇑φ := rfl,
  rw ← trv,
  rw φ.prevs_mul,
  rw trv,
  rw ← comp_app (⇑φ) g,
  rw ← comp_app (⇑φ) g,
  rw ← comp_app (⇑φ) g,
  simp [h₁],
end

theorem inverse_prevs_add {R₁ : Type u} {R₂ : Type v} [comm_ring R₁] [comm_ring R₂] {φ : R₁ →ᵣ R₂} {g : R₂ → R₁}
  : inverse g ⇑φ → ∀ a b : R₂, g (a + b) = (g a) + (g b) :=
begin
  intro h,
  have φinj : injective ⇑φ := inverse.injective h,
  cases h with h₁ h₂,
  intros a b,
  apply φinj,
  have trv : φ.map = ⇑φ := rfl,
  rw ← trv,
  rw φ.prevs_add,
  rw trv,
  rw ← comp_app (⇑φ) g,
  rw ← comp_app (⇑φ) g,
  rw ← comp_app (⇑φ) g,
  simp [h₁],
end

theorem bijective_ring_hom_ring_iso {R₁ : Type u} {R₂ : Type v} [comm_ring R₁] [comm_ring R₂] {φ : R₁ →ᵣ R₂}
  : bijective ⇑φ → ring_isomorphism φ :=
begin
  intro hφb,
  cases bijection_has_inverse hφb with g hg,
  let ghom : R₂ →ᵣ R₁,
    split,
    exact inverse_prevs_one hg,
    exact inverse_prevs_mul hg,
    exact inverse_prevs_add hg,
  have trv₁ : ⇑ghom = g := rfl,
  cases hg with hg₁ hg₂,
  existsi ghom,
  split,
  apply ring_hom_equality_hack,
  have trv₂ : ⇑(ghom ∘ᵣ φ) = ⇑ghom ∘ ⇑φ := rfl,
  rw [trv₂,trv₁,hg₂],
  refl,
  apply ring_hom_equality_hack,
  have trv₂ : ⇑(φ ∘ᵣ ghom) = φ ∘ ⇑ghom := rfl,
  rw [trv₂,trv₁,hg₁],
  refl,
end

end comm_ring