/-
Copyright (c) 2022 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import order.filter.cofinite

/-!
# Basic theory of bornology

We develop the basic theory of bornologies. Instead of axiomatizing bounded sets and defining
bornologies in terms of those, we recognize that the cobounded sets form a filter and define a
bornology as a filter of cobounded sets which contains the cofinite filter.  This allows us to make
use of the extensive library for filters, but we also provide the relevant connecting results for
bounded sets.

The specification of a bornology in terms of the cobounded filter is equivalent to the standard
one (e.g., see [Bourbaki, *Topological Vector Spaces*][bourbaki1987], **covering bornology**, now
often called simply **bornology**) in terms of bounded sets (see `bornology.of_bounded`,
`is_bounded.union`, `is_bounded.subset`), except that we do not allow the empty bornology (that is,
we require that *some* set must be bounded; equivalently, `∅` is bounded). In the literature the
cobounded filter is generally referred to as the *filter at infinity*.

## Main definitions

- `bornology α`: a class consisting of `cobounded : filter α` and a proof that this filter
  contains the `cofinite` filter.
- `bornology.is_cobounded`: the predicate that a set is a member of the `cobounded α` filter. For
  `s : set α`, one should prefer `bornology.is_cobounded s` over `s ∈ cobounded α`.
- `bornology.is_bounded`: the predicate that states a set is bounded (i.e., the complement of a
  cobounded set). One should prefer `bornology.is_bounded s` over `sᶜ ∈ cobounded α`.
- `bounded_space α`: a class extending `bornology α` with the condition
  `bornology.is_bounded (set.univ : set α)`

Although use of `cobounded α` is discouraged for indicating the (co)boundedness of individual sets,
it is intended for regular use as a filter on `α`.
-/

open set filter

variables {α β : Type*}

/-- A **bornology** on a type `α` is a filter of cobounded sets which contains the cofinite filter.
Such spaces are equivalently specified by their bounded sets, see `bornology.of_bounded`
and `bornology.ext_iff_is_bounded`-/
@[ext]
class bornology (α : Type*) :=
(cobounded [] : filter α)
(le_cofinite [] : cobounded ≤ cofinite)

/-- A constructor for bornologies by specifying the bounded sets,
and showing that they satisfy the appropriate conditions. -/
@[simps]
def bornology.of_bounded {α : Type*} (B : set (set α))
  (empty_mem : ∅ ∈ B) (subset_mem : ∀ s₁ ∈ B, ∀ s₂ : set α, s₂ ⊆ s₁ → s₂ ∈ B)
  (union_mem : ∀ s₁ s₂ ∈ B, s₁ ∪ s₂ ∈ B) (singleton_mem : ∀ x, {x} ∈ B) :
  bornology α :=
{ cobounded :=
  { sets := {s : set α | sᶜ ∈ B},
    univ_sets := by rwa ←compl_univ at empty_mem,
    sets_of_superset := λ x y hx hy, subset_mem xᶜ hx yᶜ (compl_subset_compl.mpr hy),
    inter_sets := λ x y hx hy, by simpa [compl_inter] using union_mem xᶜ hx yᶜ hy, },
  le_cofinite :=
  begin
    rw le_cofinite_iff_compl_singleton_mem,
    intros x,
    change {x}ᶜᶜ ∈ B,
    rw compl_compl,
    exact singleton_mem x
  end }

/-- A constructor for bornologies by specifying the bounded sets,
and showing that they satisfy the appropriate conditions. -/
@[simps]
def bornology.of_bounded' {α : Type*} (B : set (set α))
  (empty_mem : ∅ ∈ B) (subset_mem : ∀ s₁ ∈ B, ∀ s₂ : set α, s₂ ⊆ s₁ → s₂ ∈ B)
  (union_mem : ∀ s₁ s₂ ∈ B, s₁ ∪ s₂ ∈ B) (sUnion_univ : ⋃₀ B = univ) :
  bornology α :=
bornology.of_bounded B empty_mem subset_mem union_mem
  begin
    rw eq_univ_iff_forall at sUnion_univ,
    intros x,
    rcases sUnion_univ x with ⟨s, hs, hxs⟩,
    exact subset_mem s hs {x} (singleton_subset_iff.mpr hxs)
  end

namespace bornology

section
variables [bornology α] {s₁ s₂ : set α}

/-- `is_cobounded` is the predicate that `s` is in the filter of cobounded sets in the ambient
bornology on `α` -/
def is_cobounded (s : set α) : Prop := s ∈ cobounded α

/-- `is_bounded` is the predicate that `s` is bounded relative to the ambient bornology on `α`. -/
def is_bounded (s : set α) : Prop := sᶜ ∈ cobounded α

lemma is_cobounded_def {s : set α} : is_cobounded s ↔ s ∈ cobounded α := iff.rfl

lemma is_bounded_def {s : set α} : is_bounded s ↔ sᶜ ∈ cobounded α := iff.rfl

@[simp] lemma is_bounded_compl_iff {s : set α} : is_bounded sᶜ ↔ is_cobounded s :=
by rw [is_bounded_def, is_cobounded_def, compl_compl]

@[simp] lemma is_cobounded_compl_iff {s : set α} : is_cobounded sᶜ ↔ is_bounded s := iff.rfl

alias is_bounded_compl_iff ↔ bornology.is_bounded.of_compl bornology.is_cobounded.compl
alias is_cobounded_compl_iff ↔ bornology.is_cobounded.of_compl bornology.is_bounded.compl

@[simp] lemma is_bounded_empty : is_bounded (∅ : set α) :=
by { rw [is_bounded_def, compl_empty], exact univ_mem}

@[simp] lemma is_bounded_singleton {x : α} : is_bounded ({x} : set α) :=
by {rw [is_bounded_def], exact le_cofinite _ (finite_singleton x).compl_mem_cofinite}

lemma is_bounded.union (h₁ : is_bounded s₁) (h₂ : is_bounded s₂) : is_bounded (s₁ ∪ s₂) :=
by { rw [is_bounded_def, compl_union], exact (cobounded α).inter_sets h₁ h₂ }

lemma is_bounded.subset (h₁ : is_bounded s₂) (h₂ : s₁ ⊆ s₂) : is_bounded s₁ :=
by { rw [is_bounded_def], exact (cobounded α).sets_of_superset h₁ (compl_subset_compl.mpr h₂) }

@[simp]
lemma sUnion_bounded_univ : (⋃₀ {s : set α | is_bounded s}) = set.univ :=
univ_subset_iff.mp $ λ x hx, mem_sUnion_of_mem (mem_singleton x)
  $ le_def.mp (le_cofinite α) {x}ᶜ $ (set.finite_singleton x).compl_mem_cofinite

lemma comap_cobounded_le_iff [bornology β] {f : α → β} :
  (cobounded β).comap f ≤ cobounded α ↔ ∀ ⦃s⦄, is_bounded s → is_bounded (f '' s) :=
begin
  refine ⟨λ h s hs, _, λ h t ht,
    ⟨(f '' tᶜ)ᶜ, h $ is_cobounded.compl ht, compl_subset_comm.1 $ subset_preimage_image _ _⟩⟩,
  obtain ⟨t, ht, hts⟩ := h hs.compl,
  rw [subset_compl_comm, ←preimage_compl] at hts,
  exact (is_cobounded.compl ht).subset ((image_subset f hts).trans $ image_preimage_subset _ _),
end

end

lemma ext_iff' {t t' : bornology α} :
  t = t' ↔ ∀ s, (@cobounded α t).sets s ↔ (@cobounded α t').sets s :=
⟨λ h s, h ▸ iff.rfl, λ h, by { ext, exact h _ } ⟩

