/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis, Chris Hughes
-/
import algebra.associated
import algebra.big_operators.basic
import ring_theory.valuation.basic
import data.nat.factorization.basic

/-!
# Multiplicity of a divisor

For a commutative monoid, this file introduces the notion of multiplicity of a divisor and proves
several basic results on it.

## Main definitions

* `multiplicity a b`: for two elements `a` and `b` of a commutative monoid returns the largest
  number `n` such that `a ^ n ∣ b` or infinity, written `⊤`, if `a ^ n ∣ b` for all natural numbers
  `n`.
* `multiplicity.finite a b`: a predicate denoting that the multiplicity of `a` in `b` is finite.
-/

variables {α : Type*}

open nat part
open_locale big_operators

/-- `multiplicity a b` returns the largest natural number `n` such that
  `a ^ n ∣ b`, as an `enat` or natural with infinity. If `∀ n, a ^ n ∣ b`,
  then it returns `⊤`-/
def multiplicity [comm_monoid α] [decidable_rel ((∣) : α → α → Prop)] (a b : α) : enat :=
enat.find $ λ n, ¬a ^ (n + 1) ∣ b

namespace multiplicity

section comm_monoid
variables [comm_monoid α]

/-- `multiplicity.finite a b` indicates that the multiplicity of `a` in `b` is finite. -/
@[reducible] def finite (a b : α) : Prop := ∃ n : ℕ, ¬a ^ (n + 1) ∣ b

lemma finite_iff_dom [decidable_rel ((∣) : α → α → Prop)] {a b : α} :
  finite a b ↔ (multiplicity a b).dom := iff.rfl

lemma finite_def {a b : α} : finite a b ↔ ∃ n : ℕ, ¬a ^ (n + 1) ∣ b := iff.rfl

@[norm_cast]
theorem int.coe_nat_multiplicity (a b : ℕ) :
    multiplicity (a : ℤ) (b : ℤ) = multiplicity a b :=
begin
  apply part.ext',
  { repeat { rw [← finite_iff_dom, finite_def] },
    norm_cast },
  { intros h1 h2,
    apply _root_.le_antisymm; { apply nat.find_mono, norm_cast, simp } }
end

lemma not_finite_iff_forall {a b : α} : (¬ finite a b) ↔ ∀ n : ℕ, a ^ n ∣ b :=
⟨λ h n, nat.cases_on n (by { rw pow_zero, exact one_dvd _ }) (by simpa [finite, not_not] using h),
  by simp [finite, multiplicity, not_not]; tauto⟩

lemma not_unit_of_finite {a b : α} (h : finite a b) : ¬is_unit a :=
let ⟨n, hn⟩ := h in mt (is_unit_iff_forall_dvd.1 ∘ is_unit.pow (n + 1)) $
λ h, hn (h b)

lemma finite_of_finite_mul_left {a b c : α} : finite a (b * c) → finite a c :=
λ ⟨n, hn⟩, ⟨n, λ h, hn (h.trans (by simp [mul_pow]))⟩

lemma finite_of_finite_mul_right {a b c : α} : finite a (b * c) → finite a b :=
by rw mul_comm; exact finite_of_finite_mul_left

variable [decidable_rel ((∣) : α → α → Prop)]

lemma pow_dvd_of_le_multiplicity {a b : α} {k : ℕ} : (k : enat) ≤ multiplicity a b → a ^ k ∣ b :=
by { rw ← enat.some_eq_coe, exact
nat.cases_on k (λ _, by { rw pow_zero, exact one_dvd _ })
  (λ k ⟨h₁, h₂⟩, by_contradiction (λ hk, (nat.find_min _ (lt_of_succ_le (h₂ ⟨k, hk⟩)) hk))) }

lemma pow_multiplicity_dvd {a b : α} (h : finite a b) : a ^ get (multiplicity a b) h ∣ b :=
pow_dvd_of_le_multiplicity (by rw enat.coe_get)

lemma is_greatest  {a b : α} {m : ℕ} (hm : multiplicity a b < m) : ¬a ^ m ∣ b :=
λ h, by rw [enat.lt_coe_iff] at hm; exact nat.find_spec hm.fst ((pow_dvd_pow _ hm.snd).trans h)

lemma is_greatest' {a b : α} {m : ℕ} (h : finite a b) (hm : get (multiplicity a b) h < m) :
  ¬a ^ m ∣ b :=
is_greatest (by rwa [← enat.coe_lt_coe, enat.coe_get] at hm)

