example : ∃ a : ℕ, a = a :=
begin
  fapply exists.intro,
  exact 0,
  reflexivity
end


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.sum.basic
import logic.nontrivial

/-!
# Two-pointings

This file defines `two_pointing α`, the type of two pointings of `α`. A two-pointing is the data of
two distinct terms.

This is morally a Type-valued `nontrivial`. Another type which is quite close in essence is `sym2`.
Categorically speaking, `prod` is a cospan in the category of types. This forms the category of
bipointed types. Two-pointed types form a full subcategory of those.

## References

* [nLab, *Coalgebra of the real interval*]
  (https://ncatlab.org/nlab/show/coalgebra+of+the+real+interval)
-/

open function

variables {α β : Type*}

/-- Two-pointing of a type. This is a Type-valued termed `nontrivial`. -/
@[ext, derive decidable_eq] structure two_pointing (α : Type*) extends α × α :=
(fst_ne_snd : fst ≠ snd)

namespace two_pointing
variables (p : two_pointing α) (q : two_pointing β)

lemma snd_ne_fst : p.snd ≠ p.fst := p.fst_ne_snd.symm

/-- Swaps the two pointed elements. -/
@[simps] def swap : two_pointing α := ⟨(p.snd, p.fst), p.snd_ne_fst⟩

lemma swap_fst : p.swap.fst = p.snd := rfl
lemma swap_snd : p.swap.snd = p.fst := rfl
@[simp] lemma swap_swap : p.swap.swap = p := by ext; refl

@[reducible] -- See note [reducible non instances]
lemma to_nontrivial : nontrivial α := ⟨⟨p.fst, p.snd, p.fst_ne_snd⟩⟩

instance [nontrivial α] : nonempty (two_pointing α) :=
let ⟨a, b, h⟩ := exists_pair_ne α in ⟨⟨(a, b), h⟩⟩

@[simp] lemma nonempty_two_pointing_iff : nonempty (two_pointing α) ↔ nontrivial α :=
⟨λ ⟨p⟩, p.to_nontrivial, @two_pointing.nonempty _⟩

section pi
variables (α) [nonempty α]

/-- The two-pointing of constant functions. -/
def pi : two_pointing (α → β) :=
{ fst := λ _, q.fst,
  snd := λ _, q.snd,
  fst_ne_snd := λ h, q.fst_ne_snd $ by convert congr_fun h (classical.arbitrary α) }

@[simp] lemma pi_fst : (q.pi α).fst = const α (q.fst) := rfl
@[simp] lemma pi_snd : (q.pi α).snd = const α (q.snd) := rfl

end pi

/-- The product of two two-pointings. -/
def prod : two_pointing (α × β) :=
{ fst := (p.fst, q.fst),
  snd := (p.snd, q.snd),
  fst_ne_snd := λ h, p.fst_ne_snd (congr_arg prod.fst h) }

@[simp] lemma prod_fst : (p.prod q).fst = (p.fst, q.fst) := rfl
@[simp] lemma prod_snd : (p.prod q).snd = (p.snd, q.snd) := rfl

/-- The sum of two pointings. Keeps the first point from the left and the second point from the
right. -/
protected def sum : two_pointing (α ⊕ β) := ⟨(sum.inl (p.fst), sum.inr (q.snd)), sum.inl_ne_inr⟩

@[simp] lemma sum_fst : (p.sum q).fst = sum.inl p.fst := rfl
@[simp] lemma sum_snd : (p.sum q).snd = sum.inr q.snd := rfl

/-- The `ff`, `tt` two-pointing of `bool`. -/
protected def bool : two_pointing bool := ⟨(ff, tt), bool.ff_ne_tt⟩

@[simp] lemma bool_fst : two_pointing.bool.fst = ff := rfl
@[simp] lemma bool_snd : two_pointing.bool.snd = tt := rfl

instance : inhabited (two_pointing bool) := ⟨two_pointing.bool⟩

/-- The `false`, `true` two-pointing of `Prop`. -/
protected def «Prop» : two_pointing Prop := ⟨(false, true), false_ne_true⟩

@[simp] lemma Prop_fst : two_pointing.Prop.fst = false := rfl
@[simp] lemma Prop_snd : two_pointing.Prop.snd = true := rfl

end two_pointing


/-
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

/-!
# Multiplicity of a divisor

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

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 `part_enat` or natural with infinity. If `∀ n, a ^ n ∣ b`,
  then it returns `⊤`-/
def multiplicity [monoid α] [decidable_rel ((∣) : α → α → Prop)] (a b : α) : part_enat :=
part_enat.find $ λ n, ¬a ^ (n + 1) ∣ b

namespace multiplicity

section monoid
variables [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

lemma not_dvd_one_of_finite_one_right {a : α} : finite a 1 → ¬a ∣ 1 :=
λ ⟨n, hn⟩ ⟨d, hd⟩, hn ⟨d ^ (n + 1), (pow_mul_pow_eq_one (n + 1) hd.symm).symm⟩

@[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 hn ∘ is_unit.dvd ∘ is_unit.pow (n + 1)

lemma finite_of_finite_mul_right {a b c : α} : finite a (b * c) → finite a b :=
λ ⟨n, hn⟩, ⟨n, λ h, hn (h.trans (dvd_mul_right _ _))⟩

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

lemma pow_dvd_of_le_multiplicity {a b : α} {k : ℕ} :
  (k : part_enat) ≤ multiplicity a b → a ^ k ∣ b :=
by { rw ← part_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 part_enat.coe_get)

lemma is_greatest  {a b : α} {m : ℕ} (hm : multiplicity a b < m) : ¬a ^ m ∣ b :=
λ h, by rw [part_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 [← part_enat.coe_lt_coe, part_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 : part_enat) = multiplicity a b :=
le_antisymm (le_of_not_gt (λ hk', is_greatest hk' hk)) $
  have finite a b, from ⟨k, hsucc⟩,
  by { rw [part_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 [← part_enat.coe_inj, part_enat.coe_get, unique hk hsucc]

lemma pow_dvd_iff_le_multiplicity {a b : α}
  {k : ℕ} : a ^ k ∣ b ↔ (k : part_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 : part_enat) ↔ ¬ a ^ k ∣ b :=
by { rw [pow_dvd_iff_le_multiplicity, not_le] }

lemma eq_coe_iff {a b : α} {n : ℕ} :
  multiplicity a b = (n : part_enat) ↔ a ^ n ∣ b ∧ ¬a ^ (n + 1) ∣ b :=
begin
  rw [← part_enat.some_eq_coe],
  exact ⟨λ h, let ⟨h₁, h₂⟩ := eq_some_iff.1 h in
      h₂ ▸ ⟨pow_multiplicity_dvd _, is_greatest
        (by { rw [part_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 :=
(part_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.dvd (ha.pow _))

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

@[simp] lemma get_one_right {a : α} (ha : finite a 1) : get (multiplicity a 1) ha = 0 :=
begin
  rw [part_enat.get_eq_iff_eq_coe, eq_coe_iff, pow_zero],
  simp [not_dvd_one_of_finite_one_right ha],
end

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

lemma multiplicity_eq_zero {a b : α} : multiplicity a b = 0 ↔ ¬ a ∣ b :=
by { rw [← nat.cast_zero, eq_coe_iff], simp }

lemma multiplicity_ne_zero {a b : α} : multiplicity a b ≠ 0 ↔ a ∣ b := multiplicity_eq_zero.not_left

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 [← part_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_eq_multiplicity_iff {a b c d : α} : multiplicity a b = multiplicity c d ↔
  (∀ n : ℕ, a ^ n ∣ b ↔ c ^ n ∣ d) :=
⟨λ h n, ⟨multiplicity_le_multiplicity_iff.mp h.le n, multiplicity_le_multiplicity_iff.mp h.ge n⟩,
 λ h, le_antisymm (multiplicity_le_multiplicity_iff.mpr (λ n, (h n).mp))
                  (multiplicity_le_multiplicity_iff.mpr (λ n, (h n).mpr))⟩

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 : part_enat) < multiplicity a b) : a ∣ b :=
begin
  rw ← pow_one a,
  apply pow_dvd_of_le_multiplicity,
  simpa only [nat.cast_one, part_enat.pos_iff_one_le] using h
end

lemma dvd_iff_multiplicity_pos {a b : α} : (0 : part_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 part_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, 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 ↔ _ _root_.has_dvd.dvd.multiplicity_pos

end monoid

section comm_monoid
variables [comm_monoid α]

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

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

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 }⟩

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

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

open_locale classical

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)

alias dvd_iff_multiplicity_pos ↔ _ _root_.has_dvd.dvd.multiplicity_pos

end comm_monoid

section monoid_with_zero

variable [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 :=
multiplicity.multiplicity_eq_zero.2 $ mt zero_dvd_iff.1 ha

end monoid_with_zero

section comm_monoid_with_zero

variable [comm_monoid_with_zero α]

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

lemma multiplicity_mk_eq_multiplicity [decidable_rel ((∣) : associates α → associates α → Prop)]
  {a b : α} : multiplicity (associates.mk a) (associates.mk b) = multiplicity a b :=
begin
  by_cases h : finite a b,
  { rw ← part_enat.coe_get (finite_iff_dom.mp h),
    refine (multiplicity.unique
      (show (associates.mk a)^(((multiplicity a b).get h)) ∣ associates.mk b, from _) _).symm ;
      rw [← associates.mk_pow, associates.mk_dvd_mk],
    { exact pow_multiplicity_dvd h },
    { exact is_greatest ((part_enat.lt_coe_iff _ _).mpr (exists.intro
        (finite_iff_dom.mp h) (nat.lt_succ_self _))) } },
  { suffices : ¬ (finite (associates.mk a) (associates.mk b)),
    { rw [finite_iff_dom, part_enat.not_dom_iff_eq_top] at h this,
      rw [h, this] },
    refine not_finite_iff_forall.mpr (λ n, by { rw [← associates.mk_pow, associates.mk_dvd_mk],
      exact not_finite_iff_forall.mp h n }) }
end

end comm_monoid_with_zero

section semiring

variables [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 semiring

section ring

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

@[simp] protected lemma neg (a b : α) : multiplicity a (-b) = multiplicity a b :=
part.ext' (by simp only [multiplicity, part_enat.find, dvd_neg])
  (λ h₁ h₂, part_enat.coe_inj.1 (by rw [part_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 part_enat.le_of_lt_add_one,
    cases part_enat.ne_top_iff.mp (part_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 part_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 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 :=
part_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 [← part_enat.coe_inj, part_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 [← part_enat.coe_get (finite_iff_dom.1 h.1), ← part_enat.coe_get (finite_iff_dom.1 h.2),
  ← part_enat.coe_get (finite_iff_dom.1 (finite_mul hp h.1 h.2)),
    ← nat.cast_add, part_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 `part_enat`. -/
noncomputable def add_valuation (hp : prime p) : add_valuation R part_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, part_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

end nat


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

/-!
# Neighborhoods and continuity relative to a subset

This file defines relative versions

* `nhds_within`           of `nhds`
* `continuous_on`         of `continuous`
* `continuous_within_at`  of `continuous_at`

and proves their basic properties, including the relationships between
these restricted notions and the corresponding notions for the subtype
equipped with the subspace topology.

## Notation

* `𝓝 x`: the filter of neighborhoods of a point `x`;
* `𝓟 s`: the principal filter of a set `s`;
* `𝓝[s] x`: the filter `nhds_within x s` of neighborhoods of a point `x` within a set `s`.

-/

open set filter function
open_locale topological_space filter

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}
variables [topological_space α]

@[simp] lemma nhds_bind_nhds_within {a : α} {s : set α} :
  (𝓝 a).bind (λ x, 𝓝[s] x) = 𝓝[s] a :=
bind_inf_principal.trans $ congr_arg2 _ nhds_bind_nhds rfl

@[simp] lemma eventually_nhds_nhds_within {a : α} {s : set α} {p : α → Prop} :
  (∀ᶠ y in 𝓝 a, ∀ᶠ x in 𝓝[s] y, p x) ↔ ∀ᶠ x in 𝓝[s] a, p x :=
filter.ext_iff.1 nhds_bind_nhds_within {x | p x}

lemma eventually_nhds_within_iff {a : α} {s : set α} {p : α → Prop} :
  (∀ᶠ x in 𝓝[s] a, p x) ↔ ∀ᶠ x in 𝓝 a, x ∈ s → p x :=
eventually_inf_principal

@[simp] lemma eventually_nhds_within_nhds_within {a : α} {s : set α} {p : α → Prop} :
  (∀ᶠ y in 𝓝[s] a, ∀ᶠ x in 𝓝[s] y, p x) ↔ ∀ᶠ x in 𝓝[s] a, p x :=
begin
  refine ⟨λ h, _, λ h, (eventually_nhds_nhds_within.2 h).filter_mono inf_le_left⟩,
  simp only [eventually_nhds_within_iff] at h ⊢,
  exact h.mono (λ x hx hxs, (hx hxs).self_of_nhds hxs)
end

theorem nhds_within_eq (a : α) (s : set α) :
  𝓝[s] a = ⨅ t ∈ {t : set α | a ∈ t ∧ is_open t}, 𝓟 (t ∩ s) :=
((nhds_basis_opens a).inf_principal s).eq_binfi

theorem nhds_within_univ (a : α) : 𝓝[set.univ] a = 𝓝 a :=
by rw [nhds_within, principal_univ, inf_top_eq]

lemma nhds_within_has_basis {p : β → Prop} {s : β → set α} {a : α} (h : (𝓝 a).has_basis p s)
  (t : set α) :
  (𝓝[t] a).has_basis p (λ i, s i ∩ t) :=
h.inf_principal t

lemma nhds_within_basis_open (a : α) (t : set α) :
  (𝓝[t] a).has_basis (λ u, a ∈ u ∧ is_open u) (λ u, u ∩ t) :=
nhds_within_has_basis (nhds_basis_opens a) t

theorem mem_nhds_within {t : set α} {a : α} {s : set α} :
  t ∈ 𝓝[s] a ↔ ∃ u, is_open u ∧ a ∈ u ∧ u ∩ s ⊆ t  :=
by simpa only [exists_prop, and_assoc, and_comm] using (nhds_within_basis_open a s).mem_iff

lemma mem_nhds_within_iff_exists_mem_nhds_inter {t : set α} {a : α} {s : set α} :
  t ∈ 𝓝[s] a ↔ ∃ u ∈ 𝓝 a, u ∩ s ⊆ t :=
(nhds_within_has_basis (𝓝 a).basis_sets s).mem_iff

lemma diff_mem_nhds_within_compl {x : α} {s : set α} (hs : s ∈ 𝓝 x) (t : set α) :
  s \ t ∈ 𝓝[tᶜ] x :=
diff_mem_inf_principal_compl hs t

lemma diff_mem_nhds_within_diff {x : α} {s t : set α} (hs : s ∈ 𝓝[t] x) (t' : set α) :
  s \ t' ∈ 𝓝[t \ t'] x :=
begin
  rw [nhds_within, diff_eq, diff_eq, ← inf_principal, ← inf_assoc],
  exact inter_mem_inf hs (mem_principal_self _)
end

lemma nhds_of_nhds_within_of_nhds
  {s t : set α} {a : α} (h1 : s ∈ 𝓝 a) (h2 : t ∈ 𝓝[s] a) : (t ∈ 𝓝 a) :=
begin
  rcases mem_nhds_within_iff_exists_mem_nhds_inter.mp h2 with ⟨_, Hw, hw⟩,
  exact (nhds a).sets_of_superset ((nhds a).inter_sets Hw h1) hw,
end

lemma preimage_nhds_within_coinduced' {π : α → β} {s : set β} {t : set α} {a : α}
  (h : a ∈ t) (ht : is_open t)
  (hs : s ∈ @nhds β (topological_space.coinduced (λ x : t, π x) subtype.topological_space) (π a)) :
  π ⁻¹' s ∈ 𝓝[t] a :=
begin
  letI := topological_space.coinduced (λ x : t, π x) subtype.topological_space,
  rcases mem_nhds_iff.mp hs with ⟨V, hVs, V_op, mem_V⟩,
  refine mem_nhds_within_iff_exists_mem_nhds_inter.mpr ⟨π ⁻¹' V, mem_nhds_iff.mpr ⟨t ∩ π ⁻¹' V,
    inter_subset_right t (π ⁻¹' V), _, mem_sep h mem_V⟩, subset.trans (inter_subset_left _ _)
    (preimage_mono hVs)⟩,
  obtain ⟨u, hu1, hu2⟩ := is_open_induced_iff.mp (is_open_coinduced.1 V_op),
  rw [preimage_comp] at hu2,
  rw [set.inter_comm, ←(subtype.preimage_coe_eq_preimage_coe_iff.mp hu2)],
  exact hu1.inter ht,
end

lemma mem_nhds_within_of_mem_nhds {s t : set α} {a : α} (h : s ∈ 𝓝 a) :
  s ∈ 𝓝[t] a :=
mem_inf_of_left h

theorem self_mem_nhds_within {a : α} {s : set α} : s ∈ 𝓝[s] a :=
mem_inf_of_right (mem_principal_self s)

theorem inter_mem_nhds_within (s : set α) {t : set α} {a : α} (h : t ∈ 𝓝 a) :
  s ∩ t ∈ 𝓝[s] a :=
inter_mem self_mem_nhds_within (mem_inf_of_left h)

theorem nhds_within_mono (a : α) {s t : set α} (h : s ⊆ t) : 𝓝[s] a ≤ 𝓝[t] a :=
inf_le_inf_left _ (principal_mono.mpr h)

lemma pure_le_nhds_within {a : α} {s : set α} (ha : a ∈ s) : pure a ≤ 𝓝[s] a :=
le_inf (pure_le_nhds a) (le_principal_iff.2 ha)

lemma mem_of_mem_nhds_within {a : α} {s t : set α} (ha : a ∈ s) (ht : t ∈ 𝓝[s] a) :
  a ∈ t :=
pure_le_nhds_within ha ht

lemma filter.eventually.self_of_nhds_within {p : α → Prop} {s : set α} {x : α}
  (h : ∀ᶠ y in 𝓝[s] x, p y) (hx : x ∈ s) : p x :=
mem_of_mem_nhds_within hx h

lemma tendsto_const_nhds_within {l : filter β} {s : set α} {a : α} (ha : a ∈ s) :
  tendsto (λ x : β, a) l (𝓝[s] a) :=
tendsto_const_pure.mono_right $ pure_le_nhds_within ha

theorem nhds_within_restrict'' {a : α} (s : set α) {t : set α} (h : t ∈ 𝓝[s] a) :
  𝓝[s] a = 𝓝[s ∩ t] a :=
le_antisymm
  (le_inf inf_le_left (le_principal_iff.mpr (inter_mem self_mem_nhds_within h)))
  (inf_le_inf_left _ (principal_mono.mpr (set.inter_subset_left _ _)))

theorem nhds_within_restrict' {a : α} (s : set α) {t : set α} (h : t ∈ 𝓝 a) :
  𝓝[s] a = 𝓝[s ∩ t] a :=
nhds_within_restrict'' s $ mem_inf_of_left h

theorem nhds_within_restrict {a : α} (s : set α) {t : set α} (h₀ : a ∈ t) (h₁ : is_open t) :
  𝓝[s] a = 𝓝[s ∩ t] a :=
nhds_within_restrict' s (is_open.mem_nhds h₁ h₀)

theorem nhds_within_le_of_mem {a : α} {s t : set α} (h : s ∈ 𝓝[t] a) :
  𝓝[t] a ≤ 𝓝[s] a :=
begin
  rcases mem_nhds_within.1 h with ⟨u, u_open, au, uts⟩,
  have : 𝓝[t] a = 𝓝[t ∩ u] a := nhds_within_restrict _ au u_open,
  rw [this, inter_comm],
  exact nhds_within_mono _ uts
end

theorem nhds_within_le_nhds {a : α} {s : set α} : 𝓝[s] a ≤ 𝓝 a :=
by { rw ← nhds_within_univ, apply nhds_within_le_of_mem, exact univ_mem }

lemma nhds_within_eq_nhds_within' {a : α} {s t u : set α}
  (hs : s ∈ 𝓝 a) (h₂ : t ∩ s = u ∩ s) : 𝓝[t] a = 𝓝[u] a :=
by rw [nhds_within_restrict' t hs, nhds_within_restrict' u hs, h₂]

theorem nhds_within_eq_nhds_within {a : α} {s t u : set α}
    (h₀ : a ∈ s) (h₁ : is_open s) (h₂ : t ∩ s = u ∩ s) :
  𝓝[t] a = 𝓝[u] a :=
by rw [nhds_within_restrict t h₀ h₁, nhds_within_restrict u h₀ h₁, h₂]

theorem is_open.nhds_within_eq {a : α} {s : set α} (h : is_open s) (ha : a ∈ s) :
  𝓝[s] a = 𝓝 a :=
inf_eq_left.2 $ le_principal_iff.2 $ is_open.mem_nhds h ha

lemma preimage_nhds_within_coinduced {π : α → β} {s : set β} {t : set α} {a : α}
  (h : a ∈ t) (ht : is_open t)
  (hs : s ∈ @nhds β (topological_space.coinduced (λ x : t, π x) subtype.topological_space) (π a)) :
  π ⁻¹' s ∈ 𝓝 a :=
by { rw ← ht.nhds_within_eq h, exact preimage_nhds_within_coinduced' h ht hs }

@[simp] theorem nhds_within_empty (a : α) : 𝓝[∅] a = ⊥ :=
by rw [nhds_within, principal_empty, inf_bot_eq]

theorem nhds_within_union (a : α) (s t : set α) :
  𝓝[s ∪ t] a = 𝓝[s] a ⊔ 𝓝[t] a :=
by { delta nhds_within, rw [←inf_sup_left, sup_principal] }

theorem nhds_within_inter (a : α) (s t : set α) :
  𝓝[s ∩ t] a = 𝓝[s] a ⊓ 𝓝[t] a :=
by { delta nhds_within, rw [inf_left_comm, inf_assoc, inf_principal, ←inf_assoc, inf_idem] }

theorem nhds_within_inter' (a : α) (s t : set α) :
  𝓝[s ∩ t] a = (𝓝[s] a) ⊓ 𝓟 t :=
by { delta nhds_within, rw [←inf_principal, inf_assoc] }

theorem nhds_within_inter_of_mem {a : α} {s t : set α} (h : s ∈ 𝓝[t] a) :
  𝓝[s ∩ t] a = 𝓝[t] a :=
by { rw [nhds_within_inter, inf_eq_right], exact nhds_within_le_of_mem h }

@[simp] theorem nhds_within_singleton (a : α) : 𝓝[{a}] a = pure a :=
by rw [nhds_within, principal_singleton, inf_eq_right.2 (pure_le_nhds a)]

@[simp] theorem nhds_within_insert (a : α) (s : set α) :
  𝓝[insert a s] a = pure a ⊔ 𝓝[s] a :=
by rw [← singleton_union, nhds_within_union, nhds_within_singleton]

lemma mem_nhds_within_insert {a : α} {s t : set α} :
  t ∈ 𝓝[insert a s] a ↔ a ∈ t ∧ t ∈ 𝓝[s] a :=
by simp

lemma insert_mem_nhds_within_insert {a : α} {s t : set α} (h : t ∈ 𝓝[s] a) :
  insert a t ∈ 𝓝[insert a s] a :=
by simp [mem_of_superset h]

lemma insert_mem_nhds_iff {a : α} {s : set α} : insert a s ∈ 𝓝 a ↔ s ∈ 𝓝[≠] a :=
by simp only [nhds_within, mem_inf_principal, mem_compl_iff, mem_singleton_iff,
  or_iff_not_imp_left, insert_def]

@[simp] theorem nhds_within_compl_singleton_sup_pure (a : α) : 𝓝[≠] a ⊔ pure a = 𝓝 a :=
by rw [← nhds_within_singleton, ← nhds_within_union, compl_union_self, nhds_within_univ]

lemma nhds_within_prod_eq {α : Type*} [topological_space α] {β : Type*} [topological_space β]
  (a : α) (b : β) (s : set α) (t : set β) :
  𝓝[s ×ˢ t] (a, b) = 𝓝[s] a ×ᶠ 𝓝[t] b :=
by { delta nhds_within, rw [nhds_prod_eq, ←filter.prod_inf_prod, filter.prod_principal_principal] }

lemma nhds_within_prod {α : Type*} [topological_space α] {β : Type*} [topological_space β]
  {s u : set α} {t v : set β} {a : α} {b : β}
  (hu : u ∈ 𝓝[s] a) (hv : v ∈ 𝓝[t] b) :
  (u ×ˢ v) ∈ 𝓝[s ×ˢ t] (a, b) :=
by { rw nhds_within_prod_eq, exact prod_mem_prod hu hv, }

lemma nhds_within_pi_eq' {ι : Type*} {α : ι → Type*} [Π i, topological_space (α i)]
  {I : set ι} (hI : finite I) (s : Π i, set (α i)) (x : Π i, α i) :
  𝓝[pi I s] x = ⨅ i, comap (λ x, x i) (𝓝 (x i) ⊓ ⨅ (hi : i ∈ I), 𝓟 (s i)) :=
by simp only [nhds_within, nhds_pi, filter.pi, comap_inf, comap_infi, pi_def, comap_principal,
  ← infi_principal_finite hI, ← infi_inf_eq]

lemma nhds_within_pi_eq {ι : Type*} {α : ι → Type*} [Π i, topological_space (α i)]
  {I : set ι} (hI : finite I) (s : Π i, set (α i)) (x : Π i, α i) :
  𝓝[pi I s] x = (⨅ i ∈ I, comap (λ x, x i) (𝓝[s i] (x i))) ⊓
    ⨅ (i ∉ I), comap (λ x, x i) (𝓝 (x i)) :=
begin
  simp only [nhds_within, nhds_pi, filter.pi, pi_def, ← infi_principal_finite hI, comap_inf,
    comap_principal, eval],
  rw [infi_split _ (λ i, i ∈ I), inf_right_comm],
  simp only [infi_inf_eq]
end

lemma nhds_within_pi_univ_eq {ι : Type*} {α : ι → Type*} [fintype ι] [Π i, topological_space (α i)]
  (s : Π i, set (α i)) (x : Π i, α i) :
  𝓝[pi univ s] x = ⨅ i, comap (λ x, x i) 𝓝[s i] (x i) :=
by simpa [nhds_within] using nhds_within_pi_eq finite_univ s x

lemma nhds_within_pi_eq_bot {ι : Type*} {α : ι → Type*} [Π i, topological_space (α i)]
  {I : set ι} {s : Π i, set (α i)} {x : Π i, α i} :
  𝓝[pi I s] x = ⊥ ↔ ∃ i ∈ I, 𝓝[s i] (x i) = ⊥ :=
by simp only [nhds_within, nhds_pi, pi_inf_principal_pi_eq_bot]

lemma nhds_within_pi_ne_bot {ι : Type*} {α : ι → Type*} [Π i, topological_space (α i)]
  {I : set ι} {s : Π i, set (α i)} {x : Π i, α i} :
  (𝓝[pi I s] x).ne_bot ↔ ∀ i ∈ I, (𝓝[s i] (x i)).ne_bot :=
by simp [ne_bot_iff, nhds_within_pi_eq_bot]

theorem filter.tendsto.piecewise_nhds_within {f g : α → β} {t : set α} [∀ x, decidable (x ∈ t)]
  {a : α} {s : set α} {l : filter β}
  (h₀ : tendsto f (𝓝[s ∩ t] a) l) (h₁ : tendsto g (𝓝[s ∩ tᶜ] a) l) :
  tendsto (piecewise t f g) (𝓝[s] a) l :=
by apply tendsto.piecewise; rwa ← nhds_within_inter'

theorem filter.tendsto.if_nhds_within {f g : α → β} {p : α → Prop} [decidable_pred p]
    {a : α} {s : set α} {l : filter β}
    (h₀ : tendsto f (𝓝[s ∩ {x | p x}] a) l)
    (h₁ : tendsto g (𝓝[s ∩ {x | ¬ p x}] a) l) :
  tendsto (λ x, if p x then f x else g x) (𝓝[s] a) l :=
h₀.piecewise_nhds_within h₁

lemma map_nhds_within (f : α → β) (a : α) (s : set α) :
  map f (𝓝[s] a) = ⨅ t ∈ {t : set α | a ∈ t ∧ is_open t}, 𝓟 (f  '' (t ∩ s)) :=
((nhds_within_basis_open a s).map f).eq_binfi

theorem tendsto_nhds_within_mono_left {f : α → β} {a : α}
    {s t : set α} {l : filter β} (hst : s ⊆ t) (h : tendsto f (𝓝[t] a) l) :
  tendsto f (𝓝[s] a) l :=
h.mono_left $ nhds_within_mono a hst

theorem tendsto_nhds_within_mono_right {f : β → α} {l : filter β}
    {a : α} {s t : set α} (hst : s ⊆ t) (h : tendsto f l (𝓝[s] a)) :
  tendsto f l (𝓝[t] a) :=
h.mono_right (nhds_within_mono a hst)

theorem tendsto_nhds_within_of_tendsto_nhds {f : α → β} {a : α}
    {s : set α} {l : filter β} (h : tendsto f (𝓝 a) l) :
  tendsto f (𝓝[s] a) l :=
h.mono_left inf_le_left

theorem principal_subtype {α : Type*} (s : set α) (t : set {x // x ∈ s}) :
  𝓟 t = comap coe (𝓟 ((coe : s → α) '' t)) :=
by rw [comap_principal, set.preimage_image_eq _ subtype.coe_injective]

lemma nhds_within_ne_bot_of_mem {s : set α} {x : α} (hx : x ∈ s) :
  ne_bot (𝓝[s] x) :=
mem_closure_iff_nhds_within_ne_bot.1 $ subset_closure hx

lemma is_closed.mem_of_nhds_within_ne_bot {s : set α} (hs : is_closed s)
  {x : α} (hx : ne_bot $ 𝓝[s] x) : x ∈ s :=
by simpa only [hs.closure_eq] using mem_closure_iff_nhds_within_ne_bot.2 hx

lemma dense_range.nhds_within_ne_bot {ι : Type*} {f : ι → α} (h : dense_range f) (x : α) :
  ne_bot (𝓝[range f] x) :=
mem_closure_iff_cluster_pt.1 (h x)

lemma mem_closure_pi {ι : Type*} {α : ι → Type*} [Π i, topological_space (α i)]
  {I : set ι} {s : Π i, set (α i)} {x : Π i, α i} :
  x ∈ closure (pi I s) ↔ ∀ i ∈ I, x i ∈ closure (s i) :=
by simp only [mem_closure_iff_nhds_within_ne_bot, nhds_within_pi_ne_bot]

lemma closure_pi_set {ι : Type*} {α : ι → Type*} [Π i, topological_space (α i)]
  (I : set ι) (s : Π i, set (α i)) :
  closure (pi I s) = pi I (λ i, closure (s i)) :=
set.ext $ λ x, mem_closure_pi

lemma dense_pi {ι : Type*} {α : ι → Type*} [Π i, topological_space (α i)] {s : Π i, set (α i)}
  (I : set ι) (hs : ∀ i ∈ I, dense (s i)) :
  dense (pi I s) :=
by simp only [dense_iff_closure_eq, closure_pi_set,
  pi_congr rfl (λ i hi, (hs i hi).closure_eq), pi_univ]

lemma eventually_eq_nhds_within_iff {f g : α → β} {s : set α} {a : α} :
  (f =ᶠ[𝓝[s] a] g) ↔ ∀ᶠ x in 𝓝 a, x ∈ s → f x = g x :=
mem_inf_principal

lemma eventually_eq_nhds_within_of_eq_on {f g : α → β} {s : set α} {a : α} (h : eq_on f g s) :
  f =ᶠ[𝓝[s] a] g :=
mem_inf_of_right h

lemma set.eq_on.eventually_eq_nhds_within {f g : α → β} {s : set α} {a : α} (h : eq_on f g s) :
  f =ᶠ[𝓝[s] a] g :=
eventually_eq_nhds_within_of_eq_on h

lemma tendsto_nhds_within_congr {f g : α → β} {s : set α} {a : α} {l : filter β}
  (hfg : ∀ x ∈ s, f x = g x) (hf : tendsto f (𝓝[s] a) l) : tendsto g (𝓝[s] a) l :=
(tendsto_congr' $ eventually_eq_nhds_within_of_eq_on hfg).1 hf

lemma eventually_nhds_within_of_forall {s : set α} {a : α} {p : α → Prop} (h : ∀ x ∈ s, p x) :
  ∀ᶠ x in 𝓝[s] a, p x :=
mem_inf_of_right h

lemma tendsto_nhds_within_of_tendsto_nhds_of_eventually_within {a : α} {l : filter β}
  {s : set α} (f : β → α) (h1 : tendsto f l (𝓝 a)) (h2 : ∀ᶠ x in l, f x ∈ s) :
  tendsto f l (𝓝[s] a) :=
tendsto_inf.2 ⟨h1, tendsto_principal.2 h2⟩

@[simp] lemma tendsto_nhds_within_range {a : α} {l : filter β} {f : β → α} :
  tendsto f l (𝓝[range f] a) ↔ tendsto f l (𝓝 a) :=
⟨λ h, h.mono_right inf_le_left, λ h, tendsto_inf.2
  ⟨h, tendsto_principal.2 $ eventually_of_forall mem_range_self⟩⟩

lemma filter.eventually_eq.eq_of_nhds_within {s : set α} {f g : α → β} {a : α}
  (h : f =ᶠ[𝓝[s] a] g) (hmem : a ∈ s) : f a = g a :=
h.self_of_nhds_within hmem

lemma eventually_nhds_within_of_eventually_nhds {α : Type*} [topological_space α]
  {s : set α} {a : α} {p : α → Prop} (h : ∀ᶠ x in 𝓝 a, p x) :
  ∀ᶠ x in 𝓝[s] a, p x :=
mem_nhds_within_of_mem_nhds h

/-!
### `nhds_within` and subtypes
-/

theorem mem_nhds_within_subtype {s : set α} {a : {x // x ∈ s}} {t u : set {x // x ∈ s}} :
  t ∈ 𝓝[u] a ↔ t ∈ comap (coe : s → α) (𝓝[coe '' u] a) :=
by rw [nhds_within, nhds_subtype, principal_subtype, ←comap_inf, ←nhds_within]

theorem nhds_within_subtype (s : set α) (a : {x // x ∈ s}) (t : set {x // x ∈ s}) :
  𝓝[t] a = comap (coe : s → α) (𝓝[coe '' t] a) :=
filter.ext $ λ u, mem_nhds_within_subtype

theorem nhds_within_eq_map_subtype_coe {s : set α} {a : α} (h : a ∈ s) :
  𝓝[s] a = map (coe : s → α) (𝓝 ⟨a, h⟩) :=
by simpa only [subtype.range_coe] using (embedding_subtype_coe.map_nhds_eq ⟨a, h⟩).symm

theorem mem_nhds_subtype_iff_nhds_within {s : set α} {a : s} {t : set s} :
  t ∈ 𝓝 a ↔ coe '' t ∈ 𝓝[s] (a : α) :=
by rw [nhds_within_eq_map_subtype_coe a.coe_prop, mem_map,
  preimage_image_eq _ subtype.coe_injective, subtype.coe_eta]

theorem preimage_coe_mem_nhds_subtype {s t : set α} {a : s} :
  coe ⁻¹' t ∈ 𝓝 a ↔ t ∈ 𝓝[s] ↑a :=
by simp only [mem_nhds_subtype_iff_nhds_within, subtype.image_preimage_coe, inter_mem_iff,
  self_mem_nhds_within, and_true]

theorem tendsto_nhds_within_iff_subtype {s : set α} {a : α} (h : a ∈ s) (f : α → β) (l : filter β) :
  tendsto f (𝓝[s] a) l ↔ tendsto (s.restrict f) (𝓝 ⟨a, h⟩) l :=
by simp only [tendsto, nhds_within_eq_map_subtype_coe h, filter.map_map, restrict]

variables [topological_space β] [topological_space γ] [topological_space δ]

/-- A function between topological spaces is continuous at a point `x₀` within a subset `s`
if `f x` tends to `f x₀` when `x` tends to `x₀` while staying within `s`. -/
def continuous_within_at (f : α → β) (s : set α) (x : α) : Prop :=
tendsto f (𝓝[s] x) (𝓝 (f x))

/-- If a function is continuous within `s` at `x`, then it tends to `f x` within `s` by definition.
We register this fact for use with the dot notation, especially to use `tendsto.comp` as
`continuous_within_at.comp` will have a different meaning. -/
lemma continuous_within_at.tendsto {f : α → β} {s : set α} {x : α}
  (h : continuous_within_at f s x) :
  tendsto f (𝓝[s] x) (𝓝 (f x)) := h

/-- A function between topological spaces is continuous on a subset `s`
when it's continuous at every point of `s` within `s`. -/
def continuous_on (f : α → β) (s : set α) : Prop := ∀ x ∈ s, continuous_within_at f s x

lemma continuous_on.continuous_within_at {f : α → β} {s : set α} {x : α} (hf : continuous_on f s)
  (hx : x ∈ s) : continuous_within_at f s x :=
hf x hx

theorem continuous_within_at_univ (f : α → β) (x : α) :
  continuous_within_at f set.univ x ↔ continuous_at f x :=
by rw [continuous_at, continuous_within_at, nhds_within_univ]

theorem continuous_within_at_iff_continuous_at_restrict (f : α → β) {x : α} {s : set α}
  (h : x ∈ s) :
  continuous_within_at f s x ↔ continuous_at (s.restrict f) ⟨x, h⟩ :=
tendsto_nhds_within_iff_subtype h f _

theorem continuous_within_at.tendsto_nhds_within {f : α → β} {x : α} {s : set α} {t : set β}
  (h : continuous_within_at f s x) (ht : maps_to f s t) :
  tendsto f (𝓝[s] x) (𝓝[t] (f x)) :=
tendsto_inf.2 ⟨h, tendsto_principal.2 $ mem_inf_of_right $ mem_principal.2 $ ht⟩

theorem continuous_within_at.tendsto_nhds_within_image {f : α → β} {x : α} {s : set α}
  (h : continuous_within_at f s x) :
  tendsto f (𝓝[s] x) (𝓝[f '' s] (f x)) :=
h.tendsto_nhds_within (maps_to_image _ _)

lemma continuous_within_at.prod_map {f : α → γ} {g : β → δ} {s : set α} {t : set β}
  {x : α} {y : β}
  (hf : continuous_within_at f s x) (hg : continuous_within_at g t y) :
  continuous_within_at (prod.map f g) (s ×ˢ t) (x, y) :=
begin
  unfold continuous_within_at at *,
  rw [nhds_within_prod_eq, prod.map, nhds_prod_eq],
  exact hf.prod_map hg,
end

lemma continuous_within_at_pi {ι : Type*} {π : ι → Type*} [∀ i, topological_space (π i)]
  {f : α → Π i, π i} {s : set α} {x : α} :
  continuous_within_at f s x ↔ ∀ i, continuous_within_at (λ y, f y i) s x :=
tendsto_pi_nhds

lemma continuous_on_pi {ι : Type*} {π : ι → Type*} [∀ i, topological_space (π i)]
  {f : α → Π i, π i} {s : set α} :
  continuous_on f s ↔ ∀ i, continuous_on (λ y, f y i) s :=
⟨λ h i x hx, tendsto_pi_nhds.1 (h x hx) i, λ h x hx, tendsto_pi_nhds.2 (λ i, h i x hx)⟩

lemma continuous_within_at.fin_insert_nth {n} {π : fin (n + 1) → Type*}
  [Π i, topological_space (π i)] (i : fin (n + 1)) {f : α → π i} {a : α} {s : set α}
  (hf : continuous_within_at f s a)
  {g : α → Π j : fin n, π (i.succ_above j)} (hg : continuous_within_at g s a) :
  continuous_within_at (λ a, i.insert_nth (f a) (g a)) s a :=
hf.fin_insert_nth i hg

lemma continuous_on.fin_insert_nth {n} {π : fin (n + 1) → Type*} [Π i, topological_space (π i)]
  (i : fin (n + 1)) {f : α → π i} {s : set α} (hf : continuous_on f s)
  {g : α → Π j : fin n, π (i.succ_above j)} (hg : continuous_on g s) :
  continuous_on (λ a, i.insert_nth (f a) (g a)) s :=
λ a ha, (hf a ha).fin_insert_nth i (hg a ha)

theorem continuous_on_iff {f : α → β} {s : set α} :
  continuous_on f s ↔ ∀ x ∈ s, ∀ t : set β, is_open t → f x ∈ t → ∃ u, is_open u ∧ x ∈ u ∧
    u ∩ s ⊆ f ⁻¹' t :=
by simp only [continuous_on, continuous_within_at, tendsto_nhds, mem_nhds_within]

theorem continuous_on_iff_continuous_restrict {f : α → β} {s : set α} :
  continuous_on f s ↔ continuous (s.restrict f) :=
begin
  rw [continuous_on, continuous_iff_continuous_at], split,
  { rintros h ⟨x, xs⟩,
    exact (continuous_within_at_iff_continuous_at_restrict f xs).mp (h x xs) },
  intros h x xs,
  exact (continuous_within_at_iff_continuous_at_restrict f xs).mpr (h ⟨x, xs⟩)
end

theorem continuous_on_iff' {f : α → β} {s : set α} :
  continuous_on f s ↔ ∀ t : set β, is_open t → ∃ u, is_open u ∧ f ⁻¹' t ∩ s = u ∩ s :=
have ∀ t, is_open (s.restrict f ⁻¹' t) ↔ ∃ (u : set α), is_open u ∧ f ⁻¹' t ∩ s = u ∩ s,
  begin
    intro t,
    rw [is_open_induced_iff, set.restrict_eq, set.preimage_comp],
    simp only [subtype.preimage_coe_eq_preimage_coe_iff],
    split; { rintros ⟨u, ou, useq⟩, exact ⟨u, ou, useq.symm⟩ }
  end,
by rw [continuous_on_iff_continuous_restrict, continuous_def]; simp only [this]

theorem continuous_on_iff_is_closed {f : α → β} {s : set α} :
  continuous_on f s ↔ ∀ t : set β, is_closed t → ∃ u, is_closed u ∧ f ⁻¹' t ∩ s = u ∩ s :=
have ∀ t, is_closed (s.restrict f ⁻¹' t) ↔ ∃ (u : set α), is_closed u ∧ f ⁻¹' t ∩ s = u ∩ s,
  begin
    intro t,
    rw [is_closed_induced_iff, set.restrict_eq, set.preimage_comp],
    simp only [subtype.preimage_coe_eq_preimage_coe_iff, eq_comm]
  end,
by rw [continuous_on_iff_continuous_restrict, continuous_iff_is_closed]; simp only [this]

lemma continuous_on.prod_map {f : α → γ} {g : β → δ} {s : set α} {t : set β}
  (hf : continuous_on f s) (hg : continuous_on g t) :
  continuous_on (prod.map f g) (s ×ˢ t) :=
λ ⟨x, y⟩ ⟨hx, hy⟩, continuous_within_at.prod_map (hf x hx) (hg y hy)

lemma continuous_on_empty (f : α → β) : continuous_on f ∅ :=
λ x, false.elim

theorem nhds_within_le_comap {x : α} {s : set α} {f : α → β} (ctsf : continuous_within_at f s x) :
  𝓝[s] x ≤ comap f (𝓝[f '' s] (f x)) :=
map_le_iff_le_comap.1 ctsf.tendsto_nhds_within_image

theorem continuous_within_at_iff_ptendsto_res (f : α → β) {x : α} {s : set α} :
  continuous_within_at f s x ↔ ptendsto (pfun.res f s) (𝓝 x) (𝓝 (f x)) :=
tendsto_iff_ptendsto _ _ _ _

lemma continuous_iff_continuous_on_univ {f : α → β} : continuous f ↔ continuous_on f univ :=
by simp [continuous_iff_continuous_at, continuous_on, continuous_at, continuous_within_at,
         nhds_within_univ]

lemma continuous_within_at.mono {f : α → β} {s t : set α} {x : α} (h : continuous_within_at f t x)
  (hs : s ⊆ t) : continuous_within_at f s x :=
h.mono_left (nhds_within_mono x hs)

lemma continuous_within_at.mono_of_mem {f : α → β} {s t : set α} {x : α}
  (h : continuous_within_at f t x) (hs : t ∈ 𝓝[s] x) : continuous_within_at f s x :=
h.mono_left (nhds_within_le_of_mem hs)

lemma continuous_within_at_inter' {f : α → β} {s t : set α} {x : α} (h : t ∈ 𝓝[s] x) :
  continuous_within_at f (s ∩ t) x ↔ continuous_within_at f s x :=
by simp [continuous_within_at, nhds_within_restrict'' s h]

lemma continuous_within_at_inter {f : α → β} {s t : set α} {x : α} (h : t ∈ 𝓝 x) :
  continuous_within_at f (s ∩ t) x ↔ continuous_within_at f s x :=
by simp [continuous_within_at, nhds_within_restrict' s h]

lemma continuous_within_at_union {f : α → β} {s t : set α} {x : α} :
  continuous_within_at f (s ∪ t) x ↔ continuous_within_at f s x ∧ continuous_within_at f t x :=
by simp only [continuous_within_at, nhds_within_union, tendsto_sup]

lemma continuous_within_at.union {f : α → β} {s t : set α} {x : α}
  (hs : continuous_within_at f s x) (ht : continuous_within_at f t x) :
  continuous_within_at f (s ∪ t) x :=
continuous_within_at_union.2 ⟨hs, ht⟩

lemma continuous_within_at.mem_closure_image  {f : α → β} {s : set α} {x : α}
  (h : continuous_within_at f s x) (hx : x ∈ closure s) : f x ∈ closure (f '' s) :=
by haveI := (mem_closure_iff_nhds_within_ne_bot.1 hx);
exact (mem_closure_of_tendsto h $
  mem_of_superset self_mem_nhds_within (subset_preimage_image f s))

lemma continuous_within_at.mem_closure {f : α → β} {s : set α} {x : α} {A : set β}
  (h : continuous_within_at f s x) (hx : x ∈ closure s) (hA : s ⊆ f⁻¹' A) : f x ∈ closure A :=
closure_mono (image_subset_iff.2 hA) (h.mem_closure_image hx)

lemma continuous_within_at.image_closure {f : α → β} {s : set α}
  (hf : ∀ x ∈ closure s, continuous_within_at f s x) :
  f '' (closure s) ⊆ closure (f '' s) :=
begin
  rintros _ ⟨x, hx, rfl⟩,
  exact (hf x hx).mem_closure_image hx
end

lemma continuous_on.image_closure {f : α → β} {s : set α} (hf : continuous_on f (closure s)) :
  f '' (closure s) ⊆ closure (f '' s) :=
continuous_within_at.image_closure $ λ x hx, (hf x hx).mono subset_closure

@[simp] lemma continuous_within_at_singleton {f : α → β} {x : α} : continuous_within_at f {x} x :=
by simp only [continuous_within_at, nhds_within_singleton, tendsto_pure_nhds]

@[simp] lemma continuous_within_at_insert_self {f : α → β} {x : α} {s : set α} :
  continuous_within_at f (insert x s) x ↔ continuous_within_at f s x :=
by simp only [← singleton_union, continuous_within_at_union, continuous_within_at_singleton,
  true_and]

alias continuous_within_at_insert_self ↔ _ continuous_within_at.insert_self

lemma continuous_within_at.diff_iff {f : α → β} {s t : set α} {x : α}
  (ht : continuous_within_at f t x) :
  continuous_within_at f (s \ t) x ↔ continuous_within_at f s x :=
⟨λ h, (h.union ht).mono $ by simp only [diff_union_self, subset_union_left],
  λ h, h.mono (diff_subset _ _)⟩

@[simp] lemma continuous_within_at_diff_self {f : α → β} {s : set α} {x : α} :
  continuous_within_at f (s \ {x}) x ↔ continuous_within_at f s x :=
continuous_within_at_singleton.diff_iff

@[simp] lemma continuous_within_at_compl_self {f : α → β} {a : α} :
  continuous_within_at f {a}ᶜ a ↔ continuous_at f a :=
by rw [compl_eq_univ_diff, continuous_within_at_diff_self, continuous_within_at_univ]

@[simp] lemma continuous_within_at_update_same [decidable_eq α] {f : α → β}
  {s : set α} {x : α} {y : β} :
  continuous_within_at (update f x y) s x ↔ tendsto f (𝓝[s \ {x}] x) (𝓝 y) :=
calc continuous_within_at (update f x y) s x ↔ tendsto (update f x y) (𝓝[s \ {x}] x) (𝓝 y) :
  by rw [← continuous_within_at_diff_self, continuous_within_at, function.update_same]
... ↔ tendsto f (𝓝[s \ {x}] x) (𝓝 y) :
  tendsto_congr' $ eventually_nhds_within_iff.2 $ eventually_of_forall $
    λ z hz, update_noteq hz.2 _ _

@[simp] lemma continuous_at_update_same [decidable_eq α] {f : α → β} {x : α} {y : β} :
  continuous_at (function.update f x y) x ↔ tendsto f (𝓝[≠] x) (𝓝 y) :=
by rw [← continuous_within_at_univ, continuous_within_at_update_same, compl_eq_univ_diff]

theorem is_open_map.continuous_on_image_of_left_inv_on {f : α → β} {s : set α}
  (h : is_open_map (s.restrict f)) {finv : β → α} (hleft : left_inv_on finv f s) :
  continuous_on finv (f '' s) :=
begin
  refine continuous_on_iff'.2 (λ t ht, ⟨f '' (t ∩ s), _, _⟩),
  { rw ← image_restrict, exact h _ (ht.preimage continuous_subtype_coe) },
  { rw [inter_eq_self_of_subset_left (image_subset f (inter_subset_right t s)),
      hleft.image_inter'] },
end

theorem is_open_map.continuous_on_range_of_left_inverse {f : α → β} (hf : is_open_map f)
  {finv : β → α} (hleft : function.left_inverse finv f) :
  continuous_on finv (range f) :=
begin
  rw [← image_univ],
  exact (hf.restrict is_open_univ).continuous_on_image_of_left_inv_on (λ x _, hleft x)
end

lemma continuous_on.congr_mono {f g : α → β} {s s₁ : set α} (h : continuous_on f s)
  (h' : eq_on g f s₁) (h₁ : s₁ ⊆ s) : continuous_on g s₁ :=
begin
  assume x hx,
  unfold continuous_within_at,
  have A := (h x (h₁ hx)).mono h₁,
  unfold continuous_within_at at A,
  rw ← h' hx at A,
  exact A.congr' h'.eventually_eq_nhds_within.symm
end

lemma continuous_on.congr {f g : α → β} {s : set α} (h : continuous_on f s) (h' : eq_on g f s) :
  continuous_on g s :=
h.congr_mono h' (subset.refl _)

lemma continuous_on_congr {f g : α → β} {s : set α} (h' : eq_on g f s) :
  continuous_on g s ↔ continuous_on f s :=
⟨λ h, continuous_on.congr h h'.symm, λ h, h.congr h'⟩

lemma continuous_at.continuous_within_at {f : α → β} {s : set α} {x : α} (h : continuous_at f x) :
  continuous_within_at f s x :=
continuous_within_at.mono ((continuous_within_at_univ f x).2 h) (subset_univ _)

lemma continuous_within_at_iff_continuous_at {f : α → β} {s : set α} {x : α} (h : s ∈ 𝓝 x) :
  continuous_within_at f s x ↔ continuous_at f x :=
by rw [← univ_inter s, continuous_within_at_inter h, continuous_within_at_univ]

lemma continuous_within_at.continuous_at {f : α → β} {s : set α} {x : α}
  (h : continuous_within_at f s x) (hs : s ∈ 𝓝 x) : continuous_at f x :=
(continuous_within_at_iff_continuous_at hs).mp h

lemma continuous_on.continuous_at {f : α → β} {s : set α} {x : α}
  (h : continuous_on f s) (hx : s ∈ 𝓝 x) : continuous_at f x :=
(h x (mem_of_mem_nhds hx)).continuous_at hx

lemma continuous_at.continuous_on {f : α → β} {s : set α} (hcont : ∀ x ∈ s, continuous_at f x) :
  continuous_on f s :=
λ x hx, (hcont x hx).continuous_within_at

lemma continuous_within_at.comp {g : β → γ} {f : α → β} {s : set α} {t : set β} {x : α}
  (hg : continuous_within_at g t (f x)) (hf : continuous_within_at f s x) (h : s ⊆ f ⁻¹' t) :
  continuous_within_at (g ∘ f) s x :=
hg.tendsto.comp (hf.tendsto_nhds_within h)

lemma continuous_within_at.comp' {g : β → γ} {f : α → β} {s : set α} {t : set β} {x : α}
  (hg : continuous_within_at g t (f x)) (hf : continuous_within_at f s x) :
  continuous_within_at (g ∘ f) (s ∩ f⁻¹' t) x :=
hg.comp (hf.mono (inter_subset_left _ _)) (inter_subset_right _ _)

lemma continuous_at.comp_continuous_within_at {g : β → γ} {f : α → β} {s : set α} {x : α}
  (hg : continuous_at g (f x)) (hf : continuous_within_at f s x) :
  continuous_within_at (g ∘ f) s x :=
hg.continuous_within_at.comp hf subset_preimage_univ

lemma continuous_on.comp {g : β → γ} {f : α → β} {s : set α} {t : set β}
  (hg : continuous_on g t) (hf : continuous_on f s) (h : s ⊆ f ⁻¹' t) :
  continuous_on (g ∘ f) s :=
λx hx, continuous_within_at.comp (hg _ (h hx)) (hf x hx) h

lemma continuous_on.mono {f : α → β} {s t : set α} (hf : continuous_on f s) (h : t ⊆ s)  :
  continuous_on f t :=
λx hx, (hf x (h hx)).mono_left (nhds_within_mono _ h)

lemma continuous_on.comp' {g : β → γ} {f : α → β} {s : set α} {t : set β}
  (hg : continuous_on g t) (hf : continuous_on f s) :
  continuous_on (g ∘ f) (s ∩ f⁻¹' t) :=
hg.comp (hf.mono (inter_subset_left _ _)) (inter_subset_right _ _)

lemma continuous.continuous_on {f : α → β} {s : set α} (h : continuous f) :
  continuous_on f s :=
begin
  rw continuous_iff_continuous_on_univ at h,
  exact h.mono (subset_univ _)
end

lemma continuous.continuous_within_at {f : α → β} {s : set α} {x : α} (h : continuous f) :
  continuous_within_at f s x :=
h.continuous_at.continuous_within_at

lemma continuous.comp_continuous_on {g : β → γ} {f : α → β} {s : set α}
  (hg : continuous g) (hf : continuous_on f s) :
  continuous_on (g ∘ f) s :=
hg.continuous_on.comp hf subset_preimage_univ

lemma continuous_on.comp_continuous {g : β → γ} {f : α → β} {s : set β}
  (hg : continuous_on g s) (hf : continuous f) (hs : ∀ x, f x ∈ s) : continuous (g ∘ f) :=
begin
  rw continuous_iff_continuous_on_univ at *,
  exact hg.comp hf (λ x _, hs x),
end

lemma continuous_within_at.preimage_mem_nhds_within {f : α → β} {x : α} {s : set α} {t : set β}
  (h : continuous_within_at f s x) (ht : t ∈ 𝓝 (f x)) : f ⁻¹' t ∈ 𝓝[s] x :=
h ht

lemma set.left_inv_on.map_nhds_within_eq {f : α → β} {g : β → α} {x : β} {s : set β}
  (h : left_inv_on f g s) (hx : f (g x) = x) (hf : continuous_within_at f (g '' s) (g x))
  (hg : continuous_within_at g s x) :
  map g (𝓝[s] x) = 𝓝[g '' s] (g x) :=
begin
  apply le_antisymm,
  { exact hg.tendsto_nhds_within (maps_to_image _ _) },
  { have A : g ∘ f =ᶠ[𝓝[g '' s] (g x)] id,
      from h.right_inv_on_image.eq_on.eventually_eq_of_mem self_mem_nhds_within,
    refine le_map_of_right_inverse A _,
    simpa only [hx] using hf.tendsto_nhds_within (h.maps_to (surj_on_image _ _)) }
end

lemma function.left_inverse.map_nhds_eq {f : α → β} {g : β → α} {x : β}
  (h : function.left_inverse f g) (hf : continuous_within_at f (range g) (g x))
  (hg : continuous_at g x) :
  map g (𝓝 x) = 𝓝[range g] (g x) :=
by simpa only [nhds_within_univ, image_univ]
  using (h.left_inv_on univ).map_nhds_within_eq (h x) (by rwa image_univ) hg.continuous_within_at

lemma continuous_within_at.preimage_mem_nhds_within' {f : α → β} {x : α} {s : set α} {t : set β}
  (h : continuous_within_at f s x) (ht : t ∈ 𝓝[f '' s] (f x)) :
  f ⁻¹' t ∈ 𝓝[s] x :=
h.tendsto_nhds_within (maps_to_image _ _) ht

lemma filter.eventually_eq.congr_continuous_within_at {f g : α → β} {s : set α} {x : α}
  (h : f =ᶠ[𝓝[s] x] g) (hx : f x = g x) :
  continuous_within_at f s x ↔ continuous_within_at g s x :=
by rw [continuous_within_at, hx, tendsto_congr' h, continuous_within_at]

lemma continuous_within_at.congr_of_eventually_eq {f f₁ : α → β} {s : set α} {x : α}
  (h : continuous_within_at f s x) (h₁ : f₁ =ᶠ[𝓝[s] x] f) (hx : f₁ x = f x) :
  continuous_within_at f₁ s x :=
(h₁.congr_continuous_within_at hx).2 h

lemma continuous_within_at.congr {f f₁ : α → β} {s : set α} {x : α}
  (h : continuous_within_at f s x) (h₁ : ∀y∈s, f₁ y = f y) (hx : f₁ x = f x) :
  continuous_within_at f₁ s x :=
h.congr_of_eventually_eq (mem_of_superset self_mem_nhds_within h₁) hx

lemma continuous_within_at.congr_mono {f g : α → β} {s s₁ : set α} {x : α}
  (h : continuous_within_at f s x) (h' : eq_on g f s₁) (h₁ : s₁ ⊆ s) (hx : g x = f x):
  continuous_within_at g s₁ x :=
(h.mono h₁).congr h' hx

lemma continuous_on_const {s : set α} {c : β} : continuous_on (λx, c) s :=
continuous_const.continuous_on

lemma continuous_within_at_const {b : β} {s : set α} {x : α} :
  continuous_within_at (λ _:α, b) s x :=
continuous_const.continuous_within_at

lemma continuous_on_id {s : set α} : continuous_on id s :=
continuous_id.continuous_on

lemma continuous_within_at_id {s : set α} {x : α} : continuous_within_at id s x :=
continuous_id.continuous_within_at

lemma continuous_on_open_iff {f : α → β} {s : set α} (hs : is_open s) :
  continuous_on f s ↔ (∀t, is_open t → is_open (s ∩ f⁻¹' t)) :=
begin
  rw continuous_on_iff',
  split,
  { assume h t ht,
    rcases h t ht with ⟨u, u_open, hu⟩,
    rw [inter_comm, hu],
    apply is_open.inter u_open hs },
  { assume h t ht,
    refine ⟨s ∩ f ⁻¹' t, h t ht, _⟩,
    rw [@inter_comm _ s (f ⁻¹' t), inter_assoc, inter_self] }
end

lemma continuous_on.preimage_open_of_open {f : α → β} {s : set α} {t : set β}
  (hf : continuous_on f s) (hs : is_open s) (ht : is_open t) : is_open (s ∩ f⁻¹' t) :=
(continuous_on_open_iff hs).1 hf t ht

lemma continuous_on.is_open_preimage {f : α → β} {s : set α} {t : set β} (h : continuous_on f s)
  (hs : is_open s) (hp : f ⁻¹' t ⊆ s) (ht : is_open t) : is_open (f ⁻¹' t) :=
begin
  convert (continuous_on_open_iff hs).mp h t ht,
  rw [inter_comm, inter_eq_self_of_subset_left hp],
end

lemma continuous_on.preimage_closed_of_closed {f : α → β} {s : set α} {t : set β}
  (hf : continuous_on f s) (hs : is_closed s) (ht : is_closed t) : is_closed (s ∩ f⁻¹' t) :=
begin
  rcases continuous_on_iff_is_closed.1 hf t ht with ⟨u, hu⟩,
  rw [inter_comm, hu.2],
  apply is_closed.inter hu.1 hs
end

lemma continuous_on.preimage_interior_subset_interior_preimage {f : α → β} {s : set α} {t : set β}
  (hf : continuous_on f s) (hs : is_open s) : s ∩ f⁻¹' (interior t) ⊆ s ∩ interior (f⁻¹' t) :=
calc s ∩ f ⁻¹' (interior t) ⊆ interior (s ∩ f ⁻¹' t) :
  interior_maximal (inter_subset_inter (subset.refl _) (preimage_mono interior_subset))
    (hf.preimage_open_of_open hs is_open_interior)
... = s ∩ interior (f ⁻¹' t) : by rw [interior_inter, hs.interior_eq]

lemma continuous_on_of_locally_continuous_on {f : α → β} {s : set α}
  (h : ∀x∈s, ∃t, is_open t ∧ x ∈ t ∧ continuous_on f (s ∩ t)) : continuous_on f s :=
begin
  assume x xs,
  rcases h x xs with ⟨t, open_t, xt, ct⟩,
  have := ct x ⟨xs, xt⟩,
  rwa [continuous_within_at, ← nhds_within_restrict _ xt open_t] at this
end

lemma continuous_on_open_of_generate_from {β : Type*} {s : set α} {T : set (set β)} {f : α → β}
  (hs : is_open s) (h : ∀t ∈ T, is_open (s ∩ f⁻¹' t)) :
  @continuous_on α β _ (topological_space.generate_from T) f s :=
begin
  rw continuous_on_open_iff,
  assume t ht,
  induction ht with u hu u v Tu Tv hu hv U hU hU',
  { exact h u hu },
  { simp only [preimage_univ, inter_univ], exact hs },
  { have : s ∩ f ⁻¹' (u ∩ v) = (s ∩ f ⁻¹' u) ∩ (s ∩ f ⁻¹' v),
      by rw [preimage_inter, inter_assoc, inter_left_comm _ s, ← inter_assoc s s, inter_self],
    rw this,
    exact hu.inter hv },
  { rw [preimage_sUnion, inter_Union₂],
    exact is_open_bUnion hU' },
  { exact hs }
end

lemma continuous_within_at.prod {f : α → β} {g : α → γ} {s : set α} {x : α}
  (hf : continuous_within_at f s x) (hg : continuous_within_at g s x) :
  continuous_within_at (λx, (f x, g x)) s x :=
hf.prod_mk_nhds hg

lemma continuous_on.prod {f : α → β} {g : α → γ} {s : set α}
  (hf : continuous_on f s) (hg : continuous_on g s) : continuous_on (λx, (f x, g x)) s :=
λx hx, continuous_within_at.prod (hf x hx) (hg x hx)

lemma inducing.continuous_within_at_iff {f : α → β} {g : β → γ} (hg : inducing g) {s : set α}
  {x : α} : continuous_within_at f s x ↔ continuous_within_at (g ∘ f) s x :=
by simp_rw [continuous_within_at, inducing.tendsto_nhds_iff hg]

lemma inducing.continuous_on_iff {f : α → β} {g : β → γ} (hg : inducing g) {s : set α} :
  continuous_on f s ↔ continuous_on (g ∘ f) s :=
by simp_rw [continuous_on, hg.continuous_within_at_iff]

lemma embedding.continuous_on_iff {f : α → β} {g : β → γ} (hg : embedding g) {s : set α} :
  continuous_on f s ↔ continuous_on (g ∘ f) s :=
inducing.continuous_on_iff hg.1

lemma embedding.map_nhds_within_eq {f : α → β} (hf : embedding f) (s : set α) (x : α) :
  map f (𝓝[s] x) = 𝓝[f '' s] (f x) :=
by rw [nhds_within, map_inf hf.inj, hf.map_nhds_eq, map_principal, ← nhds_within_inter',
  inter_eq_self_of_subset_right (image_subset_range _ _)]

lemma open_embedding.map_nhds_within_preimage_eq {f : α → β} (hf : open_embedding f)
  (s : set β) (x : α) :
  map f (𝓝[f ⁻¹' s] x) = 𝓝[s] (f x) :=
begin
  rw [hf.to_embedding.map_nhds_within_eq, image_preimage_eq_inter_range],
  apply nhds_within_eq_nhds_within (mem_range_self _) hf.open_range,
  rw [inter_assoc, inter_self]
end

lemma continuous_within_at_of_not_mem_closure {f : α → β} {s : set α} {x : α} :
  x ∉ closure s → continuous_within_at f s x :=
begin
  intros hx,
  rw [mem_closure_iff_nhds_within_ne_bot, ne_bot_iff, not_not] at hx,
  rw [continuous_within_at, hx],
  exact tendsto_bot,
end

lemma continuous_on.piecewise' {s t : set α} {f g : α → β} [∀ a, decidable (a ∈ t)]
  (hpf : ∀ a ∈ s ∩ frontier t, tendsto f (𝓝[s ∩ t] a) (𝓝 (piecewise t f g a)))
  (hpg : ∀ a ∈ s ∩ frontier t, tendsto g (𝓝[s ∩ tᶜ] a) (𝓝 (piecewise t f g a)))
  (hf : continuous_on f $ s ∩ t) (hg : continuous_on g $ s ∩ tᶜ) :
  continuous_on (piecewise t f g) s :=
begin
  intros x hx,
  by_cases hx' : x ∈ frontier t,
  { exact (hpf x ⟨hx, hx'⟩).piecewise_nhds_within (hpg x ⟨hx, hx'⟩) },
  { rw [← inter_univ s, ← union_compl_self t, inter_union_distrib_left] at hx ⊢,
    cases hx,
    { apply continuous_within_at.union,
      { exact (hf x hx).congr (λ y hy, piecewise_eq_of_mem _ _ _ hy.2)
          (piecewise_eq_of_mem _ _ _ hx.2) },
      { have : x ∉ closure tᶜ,
          from λ h, hx' ⟨subset_closure hx.2, by rwa closure_compl at h⟩,
        exact continuous_within_at_of_not_mem_closure
          (λ h, this (closure_inter_subset_inter_closure _ _ h).2) } },
    { apply continuous_within_at.union,
      { have : x ∉ closure t,
          from (λ h, hx' ⟨h, (λ (h' : x ∈ interior t), hx.2 (interior_subset h'))⟩),
        exact continuous_within_at_of_not_mem_closure
          (λ h, this (closure_inter_subset_inter_closure _ _ h).2) },
      { exact (hg x hx).congr
          (λ y hy, piecewise_eq_of_not_mem _ _ _ hy.2)
          (piecewise_eq_of_not_mem _ _ _ hx.2) } } }
end

lemma continuous_on.if' {s : set α} {p : α → Prop} {f g : α → β} [∀ a, decidable (p a)]
  (hpf : ∀ a ∈ s ∩ frontier {a | p a},
    tendsto f (𝓝[s ∩ {a | p a}] a) (𝓝 $ if p a then f a else g a))
  (hpg : ∀ a ∈ s ∩ frontier {a | p a},
    tendsto g (𝓝[s ∩ {a | ¬p a}] a) (𝓝 $ if p a then f a else g a))
  (hf : continuous_on f $ s ∩ {a | p a}) (hg : continuous_on g $ s ∩ {a | ¬p a}) :
  continuous_on (λ a, if p a then f a else g a) s :=
hf.piecewise' hpf hpg hg

lemma continuous_on.if {α β : Type*} [topological_space α] [topological_space β] {p : α → Prop}
  [∀ a, decidable (p a)] {s : set α} {f g : α → β}
  (hp : ∀ a ∈ s ∩ frontier {a | p a}, f a = g a) (hf : continuous_on f $ s ∩ closure {a | p a})
  (hg : continuous_on g $ s ∩ closure {a | ¬ p a}) :
  continuous_on (λa, if p a then f a else g a) s :=
begin
  apply continuous_on.if',
  { rintros a ha,
    simp only [← hp a ha, if_t_t],
    apply tendsto_nhds_within_mono_left (inter_subset_inter_right s subset_closure),
    exact hf a ⟨ha.1, ha.2.1⟩ },
  { rintros a ha,
    simp only [hp a ha, if_t_t],
    apply tendsto_nhds_within_mono_left (inter_subset_inter_right s subset_closure),
    rcases ha with ⟨has, ⟨_, ha⟩⟩,
    rw [← mem_compl_iff, ← closure_compl] at ha,
    apply hg a ⟨has, ha⟩ },
  { exact hf.mono (inter_subset_inter_right s subset_closure) },
  { exact hg.mono (inter_subset_inter_right s subset_closure) }
end

lemma continuous_on.piecewise {s t : set α} {f g : α → β} [∀ a, decidable (a ∈ t)]
  (ht : ∀ a ∈ s ∩ frontier t, f a = g a) (hf : continuous_on f $ s ∩ closure t)
  (hg : continuous_on g $ s ∩ closure tᶜ) :
  continuous_on (piecewise t f g) s :=
hf.if ht hg

lemma continuous_if' {p : α → Prop} {f g : α → β} [∀ a, decidable (p a)]
  (hpf : ∀ a ∈ frontier {x | p x}, tendsto f (𝓝[{x | p x}] a) (𝓝 $ ite (p a) (f a) (g a)))
  (hpg : ∀ a ∈ frontier {x | p x}, tendsto g (𝓝[{x | ¬p x}] a) (𝓝 $ ite (p a) (f a) (g a)))
  (hf : continuous_on f {x | p x}) (hg : continuous_on g {x | ¬p x}) :
  continuous (λ a, ite (p a) (f a) (g a)) :=
begin
  rw continuous_iff_continuous_on_univ,
  apply continuous_on.if'; simp *; assumption
end

lemma continuous_if {p : α → Prop} {f g : α → β} [∀ a, decidable (p a)]
  (hp : ∀ a ∈ frontier {x | p x}, f a = g a) (hf : continuous_on f (closure {x | p x}))
  (hg : continuous_on g (closure {x | ¬p x})) :
  continuous (λ a, if p a then f a else g a) :=
begin
  rw continuous_iff_continuous_on_univ,
  apply continuous_on.if; simp; assumption
end

lemma continuous.if {p : α → Prop} {f g : α → β} [∀ a, decidable (p a)]
  (hp : ∀ a ∈ frontier {x | p x}, f a = g a) (hf : continuous f) (hg : continuous g) :
  continuous (λ a, if p a then f a else g a) :=
continuous_if hp hf.continuous_on hg.continuous_on

lemma continuous_piecewise {s : set α} {f g : α → β} [∀ a, decidable (a ∈ s)]
  (hs : ∀ a ∈ frontier s, f a = g a) (hf : continuous_on f (closure s))
  (hg : continuous_on g (closure sᶜ)) :
  continuous (piecewise s f g) :=
continuous_if hs hf hg

lemma continuous.piecewise {s : set α} {f g : α → β} [∀ a, decidable (a ∈ s)]
  (hs : ∀ a ∈ frontier s, f a = g a) (hf : continuous f) (hg : continuous g) :
  continuous (piecewise s f g) :=
hf.if hs hg

lemma is_open.ite' {s s' t : set α}
  (hs : is_open s) (hs' : is_open s') (ht : ∀ x ∈ frontier t, x ∈ s ↔ x ∈ s') :
  is_open (t.ite s s') :=
begin
  classical,
  simp only [is_open_iff_continuous_mem, set.ite] at *,
  convert continuous_piecewise (λ x hx, propext (ht x hx)) hs.continuous_on hs'.continuous_on,
  ext x, by_cases hx : x ∈ t; simp [hx]
end

lemma is_open.ite {s s' t : set α} (hs : is_open s) (hs' : is_open s')
  (ht : s ∩ frontier t = s' ∩ frontier t) :
  is_open (t.ite s s') :=
hs.ite' hs' $ λ x hx, by simpa [hx] using ext_iff.1 ht x

lemma ite_inter_closure_eq_of_inter_frontier_eq {s s' t : set α}
  (ht : s ∩ frontier t = s' ∩ frontier t) :
  t.ite s s' ∩ closure t = s ∩ closure t :=
by rw [closure_eq_self_union_frontier, inter_union_distrib_left, inter_union_distrib_left,
  ite_inter_self, ite_inter_of_inter_eq _ ht]

lemma ite_inter_closure_compl_eq_of_inter_frontier_eq {s s' t : set α}
  (ht : s ∩ frontier t = s' ∩ frontier t) :
  t.ite s s' ∩ closure tᶜ = s' ∩ closure tᶜ :=
by { rw [← ite_compl, ite_inter_closure_eq_of_inter_frontier_eq], rwa [frontier_compl, eq_comm] }

lemma continuous_on_piecewise_ite' {s s' t : set α} {f f' : α → β} [∀ x, decidable (x ∈ t)]
  (h : continuous_on f (s ∩ closure t)) (h' : continuous_on f' (s' ∩ closure tᶜ))
  (H : s ∩ frontier t = s' ∩ frontier t) (Heq : eq_on f f' (s ∩ frontier t)) :
  continuous_on (t.piecewise f f') (t.ite s s') :=
begin
  apply continuous_on.piecewise,
  { rwa ite_inter_of_inter_eq _ H },
  { rwa ite_inter_closure_eq_of_inter_frontier_eq H },
  { rwa ite_inter_closure_compl_eq_of_inter_frontier_eq H }
end

lemma continuous_on_piecewise_ite {s s' t : set α} {f f' : α → β} [∀ x, decidable (x ∈ t)]
  (h : continuous_on f s) (h' : continuous_on f' s')
  (H : s ∩ frontier t = s' ∩ frontier t) (Heq : eq_on f f' (s ∩ frontier t)) :
  continuous_on (t.piecewise f f') (t.ite s s') :=
continuous_on_piecewise_ite' (h.mono (inter_subset_left _ _)) (h'.mono (inter_subset_left _ _))
  H Heq

lemma continuous_on_fst {s : set (α × β)} : continuous_on prod.fst s :=
continuous_fst.continuous_on

lemma continuous_within_at_fst {s : set (α × β)} {p : α × β} :
  continuous_within_at prod.fst s p :=
continuous_fst.continuous_within_at

lemma continuous_on.fst {f : α → β × γ} {s : set α} (hf : continuous_on f s) :
  continuous_on (λ x, (f x).1) s :=
continuous_fst.comp_continuous_on hf

lemma continuous_within_at.fst {f : α → β × γ} {s : set α} {a : α}
  (h : continuous_within_at f s a) : continuous_within_at (λ x, (f x).fst) s a :=
continuous_at_fst.comp_continuous_within_at h

lemma continuous_on_snd {s : set (α × β)} : continuous_on prod.snd s :=
continuous_snd.continuous_on

lemma continuous_within_at_snd {s : set (α × β)} {p : α × β} :
  continuous_within_at prod.snd s p :=
continuous_snd.continuous_within_at

lemma continuous_on.snd {f : α → β × γ} {s : set α} (hf : continuous_on f s) :
  continuous_on (λ x, (f x).2) s :=
continuous_snd.comp_continuous_on hf

lemma continuous_within_at.snd {f : α → β × γ} {s : set α} {a : α}
  (h : continuous_within_at f s a) : continuous_within_at (λ x, (f x).snd) s a :=
continuous_at_snd.comp_continuous_within_at h

lemma continuous_within_at_prod_iff {f : α → β × γ} {s : set α} {x : α} :
  continuous_within_at f s x ↔ continuous_within_at (prod.fst ∘ f) s x ∧
  continuous_within_at (prod.snd ∘ f) s x :=
⟨λ h, ⟨h.fst, h.snd⟩, by { rintro ⟨h1, h2⟩, convert h1.prod h2, ext, refl, refl }⟩


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash

! This file was ported from Lean 3 source module topology.algebra.continuous_affine_map
! leanprover-community/mathlib commit bd1fc183335ea95a9519a1630bcf901fe9326d83
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.AffineSpace.AffineMap
import Mathbin.Topology.ContinuousFunction.Basic
import Mathbin.Topology.Algebra.Module.Basic

/-!
# Continuous affine maps.

This file defines a type of bundled continuous affine maps.

Note that the definition and basic properties established here require minimal assumptions, and do
not even assume compatibility between the topological and algebraic structures. Of course it is
necessary to assume some compatibility in order to obtain a useful theory. Such a theory is
developed elsewhere for affine spaces modelled on _normed_ vector spaces, but not yet for general
topological affine spaces (since we have not defined these yet).

## Main definitions:

 * `continuous_affine_map`

## Notation:

We introduce the notation `P →A[R] Q` for `continuous_affine_map R P Q`. Note that this is parallel
to the notation `E →L[R] F` for `continuous_linear_map R E F`.
-/

/-- A continuous map of affine spaces. -/
structure ContinuousAffineMap (R : Type _) {V W : Type _} (P Q : Type _) [Ring R] [AddCommGroup V]
  [Module R V] [TopologicalSpace P] [AddTorsor V P] [AddCommGroup W] [Module R W]
  [TopologicalSpace Q] [AddTorsor W Q] extends P →ᵃ[R] Q where
  cont : Continuous to_fun
#align continuous_affine_map ContinuousAffineMap

-- mathport name: «expr →A[ ] »
notation:25 P " →A[" R "] " Q => ContinuousAffineMap R P Q

namespace ContinuousAffineMap

variable {R V W P Q : Type _} [Ring R]

variable [AddCommGroup V] [Module R V] [TopologicalSpace P] [AddTorsor V P]

variable [AddCommGroup W] [Module R W] [TopologicalSpace Q] [AddTorsor W Q]

include V W

instance : Coe (P →A[R] Q) (P →ᵃ[R] Q) :=
  ⟨toAffineMap⟩

theorem to_affineMap_injective {f g : P →A[R] Q} (h : (f : P →ᵃ[R] Q) = (g : P →ᵃ[R] Q)) : f = g :=
  by
  cases f
  cases g
  congr
#align continuous_affine_map.to_affine_map_injective ContinuousAffineMap.to_affineMap_injective

instance : ContinuousMapClass (P →A[R] Q) P Q
    where
  coe f := f.toAffineMap
  coe_injective' f g h := to_affineMap_injective <| FunLike.coe_injective h
  map_continuous := cont

/-- Helper instance for when there's too many metavariables to apply
`fun_like.has_coe_to_fun` directly. -/
instance : CoeFun (P →A[R] Q) fun _ => P → Q :=
  FunLike.hasCoeToFun

theorem toFun_eq_coe (f : P →A[R] Q) : f.toFun = ⇑f :=
  rfl
#align continuous_affine_map.to_fun_eq_coe ContinuousAffineMap.toFun_eq_coe

theorem coe_injective : @Function.Injective (P →A[R] Q) (P → Q) coeFn :=
  FunLike.coe_injective
#align continuous_affine_map.coe_injective ContinuousAffineMap.coe_injective

@[ext]
theorem ext {f g : P →A[R] Q} (h : ∀ x, f x = g x) : f = g :=
  FunLike.ext _ _ h
#align continuous_affine_map.ext ContinuousAffineMap.ext

theorem ext_iff {f g : P →A[R] Q} : f = g ↔ ∀ x, f x = g x :=
  FunLike.ext_iff
#align continuous_affine_map.ext_iff ContinuousAffineMap.ext_iff

theorem congr_fun {f g : P →A[R] Q} (h : f = g) (x : P) : f x = g x :=
  FunLike.congr_fun h _
#align continuous_affine_map.congr_fun ContinuousAffineMap.congr_fun

/-- Forgetting its algebraic properties, a continuous affine map is a continuous map. -/
def toContinuousMap (f : P →A[R] Q) : C(P, Q) :=
  ⟨f, f.cont⟩
#align continuous_affine_map.to_continuous_map ContinuousAffineMap.toContinuousMap

instance : Coe (P →A[R] Q) C(P, Q) :=
  ⟨toContinuousMap⟩

@[simp]
theorem toAffineMap_eq_coe (f : P →A[R] Q) : f.toAffineMap = ↑f :=
  rfl
#align continuous_affine_map.to_affine_map_eq_coe ContinuousAffineMap.toAffineMap_eq_coe

@[simp]
theorem toContinuousMap_coe (f : P →A[R] Q) : f.toContinuousMap = ↑f :=
  rfl
#align continuous_affine_map.to_continuous_map_coe ContinuousAffineMap.toContinuousMap_coe

@[simp, norm_cast]
theorem coe_to_affineMap (f : P →A[R] Q) : ((f : P →ᵃ[R] Q) : P → Q) = f :=
  rfl
#align continuous_affine_map.coe_to_affine_map ContinuousAffineMap.coe_to_affineMap

@[simp, norm_cast]
theorem coe_to_continuousMap (f : P →A[R] Q) : ((f : C(P, Q)) : P → Q) = f :=
  rfl
#align continuous_affine_map.coe_to_continuous_map ContinuousAffineMap.coe_to_continuousMap

theorem to_continuousMap_injective {f g : P →A[R] Q} (h : (f : C(P, Q)) = (g : C(P, Q))) : f = g :=
  by
  ext a
  exact ContinuousMap.congr_fun h a
#align continuous_affine_map.to_continuous_map_injective ContinuousAffineMap.to_continuousMap_injective

@[norm_cast]
theorem coe_affineMap_mk (f : P →ᵃ[R] Q) (h) : ((⟨f, h⟩ : P →A[R] Q) : P →ᵃ[R] Q) = f :=
  rfl
#align continuous_affine_map.coe_affine_map_mk ContinuousAffineMap.coe_affineMap_mk

@[norm_cast]
theorem coe_continuousMap_mk (f : P →ᵃ[R] Q) (h) : ((⟨f, h⟩ : P →A[R] Q) : C(P, Q)) = ⟨f, h⟩ :=
  rfl
#align continuous_affine_map.coe_continuous_map_mk ContinuousAffineMap.coe_continuousMap_mk

@[simp]
theorem coe_mk (f : P →ᵃ[R] Q) (h) : ((⟨f, h⟩ : P →A[R] Q) : P → Q) = f :=
  rfl
#align continuous_affine_map.coe_mk ContinuousAffineMap.coe_mk

@[simp]
theorem mk_coe (f : P →A[R] Q) (h) : (⟨(f : P →ᵃ[R] Q), h⟩ : P →A[R] Q) = f :=
  by
  ext
  rfl
#align continuous_affine_map.mk_coe ContinuousAffineMap.mk_coe

@[continuity]
protected theorem continuous (f : P →A[R] Q) : Continuous f :=
  f.2
#align continuous_affine_map.continuous ContinuousAffineMap.continuous

variable (R P)

/-- The constant map is a continuous affine map. -/
def const (q : Q) : P →A[R] Q :=
  { AffineMap.const R P q with
    toFun := AffineMap.const R P q
    cont := continuous_const }
#align continuous_affine_map.const ContinuousAffineMap.const

@[simp]
theorem coe_const (q : Q) : (const R P q : P → Q) = Function.const P q :=
  rfl
#align continuous_affine_map.coe_const ContinuousAffineMap.coe_const

noncomputable instance : Inhabited (P →A[R] Q) :=
  ⟨const R P <| Nonempty.some (by infer_instance : Nonempty Q)⟩

variable {R P} {W₂ Q₂ : Type _}

variable [AddCommGroup W₂] [Module R W₂] [TopologicalSpace Q₂] [AddTorsor W₂ Q₂]

include W₂

/-- The composition of morphisms is a morphism. -/
def comp (f : Q →A[R] Q₂) (g : P →A[R] Q) : P →A[R] Q₂ :=
  { (f : Q →ᵃ[R] Q₂).comp (g : P →ᵃ[R] Q) with cont := f.cont.comp g.cont }
#align continuous_affine_map.comp ContinuousAffineMap.comp

@[simp, norm_cast]
theorem coe_comp (f : Q →A[R] Q₂) (g : P →A[R] Q) :
    (f.comp g : P → Q₂) = (f : Q → Q₂) ∘ (g : P → Q) :=
  rfl
#align continuous_affine_map.coe_comp ContinuousAffineMap.coe_comp

theorem comp_apply (f : Q →A[R] Q₂) (g : P →A[R] Q) (x : P) : f.comp g x = f (g x) :=
  rfl
#align continuous_affine_map.comp_apply ContinuousAffineMap.comp_apply

omit W₂

section ModuleValuedMaps

variable {S : Type _}

variable [TopologicalSpace W]

instance : Zero (P →A[R] W) :=
  ⟨ContinuousAffineMap.const R P 0⟩

@[norm_cast, simp]
theorem coe_zero : ((0 : P →A[R] W) : P → W) = 0 :=
  rfl
#align continuous_affine_map.coe_zero ContinuousAffineMap.coe_zero

theorem zero_apply (x : P) : (0 : P →A[R] W) x = 0 :=
  rfl
#align continuous_affine_map.zero_apply ContinuousAffineMap.zero_apply

section MulAction

variable [Monoid S] [DistribMulAction S W] [SMulCommClass R S W]

variable [ContinuousConstSMul S W]

instance : SMul S (P →A[R] W)
    where smul t f := { t • (f : P →ᵃ[R] W) with cont := f.Continuous.const_smul t }

@[norm_cast, simp]
theorem coe_smul (t : S) (f : P →A[R] W) : ⇑(t • f) = t • f :=
  rfl
#align continuous_affine_map.coe_smul ContinuousAffineMap.coe_smul

theorem smul_apply (t : S) (f : P →A[R] W) (x : P) : (t • f) x = t • f x :=
  rfl
#align continuous_affine_map.smul_apply ContinuousAffineMap.smul_apply

instance [DistribMulAction Sᵐᵒᵖ W] [IsCentralScalar S W] : IsCentralScalar S (P →A[R] W)
    where op_smul_eq_smul t f := ext fun _ => op_smul_eq_smul _ _

instance : MulAction S (P →A[R] W) :=
  Function.Injective.mulAction _ coe_injective coe_smul

end MulAction

variable [TopologicalAddGroup W]

instance : Add (P →A[R] W)
    where add f g :=
    { (f : P →ᵃ[R] W) + (g : P →ᵃ[R] W) with cont := f.Continuous.add g.Continuous }

@[norm_cast, simp]
theorem coe_add (f g : P →A[R] W) : ⇑(f + g) = f + g :=
  rfl
#align continuous_affine_map.coe_add ContinuousAffineMap.coe_add

theorem add_apply (f g : P →A[R] W) (x : P) : (f + g) x = f x + g x :=
  rfl
#align continuous_affine_map.add_apply ContinuousAffineMap.add_apply

instance : Sub (P →A[R] W)
    where sub f g :=
    { (f : P →ᵃ[R] W) - (g : P →ᵃ[R] W) with cont := f.Continuous.sub g.Continuous }

@[norm_cast, simp]
theorem coe_sub (f g : P →A[R] W) : ⇑(f - g) = f - g :=
  rfl
#align continuous_affine_map.coe_sub ContinuousAffineMap.coe_sub

theorem sub_apply (f g : P →A[R] W) (x : P) : (f - g) x = f x - g x :=
  rfl
#align continuous_affine_map.sub_apply ContinuousAffineMap.sub_apply

instance : Neg (P →A[R] W) where neg f := { -(f : P →ᵃ[R] W) with cont := f.Continuous.neg }

@[norm_cast, simp]
theorem coe_neg (f : P →A[R] W) : ⇑(-f) = -f :=
  rfl
#align continuous_affine_map.coe_neg ContinuousAffineMap.coe_neg

theorem neg_apply (f : P →A[R] W) (x : P) : (-f) x = -f x :=
  rfl
#align continuous_affine_map.neg_apply ContinuousAffineMap.neg_apply

instance : AddCommGroup (P →A[R] W) :=
  coe_injective.AddCommGroup _ coe_zero coe_add coe_neg coe_sub (fun _ _ => coe_smul _ _) fun _ _ =>
    coe_smul _ _

instance [Monoid S] [DistribMulAction S W] [SMulCommClass R S W] [ContinuousConstSMul S W] :
    DistribMulAction S (P →A[R] W) :=
  Function.Injective.distribMulAction ⟨fun f => f.toAffineMap.toFun, rfl, coe_add⟩ coe_injective
    coe_smul

instance [Semiring S] [Module S W] [SMulCommClass R S W] [ContinuousConstSMul S W] :
    Module S (P →A[R] W) :=
  Function.Injective.module S ⟨fun f => f.toAffineMap.toFun, rfl, coe_add⟩ coe_injective coe_smul

end ModuleValuedMaps

end ContinuousAffineMap

namespace ContinuousLinearMap

variable {R V W : Type _} [Ring R]

variable [AddCommGroup V] [Module R V] [TopologicalSpace V]

variable [AddCommGroup W] [Module R W] [TopologicalSpace W]

/-- A continuous linear map can be regarded as a continuous affine map. -/
def toContinuousAffineMap (f : V →L[R] W) : V →A[R] W
    where
  toFun := f
  linear := f
  map_vadd' := by simp
  cont := f.cont
#align continuous_linear_map.to_continuous_affine_map ContinuousLinearMap.toContinuousAffineMap

@[simp]
theorem coe_toContinuousAffineMap (f : V →L[R] W) : ⇑f.toContinuousAffineMap = f :=
  rfl
#align continuous_linear_map.coe_to_continuous_affine_map ContinuousLinearMap.coe_toContinuousAffineMap

@[simp]
theorem toContinuousAffineMap_map_zero (f : V →L[R] W) : f.toContinuousAffineMap 0 = 0 := by simp
#align continuous_linear_map.to_continuous_affine_map_map_zero ContinuousLinearMap.toContinuousAffineMap_map_zero

end ContinuousLinearMap


import data.int.basic
import data.rat.basic
import data.real.basic
import data.buffer.parser
import tactic.find
import analysis.special_functions.pow

import ODE_enclosures.zpow

-- https://isabelle.in.tum.de/website-Isabelle2013/dist/library/HOL/HOL-Library/Float.html

open parser zpow function

structure dyadic_rational := (m : ℤ) (e : ℤ)

local notation `𝔽` := dyadic_rational

namespace dyadic_rational

meta instance : has_to_format 𝔽 :=
⟨λ f, (to_fmt f.m) ++ (to_fmt " * 2^") ++ (to_fmt f.e)⟩

@[reducible] def to_rat (x : 𝔽) : ℚ :=
x.m * (2 ^ x.e)

@[reducible] noncomputable def to_real (x : 𝔽) : ℝ :=
x.m * (2 ^ x.e)

@[simp] lemma to_rat_mk {m e : ℤ} : to_rat ⟨m, e⟩ = m * (2 ^ e) := rfl

@[simp] lemma to_real_mk {m e : ℤ} : to_real ⟨m, e⟩ = m * (2 ^ e) := rfl

-- Basic operations.

@[reducible] def zero : 𝔽 := ⟨0, 0⟩

lemma zero_spec : to_rat zero = 0 := by simp

@[reducible] def one : 𝔽 := ⟨1, 0⟩

lemma one_spec : to_rat one = 1 := by simp

@[reducible] def align (x y : 𝔽) : ℤ × ℤ × ℤ :=
if x.e ≤ y.e then ⟨x.m, y.m * 2 ^ (y.e - x.e), x.e⟩ else ⟨x.m * 2 ^ (x.e - y.e), y.m, y.e⟩

@[simp] lemma align_le {x y : 𝔽} (h : x.e ≤ y.e)
: align x y = ⟨x.m, y.m * 2 ^ (y.e - x.e), x.e⟩ :=
by simp only [align]; split_ifs; refl

@[simp] lemma align_le.mx {x y : 𝔽} (h : x.e ≤ y.e)
: (align x y).1 = x.m :=
by simp [align_le h]

@[simp] lemma align_le.my {x y : 𝔽} (h : x.e ≤ y.e)
: (align x y).2.1 = y.m * 2 ^ (y.e - x.e) :=
by simp [align_le h]

@[simp] lemma align_le.e {x y : 𝔽} (h : x.e ≤ y.e)
: (align x y).2.2 = x.e :=
by simp [align_le h]

@[simp] lemma align_not_le {x y : 𝔽} (h : ¬ (x.e ≤ y.e))
: align x y = ⟨x.m * 2 ^ (x.e - y.e), y.m, y.e⟩ :=
by simp only [align]; split_ifs; refl

@[simp] lemma align_not_le.mx {x y : 𝔽} (h : ¬ (x.e ≤ y.e))
: (align x y).1 = x.m * 2 ^ (x.e - y.e) :=
by simp [align_not_le h]

@[simp] lemma align_not_le.my {x y : 𝔽} (h : ¬ (x.e ≤ y.e))
: (align x y).2.1 = y.m :=
by simp [align_not_le h]

@[simp] lemma align_not_le.e {x y : 𝔽} (h : ¬ (x.e ≤ y.e))
: (align x y).2.2 = y.e :=
by simp [align_not_le h]

-- TODO: Move
lemma zpow_rat_cast (x y : ℤ) (hy : 0 ≤ y) : ((zpow x y) : ℚ) = (x : ℚ) ^ (y : ℤ) :=
begin
  simp only [zpow_eq_pow, zpow_def],
  lift y to ℕ using hy,
  rw [int.to_nat_coe_nat], norm_num,
end

lemma align_spec (x y : 𝔽) :
let a := align x y in
to_rat x = to_rat ⟨a.1, a.2.2⟩ ∧ to_rat y = to_rat ⟨a.2.1, a.2.2⟩ :=
begin
  intros a,
  have h2 : ((2 : ℤ) : ℚ) = (2 : ℚ) := by norm_num,
  split; by_cases (x.e ≤ y.e); simp*;
  try { erw [zpow_rat_cast _ _ (sub_nonneg.2 (le_of_not_le h))], };
  try { erw [zpow_rat_cast _ _ (sub_nonneg.2 h)], };
  erw [mul_assoc, h2, ←fpow_add];
  simp; norm_num,
end

lemma align_semi_comm (x y : 𝔽)
: (align x y).1 = (align y x).2.1
∧ (align x y).2.1 = (align y x).1
∧ (align x y).2.2 = (align y x).2.2 :=
begin
  cases (lt_trichotomy x.e y.e),
  { have h' := not_le_of_lt h, replace h := le_of_lt h,
    simp [align_le h, align_not_le h'], },
  { cases h,
    { simp [align_le (le_of_eq h), align_le (ge_of_eq h), h], },
    { have h' := not_le_of_lt h, replace h := le_of_lt h,
      simp [align_le h, align_not_le h'], }, }
end

-- Operations.

def neg (x : 𝔽) : 𝔽 :=
⟨-x.m, x.e⟩

@[simp] lemma neg.m (x : 𝔽) : (neg x).m = -x.m := by simp [neg]

@[simp] lemma meg.e (x : 𝔽) : (neg x).e = x.e := by simp [neg]

def add (x y : 𝔽) : 𝔽 :=
let ⟨mx, my, e⟩ := align x y in ⟨mx + my, e⟩

lemma add.def (x y : 𝔽) : add x y = ⟨(align x y).1 + (align x y).2.1, (align x y).2.2⟩ :=
begin
  unfold add, by_cases (x.e ≤ y.e),
  { simp only [align_le.mx h, align_le.my h, align_le.e h],
    unfold align, split_ifs, refl, },
  { simp only [align_not_le.mx h, align_not_le.my h, align_not_le.e h],
    unfold align, split_ifs, refl, }
end

@[simp] lemma add.m (x y : 𝔽) : (add x y).m = (align x y).1 + (align x y).2.1 :=
by rw [add.def]; refl

@[simp] lemma add.e (x y : 𝔽) : (add x y).e = (align x y).2.2 :=
by rw [add.def]; refl

def mul (x y : 𝔽) : 𝔽 :=
⟨x.m * y.m, x.e + y.e⟩

@[simp] lemma mul.m (x y : 𝔽) : (mul x y).m = x.m * y.m := by simp [mul]

@[simp] lemma mul.e (x y : 𝔽) : (mul x y).e = x.e + y.e := by simp [mul]

-- Properties of to_rat.

lemma to_rat.neg {x y : 𝔽} (h : to_rat x = to_rat y) : to_rat (neg x) = to_rat (neg y) :=
begin
    simp only [neg, to_rat_mk] at *,
    iterate 2 { rw [int.cast_neg, ←neg_mul_eq_neg_mul], }, rw h,
end

lemma to_rat.add {x y x' y' : 𝔽} (h : to_rat x = to_rat y) (h' : to_rat x' = to_rat y')
: to_rat (add x x') = to_rat (add y y') :=
begin
    have h2 : ((2 : ℤ) : ℚ) = (2 : ℚ) := by norm_num, -- TODO: I hate this.
    simp only [to_rat_mk, add.m, add.e] at *,
    by_cases (x.e ≤ x'.e); replace hx := h; clear h;
    by_cases (y.e ≤ y'.e); replace hy := h; clear h;
    try { simp only [align_le.mx hx, align_le.my hx, align_le.e hx], };
    try { simp only [align_le.mx hy, align_le.my hy, align_le.e hy], };
    try { simp only [align_not_le.mx hx, align_not_le.my hx, align_not_le.e hx], };
    try { simp only [align_not_le.mx hy, align_not_le.my hy, align_not_le.e hy], };
    push_cast; rw [add_mul, add_mul],
    { rw [h, mul_assoc, mul_assoc],
      erw [zpow_rat_cast _ _ (sub_nonneg.2 hx), h2, ←fpow_add],
      erw [zpow_rat_cast _ _ (sub_nonneg.2 hy), h2, ←fpow_add],
      simp, rw [h'], norm_num, norm_num, },
    { rw [h, mul_assoc, mul_assoc],
      erw [zpow_rat_cast _ _ (sub_nonneg.2 hx), h2, ←fpow_add],
      erw [zpow_rat_cast _ _ (sub_nonneg.2 (le_of_not_le hy)), h2, ←fpow_add],
      simp, rw [←h'], norm_num, norm_num, },
    { rw [h', mul_assoc, mul_assoc],
      erw [zpow_rat_cast _ _ (sub_nonneg.2 (le_of_not_le hx)), h2, ←fpow_add],
      erw [zpow_rat_cast _ _ (sub_nonneg.2 hy), h2, ←fpow_add],
      simp, rw [h], norm_num, norm_num, },
    { rw [h', mul_assoc, mul_assoc],
      erw [zpow_rat_cast _ _ (sub_nonneg.2 (le_of_not_le hx)), h2, ←fpow_add],
      erw [zpow_rat_cast _ _ (sub_nonneg.2 (le_of_not_le hy)), h2, ←fpow_add],
      simp, rw [←h], norm_num, norm_num, }
end

lemma to_rat.mul {x y x' y' : 𝔽} (h : to_rat x = to_rat y) (h' : to_rat x' = to_rat y')
: to_rat (mul x x') = to_rat (mul y y') :=
begin
  simp only [to_rat_mk, mul.m, mul.e] at *,
  simp only [fpow_add (by norm_num : (2 : ℚ) ≠ 0)], push_cast,
  calc ↑(x.m) * ↑(x'.m) * ((2 : ℚ) ^ x.e * (2 : ℚ) ^ x'.e)
      = (↑(x.m) * 2 ^ x.e) * (↑(x'.m) * 2 ^ x'.e) : by ring
  ... = (↑(y.m) * 2 ^ y.e) * (↑(y'.m) * 2 ^ y'.e) : by rw [h, h']
  ... = ↑(y.m) * ↑(y'.m) * (2 ^ y.e * 2 ^ y'.e) : by ring
end

-- 𝔽 is not a ring but 𝔽/R where R(x,y) iff to_rat x = to_rat y is a ring.

@[reducible] private def R : 𝔽 → 𝔽 → Prop := λ x y, to_rat x = to_rat y

private lemma R.reflexive : reflexive R := λ x, by unfold R; exact eq.refl

private lemma R.symmetric : symmetric R := λ x y, by unfold R; exact eq.symm

private lemma R.transitive : transitive R := λ x y z, by unfold R; exact eq.trans

private lemma R.equivalence : equivalence R := ⟨R.reflexive, R.symmetric, R.transitive⟩

instance dyadic_rational.setoid : setoid 𝔽 := ⟨R, R.equivalence⟩

def 𝔽R := quotient dyadic_rational.setoid

instance : comm_ring 𝔽R := {
    zero := ⟦zero⟧,
    one := ⟦one⟧,
    neg := quotient.lift (λ x, ⟦neg x⟧) (λ a b h, quotient.sound $ to_rat.neg h),
    add := quotient.lift₂ (λ x y, ⟦add x y⟧) (λ a₁ a₂ b₁ b₂ h₁ h₂, quotient.sound $ to_rat.add h₁ h₂),
    mul := quotient.lift₂ (λ x y, ⟦mul x y⟧) (λ a₁ a₂ b₁ b₂ h₁ h₂, quotient.sound $ to_rat.mul h₁ h₂),
    zero_add := λ x, begin
      have h2 : ((2 : ℤ) : ℚ) = (2 : ℚ) := by norm_num,
      apply quotient.induction_on x, intros a, apply quotient.sound,
      simp only [add.def], show to_rat _ = to_rat a,
      by_cases (zero.e ≤ a.e),
      { simp only [align_le.mx h, align_le.my h, align_le.e h, to_rat_mk],
        push_cast, erw [zpow_rat_cast _ _ (sub_nonneg.2 h), h2], simp,  },
      { simp only [align_not_le.mx h, align_not_le.my h, align_not_le.e h, to_rat_mk],
        push_cast, erw [zpow_rat_cast _ _ (sub_nonneg.2 (le_of_not_le h)), h2], simp, }
    end,
    add_zero := λ x, begin
      have h2 : ((2 : ℤ) : ℚ) = (2 : ℚ) := by norm_num,
      apply quotient.induction_on x, intros a, apply quotient.sound,
      simp only [add.def], show to_rat _ = to_rat a,
      by_cases (a.e ≤ zero.e),
        { simp only [align_le.mx h, align_le.my h, align_le.e h, to_rat_mk],
          push_cast, erw [zpow_rat_cast _ _ (sub_nonneg.2 h), h2], simp,  },
        { simp only [align_not_le.mx h, align_not_le.my h, align_not_le.e h, to_rat_mk],
          push_cast, erw [zpow_rat_cast _ _ (sub_nonneg.2 (le_of_not_le h)), h2], simp, }
    end,
    add_left_neg := λ x, begin
      have h2 : ((2 : ℤ) : ℚ) = (2 : ℚ) := by norm_num,
      apply quotient.induction_on x, intros a, apply quotient.sound,
      simp only [add.def], show to_rat _ = to_rat _,
      by_cases ((neg a).e ≤ a.e),
      { simp only [align_le.mx h, align_le.my h, align_le.e h, to_rat_mk],
        push_cast, erw [zpow_rat_cast _ _ (sub_nonneg.2 h), h2], simp*,  },
      { simp only [align_not_le.mx h, align_not_le.my h, align_not_le.e h, to_rat_mk],
        push_cast, erw [zpow_rat_cast _ _ (sub_nonneg.2 (le_of_not_le h)), h2], simp*, }
    end,
    add_comm := λ x y, begin
      apply quotient.induction_on₂ x y, intros a b, apply quotient.sound,
      simp only [add.def], show to_rat _ = to_rat _,
      simp_rw [align_semi_comm a b, add_comm],
    end,
    add_assoc := λ x y z, begin
      apply quotient.induction_on₃ x y z, intros a b c, apply quotient.sound,
      simp only [add.def], show to_rat _ = to_rat _, dsimp, sorry,
    end,
    one_mul := sorry,
    mul_one := sorry,
    mul_comm := sorry,
    mul_assoc := sorry,
    left_distrib := sorry,
    right_distrib := sorry,
}

end dyadic_rational