/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import analysis.convex.basic
import topology.algebra.order.basic

/-!
# Strictly convex sets

This file defines strictly convex sets.

A set is strictly convex if the open segment between any two distinct points lies in its interior.
-/

open set
open_locale convex pointwise

variables {𝕜 𝕝 E F β : Type*}

open function set
open_locale convex

section ordered_semiring
variables [ordered_semiring 𝕜] [topological_space E] [topological_space F]

section add_comm_monoid
variables [add_comm_monoid E] [add_comm_monoid F]

section has_scalar
variables (𝕜) [has_scalar 𝕜 E] [has_scalar 𝕜 F] (s : set E)

/-- A set is strictly convex if the open segment between any two distinct points lies is in its
interior. This basically means "convex and not flat on the boundary". -/
def strict_convex : Prop :=
s.pairwise $ λ x y, ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → a + b = 1 → a • x + b • y ∈ interior s

variables {𝕜 s} {x y : E} {a b : 𝕜}

lemma strict_convex_iff_open_segment_subset :
  strict_convex 𝕜 s ↔ s.pairwise (λ x y, open_segment 𝕜 x y ⊆ interior s) :=
forall₅_congr $ λ x hx y hy hxy, (open_segment_subset_iff 𝕜).symm

lemma strict_convex.open_segment_subset (hs : strict_convex 𝕜 s) (hx : x ∈ s) (hy : y ∈ s)
  (h : x ≠ y) :
  open_segment 𝕜 x y ⊆ interior s :=
strict_convex_iff_open_segment_subset.1 hs hx hy h

lemma strict_convex_empty : strict_convex 𝕜 (∅ : set E) := pairwise_empty _

lemma strict_convex_univ : strict_convex 𝕜 (univ : set E) :=
begin
  intros x hx y hy hxy a b ha hb hab,
  rw interior_univ,
  exact mem_univ _,
end

protected lemma strict_convex.eq (hs : strict_convex 𝕜 s) (hx : x ∈ s) (hy : y ∈ s) (ha : 0 < a)
  (hb : 0 < b) (hab : a + b = 1) (h : a • x + b • y ∉ interior s) : x = y :=
hs.eq hx hy $ λ H, h $ H ha hb hab

protected lemma strict_convex.inter {t : set E} (hs : strict_convex 𝕜 s) (ht : strict_convex 𝕜 t) :
  strict_convex 𝕜 (s ∩ t) :=
begin
  intros x hx y hy hxy a b ha hb hab,
  rw interior_inter,
  exact ⟨hs hx.1 hy.1 hxy ha hb hab, ht hx.2 hy.2 hxy ha hb hab⟩,
end

lemma directed.strict_convex_Union {ι : Sort*} {s : ι → set E} (hdir : directed (⊆) s)
  (hs : ∀ ⦃i : ι⦄, strict_convex 𝕜 (s i)) :
  strict_convex 𝕜 (⋃ i, s i) :=
begin
  rintro x hx y hy hxy a b ha hb hab,
  rw mem_Union at hx hy,
  obtain ⟨i, hx⟩ := hx,
  obtain ⟨j, hy⟩ := hy,
  obtain ⟨k, hik, hjk⟩ := hdir i j,
  exact interior_mono (subset_Union s k) (hs (hik hx) (hjk hy) hxy ha hb hab),
end

lemma directed_on.strict_convex_sUnion {S : set (set E)} (hdir : directed_on (⊆) S)
  (hS : ∀ s ∈ S, strict_convex 𝕜 s) :
  strict_convex 𝕜 (⋃₀ S) :=
begin
  rw sUnion_eq_Union,
  exact (directed_on_iff_directed.1 hdir).strict_convex_Union (λ s, hS _ s.2),
end

end has_scalar

section module
variables [module 𝕜 E] [module 𝕜 F] {s : set E}

protected lemma strict_convex.convex (hs : strict_convex 𝕜 s) : convex 𝕜 s :=
convex_iff_pairwise_pos.2 $ λ x hx y hy hxy a b ha hb hab, interior_subset $ hs hx hy hxy ha hb hab

/-- An open convex set is strictly convex. -/
protected lemma convex.strict_convex (h : is_open s) (hs : convex 𝕜 s) : strict_convex 𝕜 s :=
λ x hx y hy _ a b ha hb hab, h.interior_eq.symm ▸ hs hx hy ha.le hb.le hab

lemma is_open.strict_convex_iff (h : is_open s) : strict_convex 𝕜 s ↔ convex 𝕜 s :=
⟨strict_convex.convex, convex.strict_convex h⟩

lemma strict_convex_singleton (c : E) : strict_convex 𝕜 ({c} : set E) := pairwise_singleton _ _

lemma set.subsingleton.strict_convex (hs : s.subsingleton) : strict_convex 𝕜 s := hs.pairwise _

lemma strict_convex.linear_image [semiring 𝕝] [module 𝕝 E] [module 𝕝 F]
  [linear_map.compatible_smul E F 𝕜 𝕝] (hs : strict_convex 𝕜 s) (f : E →ₗ[𝕝] F)
  (hf : is_open_map f) :
  strict_convex 𝕜 (f '' s) :=
begin
  rintro _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ hxy a b ha hb hab,
  refine hf.image_interior_subset _ ⟨a • x + b • y, hs hx hy (ne_of_apply_ne _ hxy) ha hb hab, _⟩,
  rw [map_add, f.map_smul_of_tower a, f.map_smul_of_tower b]
end

lemma strict_convex.is_linear_image (hs : strict_convex 𝕜 s) {f : E → F} (h : is_linear_map 𝕜 f)
  (hf : is_open_map f) :
  strict_convex 𝕜 (f '' s) :=