lemma pos_of_dvd {a b : α} (hfin : finite a b) (hdiv : a ∣ b) : 0 < (multiplicity a b).get hfin :=
begin
  refine zero_lt_iff.2 (λ h, _),
  simpa [hdiv] using (is_greatest' hfin (lt_one_iff.mpr h)),
end

lemma unique {a b : α} {k : ℕ} (hk : a ^ k ∣ b) (hsucc : ¬a ^ (k + 1) ∣ b) :
  (k : enat) = multiplicity a b :=
le_antisymm (le_of_not_gt (λ hk', is_greatest hk' hk)) $
  have finite a b, from ⟨k, hsucc⟩,
  by { rw [enat.le_coe_iff], exact ⟨this, nat.find_min' _ hsucc⟩ }

lemma unique' {a b : α} {k : ℕ} (hk : a ^ k ∣ b) (hsucc : ¬ a ^ (k + 1) ∣ b) :
  k = get (multiplicity a b) ⟨k, hsucc⟩ :=
by rw [← enat.coe_inj, enat.coe_get, unique hk hsucc]

lemma pow_dvd_iff_le_multiplicity {a b : α}
  {k : ℕ} : a ^ k ∣ b ↔ (k : enat) ≤ multiplicity a b :=
⟨le_multiplicity_of_pow_dvd, pow_dvd_of_le_multiplicity⟩

lemma multiplicity_lt_iff_neg_dvd {a b : α} {k : ℕ} :
  multiplicity a b < (k : enat) ↔ ¬ a ^ k ∣ b :=
by { rw [pow_dvd_iff_le_multiplicity, not_le] }

lemma eq_coe_iff {a b : α} {n : ℕ} :
  multiplicity a b = (n : enat) ↔ a ^ n ∣ b ∧ ¬a ^ (n + 1) ∣ b :=
begin
  rw [← enat.some_eq_coe],
  exact ⟨λ h, let ⟨h₁, h₂⟩ := eq_some_iff.1 h in
      h₂ ▸ ⟨pow_multiplicity_dvd _, is_greatest
        (by { rw [enat.lt_coe_iff], exact ⟨h₁, lt_succ_self _⟩ })⟩,
    λ h, eq_some_iff.2 ⟨⟨n, h.2⟩, eq.symm $ unique' h.1 h.2⟩⟩
end

lemma eq_top_iff {a b : α} :
  multiplicity a b = ⊤ ↔ ∀ n : ℕ, a ^ n ∣ b :=
(enat.find_eq_top_iff _).trans $
by { simp only [not_not],
     exact ⟨λ h n, nat.cases_on n (by { rw pow_zero, exact one_dvd _}) (λ n, h _), λ h n, h _⟩ }

@[simp] lemma is_unit_left {a : α} (b : α) (ha : is_unit a) : multiplicity a b = ⊤ :=
eq_top_iff.2 (λ _, is_unit_iff_forall_dvd.1 (ha.pow _) _)

lemma is_unit_right {a b : α} (ha : ¬is_unit a) (hb : is_unit b) :
  multiplicity a b = 0 :=
eq_coe_iff.2 ⟨show a ^ 0 ∣ b, by simp only [pow_zero, one_dvd],
  by { rw pow_one, exact λ h, mt (is_unit_of_dvd_unit h) ha hb }⟩

@[simp] lemma one_left (b : α) : multiplicity 1 b = ⊤ := is_unit_left b is_unit_one

lemma one_right {a : α} (ha : ¬is_unit a) : multiplicity a 1 = 0 := is_unit_right ha is_unit_one

@[simp] lemma get_one_right {a : α} (ha : finite a 1) : get (multiplicity a 1) ha = 0 :=
begin
  rw [enat.get_eq_iff_eq_coe, eq_coe_iff, pow_zero],
  simpa [is_unit_iff_dvd_one.symm] using not_unit_of_finite ha,
end

@[simp] lemma unit_left (a : α) (u : αˣ) : multiplicity (u : α) a = ⊤ :=
is_unit_left a u.is_unit

lemma unit_right {a : α} (ha : ¬is_unit a) (u : αˣ) : multiplicity a u = 0 :=
is_unit_right ha u.is_unit

lemma multiplicity_eq_zero_of_not_dvd {a b : α} (ha : ¬a ∣ b) : multiplicity a b = 0 :=
by { rw [← nat.cast_zero, eq_coe_iff], simpa }

lemma eq_top_iff_not_finite {a b : α} : multiplicity a b = ⊤ ↔ ¬ finite a b :=
part.eq_none_iff'

lemma ne_top_iff_finite {a b : α} : multiplicity a b ≠ ⊤ ↔ finite a b :=
by rw [ne.def, eq_top_iff_not_finite, not_not]

lemma lt_top_iff_finite {a b : α} : multiplicity a b < ⊤ ↔ finite a b :=
by rw [lt_top_iff_ne_top, ne_top_iff_finite]

lemma exists_eq_pow_mul_and_not_dvd {a b : α} (hfin : finite a b) :
  ∃ (c : α), b = a ^ ((multiplicity a b).get hfin) * c ∧ ¬ a ∣ c :=
begin
  obtain ⟨c, hc⟩ := multiplicity.pow_multiplicity_dvd hfin,
  refine ⟨c, hc, _⟩,
  rintro ⟨k, hk⟩,
  rw [hk, ← mul_assoc, ← pow_succ'] at hc,
  have h₁ : a ^ ((multiplicity a b).get hfin + 1) ∣ b := ⟨k, hc⟩,
  exact (multiplicity.eq_coe_iff.1 (by simp)).2 h₁,
end

open_locale classical

lemma multiplicity_le_multiplicity_iff {a b c d : α} : multiplicity a b ≤ multiplicity c d ↔
  (∀ n : ℕ, a ^ n ∣ b → c ^ n ∣ d) :=
⟨λ h n hab, (pow_dvd_of_le_multiplicity (le_trans (le_multiplicity_of_pow_dvd hab) h)),
  λ h, if hab : finite a b
    then by rw [← enat.coe_get (finite_iff_dom.1 hab)];
      exact le_multiplicity_of_pow_dvd (h _ (pow_multiplicity_dvd _))
    else
    have ∀ n : ℕ, c ^ n ∣ d, from λ n, h n (not_finite_iff_forall.1 hab _),
    by rw [eq_top_iff_not_finite.2 hab, eq_top_iff_not_finite.2
      (not_finite_iff_forall.2 this)]⟩

lemma multiplicity_le_multiplicity_of_dvd_left {a b c : α} (hdvd : a ∣ b) :
  multiplicity b c ≤ multiplicity a c :=
multiplicity_le_multiplicity_iff.2 $ λ n h, (pow_dvd_pow_of_dvd hdvd n).trans h

lemma eq_of_associated_left {a b c : α} (h : associated a b) :
  multiplicity b c = multiplicity a c :=
le_antisymm (multiplicity_le_multiplicity_of_dvd_left h.dvd)
  (multiplicity_le_multiplicity_of_dvd_left h.symm.dvd)

lemma multiplicity_le_multiplicity_of_dvd_right {a b c : α} (h : b ∣ c) :
  multiplicity a b ≤ multiplicity a c :=
multiplicity_le_multiplicity_iff.2 $ λ n hb, hb.trans h

lemma eq_of_associated_right {a b c : α} (h : associated b c) :
  multiplicity a b = multiplicity a c :=
le_antisymm (multiplicity_le_multiplicity_of_dvd_right h.dvd)
  (multiplicity_le_multiplicity_of_dvd_right h.symm.dvd)

lemma dvd_of_multiplicity_pos {a b : α} (h : (0 : enat) < multiplicity a b) : a ∣ b :=
begin
  rw ← pow_one a,
  apply pow_dvd_of_le_multiplicity,
  simpa only [nat.cast_one, enat.pos_iff_one_le] using h
end

lemma dvd_iff_multiplicity_pos {a b : α} : (0 : enat) < multiplicity a b ↔ a ∣ b :=
⟨dvd_of_multiplicity_pos,
  λ hdvd, lt_of_le_of_ne (zero_le _) (λ heq, is_greatest
    (show multiplicity a b < ↑1,
      by simpa only [heq, nat.cast_zero] using enat.coe_lt_coe.mpr zero_lt_one)
    (by rwa pow_one a))⟩

lemma finite_nat_iff {a b : ℕ} : finite a b ↔ (a ≠ 1 ∧ 0 < b) :=
begin
  rw [← not_iff_not, not_finite_iff_forall, not_and_distrib, ne.def,
    not_not, not_lt, nat.le_zero_iff],
  exact ⟨λ h, or_iff_not_imp_right.2 (λ hb,
    have ha : a ≠ 0, from λ ha, by simpa [ha] using h 1,
    by_contradiction (λ ha1 : a ≠ 1,
      have ha_gt_one : 1 < a, from
        lt_of_not_ge (λ ha', by { clear h, revert ha ha1, dec_trivial! }),
      not_lt_of_ge (le_of_dvd (nat.pos_of_ne_zero hb) (h b))
          (lt_pow_self ha_gt_one b))),
    λ h, by cases h; simp *⟩
end

alias dvd_iff_multiplicity_pos ↔ _ has_dvd.dvd.multiplicity_pos

end comm_monoid

section comm_monoid_with_zero

variable [comm_monoid_with_zero α]

lemma ne_zero_of_finite {a b : α} (h : finite a b) : b ≠ 0 :=
let ⟨n, hn⟩ := h in λ hb, by simpa [hb] using hn

variable [decidable_rel ((∣) : α → α → Prop)]

@[simp] protected lemma zero (a : α) : multiplicity a 0 = ⊤ :=
part.eq_none_iff.2 (λ n ⟨⟨k, hk⟩, _⟩, hk (dvd_zero _))

@[simp] lemma multiplicity_zero_eq_zero_of_ne_zero (a : α) (ha : a ≠ 0) : multiplicity 0 a = 0 :=
begin
  apply multiplicity.multiplicity_eq_zero_of_not_dvd,
  rwa zero_dvd_iff,
end

end comm_monoid_with_zero

section comm_semiring

variables [comm_semiring α] [decidable_rel ((∣) : α → α → Prop)]

lemma min_le_multiplicity_add {p a b : α} :
  min (multiplicity p a) (multiplicity p b) ≤ multiplicity p (a + b) :=
(le_total (multiplicity p a) (multiplicity p b)).elim
  (λ h, by rw [min_eq_left h, multiplicity_le_multiplicity_iff];
    exact λ n hn, dvd_add hn (multiplicity_le_multiplicity_iff.1 h n hn))
  (λ h, by rw [min_eq_right h, multiplicity_le_multiplicity_iff];
    exact λ n hn, dvd_add (multiplicity_le_multiplicity_iff.1 h n hn) hn)

end comm_semiring

section comm_ring

variables [comm_ring α] [decidable_rel ((∣) : α → α → Prop)]

open_locale classical

@[simp] protected lemma neg (a b : α) : multiplicity a (-b) = multiplicity a b :=
part.ext' (by simp only [multiplicity, enat.find, dvd_neg])
  (λ h₁ h₂, enat.coe_inj.1 (by rw [enat.coe_get]; exact
    eq.symm (unique ((dvd_neg _ _).2 (pow_multiplicity_dvd _))
      (mt (dvd_neg _ _).1 (is_greatest' _ (lt_succ_self _))))))

theorem int.nat_abs (a : ℕ) (b : ℤ) : multiplicity a b.nat_abs = multiplicity (a : ℤ) b :=
begin
  cases int.nat_abs_eq b with h h; conv_rhs { rw h },
  { rw [int.coe_nat_multiplicity], },
  { rw [multiplicity.neg, int.coe_nat_multiplicity], },
end

lemma multiplicity_add_of_gt {p a b : α} (h : multiplicity p b < multiplicity p a) :
  multiplicity p (a + b) = multiplicity p b :=
begin
  apply le_antisymm,
  { apply enat.le_of_lt_add_one,
    cases enat.ne_top_iff.mp (enat.ne_top_of_lt h) with k hk,
    rw [hk], rw_mod_cast [multiplicity_lt_iff_neg_dvd], intro h_dvd,
    rw [← dvd_add_iff_right] at h_dvd,
    apply multiplicity.is_greatest _ h_dvd, rw [hk], apply_mod_cast nat.lt_succ_self,
    rw [pow_dvd_iff_le_multiplicity, nat.cast_add, ← hk, nat.cast_one],
    exact enat.add_one_le_of_lt h },
  { convert min_le_multiplicity_add, rw [min_eq_right (le_of_lt h)] }
end

lemma multiplicity_sub_of_gt {p a b : α} (h : multiplicity p b < multiplicity p a) :
  multiplicity p (a - b) = multiplicity p b :=
by { rw [sub_eq_add_neg, multiplicity_add_of_gt]; rwa [multiplicity.neg] }

lemma multiplicity_add_eq_min {p a b : α} (h : multiplicity p a ≠ multiplicity p b) :
  multiplicity p (a + b) = min (multiplicity p a) (multiplicity p b) :=
begin
  rcases lt_trichotomy (multiplicity p a) (multiplicity p b) with hab|hab|hab,
  { rw [add_comm, multiplicity_add_of_gt hab, min_eq_left], exact le_of_lt hab },
  { contradiction },
  { rw [multiplicity_add_of_gt hab, min_eq_right], exact le_of_lt hab},
end

end comm_ring

section cancel_comm_monoid_with_zero

variables [cancel_comm_monoid_with_zero α]

lemma finite_mul_aux {p : α} (hp : prime p) : ∀ {n m : ℕ} {a b : α},
  ¬p ^ (n + 1) ∣ a → ¬p ^ (m + 1) ∣ b → ¬p ^ (n + m + 1) ∣ a * b
| n m := λ a b ha hb ⟨s, hs⟩,
  have p ∣ a * b, from ⟨p ^ (n + m) * s,
    by simp [hs, pow_add, mul_comm, mul_assoc, mul_left_comm]⟩,
  (hp.2.2 a b this).elim
    (λ ⟨x, hx⟩, have hn0 : 0 < n,
        from nat.pos_of_ne_zero (λ hn0, by clear _fun_match _fun_match; simpa [hx, hn0] using ha),
      have wf : (n - 1) < n, from tsub_lt_self hn0 dec_trivial,
      have hpx : ¬ p ^ (n - 1 + 1) ∣ x,
        from λ ⟨y, hy⟩, ha (hx.symm ▸ ⟨y, mul_right_cancel₀ hp.1
          $ by rw [tsub_add_cancel_of_le (succ_le_of_lt hn0)] at hy;
            simp [hy, pow_add, mul_comm, mul_assoc, mul_left_comm]⟩),
      have 1 ≤ n + m, from le_trans hn0 (nat.le_add_right n m),
      finite_mul_aux hpx hb ⟨s, mul_right_cancel₀ hp.1 begin
          rw [tsub_add_eq_add_tsub (succ_le_of_lt hn0), tsub_add_cancel_of_le this],
          clear _fun_match _fun_match finite_mul_aux,
          simp [*, mul_comm, mul_assoc, mul_left_comm, pow_add] at *
        end⟩)
    (λ ⟨x, hx⟩, have hm0 : 0 < m,
        from nat.pos_of_ne_zero (λ hm0, by clear _fun_match _fun_match; simpa [hx, hm0] using hb),
      have wf : (m - 1) < m, from tsub_lt_self hm0 dec_trivial,
      have hpx : ¬ p ^ (m - 1 + 1) ∣ x,
        from λ ⟨y, hy⟩, hb (hx.symm ▸ ⟨y, mul_right_cancel₀ hp.1
          $ by rw [tsub_add_cancel_of_le (succ_le_of_lt hm0)] at hy;
            simp [hy, pow_add, mul_comm, mul_assoc, mul_left_comm]⟩),
      finite_mul_aux ha hpx ⟨s, mul_right_cancel₀ hp.1 begin
          rw [add_assoc, tsub_add_cancel_of_le (succ_le_of_lt hm0)],
          clear _fun_match _fun_match finite_mul_aux,
          simp [*, mul_comm, mul_assoc, mul_left_comm, pow_add] at *
        end⟩)

lemma finite_mul {p a b : α} (hp : prime p) : finite p a → finite p b → finite p (a * b) :=
λ ⟨n, hn⟩ ⟨m, hm⟩, ⟨n + m, finite_mul_aux hp hn hm⟩

lemma finite_mul_iff {p a b : α} (hp : prime p) : finite p (a * b) ↔ finite p a ∧ finite p b :=
⟨λ h, ⟨finite_of_finite_mul_right h, finite_of_finite_mul_left h⟩,
  λ h, finite_mul hp h.1 h.2⟩

lemma finite_pow {p a : α} (hp : prime p) : Π {k : ℕ} (ha : finite p a), finite p (a ^ k)
| 0     ha := ⟨0, by simp [mt is_unit_iff_dvd_one.2 hp.2.1]⟩
| (k+1) ha := by rw [pow_succ]; exact finite_mul hp ha (finite_pow ha)

variable [decidable_rel ((∣) : α → α → Prop)]

@[simp] lemma multiplicity_self {a : α} (ha : ¬is_unit a) (ha0 : a ≠ 0) :
  multiplicity a a = 1 :=
by { rw ← nat.cast_one, exact
eq_coe_iff.2 ⟨by simp, λ ⟨b, hb⟩, ha (is_unit_iff_dvd_one.2
  ⟨b, mul_left_cancel₀ ha0 $ by { clear _fun_match,
    simpa [pow_succ, mul_assoc] using hb }⟩)⟩ }

@[simp] lemma get_multiplicity_self {a : α} (ha : finite a a) :
  get (multiplicity a a) ha = 1 :=
enat.get_eq_iff_eq_coe.2 (eq_coe_iff.2
  ⟨by simp, λ ⟨b, hb⟩,
    by rw [← mul_one a, pow_add, pow_one, mul_assoc, mul_assoc,
        mul_right_inj' (ne_zero_of_finite ha)] at hb;
      exact mt is_unit_iff_dvd_one.2 (not_unit_of_finite ha)
        ⟨b, by clear _fun_match; simp * at *⟩⟩)

protected lemma mul' {p a b : α} (hp : prime p)
  (h : (multiplicity p (a * b)).dom) :
  get (multiplicity p (a * b)) h =
  get (multiplicity p a) ((finite_mul_iff hp).1 h).1 +
  get (multiplicity p b) ((finite_mul_iff hp).1 h).2 :=
have hdiva : p ^ get (multiplicity p a) ((finite_mul_iff hp).1 h).1 ∣ a,
  from pow_multiplicity_dvd _,
have hdivb : p ^ get (multiplicity p b) ((finite_mul_iff hp).1 h).2 ∣ b,
  from pow_multiplicity_dvd _,
have hpoweq : p ^ (get (multiplicity p a) ((finite_mul_iff hp).1 h).1 +
    get (multiplicity p b) ((finite_mul_iff hp).1 h).2) =
    p ^ get (multiplicity p a) ((finite_mul_iff hp).1 h).1 *
    p ^ get (multiplicity p b) ((finite_mul_iff hp).1 h).2,
  by simp [pow_add],
have hdiv : p ^ (get (multiplicity p a) ((finite_mul_iff hp).1 h).1 +
    get (multiplicity p b) ((finite_mul_iff hp).1 h).2) ∣ a * b,
  by rw [hpoweq]; apply mul_dvd_mul; assumption,
have hsucc : ¬p ^ ((get (multiplicity p a) ((finite_mul_iff hp).1 h).1 +
    get (multiplicity p b) ((finite_mul_iff hp).1 h).2) + 1) ∣ a * b,
  from λ h, by exact
    not_or (is_greatest' _ (lt_succ_self _)) (is_greatest' _ (lt_succ_self _))
      (_root_.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul hp hdiva hdivb h),
by rw [← enat.coe_inj, enat.coe_get, eq_coe_iff];
  exact ⟨hdiv, hsucc⟩

open_locale classical

protected lemma mul {p a b : α} (hp : prime p) :
  multiplicity p (a * b) = multiplicity p a + multiplicity p b :=
if h : finite p a ∧ finite p b then
by rw [← enat.coe_get (finite_iff_dom.1 h.1), ← enat.coe_get (finite_iff_dom.1 h.2),
  ← enat.coe_get (finite_iff_dom.1 (finite_mul hp h.1 h.2)),
    ← nat.cast_add, enat.coe_inj, multiplicity.mul' hp]; refl
else begin
  rw [eq_top_iff_not_finite.2 (mt (finite_mul_iff hp).1 h)],
  cases not_and_distrib.1 h with h h;
    simp [eq_top_iff_not_finite.2 h]
end

lemma finset.prod {β : Type*} {p : α} (hp : prime p) (s : finset β) (f : β → α) :
  multiplicity p (∏ x in s, f x) = ∑ x in s, multiplicity p (f x) :=
begin
  classical,
  induction s using finset.induction with a s has ih h,
  { simp only [finset.sum_empty, finset.prod_empty],
    convert one_right hp.not_unit },
  { simp [has, ← ih],
    convert multiplicity.mul hp }
end

protected lemma pow' {p a : α} (hp : prime p) (ha : finite p a) : ∀ {k : ℕ},
  get (multiplicity p (a ^ k)) (finite_pow hp ha) = k * get (multiplicity p a) ha
| 0     := by simp [one_right hp.not_unit]
| (k+1) := have multiplicity p (a ^ (k + 1)) = multiplicity p (a * a ^ k), by rw pow_succ,
    by rw [get_eq_get_of_eq _ _ this, multiplicity.mul' hp, pow', add_mul, one_mul, add_comm]

lemma pow {p a : α} (hp : prime p) : ∀ {k : ℕ},
  multiplicity p (a ^ k) = k • (multiplicity p a)
| 0        := by simp [one_right hp.not_unit]
| (succ k) := by simp [pow_succ, succ_nsmul, pow, multiplicity.mul hp]

lemma multiplicity_pow_self {p : α} (h0 : p ≠ 0) (hu : ¬ is_unit p) (n : ℕ) :
  multiplicity p (p ^ n) = n :=
by { rw [eq_coe_iff], use dvd_rfl, rw [pow_dvd_pow_iff h0 hu], apply nat.not_succ_le_self }

lemma multiplicity_pow_self_of_prime {p : α} (hp : prime p) (n : ℕ) :
  multiplicity p (p ^ n) = n :=
multiplicity_pow_self hp.ne_zero hp.not_unit n

end cancel_comm_monoid_with_zero

section valuation

variables {R : Type*} [comm_ring R] [is_domain R] {p : R}
  [decidable_rel (has_dvd.dvd : R → R → Prop)]

/-- `multiplicity` of a prime inan integral domain as an additive valuation to `enat`. -/
noncomputable def add_valuation (hp : prime p) : add_valuation R enat :=
add_valuation.of (multiplicity p) (multiplicity.zero _) (one_right hp.not_unit)
  (λ _ _, min_le_multiplicity_add) (λ a b, multiplicity.mul hp)

@[simp]
lemma add_valuation_apply {hp : prime p} {r : R} : add_valuation hp r = multiplicity p r := rfl

end valuation

end multiplicity

section nat
open multiplicity

lemma multiplicity_eq_zero_of_coprime {p a b : ℕ} (hp : p ≠ 1)
  (hle : multiplicity p a ≤ multiplicity p b)
  (hab : nat.coprime a b) : multiplicity p a = 0 :=
begin
  rw [multiplicity_le_multiplicity_iff] at hle,
  rw [← nonpos_iff_eq_zero, ← not_lt, enat.pos_iff_one_le, ← nat.cast_one,
    ← pow_dvd_iff_le_multiplicity],
  assume h,
  have := nat.dvd_gcd h (hle _ h),
  rw [coprime.gcd_eq_one hab, nat.dvd_one, pow_one] at this,
  exact hp this
end

lemma multiplicity_eq_factorization {n p : ℕ} (pp : p.prime) (hn : n ≠ 0) :
  multiplicity p n = n.factorization p :=
multiplicity.eq_coe_iff.mpr ⟨pow_factorization_dvd n p, pow_succ_factorization_not_dvd hn pp⟩

@[to_additive sum_factors_gcd_add_sum_factors_mul]
lemma prod_factors_gcd_mul_prod_factors_mul {β : Type*} [comm_monoid β] (m n : ℕ) (f : ℕ → β) :
  (m.gcd n).factors.to_finset.prod f * (m * n).factors.to_finset.prod f
    = m.factors.to_finset.prod f * n.factors.to_finset.prod f :=
begin
  rcases eq_or_ne n 0 with rfl | hm0, { simp },
  rcases eq_or_ne m 0 with rfl | hn0, { simp },
  rw [←@finset.prod_union_inter _ _ m.factors.to_finset n.factors.to_finset, mul_comm],
  congr,
  { apply factors_mul_to_finset; assumption },
  { simp only [←support_factorization, factorization_gcd hn0 hm0, finsupp.support_inf] },
end

end nat


import analysis.topology.topological_space
import analysis.topology.continuity
import analysis.topology.topological_structures
import data.set.basic
import analysis.real
import tactic.wlog
import connected_space

open set
open function
open tactic

universes u v

section intervals

variables {α : Type*} [partial_order α] {i : set α}

/-- an interval is a convex set -/
def interval (i : set α) : Prop := ∀x y z, x ∈ i → z ∈ i → x ≤ y → y ≤ z → y ∈ i

/-- Left-open right-closed interval -/
def Ioc (a b : α) := {x | a < x ∧ x ≤ b}

/-- Left-infinite right-open interval -/
def Iic (a : α) := {x | x ≤ a}

/-- Left-open right-infinite interval -/
def Ioi (b : α) := {x | b < x}

lemma Iio_inter_Ioi_empty {b : ℝ} : Iio b ∩ Ioi b = ∅ :=
classical.by_contradiction
    (assume h : Iio b ∩ Ioi b ≠ ∅,
    let ⟨x, _⟩ := exists_mem_of_ne_empty h in
    have x < b, from mem_of_mem_inter_left  ‹x ∈ Iio b ∩ Ioi b›,
    have b < x, from mem_of_mem_inter_right ‹x ∈ Iio b ∩ Ioi b›,
    show false, from not_le_of_lt ‹x < b› (le_of_lt ‹b < x›))

lemma neg_Ioi_eq_Iio {b : ℝ} : (λ (x : ℝ), -x)⁻¹' (Iio (-b)) = Ioi b := sorry

lemma is_open_Ioi {b : ℝ} : is_open (Ioi b) :=
let neg := λ (x : ℝ), -x in
have continuous neg, from topological_ring.continuous_neg ℝ,
@neg_Ioi_eq_Iio b ▸ ‹continuous neg› (Iio (-b)) is_open_Iio

--Classification of bounded above intervals
lemma exists_smaller_of_not_bounded_below {i : set ℝ} (_ : ¬bdd_below i) (x : ℝ) : ∃ y ∈ i, y ≤ x :=
have h : ∀ y, ¬∀ z ∈ i, y ≤ z, by rw [←not_exists]; assumption,
have ¬∀ z ∈ i, x ≤ z, from h x,
have ∃ z, ¬(z ∈ i → x ≤ z), by rw [←classical.not_forall]; assumption,
let ⟨z, h1⟩ := this in
have h2 : z ∈ i ∧ ¬x ≤ z, from (@not_imp _ _ (classical.dec (z ∈ i))).mp h1,
⟨z, h2.left, le_of_not_le h2.right⟩

lemma exists_real_between {x y : ℝ} (_ : x < y) : ∃z, x < z ∧ z < y :=
suffices Ioo x y ≠ ∅, from exists_mem_of_ne_empty this,
mt Ioo_eq_empty_iff.mp (not_le_of_lt ‹x < y›)

theorem exists_inf (S : set ℝ) : (∃ x, x ∈ S) → (∃ x, ∀ y ∈ S, x ≤ y) →
  ∃ x, ∀ y, y ≤ x ↔ ∀ z ∈ S, y ≤ z := sorry

lemma mem_nbhd_sup_of_right_open {i : set ℝ} {x sup : ℝ} (_ : sup ∉ i) (_ : x < sup)
  (bound_iff_ge_sup : ∀ b, sup ≤ b ↔ ∀ y ∈ i, y ≤ b) : ∃ z ∈ i, x ≤ z :=
have le_sup : ∀ x ∈ i, x ≤ sup, from (bound_iff_ge_sup sup).mp (le_refl sup),
have i ∩ Ioo x sup ≠ ∅, from
  assume _ : i ∩ Ioo x sup = ∅, --show that a smaller supremum exists
  let ⟨sup2, _⟩ := exists_real_between ‹x < sup› in
  have ∀ z ∈ i, z ≤ sup2, from
    assume z,
    assume _ : z ∈ i,
    le_of_not_lt $
      assume _ : z > sup2,
      have z ≠ sup, from assume _ : z = sup, ‹sup ∉ i› $ ‹z = sup› ▸ ‹z ∈ i›,
      have z < sup, from lt_of_le_of_ne (le_sup z ‹z ∈ i›) ‹z ≠ sup›,
      have z ∈ Ioo x sup, from ⟨lt_trans ‹x < sup2 ∧ sup2 < sup›.left ‹sup2 < z›, ‹z < sup›⟩,
      have z ∈ i ∩ Ioo x sup, from mem_inter ‹z ∈ i› ‹z ∈ Ioo x sup›,
      show false, from eq_empty_iff_forall_not_mem.mp ‹i ∩ Ioo x sup = ∅› z ‹z ∈ i ∩ Ioo x sup›,
have sup ≤ sup2, from (bound_iff_ge_sup sup2).mpr this,
show false, from (not_le_of_lt ‹x < sup2 ∧ sup2 < sup›.right) ‹sup ≤ sup2›,
let ⟨z, _⟩ := exists_mem_of_ne_empty ‹i ∩ Ioo x sup ≠ ∅› in
have z ∈ i, from mem_of_mem_inter_left ‹z ∈ i ∩ Ioo x sup›,
have x ≤ z, from le_of_lt (mem_of_mem_inter_right ‹z ∈ i ∩ Ioo x sup›).left,
⟨z, ‹z ∈ i›, ‹x ≤ z›⟩

lemma mem_nbhd_inf_of_left_open {i : set ℝ} {x inf : ℝ} (_ : inf ∉ i) (_ : inf < x)
  (bound_iff_le_inf : ∀ b, b ≤ inf ↔ ∀ y ∈ i, b ≤ y) : ∃ z ∈ i, z ≤ x := sorry

theorem bdd_above_interval_iff {i : set ℝ} (_ : bdd_above i) (_ : i ≠ ∅) : interval i ↔
∃b, i = Iic b ∨ i = Iio b ∨ ∃a, i = Icc a b ∨ i = Ioc a b ∨ i = Ico a b ∨ i = Ioo a b :=
iff.intro
  (assume _ : interval i,
  have ∃ sup, ∀ bound, sup ≤ bound ↔ ∀ x ∈ i, x ≤ bound, from
    real.exists_sup i (set.exists_mem_of_ne_empty ‹i ≠ ∅›) ‹bdd_above i›,
  let ⟨sup, bound_iff_ge_sup⟩ := this in
  have le_sup : ∀ x ∈ i, x ≤ sup, from (bound_iff_ge_sup sup).mp $ le_refl sup,
  ⟨sup, classical.by_cases
    (assume _ : bdd_below i, /-left-bounded cases-/
    have ∃ inf, ∀ bound, bound ≤ inf ↔ ∀ x ∈ i, bound ≤ x, from
      exists_inf i (set.exists_mem_of_ne_empty ‹i ≠ ∅›) ‹bdd_below i›,
    let ⟨inf, bound_iff_le_inf⟩ := this in
    have ge_inf : ∀ x ∈ i, inf ≤ x, from (bound_iff_le_inf inf).mp $ le_refl inf,
    or.intro_right (i = Iic sup) $ or.intro_right (i = Iio sup)
    ⟨inf, classical.by_cases
      (assume _ : sup ∈ i,
      classical.by_cases
        (assume _ : inf ∈ i, --left-closed right-closed case
        have i = Icc inf sup, from ext $
          assume x,
          iff.intro
            (assume _ : x ∈ i, ⟨ge_inf x ‹x ∈ i›, le_sup x ‹x ∈ i›⟩)
            (assume _ : x ∈ Icc inf sup, ‹interval i› inf x sup ‹inf ∈ i› ‹sup ∈ i› ‹x ∈ Icc inf sup›.left ‹x ∈ Icc inf sup›.right),
        by simp [this])
        (assume _ : inf ∉ i, --left-open right-closed case
        have gt_inf : ∀ x ∈ i, inf < x, from assume x, assume _ : x ∈ i, --DUPLICATE
          lt_of_le_of_ne (ge_inf x ‹x ∈ i›) $ ne.symm $ ne_of_mem_of_not_mem ‹x ∈ i› ‹inf ∉ i›,
        have i = Ioc inf sup, from ext $
          assume x,
          iff.intro
            (assume _ : x ∈ i, ⟨gt_inf x ‹x ∈ i›, le_sup x ‹x ∈ i›⟩)
            (assume _ : x ∈ Ioc inf sup,
            let ⟨z, _, _⟩ := mem_nbhd_inf_of_left_open ‹inf ∉ i› ‹inf < x ∧ x ≤ sup›.left bound_iff_le_inf in
            ‹interval i› z x sup ‹z ∈ i› ‹sup ∈ i› ‹z ≤ x› ‹x ∈ Ioc inf sup›.right),
        by simp [this]))
      (assume _ : sup ∉ i,
      have lt_sup : ∀ x ∈ i, x < sup, from assume x, assume _ : x ∈ i, --DUPLICATE
          lt_of_le_of_ne (le_sup x ‹x ∈ i›) $ ne_of_mem_of_not_mem ‹x ∈ i› ‹sup ∉ i›,
      classical.by_cases
        (assume _ : inf ∈ i, --left-closed right-open case
        have i = Ico inf sup, from ext $
          assume x,
          iff.intro
            (assume _ : x ∈ i, ⟨ge_inf x ‹x ∈ i›, lt_sup x ‹x ∈ i›⟩)
            (assume _ : x ∈ Ico inf sup,
            let ⟨z, _, _⟩ := mem_nbhd_sup_of_right_open ‹sup ∉ i› ‹inf ≤ x ∧ x < sup›.right bound_iff_ge_sup in
            ‹interval i› inf x z ‹inf ∈ i› ‹z ∈ i› ‹x ∈ Ico inf sup›.left ‹x ≤ z›),
        by simp [this])
        (assume _ : inf ∉ i, --left-open right-open case
        have gt_inf : ∀ x ∈ i, inf < x, from assume x, assume _ : x ∈ i, --DUPLICATE
          lt_of_le_of_ne (ge_inf x ‹x ∈ i›) $ ne.symm $ ne_of_mem_of_not_mem ‹x ∈ i› ‹inf ∉ i›,
        have i = Ioo inf sup, from ext $
          assume x,
          iff.intro
            (assume _ : x ∈ i, ⟨gt_inf x ‹x ∈ i›, lt_sup x ‹x ∈ i›⟩)
            (assume _ : x ∈ Ioo inf sup,
            let ⟨z1, _, _⟩ := mem_nbhd_inf_of_left_open ‹inf ∉ i› ‹inf < x ∧ x < sup›.left bound_iff_le_inf in
            let ⟨z2, _, _⟩ := mem_nbhd_sup_of_right_open ‹sup ∉ i› ‹inf < x ∧ x < sup›.right bound_iff_ge_sup in
            ‹interval i› z1 x z2 ‹z1 ∈ i› ‹z2 ∈ i› ‹z1 ≤ x› ‹x ≤ z2›),
        by simp [this]))⟩)
    (assume _ : ¬bdd_below i, /-left-infinite cases-/
    classical.by_cases
      --left-infinite right-closed case
      (assume _ : sup ∈ i,
      have i = Iic sup, from ext $
        assume x,
        let ⟨y, _, _⟩ := exists_smaller_of_not_bounded_below ‹¬bdd_below i› x in
        iff.intro
          (assume _ : x ∈ i, le_sup x ‹x ∈ i›)
          (assume _ : x ∈ Iic sup, ‹interval i› y x sup ‹y ∈ i› ‹sup ∈ i› ‹y ≤ x› ‹x ∈ Iic sup›),
      by simp [this]) --add the large disjunction
      --left-infinite right-open cases
      (assume _ : sup ∉ i,
      have i = Iio sup, from ext $
        assume x,
        let ⟨y, _, _⟩ := exists_smaller_of_not_bounded_below ‹¬bdd_below i› x in
        iff.intro
          (assume _ : x ∈ i,
          have x ≠ sup, from ne_of_mem_of_not_mem ‹x ∈ i› ‹sup ∉ i›,
          lt_of_le_of_ne (le_sup x ‹x ∈ i›) ‹x ≠ sup›)
          (assume _ : x ∈ Iio sup,
          let ⟨z, _, _⟩ := mem_nbhd_sup_of_right_open ‹sup ∉ i› ‹x < sup› bound_iff_ge_sup in
          ‹interval i› y x z ‹y ∈ i› ‹z ∈ i› ‹y ≤ x› ‹x ≤ z›),
      by simp [this]))⟩) --add the large disjunction
  --(begin
  --intros h,
  --cases h with b h1,
  --cases h1 with hic h2,
  --show interval i, from (assume x y z _ _ _ _, eq.symm hic ▸ le_trans ‹y ≤ z› (show z ∈ Iic b, from (hic ▸ ‹z ∈ i›)))
  sorry
  --end)

end intervals

section real
variables {i: set ℝ} {s₁ s₂: set ℝ}
variables {t : topological_space ℝ}

def has_max (S : set ℝ) : Prop := ∃ max ∈ S, ∀ x ∈ S, x ≤ max

/- A closed subset of ℝ that is bounded from above has a maximum. -/
lemma has_max_of_closed_bdd_above {S : set ℝ} (_ : is_closed S) (_ : bdd_above S) (_ : S ≠ ∅) : has_max S :=
-- a set that is bounded from above has a supremum
-- if that supremum is contained in the set, it is the maximum
have ∃ sup, ∀ bound, sup ≤ bound ↔ ∀ x ∈ S, x ≤ bound, from
  real.exists_sup S (set.exists_mem_of_ne_empty ‹S ≠ ∅›) ‹bdd_above S›,
let ⟨sup, bound_iff_ge_sup⟩ := this in
suffices sup ∈ S, from exists.intro sup ⟨‹sup ∈ S›, (bound_iff_ge_sup sup).mp (le_refl sup)⟩,
classical.by_contradiction
  -- we now show that the supremum is contained in the set
  -- for that we use that, since -S is open, sup ∈ -S implies that there is a metric ball around it that's not in S
  -- anything left of the supremum will be smaller than the sup, but still bound S
  -- this contradicts the assumptions
  (assume : sup ∉ S, show false, from
    have ∃ ε > 0, ball sup ε ⊆ -S, from is_open_metric.mp ‹is_open (-S)› sup ‹sup ∈ -S›,
    let ⟨ε, _, _⟩ := this in
      suffices ∀ x ∈ S, x ≤ sup - ε, from
        have ¬(sup ≤ sup - ε), from not_le_of_lt (show sup - ε < sup, by linarith),
        have (sup ≤ sup - ε), from ((bound_iff_ge_sup (sup - ε)).mpr ‹∀ x ∈ S, x ≤ sup - ε›),
        absurd this ‹¬(sup ≤ sup - ε)›,
      assume x (_ : x ∈ S),
      classical.by_contradiction
        (assume : ¬ x ≤ sup - ε,
          have x ≤ sup, from (bound_iff_ge_sup sup).mp (le_refl sup) x ‹x ∈ S›,
          have 0 ≤ sup - x, by linarith,
          have dist x sup < ε, from
            calc dist x sup = abs (sup - x) : by rw[dist_comm x sup]; refl
                        ... = sup - x : abs_of_nonneg ‹0 ≤ sup - x›
                        ... < ε : by linarith,
          have x ∈ -S, from mem_of_subset_of_mem ‹ball sup ε ⊆ -S› ‹x ∈ ball sup ε›,
          absurd ‹x ∈ S› ‹x ∈ -S›))

lemma sup_in_closed {S : set ℝ} (_ : is_closed S) (_ : bdd_above S) (_ : S ≠ ∅) : real.Sup S ∈ S :=
have has_max S, from has_max_of_closed_bdd_above ‹is_closed S› ‹bdd_above S› ‹S ≠ ∅›,
let ⟨max, (_ : max ∈ S), max_upper_bound⟩ := this in
have max ≤ real.Sup S, from real.le_Sup S ‹bdd_above S› ‹max ∈ S›,
have real.Sup S ≤ max, from (real.Sup_le S (set.exists_mem_of_ne_empty ‹S ≠ ∅›) ‹bdd_above S›).mpr max_upper_bound,
have max = real.Sup S, from le_antisymm ‹max ≤ real.Sup S› ‹real.Sup S ≤ max›,
show real.Sup S ∈ S, from ‹max = real.Sup S› ▸ ‹max ∈ S›

lemma mem_iff_neg_mem {S : set ℝ} {x : ℝ} : -x ∈ S ↔ x ∈ {y | -y ∈ S} :=
by rw mem_set_of_eq

lemma bdd_above_iff_neg_bdd_below {S : set ℝ} : bdd_below S ↔ bdd_above {x | -x ∈ S} :=
iff.intro
  (assume ⟨y, h⟩, --S is bounded from below by y
    ⟨-y,
    assume x,
    assume _ : x ∈ {x | -x ∈ S},
    have -x ∈ S, by rwa [mem_iff_neg_mem],
    neg_neg x ▸ neg_le_neg (h (-x) ‹-x ∈ S›)⟩)
  (assume ⟨y, h⟩, --{x | -x ∈ S} is bounded from above by y
    ⟨-y,
    assume x,
    assume _ : x ∈ S,
    have -x ∈ {x | -x ∈ S}, by simp [‹x ∈ S›], --how to do this by def?
    neg_neg x ▸ neg_le_neg (h (-x) ‹-x ∈ {x | -x ∈ S}›)⟩)

lemma bdd_above_Icc {a b : ℝ} : bdd_above (Icc a b) :=
⟨b, by intros; exact (mem_def.mp ‹y ∈ Icc a b›).right⟩

lemma bdd_below_Icc {a b : ℝ} : bdd_below (Icc a b) :=
⟨a, by intros; exact (mem_def.mp ‹y ∈ Icc a b›).left⟩

lemma neg_closed {S : set ℝ} (_ : is_closed S) : is_closed {x | -x ∈ S} :=
let neg := λ (x : ℝ), -x in
have continuous neg, from topological_ring.continuous_neg ℝ,
show is_closed (neg ⁻¹' S), from continuous_iff_is_closed.mp ‹continuous neg› S ‹is_closed S›

lemma inf_in_closed {S : set ℝ} (_ : is_closed S) (_ : bdd_below S) (_ : S ≠ ∅) : real.Inf S ∈ S :=
let neg := λ (x : ℝ), -x in
let ⟨x, h⟩ := ne_empty_iff_exists_mem.mp ‹S ≠ ∅› in
have {x | -x ∈ S} ≠ ∅, from ne_empty_iff_exists_mem.mpr ⟨-x, mem_iff_neg_mem.mp (eq.symm (neg_neg x) ▸ h)⟩,
sup_in_closed
  (neg_closed ‹is_closed S›)
  (bdd_above_iff_neg_bdd_below.mp ‹bdd_below S›)
  ‹{x | -x ∈ S} ≠ ∅›

lemma inter_sep_comp_eq {α : Type u} {s s₁ s₂ : set α} (_ : s ∩ s₁ ∩ s₂ = ∅) (_ : s ⊆ s₁ ∪ s₂) : s ∩ s₁ = s ∩ -s₂ :=
have s ∩ s₁ ⊆ s ∩-s₂, by simpa [subset_compl_iff_disjoint],
have s ∩-s₂ ⊆ s ∩ s₁, from
calc s ∩-s₂ ⊆ s ∩ ((s₁ ∪ s₂) ∩ -s₂) : by simp [inter_subset_inter_left, ‹s ⊆ s₁ ∪ s₂›]
        ... ⊆ s ∩ s₁                : by simp [inter_subset_inter_right, inter_distrib_right],
eq_of_subset_of_subset ‹s ∩ s₁ ⊆ s ∩ -s₂› ‹s ∩-s₂ ⊆ s ∩ s₁›

lemma subset_separation_left_inter_closed {α : Type u} {s s₁ s₂ c : set α} [topological_space α]
  (sub_sep : subset_separation s s₁ s₂) (_ : is_closed c) (_ : c ⊆ s) : is_closed (s₁ ∩ c) :=
let ⟨_, _, _, _, _, _⟩ := sub_sep in
let lift := @subtype.val α s in
have sep : @separation s _ (lift⁻¹' s₁) (lift⁻¹' s₂), from sep_of_subset_sep sub_sep,
have h : lift⁻¹' s₁ = lift⁻¹' -s₂, by rw [sep_neg sep, eq.symm preimage_compl],
have is_closed (-s₂), by rw [show is_closed (-s₂) = is_open ( - - s₂), by refl]; rwa [compl_compl s₂],
have s₁ ∩ s = -s₂ ∩ s, from
  calc s₁ ∩ s = lift '' (lift⁻¹' s₁)  : by rw [inter_comm, image_preimage_subtype_val s₁]
          ... = lift '' (lift⁻¹' -s₂) : by rw h
          ... = -s₂ ∩ s               : by rw [image_preimage_subtype_val (-s₂), inter_comm],
have s₁ ∩ c = -s₂ ∩ c, from
  calc s₁ ∩ c =  s₁ ∩ s ∩ c : by rw [inter_assoc, inter_eq_self_of_subset_right ‹c ⊆ s›]
          ... = -s₂ ∩ s ∩ c : by rw [←‹s₁ ∩ s = -s₂ ∩ s›]
          ... = -s₂ ∩ c     : by rw [inter_assoc, inter_eq_self_of_subset_right ‹c ⊆ s›],
eq.symm this ▸ (is_closed_inter ‹is_closed (-s₂)› ‹is_closed c›)

lemma subset_separation_right_inter_closed {α : Type u} {s s₁ s₂ c : set α} [topological_space α]
  (sep : subset_separation s s₁ s₂) (_ : is_closed c) (_ : c ⊆ s) : is_closed (s₂ ∩ c) :=
subset_separation_left_inter_closed (subset_sep_symm sep) ‹is_closed c› ‹c ⊆ s›

set_option eqn_compiler.zeta true

-- An convex subset of ℝ is connected in the subspace topology
instance connected_of_interval {i : set ℝ} (_ : interval i) : connected_space' i :=
subtype_connected_iff_subset_connected.mpr $
-- assume that i is not connected, then there exists a separation
assume _ : disconnected_subset i,
  have ∃ (s₁ : set ℝ) (s₂ : set ℝ) (a ∈ s₁ ∩ i) (b ∈ s₂ ∩ i), a < b ∧ subset_separation i s₁ s₂,
    from (
      let ⟨s₁, s₂, sep⟩ := ‹disconnected_subset i›,
          ⟨_, _, _, _, _, _⟩ := sep,
          ⟨a, _⟩ := exists_mem_of_ne_empty ‹s₁ ∩ i ≠ ∅›,
          ⟨b, _⟩ := exists_mem_of_ne_empty ‹s₂ ∩ i ≠ ∅› in
      have a ≠ b, from (assume _ : a = b,
      have b ∈ s₁ ∩ s₂ ∩ i, from ⟨⟨‹a = b› ▸ (‹a ∈ s₁ ∩ i›.1), (‹b ∈ s₂ ∩ i›).1⟩, (‹b ∈ s₂ ∩ i›.2)⟩,
      show false, from eq_empty_iff_forall_not_mem.1 ‹s₁ ∩ s₂ ∩ i = ∅› b ‹b ∈ s₁ ∩ s₂ ∩ i›),
      or.elim (ne_iff_lt_or_gt.mp ‹a ≠ b›)
        (assume _, ⟨s₁, s₂, a, ‹_›, b, ‹_›, ⟨‹_›, sep⟩⟩)
        (assume _, ⟨s₂, s₁, b, ‹_›, a, ‹_›, ⟨‹_›, subset_sep_symm sep⟩⟩)),
  let ⟨s₁, s₂, a, ⟨_, _⟩, b, ⟨_, _⟩, ⟨(_ : a < b), sep⟩⟩ := this,
      ⟨_, _, _, _, _, _⟩ := sep in
      have Icc a b ⊆ i, from
        (suffices (∀x, x ∈ Icc a b → x ∈ i), by simpa only [subset_def],
        assume x,
        assume _ : x ∈ Icc a b,
        have hab : a ≤ x ∧ x ≤ b, from mem_set_of_eq.mp ‹x ∈ Icc a b›,
        show x ∈ i, from ‹interval i› a x b ‹a ∈ i› ‹b ∈ i› hab.1 hab.2),
      let s₁' := s₁ ∩ Icc a b, s₂' := s₂ ∩ Icc a b in
      have s₁' ∪ s₂' = Icc a b, from
        (calc  s₁' ∪ s₂' = (s₁ ∪ s₂) ∩ Icc a b : eq.symm (inter_distrib_right s₁ s₂ (Icc a b))
                     ... = Icc a b             : inter_eq_self_of_subset_right (subset.trans ‹Icc a b ⊆ i› ‹i ⊆ s₁ ∪ s₂›)),
      let sup := real.Sup s₁' in
      have is_closed s₁', from subset_separation_left_inter_closed sep is_closed_Icc ‹Icc a b ⊆ i›,
      have is_closed s₂', from subset_separation_right_inter_closed sep is_closed_Icc ‹Icc a b ⊆ i›,

      have bdd_above s₁', from bdd_above_Int2 bdd_above_Icc,
      have s₁' ≠ ∅, from ne_empty_of_mem (⟨‹a ∈ s₁›, mem_set_of_eq.mpr ⟨le_refl a, le_of_lt ‹a < b›⟩⟩),
      have sup ∈ s₁', from sup_in_closed ‹is_closed s₁'› ‹bdd_above s₁'› ‹s₁' ≠ ∅›,
      have sup ∈ Icc a b, from mem_of_mem_inter_right ‹sup ∈ s₁'›,
      have sup ∈ i, from mem_of_subset_of_mem ‹Icc a b ⊆ i› ‹sup ∈ Icc a b›,

      have sup ≤ b, from (mem_def.mp ‹sup ∈ Icc a b›).2,
      let s₂'' := s₂' ∩ Icc sup b in
      let inf := real.Inf s₂'' in

      have is_closed s₂'', from is_closed_inter ‹is_closed s₂'› is_closed_Icc,
      have bdd_below s₂', from bdd_below_Int2 bdd_below_Icc,
      have bdd_below s₂'', from bdd_below_Int1 ‹bdd_below s₂'›,
      have b ∈ s₂', from ⟨‹b ∈ s₂›, mem_set_of_eq.mpr ⟨le_of_lt ‹a < b›, le_refl b⟩⟩,
      have s₂'' ≠ ∅, from ne_empty_of_mem ⟨‹b ∈ s₂'›, mem_set_of_eq.mpr ⟨‹sup ≤ b›, le_refl b⟩⟩,
      have inf ∈ s₂'', from inf_in_closed ‹is_closed s₂''› ‹bdd_below s₂''› ‹s₂'' ≠ ∅›,
      have inf ∈ Icc a b, from mem_of_mem_inter_right $ mem_of_mem_inter_left ‹inf ∈ s₂''›,
      have inf ∈ i, from mem_of_subset_of_mem ‹Icc a b ⊆ i› ‹inf ∈ Icc a b›,

      have sup ≤ inf, from (mem_def.mp (mem_of_mem_inter_right ‹inf ∈ s₂''›)).left,
      have sup < inf, from lt_of_le_of_ne ‹sup ≤ inf› $ ne.intro
        (assume _ : sup = inf,
        have inf ∈ s₁', from ‹sup = inf› ▸ ‹sup ∈ s₁'›,
        have inf ∈ s₁ ∩ s₂ ∩ i, from ⟨⟨mem_of_mem_inter_left ‹inf ∈ s₁'›, mem_of_mem_inter_left $ mem_of_mem_inter_left ‹inf ∈ s₂''›⟩, ‹inf ∈ i›⟩,
        show false, from mem_empty_eq inf ▸ ‹s₁ ∩ s₂ ∩ i = ∅› ▸ ‹inf ∈ s₁ ∩ s₂ ∩ i›),

      let ⟨z, ⟨(_ : sup < z), (_ : z < inf)⟩⟩ := exists_real_between ‹sup < inf› in
      have z ∈ Ioo sup inf, from mem_set_of_eq.mp (and.intro ‹sup < z› ‹z < inf›),
      have z ∈ i, from ‹interval i› sup z inf ‹sup ∈ i› ‹inf ∈ i› (le_of_lt ‹sup < z›) (le_of_lt ‹z < inf›),
      have z ∈ s₁ ∪ s₂, from mem_of_subset_of_mem ‹i ⊆ s₁ ∪ s₂› ‹z ∈ i›,
      have a ≤ z, from le_trans ‹sup ∈ Icc a b›.left (le_of_lt ‹sup < z›),
      have z ≤ b, from le_trans (le_of_lt ‹z < inf›) ‹inf ∈ Icc a b›.right,
      show false, from mem_union.elim ‹z ∈ s₁ ∪ s₂›
        (assume _ : z ∈ s₁,
        have z ∈ s₁', from mem_inter ‹z ∈ s₁› $ and.intro ‹a ≤ z› ‹z ≤ b›,
        have z ≤ sup, from real.le_Sup s₁' ‹bdd_above s₁'› ‹z ∈ s₁'›,
        not_lt_of_le ‹z ≤ sup› ‹sup < z›)
        (assume _ : z ∈ s₂,
        have z ∈ s₂', from mem_inter ‹z ∈ s₂› $ and.intro ‹a ≤ z› ‹z ≤ b›,
        have z ∈ s₂'', from mem_inter ‹z ∈ s₂'› $ and.intro (le_of_lt ‹sup < z›) ‹z ≤ b›,
        have z ≥ inf, from real.Inf_le s₂'' ‹bdd_below s₂''› ‹z ∈ s₂''›,
        not_le_of_gt ‹inf > z› ‹inf ≤ z›)

theorem interval_of_connected {i : set ℝ} [connected_space' i] : interval i :=
by intros x y z _ _ _ _;
exact
  classical.by_cases
    (assume h : x = y ∨ y = z,
    or.elim h
      (assume _ : x = y, ‹x = y› ▸ ‹x ∈ i›)
      (assume _ : y = z, eq.symm ‹y = z› ▸ ‹z ∈ i›))
    (assume _ : ¬(x = y ∨ y = z),
    have x ≠ y ∧ y ≠ z, from not_or_distrib.mp ‹¬(x = y ∨ y = z)›,
    have x < y, from lt_of_le_of_ne ‹x ≤ y› ‹x ≠ y ∧ y ≠ z›.left,
    have y < z, from lt_of_le_of_ne ‹y ≤ z› ‹x ≠ y ∧ y ≠ z›.right,
    classical.by_contradiction
    (assume _ : y ∉ i,
    have Iio y ∩ Ioi y ∩ i = ∅, from
      calc Iio y ∩ Ioi y ∩ i = ∅ ∩ i : by rw [Iio_inter_Ioi_empty]
                         ... = ∅     : empty_inter i,
    have i ⊆ Iio y ∪ Ioi y, from subset_def.mpr
      (assume a,
      assume _ : a ∈ i,
      have a ≠ y, from ne_of_mem_of_not_mem ‹a ∈ i› ‹y ∉ i›,
      or.elim (ne_iff_lt_or_gt.mp ‹a ≠ y›)
        (assume _ : a < y, mem_union_left  (Ioi y) ‹a < y›)
        (assume _ : a > y, mem_union_right (Iio y) ‹y < a›)),
    have Iio y ∩ i ≠ ∅, from ne_empty_of_mem (mem_inter ‹x < y› ‹x ∈ i›),
    have Ioi y ∩ i ≠ ∅, from ne_empty_of_mem (mem_inter ‹y < z› ‹z ∈ i›),
    have disconnected_subset i, from ⟨Iio y, Ioi y, is_open_Iio, is_open_Ioi, ‹Iio y ∩ i ≠ ∅›, ‹Ioi y ∩ i ≠ ∅›, ‹Iio y ∩ Ioi y ∩ i = ∅›, ‹i ⊆ Iio y ∪ Ioi y›⟩,
    have ¬connected_space' i, by simpa [subtype_connected_iff_subset_connected],
    this ‹connected_space' i›))

end real


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

Type class hierarchy for Boolean algebras.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.bounded_lattice
import Mathlib.PostPort

universes u_1 l u v

namespace Mathlib

/-- Set / lattice complement -/
class has_compl (α : Type u_1) where
  compl : α → α

postfix:0 "ᶜ" => Mathlib.has_compl.compl

/-- A boolean algebra is a bounded distributive lattice with a
  complementation operation `-` such that `x ⊓ - x = ⊥` and `x ⊔ - x = ⊤`.
  This is a generalization of (classical) logic of propositions, or
  the powerset lattice. -/
class boolean_algebra (α : Type u_1) extends has_sdiff α, has_compl α, bounded_distrib_lattice α
    where
  inf_compl_le_bot : ∀ (x : α), x ⊓ (xᶜ) ≤ ⊥
  top_le_sup_compl : ∀ (x : α), ⊤ ≤ x ⊔ (xᶜ)
  sdiff_eq : ∀ (x y : α), x \ y = x ⊓ (yᶜ)

@[simp] theorem inf_compl_eq_bot {α : Type u} {x : α} [boolean_algebra α] : x ⊓ (xᶜ) = ⊥ :=
  bot_unique (boolean_algebra.inf_compl_le_bot x)

@[simp] theorem compl_inf_eq_bot {α : Type u} {x : α} [boolean_algebra α] : xᶜ ⊓ x = ⊥ :=
  Eq.trans inf_comm inf_compl_eq_bot

@[simp] theorem sup_compl_eq_top {α : Type u} {x : α} [boolean_algebra α] : x ⊔ (xᶜ) = ⊤ :=
  top_unique (boolean_algebra.top_le_sup_compl x)

@[simp] theorem compl_sup_eq_top {α : Type u} {x : α} [boolean_algebra α] : xᶜ ⊔ x = ⊤ :=
  Eq.trans sup_comm sup_compl_eq_top

theorem is_compl_compl {α : Type u} {x : α} [boolean_algebra α] : is_compl x (xᶜ) :=
  is_compl.of_eq inf_compl_eq_bot sup_compl_eq_top

theorem is_compl.compl_eq {α : Type u} {x : α} {y : α} [boolean_algebra α] (h : is_compl x y) :
    xᶜ = y :=
  Eq.symm (is_compl.right_unique h is_compl_compl)

theorem disjoint_compl_right {α : Type u} {x : α} [boolean_algebra α] : disjoint x (xᶜ) :=
  is_compl.disjoint is_compl_compl

theorem disjoint_compl_left {α : Type u} {x : α} [boolean_algebra α] : disjoint (xᶜ) x :=
  disjoint.symm disjoint_compl_right

theorem sdiff_eq {α : Type u} {x : α} {y : α} [boolean_algebra α] : x \ y = x ⊓ (yᶜ) :=
  boolean_algebra.sdiff_eq x y

theorem compl_unique {α : Type u} {x : α} {y : α} [boolean_algebra α] (i : x ⊓ y = ⊥)
    (s : x ⊔ y = ⊤) : xᶜ = y :=
  is_compl.compl_eq (is_compl.of_eq i s)

@[simp] theorem compl_top {α : Type u} [boolean_algebra α] : ⊤ᶜ = ⊥ :=
  is_compl.compl_eq is_compl_top_bot

@[simp] theorem compl_bot {α : Type u} [boolean_algebra α] : ⊥ᶜ = ⊤ :=
  is_compl.compl_eq is_compl_bot_top

@[simp] theorem compl_compl {α : Type u} [boolean_algebra α] (x : α) : xᶜᶜ = x :=
  is_compl.compl_eq (is_compl.symm is_compl_compl)

theorem compl_injective {α : Type u} [boolean_algebra α] : function.injective compl :=
  function.involutive.injective compl_compl

@[simp] theorem compl_inj_iff {α : Type u} {x : α} {y : α} [boolean_algebra α] :
    xᶜ = (yᶜ) ↔ x = y :=
  function.injective.eq_iff compl_injective

theorem is_compl.compl_eq_iff {α : Type u} {x : α} {y : α} {z : α} [boolean_algebra α]
    (h : is_compl x y) : zᶜ = y ↔ z = x :=
  is_compl.compl_eq h ▸ compl_inj_iff

@[simp] theorem compl_eq_top {α : Type u} {x : α} [boolean_algebra α] : xᶜ = ⊤ ↔ x = ⊥ :=
  is_compl.compl_eq_iff is_compl_bot_top

@[simp] theorem compl_eq_bot {α : Type u} {x : α} [boolean_algebra α] : xᶜ = ⊥ ↔ x = ⊤ :=
  is_compl.compl_eq_iff is_compl_top_bot

@[simp] theorem compl_inf {α : Type u} {x : α} {y : α} [boolean_algebra α] : x ⊓ yᶜ = xᶜ ⊔ (yᶜ) :=
  is_compl.compl_eq (is_compl.inf_sup is_compl_compl is_compl_compl)

@[simp] theorem compl_sup {α : Type u} {x : α} {y : α} [boolean_algebra α] : x ⊔ yᶜ = xᶜ ⊓ (yᶜ) :=
  is_compl.compl_eq (is_compl.sup_inf is_compl_compl is_compl_compl)

theorem compl_le_compl {α : Type u} {x : α} {y : α} [boolean_algebra α] (h : y ≤ x) : xᶜ ≤ (yᶜ) :=
  is_compl.antimono is_compl_compl is_compl_compl h

@[simp] theorem compl_le_compl_iff_le {α : Type u} {x : α} {y : α} [boolean_algebra α] :
    yᶜ ≤ (xᶜ) ↔ x ≤ y :=
  sorry

theorem le_compl_of_le_compl {α : Type u} {x : α} {y : α} [boolean_algebra α] (h : y ≤ (xᶜ)) :
    x ≤ (yᶜ) :=
  sorry

theorem compl_le_of_compl_le {α : Type u} {x : α} {y : α} [boolean_algebra α] (h : yᶜ ≤ x) :
    xᶜ ≤ y :=
  sorry

theorem le_compl_iff_le_compl {α : Type u} {x : α} {y : α} [boolean_algebra α] :
    y ≤ (xᶜ) ↔ x ≤ (yᶜ) :=
  { mp := le_compl_of_le_compl, mpr := le_compl_of_le_compl }

theorem compl_le_iff_compl_le {α : Type u} {x : α} {y : α} [boolean_algebra α] : xᶜ ≤ y ↔ yᶜ ≤ x :=
  { mp := compl_le_of_compl_le, mpr := compl_le_of_compl_le }

theorem sup_sdiff_same {α : Type u} {x : α} {y : α} [boolean_algebra α] : x ⊔ y \ x = x ⊔ y := sorry

theorem sdiff_eq_left {α : Type u} {x : α} {y : α} [boolean_algebra α] (h : x ⊓ y = ⊥) :
    x \ y = x :=
  sorry

theorem sdiff_le_sdiff {α : Type u} {w : α} {x : α} {y : α} {z : α} [boolean_algebra α] (h₁ : w ≤ y)
    (h₂ : z ≤ x) : w \ x ≤ y \ z :=
  eq.mpr (id (Eq._oldrec (Eq.refl (w \ x ≤ y \ z)) sdiff_eq))
    (eq.mpr (id (Eq._oldrec (Eq.refl (w ⊓ (xᶜ) ≤ y \ z)) sdiff_eq))
      (inf_le_inf h₁ (compl_le_compl h₂)))

@[simp] theorem sdiff_idem_right {α : Type u} {x : α} {y : α} [boolean_algebra α] :
    x \ y \ y = x \ y :=
  sorry

protected instance boolean_algebra_Prop : boolean_algebra Prop :=
  boolean_algebra.mk bounded_distrib_lattice.sup bounded_distrib_lattice.le
    bounded_distrib_lattice.lt sorry sorry sorry sorry sorry sorry bounded_distrib_lattice.inf sorry
    sorry sorry sorry bounded_distrib_lattice.top sorry bounded_distrib_lattice.bot sorry Not
    (fun (p q : Prop) => p ∧ ¬q) sorry sorry sorry

protected instance pi.boolean_algebra {α : Type u} {β : Type v} [boolean_algebra β] :
    boolean_algebra (α → β) :=
  boolean_algebra.mk (fun (ᾰ ᾰ_1 : α → β) (i : α) => boolean_algebra.sup (ᾰ i) (ᾰ_1 i))
    partial_order.le partial_order.lt sorry sorry sorry sorry sorry sorry
    (fun (ᾰ ᾰ_1 : α → β) (i : α) => boolean_algebra.inf (ᾰ i) (ᾰ_1 i)) sorry sorry sorry sorry
    (fun (i : α) => boolean_algebra.top) sorry (fun (i : α) => boolean_algebra.bot) sorry
    (fun (ᾰ : α → β) (i : α) => boolean_algebra.compl (ᾰ i))
    (fun (ᾰ ᾰ_1 : α → β) (i : α) => boolean_algebra.sdiff (ᾰ i) (ᾰ_1 i)) sorry sorry sorry

end Mathlib