lemma ext_iff_is_bounded {t t' : bornology α} :
  t = t' ↔ ∀ s, @is_bounded α t s ↔ @is_bounded α t' s :=
⟨λ h s, h ▸ iff.rfl, λ h, by { ext, simpa only [is_bounded_def, compl_compl] using h sᶜ, }⟩

variables {s : set α}

lemma is_cobounded_of_bounded_iff (B : set (set α)) {empty_mem subset_mem union_mem sUnion_univ} :
  @is_cobounded _ (of_bounded B empty_mem subset_mem union_mem sUnion_univ) s ↔ sᶜ ∈ B := iff.rfl

lemma is_bounded_of_bounded_iff (B : set (set α)) {empty_mem subset_mem union_mem sUnion_univ} :
  @is_bounded _ (of_bounded B empty_mem subset_mem union_mem sUnion_univ) s ↔ s ∈ B :=
by rw [is_bounded_def, ←filter.mem_sets, of_bounded_cobounded_sets, set.mem_set_of_eq, compl_compl]

variables [bornology α]

lemma is_bounded_sUnion {s : set (set α)} (hs : finite s) :
  (∀ t ∈ s, is_bounded t) → is_bounded (⋃₀ s) :=
finite.induction_on hs (λ _, by { rw sUnion_empty, exact is_bounded_empty }) $
λ a s has hs ih h, by
  { rw sUnion_insert,
    exact is_bounded.union (h _ $ mem_insert _ _) (ih $ λ t, h t ∘ mem_insert_of_mem _) }

lemma is_bounded_bUnion {s : set β} {f : β → set α} (hs : finite s) :
  (∀ i ∈ s, is_bounded (f i)) → is_bounded (⋃ i ∈ s, f i) :=
finite.induction_on hs
  (λ _, by { rw bUnion_empty, exact is_bounded_empty })
  (λ a s has hs ih h, by
    { rw bUnion_insert,
      exact is_bounded.union (h a (mem_insert _ _)) (ih (λ i hi, h i (mem_insert_of_mem _ hi))) })

lemma is_bounded_Union [fintype β] {s : β → set α}
  (h : ∀ i, is_bounded (s i)) : is_bounded (⋃ i, s i) :=
by simpa using is_bounded_bUnion finite_univ (λ i _, h i)

end bornology

instance : bornology punit := ⟨⊥, bot_le⟩

/-- The cofinite filter as a bornology -/
@[reducible] def bornology.cofinite : bornology α :=
{ cobounded := cofinite,
  le_cofinite := le_refl _ }

/-- A **bounded space** is a `bornology α` such that `set.univ : set α` is bounded. -/
class bounded_space extends bornology α :=
(bounded_univ : bornology.is_bounded (univ : set α))


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import algebra.order.archimedean
import topology.algebra.infinite_sum.basic
import topology.algebra.order.field
import topology.algebra.order.monotone_convergence

/-!
# Infinite sum in an order

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

This file provides lemmas about the interaction of infinite sums and order operations.
-/

open finset filter function
open_locale big_operators classical

variables {ι κ α : Type*}

section preorder
variables [preorder α] [add_comm_monoid α] [topological_space α] [order_closed_topology α]
  [t2_space α] {f : ℕ → α} {c : α}

lemma tsum_le_of_sum_range_le (hf : summable f) (h : ∀ n, ∑ i in range n, f i ≤ c) :
  ∑' n, f n ≤ c :=
let ⟨l, hl⟩ := hf in hl.tsum_eq.symm ▸ le_of_tendsto' hl.tendsto_sum_nat h

end preorder

section ordered_add_comm_monoid
variables [ordered_add_comm_monoid α] [topological_space α] [order_closed_topology α] {f g : ι → α}
  {a a₁ a₂ : α}

lemma has_sum_le (h : ∀ i, f i ≤ g i) (hf : has_sum f a₁) (hg : has_sum g a₂) : a₁ ≤ a₂ :=
le_of_tendsto_of_tendsto' hf hg $ λ s, sum_le_sum $ λ i _, h i

@[mono] lemma has_sum_mono (hf : has_sum f a₁) (hg : has_sum g a₂) (h : f ≤ g) : a₁ ≤ a₂ :=
has_sum_le h hf hg

lemma has_sum_le_of_sum_le (hf : has_sum f a) (h : ∀ s, ∑ i in s, f i ≤ a₂) : a ≤ a₂ :=
le_of_tendsto' hf h

lemma le_has_sum_of_le_sum (hf : has_sum f a) (h : ∀ s, a₂ ≤ ∑ i in s, f i) : a₂ ≤ a :=
ge_of_tendsto' hf h

lemma has_sum_le_inj {g : κ → α} (e : ι → κ) (he : injective e) (hs : ∀ c ∉ set.range e, 0 ≤ g c)
  (h : ∀ i, f i ≤ g (e i)) (hf : has_sum f a₁) (hg : has_sum g a₂) : a₁ ≤ a₂ :=
have has_sum (λ c, (partial_inv e c).cases_on' 0 f) a₁,
begin
  refine (has_sum_iff_has_sum_of_ne_zero_bij (e ∘ coe) (λ c₁ c₂ hc, he hc) (λ c hc, _) _).2 hf,
  { rw mem_support at hc,
    cases eq : partial_inv e c with i; rw eq at hc,
    { contradiction },
    { rw [partial_inv_of_injective he] at eq,
      exact ⟨⟨i, hc⟩, eq⟩ } },
  { rintro c,
    simp [partial_inv_left he, option.cases_on'] }
end,
begin
  refine has_sum_le (λ c, _) this hg,
  obtain ⟨i, rfl⟩ | h := em (c ∈ set.range e),
  { rw [partial_inv_left he, option.cases_on'],
    exact h _ },
  { have : partial_inv e c = none := dif_neg h,
    rw [this, option.cases_on'],
    exact hs _ h }
end

lemma tsum_le_tsum_of_inj {g : κ → α} (e : ι → κ) (he : injective e)
  (hs : ∀ c ∉ set.range e, 0 ≤ g c) (h : ∀ i, f i ≤ g (e i)) (hf : summable f) (hg : summable g) :
  tsum f ≤ tsum g :=
has_sum_le_inj _ he hs h hf.has_sum hg.has_sum

lemma sum_le_has_sum (s : finset ι) (hs : ∀ i ∉ s, 0 ≤ f i) (hf : has_sum f a) :
  ∑ i in s, f i ≤ a :=
ge_of_tendsto hf (eventually_at_top.2 ⟨s, λ t hst,
  sum_le_sum_of_subset_of_nonneg hst $ λ i hbt hbs, hs i hbs⟩)

lemma is_lub_has_sum (h : ∀ i, 0 ≤ f i) (hf : has_sum f a) :
  is_lub (set.range $ λ s, ∑ i in s, f i) a :=
is_lub_of_tendsto_at_top (finset.sum_mono_set_of_nonneg h) hf

lemma le_has_sum (hf : has_sum f a) (i : ι) (hb : ∀ b' ≠ i, 0 ≤ f b') : f i ≤ a :=
calc f i = ∑ i in {i}, f i : finset.sum_singleton.symm
... ≤ a : sum_le_has_sum _ (by { convert hb, simp }) hf

lemma sum_le_tsum {f : ι → α} (s : finset ι) (hs : ∀ i ∉ s, 0 ≤ f i) (hf : summable f) :
  ∑ i in s, f i ≤ ∑' i, f i :=
sum_le_has_sum s hs hf.has_sum

lemma le_tsum (hf : summable f) (i : ι) (hb : ∀ b' ≠ i, 0 ≤ f b') : f i ≤ ∑' i, f i :=
le_has_sum (summable.has_sum hf) i hb

lemma tsum_le_tsum (h : ∀ i, f i ≤ g i) (hf : summable f) (hg : summable g) :
  ∑' i, f i ≤ ∑' i, g i :=
has_sum_le h hf.has_sum hg.has_sum

@[mono] lemma tsum_mono (hf : summable f) (hg : summable g) (h : f ≤ g) :
  ∑' n, f n ≤ ∑' n, g n :=
tsum_le_tsum h hf hg

lemma tsum_le_of_sum_le (hf : summable f) (h : ∀ s, ∑ i in s, f i ≤ a₂) : ∑' i, f i ≤ a₂ :=
has_sum_le_of_sum_le hf.has_sum h

lemma tsum_le_of_sum_le' (ha₂ : 0 ≤ a₂) (h : ∀ s, ∑ i in s, f i ≤ a₂) : ∑' i, f i ≤ a₂ :=
begin
  by_cases hf : summable f,
  { exact tsum_le_of_sum_le hf h },
  { rw tsum_eq_zero_of_not_summable hf,
    exact ha₂ }
end

lemma has_sum.nonneg (h : ∀ i, 0 ≤ g i) (ha : has_sum g a) : 0 ≤ a := has_sum_le h has_sum_zero ha
lemma has_sum.nonpos (h : ∀ i, g i ≤ 0) (ha : has_sum g a) : a ≤ 0 := has_sum_le h ha has_sum_zero

lemma tsum_nonneg (h : ∀ i, 0 ≤ g i) : 0 ≤ ∑' i, g i :=
begin
  by_cases hg : summable g,
  { exact hg.has_sum.nonneg h },
  { simp [tsum_eq_zero_of_not_summable hg] }
end

lemma tsum_nonpos (h : ∀ i, f i ≤ 0) : ∑' i, f i ≤ 0 :=
begin
  by_cases hf : summable f,
  { exact hf.has_sum.nonpos h },
  { simp [tsum_eq_zero_of_not_summable hf] }
end

end ordered_add_comm_monoid

section ordered_add_comm_group
variables [ordered_add_comm_group α] [topological_space α] [topological_add_group α]
  [order_closed_topology α] {f g : ι → α} {a₁ a₂ : α} {i : ι}

lemma has_sum_lt (h : f ≤ g) (hi : f i < g i) (hf : has_sum f a₁) (hg : has_sum g a₂) : a₁ < a₂ :=
have update f i 0 ≤ update g i 0 := update_le_update_iff.mpr ⟨rfl.le, λ i _, h i⟩,
have 0 - f i + a₁ ≤ 0 - g i + a₂ := has_sum_le this (hf.update i 0) (hg.update i 0),
by simpa only [zero_sub, add_neg_cancel_left] using add_lt_add_of_lt_of_le hi this

@[mono] lemma has_sum_strict_mono (hf : has_sum f a₁) (hg : has_sum g a₂) (h : f < g) : a₁ < a₂ :=
let ⟨hle, i, hi⟩ := pi.lt_def.mp h in has_sum_lt hle hi hf hg

lemma tsum_lt_tsum (h : f ≤ g) (hi : f i < g i) (hf : summable f) (hg : summable g) :
  ∑' n, f n < ∑' n, g n :=
has_sum_lt h hi hf.has_sum hg.has_sum

@[mono] lemma tsum_strict_mono (hf : summable f) (hg : summable g) (h : f < g) :
  ∑' n, f n < ∑' n, g n :=
let ⟨hle, i, hi⟩ := pi.lt_def.mp h in tsum_lt_tsum hle hi hf hg

lemma tsum_pos (hsum : summable g) (hg : ∀ i, 0 ≤ g i) (i : ι) (hi : 0 < g i) : 0 < ∑' i, g i :=
by { rw ←tsum_zero, exact tsum_lt_tsum hg hi summable_zero hsum }

lemma has_sum_zero_iff_of_nonneg (hf : ∀ i, 0 ≤ f i) : has_sum f 0 ↔ f = 0 :=
begin
  refine ⟨λ hf', _, _⟩,
  { ext i,
    refine (hf i).eq_of_not_gt (λ hi, _),
    simpa using has_sum_lt hf hi has_sum_zero hf' },
  { rintro rfl,
    exact has_sum_zero }
end

end ordered_add_comm_group

section canonically_ordered_add_monoid
variables [canonically_ordered_add_monoid α] [topological_space α] [order_closed_topology α]
  {f : ι → α} {a : α}

lemma le_has_sum' (hf : has_sum f a) (i : ι) : f i ≤ a := le_has_sum hf i $ λ _ _, zero_le _

lemma le_tsum' (hf : summable f) (i : ι) : f i ≤ ∑' i, f i := le_tsum hf i $ λ _ _, zero_le _

lemma has_sum_zero_iff : has_sum f 0 ↔ ∀ x, f x = 0 :=
begin
  refine ⟨_, λ h, _⟩,
  { contrapose!,
    exact λ ⟨x, hx⟩ h, hx (nonpos_iff_eq_zero.1$ le_has_sum' h x) },
  { convert has_sum_zero,
    exact funext h }
end

lemma tsum_eq_zero_iff (hf : summable f) : ∑' i, f i = 0 ↔ ∀ x, f x = 0 :=
by rw [←has_sum_zero_iff, hf.has_sum_iff]

lemma tsum_ne_zero_iff (hf : summable f) : ∑' i, f i ≠ 0 ↔ ∃ x, f x ≠ 0 :=
by rw [ne.def, tsum_eq_zero_iff hf, not_forall]

lemma is_lub_has_sum' (hf : has_sum f a) : is_lub (set.range $ λ s, ∑ i in s, f i) a :=
is_lub_of_tendsto_at_top (finset.sum_mono_set f) hf

end canonically_ordered_add_monoid

section linear_order

/-!
For infinite sums taking values in a linearly ordered monoid, the existence of a least upper
bound for the finite sums is a criterion for summability.

This criterion is useful when applied in a linearly ordered monoid which is also a complete or
conditionally complete linear order, such as `ℝ`, `ℝ≥0`, `ℝ≥0∞`, because it is then easy to check
the existence of a least upper bound.
-/

lemma has_sum_of_is_lub_of_nonneg [linear_ordered_add_comm_monoid α] [topological_space α]
  [order_topology α] {f : ι → α} (i : α) (h : ∀ i, 0 ≤ f i)
  (hf : is_lub (set.range $ λ s, ∑ i in s, f i) i) :
  has_sum f i :=
tendsto_at_top_is_lub (finset.sum_mono_set_of_nonneg h) hf

lemma has_sum_of_is_lub [canonically_linear_ordered_add_monoid α] [topological_space α]
   [order_topology α] {f : ι → α} (b : α) (hf : is_lub (set.range $ λ s, ∑ i in s, f i) b) :
  has_sum f b :=
tendsto_at_top_is_lub (finset.sum_mono_set f) hf

lemma summable_abs_iff [linear_ordered_add_comm_group α] [uniform_space α] [uniform_add_group α]
  [complete_space α] {f : ι → α} :
  summable (λ x, |f x|) ↔ summable f :=
have h1 : ∀ x : {x | 0 ≤ f x}, |f x| = f x := λ x, abs_of_nonneg x.2,
have h2 : ∀ x : {x | 0 ≤ f x}ᶜ, |f x| = -f x := λ x, abs_of_neg (not_le.1 x.2),
calc summable (λ x, |f x|) ↔
  summable (λ x : {x | 0 ≤ f x}, |f x|) ∧ summable (λ x : {x | 0 ≤ f x}ᶜ, |f x|) :
  summable_subtype_and_compl.symm
... ↔ summable (λ x : {x | 0 ≤ f x}, f x) ∧ summable (λ x : {x | 0 ≤ f x}ᶜ, -f x) :
  by simp only [h1, h2]
... ↔ _ : by simp only [summable_neg_iff, summable_subtype_and_compl]

alias summable_abs_iff ↔ summable.of_abs summable.abs

--TODO: Change the conclusion to `finite ι`
lemma finite_of_summable_const [linear_ordered_add_comm_group α] [topological_space α]
  [archimedean α] [order_closed_topology α] {b : α} (hb : 0 < b) (hf : summable (λ i : ι, b)) :
  (set.univ : set ι).finite :=
begin
  have H : ∀ s : finset ι, s.card • b ≤ ∑' i : ι, b,
  { intros s,
    simpa using sum_le_has_sum s (λ a ha, hb.le) hf.has_sum },
  obtain ⟨n, hn⟩ := archimedean.arch (∑' i : ι, b) hb,
  have : ∀ s : finset ι, s.card ≤ n,
  { intros s,
    simpa [nsmul_le_nsmul_iff hb] using (H s).trans hn },
  haveI : fintype ι := fintype_of_finset_card_le n this,
  exact set.finite_univ
end

end linear_order

lemma summable.tendsto_top_of_pos [linear_ordered_field α] [topological_space α] [order_topology α]
  {f : ℕ → α} (hf : summable f⁻¹) (hf' : ∀ n, 0 < f n) : tendsto f at_top at_top :=
begin
  rw ←inv_inv f,
  apply filter.tendsto.inv_tendsto_zero,
  apply tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
    (summable.tendsto_at_top_zero hf),
  rw eventually_iff_exists_mem,
  refine ⟨set.Ioi 0, Ioi_mem_at_top _, λ _ _, _⟩,
  rw [set.mem_Ioi, inv_eq_one_div, one_div, pi.inv_apply, _root_.inv_pos],
  exact hf' _,
end


/-
This is a d∃∀duction file providing first exercises about quantifiers and numbers.
French version.
-/

import data.set
import data.real.basic
import tactic

-- dEAduction tactics
import structures2      -- hypo_analysis, targets_analysis
import utils            -- no_meta_vars
import user_notations   -- notations that can be used in deaduction UI for a new object

-- dEAduction definitions
import set_definitions

-- dEAduction tactics
import push_neg_1
-- dEAduction definitions
-- import set_definitions

-- General principles :
-- Type should be defined as parameters, in order to be implicit everywhere
-- other parameters are implicit in definitions, i.e. defined using '{}' (e.g. {A : set X} )
-- but explicit everywhere else, i.e. defined using '()' (e.g. (A : set X) )
-- each definition must be an iff statement (since it will be called with 'rw' or 'symp_rw')

---------------------
-- Course metadata --
---------------------
-- logic names ['and', 'or', 'negate', 'implicate', 'iff', 'forall', 'exists']
-- proofs names ['use_proof_methods', 'new_object', 'apply', 'assumption']
-- magic names ['compute']
-- proof methods names ['cbr', 'contrapose', 'absurdum', 'sorry']
-- Note for Python devs:
--      Any supplementary metadata will be put in the 'info' dict of each exo

/- dEAduction
Author
    Frédéric Le Roux
Institution
    Université de France
Title
    Logique et inégalités
Description
    Ce fichier contient quelques exercices de base
    impliquant des quantificateurs et des inégalités.
    Certains buts sont vrais et d'autres faux :
    avant de commencer l'exercice,
    vous choisirez ce que vous voulez prouver,
    le but ou sa négation.
OpenQuestion
    True
AvailableExercises
    NONE
AvailableLogic
    ALL -not
-/

-- If OpenQuestion is True, DEAduction will ask the user if she wants to
-- prove the statement or its negation, and set the variable
-- NegateStatement accordingly
-- If NegateStatement is True, then the statement will be replaced by its
-- negation
-- AvailableExercises is set to None so that no exercise statement can be applied
-- by the user. Recommended with OpenQuestions set to True!

local attribute [instance] classical.prop_decidable

---------------------------------------------
-- global parameters = implicit variables --
---------------------------------------------
section course

namespace Logique_et_nombres_reels
/- dEAduction
PrettyName
    Logique et nombres réels
-/

namespace negation
/- dEAduction
PrettyName
    Enoncés de négation
-/

lemma theorem.negation_et {P Q : Prop} :
( not (P and Q) ) ↔ ( (not P) or (not Q) )
:=
/- dEAduction
PrettyName
    Négation du 'et'
-/
begin
    exact not_and_distrib
end

lemma theorem.negation_ou {P Q : Prop} :
( not (P or Q) ) ↔ ( (not P) and (not Q) )
:=
/- dEAduction
PrettyName
    Négation du 'ou'
-/
begin
    exact not_or_distrib
end

lemma theorem.negation_non {P : Prop} :
( not not P ) ↔  P
:=
/- dEAduction
PrettyName
    Négation du 'non'
-/
begin
    exact not_not
end

lemma theorem.negation_implique {P Q : Prop} :
( not (P → Q) ) ↔  ( P and (not Q) )
:=
/- dEAduction
PrettyName
    Négation d'une implication
-/
begin
    exact not_imp,
end

lemma theorem.negation_existe  {X : Sort*} {P : X → Prop} :
( ( not ∃ (x:X), P x  ) ↔ ∀ x:X, not P x )
:=
/- dEAduction
PrettyName
    Négation de '∃X, P(x)'
-/
begin
    exact not_exists,
end

lemma theorem.negation_pour_tout {X : Sort*} {P : X → Prop} :
( not (∀x, P x ) ) ↔ ∃x, not P x
:=
/- dEAduction
PrettyName
    Négation de '∀x, P(x)'
-/
begin
    exact not_forall
end

lemma theorem.negation_inegalite_stricte {X : Type} (x y : X) [linear_order X]:
( not (x < y) ) ↔ y ≤ x
:=
/- dEAduction
PrettyName
    Négation de 'x < y'
-/
begin
    exact not_lt
end

lemma theorem.negation_inegalite_large {X : Type} (x y : X) [linear_order X]:
( not (x ≤ y) ) ↔ y < x
:=
/- dEAduction
PrettyName
    Négation de 'x ≤ y'
-/
begin
    exact not_le
end

end negation

namespace exercices
/- dEAduction
PrettyName
    Exercices
-/

lemma exercise.zero_ou_un : ∀ n:ℕ, (n ≠ 0 or n ≠ 1)
:=
/- dEAduction
PrettyName
    Pas zéro ou pas un
-/
begin
    todo
end

lemma exercise.zero_ou_un_2 : not (∀ n:ℕ, (n = 0 or n = 1))
:=
/- dEAduction
PrettyName
    Zéro ou un ou ?...
-/
begin
    push_neg_1,
end

lemma exercise.plus_petit : ∃ m:ℕ, ∀ n:ℕ, m ≤ n
:=
/- dEAduction
PrettyName
    Plus petit que tous
-/
begin
    todo
end

lemma exercise.vraiment_plus_petit : ∃ m:ℤ, ∀ n:ℤ, m ≤ n
:=
/- dEAduction
PrettyName
    Plus petit que tous...
-/
begin
    todo
end

lemma exercise.egalite : ∀ n:ℕ, ∃ m:ℕ, m=n
:=
/- dEAduction
PrettyName
    Tous égaux
-/
begin
    todo
end

lemma exercise.egalite_2 :
∃ m:ℕ, ∀ n:ℕ, m=n
:=
/- dEAduction
PrettyName
    Egaux à tous !
-/
begin
    todo
end

lemma exercise.tres_petit :
not (∀ a ≥ (0:ℝ), ∀ ε ≥ (0:ℝ), (a ≤ ε → a = 0))
:=
/- dEAduction
PrettyName
    Très petit
-/
begin
    push_neg,
    push_neg_1,
end

lemma exercise.tres_petit_2 :
∀ a ≥ (0:ℝ), ((∀ ε ≥ (0:ℝ), a ≤ ε) → a = 0)
:=
/- dEAduction
PrettyName
    Ca se complique
SimplificationCompute
    $ALL
-/
begin
    todo
end

lemma exercise.tres_petit_3 :
∀ a ≥ (0:ℝ), ((∀ ε > (0:ℝ), a ≤ ε) → a = 0)
:=
/- dEAduction
PrettyName
    Trop compliqué !
-/
begin
    todo
end

lemma exercise.entre_deux_entiers :
∀x:ℤ, ∀y:ℤ, (x<y → (∃z:ℤ, x < z and z < y))
:=
/- dEAduction
PrettyName
    Entre deux entiers
-/
begin
    todo
end

lemma exercise.entre_deux_reels :
∀x:ℝ, ∀y:ℝ, (x<y → (∃z:ℝ, x < z and z < y))
:=
/- dEAduction
PrettyName
    Entre deux réels
-/
begin
    todo
end

end exercices

end Logique_et_nombres_reels

end course


-- Una_funcion_tiene_inversa_si_y_solo_si_es_biyectiva.lean
-- Una función tiene inversa si y solo si es biyectiva
-- José A. Alonso Jiménez
-- Sevilla, 2 de agosto de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- En Lean se puede definir que g es una inversa de f por
--    def inversa (f : X → Y) (g : Y → X) :=
--      (∀ x, (g ∘ f) x = x) ∧ (∀ y, (f ∘ g) y = y)
-- y que f tiene inversa por
--    def tiene_inversa (f : X → Y) :=
--      ∃ g, inversa g f
--
-- Demostrar que la función f tiene inversa si y solo si f es biyectiva.
-- ---------------------------------------------------------------------

import tactic
open function

variables {X Y : Type*}
variable  (f : X → Y)
def inversa (f : X → Y) (g : Y → X) :=
  (∀ x, (g ∘ f) x = x) ∧ (∀ y, (f ∘ g) y = y)

def tiene_inversa (f : X → Y) :=
  ∃ g, inversa g f

-- 1ª demostración
example : tiene_inversa f ↔ bijective f :=
begin
  split,
  { rintro ⟨g, ⟨h1, h2⟩⟩,
    split,
    { intros p q hf,
      calc p = g (f p) : (h2 p).symm
         ... = g (f q) : congr_arg g hf
         ... = q       : h2 q, },
    { intro y,
      use g y,
      exact h1 y, }},
  { rintro ⟨hfinj, hfsur⟩,
    choose g hg using hfsur,
    use g,
    split,
    { exact hg, },
    { intro a,
      apply hfinj,
      rw hg (f a), }},
end

-- 2ª demostración
example : tiene_inversa f ↔ bijective f :=
begin
  split,
  { rintro ⟨g, ⟨h1, h2⟩⟩,
    split,
    { intros p q hf,
      calc p = g (f p) : (h2 p).symm
         ... = g (f q) : congr_arg g hf
         ... = q       : h2 q, },
    { intro y,
      use [g y, h1 y], }},
  { rintro ⟨hfinj, hfsur⟩,
    choose g hg using hfsur,
    use g,
    split,
    { exact hg, },
    { intro a,
      exact @hfinj (g (f a)) a (hg (f a)), }},
end

-- 3ª demostración
example : tiene_inversa f ↔ bijective f :=
begin
  split,
  { rintro ⟨g, ⟨h1, h2⟩⟩,
    split,
    { intros p q hf,
      calc p = g (f p) : (h2 p).symm
         ... = g (f q) : congr_arg g hf
         ... = q       : h2 q, },
    { intro y,
      use [g y, h1 y], }},
  { rintro ⟨hfinj, hfsur⟩,
    choose g hg using hfsur,
    use g,
    exact ⟨hg, λ a, @hfinj (g (f a)) a (hg (f a))⟩, },
end

-- 4ª demostración
example
  : tiene_inversa f ↔ bijective f :=
begin
  split,
  { rintro ⟨g, ⟨h1, h2⟩⟩,
    split,
    { intros p q hf,
      calc p = g (f p) : (h2 p).symm
         ... = g (f q) : congr_arg g hf
         ... = q       : h2 q, },
    { intro y,
      use [g y, h1 y], }},
  { rintro ⟨hfinj, hfsur⟩,
    choose g hg using hfsur,
    use [g, ⟨hg, λ a, @hfinj (g (f a)) a (hg (f a))⟩], },
end


import data.multiset.basic data.real.basic
  analysis.inner_product_space.basic
  data.multiset.fintype
import tactic.wlog

-- needed to get decidable_eq for sets!
open classical
local attribute [instance] prop_decidable

variables {α : Type}

lemma pauls_multiset_induction {α: Type} {p : multiset α → Prop} (C : multiset α) :
p 0 → (Π C' : multiset α, (Π a : α, p C' → p (a ::ₘ C'))) → p C :=
begin
  induction C using multiset.strong_induction_on,
  by_cases C_s = 0,
  {
    rcases h with rfl,
    tauto,
  },
  {
    intro _,
    rcases multiset.exists_mem_of_ne_zero h with ⟨d, hd⟩,
    rcases multiset.exists_cons_of_mem hd with ⟨D, rfl⟩,
    intro f,
    have D_lt_C : D < d ::ₘ D := multiset.lt_iff_cons_le.mpr ⟨d, le_refl (d ::ₘ D)⟩,
    have := C_ᾰ D D_lt_C ᾰ f,
    exact f D d this,
  }
end

lemma multiset.card_induction {α: Type} {β : α → Type} {p : Π {a : α}, multiset (β a) → Prop} {a : α} (C : multiset (β a)) :
(∀ {b : α} (D : multiset (β b)), (∀ {c : α} (E : multiset (β c)), E.card < D.card → p E) → p D) → p C :=
begin
  intro ps,
  generalize hn : C.card = n,
  replace hn : C.card ≤ n := le_of_eq hn,
  induction n with n ih generalizing C a,
  {
    rw [nat.le_zero_iff, multiset.card_eq_zero] at hn,
    rcases hn with rfl,
    apply ps,
    simp only [multiset.card_zero, not_lt_zero', is_empty.forall_iff, forall_const],
    tauto,
  },
  {
    apply (ps C),
    intros b E hE,
    apply ih,
    apply nat.le_of_lt_succ,
    exact lt_of_lt_of_le hE hn,
  },
end

lemma multiset_split_le' {F : multiset α} :
∀ C D : multiset α, ∀ (h : F ≤ C + D), ∃ G H : multiset α, G ≤ C ∧ H ≤ D ∧ F = G + H :=
begin
  induction F using pauls_multiset_induction with K l ih,
  {
    intros C D h,
    refine ⟨0, 0, _⟩,
    simp,
  },
  {
    intros C D h,
    have hl : l ∈ C + D :=
    begin
      refine multiset.mem_of_subset _ (multiset.mem_cons_self l K),
      exact multiset.subset_of_le h,
    end,
    wlog hlC : l ∈ C using [C D, D C],
    {exact multiset.mem_add.mp hl},
    {
      rcases multiset.exists_cons_of_mem hlC with ⟨T, rfl⟩,
      have KssTD : K ≤ T + D :=
      begin --multiset.cons_subset_cons, multiset.cons_add] using h,
        rw [multiset.cons_add] at h,
        refine (multiset.cons_le_cons_iff l).mp h,
      end,
      rcases ih _ _ KssTD with ⟨G', H', hG, hH, rfl⟩,
      refine ⟨l ::ₘ G', H', _⟩,
      split,
      any_goals {simp [hG, hH, multiset.cons_le_cons]},
    },
    {
      rw [add_comm] at h hl,
      rcases this h hl with ⟨G', H', hG, hH, hhh⟩,
      refine ⟨H', G', _⟩,
      rw [add_comm],
      tauto,
    }
  }
end

lemma multiset_split_le {C D F : multiset α}
(h : F ≤ C + D) : ∃ G H : multiset α, G ≤ C ∧ H ≤ D ∧ F = G + H :=
begin
  exact multiset_split_le' C D h
end

def multiset_all {α : Type} (p : α → Prop) (C : multiset α) : Prop :=
∀ a : α, a ∈ C → p a

lemma ex_multiset_argmax {α : Type} (f : α → ℝ) {m : multiset α} (hm : m ≠ 0) :
∃ a ∈ m, ∀ b ∈ m, f a ≥ f b :=
begin
  induction m using pauls_multiset_induction,
  {contradiction},
  {
    by_cases hz : m_C' = 0,
    {
      rw [hz],
      refine ⟨m_a, multiset.mem_cons_self _ _, _⟩,
      simp only [multiset.mem_cons, multiset.not_mem_zero, or_false,
        ge_iff_le, forall_eq],
    },
    {
      rcases m_ᾰ hz with ⟨z, ⟨zmem, zprop⟩⟩,
      by_cases hle : f z ≤ f m_a,
      {
        refine ⟨m_a, multiset.mem_cons_self _ _, _⟩,
        intros b hb,
        rcases multiset.mem_cons.mp hb with ⟨-, -⟩,
        {apply le_refl},
        {exact le_trans (zprop b h) hle},
      },
      {
        refine ⟨z, multiset.mem_cons_of_mem zmem, _⟩,
        intros b hb,
        rcases multiset.mem_cons.mp hb with ⟨-, -⟩,
        {apply le_of_not_ge hle},
        {exact zprop b h},
      },
    },
  },
end

lemma multiset_exists_of_le_map {α β : Type} {f : α → β} {b : multiset β} {l : multiset α} :
b ≤ multiset.map f l → ∃ as : multiset α, as ≤ l ∧ multiset.map f as = b :=
begin
  induction b,
  begin
    induction b generalizing l,
    begin
      simp,
    end,
    begin
      intro h,
      simp only [multiset.quot_mk_to_coe''] at *,
      rw [←multiset.cons_coe] at *,
      have := multiset.mem_of_le h (multiset.mem_cons_self b_hd b_tl),
      simp only [multiset.mem_map] at this,
      rcases this with ⟨a, ⟨a_mem_l, a_to_b_hd⟩⟩,
      rcases (multiset.exists_cons_of_mem a_mem_l) with ⟨l_tl, rfl⟩,
      simp only [multiset.map_cons, a_to_b_hd] at h,
      have := multiset.erase_le_erase b_hd h,
      simp only [multiset.erase_cons_head] at this,
      rcases b_ih this with ⟨as_tl, ⟨hle, heq⟩⟩,
      apply exists.intro (a ::ₘ as_tl),
      simp only [multiset.cons_le_cons_iff, hle, multiset.map_cons, a_to_b_hd],
      simp [multiset.cons_eq_cons, heq],
    end,
  end,
  begin
    simp,
  end
end

lemma ex_maximal_multiset {α : Type} {p : multiset α → Prop}
{C D : multiset α}
(hDC : D ≤ C) (pD : p D) :
∃ F : multiset α, F ≤ C ∧ p F ∧
∀ G : multiset α, F ≤ G → G ≤ C → p G → F = G :=
begin
  simp only [multiset.le_iff_exists_add] at hDC,
  rcases hDC with ⟨D', rfl⟩,
  let q : ℕ → Prop := λ k, ∃ F : multiset α, F.card + k = (D.card + D'.card) ∧ D ≤ F ∧ F ≤ D + D' ∧ p F,
  have ex : ∃ k : ℕ, q k,
  {
    refine ⟨D'.card, D, rfl, le_refl D, multiset.le_add_right _ _, pD⟩,
  },
  let k := nat.find ex,
  rcases nat.find_spec ex with ⟨F, hk, leF, Fle, pF⟩,
  refine ⟨F, Fle, pF, _⟩,
  intros G hFG Gle pG,
  let l := D.card + D'.card - G.card,
  have hl : G.card + l = D.card + D'.card,
  {
    simp only [l, ←multiset.card_add D D'],
    rw [add_tsub_cancel_of_le (multiset.card_mono Gle)],
  },
  have ql : q l := ⟨G, hl, le_trans leF hFG, Gle, pG⟩,
  have : k ≤ l := nat.find_min' ex ql,
  simp only [←hk] at hl,
  replace this := add_le_add_left this G.card,
  rw [hl] at this,
  simp only [k, add_le_add_iff_right] at this,
  exact multiset.eq_of_le_of_card_le hFG this,
end

lemma ex_minimal_multiset {α : Type} {p : multiset α → Prop}
{C D : multiset α}
(hDC : D ≤ C) (pD : p D) :
∃ F : multiset α, F ≤ C ∧ p F ∧
∀ G : multiset α, G ≤ F → p G → F = G :=
begin
  simp only [multiset.le_iff_exists_add] at hDC,
  rcases hDC with ⟨D', rfl⟩,
  let q : ℕ → Prop := λ k, ∃ F : multiset α, F.card = k ∧ F ≤ D ∧ p F,
  have ex : ∃ k : ℕ, q k,
  {
    refine ⟨D.card, D, rfl, le_refl D, pD⟩,
  },
  let k := nat.find ex,
  rcases nat.find_spec ex with ⟨F, hk, Fle, pF⟩,
  refine ⟨F, le_trans Fle (multiset.le_add_right _ _), pF, _⟩,
  intros G Gle pG,
  let l := G.card,
  have ql : q l := ⟨G, rfl, le_trans Gle Fle, pG⟩,
  have : k ≤ l := nat.find_min' ex ql,
  symmetry,
  simp only [k, ←hk] at this,
  exact multiset.eq_of_le_of_card_le Gle this,
end

lemma sum_multiset_le {V : Type} [inner_product_space ℝ V]
{C : multiset (submodule ℝ V)}
{E : submodule ℝ V}
(h : multiset_all (λ W, W ≤ E) C) :
C.sum ≤ E :=
begin
  induction C using multiset.induction,
  {simp only [multiset.sum_zero, submodule.zero_eq_bot, bot_le]},
  {
    simp only [multiset.sum_cons, submodule.add_eq_sup, sup_le_iff],
    split,
    {
      refine h C_a _,
      simp only [multiset.mem_cons_self],
    },
    {
      refine C_ᾰ _,
      intros W hW,
      refine h W _,
      simp only [hW, multiset.mem_cons, or_true],
    },
  },
end

lemma le_sum_multiset_of_mem {V : Type} [inner_product_space ℝ V]
{C : multiset (submodule ℝ V)}
{E : submodule ℝ V}
(h : E ∈ C) :
E ≤ C.sum :=
begin
  rcases multiset.exists_cons_of_mem h with ⟨D, rfl⟩,
  simp only [multiset.sum_cons, submodule.add_eq_sup, le_sup_left],
end

lemma multiset_sum_mono {V α: Type} [inner_product_space ℝ V]
{C : multiset α}
{f g : α → submodule ℝ V}
(h : f ≤ g) : (C.map f).sum ≤ (C.map g).sum :=
begin
  induction C using pauls_multiset_induction,
  {
    simp only [multiset.map_zero, multiset.sum_zero, submodule.zero_eq_bot, le_bot_iff],
  },
  {
    simp only [multiset.map_cons, multiset.sum_cons, submodule.add_eq_sup, sup_le_iff],
    split,
    {
      exact le_trans (h C_a) le_sup_left,
    },
    {
      exact le_trans C_ᾰ le_sup_right,
    },
  },
end

lemma map_lambda
{α β : Type}
(f : α → β) (C : multiset α) :
C.map f = C.map (λ x, f x) := rfl

lemma cons_erase_cons {α : Type}
(C D: multiset α) (a : α) :
a ::ₘ C - a ::ₘ D = C - D :=
begin
  simp only [multiset.sub_cons, multiset.erase_cons_head],
end

lemma dite_true {α : Type} {p : Prop} (h : p) (ft : p → α) (ff : ¬p → α) :
dite p ft ff = ft h :=
begin
  have : ft = λ h', ft h,
  {
    funext, refl,
  },
  rw [this],
  apply dite_eq_left_iff.mpr,
  intro hc,
  have := hc h,
  contradiction,
end

lemma dite_false {α : Type} {p : Prop} (h : ¬p) (ft : p → α) (ff : ¬p → α) :
dite p ft ff = ff h :=
begin
  have : ff = λ h', ff h := rfl,
  rw [this],
  apply dite_eq_right_iff.mpr,
  intro hc,
  have := h hc,
  contradiction,
end

noncomputable def multiset.add_to_enum_finset {α : Type}
(C D : multiset α) :
(C + D).to_enum_finset ≃ C.to_enum_finset ⊕ D.to_enum_finset :=
begin
  refine ⟨_, _, _, _⟩,
  {
    intro x,
    by_cases h : x.val.snd < C.count x.val.fst,
    {
      left,
      refine ⟨x.val, _⟩,
      simp only [multiset.mem_to_enum_finset],
      exact h,
    },
    {
      right,
      refine ⟨⟨x.val.fst, x.val.snd - C.count x.val.fst⟩, _⟩,
      push_neg at h,
      have := x.property,
      simp only [multiset.mem_to_enum_finset] at this ⊢,
      simp only [multiset.count_add] at this,
      rcases nat.exists_eq_add_of_le h with ⟨l, hl⟩,
      rw [hl, add_tsub_cancel_left],
      zify at *,
      linarith,
    },
  },
  {
    intro x,
    rcases x with x | x,
    {
      refine ⟨x.val, _⟩,
      have := x.property,
      simp only [multiset.mem_to_enum_finset] at this ⊢,
      refine lt_of_lt_of_le this _,
      apply multiset.count_le_of_le,
      simp only [le_add_iff_nonneg_right, zero_le],
    },
    {
      refine ⟨⟨x.val.fst, x.val.snd + C.count x.val.fst⟩, _⟩,
      have := x.property,
      simp only [multiset.mem_to_enum_finset] at this ⊢,
      simp only [multiset.count_add],
      conv {to_lhs, rw [add_comm]},
      simp only [subtype.val_eq_coe, add_lt_add_iff_left],
      exact this,
    },
  },
  {
    simp only [function.left_inverse_iff_comp],
    funext x,
    simp only [function.comp_app, id.def],
    by_cases h : x.val.snd < multiset.count x.val.fst C,
    {
      rw [dite_true h],
      simp only [subtype.val_eq_coe, finset.mk_coe],
    },
    {
      rw [dite_false h],
      push_neg at h,
      simp only [nat.sub_add_cancel h],
      simp only [subtype.val_eq_coe, prod.mk.eta, finset.mk_coe],
    },
  },
  {
    simp only [function.right_inverse_iff_comp],
    funext x,
    cases x,
    {
      have := x.property,
      simp only [subtype.val_eq_coe, subtype.coe_mk, not_lt, function.comp_app, finset.mk_coe, id.def, dite_eq_left_iff] at this ⊢,
      simp only [multiset.mem_to_enum_finset] at this,
      intro hc,
      linarith,
    },
    {
      have := x.property,
      simp only [multiset.mem_to_enum_finset] at this,
      simp only [subtype.val_eq_coe, subtype.coe_mk, add_lt_iff_neg_right, not_lt_zero', not_false_iff, function.comp_app,
      add_tsub_cancel_right, prod.mk.eta, finset.mk_coe, dif_neg, id.def] at this ⊢,
    },
  },
end

noncomputable def multiset.glue_enum_fns {α β : Type}
{C D : multiset α}
(fC : C.to_enum_finset → β) (fD : D.to_enum_finset → β) :
(C + D).to_enum_finset → β :=
begin
  intro x,
  cases multiset.add_to_enum_finset C D x with k k,
  {
    exact fC k,
  },
  {
    exact fD k,
  },
end

@[simp]
lemma multiset.zero_to_enum_finset {α : Type} :
(0 : multiset α).to_enum_finset = ∅ :=
begin
  rw [←finset.card_eq_zero],
  rw [multiset.card_to_enum_finset, multiset.card_zero],
end

lemma multiset.exists_elementwise_preimage {α β : Type}
(C : multiset α) (f : β → α) (h : ∀ a : α, a ∈ C → a ∈ set.range f) :
∃ D : multiset β, D.map f = C :=
begin
  induction C using pauls_multiset_induction with C a ih,
  {
    simp only [multiset.map_eq_zero, exists_apply_eq_apply],
  },
  {
    obtain ⟨b, rfl⟩ := h a (multiset.mem_cons_self _ _),
    obtain ⟨D, hD⟩ := ih _, rotate,
    {
      intros a aC,
      exact h a (multiset.mem_cons_of_mem aC),
    },
    refine ⟨b ::ₘ D, _⟩,
    simpa only [multiset.map_cons, multiset.cons_inj_right] using hD,
  },
end

@[simp]
lemma multiset_all_zero {α : Type} {p : α → Prop} :
multiset_all p (0 : multiset α) = true :=
begin
  simp only [multiset_all, multiset.not_mem_zero, is_empty.forall_iff, implies_true_iff],
end

@[simp]
lemma multiset.zero_eq_map {α β : Type} {s : multiset α} {f : α → β} :
0 = s.map f ↔ s = 0 :=
begin
  split,
  {intro h, replace h := h.symm, simpa only [multiset.map_eq_zero] using h},
  {intro h, simp only [*, multiset.map_zero]},
end

lemma multiset.exists_join' {α β γ : Type} {f : α → γ} {g : β → γ}
{C : multiset α} {D : multiset β} (h : C.map f = D.map g) :
∃ E : multiset ({pr : α × β // f pr.fst = g pr.snd}),
E.map (λ pr, pr.val.fst) = C ∧ E.map (λ pr, pr.val.snd) = D :=
begin
  revert D,
  induction C using pauls_multiset_induction with C a ih,
  {
    intros D h,
    simp only [multiset.map_eq_zero, exists_eq_left, multiset.map_zero],
    simp only [multiset.map_zero, multiset.zero_eq_map] at h,
    simp only [h, eq_self_iff_true, true_and, multiset_all_zero],
  },
  {
    intros D h,
    simp only [multiset.map_cons] at h,
    have : f a ∈ D.map g := h ▸ multiset.mem_cons_self (f a) (C.map f),
    rw [multiset.mem_map] at this,
    obtain ⟨b, bD, hd⟩ := this,
    obtain ⟨D, rfl⟩ := multiset.exists_cons_of_mem bD,
    simp only [multiset.map_cons, hd, multiset.cons_inj_right] at h,
    obtain ⟨E, hE⟩ := ih h,
    refine ⟨⟨⟨a, b⟩, _⟩ ::ₘ E, _⟩,
    {simp only [hd]},
    {
      simp only [subtype.val_eq_coe, multiset.map_cons, subtype.coe_mk, multiset.cons_inj_right],
      exact hE,
    },
  },
end

lemma multiset.exists_join {α β γ : Type} {f : α → γ} {g : β → γ}
{C : multiset α} {D : multiset β} (h : C.map f = D.map g) :
∃ E : multiset (α × β), E.map prod.fst = C ∧ E.map prod.snd = D ∧
multiset_all (λ x : α × β, f x.fst = g x.snd) E :=
begin
  revert D,
  induction C using pauls_multiset_induction with C a ih,
  {
    intros D h,
    simp only [multiset.map_eq_zero, exists_eq_left, multiset.map_zero],
    simp only [multiset.map_zero, multiset.zero_eq_map] at h,
    simp only [h, eq_self_iff_true, true_and, multiset_all_zero],
  },
  {
    intros D h,
    simp only [multiset.map_cons] at h,
    have : f a ∈ D.map g := h ▸ multiset.mem_cons_self (f a) (C.map f),
    rw [multiset.mem_map] at this,
    obtain ⟨b, bD, hd⟩ := this,
    obtain ⟨D, rfl⟩ := multiset.exists_cons_of_mem bD,
    simp only [multiset.map_cons, hd, multiset.cons_inj_right] at h,
    obtain ⟨E, hE⟩ := ih h,
    refine ⟨⟨a, b⟩ ::ₘ E, _⟩,
    simp only [hE, multiset_all, multiset.map_cons, eq_self_iff_true, multiset.mem_cons, prod.forall, prod.mk.inj_iff, true_and],
    rintro a' b' (⟨rfl, rfl⟩ | h),
    {exact hd.symm},
    {simp only [multiset_all, prod.forall] at hE, tauto},
  },
end

@[simp]
lemma multiset.sum_linear_map
{V : Type} [inner_product_space ℝ V] [finite_dimensional ℝ V]
{W : Type} [inner_product_space ℝ W] [finite_dimensional ℝ W]
(C : multiset (submodule ℝ V)) (f : V →ₗ[ℝ] W) :
submodule.map f C.sum = (C.map (submodule.map f)).sum :=
begin
  induction C using pauls_multiset_induction,
  {
    simp only [multiset.map_zero, multiset.sum_zero, submodule.zero_eq_bot, submodule.map_bot],
  },
  {
    simp only [*, multiset.map_cons, multiset.sum_cons, submodule.add_eq_sup, submodule.map_sup],
  },
end

lemma dim_add_le_dim_add_dim' {V : Type}
[inner_product_space ℝ V] [finite_dimensional ℝ V]
{U W : submodule ℝ V} :
finite_dimensional.finrank ℝ (U + W : submodule ℝ V) ≤ finite_dimensional.finrank ℝ U + finite_dimensional.finrank ℝ W :=
begin
  have := dim_add_le_dim_add_dim U W,
  simp only [←finite_dimensional.finrank_eq_dim] at this,
  rw [←cardinal.nat_cast_le, nat.cast_add],
  exact this,
end

lemma multiset.dim_sum_le_sum_dim {V : Type}
[inner_product_space ℝ V] [finite_dimensional ℝ V]
(C : multiset (submodule ℝ V)) :
finite_dimensional.finrank ℝ C.sum ≤ (C.map (λ W : submodule ℝ V, finite_dimensional.finrank ℝ W)).sum :=
begin
  induction C using pauls_multiset_induction with C W ih,
  {
    simp only [multiset.map_zero, multiset.sum_zero, le_zero_iff, finrank_eq_zero, submodule.zero_eq_bot],
  },
  {
    rw [multiset.map_cons, multiset.sum_cons, multiset.sum_cons],
    refine le_trans _ (add_le_add_left ih _),
    apply dim_add_le_dim_add_dim',
  },
end

lemma multiset.sum_one {C : multiset ℕ}
(h : multiset_all (λ n, n = 1) C) :
C.sum = C.card :=
begin
  induction C using pauls_multiset_induction with C n ih,
  {
    simp only [multiset.sum_zero, multiset.card_zero],
  },
  {
    simp only [multiset.sum_cons, multiset.card_cons],
    replace ih := ih (λ n hn, h n (multiset.mem_cons_of_mem hn)),
    rw [ih, h n (multiset.mem_cons_self _ _)],
    ac_refl,
  },
end

lemma multiset.all_map {α β: Type} {C : multiset α}
(f : α → β) (p : β → Prop) :
multiset_all p (C.map f) ↔ multiset_all (p ∘ f) C :=
begin
  simp only [multiset_all, multiset.mem_map, forall_exists_index, and_imp, forall_apply_eq_imp_iff₂],
end

lemma multiset.all_of_le {α : Type} {C D : multiset α} {p : α → Prop}
(CD : C ≤ D) :
multiset_all p D → multiset_all p C :=
begin
  simp only [multiset_all],
  intros h a aC,
  exact h a ((multiset.subset_of_le CD) aC),
end

@[simp]
lemma multiset.all_add {α : Type} {C D : multiset α} {p : α → Prop} :
multiset_all p (C + D) ↔ multiset_all p C ∧ multiset_all p D :=
begin
  simp only [multiset_all, multiset.mem_add],
  split,
  {exact λ h, ⟨λ a aC, h a (or.inl aC), λ a aC, h a (or.inr aC)⟩},
  {tauto},
end


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

! This file was ported from Lean 3 source module topology.algebra.group_with_zero
! leanprover-community/mathlib commit c10e724be91096453ee3db13862b9fb9a992fef2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Algebra.Monoid
import Mathlib.Algebra.Group.Pi
import Mathlib.Topology.Homeomorph

/-!
# Topological group with zero

In this file we define `HasContinuousInv₀` to be a mixin typeclass a type with `Inv` and
`Zero` (e.g., a `GroupWithZero`) such that `fun x ↦ x⁻¹` is continuous at all nonzero points. Any
normed (semi)field has this property. Currently the only example of `HasContinuousInv₀` in
`mathlib` which is not a normed field is the type `NNReal` (a.k.a. `ℝ≥0`) of nonnegative real
numbers.

Then we prove lemmas about continuity of `x ↦ x⁻¹` and `f / g` providing dot-style `*.inv₀` and
`*.div` operations on `Filter.Tendsto`, `ContinuousAt`, `ContinuousWithinAt`, `ContinuousOn`,
and `Continuous`. As a special case, we provide `*.div_const` operations that require only
`DivInvMonoid` and `ContinuousMul` instances.

All lemmas about `(⁻¹)` use `inv₀` in their names because lemmas without `₀` are used for
`TopologicalGroup`s. We also use `'` in the typeclass name `HasContinuousInv₀` for the sake of
consistency of notation.

On a `GroupWithZero` with continuous multiplication, we also define left and right multiplication
as homeomorphisms.
-/
open Topology Filter Function

/-!
### A `DivInvMonoid` with continuous multiplication

If `G₀` is a `DivInvMonoid` with continuous `(*)`, then `(/y)` is continuous for any `y`. In this
section we prove lemmas that immediately follow from this fact providing `*.div_const` dot-style
operations on `Filter.Tendsto`, `ContinuousAt`, `ContinuousWithinAt`, `ContinuousOn`, and
`Continuous`.
-/

variable {α β G₀ : Type _}

section DivConst

variable [DivInvMonoid G₀] [TopologicalSpace G₀] [ContinuousMul G₀] {f : α → G₀} {s : Set α}
  {l : Filter α}

theorem Filter.Tendsto.div_const {x : G₀} (hf : Tendsto f l (𝓝 x)) (y : G₀) :
    Tendsto (fun a => f a / y) l (𝓝 (x / y)) := by
  simpa only [div_eq_mul_inv] using hf.mul tendsto_const_nhds
#align filter.tendsto.div_const Filter.Tendsto.div_const

variable [TopologicalSpace α]

nonrec theorem ContinuousAt.div_const {a : α} (hf : ContinuousAt f a) (y : G₀) :
    ContinuousAt (fun x => f x / y) a :=
  hf.div_const y
#align continuous_at.div_const ContinuousAt.div_const

nonrec theorem ContinuousWithinAt.div_const {a} (hf : ContinuousWithinAt f s a) (y : G₀) :
    ContinuousWithinAt (fun x => f x / y) s a :=
  hf.div_const _
#align continuous_within_at.div_const ContinuousWithinAt.div_const

theorem ContinuousOn.div_const (hf : ContinuousOn f s) (y : G₀) :
    ContinuousOn (fun x => f x / y) s := by
  simpa only [div_eq_mul_inv] using hf.mul continuousOn_const
#align continuous_on.div_const ContinuousOn.div_const

@[continuity]
theorem Continuous.div_const (hf : Continuous f) (y : G₀) : Continuous fun x => f x / y := by
  simpa only [div_eq_mul_inv] using hf.mul continuous_const
#align continuous.div_const Continuous.div_const

end DivConst

/-- A type with `0` and `Inv` such that `fun x ↦ x⁻¹` is continuous at all nonzero points. Any
normed (semi)field has this property. -/
class HasContinuousInv₀ (G₀ : Type _) [Zero G₀] [Inv G₀] [TopologicalSpace G₀] : Prop where
  /-- The map `fun x ↦ x⁻¹` is continuous at all nonzero points. -/
  continuousAt_inv₀ : ∀ ⦃x : G₀⦄, x ≠ 0 → ContinuousAt Inv.inv x
#align has_continuous_inv₀ HasContinuousInv₀

export HasContinuousInv₀ (continuousAt_inv₀)

section Inv₀

variable [Zero G₀] [Inv G₀] [TopologicalSpace G₀] [HasContinuousInv₀ G₀] {l : Filter α} {f : α → G₀}
  {s : Set α} {a : α}

/-!
### Continuity of `fun x ↦ x⁻¹` at a non-zero point

We define `HasContinuousinv₀` to be a `GroupWithZero` such that the operation `x ↦ x⁻¹`
is continuous at all nonzero points. In this section we prove dot-style `*.inv₀` lemmas for
`Filter.Tendsto`, `ContinuousAt`, `ContinuousWithinAt`, `ContinuousOn`, and `Continuous`.
-/

theorem tendsto_inv₀ {x : G₀} (hx : x ≠ 0) : Tendsto Inv.inv (𝓝 x) (𝓝 x⁻¹) :=
  continuousAt_inv₀ hx
#align tendsto_inv₀ tendsto_inv₀

theorem continuousOn_inv₀ : ContinuousOn (Inv.inv : G₀ → G₀) ({0}ᶜ) := fun _x hx =>
  (continuousAt_inv₀ hx).continuousWithinAt
#align continuous_on_inv₀ continuousOn_inv₀

/-- If a function converges to a nonzero value, its inverse converges to the inverse of this value.
We use the name `Filter.Tendsto.inv₀` as `Filter.Tendsto.inv` is already used in multiplicative
topological groups. -/
theorem Filter.Tendsto.inv₀ {a : G₀} (hf : Tendsto f l (𝓝 a)) (ha : a ≠ 0) :
    Tendsto (fun x => (f x)⁻¹) l (𝓝 a⁻¹) :=
  (tendsto_inv₀ ha).comp hf
#align filter.tendsto.inv₀ Filter.Tendsto.inv₀

variable [TopologicalSpace α]

nonrec theorem ContinuousWithinAt.inv₀ (hf : ContinuousWithinAt f s a) (ha : f a ≠ 0) :
    ContinuousWithinAt (fun x => (f x)⁻¹) s a :=
  hf.inv₀ ha
#align continuous_within_at.inv₀ ContinuousWithinAt.inv₀

nonrec theorem ContinuousAt.inv₀ (hf : ContinuousAt f a) (ha : f a ≠ 0) :
    ContinuousAt (fun x => (f x)⁻¹) a :=
  hf.inv₀ ha
#align continuous_at.inv₀ ContinuousAt.inv₀

@[continuity]
theorem Continuous.inv₀ (hf : Continuous f) (h0 : ∀ x, f x ≠ 0) : Continuous fun x => (f x)⁻¹ :=
  continuous_iff_continuousAt.2 fun x => (hf.tendsto x).inv₀ (h0 x)
#align continuous.inv₀ Continuous.inv₀

theorem ContinuousOn.inv₀ (hf : ContinuousOn f s) (h0 : ∀ x ∈ s, f x ≠ 0) :
    ContinuousOn (fun x => (f x)⁻¹) s := fun x hx => (hf x hx).inv₀ (h0 x hx)
#align continuous_on.inv₀ ContinuousOn.inv₀

end Inv₀

/-- If `G₀` is a group with zero with topology such that `x ↦ x⁻¹` is continuous at all nonzero
points. Then the coercion `G₀ˣ → G₀` is a topological embedding. -/
theorem Units.embedding_val₀ [GroupWithZero G₀] [TopologicalSpace G₀] [HasContinuousInv₀ G₀] :
    Embedding (val : G₀ˣ → G₀) :=
  embedding_val_mk <| (continuousOn_inv₀ (G₀ := G₀)).mono <| fun _ ↦ IsUnit.ne_zero
#align units.embedding_coe₀ Units.embedding_val₀

/-!
### Continuity of division

If `G₀` is a `GroupWithZero` with `x ↦ x⁻¹` continuous at all nonzero points and `(*)`, then
division `(/)` is continuous at any point where the denominator is continuous.
-/

section Div

variable [GroupWithZero G₀] [TopologicalSpace G₀] [HasContinuousInv₀ G₀] [ContinuousMul G₀]
  {f g : α → G₀}

theorem Filter.Tendsto.div {l : Filter α} {a b : G₀} (hf : Tendsto f l (𝓝 a))
    (hg : Tendsto g l (𝓝 b)) (hy : b ≠ 0) : Tendsto (f / g) l (𝓝 (a / b)) := by
  simpa only [div_eq_mul_inv] using hf.mul (hg.inv₀ hy)
#align filter.tendsto.div Filter.Tendsto.div

theorem Filter.tendsto_mul_iff_of_ne_zero [T1Space G₀] {f g : α → G₀} {l : Filter α} {x y : G₀}
    (hg : Tendsto g l (𝓝 y)) (hy : y ≠ 0) :
    Tendsto (fun n => f n * g n) l (𝓝 <| x * y) ↔ Tendsto f l (𝓝 x) := by
  refine' ⟨fun hfg => _, fun hf => hf.mul hg⟩
  rw [← mul_div_cancel x hy]
  refine' Tendsto.congr' _ (hfg.div hg hy)
  refine' (hg.eventually_ne hy).mono fun n hn => mul_div_cancel _ hn
#align filter.tendsto_mul_iff_of_ne_zero Filter.tendsto_mul_iff_of_ne_zero

variable [TopologicalSpace α] [TopologicalSpace β] {s : Set α} {a : α}

nonrec theorem ContinuousWithinAt.div (hf : ContinuousWithinAt f s a)
    (hg : ContinuousWithinAt g s a) (h₀ : g a ≠ 0) : ContinuousWithinAt (f / g) s a :=
  hf.div hg h₀
#align continuous_within_at.div ContinuousWithinAt.div

theorem ContinuousOn.div (hf : ContinuousOn f s) (hg : ContinuousOn g s) (h₀ : ∀ x ∈ s, g x ≠ 0) :
    ContinuousOn (f / g) s := fun x hx => (hf x hx).div (hg x hx) (h₀ x hx)
#align continuous_on.div ContinuousOn.div

/-- Continuity at a point of the result of dividing two functions continuous at that point, where
the denominator is nonzero. -/
nonrec theorem ContinuousAt.div (hf : ContinuousAt f a) (hg : ContinuousAt g a) (h₀ : g a ≠ 0) :
    ContinuousAt (f / g) a :=
  hf.div hg h₀
#align continuous_at.div ContinuousAt.div

@[continuity]
theorem Continuous.div (hf : Continuous f) (hg : Continuous g) (h₀ : ∀ x, g x ≠ 0) :
    Continuous (f / g) := by simpa only [div_eq_mul_inv] using hf.mul (hg.inv₀ h₀)
#align continuous.div Continuous.div

theorem continuousOn_div : ContinuousOn (fun p : G₀ × G₀ => p.1 / p.2) { p | p.2 ≠ 0 } :=
  continuousOn_fst.div continuousOn_snd fun _ => id
#align continuous_on_div continuousOn_div

/-- The function `f x / g x` is discontinuous when `g x = 0`. However, under appropriate
conditions, `h x (f x / g x)` is still continuous.  The condition is that if `g a = 0` then `h x y`
must tend to `h a 0` when `x` tends to `a`, with no information about `y`. This is represented by
the `⊤` filter.  Note: `tendsto_prod_top_iff` characterizes this convergence in uniform spaces.  See
also `Filter.prod_top` and `Filter.mem_prod_top`. -/
theorem ContinuousAt.comp_div_cases {f g : α → G₀} (h : α → G₀ → β) (hf : ContinuousAt f a)
    (hg : ContinuousAt g a) (hh : g a ≠ 0 → ContinuousAt (↿h) (a, f a / g a))
    (h2h : g a = 0 → Tendsto (↿h) (𝓝 a ×ᶠ ⊤) (𝓝 (h a 0))) :
    ContinuousAt (fun x => h x (f x / g x)) a := by
  show ContinuousAt (↿h ∘ fun x => (x, f x / g x)) a
  by_cases hga : g a = 0
  · rw [ContinuousAt]
    simp_rw [comp_apply, hga, div_zero]
    exact (h2h hga).comp (continuousAt_id.prod_mk tendsto_top)
  · exact ContinuousAt.comp (hh hga) (continuousAt_id.prod (hf.div hg hga))
#align continuous_at.comp_div_cases ContinuousAt.comp_div_cases

/-- `h x (f x / g x)` is continuous under certain conditions, even if the denominator is sometimes
  `0`. See docstring of `ContinuousAt.comp_div_cases`. -/
theorem Continuous.comp_div_cases {f g : α → G₀} (h : α → G₀ → β) (hf : Continuous f)
    (hg : Continuous g) (hh : ∀ a, g a ≠ 0 → ContinuousAt (↿h) (a, f a / g a))
    (h2h : ∀ a, g a = 0 → Tendsto (↿h) (𝓝 a ×ᶠ ⊤) (𝓝 (h a 0))) :
    Continuous fun x => h x (f x / g x) :=
  continuous_iff_continuousAt.mpr fun a =>
    hf.continuousAt.comp_div_cases _ hg.continuousAt (hh a) (h2h a)
#align continuous.comp_div_cases Continuous.comp_div_cases

end Div

/-! ### Left and right multiplication as homeomorphisms -/

namespace Homeomorph

variable [TopologicalSpace α] [GroupWithZero α] [ContinuousMul α]

/-- Left multiplication by a nonzero element in a `GroupWithZero` with continuous multiplication
is a homeomorphism of the underlying type. -/
protected def mulLeft₀ (c : α) (hc : c ≠ 0) : α ≃ₜ α :=
  { Equiv.mulLeft₀ c hc with
    continuous_toFun := continuous_mul_left _
    continuous_invFun := continuous_mul_left _ }
#align homeomorph.mul_left₀ Homeomorph.mulLeft₀

/-- Right multiplication by a nonzero element in a `GroupWithZero` with continuous multiplication
is a homeomorphism of the underlying type. -/
protected def mulRight₀ (c : α) (hc : c ≠ 0) : α ≃ₜ α :=
  { Equiv.mulRight₀ c hc with
    continuous_toFun := continuous_mul_right _
    continuous_invFun := continuous_mul_right _ }
#align homeomorph.mul_right₀ Homeomorph.mulRight₀

@[simp]
theorem coe_mulLeft₀ (c : α) (hc : c ≠ 0) : ⇑(Homeomorph.mulLeft₀ c hc) = (c * ·) :=
  rfl
#align homeomorph.coe_mul_left₀ Homeomorph.coe_mulLeft₀

@[simp]
theorem mulLeft₀_symm_apply (c : α) (hc : c ≠ 0) :
    ((Homeomorph.mulLeft₀ c hc).symm : α → α) = (c⁻¹ * ·) :=
  rfl
#align homeomorph.mul_left₀_symm_apply Homeomorph.mulLeft₀_symm_apply

@[simp]
theorem coe_mulRight₀ (c : α) (hc : c ≠ 0) : ⇑(Homeomorph.mulRight₀ c hc) = (· * c) :=
  rfl
#align homeomorph.coe_mul_right₀ Homeomorph.coe_mulRight₀

@[simp]

end Homeomorph

section map_comap

variable [TopologicalSpace G₀] [GroupWithZero G₀] [ContinuousMul G₀] {a : G₀}

theorem map_mul_left_nhds₀ (ha : a ≠ 0) (b : G₀) : map (a * ·) (𝓝 b) = 𝓝 (a * b) :=
  (Homeomorph.mulLeft₀ a ha).map_nhds_eq b

theorem map_mul_left_nhds_one₀ (ha : a ≠ 0) : map (a * ·) (𝓝 1) = 𝓝 (a) := by
  rw [map_mul_left_nhds₀ ha, mul_one]

theorem map_mul_right_nhds₀ (ha : a ≠ 0) (b : G₀) : map (· * a) (𝓝 b) = 𝓝 (b * a) :=
  (Homeomorph.mulRight₀ a ha).map_nhds_eq b

theorem map_mul_right_nhds_one₀ (ha : a ≠ 0) : map (· * a) (𝓝 1) = 𝓝 (a) := by
  rw [map_mul_right_nhds₀ ha, one_mul]

theorem nhds_translation_mul_inv₀ (ha : a ≠ 0) : comap (· * a⁻¹) (𝓝 1) = 𝓝 a :=
  ((Homeomorph.mulRight₀ a ha).symm.comap_nhds_eq 1).trans <| by simp

/-- If a group with zero has continuous multiplication and `fun x ↦ x⁻¹` is continuous at one,
then it is continuous at any unit. -/
theorem HasContinuousInv₀.of_nhds_one (h : Tendsto Inv.inv (𝓝 (1 : G₀)) (𝓝 1)) :
    HasContinuousInv₀ G₀ where
  continuousAt_inv₀ x hx := by
    have hx' := inv_ne_zero hx
    rw [ContinuousAt, ← map_mul_left_nhds_one₀ hx, ← nhds_translation_mul_inv₀ hx',
      tendsto_map'_iff, tendsto_comap_iff]
    simpa only [(· ∘ ·), mul_inv_rev, mul_inv_cancel_right₀ hx']

end map_comap

section Zpow

variable [GroupWithZero G₀] [TopologicalSpace G₀] [HasContinuousInv₀ G₀] [ContinuousMul G₀]

theorem continuousAt_zpow₀ (x : G₀) (m : ℤ) (h : x ≠ 0 ∨ 0 ≤ m) :
    ContinuousAt (fun x => x ^ m) x := by
  cases' m with m m
  · simpa only [Int.ofNat_eq_coe, zpow_coe_nat] using continuousAt_pow x m
  · simp only [zpow_negSucc]
    have hx : x ≠ 0 := h.resolve_right (Int.negSucc_lt_zero m).not_le
    exact (continuousAt_pow x (m + 1)).inv₀ (pow_ne_zero _ hx)
#align continuous_at_zpow₀ continuousAt_zpow₀

theorem continuousOn_zpow₀ (m : ℤ) : ContinuousOn (fun x : G₀ => x ^ m) ({0}ᶜ) := fun _x hx =>
  (continuousAt_zpow₀ _ _ (Or.inl hx)).continuousWithinAt
#align continuous_on_zpow₀ continuousOn_zpow₀

theorem Filter.Tendsto.zpow₀ {f : α → G₀} {l : Filter α} {a : G₀} (hf : Tendsto f l (𝓝 a)) (m : ℤ)
    (h : a ≠ 0 ∨ 0 ≤ m) : Tendsto (fun x => f x ^ m) l (𝓝 (a ^ m)) :=
  (continuousAt_zpow₀ _ m h).tendsto.comp hf
#align filter.tendsto.zpow₀ Filter.Tendsto.zpow₀

variable {X : Type _} [TopologicalSpace X] {a : X} {s : Set X} {f : X → G₀}

nonrec theorem ContinuousAt.zpow₀ (hf : ContinuousAt f a) (m : ℤ) (h : f a ≠ 0 ∨ 0 ≤ m) :
    ContinuousAt (fun x => f x ^ m) a :=
  hf.zpow₀ m h
#align continuous_at.zpow₀ ContinuousAt.zpow₀

nonrec theorem ContinuousWithinAt.zpow₀ (hf : ContinuousWithinAt f s a) (m : ℤ)
    (h : f a ≠ 0 ∨ 0 ≤ m) : ContinuousWithinAt (fun x => f x ^ m) s a :=
  hf.zpow₀ m h
#align continuous_within_at.zpow₀ ContinuousWithinAt.zpow₀

theorem ContinuousOn.zpow₀ (hf : ContinuousOn f s) (m : ℤ) (h : ∀ a ∈ s, f a ≠ 0 ∨ 0 ≤ m) :
    ContinuousOn (fun x => f x ^ m) s := fun a ha => (hf a ha).zpow₀ m (h a ha)
#align continuous_on.zpow₀ ContinuousOn.zpow₀

@[continuity]
theorem Continuous.zpow₀ (hf : Continuous f) (m : ℤ) (h0 : ∀ a, f a ≠ 0 ∨ 0 ≤ m) :
    Continuous fun x => f x ^ m :=
  continuous_iff_continuousAt.2 fun x => (hf.tendsto x).zpow₀ m (h0 x)
#align continuous.zpow₀ Continuous.zpow₀

end Zpow


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

! This file was ported from Lean 3 source module number_theory.modular_forms.congruence_subgroups
! leanprover-community/mathlib commit ae690b0c236e488a0043f6faa8ce3546e7f2f9c5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Zmod.Basic
import Mathbin.GroupTheory.GroupAction.ConjAct
import Mathbin.GroupTheory.Subgroup.Pointwise
import Mathbin.LinearAlgebra.Matrix.SpecialLinearGroup

/-!
# Congruence subgroups

This defines congruence subgroups of `SL(2, ℤ)` such as `Γ(N)`, `Γ₀(N)` and `Γ₁(N)` for `N` a
natural number.

It also contains basic results about congruence subgroups.

-/

-- mathport name: «exprSL( , )»
local notation "SL(" n ", " R ")" => Matrix.SpecialLinearGroup (Fin n) R

attribute [-instance] Matrix.SpecialLinearGroup.hasCoeToFun

-- mathport name: «expr↑ₘ »
local prefix:1024 "↑ₘ" => @coe _ (Matrix (Fin 2) (Fin 2) _) _

open Matrix.SpecialLinearGroup Matrix

variable (N : ℕ)

-- mathport name: «exprSLMOD( )»
local notation "SLMOD(" N ")" =>
  @Matrix.SpecialLinearGroup.map (Fin 2) _ _ _ _ _ _ (Int.castRingHom (ZMod N))

@[simp]
theorem SL_reduction_mod_hom_val (N : ℕ) (γ : SL(2, ℤ)) :
    ∀ i j : Fin 2, (SLMOD(N) γ : Matrix (Fin 2) (Fin 2) (ZMod N)) i j = ((↑ₘγ i j : ℤ) : ZMod N) :=
  fun i j => rfl
#align SL_reduction_mod_hom_val SL_reduction_mod_hom_val

/-- The full level `N` congruence subgroup of `SL(2, ℤ)` of matrices that reduce to the identity
modulo `N`.-/
def gamma (N : ℕ) : Subgroup SL(2, ℤ) :=
  SLMOD(N).ker
#align Gamma gamma

theorem gamma_mem' (N : ℕ) (γ : SL(2, ℤ)) : γ ∈ gamma N ↔ SLMOD(N) γ = 1 :=
  Iff.rfl
#align Gamma_mem' gamma_mem'

@[simp]
theorem gamma_mem (N : ℕ) (γ : SL(2, ℤ)) :
    γ ∈ gamma N ↔
      ((↑ₘγ 0 0 : ℤ) : ZMod N) = 1 ∧
        ((↑ₘγ 0 1 : ℤ) : ZMod N) = 0 ∧
          ((↑ₘγ 1 0 : ℤ) : ZMod N) = 0 ∧ ((↑ₘγ 1 1 : ℤ) : ZMod N) = 1 :=
  by
  rw [gamma_mem']
  constructor
  · intro h
    simp [← SL_reduction_mod_hom_val N γ, h]
  · intro h
    ext
    rw [SL_reduction_mod_hom_val N γ]
    fin_cases i <;> fin_cases j
    all_goals simp_rw [h]; rfl
#align Gamma_mem gamma_mem

theorem gamma_normal (N : ℕ) : Subgroup.Normal (gamma N) :=
  SLMOD(N).normal_ker
#align Gamma_normal gamma_normal

theorem gamma_one_top : gamma 1 = ⊤ := by
  ext
  simp
#align Gamma_one_top gamma_one_top

theorem gamma_zero_bot : gamma 0 = ⊥ := by
  ext
  simp only [gamma_mem, coe_coe, coe_matrix_coe, Int.coe_castRingHom, map_apply, Int.cast_id,
    Subgroup.mem_bot]
  constructor
  · intro h
    ext
    fin_cases i <;> fin_cases j
    any_goals simp [h]
  · intro h
    simp [h]
#align Gamma_zero_bot gamma_zero_bot

/-- The congruence subgroup of `SL(2, ℤ)` of matrices whose lower left-hand entry reduces to zero
modulo `N`. -/
def gamma0 (N : ℕ) : Subgroup SL(2, ℤ)
    where
  carrier := { g : SL(2, ℤ) | ((↑ₘg 1 0 : ℤ) : ZMod N) = 0 }
  one_mem' := by simp
  mul_mem' := by
    intro a b ha hb
    simp only [Set.mem_setOf_eq]
    have h := (Matrix.two_mul_expl a.1 b.1).2.2.1
    simp only [coe_coe, coe_matrix_coe, coe_mul, Int.coe_castRingHom, map_apply, Set.mem_setOf_eq,
      Subtype.val_eq_coe, mul_eq_mul] at *
    rw [h]
    simp [ha, hb]
  inv_mem' := by
    intro a ha
    simp only [Set.mem_setOf_eq, Subtype.val_eq_coe]
    rw [SL2_inv_expl a]
    simp only [Subtype.val_eq_coe, cons_val_zero, cons_val_one, head_cons, coe_coe, coe_matrix_coe,
      coe_mk, Int.coe_castRingHom, map_apply, Int.cast_neg, neg_eq_zero, Set.mem_setOf_eq] at *
    exact ha
#align Gamma0 gamma0

@[simp]
theorem gamma0_mem (N : ℕ) (A : SL(2, ℤ)) : A ∈ gamma0 N ↔ ((↑ₘA 1 0 : ℤ) : ZMod N) = 0 :=
  Iff.rfl
#align Gamma0_mem gamma0_mem

theorem gamma0_det (N : ℕ) (A : gamma0 N) : (A.1.1.det : ZMod N) = 1 := by simp [A.1.property]
#align Gamma0_det gamma0_det

/-- The group homomorphism from `Gamma0` to `zmod N` given by mapping a matrix to its lower
right-hand entry. -/
def gamma0Map (N : ℕ) : gamma0 N →* ZMod N
    where
  toFun g := ((↑ₘg 1 1 : ℤ) : ZMod N)
  map_one' := by simp
  map_mul' := by
    intro A B
    have := (two_mul_expl A.1.1 B.1.1).2.2.2
    simp only [coe_coe, Subgroup.coe_mul, coe_matrix_coe, coe_mul, Int.coe_castRingHom, map_apply,
      Subtype.val_eq_coe, mul_eq_mul] at *
    rw [this]
    have ha := A.property
    simp only [Int.cast_add, Int.cast_mul, add_left_eq_self, Subtype.val_eq_coe, gamma0_mem,
      coe_coe, coe_matrix_coe, Int.coe_castRingHom, map_apply] at *
    rw [ha]
    simp
#align Gamma_0_map gamma0Map

/-- The congruence subgroup `Gamma1` (as a subgroup of `Gamma0`) of matrices whose bottom
row is congruent to `(0,1)` modulo `N`.-/
def gamma1' (N : ℕ) : Subgroup (gamma0 N) :=
  (gamma0Map N).ker
#align Gamma1' gamma1'

@[simp]
theorem Gamma1_mem' (N : ℕ) (γ : gamma0 N) : γ ∈ gamma1' N ↔ (gamma0Map N) γ = 1 :=
  Iff.rfl
#align Gamma1_mem' Gamma1_mem'

theorem Gamma1_to_gamma0_mem (N : ℕ) (A : gamma0 N) :
    A ∈ gamma1' N ↔
      ((↑ₘA 0 0 : ℤ) : ZMod N) = 1 ∧ ((↑ₘA 1 1 : ℤ) : ZMod N) = 1 ∧ ((↑ₘA 1 0 : ℤ) : ZMod N) = 0 :=
  by
  constructor
  · intro ha
    have hA := A.property
    rw [gamma0_mem] at hA
    have adet := gamma0_det N A
    rw [Matrix.det_fin_two] at adet
    simp only [gamma0Map, coe_coe, coe_matrix_coe, Int.coe_castRingHom, map_apply, Gamma1_mem',
      MonoidHom.coe_mk, Subtype.val_eq_coe, Int.cast_sub, Int.cast_mul] at *
    rw [hA, ha] at adet
    simp only [mul_one, MulZeroClass.mul_zero, sub_zero] at adet
    simp only [adet, hA, ha, eq_self_iff_true, and_self_iff]
  · intro ha
    simp only [Gamma1_mem', gamma0Map, MonoidHom.coe_mk, coe_coe, coe_matrix_coe,
      Int.coe_castRingHom, map_apply]
    exact ha.2.1
#align Gamma1_to_Gamma0_mem Gamma1_to_gamma0_mem

/-- The congruence subgroup `Gamma1` of `SL(2, ℤ)` consisting of matrices whose bottom
row is congruent to `(0,1)` modulo `N`. -/
def gamma1 (N : ℕ) : Subgroup SL(2, ℤ) :=
  Subgroup.map ((gamma0 N).Subtype.comp (gamma1' N).Subtype) ⊤
#align Gamma1 gamma1

@[simp]
theorem gamma1_mem (N : ℕ) (A : SL(2, ℤ)) :
    A ∈ gamma1 N ↔
      ((↑ₘA 0 0 : ℤ) : ZMod N) = 1 ∧ ((↑ₘA 1 1 : ℤ) : ZMod N) = 1 ∧ ((↑ₘA 1 0 : ℤ) : ZMod N) = 0 :=
  by
  constructor
  · intro ha
    simp_rw [gamma1, Subgroup.mem_map] at ha
    simp at ha
    obtain ⟨⟨x, hx⟩, hxx⟩ := ha
    rw [Gamma1_to_gamma0_mem] at hx
    rw [← hxx]
    convert hx
  · intro ha
    simp_rw [gamma1, Subgroup.mem_map]
    have hA : A ∈ gamma0 N := by simp [ha.right.right, gamma0_mem, Subtype.val_eq_coe]
    have HA : (⟨A, hA⟩ : gamma0 N) ∈ gamma1' N :=
      by
      simp only [Gamma1_to_gamma0_mem, Subgroup.coe_mk, coe_coe, coe_matrix_coe,
        Int.coe_castRingHom, map_apply]
      exact ha
    refine' ⟨(⟨(⟨A, hA⟩ : gamma0 N), HA⟩ : (gamma1' N : Subgroup (gamma0 N))), _⟩
    simp
#align Gamma1_mem gamma1_mem

theorem gamma1_in_gamma0 (N : ℕ) : gamma1 N ≤ gamma0 N :=
  by
  intro x HA
  simp only [gamma0_mem, gamma1_mem, coe_coe, coe_matrix_coe, Int.coe_castRingHom, map_apply] at *
  exact HA.2.2
#align Gamma1_in_Gamma0 gamma1_in_gamma0

section CongruenceSubgroup

/-- A congruence subgroup is a subgroup of `SL(2, ℤ)` which contains some `Gamma N` for some
`(N : ℕ+)`. -/
def IsCongruenceSubgroup (Γ : Subgroup SL(2, ℤ)) : Prop :=
  ∃ N : ℕ+, gamma N ≤ Γ
#align is_congruence_subgroup IsCongruenceSubgroup

theorem isCongruenceSubgroup_trans (H K : Subgroup SL(2, ℤ)) (h : H ≤ K)
    (h2 : IsCongruenceSubgroup H) : IsCongruenceSubgroup K :=
  by
  obtain ⟨N, hN⟩ := h2
  refine' ⟨N, le_trans hN h⟩
#align is_congruence_subgroup_trans isCongruenceSubgroup_trans

theorem gamma_is_cong_sub (N : ℕ+) : IsCongruenceSubgroup (gamma N) :=
  ⟨N, by simp only [le_refl]⟩
#align Gamma_is_cong_sub gamma_is_cong_sub

theorem gamma1_is_congruence (N : ℕ+) : IsCongruenceSubgroup (gamma1 N) :=
  by
  refine' ⟨N, _⟩
  intro A hA
  simp only [gamma1_mem, gamma_mem] at *
  simp only [hA, eq_self_iff_true, and_self_iff]
#align Gamma1_is_congruence gamma1_is_congruence

theorem gamma0_is_congruence (N : ℕ+) : IsCongruenceSubgroup (gamma0 N) :=
  isCongruenceSubgroup_trans _ _ (gamma1_in_gamma0 N) (gamma1_is_congruence N)
#align Gamma0_is_congruence gamma0_is_congruence

end CongruenceSubgroup

section Conjugation

open Pointwise

theorem gamma_cong_eq_self (N : ℕ) (g : ConjAct SL(2, ℤ)) : g • gamma N = gamma N := by
  apply Subgroup.Normal.conjAct (gamma_normal N)
#align Gamma_cong_eq_self gamma_cong_eq_self

theorem conj_cong_is_cong (g : ConjAct SL(2, ℤ)) (Γ : Subgroup SL(2, ℤ))
    (h : IsCongruenceSubgroup Γ) : IsCongruenceSubgroup (g • Γ) :=
  by
  obtain ⟨N, HN⟩ := h
  refine' ⟨N, _⟩
  rw [← gamma_cong_eq_self N g, Subgroup.pointwise_smul_le_pointwise_smul_iff]
  exact HN
#align conj_cong_is_cong conj_cong_is_cong

end Conjugation


import week_7.Part_A_quotients
import week_7.Part_B_universal_property

/-

# `Z ≃ ℤ`

Let's use the previous parts to show that Z and ℤ are isomorphic.

-/

-- Let's define pℤ to be the usual subtraction function ℕ² → ℤ
def pℤ (ab : N2) : ℤ := (ab.1 : ℤ) - ab.2

@[simp] lemma pℤ_def (a b : ℕ) : pℤ (a, b) = (a : ℤ) - b := rfl

-- Start with `intro z, apply int.induction_on z` to prove this.
theorem pℤsurj : function.surjective pℤ :=
begin
  sorry,
end

-- The fibres of pℤ are equivalence classes.
theorem pℤequiv (ab cd : N2) : ab ≈ cd ↔ pℤ ab = pℤ cd :=
begin
  sorry,
end

-- It's helpful to have a random one-sided inverse coming from surjectivity
noncomputable def invp : ℤ → N2 :=
λ z, classical.some (pℤsurj z)

-- Here's the proof that it is an inverse.
@[simp] theorem invp_inv (z : ℤ) : pℤ (invp z) = z :=
classical.some_spec (pℤsurj z)

-- Now we can prove that ℤ and pℤ are universal.
theorem int_is_universal : is_universal ℤ pℤ :=
begin
  sorry,
end

-- and now we can prove they're in bijection
noncomputable example : ℤ ≃ Z :=
universal_equiv_quotient _ _ _ int_is_universal