hs.linear_image (h.mk' f) hf

lemma strict_convex.linear_preimage {s : set F} (hs : strict_convex 𝕜 s) (f : E →ₗ[𝕜] F)
  (hf : continuous f) (hfinj : injective f) :
  strict_convex 𝕜 (s.preimage f) :=
begin
  intros x hx y hy hxy a b ha hb hab,
  refine preimage_interior_subset_interior_preimage hf _,
  rw [mem_preimage, f.map_add, f.map_smul, f.map_smul],
  exact hs hx hy (hfinj.ne hxy) ha hb hab,
end

lemma strict_convex.is_linear_preimage {s : set F} (hs : strict_convex 𝕜 s) {f : E → F}
  (h : is_linear_map 𝕜 f) (hf : continuous f) (hfinj : injective f) :
  strict_convex 𝕜 (s.preimage f) :=
hs.linear_preimage (h.mk' f) hf hfinj

section linear_ordered_cancel_add_comm_monoid
variables [topological_space β] [linear_ordered_cancel_add_comm_monoid β] [order_topology β]
  [module 𝕜 β] [ordered_smul 𝕜 β]

lemma strict_convex_Iic (r : β) : strict_convex 𝕜 (Iic r) :=
begin
  rintro x (hx : x ≤ r) y (hy : y ≤ r) hxy a b ha hb hab,
  refine (subset_interior_iff_subset_of_open is_open_Iio).2 Iio_subset_Iic_self _,
  rw ←convex.combo_self hab r,
  obtain rfl | hx := hx.eq_or_lt,
  { exact add_lt_add_left (smul_lt_smul_of_pos (hy.lt_of_ne hxy.symm) hb) _ },
  obtain rfl | hy := hy.eq_or_lt,
  { exact add_lt_add_right (smul_lt_smul_of_pos hx ha) _ },
  { exact add_lt_add (smul_lt_smul_of_pos hx ha) (smul_lt_smul_of_pos hy hb) }
end

lemma strict_convex_Ici (r : β) : strict_convex 𝕜 (Ici r) := @strict_convex_Iic 𝕜 βᵒᵈ _ _ _ _ _ _ r

lemma strict_convex_Icc (r s : β) : strict_convex 𝕜 (Icc r s) :=
(strict_convex_Ici r).inter $ strict_convex_Iic s

lemma strict_convex_Iio (r : β) : strict_convex 𝕜 (Iio r) :=
(convex_Iio r).strict_convex is_open_Iio

lemma strict_convex_Ioi (r : β) : strict_convex 𝕜 (Ioi r) :=
(convex_Ioi r).strict_convex is_open_Ioi

lemma strict_convex_Ioo (r s : β) : strict_convex 𝕜 (Ioo r s) :=
(strict_convex_Ioi r).inter $ strict_convex_Iio s

lemma strict_convex_Ico (r s : β) : strict_convex 𝕜 (Ico r s) :=
(strict_convex_Ici r).inter $ strict_convex_Iio s

lemma strict_convex_Ioc (r s : β) : strict_convex 𝕜 (Ioc r s) :=
(strict_convex_Ioi r).inter $ strict_convex_Iic s

lemma strict_convex_interval (r s : β) : strict_convex 𝕜 (interval r s) :=
strict_convex_Icc _ _

end linear_ordered_cancel_add_comm_monoid
end module
end add_comm_monoid

section add_cancel_comm_monoid
variables [add_cancel_comm_monoid E] [has_continuous_add E] [module 𝕜 E] {s : set E}

/-- The translation of a strictly convex set is also strictly convex. -/
lemma strict_convex.preimage_add_right (hs : strict_convex 𝕜 s) (z : E) :
  strict_convex 𝕜 ((λ x, z + x) ⁻¹' s) :=
begin
  intros x hx y hy hxy a b ha hb hab,
  refine preimage_interior_subset_interior_preimage (continuous_add_left _) _,
  have h := hs hx hy ((add_right_injective _).ne hxy) ha hb hab,
  rwa [smul_add, smul_add, add_add_add_comm, ←add_smul, hab, one_smul] at h,
end

/-- The translation of a strictly convex set is also strictly convex. -/
lemma strict_convex.preimage_add_left (hs : strict_convex 𝕜 s) (z : E) :
  strict_convex 𝕜 ((λ x, x + z) ⁻¹' s) :=
by simpa only [add_comm] using hs.preimage_add_right z

end add_cancel_comm_monoid

section add_comm_group
variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F]

section continuous_add
variables [has_continuous_add E] {s t : set E}

lemma strict_convex.add (hs : strict_convex 𝕜 s) (ht : strict_convex 𝕜 t) :
  strict_convex 𝕜 (s + t) :=
begin
  rintro _ ⟨v, w, hv, hw, rfl⟩ _ ⟨x, y, hx, hy, rfl⟩ h a b ha hb hab,
  rw [smul_add, smul_add, add_add_add_comm],
  obtain rfl | hvx := eq_or_ne v x,
  { refine interior_mono (add_subset_add (singleton_subset_iff.2 hv) subset.rfl) _,
    rw [convex.combo_self hab, singleton_add],
    exact (is_open_map_add_left _).image_interior_subset _
      (mem_image_of_mem _ $ ht hw hy (ne_of_apply_ne _ h) ha hb hab) },
  exact subset_interior_add_left (add_mem_add (hs hv hx hvx ha hb hab) $
    ht.convex hw hy ha.le hb.le hab)
end

lemma strict_convex.add_left (hs : strict_convex 𝕜 s) (z : E) :
  strict_convex 𝕜 ((λ x, z + x) '' s) :=
by simpa only [singleton_add] using (strict_convex_singleton z).add hs

lemma strict_convex.add_right (hs : strict_convex 𝕜 s) (z : E) :
  strict_convex 𝕜 ((λ x, x + z) '' s) :=
by simpa only [add_comm] using hs.add_left z

/-- The translation of a strictly convex set is also strictly convex. -/
lemma strict_convex.vadd (hs : strict_convex 𝕜 s) (x : E) : strict_convex 𝕜 (x +ᵥ s) :=
hs.add_left x

end continuous_add

section continuous_smul
variables [linear_ordered_field 𝕝] [module 𝕝 E] [has_continuous_const_smul 𝕝 E]
  [linear_map.compatible_smul E E 𝕜 𝕝] {s : set E} {x : E}

lemma strict_convex.smul (hs : strict_convex 𝕜 s) (c : 𝕝) : strict_convex 𝕜 (c • s) :=
begin
  obtain rfl | hc := eq_or_ne c 0,
  { exact (subsingleton_zero_smul_set _).strict_convex },
  { exact hs.linear_image (linear_map.lsmul _ _ c) (is_open_map_smul₀ hc) }
end

lemma strict_convex.affinity [has_continuous_add E] (hs : strict_convex 𝕜 s) (z : E) (c : 𝕝) :
  strict_convex 𝕜 (z +ᵥ c • s) :=
(hs.smul c).vadd z

end continuous_smul
end add_comm_group
end ordered_semiring

section ordered_comm_semiring
variables [ordered_comm_semiring 𝕜] [topological_space E]

section add_comm_group
variables [add_comm_group E] [module 𝕜 E] [no_zero_smul_divisors 𝕜 E]
  [has_continuous_const_smul 𝕜 E] {s : set E}

lemma strict_convex.preimage_smul (hs : strict_convex 𝕜 s) (c : 𝕜) :
  strict_convex 𝕜 ((λ z, c • z) ⁻¹' s) :=
begin
  classical,
  obtain rfl | hc := eq_or_ne c 0,
  { simp_rw [zero_smul, preimage_const],
    split_ifs,
    { exact strict_convex_univ },
    { exact strict_convex_empty } },
  refine hs.linear_preimage (linear_map.lsmul _ _ c) _ (smul_right_injective E hc),
  unfold linear_map.lsmul linear_map.mk₂ linear_map.mk₂' linear_map.mk₂'ₛₗ,
  exact continuous_const_smul _,
end

end add_comm_group
end ordered_comm_semiring

section ordered_ring
variables [ordered_ring 𝕜] [topological_space E] [topological_space F]

section add_comm_group
variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] {s t : set E} {x y : E}

lemma strict_convex.eq_of_open_segment_subset_frontier [nontrivial 𝕜] [densely_ordered 𝕜]
  (hs : strict_convex 𝕜 s) (hx : x ∈ s) (hy : y ∈ s) (h : open_segment 𝕜 x y ⊆ frontier s) :
  x = y :=
begin
  obtain ⟨a, ha₀, ha₁⟩ := densely_ordered.dense (0 : 𝕜) 1 zero_lt_one,
  classical,
  by_contra hxy,
  exact (h ⟨a, 1 - a, ha₀, sub_pos_of_lt ha₁, add_sub_cancel'_right _ _, rfl⟩).2
    (hs hx hy hxy ha₀ (sub_pos_of_lt ha₁) $ add_sub_cancel'_right _ _),
end

lemma strict_convex.add_smul_mem (hs : strict_convex 𝕜 s) (hx : x ∈ s) (hxy : x + y ∈ s)
  (hy : y ≠ 0) {t : 𝕜} (ht₀ : 0 < t) (ht₁ : t < 1) :
  x + t • y ∈ interior s :=
begin
  have h : x + t • y = (1 - t) • x + t • (x + y),
  { rw [smul_add, ←add_assoc, ←add_smul, sub_add_cancel, one_smul] },
  rw h,
  refine hs hx hxy (λ h, hy $ add_left_cancel _) (sub_pos_of_lt ht₁) ht₀ (sub_add_cancel _ _),
  exact x,
  rw [←h, add_zero],
end

lemma strict_convex.smul_mem_of_zero_mem (hs : strict_convex 𝕜 s) (zero_mem : (0 : E) ∈ s)
  (hx : x ∈ s) (hx₀ : x ≠ 0) {t : 𝕜} (ht₀ : 0 < t) (ht₁ : t < 1) :
  t • x ∈ interior s :=
by simpa using hs.add_smul_mem zero_mem (by simpa using hx) hx₀ ht₀ ht₁

lemma strict_convex.add_smul_sub_mem (h : strict_convex 𝕜 s) (hx : x ∈ s) (hy : y ∈ s) (hxy : x ≠ y)
  {t : 𝕜} (ht₀ : 0 < t) (ht₁ : t < 1) : x + t • (y - x) ∈ interior s :=
begin
  apply h.open_segment_subset hx hy hxy,
  rw open_segment_eq_image',
  exact mem_image_of_mem _ ⟨ht₀, ht₁⟩,
end

/-- The preimage of a strictly convex set under an affine map is strictly convex. -/
lemma strict_convex.affine_preimage {s : set F} (hs : strict_convex 𝕜 s) {f : E →ᵃ[𝕜] F}
  (hf : continuous f) (hfinj : injective f) :
  strict_convex 𝕜 (f ⁻¹' s) :=
begin
  intros x hx y hy hxy a b ha hb hab,
  refine preimage_interior_subset_interior_preimage hf _,
  rw [mem_preimage, convex.combo_affine_apply hab],
  exact hs hx hy (hfinj.ne hxy) ha hb hab,
end

/-- The image of a strictly convex set under an affine map is strictly convex. -/
lemma strict_convex.affine_image (hs : strict_convex 𝕜 s) {f : E →ᵃ[𝕜] F} (hf : is_open_map f) :
  strict_convex 𝕜 (f '' s) :=
begin
  rintro _ ⟨x, hx, rfl⟩ _ ⟨y, hy, rfl⟩ hxy a b ha hb hab,
  exact hf.image_interior_subset _ ⟨a • x + b • y, ⟨hs hx hy (ne_of_apply_ne _ hxy) ha hb hab,
    convex.combo_affine_apply hab⟩⟩,
end

variables [topological_add_group E]

lemma strict_convex.neg (hs : strict_convex 𝕜 s) : strict_convex 𝕜 (-s) :=
hs.is_linear_preimage is_linear_map.is_linear_map_neg continuous_id.neg neg_injective

lemma strict_convex.sub (hs : strict_convex 𝕜 s) (ht : strict_convex 𝕜 t) :
  strict_convex 𝕜 (s - t) :=
(sub_eq_add_neg s t).symm ▸ hs.add ht.neg

end add_comm_group
end ordered_ring

section linear_ordered_field
variables [linear_ordered_field 𝕜] [topological_space E]

section add_comm_group
variables [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F] {s : set E} {x : E}

/-- Alternative definition of set strict convexity, using division. -/
lemma strict_convex_iff_div :
  strict_convex 𝕜 s ↔ s.pairwise
    (λ x y, ∀ ⦃a b : 𝕜⦄, 0 < a → 0 < b → (a / (a + b)) • x + (b / (a + b)) • y ∈ interior s) :=
⟨λ h x hx y hy hxy a b ha hb, begin
  apply h hx hy hxy (div_pos ha $ add_pos ha hb) (div_pos hb $ add_pos ha hb),
  rw ←add_div,
  exact div_self (add_pos ha hb).ne',
end, λ h x hx y hy hxy a b ha hb hab, by convert h hx hy hxy ha hb; rw [hab, div_one] ⟩

lemma strict_convex.mem_smul_of_zero_mem (hs : strict_convex 𝕜 s) (zero_mem : (0 : E) ∈ s)
  (hx : x ∈ s) (hx₀ : x ≠ 0) {t : 𝕜} (ht : 1 < t) :
  x ∈ t • interior s :=
begin
  rw mem_smul_set_iff_inv_smul_mem₀ (zero_lt_one.trans ht).ne',
  exact hs.smul_mem_of_zero_mem zero_mem hx hx₀ (inv_pos.2 $ zero_lt_one.trans ht)  (inv_lt_one ht),
end

end add_comm_group
end linear_ordered_field

/-!
#### Convex sets in an ordered space

Relates `convex` and `set.ord_connected`.
-/

section
variables [topological_space E]

/-- A set in a linear ordered field is strictly convex if and only if it is convex. -/
@[simp] lemma strict_convex_iff_convex [linear_ordered_field 𝕜] [topological_space 𝕜]
  [order_topology 𝕜] {s : set 𝕜} :
  strict_convex 𝕜 s ↔ convex 𝕜 s :=
begin
  refine ⟨strict_convex.convex, λ hs, strict_convex_iff_open_segment_subset.2 (λ x hx y hy hxy, _)⟩,
  obtain h | h := hxy.lt_or_lt,
  { refine (open_segment_subset_Ioo h).trans _,
    rw ←interior_Icc,
    exact interior_mono (Icc_subset_segment.trans $ hs.segment_subset hx hy) },
  { rw open_segment_symm,
    refine (open_segment_subset_Ioo h).trans _,
    rw ←interior_Icc,
    exact interior_mono (Icc_subset_segment.trans $ hs.segment_subset hy hx) }
end

lemma strict_convex_iff_ord_connected [linear_ordered_field 𝕜] [topological_space 𝕜]
  [order_topology 𝕜] {s : set 𝕜} :
  strict_convex 𝕜 s ↔ s.ord_connected :=
strict_convex_iff_convex.trans convex_iff_ord_connected

alias strict_convex_iff_ord_connected ↔ strict_convex.ord_connected _

end


import data.set.function
import .src_33_identity_and_inverse_functions

import tactic.norm_num

open function

namespace mth1001

/-
What about the 'converses' of these statements? Asserting the converses requires classical
reasoning and a principle called the *axiom of choice*.

Further, we'll use predicates `has_left_inverse` and `has_right_inverse`, which are merely
existentially quantified statements concerning left and right inverses.
-/

#print has_left_inverse
#print has_right_inverse

open classical

section aoc
/-
The axiom of choice is best explained via an example. Let `U` denote the type of all modules
currently running at Exeter and let `V` denote the type of all students at Exeter.

For `u : U` and `v : V`, we denote by `R u v` the notion that student `v` is enrolled on module `u`.
[Here, `R : U → V → Prop` is a predicate on the types `U` and `V`. A predicate on more than one
type is sometimes referred to as a *relation*. So `R` is a relation on `U` and `V`.]

We have `h : ∀ u : U, ∃ v : V, R u v`. That is, for every module `u`, there is a student `v` who is
enrolled on `u`.

The axiom of choice asserts, under these hypotheses, that there is a function `g : U → V` such that`
`R u (g u)` holds, for every `u : U`.

In our example, this means that for every module `u`, `g(u)` is a student enrolled on `u`.
In other words, the axiom of choice guarantees the existence of a function that has *chosen*, for
each module `u`, a student `v` enrolled on `u`. Clearly, this function is not unique! There are
many functions with this property, but we need the axiom of choice to ensure the *existence* of
such a function.
-/

  variable U : Type*
  variable V : Type*
  variable R : U → V → Prop

  example (h : ∀ u : U, ∃ v : V, R u v) : ∃ g : U → V, ∀ u : U, R u (g u) :=
  axiom_of_choice h

end aoc

section constructing_inverses

variable {α : Type*}
variable {β : Type*}

/-
The axiom of choice gives a 'one-line' proof that a surjective function has a right inverse.
If you place your cursor after the last `unfold` below, you'll see that `h` asserts
`h : ∀ b : β, ∃ a : α, f a = b`.

In our expression of the axiom of choice, `β` takes the role of `U`, `α` the role of `V`, and
`f a = b` the role of `R b a`. The axiom of choice thus asserts the existence of `g : β → α`
such that `∀ β : β, f (g b) = b`. That is, `g` is a right inverse of `g`.
-/
theorem has_right_inverse_of_surjective {f : α → β} (h : surjective f) : has_right_inverse f :=
begin
  unfold has_right_inverse,              -- These four lines aren't neeeded for
  unfold function.right_inverse,         -- Lean, but help the human mathematician to
  unfold function.left_inverse,          -- understand the proof by unfolding
  unfold function.surjective at h,       -- the defintions.
  exact axiom_of_choice h,
end

/-
The situation for left inverse is more complicated. In fact, it isn't even true in general that
an injective function has a left inverse. It's true precisely when the domain of the function is
inhabited (this is roughly the same as saying that the domain is non-empty, when viewed as a set).

In the proof below, we include the hypothesis `d : α`. This asserts that `d` is a term of type `α`.
Knowing this is equivalent to knowing that `α` is inhabited.

Here's a proof sketch:

Suppose `f : α → β`, `h : injective f`, and `d : α`. We want to construct `g : β → α` with the
property that `g (f a) = a`, for every `a : α`.

To begin, take `b : β`. There are two cases.

1. `∃ x : α, f x = b`
2. `¬(∃ x : α, f x = b)`

In the first case, we'll define `g b = x` (we need something like the axiom of choice for this).
In the second case, we'll define `g b = d`, where `d` is the 'default' term in `α` mentioned before.

It remains to show `g` is a left inverse of `f`.

Let `a : α`. We must show `g (f a) = a`. Write `b` for `f a`, so `f a = b`. We must show `g b = a`.
Certainly, `∃ x : α, f x = b`, as witnessed by `a : α`. Let `x : α` be the term used in the
construction to define `g b`, so `f x = b`. Then `g b = x`. It remains to show `x = a`.
But `f x = f a`. By injectivity of `f`, the goal follows.
-/

local attribute [instance] prop_decidable

/-
Finally, here's our proof that every injective function on an inhabited type has a left inverse.
-/
theorem has_left_inverse_of_injective {f : α → β} (h : injective f) (d : α) : has_left_inverse f :=
begin
  unfold has_left_inverse, -- These three lines aren't needed by Lean
  unfold left_inverse,     -- but assist the human matheamtician in
  unfold injective at h,   -- understanding the proof.
  -- Below, we produce the hypothesis required in applying the axiom of choice.
  have h₂ : ∀ b : β, ∃ a : α, (f a = b) ∨ ¬(∃ x : α, f x = b),
  { intro b,
    by_cases k : (∃ x : α, f x = b),
    { cases k with a k₂, -- This is the case where there is some `x` for which `f x = b`.
      use a,
      left,
      exact k₂, },
    { use d,             -- This is the case where there is no such `x`.
      right,
      exact k, }, },
  have h₃ : ∃ g : β → α, ∀ b : β, f (g b) = b ∨ ¬(∃ x : α, f x = b) := axiom_of_choice h₂,
  cases h₃ with g h₄,
  use g,
  intro a,
  let b := f a,
  specialize h₄ b,
  cases h₄ with h₅ h₆,
  { have k₂ : g b = a, from h h₅,
    show g (f a) = a, from k₂, },
  { exfalso,
    apply h₆,
    use a, },
end

/-
Finally, we have a partial converse to the result at the end of the previous file. Namely, we prove
that if `f : α → β` is bijective *and* if `α` is inhabited, then `f` is invertible.
-/
theorem invertible_of_bijective (f : α → β) (d : α) (k : bijective f) : invertible f :=
begin
  cases k with fi fs, -- We have `fi : injective f` and `fs : surjective f`.
  split, -- It suffices to prove `has_left_inverse f` and `has_right_inverse f`.
  { exact has_left_inverse_of_injective fi d, },
  { exact has_right_inverse_of_surjective fs, },
end

end constructing_inverses

end mth1001


/-
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, Scott Morrison
-/
import algebra.indicator_function
import group_theory.submonoid.basic

/-!
# Type of functions with finite support

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

For any type `α` and any type `M` with zero, we define the type `finsupp α M` (notation: `α →₀ M`)
of finitely supported functions from `α` to `M`, i.e. the functions which are zero everywhere
on `α` except on a finite set.

Functions with finite support are used (at least) in the following parts of the library:

* `monoid_algebra R M` and `add_monoid_algebra R M` are defined as `M →₀ R`;

* polynomials and multivariate polynomials are defined as `add_monoid_algebra`s, hence they use
  `finsupp` under the hood;

* the linear combination of a family of vectors `v i` with coefficients `f i` (as used, e.g., to
  define linearly independent family `linear_independent`) is defined as a map
  `finsupp.total : (ι → M) → (ι →₀ R) →ₗ[R] M`.

Some other constructions are naturally equivalent to `α →₀ M` with some `α` and `M` but are defined
in a different way in the library:

* `multiset α ≃+ α →₀ ℕ`;
* `free_abelian_group α ≃+ α →₀ ℤ`.

Most of the theory assumes that the range is a commutative additive monoid. This gives us the big
sum operator as a powerful way to construct `finsupp` elements, which is defined in
`algebra/big_operators/finsupp`.

Many constructions based on `α →₀ M` use `semireducible` type tags to avoid reusing unwanted type
instances. E.g., `monoid_algebra`, `add_monoid_algebra`, and types based on these two have
non-pointwise multiplication.

## Main declarations

* `finsupp`: The type of finitely supported functions from `α` to `β`.
* `finsupp.single`: The `finsupp` which is nonzero in exactly one point.
* `finsupp.update`: Changes one value of a `finsupp`.
* `finsupp.erase`: Replaces one value of a `finsupp` by `0`.
* `finsupp.on_finset`: The restriction of a function to a `finset` as a `finsupp`.
* `finsupp.map_range`: Composition of a `zero_hom` with a `finsupp`.
* `finsupp.emb_domain`: Maps the domain of a `finsupp` by an embedding.
* `finsupp.zip_with`: Postcomposition of two `finsupp`s with a function `f` such that `f 0 0 = 0`.

## Notations

This file adds `α →₀ M` as a global notation for `finsupp α M`.

We also use the following convention for `Type*` variables in this file

* `α`, `β`, `γ`: types with no additional structure that appear as the first argument to `finsupp`
  somewhere in the statement;

* `ι` : an auxiliary index type;

* `M`, `M'`, `N`, `P`: types with `has_zero` or `(add_)(comm_)monoid` structure; `M` is also used
  for a (semi)module over a (semi)ring.

* `G`, `H`: groups (commutative or not, multiplicative or additive);

* `R`, `S`: (semi)rings.

## Implementation notes

This file is a `noncomputable theory` and uses classical logic throughout.

## TODO

* Expand the list of definitions and important lemmas to the module docstring.

-/

noncomputable theory

open finset function
open_locale big_operators

variables {α β γ ι M M' N P G H R S : Type*}

/-- `finsupp α M`, denoted `α →₀ M`, is the type of functions `f : α → M` such that
  `f x = 0` for all but finitely many `x`. -/
structure finsupp (α : Type*) (M : Type*) [has_zero M] :=
(support            : finset α)
(to_fun             : α → M)
(mem_support_to_fun : ∀a, a ∈ support ↔ to_fun a ≠ 0)

infixr ` →₀ `:25 := finsupp

namespace finsupp

/-! ### Basic declarations about `finsupp` -/

section basic
variable [has_zero M]

instance fun_like : fun_like (α →₀ M) α (λ _, M) := ⟨to_fun, begin
  rintro ⟨s, f, hf⟩ ⟨t, g, hg⟩ (rfl : f = g),
  congr',
  ext a,
  exact (hf _).trans (hg _).symm,
end⟩

/-- Helper instance for when there are too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (α →₀ M) (λ _, α → M) := fun_like.has_coe_to_fun

@[ext] lemma ext {f g : α →₀ M} (h : ∀ a, f a = g a) : f = g := fun_like.ext _ _ h
/-- Deprecated. Use `fun_like.ext_iff` instead. -/
lemma ext_iff {f g : α →₀ M} : f = g ↔ ∀ a, f a = g a := fun_like.ext_iff
/-- Deprecated. Use `fun_like.coe_fn_eq` instead. -/
lemma coe_fn_inj {f g : α →₀ M} : (f : α → M) = g ↔ f = g := fun_like.coe_fn_eq
/-- Deprecated. Use `fun_like.coe_injective` instead. -/
lemma coe_fn_injective : @function.injective (α →₀ M) (α → M) coe_fn := fun_like.coe_injective
/-- Deprecated. Use `fun_like.congr_fun` instead. -/
lemma congr_fun {f g : α →₀ M} (h : f = g) (a : α) : f a = g a := fun_like.congr_fun h _

@[simp] lemma coe_mk (f : α → M) (s : finset α) (h : ∀ a, a ∈ s ↔ f a ≠ 0) :
  ⇑(⟨s, f, h⟩ : α →₀ M) = f := rfl

instance : has_zero (α →₀ M) := ⟨⟨∅, 0, λ _, ⟨false.elim, λ H, H rfl⟩⟩⟩

@[simp] lemma coe_zero : ⇑(0 : α →₀ M) = 0 := rfl
lemma zero_apply {a : α} : (0 : α →₀ M) a = 0 := rfl
@[simp] lemma support_zero : (0 : α →₀ M).support = ∅ := rfl

instance : inhabited (α →₀ M) := ⟨0⟩

@[simp] lemma mem_support_iff {f : α →₀ M} : ∀{a:α}, a ∈ f.support ↔ f a ≠ 0 :=
f.mem_support_to_fun

@[simp, norm_cast] lemma fun_support_eq (f : α →₀ M) : function.support f = f.support :=
set.ext $ λ x, mem_support_iff.symm

lemma not_mem_support_iff {f : α →₀ M} {a} : a ∉ f.support ↔ f a = 0 :=
not_iff_comm.1 mem_support_iff.symm

@[simp, norm_cast] lemma coe_eq_zero {f : α →₀ M} : (f : α → M) = 0 ↔ f = 0 :=
by rw [← coe_zero, coe_fn_inj]

lemma ext_iff' {f g : α →₀ M} : f = g ↔ f.support = g.support ∧ ∀ x ∈ f.support, f x = g x :=
⟨λ h, h ▸ ⟨rfl, λ _ _, rfl⟩, λ ⟨h₁, h₂⟩, ext $ λ a,
  by classical; exact if h : a ∈ f.support then h₂ a h else
    have hf : f a = 0, from not_mem_support_iff.1 h,
    have hg : g a = 0, by rwa [h₁, not_mem_support_iff] at h,
    by rw [hf, hg]⟩

@[simp] lemma support_eq_empty {f : α →₀ M} : f.support = ∅ ↔ f = 0 :=
by exact_mod_cast @function.support_eq_empty_iff _ _ _ f

lemma support_nonempty_iff {f : α →₀ M} : f.support.nonempty ↔ f ≠ 0 :=
by simp only [finsupp.support_eq_empty, finset.nonempty_iff_ne_empty, ne.def]

lemma nonzero_iff_exists {f : α →₀ M} : f ≠ 0 ↔ ∃ a : α, f a ≠ 0 :=
by simp [← finsupp.support_eq_empty, finset.eq_empty_iff_forall_not_mem]

lemma card_support_eq_zero {f : α →₀ M} : card f.support = 0 ↔ f = 0 :=
by simp

instance [decidable_eq α] [decidable_eq M] : decidable_eq (α →₀ M) :=
assume f g, decidable_of_iff (f.support = g.support ∧ (∀a∈f.support, f a = g a)) ext_iff'.symm

lemma finite_support (f : α →₀ M) : set.finite (function.support f) :=
f.fun_support_eq.symm ▸ f.support.finite_to_set

lemma support_subset_iff {s : set α} {f : α →₀ M} :
  ↑f.support ⊆ s ↔ (∀a∉s, f a = 0) :=
by simp only [set.subset_def, mem_coe, mem_support_iff];
   exact forall_congr (assume a, not_imp_comm)

/-- Given `finite α`, `equiv_fun_on_finite` is the `equiv` between `α →₀ β` and `α → β`.
  (All functions on a finite type are finitely supported.) -/
@[simps] def equiv_fun_on_finite [finite α] : (α →₀ M) ≃ (α → M) :=
{ to_fun := coe_fn,
  inv_fun := λ f, mk (function.support f).to_finite.to_finset f (λ a, set.finite.mem_to_finset _),
  left_inv := λ f, ext $ λ x, rfl,
  right_inv := λ f, rfl }

@[simp] lemma equiv_fun_on_finite_symm_coe {α} [finite α] (f : α →₀ M) :
  equiv_fun_on_finite.symm f = f :=
equiv_fun_on_finite.symm_apply_apply f

/--
If `α` has a unique term, the type of finitely supported functions `α →₀ β` is equivalent to `β`.
-/
@[simps] noncomputable
def _root_.equiv.finsupp_unique {ι : Type*} [unique ι] : (ι →₀ M) ≃ M :=
finsupp.equiv_fun_on_finite.trans (equiv.fun_unique ι M)

@[ext]
lemma unique_ext [unique α] {f g : α →₀ M} (h : f default = g default) : f = g :=
ext $ λ a, by rwa [unique.eq_default a]

lemma unique_ext_iff [unique α] {f g : α →₀ M} : f = g ↔ f default = g default :=
⟨λ h, h ▸ rfl, unique_ext⟩

end basic

/-! ### Declarations about `single` -/

section single
variables [has_zero M] {a a' : α} {b : M}

/-- `single a b` is the finitely supported function with value `b` at `a` and zero otherwise. -/
def single (a : α) (b : M) : α →₀ M :=
{ support := by haveI := classical.dec_eq M; exact if b = 0 then ∅ else {a},
  to_fun := by haveI := classical.dec_eq α; exact pi.single a b,
  mem_support_to_fun := λ a', begin
    classical,
    obtain rfl | hb := eq_or_ne b 0,
    { simp },
    rw [if_neg hb, mem_singleton],
    obtain rfl | ha := eq_or_ne a' a,
    { simp [hb] },
    simp [pi.single_eq_of_ne', ha],
  end }

lemma single_apply [decidable (a = a')] : single a b a' = if a = a' then b else 0 :=
by { classical, simp_rw [@eq_comm _ a a'], convert pi.single_apply _ _ _, }

lemma single_apply_left {f : α → β} (hf : function.injective f)
  (x z : α) (y : M) :
  single (f x) y (f z) = single x y z :=
by { classical, simp only [single_apply, hf.eq_iff] }

lemma single_eq_set_indicator : ⇑(single a b) = set.indicator {a} (λ _, b) :=
by { classical, ext, simp [single_apply, set.indicator, @eq_comm _ a] }

@[simp] lemma single_eq_same : (single a b : α →₀ M) a = b :=
by { classical, exact pi.single_eq_same a b }

@[simp] lemma single_eq_of_ne (h : a ≠ a') : (single a b : α →₀ M) a' = 0 :=
by { classical, exact pi.single_eq_of_ne' h _ }

lemma single_eq_update [decidable_eq α] (a : α) (b : M) : ⇑(single a b) = function.update 0 a b :=
by rw [single_eq_set_indicator, ← set.piecewise_eq_indicator, set.piecewise_singleton]

lemma single_eq_pi_single [decidable_eq α] (a : α) (b : M) : ⇑(single a b) = pi.single a b :=
single_eq_update a b

@[simp] lemma single_zero (a : α) : (single a 0 : α →₀ M) = 0 :=
coe_fn_injective $ begin
  classical,
  simpa only [single_eq_update, coe_zero] using function.update_eq_self a (0 : α → M)
end

lemma single_of_single_apply (a a' : α) (b : M) :
  single a ((single a' b) a) = single a' (single a' b) a :=
begin
  classical,
  rw [single_apply, single_apply],
  ext,
  split_ifs,
  { rw h, },
  { rw [zero_apply, single_apply, if_t_t], },
end

lemma support_single_ne_zero (a : α) (hb : b ≠ 0) : (single a b).support = {a} :=
by { classical, exact if_neg hb }

lemma support_single_subset : (single a b).support ⊆ {a} :=
by { classical, show ite _ _ _ ⊆ _, split_ifs; [exact empty_subset _, exact subset.refl _] }

lemma single_apply_mem (x) : single a b x ∈ ({0, b} : set M) :=
by rcases em (a = x) with (rfl|hx); [simp, simp [single_eq_of_ne hx]]

lemma range_single_subset : set.range (single a b) ⊆ {0, b} :=
set.range_subset_iff.2 single_apply_mem

/-- `finsupp.single a b` is injective in `b`. For the statement that it is injective in `a`, see
`finsupp.single_left_injective` -/
lemma single_injective (a : α) : function.injective (single a : M → α →₀ M) :=
assume b₁ b₂ eq,
have (single a b₁ : α →₀ M) a = (single a b₂ : α →₀ M) a, by rw eq,
by rwa [single_eq_same, single_eq_same] at this

lemma single_apply_eq_zero {a x : α} {b : M} : single a b x = 0 ↔ (x = a → b = 0) :=
by simp [single_eq_set_indicator]

lemma single_apply_ne_zero {a x : α} {b : M} : single a b x ≠ 0 ↔ (x = a ∧ b ≠ 0) :=
by simp [single_apply_eq_zero]

lemma mem_support_single (a a' : α) (b : M) :
  a ∈ (single a' b).support ↔ a = a' ∧ b ≠ 0 :=
by simp [single_apply_eq_zero, not_or_distrib]

lemma eq_single_iff {f : α →₀ M} {a b} : f = single a b ↔ f.support ⊆ {a} ∧ f a = b :=
begin
  refine ⟨λ h, h.symm ▸ ⟨support_single_subset, single_eq_same⟩, _⟩,
  rintro ⟨h, rfl⟩,
  ext x,
  by_cases hx : a = x; simp only [hx, single_eq_same, single_eq_of_ne, ne.def, not_false_iff],
  exact not_mem_support_iff.1 (mt (λ hx, (mem_singleton.1 (h hx)).symm) hx)
end

lemma single_eq_single_iff (a₁ a₂ : α) (b₁ b₂ : M) :
  single a₁ b₁ = single a₂ b₂ ↔ ((a₁ = a₂ ∧ b₁ = b₂) ∨ (b₁ = 0 ∧ b₂ = 0)) :=
begin
  split,
  { assume eq,
    by_cases a₁ = a₂,
    { refine or.inl ⟨h, _⟩,
      rwa [h, (single_injective a₂).eq_iff] at eq },
    { rw [ext_iff] at eq,
      have h₁ := eq a₁,
      have h₂ := eq a₂,
      simp only [single_eq_same, single_eq_of_ne h, single_eq_of_ne (ne.symm h)] at h₁ h₂,
      exact or.inr ⟨h₁, h₂.symm⟩ } },
  { rintros (⟨rfl, rfl⟩ | ⟨rfl, rfl⟩),
    { refl },
    { rw [single_zero, single_zero] } }
end

/-- `finsupp.single a b` is injective in `a`. For the statement that it is injective in `b`, see
`finsupp.single_injective` -/
lemma single_left_injective (h : b ≠ 0) : function.injective (λ a : α, single a b) :=
λ a a' H, (((single_eq_single_iff _ _ _ _).mp H).resolve_right $ λ hb, h hb.1).left

lemma single_left_inj (h : b ≠ 0) : single a b = single a' b ↔ a = a' :=
(single_left_injective h).eq_iff

lemma support_single_ne_bot (i : α) (h : b ≠ 0) :
  (single i b).support ≠ ⊥ :=
by simpa only [support_single_ne_zero _ h] using singleton_ne_empty _

lemma support_single_disjoint {b' : M} (hb : b ≠ 0) (hb' : b' ≠ 0) {i j : α} :
  disjoint (single i b).support (single j b').support ↔ i ≠ j :=
by rw [support_single_ne_zero _ hb, support_single_ne_zero _ hb', disjoint_singleton]

@[simp] lemma single_eq_zero : single a b = 0 ↔ b = 0 :=
by simp [ext_iff, single_eq_set_indicator]

lemma single_swap (a₁ a₂ : α) (b : M) : single a₁ b a₂ = single a₂ b a₁ :=
by { classical, simp only [single_apply], ac_refl }

instance [nonempty α] [nontrivial M] : nontrivial (α →₀ M) :=
begin
  inhabit α,
  rcases exists_ne (0 : M) with ⟨x, hx⟩,
  exact nontrivial_of_ne (single default x) 0 (mt single_eq_zero.1 hx)
end

lemma unique_single [unique α] (x : α →₀ M) : x = single default (x default) :=
ext $ unique.forall_iff.2 single_eq_same.symm

@[simp] lemma unique_single_eq_iff [unique α] {b' : M} :
  single a b = single a' b' ↔ b = b' :=
by rw [unique_ext_iff, unique.eq_default a, unique.eq_default a', single_eq_same, single_eq_same]

lemma support_eq_singleton {f : α →₀ M} {a : α} :
  f.support = {a} ↔ f a ≠ 0 ∧ f = single a (f a) :=
⟨λ h, ⟨mem_support_iff.1 $ h.symm ▸ finset.mem_singleton_self a,
  eq_single_iff.2 ⟨subset_of_eq h, rfl⟩⟩, λ h, h.2.symm ▸ support_single_ne_zero _ h.1⟩

lemma support_eq_singleton' {f : α →₀ M} {a : α} :
  f.support = {a} ↔ ∃ b ≠ 0, f = single a b :=
⟨λ h, let h := support_eq_singleton.1 h in ⟨_, h.1, h.2⟩,
  λ ⟨b, hb, hf⟩, hf.symm ▸ support_single_ne_zero _ hb⟩

lemma card_support_eq_one {f : α →₀ M} : card f.support = 1 ↔ ∃ a, f a ≠ 0 ∧ f = single a (f a) :=
by simp only [card_eq_one, support_eq_singleton]

lemma card_support_eq_one' {f : α →₀ M} : card f.support = 1 ↔ ∃ a (b ≠ 0), f = single a b :=
by simp only [card_eq_one, support_eq_singleton']

lemma support_subset_singleton {f : α →₀ M} {a : α} :
  f.support ⊆ {a} ↔ f = single a (f a) :=
⟨λ h, eq_single_iff.mpr ⟨h, rfl⟩, λ h, (eq_single_iff.mp h).left⟩

lemma support_subset_singleton' {f : α →₀ M} {a : α} :
  f.support ⊆ {a} ↔ ∃ b, f = single a b :=
⟨λ h, ⟨f a, support_subset_singleton.mp h⟩,
  λ ⟨b, hb⟩, by rw [hb, support_subset_singleton, single_eq_same]⟩

lemma card_support_le_one [nonempty α] {f : α →₀ M} :
  card f.support ≤ 1 ↔ ∃ a, f = single a (f a) :=
by simp only [card_le_one_iff_subset_singleton, support_subset_singleton]

lemma card_support_le_one' [nonempty α] {f : α →₀ M} :
  card f.support ≤ 1 ↔ ∃ a b, f = single a b :=
by simp only [card_le_one_iff_subset_singleton, support_subset_singleton']

@[simp] lemma equiv_fun_on_finite_single [decidable_eq α] [finite α] (x : α) (m : M) :
  finsupp.equiv_fun_on_finite (finsupp.single x m) = pi.single x m :=
by { ext, simp [finsupp.single_eq_pi_single], }

@[simp] lemma equiv_fun_on_finite_symm_single [decidable_eq α] [finite α] (x : α) (m : M) :
  finsupp.equiv_fun_on_finite.symm (pi.single x m) = finsupp.single x m :=
by rw [← equiv_fun_on_finite_single, equiv.symm_apply_apply]

end single

/-! ### Declarations about `update` -/

section update

variables [has_zero M] (f : α →₀ M) (a : α) (b : M) (i : α)

/-- Replace the value of a `α →₀ M` at a given point `a : α` by a given value `b : M`.
If `b = 0`, this amounts to removing `a` from the `finsupp.support`.
Otherwise, if `a` was not in the `finsupp.support`, it is added to it.

This is the finitely-supported version of `function.update`. -/
def update (f : α →₀ M) (a : α) (b : M) : α →₀ M :=
{ support := by haveI := classical.dec_eq α; haveI := classical.dec_eq M; exact
    if b = 0 then f.support.erase a else insert a f.support,
  to_fun := by haveI := classical.dec_eq α; exact
    function.update f a b,
  mem_support_to_fun := λ i, begin
    simp only [function.update_apply, ne.def],
    split_ifs with hb ha ha hb;
    simp [ha, hb]
  end }

@[simp] lemma coe_update [decidable_eq α] : (f.update a b : α → M) = function.update f a b :=
by convert rfl

@[simp] lemma update_self : f.update a (f a) = f :=
by { classical, ext, simp }

@[simp] lemma zero_update : update 0 a b = single a b :=
by { classical, ext, rw single_eq_update, refl }

lemma support_update [decidable_eq α] [decidable_eq M] :
  support (f.update a b) = if b = 0 then f.support.erase a else insert a f.support :=
by convert rfl

@[simp] lemma support_update_zero [decidable_eq α] :
  support (f.update a 0) = f.support.erase a := by convert if_pos rfl

variables {b}

lemma support_update_ne_zero [decidable_eq α] (h : b ≠ 0) :
  support (f.update a b) = insert a f.support := by { classical, convert if_neg h }

end update

/-! ### Declarations about `erase` -/

section erase

variables [has_zero M]

/--
`erase a f` is the finitely supported function equal to `f` except at `a` where it is equal to `0`.
If `a` is not in the support of `f` then `erase a f = f`.
-/
def erase (a : α) (f : α →₀ M) : α →₀ M :=
{ support := by haveI := classical.dec_eq α; exact f.support.erase a,
  to_fun := λ a', by haveI := classical.dec_eq α; exact if a' = a then 0 else f a',
  mem_support_to_fun := assume a', by rw [mem_erase, mem_support_iff]; split_ifs;
    [exact ⟨λ H _, H.1 h, λ H, (H rfl).elim⟩,
    exact and_iff_right h] }

@[simp] lemma support_erase [decidable_eq α] {a : α} {f : α →₀ M} :
  (f.erase a).support = f.support.erase a :=
by convert rfl

@[simp] lemma erase_same {a : α} {f : α →₀ M} : (f.erase a) a = 0 :=
by convert if_pos rfl

@[simp] lemma erase_ne {a a' : α} {f : α →₀ M} (h : a' ≠ a) : (f.erase a) a' = f a' :=
by { classical, convert if_neg h }

@[simp] lemma erase_single {a : α} {b : M} : (erase a (single a b)) = 0 :=
begin
  ext s, by_cases hs : s = a,
  { rw [hs, erase_same], refl },
  { rw [erase_ne hs], exact single_eq_of_ne (ne.symm hs) }
end

lemma erase_single_ne {a a' : α} {b : M} (h : a ≠ a') : (erase a (single a' b)) = single a' b :=
begin
  ext s, by_cases hs : s = a,
  { rw [hs, erase_same, single_eq_of_ne (h.symm)] },
  { rw [erase_ne hs] }
end

@[simp] lemma erase_of_not_mem_support {f : α →₀ M} {a} (haf : a ∉ f.support) : erase a f = f :=
begin
  ext b, by_cases hab : b = a,
  { rwa [hab, erase_same, eq_comm, ←not_mem_support_iff] },
  { rw erase_ne hab }
end

@[simp] lemma erase_zero (a : α) : erase a (0 : α →₀ M) = 0 :=
by { classical, rw [← support_eq_empty, support_erase, support_zero, erase_empty] }

end erase

/-! ### Declarations about `on_finset` -/

section on_finset
variables [has_zero M]

/-- `on_finset s f hf` is the finsupp function representing `f` restricted to the finset `s`.
The function must be `0` outside of `s`. Use this when the set needs to be filtered anyways,
otherwise a better set representation is often available. -/
def on_finset (s : finset α) (f : α → M) (hf : ∀a, f a ≠ 0 → a ∈ s) : α →₀ M :=
{ support := by haveI := classical.dec_eq M; exact s.filter (λa, f a ≠ 0),
  to_fun := f,
  mem_support_to_fun := by simpa }

@[simp] lemma on_finset_apply {s : finset α} {f : α → M} {hf a} :
  (on_finset s f hf : α →₀ M) a = f a :=
rfl

@[simp] lemma support_on_finset_subset {s : finset α} {f : α → M} {hf} :
  (on_finset s f hf).support ⊆ s :=
by convert filter_subset _ _

@[simp] lemma mem_support_on_finset
  {s : finset α} {f : α → M} (hf : ∀ (a : α), f a ≠ 0 → a ∈ s) {a : α} :
  a ∈ (finsupp.on_finset s f hf).support ↔ f a ≠ 0 :=
by rw [finsupp.mem_support_iff, finsupp.on_finset_apply]

lemma support_on_finset [decidable_eq M]
  {s : finset α} {f : α → M} (hf : ∀ (a : α), f a ≠ 0 → a ∈ s) :
  (finsupp.on_finset s f hf).support = s.filter (λ a, f a ≠ 0) :=
by convert rfl

end on_finset

section of_support_finite

variables [has_zero M]

/-- The natural `finsupp` induced by the function `f` given that it has finite support. -/
noncomputable def of_support_finite
  (f : α → M) (hf : (function.support f).finite) : α →₀ M :=
{ support := hf.to_finset,
  to_fun := f,
  mem_support_to_fun := λ _, hf.mem_to_finset }

lemma of_support_finite_coe {f : α → M} {hf : (function.support f).finite} :
  (of_support_finite f hf : α → M) = f := rfl

instance can_lift : can_lift (α → M) (α →₀ M) coe_fn (λ f, (function.support f).finite) :=
{ prf := λ f hf, ⟨of_support_finite f hf, rfl⟩ }

end of_support_finite

/-! ### Declarations about `map_range` -/

section map_range
variables [has_zero M] [has_zero N] [has_zero P]

/-- The composition of `f : M → N` and `g : α →₀ M` is `map_range f hf g : α →₀ N`,
which is well-defined when `f 0 = 0`.

This preserves the structure on `f`, and exists in various bundled forms for when `f` is itself
bundled (defined in `data/finsupp/basic`):

* `finsupp.map_range.equiv`
* `finsupp.map_range.zero_hom`
* `finsupp.map_range.add_monoid_hom`
* `finsupp.map_range.add_equiv`
* `finsupp.map_range.linear_map`
* `finsupp.map_range.linear_equiv`
-/
def map_range (f : M → N) (hf : f 0 = 0) (g : α →₀ M) : α →₀ N :=
on_finset g.support (f ∘ g) $
  assume a, by rw [mem_support_iff, not_imp_not]; exact λ H, (congr_arg f H).trans hf

@[simp] lemma map_range_apply {f : M → N} {hf : f 0 = 0} {g : α →₀ M} {a : α} :
  map_range f hf g a = f (g a) :=
rfl

@[simp] lemma map_range_zero {f : M → N} {hf : f 0 = 0} : map_range f hf (0 : α →₀ M) = 0 :=
ext $ λ a, by simp only [hf, zero_apply, map_range_apply]

@[simp] lemma map_range_id (g : α →₀ M) : map_range id rfl g = g :=
ext $ λ _, rfl

lemma map_range_comp
  (f : N → P) (hf : f 0 = 0) (f₂ : M → N) (hf₂ : f₂ 0 = 0) (h : (f ∘ f₂) 0 = 0) (g : α →₀ M) :
  map_range (f ∘ f₂) h g = map_range f hf (map_range f₂ hf₂ g) :=
ext $ λ _, rfl

lemma support_map_range {f : M → N} {hf : f 0 = 0} {g : α →₀ M} :
  (map_range f hf g).support ⊆ g.support :=
support_on_finset_subset

@[simp] lemma map_range_single {f : M → N} {hf : f 0 = 0} {a : α} {b : M} :
  map_range f hf (single a b) = single a (f b) :=
ext $ λ a', begin
  classical,
  simpa only [single_eq_pi_single] using pi.apply_single _ (λ _, hf) a _ a'
end

lemma support_map_range_of_injective
  {e : M → N} (he0 : e 0 = 0) (f : ι →₀ M) (he : function.injective e) :
  (finsupp.map_range e he0 f).support = f.support :=
begin
  ext,
  simp only [finsupp.mem_support_iff, ne.def, finsupp.map_range_apply],
  exact he.ne_iff' he0,
end

end map_range

/-! ### Declarations about `emb_domain` -/

section emb_domain
variables [has_zero M] [has_zero N]

/-- Given `f : α ↪ β` and `v : α →₀ M`, `emb_domain f v : β →₀ M`
is the finitely supported function whose value at `f a : β` is `v a`.
For a `b : β` outside the range of `f`, it is zero. -/
def emb_domain (f : α ↪ β) (v : α →₀ M) : β →₀ M :=
{ support := v.support.map f,
  to_fun := λ a₂,
    by haveI := classical.dec_eq β; exact
    if h : a₂ ∈ v.support.map f
      then v (v.support.choose (λa₁, f a₁ = a₂) begin
        rcases finset.mem_map.1 h with ⟨a, ha, rfl⟩,
        exact exists_unique.intro a ⟨ha, rfl⟩ (assume b ⟨_, hb⟩, f.injective hb)
      end)
      else 0,
  mem_support_to_fun := λ a₂, begin
    split_ifs,
    { simp only [h, true_iff, ne.def],
      rw [← not_mem_support_iff, not_not],
      apply finset.choose_mem },
    { simp only [h, ne.def, ne_self_iff_false] }
  end }

@[simp] lemma support_emb_domain (f : α ↪ β) (v : α →₀ M) :
  (emb_domain f v).support = v.support.map f :=
rfl

@[simp] lemma emb_domain_zero (f : α ↪ β) : (emb_domain f 0 : β →₀ M) = 0 :=
rfl

@[simp] lemma emb_domain_apply (f : α ↪ β) (v : α →₀ M) (a : α) :
  emb_domain f v (f a) = v a :=
begin
  classical,
  change dite _ _ _ = _,
  split_ifs; rw [finset.mem_map' f] at h,
  { refine congr_arg (v : α → M) (f.inj' _),
    exact finset.choose_property (λa₁, f a₁ = f a) _ _ },
  { exact (not_mem_support_iff.1 h).symm }
end

lemma emb_domain_notin_range (f : α ↪ β) (v : α →₀ M) (a : β) (h : a ∉ set.range f) :
  emb_domain f v a = 0 :=
begin
  classical,
  refine dif_neg (mt (assume h, _) h),
  rcases finset.mem_map.1 h with ⟨a, h, rfl⟩,
  exact set.mem_range_self a
end

lemma emb_domain_injective (f : α ↪ β) :
  function.injective (emb_domain f : (α →₀ M) → (β →₀ M)) :=
λ l₁ l₂ h, ext $ λ a, by simpa only [emb_domain_apply] using ext_iff.1 h (f a)

@[simp] lemma emb_domain_inj {f : α ↪ β} {l₁ l₂ : α →₀ M} :
  emb_domain f l₁ = emb_domain f l₂ ↔ l₁ = l₂ :=
(emb_domain_injective f).eq_iff

@[simp] lemma emb_domain_eq_zero {f : α ↪ β} {l : α →₀ M} :
  emb_domain f l = 0 ↔ l = 0 :=
(emb_domain_injective f).eq_iff' $ emb_domain_zero f

lemma emb_domain_map_range
  (f : α ↪ β) (g : M → N) (p : α →₀ M) (hg : g 0 = 0) :
  emb_domain f (map_range g hg p) = map_range g hg (emb_domain f p) :=
begin
  ext a,
  by_cases a ∈ set.range f,
  { rcases h with ⟨a', rfl⟩,
    rw [map_range_apply, emb_domain_apply, emb_domain_apply, map_range_apply] },
  { rw [map_range_apply, emb_domain_notin_range, emb_domain_notin_range, ← hg]; assumption }
end

lemma single_of_emb_domain_single
  (l : α →₀ M) (f : α ↪ β) (a : β) (b : M) (hb : b ≠ 0)
  (h : l.emb_domain f = single a b) :
  ∃ x, l = single x b ∧ f x = a :=
begin
  classical,
  have h_map_support : finset.map f (l.support) = {a},
    by rw [←support_emb_domain, h, support_single_ne_zero _ hb]; refl,
  have ha : a ∈ finset.map f (l.support),
    by simp only [h_map_support, finset.mem_singleton],
  rcases finset.mem_map.1 ha with ⟨c, hc₁, hc₂⟩,
  use c,
  split,
  { ext d,
    rw [← emb_domain_apply f l, h],
    by_cases h_cases : c = d,
    { simp only [eq.symm h_cases, hc₂, single_eq_same] },
    { rw [single_apply, single_apply, if_neg, if_neg h_cases],
      by_contra hfd,
      exact h_cases (f.injective (hc₂.trans hfd)) } },
  { exact hc₂ }
end

@[simp] lemma emb_domain_single (f : α ↪ β) (a : α) (m : M) :
  emb_domain f (single a m) = single (f a) m :=
begin
  classical,
  ext b,
  by_cases h : b ∈ set.range f,
  { rcases h with ⟨a', rfl⟩,
    simp [single_apply], },
  { simp only [emb_domain_notin_range, h, single_apply, not_false_iff],
    rw if_neg,
    rintro rfl,
    simpa using h, },
end

end emb_domain

/-! ### Declarations about `zip_with` -/

section zip_with
variables [has_zero M] [has_zero N] [has_zero P]

/-- Given finitely supported functions `g₁ : α →₀ M` and `g₂ : α →₀ N` and function `f : M → N → P`,
`zip_with f hf g₁ g₂` is the finitely supported function `α →₀ P` satisfying
`zip_with f hf g₁ g₂ a = f (g₁ a) (g₂ a)`, which is well-defined when `f 0 0 = 0`. -/
def zip_with (f : M → N → P) (hf : f 0 0 = 0) (g₁ : α →₀ M) (g₂ : α →₀ N) : α →₀ P :=
on_finset
  (by haveI := classical.dec_eq α; exact g₁.support ∪ g₂.support)
  (λa, f (g₁ a) (g₂ a)) $ λ a H,
  begin
    simp only [mem_union, mem_support_iff, ne], rw [← not_and_distrib],
    rintro ⟨h₁, h₂⟩, rw [h₁, h₂] at H, exact H hf
  end

@[simp] lemma zip_with_apply
  {f : M → N → P} {hf : f 0 0 = 0} {g₁ : α →₀ M} {g₂ : α →₀ N} {a : α} :
  zip_with f hf g₁ g₂ a = f (g₁ a) (g₂ a) :=
rfl

lemma support_zip_with [D : decidable_eq α] {f : M → N → P} {hf : f 0 0 = 0}
  {g₁ : α →₀ M} {g₂ : α →₀ N} : (zip_with f hf g₁ g₂).support ⊆ g₁.support ∪ g₂.support :=
by rw subsingleton.elim D; exact support_on_finset_subset

end zip_with

/-! ### Additive monoid structure on `α →₀ M` -/

section add_zero_class

variables [add_zero_class M]

instance : has_add (α →₀ M) := ⟨zip_with (+) (add_zero 0)⟩

@[simp] lemma coe_add (f g : α →₀ M) : ⇑(f + g) = f + g := rfl
lemma add_apply (g₁ g₂ : α →₀ M) (a : α) : (g₁ + g₂) a = g₁ a + g₂ a := rfl

lemma support_add [decidable_eq α] {g₁ g₂ : α →₀ M} :
  (g₁ + g₂).support ⊆ g₁.support ∪ g₂.support :=
support_zip_with

lemma support_add_eq [decidable_eq α] {g₁ g₂ : α →₀ M} (h : disjoint g₁.support g₂.support) :
  (g₁ + g₂).support = g₁.support ∪ g₂.support :=
le_antisymm support_zip_with $ assume a ha,
(finset.mem_union.1 ha).elim
  (assume ha, have a ∉ g₂.support, from disjoint_left.1 h ha,
    by simp only [mem_support_iff, not_not] at *;
    simpa only [add_apply, this, add_zero])
  (assume ha, have a ∉ g₁.support, from disjoint_right.1 h ha,
    by simp only [mem_support_iff, not_not] at *;
    simpa only [add_apply, this, zero_add])

@[simp] lemma single_add (a : α) (b₁ b₂ : M) : single a (b₁ + b₂) = single a b₁ + single a b₂ :=
ext $ assume a',
begin
  by_cases h : a = a',
  { rw [h, add_apply, single_eq_same, single_eq_same, single_eq_same] },
  { rw [add_apply, single_eq_of_ne h, single_eq_of_ne h, single_eq_of_ne h, zero_add] }
end

instance : add_zero_class (α →₀ M) :=
fun_like.coe_injective.add_zero_class _ coe_zero coe_add

/-- `finsupp.single` as an `add_monoid_hom`.

See `finsupp.lsingle` in `linear_algebra/finsupp` for the stronger version as a linear map. -/
@[simps] def single_add_hom (a : α) : M →+ α →₀ M :=
⟨single a, single_zero a, single_add a⟩

/-- Evaluation of a function `f : α →₀ M` at a point as an additive monoid homomorphism.

See `finsupp.lapply` in `linear_algebra/finsupp` for the stronger version as a linear map. -/
@[simps apply]
def apply_add_hom (a : α) : (α →₀ M) →+ M := ⟨λ g, g a, zero_apply, λ _ _, add_apply _ _ _⟩

/-- Coercion from a `finsupp` to a function type is an `add_monoid_hom`. -/
@[simps]
noncomputable def coe_fn_add_hom : (α →₀ M) →+ (α → M) :=
{ to_fun := coe_fn,
  map_zero' := coe_zero,
  map_add' := coe_add }

lemma update_eq_single_add_erase (f : α →₀ M) (a : α) (b : M) :
  f.update a b = single a b + f.erase a :=
begin
  classical,
  ext j,
  rcases eq_or_ne a j with rfl|h,
  { simp },
  { simp [function.update_noteq h.symm, single_apply, h, erase_ne, h.symm] }
end

lemma update_eq_erase_add_single (f : α →₀ M) (a : α) (b : M) :
  f.update a b = f.erase a + single a b :=
begin
  classical,
  ext j,
  rcases eq_or_ne a j with rfl|h,
  { simp },
  { simp [function.update_noteq h.symm, single_apply, h, erase_ne, h.symm] }
end

lemma single_add_erase (a : α) (f : α →₀ M) : single a (f a) + f.erase a = f :=
by rw [←update_eq_single_add_erase, update_self]

lemma erase_add_single (a : α) (f : α →₀ M) : f.erase a + single a (f a) = f :=
by rw [←update_eq_erase_add_single, update_self]

@[simp] lemma erase_add (a : α) (f f' : α →₀ M) : erase a (f + f') = erase a f + erase a f' :=
begin
  ext s, by_cases hs : s = a,
  { rw [hs, add_apply, erase_same, erase_same, erase_same, add_zero] },
  rw [add_apply, erase_ne hs, erase_ne hs, erase_ne hs, add_apply],
end

/-- `finsupp.erase` as an `add_monoid_hom`. -/
@[simps]
def erase_add_hom (a : α) : (α →₀ M) →+ (α →₀ M) :=
{ to_fun := erase a, map_zero' := erase_zero a, map_add' := erase_add a }

@[elab_as_eliminator]
protected theorem induction {p : (α →₀ M) → Prop} (f : α →₀ M)
  (h0 : p 0) (ha : ∀a b (f : α →₀ M), a ∉ f.support → b ≠ 0 → p f → p (single a b + f)) :
  p f :=
suffices ∀s (f : α →₀ M), f.support = s → p f, from this _ _ rfl,
assume s, finset.cons_induction_on s (λ f hf, by rwa [support_eq_empty.1 hf]) $
assume a s has ih f hf,
suffices p (single a (f a) + f.erase a), by rwa [single_add_erase] at this,
begin
  classical,
  apply ha,
  { rw [support_erase, mem_erase], exact λ H, H.1 rfl },
  { rw [← mem_support_iff, hf], exact mem_cons_self _ _ },
  { apply ih _ _,
    rw [support_erase, hf, finset.erase_cons] }
end

lemma induction₂ {p : (α →₀ M) → Prop} (f : α →₀ M)
  (h0 : p 0) (ha : ∀a b (f : α →₀ M), a ∉ f.support → b ≠ 0 → p f → p (f + single a b)) :
  p f :=
suffices ∀s (f : α →₀ M), f.support = s → p f, from this _ _ rfl,
assume s, finset.cons_induction_on s (λ f hf, by rwa [support_eq_empty.1 hf]) $
assume a s has ih f hf,
suffices p (f.erase a + single a (f a)), by rwa [erase_add_single] at this,
begin
  classical,
  apply ha,
  { rw [support_erase, mem_erase], exact λ H, H.1 rfl },
  { rw [← mem_support_iff, hf],
    exact mem_cons_self _ _ },
  { apply ih _ _,
    rw [support_erase, hf, finset.erase_cons] }
end

lemma induction_linear {p : (α →₀ M) → Prop} (f : α →₀ M)
  (h0 : p 0) (hadd : ∀ f g : α →₀ M, p f → p g → p (f + g)) (hsingle : ∀ a b, p (single a b)) :
  p f :=
induction₂ f h0 (λ a b f _ _ w, hadd _ _ w (hsingle _ _))

@[simp]

/-- If two additive homomorphisms from `α →₀ M` are equal on each `single a b`,
then they are equal. -/
lemma add_hom_ext [add_zero_class N] ⦃f g : (α →₀ M) →+ N⦄
  (H : ∀ x y, f (single x y) = g (single x y)) :
  f = g :=
begin
  refine add_monoid_hom.eq_of_eq_on_mdense add_closure_set_of_eq_single _,
  rintro _ ⟨x, y, rfl⟩,
  apply H
end

/-- If two additive homomorphisms from `α →₀ M` are equal on each `single a b`,
then they are equal.

We formulate this using equality of `add_monoid_hom`s so that `ext` tactic can apply a type-specific
extensionality lemma after this one.  E.g., if the fiber `M` is `ℕ` or `ℤ`, then it suffices to
verify `f (single a 1) = g (single a 1)`. -/
@[ext] lemma add_hom_ext' [add_zero_class N] ⦃f g : (α →₀ M) →+ N⦄
  (H : ∀ x, f.comp (single_add_hom x) = g.comp (single_add_hom x)) :
  f = g :=
add_hom_ext $ λ x, add_monoid_hom.congr_fun (H x)

lemma mul_hom_ext [mul_one_class N] ⦃f g : multiplicative (α →₀ M) →* N⦄
  (H : ∀ x y, f (multiplicative.of_add $ single x y) = g (multiplicative.of_add $ single x y)) :
  f = g :=
monoid_hom.ext $ add_monoid_hom.congr_fun $
  @add_hom_ext α M (additive N) _ _ f.to_additive'' g.to_additive'' H

@[ext] lemma mul_hom_ext' [mul_one_class N] {f g : multiplicative (α →₀ M) →* N}
  (H : ∀ x, f.comp (single_add_hom x).to_multiplicative =
    g.comp (single_add_hom x).to_multiplicative) :
  f = g :=
mul_hom_ext $ λ x, monoid_hom.congr_fun (H x)

lemma map_range_add [add_zero_class N]
  {f : M → N} {hf : f 0 = 0} (hf' : ∀ x y, f (x + y) = f x + f y) (v₁ v₂ : α →₀ M) :
  map_range f hf (v₁ + v₂) = map_range f hf v₁ + map_range f hf v₂ :=
ext $ λ _, by simp only [hf', add_apply, map_range_apply]

lemma map_range_add' [add_zero_class N] [add_monoid_hom_class β M N]
  {f : β} (v₁ v₂ : α →₀ M) :
  map_range f (map_zero f) (v₁ + v₂) = map_range f (map_zero f) v₁ + map_range f (map_zero f) v₂ :=
map_range_add (map_add f) v₁ v₂

/-- Bundle `emb_domain f` as an additive map from `α →₀ M` to `β →₀ M`. -/
@[simps] def emb_domain.add_monoid_hom (f : α ↪ β) : (α →₀ M) →+ β →₀ M :=
{ to_fun := λ v, emb_domain f v,
  map_zero' := by simp,
  map_add' := λ v w,
  begin
    ext b,
    by_cases h : b ∈ set.range f,
    { rcases h with ⟨a, rfl⟩,
      simp, },
    { simp [emb_domain_notin_range, h], },
  end, }

@[simp] lemma emb_domain_add (f : α ↪ β) (v w : α →₀ M) :
  emb_domain f (v + w) = emb_domain f v + emb_domain f w :=
(emb_domain.add_monoid_hom f).map_add v w

end add_zero_class

section add_monoid

variables [add_monoid M]

/-- Note the general `finsupp.has_smul` instance doesn't apply as `ℕ` is not distributive
unless `β i`'s addition is commutative. -/
instance has_nat_scalar : has_smul ℕ (α →₀ M) :=
⟨λ n v, v.map_range ((•) n) (nsmul_zero _)⟩

instance : add_monoid (α →₀ M) :=
fun_like.coe_injective.add_monoid _ coe_zero coe_add (λ _ _, rfl)

end add_monoid

instance [add_comm_monoid M] : add_comm_monoid (α →₀ M) :=
fun_like.coe_injective.add_comm_monoid _ coe_zero coe_add (λ _ _, rfl)

instance [neg_zero_class G] : has_neg (α →₀ G) := ⟨map_range (has_neg.neg) neg_zero⟩

@[simp] lemma coe_neg [neg_zero_class G] (g : α →₀ G) : ⇑(-g) = -g := rfl

lemma neg_apply [neg_zero_class G] (g : α →₀ G) (a : α) : (- g) a = - g a := rfl

lemma map_range_neg [neg_zero_class G] [neg_zero_class H]
  {f : G → H} {hf : f 0 = 0} (hf' : ∀ x, f (-x) = -f x) (v : α →₀ G) :
  map_range f hf (-v) = -map_range f hf v :=
ext $ λ _, by simp only [hf', neg_apply, map_range_apply]

lemma map_range_neg' [add_group G] [subtraction_monoid H] [add_monoid_hom_class β G H]
  {f : β} (v : α →₀ G) :
  map_range f (map_zero f) (-v) = -map_range f (map_zero f) v :=
map_range_neg (map_neg f) v

instance [sub_neg_zero_monoid G] : has_sub (α →₀ G) := ⟨zip_with has_sub.sub (sub_zero _)⟩

@[simp] lemma coe_sub [sub_neg_zero_monoid G] (g₁ g₂ : α →₀ G) : ⇑(g₁ - g₂) = g₁ - g₂ :=
rfl

lemma sub_apply [sub_neg_zero_monoid G] (g₁ g₂ : α →₀ G) (a : α) : (g₁ - g₂) a = g₁ a - g₂ a := rfl

lemma map_range_sub [sub_neg_zero_monoid G] [sub_neg_zero_monoid H]
  {f : G → H} {hf : f 0 = 0} (hf' : ∀ x y, f (x - y) = f x - f y) (v₁ v₂ : α →₀ G) :
  map_range f hf (v₁ - v₂) = map_range f hf v₁ - map_range f hf v₂ :=
ext $ λ _, by simp only [hf', sub_apply, map_range_apply]

lemma map_range_sub' [add_group G] [subtraction_monoid H] [add_monoid_hom_class β G H]
  {f : β} (v₁ v₂ : α →₀ G) :
  map_range f (map_zero f) (v₁ - v₂) = map_range f (map_zero f) v₁ - map_range f (map_zero f) v₂ :=
map_range_sub (map_sub f) v₁ v₂

/-- Note the general `finsupp.has_smul` instance doesn't apply as `ℤ` is not distributive
unless `β i`'s addition is commutative. -/
instance has_int_scalar [add_group G] : has_smul ℤ (α →₀ G) :=
⟨λ n v, v.map_range ((•) n) (zsmul_zero _)⟩

instance [add_group G] : add_group (α →₀ G) :=
fun_like.coe_injective.add_group _ coe_zero coe_add coe_neg coe_sub
  (λ _ _, rfl) (λ _ _, rfl)

instance [add_comm_group G] : add_comm_group (α →₀ G) :=
fun_like.coe_injective.add_comm_group _ coe_zero coe_add coe_neg coe_sub
  (λ _ _, rfl) (λ _ _, rfl)

lemma single_add_single_eq_single_add_single [add_comm_monoid M]
  {k l m n : α} {u v : M} (hu : u ≠ 0) (hv : v ≠ 0) :
  single k u + single l v = single m u + single n v ↔
  (k = m ∧ l = n) ∨ (u = v ∧ k = n ∧ l = m) ∨ (u + v = 0 ∧ k = l ∧ m = n) :=
begin
  classical,
  simp_rw [fun_like.ext_iff, coe_add, single_eq_pi_single, ←funext_iff],
  exact pi.single_add_single_eq_single_add_single hu hv,
end

@[simp] lemma support_neg [add_group G] (f : α →₀ G) : support (-f) = support f :=
finset.subset.antisymm
  support_map_range
  (calc support f = support (- (- f)) : congr_arg support (neg_neg _).symm
     ... ⊆ support (- f) : support_map_range)

lemma support_sub [decidable_eq α] [add_group G] {f g : α →₀ G} :
  support (f - g) ⊆ support f ∪ support g :=
begin
  rw [sub_eq_add_neg, ←support_neg g],
  exact support_add,
end

lemma erase_eq_sub_single [add_group G] (f : α →₀ G) (a : α) :
  f.erase a = f - single a (f a) :=
begin
  ext a',
  rcases eq_or_ne a a' with rfl|h,
  { simp },
  { simp [erase_ne h.symm, single_eq_of_ne h] }
end

lemma update_eq_sub_add_single [add_group G] (f : α →₀ G) (a : α) (b : G) :
  f.update a b = f - single a (f a) + single a b :=
by rw [update_eq_erase_add_single, erase_eq_sub_single]

end finsupp


/-
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, Johan Commelin, Mario Carneiro
-/

import data.mv_polynomial.rename
import data.equiv.fin
import data.polynomial.algebra_map

/-!
# Equivalences between polynomial rings

This file establishes a number of equivalences between polynomial rings,
based on equivalences between the underlying types.

## Notation

As in other polynomial files, we typically use the notation:

+ `σ : Type*` (indexing the variables)

+ `R : Type*` `[comm_semiring R]` (the coefficients)

+ `s : σ →₀ ℕ`, a function from `σ` to `ℕ` which is zero away from a finite set.
This will give rise to a monomial in `mv_polynomial σ R` which mathematicians might call `X^s`

+ `a : R`

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `p : mv_polynomial σ R`

## Tags

equivalence, isomorphism, morphism, ring hom, hom

-/

noncomputable theory

open_locale classical big_operators

open set function finsupp add_monoid_algebra

universes u v w x
variables {R : Type u} {S₁ : Type v} {S₂ : Type w} {S₃ : Type x}

namespace mv_polynomial
variables {σ : Type*} {a a' a₁ a₂ : R} {e : ℕ} {n m : σ} {s : σ →₀ ℕ}

section equiv

variables (R) [comm_semiring R]

/-- The algebra isomorphism between multivariable polynomials in no variables
and the ground ring. -/
@[simps]
def pempty_alg_equiv : mv_polynomial pempty R ≃ₐ[R] R :=
{ to_fun    := mv_polynomial.eval₂ (ring_hom.id _) $ pempty.elim,
  inv_fun   := C,
  left_inv  := is_id (C.comp (eval₂_hom (ring_hom.id _) pempty.elim))
    (assume a : R, by { dsimp, rw [eval₂_C], refl }) (assume a, a.elim),
  right_inv := λ r, eval₂_C _ _ _,
  map_mul'  := λ _ _, eval₂_mul _ _,
  map_add'  := λ _ _, eval₂_add _ _,
  commutes' := λ _, by rw [mv_polynomial.algebra_map_eq]; simp }

/-- The ring isomorphism between multivariable polynomials in no variables and the ground ring. -/
@[simps]
def pempty_ring_equiv : mv_polynomial pempty R ≃+* R :=
(pempty_alg_equiv R).to_ring_equiv

/--
The ring isomorphism between multivariable polynomials in a single variable and
polynomials over the ground ring.
-/
@[simps]
def punit_alg_equiv : mv_polynomial punit R ≃ₐ[R] polynomial R :=
{ to_fun    := eval₂ polynomial.C (λu:punit, polynomial.X),
  inv_fun   := polynomial.eval₂ mv_polynomial.C (X punit.star),
  left_inv  :=
    begin
      let f : polynomial R →+* mv_polynomial punit R :=
      ring_hom.of (polynomial.eval₂ mv_polynomial.C (X punit.star)),
      let g : mv_polynomial punit R →+* polynomial R :=
      ring_hom.of (eval₂ polynomial.C (λu:punit, polynomial.X)),
      show ∀ p, f.comp g p = p,
      apply is_id,
      { assume a, dsimp, rw [eval₂_C, polynomial.eval₂_C] },
      { rintros ⟨⟩, dsimp, rw [eval₂_X, polynomial.eval₂_X] }
    end,
  right_inv := assume p, polynomial.induction_on p
    (assume a, by rw [polynomial.eval₂_C, mv_polynomial.eval₂_C])
    (assume p q hp hq, by rw [polynomial.eval₂_add, mv_polynomial.eval₂_add, hp, hq])
    (assume p n hp,
      by rw [polynomial.eval₂_mul, polynomial.eval₂_pow, polynomial.eval₂_X, polynomial.eval₂_C,
        eval₂_mul, eval₂_C, eval₂_pow, eval₂_X]),
  map_mul'  := λ _ _, eval₂_mul _ _,
  map_add'  := λ _ _, eval₂_add _ _,
  commutes' := λ _, eval₂_C _ _ _}

section map
variables {R} (σ)

/-- If `e : A ≃+* B` is an isomorphism of rings, then so is `map e`. -/
@[simps apply]
def map_equiv [comm_semiring S₁] [comm_semiring S₂] (e : S₁ ≃+* S₂) :
  mv_polynomial σ S₁ ≃+* mv_polynomial σ S₂ :=
{ to_fun    := map (e : S₁ →+* S₂),
  inv_fun   := map (e.symm : S₂ →+* S₁),
  left_inv  := λ p,
    have (e.symm : S₂ →+* S₁).comp ↑e = ring_hom.id _ := ring_hom.ext e.symm_apply_apply,
    by rw [map_map, this, map_id],
  right_inv := assume p,
    have (e : S₁ →+* S₂).comp ↑e.symm = ring_hom.id _ := ring_hom.ext e.apply_symm_apply,
    by rw [map_map, this, map_id],
  ..map (e : S₁ →+* S₂) }

@[simp] lemma map_equiv_refl :
  map_equiv σ (ring_equiv.refl R) = ring_equiv.refl _ :=
ring_equiv.ext map_id

@[simp] lemma map_equiv_symm [comm_semiring S₁] [comm_semiring S₂] (e : S₁ ≃+* S₂) :
  (map_equiv σ e).symm = map_equiv σ e.symm := rfl

@[simp] lemma map_equiv_trans [comm_semiring S₁] [comm_semiring S₂] [comm_semiring S₃]
  (e : S₁ ≃+* S₂) (f : S₂ ≃+* S₃) :
  (map_equiv σ e).trans (map_equiv σ f) = map_equiv σ (e.trans f) :=
ring_equiv.ext (map_map e f)

variables {A₁ A₂ A₃ : Type*} [comm_semiring A₁] [comm_semiring A₂] [comm_semiring A₃]
variables [algebra R A₁] [algebra R A₂] [algebra R A₃]

/-- If `e : A ≃ₐ[R] B` is an isomorphism of `R`-algebras, then so is `map e`. -/
def map_alg_equiv (e : A₁ ≃ₐ[R] A₂) :
  mv_polynomial σ A₁ ≃ₐ[R] mv_polynomial σ A₂ :=
{ commutes' := λ r, begin
    dsimp,
    have h₁ : algebra_map R (mv_polynomial σ A₁) r = C (algebra_map R A₁ r) := rfl,
    have h₂ : algebra_map R (mv_polynomial σ A₂) r = C (algebra_map R A₂ r) := rfl,
    rw [h₁, h₂, map, eval₂_hom_C, ring_hom.comp_apply,
      ring_equiv.coe_to_ring_hom, alg_equiv.coe_ring_equiv, alg_equiv.commutes],
  end,
  ..(map_equiv σ ↑e) }

@[simp] lemma map_alg_equiv_apply (e : A₁ ≃ₐ[R] A₂) (x : mv_polynomial σ A₁) :
  map_alg_equiv σ e x = map ↑e x := rfl

@[simp] lemma map_alg_equiv_refl :
  map_alg_equiv σ (alg_equiv.refl : A₁ ≃ₐ[R] A₁) = alg_equiv.refl :=
alg_equiv.ext map_id

@[simp] lemma map_alg_equiv_symm (e : A₁ ≃ₐ[R] A₂) :
  (map_alg_equiv σ e).symm = map_alg_equiv σ e.symm := rfl

@[simp] lemma map_alg_equiv_trans (e : A₁ ≃ₐ[R] A₂) (f : A₂ ≃ₐ[R] A₃) :
  (map_alg_equiv σ e).trans (map_alg_equiv σ f) = map_alg_equiv σ (e.trans f) :=
alg_equiv.ext (map_map e f)

end map

section
variables (S₁ S₂ S₃)

/--
The function from multivariable polynomials in a sum of two types,
to multivariable polynomials in one of the types,
with coefficents in multivariable polynomials in the other type.

See `sum_ring_equiv` for the ring isomorphism.
-/
def sum_to_iter : mv_polynomial (S₁ ⊕ S₂) R →+* mv_polynomial S₁ (mv_polynomial S₂ R) :=
eval₂_hom (C.comp C) (λbc, sum.rec_on bc X (C ∘ X))

instance is_semiring_hom_sum_to_iter : is_semiring_hom (sum_to_iter R S₁ S₂) :=
eval₂.is_semiring_hom _ _

@[simp]
lemma sum_to_iter_C (a : R) : sum_to_iter R S₁ S₂ (C a) = C (C a) :=
eval₂_C _ _ a

@[simp]
lemma sum_to_iter_Xl (b : S₁) : sum_to_iter R S₁ S₂ (X (sum.inl b)) = X b :=
eval₂_X _ _ (sum.inl b)

@[simp]
lemma sum_to_iter_Xr (c : S₂) : sum_to_iter R S₁ S₂ (X (sum.inr c)) = C (X c) :=
eval₂_X _ _ (sum.inr c)

/--
The function from multivariable polynomials in one type,
with coefficents in multivariable polynomials in another type,
to multivariable polynomials in the sum of the two types.

See `sum_ring_equiv` for the ring isomorphism.
-/
def iter_to_sum : mv_polynomial S₁ (mv_polynomial S₂ R) →+* mv_polynomial (S₁ ⊕ S₂) R :=
eval₂_hom (ring_hom.of (eval₂ C (X ∘ sum.inr))) (X ∘ sum.inl)

lemma iter_to_sum_C_C (a : R) : iter_to_sum R S₁ S₂ (C (C a)) = C a :=
eq.trans (eval₂_C _ _ (C a)) (eval₂_C _ _ _)

lemma iter_to_sum_X (b : S₁) : iter_to_sum R S₁ S₂ (X b) = X (sum.inl b) :=
eval₂_X _ _ _

lemma iter_to_sum_C_X (c : S₂) : iter_to_sum R S₁ S₂ (C (X c)) = X (sum.inr c) :=
eq.trans (eval₂_C _ _ (X c)) (eval₂_X _ _ _)

/-- A helper function for `sum_ring_equiv`. -/
@[simps]
def mv_polynomial_equiv_mv_polynomial [comm_semiring S₃]
  (f : mv_polynomial S₁ R →+* mv_polynomial S₂ S₃)
  (g : mv_polynomial S₂ S₃ →+* mv_polynomial S₁ R)
  (hfgC : ∀a, f (g (C a)) = C a)
  (hfgX : ∀n, f (g (X n)) = X n)
  (hgfC : ∀a, g (f (C a)) = C a)
  (hgfX : ∀n, g (f (X n)) = X n) :
  mv_polynomial S₁ R ≃+* mv_polynomial S₂ S₃ :=
{ to_fun    := f, inv_fun := g,
  left_inv  := is_id (ring_hom.comp _ _) hgfC hgfX,
  right_inv := is_id (ring_hom.comp _ _) hfgC hfgX,
  map_mul'  := f.map_mul,
  map_add'  := f.map_add }

/--
The ring isomorphism between multivariable polynomials in a sum of two types,
and multivariable polynomials in one of the types,
with coefficents in multivariable polynomials in the other type.
-/
def sum_ring_equiv : mv_polynomial (S₁ ⊕ S₂) R ≃+* mv_polynomial S₁ (mv_polynomial S₂ R) :=
begin
  apply @mv_polynomial_equiv_mv_polynomial R (S₁ ⊕ S₂) _ _ _ _
    (sum_to_iter R S₁ S₂) (iter_to_sum R S₁ S₂),
  { assume p,
    convert hom_eq_hom ((sum_to_iter R S₁ S₂).comp ((iter_to_sum R S₁ S₂).comp C)) C _ _ p,
    { assume a, dsimp, rw [iter_to_sum_C_C R S₁ S₂, sum_to_iter_C R S₁ S₂] },
    { assume c, dsimp, rw [iter_to_sum_C_X R S₁ S₂, sum_to_iter_Xr R S₁ S₂] } },
  { assume b, rw [iter_to_sum_X R S₁ S₂, sum_to_iter_Xl R S₁ S₂] },
  { assume a, rw [sum_to_iter_C R S₁ S₂, iter_to_sum_C_C R S₁ S₂] },
  { assume n, cases n with b c,
    { rw [sum_to_iter_Xl, iter_to_sum_X] },
    { rw [sum_to_iter_Xr, iter_to_sum_C_X] } },
end

/--
The algebra isomorphism between multivariable polynomials in a sum of two types,
and multivariable polynomials in one of the types,
with coefficents in multivariable polynomials in the other type.
-/
def sum_alg_equiv : mv_polynomial (S₁ ⊕ S₂) R ≃ₐ[R]
  mv_polynomial S₁ (mv_polynomial S₂ R) :=
{ commutes' := begin
    intro r,
    have A : algebra_map R (mv_polynomial S₁ (mv_polynomial S₂ R)) r = (C (C r) : _), by refl,
    have B : algebra_map R (mv_polynomial (S₁ ⊕ S₂) R) r = C r, by refl,
    simp only [sum_ring_equiv, sum_to_iter_C, mv_polynomial_equiv_mv_polynomial_apply,
      ring_equiv.to_fun_eq_coe, A, B],
  end,
  ..sum_ring_equiv R S₁ S₂ }

/--
The algebra isomorphism between multivariable polynomials in `option S₁` and
polynomials with coefficients in `mv_polynomial S₁ R`.
-/
def option_equiv_left : mv_polynomial (option S₁) R ≃ₐ[R] polynomial (mv_polynomial S₁ R) :=
(rename_equiv R $ (equiv.option_equiv_sum_punit.{0} S₁).trans (equiv.sum_comm _ _))
  .trans $
(sum_alg_equiv R _ _).trans $
(punit_alg_equiv (mv_polynomial S₁ R)).restrict_scalars R

/--
The algebra isomorphism between multivariable polynomials in `option S₁` and
multivariable polynomials with coefficients in polynomials.
-/
def option_equiv_right : mv_polynomial (option S₁) R ≃ₐ[R] mv_polynomial S₁ (polynomial R) :=
(rename_equiv R $ equiv.option_equiv_sum_punit.{0} S₁).trans $
(sum_alg_equiv R S₁ unit).trans $
map_alg_equiv _ (punit_alg_equiv R)

/--
The algebra isomorphism between multivariable polynomials in `fin (n + 1)` and
polynomials over multivariable polynomials in `fin n`.
-/
def fin_succ_equiv (n : ℕ) :
  mv_polynomial (fin (n + 1)) R ≃ₐ[R] polynomial (mv_polynomial (fin n) R) :=
(rename_equiv R (fin_succ_equiv n)).trans
  (option_equiv_left R (fin n))

lemma fin_succ_equiv_eq (n : ℕ) :
  (fin_succ_equiv R n : mv_polynomial (fin (n + 1)) R →+* polynomial (mv_polynomial (fin n) R)) =
  eval₂_hom (polynomial.C.comp (C : R →+* mv_polynomial (fin n) R))
    (λ i : fin (n+1), fin.cases polynomial.X (λ k, polynomial.C (X k)) i) :=
begin
  apply ring_hom_ext,
  { intro r,
    dsimp [ring_equiv.coe_to_ring_hom, fin_succ_equiv, option_equiv_left, sum_alg_equiv,
      sum_ring_equiv],
    simp only [sum_to_iter_C, eval₂_C, rename_C, ring_hom.coe_comp] },
  { intro i,
    dsimp [fin_succ_equiv, option_equiv_left, sum_alg_equiv, sum_ring_equiv],
    refine fin.cases _ (λ _, _) i,
    { simp only [fin.cases_zero, sum.swap, rename_X, equiv.option_equiv_sum_punit_none,
      equiv.sum_comm_apply, rename_equiv_apply, comp_app, sum_to_iter_Xl, equiv.coe_trans,
      fin_succ_equiv_zero, eval₂_X], },
    { simp only [equiv.option_equiv_sum_punit_some, sum.swap, fin.cases_succ, rename_X,
        equiv.sum_comm_apply, sum_to_iter_Xr, comp_app, eval₂_C,
        equiv.coe_trans, fin_succ_equiv_succ, eval₂_X]} }
end

@[simp] lemma fin_succ_equiv_apply (n : ℕ) (p : mv_polynomial (fin (n + 1)) R) :
  fin_succ_equiv R n p =
  eval₂_hom (polynomial.C.comp (C : R →+* mv_polynomial (fin n) R))
    (λ i : fin (n+1), fin.cases polynomial.X (λ k, polynomial.C (X k)) i) p :=
by { rw ← fin_succ_equiv_eq, refl }

lemma fin_succ_equiv_comp_C_eq_C {R : Type u} [comm_semiring R] (n : ℕ) :
  (↑(mv_polynomial.fin_succ_equiv R n).symm : polynomial (mv_polynomial (fin n) R) →+* _).comp
    ((polynomial.C).comp (mv_polynomial.C))
    = (mv_polynomial.C : R →+* mv_polynomial (fin n.succ) R) :=
begin
  refine ring_hom.ext (λ x, _),
  rw ring_hom.comp_apply,
  refine (mv_polynomial.fin_succ_equiv R n).injective
    (trans ((mv_polynomial.fin_succ_equiv R n).apply_symm_apply _) _),
  simp only [mv_polynomial.fin_succ_equiv_apply, mv_polynomial.eval₂_hom_C],
end

end

end equiv

end mv_polynomial


import .basic
import ..logic
import ..sequence
import ..mynat.max

namespace hidden
namespace myring

structure polynomial (α : Type) [myring α] :=
(seq : sequence α)
(eventually_zero : ∃ N, ∀ n, N ≤ n → seq n = 0)

namespace polynomial

variables {α : Type} [myring α]

theorem polyext (a b : polynomial α) : (∀ n, a.seq n = b.seq n) → a = b :=
begin
  assume h,
  cases a,
  cases b,
  dsimp at h,
  simp,
  apply funext,
  assumption,
end

def add : polynomial α → polynomial α → polynomial α :=
λ a b, ⟨a.seq + b.seq, begin
  cases a.eventually_zero with N hN,
  cases b.eventually_zero with M hM,
  existsi (mynat.max N M),
  intros n hn,
  change a.seq n + b.seq n = 0,
  suffices h₁ : a.seq n = 0,
    suffices h₂ : b.seq n = 0,
      rw [h₁, h₂, add_zero],
    apply hM,
    apply @mynat.max_le_cancel_right N M n,
    assumption,
  apply hN,
  apply @mynat.max_le_cancel_left N M n,
  assumption,
end⟩

instance: has_add (polynomial α) := ⟨add⟩

instance: has_zero (polynomial α) := ⟨⟨λ n, 0, begin
  existsi (0 : mynat),
  intros n hn,
  refl,
end⟩⟩

def neg : polynomial α → polynomial α :=
λ a, ⟨λ n, -a.seq n, begin
  cases a.eventually_zero with N hN,
  existsi N,
  intros n hn,
  symmetry,
  rw [←neg_unique, zero_add],
  apply hN,
  assumption,
end⟩

instance: has_neg (polynomial α) := ⟨neg⟩

-- Same formula for power series ring
-- term_collection a b m n = a_m b_n + a_{m + 1} b_{n-1} + ... + a_{m + n} b_0
private def term_collection (seq₁ : sequence α) (seq₂ : sequence α) : mynat → mynat → α
| m 0              := seq₁ m * seq₂ 0
| m (mynat.succ n) := seq₁ m * seq₂ (n.succ) + (term_collection m.succ n)

private lemma term_collection_zero (seq₁ seq₂ : sequence α) (m n N : mynat)
(h : ∀ a b, N ≤ a + b → seq₁ a * seq₂ b = 0) :
(N ≤ m + n → term_collection seq₁ seq₂ m n = 0) :=
begin
  assume hmnN,
  -- Holy fuck it took me ages to remember `generalizing`
  induction n with n hn generalizing m, {
    rw mynat.zz at *,
    unfold term_collection,
    apply h,
    assumption,
  }, {
    unfold term_collection,
    rw [h m n.succ hmnN, zero_add],
    rw mynat.add_succ at hmnN,
    apply hn,
    rwa mynat.succ_add,
  },
end

private lemma term_collection_succ (a b : sequence α) (m n : mynat) :
term_collection a b m.succ n = term_collection a b m n.succ + -(a m * b n.succ) :=
begin
  apply add_cancel_right _ _ (a m * b n.succ),
  rw [add_assoc, neg_add, add_zero],
  dsimp only [term_collection],
  rw add_comm,
end

-- Formula for what happens if you swap a and b.
private lemma term_collection_swap_args_lemma (a b : sequence α) (m n : mynat) :
term_collection b a m.succ n + term_collection a b n.succ m = term_collection a b 0 (m + n).succ :=
begin
  induction n with n hn generalizing m, {
    rw [mynat.zz, mynat.add_zero],
    dsimp only [term_collection],
    rw mul_comm,
  }, {
    rw [mynat.add_succ],
    have := hn m.succ,
    rw mynat.succ_add at this,
    rw this.symm,
    conv {
      congr,
        congr,
          skip,
        rw term_collection_succ,
        skip,
      congr,
        rw term_collection_succ,
        skip,
      skip,
    },
    ac_refl,
  },
end

private theorem term_collection_swap_args (a b : sequence α) (m n : mynat) :
term_collection b a m.succ n = term_collection a b 0 (m + n).succ + -term_collection a b n.succ m :=
begin
  apply add_cancel_right _ _ (term_collection a b n.succ m),
  rw [add_assoc, neg_add, add_zero, term_collection_swap_args_lemma],
end

open classical

-- Move to mynat? Prove in ordered_myring?
-- This is a slightly strange method of proof
private lemma sum_lemma {m n M N : mynat} : M + N ≤ m + n → M ≤ m ∨ N ≤ n :=
begin
  assume h,
  by_cases hm: M ≤ m,
    left, assumption,
  right,
  change m < M at hm,
  by_contradiction hn,
  change n < N at hn,
  rw ←@not_not (M + N ≤ m + n) at h,
  change ¬(m + n < M + N) at h,
  apply h,
  apply mynat.lt_comb; assumption,
end

def mul : polynomial α → polynomial α → polynomial α :=
λ a b, ⟨λ n, term_collection a.seq b.seq 0 n, begin
  cases a.eventually_zero with N hN,
  cases b.eventually_zero with M hM,
  existsi N + M,
  intros n hNMn,
  apply term_collection_zero _ _ _ _ (N + M),
    intros i j hij,
    suffices: N ≤ i ∨ M ≤ j,
      suffices h₁: a.seq i = 0 ∨ b.seq j = 0,
        cases h₁ with h₁a h₁b,
          rw [h₁a, zero_mul],
        rw [h₁b, mul_zero],
      cases this,
        left,
        apply hN,
        assumption,
      right,
      apply hM,
      assumption,
    apply sum_lemma,
    assumption,
  rwa mynat.zero_add,
end⟩

instance: has_mul (polynomial α) := ⟨mul⟩

instance: has_one (polynomial α) := ⟨⟨λ n, if n = 0 then 1 else 0, begin
  existsi (1 : mynat),
  intro n,
  assume h2n,
  change (0 : mynat).succ ≤ n at h2n,
  rw ←mynat.lt_iff_succ_le at h2n,
  apply if_neg,
  assume hn0,
  apply @mynat.lt_impl_neq 0 n,
    assumption,
  symmetry, assumption,
end⟩⟩

private lemma term_collection_one_zero (a : sequence α) (m n : mynat) :
term_collection (1 : polynomial α).seq a m.succ n = 0 :=
begin
  induction n with n hn generalizing m, {
    rw mynat.zz,
    dsimp only [term_collection],
    change (ite (m.succ = 0) 1 0) * a 0 = 0,
    rw [if_neg mynat.succ_ne_zero, zero_mul],
  }, {
    dsimp only [term_collection],
    conv {
      congr, congr,
      change (ite (m.succ = 0) 1 0) * a n.succ,
    },
    rw [if_neg (mynat.succ_ne_zero), zero_mul, zero_add],
    apply hn,
  },
end

private lemma term_collection_distr (a b c : sequence α) (m n : mynat) :
term_collection a (b + c) m n = term_collection a b m n + term_collection a c m n :=
begin
  induction n with n hn generalizing m, {
    rw mynat.zz,
    dsimp only [term_collection],
    change a m * (b 0 + c 0)= a m * b 0 + a m * c 0,
    rw mul_add,
  }, {
    dsimp only [term_collection],
    rw hn m.succ,
    conv {
      congr, congr,
      change a m * (b n.succ + c n.succ),
      rw mul_add,
    },
    ac_refl,
  },
end

variables a b c : polynomial α

private theorem poly_add_assoc : a + b + c = a + (b + c) :=
begin
  apply polyext,
  intro n,
  change a.seq n + b.seq n + c.seq n = a.seq n + (b.seq n + c.seq n),
  rw add_assoc,
end

private theorem poly_add_zero : a + 0 = a :=
begin
  apply polyext,
  intro n,
  change a.seq n + 0 = a.seq n,
  rw add_zero,
end

private theorem poly_add_neg : a + -a = 0 :=
begin
  apply polyext,
  intro n,
  change a.seq n + -(a.seq n) = 0,
  rw add_neg,
end

-- Presumably impossible
private theorem poly_mul_assoc : a * b * c = a * (b * c) :=
begin
  sorry,
end

private theorem poly_mul_comm : a * b = b * a :=
begin
  apply polyext,
  intro n,
  change term_collection a.seq b.seq 0 n = term_collection b.seq a.seq 0 n,
  cases n,
    rw mynat.zz,
    dsimp only [term_collection],
    rw mul_comm,
  conv {
    to_lhs,
    dsimp only [term_collection],
    rw [term_collection_swap_args, mynat.zero_add],
    dsimp only [term_collection],
    congr,
      rw mul_comm,
      skip,
    rw add_comm,
  },
  rw [←add_assoc, add_neg, zero_add],
  refl,
end

private theorem poly_mul_one : a * 1 = a :=
begin
  apply polyext,
  intro n,
  change term_collection a.seq (1 : polynomial α).seq 0 n = a.seq n,
  cases n,
    rw mynat.zz,
    dsimp only [term_collection],
    change a.seq 0 * (ite (0 = 0) 1 0) = a.seq 0,
    rw [if_pos rfl, mul_one],
  dsimp only [term_collection],
  rw [term_collection_swap_args],
  conv {
    congr, congr,
    change a.seq 0 * (ite (n.succ = 0) 1 0),
    rw [if_neg mynat.succ_ne_zero, mul_zero],
  },
  rw [zero_add, mynat.zero_add, term_collection_one_zero, neg_zero, add_zero],
  dsimp only [term_collection],
  rw [term_collection_one_zero, add_zero],
  change (ite (0 = 0) 1 0) * a.seq n.succ = a.seq n.succ,
  rw [if_pos rfl, one_mul],
end

-- Nice and easy :)
private theorem poly_mul_add : a * (b + c) = a * b + a * c :=
begin
  apply polyext,
  intro n,
  change term_collection a.seq (b.seq + c.seq) 0 n =
  term_collection a.seq b.seq 0 n + term_collection a.seq c.seq 0 n,
  rw term_collection_distr,
end

instance: myring (polynomial α) :=
⟨poly_add_assoc, poly_add_zero, poly_add_neg,
poly_mul_assoc, poly_mul_comm, poly_mul_one, poly_mul_add⟩

end polynomial

end myring
end hidden


import data.int.modeq data.int.basic data.nat.modeq data.equiv data.fintype data.nat.prime data.nat.gcd data.pnat .int_gcd data.nat.prime

@[simp] lemma nat.mod_mod (n m : ℕ) : n % m % m = n % m :=
nat.cases_on m (by simp) (λ m, nat.mod_eq_of_lt (nat.mod_lt _ (nat.succ_pos _)))

@[simp] lemma int.mod_mod (a b : ℤ) : a % b % b = a % b :=
by conv {to_rhs, rw [← int.mod_add_div a b, int.add_mul_mod_self_left]}

@[simp] lemma int.mod_neg_mod (a b : ℤ) : (-(a % b) % b) = (-a % b) :=
by conv {to_rhs, rw [← int.mod_add_div a b, neg_add, neg_mul_eq_mul_neg, int.add_mul_mod_self_left]}

open nat nat.modeq int

def Zmod (n : ℕ) := subtype (< n)

namespace Zmod

@[simp] lemma nat_mod_coe_pnat (n : ℕ+) (a : ℤ) : (nat_mod a ((n : ℕ) : ℤ) : ℤ) = a % ((n : ℕ) : ℤ) :=
have h : (n : ℤ) ≠ 0 := (ne_of_lt (int.coe_nat_lt.2 n.2)).symm,
by rw [← coe_coe, nat_mod, to_nat_of_nonneg (mod_nonneg _ h)]

def of_int (n : ℕ+) (a : ℤ) : Zmod n :=
⟨int.nat_mod a n,
begin
  cases n with n hn,
  cases n with n,
  { exact (nat.not_lt_zero _ hn).elim },
  { have h : ((⟨succ n, hn⟩ : ℕ+) : ℤ) ≠ 0 := dec_trivial,
    rw [← int.coe_nat_lt, int.nat_mod, int.to_nat_of_nonneg (int.mod_nonneg _ h)],
    exact int.mod_lt _ h }
end⟩

def of_nat (n : ℕ+) (a : ℕ) : Zmod n :=
⟨a % n, nat.mod_lt _ n.2⟩

--Copied from core, but marked as private in core
lemma mlt {n b : nat} : ∀ {a}, n > a → b % n < n
| 0     h := nat.mod_lt _ h
| (a+1) h :=
  have n > 0, from lt.trans (nat.zero_lt_succ _) h,
  nat.mod_lt _ this

def add_aux {n : ℕ} (a b : Zmod n) : Zmod n :=
⟨(a.1 + b.1) % n, mlt a.2⟩

def mul_aux {n : ℕ} (a b : Zmod n) : Zmod n :=
⟨(a.1 * b.1) % n, mlt a.2⟩

def neg_aux {n : ℕ} (a : Zmod n) : Zmod n :=
⟨nat_mod (-(a.1 : ℤ)) n,
begin
  cases n with n,
  { exact (nat.not_lt_zero _ a.2).elim },
  { have h : (nat.succ n : ℤ) ≠ 0 := dec_trivial,
    rw [← int.coe_nat_lt, nat_mod, to_nat_of_nonneg (int.mod_nonneg _ h)],
    exact int.mod_lt _ h }
end⟩

instance (n : ℕ) : add_comm_semigroup (Zmod n) :=
{ add := add_aux,
  add_assoc := λ ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, subtype.eq
    (show ((a + b) % n + c) ≡ (a + (b + c) % n) [MOD n],
    from calc ((a + b) % n + c) ≡ a + b + c [MOD n] : modeq_add (nat.mod_mod _ _) rfl
      ... ≡ a + (b + c) [MOD n] : by rw add_assoc
      ... ≡ (a + (b + c) % n) [MOD n] : modeq_add rfl (nat.mod_mod _ _).symm),
  add_comm := λ a b, subtype.eq (show (a.1 + b.1) % n = (b.1 + a.1) % n, by rw add_comm) }

instance (n : ℕ) : comm_semigroup (Zmod n) :=
{ mul := mul_aux,
  mul_assoc := λ ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, subtype.eq
    (calc ((a * b) % n * c) ≡ a * b * c [MOD n] : modeq_mul (nat.mod_mod _ _) rfl
      ... ≡ a * (b * c) [MOD n] : by rw mul_assoc
      ... ≡ a * (b * c % n) [MOD n] : modeq_mul rfl (nat.mod_mod _ _).symm),
  mul_comm := λ a b, subtype.eq (show (a.1 * b.1) % n = (b.1 * a.1) % n, by rw mul_comm) }

lemma one_mul_aux : ∀ (n : ℕ+) (a : Zmod n), of_nat n 1 * a = a :=
λ ⟨n, hn⟩ ⟨a, ha⟩, subtype.eq (show (1 % n * a) % n = a,
begin
  clear _fun_match,
  cases n with n,
  { simp },
  { cases n with n,
    { rw [nat.mod_self, zero_mul];
      exact (nat.eq_zero_of_le_zero (le_of_lt_succ ha)).symm },
    { have h : 1 < n + 2 := dec_trivial,
      have ha : a < succ (succ n) := ha,
      rw [nat.mod_eq_of_lt h, one_mul, nat.mod_eq_of_lt ha] } }
end)

lemma left_distrib_aux (n : ℕ) : ∀ a b c : Zmod n, a * (b + c) = a * b + a * c :=
λ ⟨a, ha⟩ ⟨b, hb⟩ ⟨c, hc⟩, subtype.eq
(calc a * ((b + c) % n) ≡ a * (b + c) [MOD n] : modeq_mul rfl (nat.mod_mod _ _)
  ... ≡ a * b + a * c [MOD n] : by rw mul_add
  ... ≡ (a * b) % n + (a * c) % n [MOD n] : modeq_add (nat.mod_mod _ _).symm (nat.mod_mod _ _).symm)

instance (n : ℕ) : has_neg (Zmod n) := ⟨neg_aux⟩

instance (n : ℕ) : distrib (Zmod n) :=
{ left_distrib := left_distrib_aux n,
  right_distrib := λ a b c, by rw [mul_comm, left_distrib_aux, mul_comm _ b, mul_comm]; refl,
  ..Zmod.add_comm_semigroup n,
  ..Zmod.comm_semigroup n }

instance (n : ℕ+) : comm_ring (Zmod n) :=
{ zero := ⟨0, n.2⟩,
  zero_add := λ ⟨a, ha⟩, subtype.eq (show (0 + a) % n = a, by rw zero_add; exact nat.mod_eq_of_lt ha),
  add_zero := λ ⟨a, ha⟩, subtype.eq (nat.mod_eq_of_lt ha),
  neg := has_neg.neg,
  add_left_neg :=
    λ ⟨a, ha⟩, subtype.eq (show (((-a : ℤ) % n).to_nat + a) % n = 0,
      from int.coe_nat_inj
      begin
        have hn : (n : ℤ) ≠ 0 := (ne_of_lt (int.coe_nat_lt.2 n.2)).symm,
        rw [int.coe_nat_mod, int.coe_nat_add, to_nat_of_nonneg (int.mod_nonneg _ hn), add_comm],
        simp,
      end),
  one := of_nat n 1,
  one_mul := one_mul_aux n,
  mul_one := λ a, by rw mul_comm; exact one_mul_aux n a,
  ..Zmod.distrib n,
  ..Zmod.add_comm_semigroup n,
  ..Zmod.comm_semigroup n }

instance {n : ℕ+} : has_coe ℤ (Zmod n) := ⟨of_int n⟩

instance Zmod_coe_nat (n : ℕ+) : has_coe ℕ (Zmod n) := ⟨of_nat n⟩

@[simp] lemma coe_nat_coe_int (n : ℕ+) (a : ℕ) : (((a : ℕ) : ℤ) : Zmod n) = a :=
subtype.eq $ int.coe_nat_inj $ (show (nat_mod a n : ℤ)= a % n, by simp)

lemma coe_eq_nat_mk {n : ℕ+} (a : ℕ) : (a : Zmod n) = of_nat n a := rfl

lemma coe_int_add {n : ℕ+} (a b : ℤ) : ((a + b : ℤ) : Zmod n) = a + b :=
subtype.eq (show nat_mod (a + b) n = (nat_mod a n + nat_mod b n) % n,
  from int.coe_nat_inj (by simp [int.coe_nat_add]))

lemma coe_int_mul (n : ℕ+) (a b : ℤ) : ((a * b : ℤ) : Zmod n) = a * b :=
subtype.eq (show nat_mod (a * b) n = (nat_mod a n * nat_mod b n) % n,
  from int.coe_nat_inj (begin
    rw [coe_coe, nat_mod_coe_pnat, int.coe_nat_mod, int.coe_nat_mul, nat_mod_coe_pnat, nat_mod_coe_pnat],
    exact int.modeq.modeq_mul (int.mod_mod _ _).symm (int.mod_mod _ _).symm
  end))

lemma coe_int_neg (n : ℕ+) (a : ℤ) : ((-a : ℤ) : Zmod n) = -a :=
subtype.eq (show nat_mod (-a) n = nat_mod (-↑(nat_mod a n)) n,
from int.coe_nat_inj (by simp))

lemma coe_int_sub (n : ℕ+) (a b : ℤ) : ((a - b : ℤ) : Zmod n) = a - b :=
by rw [sub_eq_add_neg, coe_int_add, coe_int_neg, sub_eq_add_neg]

lemma coe_nat_add (n : ℕ+) (a b : ℕ) : ((a + b : ℕ) : Zmod n) = a + b :=
subtype.eq (modeq_add (nat.mod_mod _ _).symm (nat.mod_mod _ _).symm)

lemma coe_nat_mul (n : ℕ+) (a b : ℕ) : ((a * b : ℕ) : Zmod n) = a * b :=
subtype.eq (modeq_mul (nat.mod_mod _ _).symm (nat.mod_mod _ _).symm)

lemma coe_nat_sub (n : ℕ+) {a b : ℕ} (h : b ≤ a) : ((a - b : ℕ) : Zmod n) = a - b :=
by rw [← coe_nat_coe_int, int.coe_nat_sub h, coe_int_sub]; simp

@[simp] lemma coe_eq_zero' (n : ℕ+) : ((n : ℕ) : Zmod n) = 0 :=
subtype.eq (nat.mod_self _)

lemma eq_iff_modeq_nat {n : ℕ+} {a b : ℕ} : (a : Zmod n) = b ↔ a ≡ b [MOD n] :=
⟨subtype.mk.inj, λ h, subtype.eq h⟩

@[simp] lemma val_coe {n : ℕ+} (a : Zmod n) : (a.val : Zmod n) = a :=
subtype.eq (nat.mod_eq_of_lt a.2)

lemma eq_iff_modeq_int {n : ℕ+} {a b : ℤ} : (a : Zmod n) = b ↔ a ≡ b [ZMOD n] :=
⟨λ h, begin
  have := (int.coe_nat_eq_coe_nat_iff _ _).2 (subtype.mk.inj h),
  rw [coe_coe, nat_mod_coe_pnat, nat_mod_coe_pnat] at this,
  exact this
end,
λ h, subtype.eq (show nat_mod a n = nat_mod b n, from
  int.coe_nat_inj begin
  rw [coe_coe, nat_mod_coe_pnat, nat_mod_coe_pnat],
  exact h
end)⟩

@[simp] lemma coe_int_mod (n : ℕ+) (a : ℤ) : ((a % ((n : ℕ) : ℤ) : ℤ) : Zmod n) = a :=
eq_iff_modeq_int.2 (int.mod_mod _ _)

@[simp] lemma coe_nat_mod (n : ℕ+) (a : ℕ) : ((a % n : ℕ) : Zmod n) = a :=
eq_iff_modeq_nat.2 (nat.mod_mod _ _)

@[simp] lemma coe_nat_zero (n : ℕ+) : ((0 : ℕ) : Zmod n) = 0 :=
subtype.eq (nat.zero_mod _)

@[simp] lemma coe_int_zero (n : ℕ+) : ((0 : ℤ) : Zmod n) = 0 :=
by rw [← int.coe_nat_zero, coe_nat_coe_int, coe_nat_zero]

lemma eq_zero_iff_dvd_nat (n : ℕ+) (a : ℕ) : (a : Zmod n) = 0 ↔ (n : ℕ) ∣ a :=
⟨nat.dvd_of_mod_eq_zero ∘ subtype.mk.inj,
  subtype.eq ∘ nat.mod_eq_zero_of_dvd⟩

lemma eq_zero_iff_dvd_int (n : ℕ+) (a : ℤ) : (a : Zmod n) = 0 ↔ (n : ℤ) ∣ a :=
⟨λ h, int.modeq.modeq_zero_iff.1 (eq_iff_modeq_int.1 (by  rw [h, coe_int_zero])),
λ h, by rwa [← int.modeq.modeq_zero_iff, ← eq_iff_modeq_int, coe_int_zero] at h⟩

def to_nat {n : ℕ} (a : Zmod n) : ℕ := a.1

lemma to_nat_lt {n : ℕ} (a : Zmod n) : a.to_nat < n := a.2

def equiv_fin (n : ℕ) : Zmod n ≃ fin (nat_abs n) :=
{ to_fun := λ ⟨a, h⟩, ⟨a, h⟩,
  inv_fun := λ ⟨a, h⟩, ⟨a, h⟩,
  left_inv := λ ⟨_, _⟩, rfl,
  right_inv := λ ⟨_, _⟩, rfl }

instance (n : ℕ) : fintype (Zmod n) :=
fintype.of_equiv _ (equiv_fin n).symm

lemma card_Zmod {n : ℕ} : fintype.card (Zmod n) = n :=
eq.trans (fintype.card_congr (equiv_fin n)) (fintype.card_fin _)

private def inv_aux {n : ℕ+} (a : Zmod n) : Zmod n := gcd_a a.1 n

instance (n : ℕ+) : has_inv (Zmod n) := ⟨inv_aux⟩

@[simp] lemma int.gcd_neg (a b : ℤ) : int.gcd (-a) b = int.gcd a b :=
by unfold int.gcd; rw nat_abs_neg

lemma gcd_a_modeq (a b : ℕ) : (a : ℤ) * gcd_a a b ≡ nat.gcd a b [ZMOD b] :=
by rw [← add_zero ((a : ℤ) * _), gcd_eq_gcd_ab];
  exact int.modeq.modeq_add rfl (int.modeq.modeq_zero_iff.2 (dvd_mul_right _ _)).symm

lemma mul_inv_eq_gcd_nat (n : ℕ+) (a : ℕ) : (a : Zmod n) * a⁻¹ = nat.gcd a n :=
eq_iff_modeq_nat.2 $ int.modeq.coe_nat_modeq_iff.1
  (calc ((a % n * nat_mod (gcd_a (a % n) n) ↑n : ℕ) : ℤ) ≡ (a % n : ℕ) * gcd_a (a % n) n [ZMOD n] :
    by rw [coe_coe, int.coe_nat_mul, nat_mod_coe_pnat]; exact int.modeq.modeq_mul rfl (int.mod_mod _ _)
  ... ≡ nat.gcd (a % n) n [ZMOD n] : gcd_a_modeq _ _
  ... = (nat.gcd a n : ℤ) : by rw [← gcd_rec, nat.gcd_comm])

lemma mul_inv_eq_gcd_int (n : ℕ+) (a : ℤ) : (a : Zmod n) * a⁻¹ = int.gcd a n :=
have h : ((n : ℕ) : ℤ) ≠ 0 := (ne_of_lt (int.coe_nat_lt.2 n.2)).symm,
begin
  rw [int.gcd_comm, ← int.gcd_mod, int.gcd, coe_coe, nat_abs_of_nat, ← mul_inv_eq_gcd_nat,
    ← coe_nat_coe_int _ (nat_abs _), nat_abs_of_nonneg (mod_nonneg _ h)],
  simp,
end

private lemma mul_inv_cancel_aux {p : {n : ℕ+ // nat.prime n.1}} (a : Zmod (p : ℕ+)) (ha : a ≠ 0) : a * a⁻¹ = 1 :=
begin
  rw [← val_coe a, ne.def, eq_zero_iff_dvd_nat] at ha,
  have : coprime ((p : ℕ+) : ℕ) a.val := p.2.coprime_iff_not_dvd.2 ha,
  rw [← val_coe a, mul_inv_eq_gcd_nat, nat.gcd_comm, coprime.gcd_eq_one this],
  refl,
end

instance Zmod_prime_field (p : {n : ℕ+ // nat.prime n.1}) : field (Zmod (p : ℕ+)) :=
{ inv := has_inv.inv,
  zero_ne_one := λ h, begin
    have : 0 = 1 % p.1.1 := subtype.mk.inj h,
    rw nat.mod_eq_of_lt (p.2.gt_one) at this,
    exact nat.no_confusion this,
  end,
  mul_inv_cancel := mul_inv_cancel_aux,
  inv_mul_cancel := λ a ha, by rw mul_comm; exact mul_inv_cancel_aux a ha,
  ..Zmod.comm_ring p.1 }

end Zmod


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

open_locale nat rat real big_operators topological_space

theorem mathd_numbertheory_84 :
  int.floor ((9:ℝ) / 160 * 100) = 5 :=
begin
  rw int.floor_eq_iff,
  norm_num,
end


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.metric_space.emetric_space
import Mathlib.PostPort

universes u_1 u_4 u_2

namespace Mathlib

/-!
# `Gδ` sets

In this file we define `Gδ` sets and prove their basic properties.

## Main definitions

* `is_Gδ`: a set `s` is a `Gδ` set if it can be represented as an intersection
  of countably many open sets;

* `residual`: the filter of residual sets. A set `s` is called *residual* if it includes a dense
  `Gδ` set. In a Baire space (e.g., in a complete (e)metric space), residual sets form a filter.

  For technical reasons, we define `residual` in any topological space but the definition agrees
  with the description above only in Baire spaces.

## Main results

We prove that finite or countable intersections of Gδ sets is a Gδ set. We also prove that the
continuity set of a function from a topological space to an (e)metric space is a Gδ set.

## Tags

Gδ set, residual set
-/

/-- A Gδ set is a countable intersection of open sets. -/
def is_Gδ {α : Type u_1} [topological_space α] (s : set α) :=
  ∃ (T : set (set α)), (∀ (t : set α), t ∈ T → is_open t) ∧ set.countable T ∧ s = ⋂₀T

/-- An open set is a Gδ set. -/
theorem is_open.is_Gδ {α : Type u_1} [topological_space α] {s : set α} (h : is_open s) : is_Gδ s := sorry

theorem is_Gδ_univ {α : Type u_1} [topological_space α] : is_Gδ set.univ :=
  is_open.is_Gδ is_open_univ

theorem is_Gδ_bInter_of_open {α : Type u_1} {ι : Type u_4} [topological_space α] {I : set ι} (hI : set.countable I) {f : ι → set α} (hf : ∀ (i : ι), i ∈ I → is_open (f i)) : is_Gδ (set.Inter fun (i : ι) => set.Inter fun (H : i ∈ I) => f i) := sorry

theorem is_Gδ_Inter_of_open {α : Type u_1} {ι : Type u_4} [topological_space α] [encodable ι] {f : ι → set α} (hf : ∀ (i : ι), is_open (f i)) : is_Gδ (set.Inter fun (i : ι) => f i) := sorry

/-- A countable intersection of Gδ sets is a Gδ set. -/
theorem is_Gδ_sInter {α : Type u_1} [topological_space α] {S : set (set α)} (h : ∀ (s : set α), s ∈ S → is_Gδ s) (hS : set.countable S) : is_Gδ (⋂₀S) := sorry

theorem is_Gδ_Inter {α : Type u_1} {ι : Type u_4} [topological_space α] [encodable ι] {s : ι → set α} (hs : ∀ (i : ι), is_Gδ (s i)) : is_Gδ (set.Inter fun (i : ι) => s i) :=
  is_Gδ_sInter (iff.mpr set.forall_range_iff hs) (set.countable_range s)

theorem is_Gδ_bInter {α : Type u_1} {ι : Type u_4} [topological_space α] {s : set ι} (hs : set.countable s) {t : (i : ι) → i ∈ s → set α} (ht : ∀ (i : ι) (H : i ∈ s), is_Gδ (t i H)) : is_Gδ (set.Inter fun (i : ι) => set.Inter fun (H : i ∈ s) => t i H) := sorry

theorem is_Gδ.inter {α : Type u_1} [topological_space α] {s : set α} {t : set α} (hs : is_Gδ s) (ht : is_Gδ t) : is_Gδ (s ∩ t) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_Gδ (s ∩ t))) set.inter_eq_Inter))
    (is_Gδ_Inter (iff.mpr bool.forall_bool { left := ht, right := hs }))

/-- The union of two Gδ sets is a Gδ set. -/
theorem is_Gδ.union {α : Type u_1} [topological_space α] {s : set α} {t : set α} (hs : is_Gδ s) (ht : is_Gδ t) : is_Gδ (s ∪ t) := sorry

theorem is_Gδ_set_of_continuous_at_of_countably_generated_uniformity {α : Type u_1} {β : Type u_2} [topological_space α] [uniform_space β] (hU : filter.is_countably_generated (uniformity β)) (f : α → β) : is_Gδ (set_of fun (x : α) => continuous_at f x) := sorry

/-- The set of points where a function is continuous is a Gδ set. -/
theorem is_Gδ_set_of_continuous_at {α : Type u_1} {β : Type u_2} [topological_space α] [emetric_space β] (f : α → β) : is_Gδ (set_of fun (x : α) => continuous_at f x) :=
  is_Gδ_set_of_continuous_at_of_countably_generated_uniformity emetric.uniformity_has_countable_basis f

/-- A set `s` is called *residual* if it includes a dense `Gδ` set. If `α` is a Baire space
(e.g., a complete metric space), then residual sets form a filter, see `mem_residual`.

For technical reasons we define the filter `residual` in any topological space but in a non-Baire
space it is not useful because it may contain some non-residual sets. -/
def residual (α : Type u_1) [topological_space α] : filter α :=
  infi fun (t : set α) => infi fun (ht : is_Gδ t) => infi fun (ht' : dense t) => filter.principal t