import tactic
import data.real.basic
-- import data.set
/-
- nom des variables dans la def de limite !
- variables muettes = variables globales : bof
- calcul avec abs : abs (l'-l) /2 >0 ??
(x ≠ 0 → |x| >0)
- ne pas ajouter l'inégalité au contexte si elle y est déjà !
- 'dsimp only at h' effectue les beta-réduction : (λ x, f x) 37 = f 37
- max : def et propriétés
- utiliser specialize ??

-/

-- dEAduction tactics
import structures2      -- hypo_analysis, targets_analysis
import utils            -- no_meta_vars
import user_notations   -- notations that can be used in deaduction UI for a new object
import compute
import push_neg_once    -- pushing negation just one step

-- dEAduction definitions
import set_definitions
import real_definitions

-- class real_number_subgroup (α : Type) :=
-- (subgroup : ((α = ℕ) ∨ (α = ℤ) ∨ (α = ℚ) ∨ (α = ℝ)) )

-- lemma real_number_subgroup_nat : (nat = ℕ) ∨ (nat = ℤ) ∨ (nat = ℚ) ∨ (nat = ℝ) :=
-- begin
--   left, refl,
-- end

-- instance : real_number_subgroup nat := ⟨real_number_subgroup_nat⟩

local attribute [instance] classical.prop_decidable

/-- `l` is the limit of the sequence `a` of reals -/
definition limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, | u n - l | < ε

definition converging_seq (u : ℕ → ℝ) : Prop :=
∃ l, limit u l

definition limit_plus_infinity (u : ℕ → ℝ) : Prop :=
∀ M:ℝ, ∃ N:ℕ, ∀ n ≥ N, u n ≥ M

definition increasing_seq (u : ℕ → ℝ) : Prop :=
∀ p q , p ≤ q → u p ≤ u q

definition bounded_above (u : ℕ → ℝ) : Prop :=
∃ M:ℝ, ∀ n, u n ≤ M

definition bounded_below (u : ℕ → ℝ) : Prop :=
∃ m:ℝ, ∀ n, u n ≥ m

definition bounded_sequence (u : ℕ → ℝ) : Prop :=
∃ M>0, ∀ n, | u n | ≤ M

definition even (n:ℕ) : Prop := ∃ n', n=2 * n'

definition limit_function (f : ℝ → ℝ) (a : ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ δ>0, ∀ x: ℝ, ( | x-a | < δ → | f x  - l | < ε )

definition continuous_at (f : ℝ → ℝ) (a : ℝ) : Prop :=
limit_function (λ x, f x) a (f a)

definition continuous (f: ℝ → ℝ) : Prop :=
∀ a, continuous_at f a

definition cauchy (u: ℕ → ℝ) : Prop :=
∀ ε>0, ∃ N: ℕ, ∀ p≥N, ∀ q≥N, |u p - u q | < ε

definition uniformly_continuous (f: ℝ → ℝ) : Prop :=
∀ ε>0, ∃ δ>0, ∀ x y: ℝ,
(|x - y| < δ → |f x - f y | < ε)

section course
open tactic.interactive
-- notation `|` x `|` := abs x

-----------------
-- definitions --
-----------------
namespace definitions
/- dEAduction
PrettyName
  Définitions
-/

namespace generalites
/- dEAduction
PrettyName
  Généralités
-/

/-
abs_pos : 0 < |a| ↔ a ≠ 0
abs_mul x y : |x * y| = |x| * |y|
abs_add x y : |x + y| ≤ |x| + |y|
-/

/-
Max :
def
max ≥ n et n'
1) We will be using `max` a lot in this workshop. `max A B` is
the max of `A` and `B`. `max` is a definition, not a theorem, so
that means that there will be an API associated with it, i.e.
a list of little theorems which make `max` possible to use.
We just saw the two important theorems which we'll be using:
`le_max_left A B : A ≤ max A B` and
`le_max-right A B : B ≤ max A B`.
There are other cool functions in the `max` API, for example
`max_le : A ≤ C → B ≤ C → max A B ≤ C`. The easiest way to
find your way around the `max` API is to *guess* what the names
of the theorems are! For example what do you think
`max A B < C ↔ A < C ∧ B < C` is called?
-/

----------------------------------
namespace maximum
-- The name RealSubGroup will be replaced by ℝ in d∃∀duction,
-- but allows to treat the cases of integers or rationals.
variables {RealSubGroup : Type} [decidable_linear_order RealSubGroup]

lemma theorem.ppe_max_gauche :
∀ a b : RealSubGroup, a ≤ max a b :=
begin
  -- targets_analysis,
  intros a b,
  -- hypo_analysis,
  -- norm_num, tautology,
  exact le_max_left a b,
  -- todo
end

lemma theorem.ppe_max_droite :
∀ a b : RealSubGroup,  b ≤ max a b :=
begin
  have H := @theorem.ppe_max_gauche,
  intros a b, norm_num, tautology,
  -- exact le_max_right a b,
end

lemma theorem.max_ppe
(a b c : RealSubGroup) (Ha: a ≤ c) (Hb: b ≤ c) :
max a b ≤ c :=
begin
  norm_num, tautology,
  -- exact max_le Ha Hb,
end

lemma theorem.max_pp
(a b c : RealSubGroup) (Ha: a < c) (Hb: b < c) :
max a b < c :=
begin
  norm_num, tautology,
  -- exact max_lt Ha Hb,
end

end maximum

namespace valeur_absolue
variables {RealSubGroup : Type} [decidable_linear_ordered_comm_ring RealSubGroup]
-- [has_zero RealSubGroup]

-- A modifier : faire une classe "nombres" ?
lemma theorem.valeur_absolue :
∀ x : RealSubGroup,
((0:RealSubGroup) ≤ x) → (abs x = x) and ((x ≤ 0) → (abs x = -x)) :=
begin
  intro x, split, exact abs_of_nonneg, exact abs_of_nonpos,
end

lemma theorem.majoration_valeur_absolue :
∀ x r : RealSubGroup, (abs x < r) ↔ ((-r < x) ∧ (x < r))
:=
/- dEAduction
PrettyName
  Majoration d'une valeur absolue
-/
begin
  intros x r,
  exact abs_lt
end

lemma theorem.inegalite_triangulaire :
∀ x y : RealSubGroup, |x + y| ≤ |x| + |y|
:=
/- dEAduction
PrettyName
  Inégalité triangulaire
-/
begin
  intros x y, exact abs_add x y
end

lemma theorem.valeur_absolue_produit :
∀ x y : RealSubGroup,  |x * y| = |x| * |y|
:=
/- dEAduction
PrettyName
  Valeur absolue d'un produit
-/
begin
  intros x y, exact abs_mul x y
end

end valeur_absolue

end generalites
namespace suites

------------------------------
-- Définitions de la limite --
------------------------------

lemma definition.limit
{u : ℕ → ℝ} {l : ℝ} :
(limit u l) ↔
∀ ε > 0, ∃ N, ∀ n ≥ N, | u n - l | < ε
:=
/- dEAduction
PrettyName
  Limite d'une suite
ImplicitUse
  True
-/
begin
  refl
end

lemma definition.converging_seq
{u : ℕ → ℝ} :
(converging_seq u) ↔
∃ l, limit u l
:=
/- dEAduction
PrettyName
  Suite convergente
ImplicitUse
  True
-/
begin
  refl
end

lemma definition.limit_plus_infinity
{u : ℕ → ℝ} :
(limit_plus_infinity u) ↔ ∀ M:ℝ, ∃ N:ℕ, ∀ n ≥ N, u n ≥ M :=
/- dEAduction
PrettyName
  Limite infinie d'une suite
ImplicitUse
  True
-/
begin
  refl
end

lemma definition.increasing_seq
{u : ℕ → ℝ} :
(increasing_seq u) ↔
∀ p q, p ≤ q → u p ≤ u q
:=
/- dEAduction
PrettyName
  Suite croissante
ImplicitUse
  True
-/
begin
  refl
end

lemma definition.bounded_above
{u : ℕ → ℝ} :
(bounded_above u) ↔
∃ M:ℝ, ∀ n,  u n ≤ M
:=
/- dEAduction
PrettyName
  Suite majorée
ImplicitUse
  True
-/
begin
  refl
end

-- lemma definition.bounded_below
-- {u : ℕ → ℝ} :
-- (bounded_below_sequence u) ↔
-- ∃ M:ℝ, ∀ n,  u n ≥ M
-- :=
-- /- dEAduction
-- PrettyName
--   Suite minorée
-- ImplicitUse
--   True
-- -/
-- begin
--   refl
-- end

lemma definition.bounded
{u : ℕ → ℝ} :
(bounded_sequence u) ↔
∃ M>0, ∀ n, | u n | ≤ M
:=
/- dEAduction
PrettyName
  Suite bornée
ImplicitUse
  True
-/
begin
  refl
end

end suites

namespace fonctions

lemma definition.composition {X Y Z: Type} {f: X → Y} {g:Y → Z} {x:X}:
set.composition g f x = g (f x)
:=
begin
    todo,
end

lemma definition.limit_function (f : ℝ → ℝ) (a : ℝ) (l : ℝ) :
limit_function f a l ↔
( ∀ ε > 0, ∃ δ>0, ∀ x: ℝ, ( | x-a | < δ → | f x  - l | < ε ) ):=
/- dEAduction
PrettyName
  Limite d'une fonction
ImplicitUse
  True
-/
begin
  refl
end

lemma definition.continuous_at (f : ℝ → ℝ) (a : ℝ) :
(continuous_at f a) ↔ (limit_function f a (f a)) :=
/- dEAduction
PrettyName
  Continuité en un point
-/
begin
  refl
end

lemma definition.continuous (f: ℝ → ℝ) :
(continuous f) ↔ ∀ a, continuous_at f a :=
/- dEAduction
PrettyName
  Continuité
ImplicitUse
  True
-/
begin
  refl
end

end fonctions

end definitions

-----------------
--  exercices  --
-----------------
namespace exercices_suites_I
/- dEAduction
PrettyName
  Exercices sur les suites I
-/

-- open definitions

-- --------------------------------------------------
-- namespace exemples

-- end exemples

lemma exercise.limit_constante
(u : ℕ → ℝ) (c : ℝ) (H : ∀ n, u n = c) :
converging_seq u :=
/- dEAduction
PrettyName
  La limite d'une suite constante !
Description
  Dans ce premier exercice,
  il s'agit de démontrer, dans un cas très simple,
  l'existence d'une limite.
-/
begin
--   rw definition.limit,
--   intros ε Hε,
--   use 0,
--   intros n H1,
--   rw H,
-- `[ solve1 {norm_num at * }, trace "EFFECTIVE CODE n°4.0"] <|> `[ `[ norm_num at *, trace "EFFECTIVE CODE n°5.0"] <|> `[ skip, trace "EFFECTIVE CODE n°5.1"], compute_n 10, trace "EFFECTIVE CODE n°4.1"],
  todo,
end

lemma exercise.croissante_non_majoree
(u: ℕ → ℝ) (H1: increasing_seq u) (H2: not (bounded_above u)) :
limit_plus_infinity u :=
/- dEAduction
PrettyName
  Une suite croissante non majorée tend vers plus l'infini
Description
  Dans ce deuxième exercice,
  il s'agit à nouveau de démontrer une limite, mais infinie.
-/
begin
  todo,
end

lemma exercise.limite_positive
(u : ℕ → ℝ) (l : ℝ) (H : limit u l)
(H' : l >0) :
∃ N, ∀ n ≥ N, u n > 0
:=
/- dEAduction
PrettyName
  Suite dont la limite est strictement positive
Description
  Dans ce troisième exercice,
  il s'agit d'utiliser une hypothèse de limite.
-/
begin
  -- have W := exercise.limit_constante,
  -- hypo_analysis,
  todo,
end

lemma exercise.limite_inegalites
(u v: ℕ → ℝ) (l l' : ℝ) (H : limit u l)
(H' : limit v l'):
(∀n, u n ≤ v n ) → l ≤ l'
:=
/- dEAduction
PrettyName
  Passage à la limite dans une inégalité (*)
Description
  Comment démarrer ??
  Comment avoir un epsilon pertinent auquel appliquer nos
  définitions de limites ?...
-/
begin
  todo,
  -- contrapose H'' with H1,
  -- push_neg,
  -- push_neg at H1,
  -- let e := (l-l')/2, have H2 : e = (l-l')/2, refl, no_meta_vars,
  -- rw limit at H H',
  -- have H3: (e:ℝ) > 0, rotate, have H4 := H e H3, rotate 1, rotate, rotate,
  -- solve1 {norm_num at *, apply mul_pos, linarith only [H1], apply inv_pos.mpr, linarith},
  -- have H5 := H' e H3,
  -- cases H4 with n H6,
  -- cases H5 with n' H7,
  -- let n'' := max n n', have H8 : n'' = max n n', refl, no_meta_vars,
  -- have H9: (n'':ℕ) ≥ n, rotate, have H10 := H6 n'' H9, rotate 1, solve1 {norm_num at *, tautology }, rotate,
  -- have H11: (n'':ℕ) ≥ n', rotate, have H12 := H7 n'' H11, rotate 1, solve1 {norm_num at *, tautology }, rotate,
  -- use n'',
  -- rw generalites.valeur_absolue.theorem.majoration_valeur_absolue at H10,
  -- cases H10 with H14 H15,
  -- rw generalites.valeur_absolue.theorem.majoration_valeur_absolue at H12,
  -- cases H12 with H17 H18,
  -- linarith only [H18, H14, H2],
end

end exercices_suites_I

namespace exercices_suites_II
/- dEAduction
PrettyName
  Exercices sur les suites II
-/

lemma exercise.couper_epsilon_en_deux
(u : ℕ → ℝ) (l : ℝ) :
(limit u l) ↔
∀ ε > 0, ∃ N, ∀ n ≥ N, | u n - l | < 2*ε
:=
/- dEAduction
PrettyName
  Couper les epsilons en deux
Description
  Nous avons maintenant une limite dans les hypothèses,
  et une limite dans la conclusion !
-/
begin
  todo,
end

lemma exercise.couper_epsilon_en_100
(u : ℕ → ℝ) (l : ℝ) :
(limit u l) ↔
∀ ε > 0, ∃ N, ∀ n ≥ N, | u n - l | < 100*ε
:=
/- dEAduction
PrettyName
  Couper les epsilons en cent !
Description
  Simple variante du précédent,
  pour voir si vous avez compris...
-/
begin
  todo,
end

lemma exercise.limite_somme
(u v: ℕ → ℝ) (l l' : ℝ) (H : limit u l)
(H' : limit v l') :
limit (λn, u n + v n) (l+l')
:=
/- dEAduction
PrettyName
  Limite d'une somme
Description
  Aide : il peut être judicieux d'utiliser le résultat
  d'un exercice précédent...
-/
begin
--   rw definitions.definition.limit,
-- rw definitions.definition.limit at H H',
-- intro ε, intro H1,
-- have H2 := H _ H1,
-- have H3 := H' _ H1,
-- cases H2 with n H4,
-- cases H3 with n' H5,
-- let x2 := max n n', have H7 : x2 = max n n', refl,
-- have H9 := @definitions.maximum.theorem.ppe_max_gauche,
-- have H10 := H9 n n',
-- -- norm_num at H10,
-- rw H7 at H10,
  todo,
  -- rw limit,
  -- intro ε, intro H1,
  -- rw limit at H H',
  -- have H2: ((ε/2):ℝ) > 0, rotate, have H3 := H (ε/2) H2, rotate 1, solve1 {linarith only [H1] }, rotate,
  -- have H4: ((ε/2):ℝ) > 0, rotate, have H5 := H' (ε/2) H4, rotate 1, solve1 {assumption}, rotate,
  -- cases H3 with n H6,
  -- cases H5 with n' H7,
  -- use max n n',
  -- intro n'', intro H8,
  -- have H9: (n'':ℕ) ≥ n, rotate, have H10 := H6 n'' H9, rotate 1, solve1 {norm_num at *, tautology }, rotate,
  -- have H11: (n'':ℕ) ≥ n', rotate, have H12 := H7 n'' H11, rotate 1, solve1 {norm_num at *, tautology }, rotate,

  -- rw generalites.valeur_absolue.theorem.majoration_valeur_absolue at H10 H12,
  -- rw generalites.valeur_absolue.theorem.majoration_valeur_absolue,
  -- cases H12 with Ha Hb, cases H10 with Hc Hd,
  -- split,
  -- linarith only [Ha, Hc],
  -- linarith only [Hb, Hc, Hd],
end

lemma exercise.limite_unique
(u : ℕ → ℝ) (l : ℝ)(l' : ℝ) (H : limit u l) (H' : limit u l') :
l = l'
:=
/- dEAduction
PrettyName
  (*) Unicité de la limite
-/
begin
  -- by_contradiction,
  -- wlog Hll': l < l',
  -- -- exact lt_or_gt_of_ne a,
  -- rotate,
  -- set ε := (l'-l)/2 with Heps,
  -- have Hpos: ε >0, rotate, -- by compute1,
  -- specialize H ε Hpos, rotate 2,
  -- rotate,

  -- cases H with N1,
  -- specialize H' ε Hpos, cases H' with N2,
  -- set n := max N1 N2 with Hn,
  -- have HnsuppN1: n ≥ N1, from le_max_left N1 N2,
  -- have ineq1 := H_h n HnsuppN1,
  -- have HnsuppN2: n ≥ N2, from le_max_right N1 N2,
  -- have ineq1 := H'_h n HnsuppN2,

  -- -- sorry,
  -- todo,
  -- todo,
  todo,
end

lemma exercise.gendarmes
(u v w  : ℕ → ℝ) (l : ℝ)
(H : limit u l) (H' : limit w l)
(H'' : ∀n, (((u n) ≤ v n) and ((v n) ≤ w n))) :
limit v l
:=
/- dEAduction
PrettyName
  (**) Théorème des gendarmes
-/
begin
  todo,
end

lemma exercise.borne_fois_zero
(u v: ℕ → ℝ) (H : limit u 0)
(H' : bounded_sequence v) :
limit (λn, (u n) * (v n)) 0
:=
/- dEAduction
PrettyName
  (**) Limite d'un produit (cas particulier)
-/
begin
  todo,
end

/-
A essayer : appliquer somme, CV implique borné, borné x 0
-/
lemma limite_produit
(u u': ℕ → ℝ) (l l' : ℝ) (H : limit u l)
(H' : limit u' l') :
limit (λn, (u n) * (u' n)) (l*l')
:=
begin
  todo,
end

end exercices_suites_II

namespace exercices_fonctions
/- dEAduction
PrettyName
  Exercices sur les fonctions
-/

open definitions

open set

lemma exercise.limite_positive
(f: ℝ → ℝ)
(H0: continuous f) (H1: f(0) = 1):
∃ δ>(0:ℝ), ∀ x, |x| < δ → f(x) >0 :=
/- dEAduction
PrettyName
  Limite positive
Description
  Deux limites en hypothèse, une en conclusion...
-/
begin
  todo,
  -- have H2 := (H0 0) 1 _,
  -- rcases H2 with ⟨δ, H3, H4⟩,
  -- norm_num at H4,
  -- rw H1 at H4,
  -- use δ, split, rotate,
  -- intros x x_del,
  -- have H5 := H4 _ x_del,
  -- rw generalites.valeur_absolue.theorem.majoration_valeur_absolue at *,
  -- cases H5 with H5a H5b,
  -- linarith only [H5a], linarith, assumption,
end

lemma exercise.composition_limite_fonction
(f: ℝ → ℝ) (g: ℝ → ℝ) (a b c : ℝ)
(H0: limit_function (λ x, f x) a b)
(H1: limit_function (λ y, g y) b c):
limit_function (λ x, g ( f ( x)) ) a c :=
/- dEAduction
PrettyName
  Limite et composition
Description
  Deux limites en hypothèse, une en conclusion...
-/
begin
  todo,
end

lemma exercise.composition_continuite (f: ℝ → ℝ) (g: ℝ → ℝ)
(H: continuous f) (H': continuous g):
continuous (composition g f) :=
/- dEAduction
PrettyName
  Continuité et composition
-/
begin
  todo,
end

lemma exercise.image_convergente (u: ℕ → ℝ) (l : ℝ) (f: ℝ → ℝ)
(H: limit u l) (H': continuous f):
limit (λ n, f (u n)) (f l) :=
/- dEAduction
PrettyName
  Image d'une suite convergente
Description
  Deux limites en hypothèse, une en conclusion...
-/
begin
  todo,
end

end exercices_fonctions

namespace suites_de_Cauchy
/- dEAduction
PrettyName
  Suites de Cauchy
-/

-- open definitions

lemma definition.suite_de_cauchy
(u: ℕ → ℝ) :
cauchy u ↔ ∀ ε>0, ∃ N: ℕ, ∀ p≥N, ∀ q≥N, |u p - u q | < ε
:=
/- dEAduction
PrettyName
  Suites de Cauchy
ImplicitUse
  True
-/
begin
  refl,
end

-- definition increasing (k: ℕ → ℕ) : Prop :=
-- ∀ n, (k n) > (k (n+1))

-- definition limit_value (u: ℕ → ℝ) (a: ℝ) : Prop :=
-- ∃ k: ℕ → ℕ, increasing k ∧ limit (λ n, (u (k n))) a

-- lemma definition.increasing (k: ℕ → ℕ): (increasing k) ↔
-- ∀ n, (k n) > (k (n+1)) :=
-- begin
--   refl,
-- end

-- lemma theorem.increasing_limit (k: ℕ → ℕ) (H: increasing k):
-- limit_plus_infinity (coe k) :=
-- begin
--   todo,
-- end

-- lemma definition.limit_value (u: ℕ → ℝ) (a: ℝ) :
-- limit_value u a ↔
-- ∃ k: ℕ → ℕ, increasing k ∧ limit (λ n, (u (k n))) a :=
-- begin
--   refl,
-- end

-- lemma exercise.limit_limit_value
--  (u: ℕ → ℝ) (a b: ℝ) (H1: limit u a) (H2: limit_value u b) :
--  b = a :=
-- /- dEAduction
-- PrettyName
--   Une suite convergence a une unique valeur d'adhérence
-- -/
-- begin
--   todo,
-- end

lemma exercise.convergente_implique_cauchy (u: ℕ → ℝ):
converging_seq u → cauchy u :=
/- dEAduction
PrettyName
  Une suite convergente est de Cauchy
-/
begin
  todo,
  -- intro H,
  -- rw converging_seq at H, cases H with x H,
  -- have H := limit (λ n, (u n)^2)  (x^2)
end

-- lemma theorem.cauchy_bounded (u: ℕ → ℝ):
-- cauchy u → bounded_sequence u :=
-- /- dEAduction
-- PrettyName
--   Une suite de Cauchy est bornée
-- -/
-- begin
--   todo,
-- end

-- lemma theorem.bounded_limit_value (u: ℕ → ℝ):
-- bounded_sequence u → ∃ a, limit_value u a :=
-- /- dEAduction
-- PrettyName
--   Une suite bornée a une valeur d'adhérence
-- -/
-- begin
--   todo,
-- end

-- lemma exercise.limit_value_cauchy_converge (u: ℕ → ℝ)
-- (H1: cauchy u) (H2: ∃ a, limit_value u a) :
-- converging_seq u  :=
-- /- dEAduction
-- PrettyName
--   Une suite de Cauchy ayant une valeur d'adhérence converge
-- -/
-- begin
--   todo,
-- end

-- lemma exercise.cauchy_converge (u: ℕ → ℝ)
-- (H1: cauchy u):
-- converging_seq u  :=
-- /- dEAduction
-- PrettyName
--   Toute suite de Cauchy converge
-- -/
-- begin
--   todo,
-- end

end suites_de_Cauchy

namespace continuite_uniforme
/- dEAduction
PrettyName
  Continuité uniforme
-/

lemma definition.uniformly_continuous
(f: ℝ → ℝ) : uniformly_continuous f ↔
∀ ε>0, ∃ δ>0, ∀ x y: ℝ,
(|x - y| < δ → |f x - f y | < ε)
:=
/- dEAduction
PrettyName
  Continuité uniforme
ImplicitUse
  True
-/
begin
  refl,
end

lemma exercise.continue_de_uniformement_continue
(f: ℝ → ℝ) (H0: uniformly_continuous f):
continuous f :=
/- dEAduction
PrettyName
  Uniformément continu implique continu
-/
begin
  todo,
end

lemma exercise.cauchy_uniformement_continue
(u: ℕ → ℝ) (f: ℝ → ℝ)
(H0: cauchy u) (H1: uniformly_continuous f):
cauchy (λ n:ℕ, f (u n))
:=
/- dEAduction
PrettyName
  Image d'une suite de Cauchy
-/
begin
  todo,
end

-- TODO: cauchy => bornée, bornée => valeur d'adh,
-- Cauchy + va => cv

end continuite_uniforme

-- namespace DL
-- /- dEAduction
-- PrettyName
--   Développements limités
-- -/

-- definition DL_order_0 (f: ℝ → ℝ) : Prop :=
-- ∃ (φ : ℝ → ℝ), (limit_function φ 0 0) and
-- (∀ h, f h = f 0 + φ h)

-- definition DL_order_1 (f: ℝ → ℝ) (a : ℝ) : Prop :=
-- ∃ (φ : ℝ → ℝ), (limit_function φ 0 0) and
-- (∀ h, f h = f 0 + a * h + (φ h) * h)

-- lemma definition.DL_order_0
-- (f: ℝ → ℝ) (a : ℝ):
-- (DL_order_0 f) ↔ (∃ (φ : ℝ → ℝ), (limit_function φ 0 0) and
-- (∀ h, f h = f 0 + φ h))
-- :=
-- begin
--   todo
-- end

-- example
-- (f: ℝ → ℝ):
-- (DL_order_0 f) ↔ ∃ l, (limit_function f 0 l) :=
-- begin
--   todo
-- end
-- end DL

/-
On peut multiplier les variantes : si une fonction a une
limite >0 en un point, elle est >0 au voisinage.
Si lim f < lim g alors f < g au voisinage.

Signe à partir d'un DL !

-/

end course


/-
Copyright © 2018 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import .basic .cons .append

namespace tup
variable {α : Type*}

@[reducible]
definition bar (f : ℕ → α) (n : ℕ) : fin n → α
| ⟨i,_⟩ := f i

@[simp]
lemma bar_val (f : ℕ → α) {n : ℕ} :
∀ i, (bar f n)[i] = f i.val
| ⟨_,_⟩ := rfl

lemma take_bar (f : ℕ → α) {m n : ℕ} (h : m ≤ n) :
take h (bar f n) = bar f m :=
tup.ext (λ _, by simp)

definition extend {n : ℕ} (xs : α ^ n) (x : α) (i : ℕ) : α :=
if h : i < n then xs[⟨i,h⟩] else x

lemma extend_of_lt {n : ℕ} {xs : α ^ n} {x : α} {i : ℕ} (h : i < n) :
extend xs x i = xs[⟨i,h⟩] := dif_pos h

lemma extend_of_ge {n : ℕ} {xs : α ^ n} {x : α} {i : ℕ} (h : i ≥ n) :
extend xs x i = x := dif_neg (not_lt_of_ge h)

lemma bar_extend {n : ℕ} {xs : α ^ n} {x : α} :
bar (extend xs x) n = xs :=
ext (λ ⟨i,h⟩, extend_of_lt h)

end tup


import Rings.Rings
import Rings.Fields

-- import data.polynomial.eval
-- import data.mv_polynomial

namespace AxGroth

noncomputable theory

universe u

@[simp] def poly_map_data (K : Type) [comm_semiring K] (n : ℕ) : Type :=
fin n → mv_polynomial (fin n) K

def poly_map {K : Type} [comm_semiring K] {n : ℕ} :
  poly_map_data K n → (fin n → K) → (fin n → K) :=
λ ps as k, mv_polynomial.eval as (ps k)

open fol
open Rings

/-
-- takes x : A and for each xs : fin n → A appends x at the end,
-- then take the image
def image_append {A : Type u} [decidable_eq A] {n} :
  A → finset (fin n → A) → finset (fin n.succ → A) :=
λ x, finset.image (λ xs k, dite (↑k < n) (λ h, xs ⟨ k , h ⟩) (λ _ , x))
-/

def list_image_append {A : Type u} [decidable_eq A] {n} :
  A → list (fin n → A) → list (fin n.succ → A) :=
λ x, list.map (λ xs k, dite (↑k < n) (λ h, xs ⟨ k , h ⟩) (λ _ , x))

/-
def homog_basis (n d : ℕ) : set (fin n → ℕ) :=
{ f | finset.sum (finset.range n) (λ k, dite (k < n) (λ h, f ⟨ k , h ⟩) (λ h, 0)) = d }

-- #check finset.sum_fin_eq_sum_range
def homog_basis' (n d : ℕ) : set (fin n → ℕ) :=
{ f | finset.univ.sum (λ (k : fin n), f k) = d }
-/

/-
-- takes number of variables n and degree d and returns finite set
-- {f : fin n → ℕ | Σᵢ f i = d}
-- for each i : fin n, we read (f i) as the degree of the variable xᵢ
-- hence each f represents a monomial of degree d
def homog_basis'' : Π (n d : ℕ), finset (fin n → ℕ)
| 0 d := {fin_zero_elim}
| 1 d := {λ k, d}
| (n + 2) 0 := {λ k, 0}
| (n + 2) (d + 1) :=
  finset.bUnion (finset.range (d + 2)) (λ i, image_append i (homog_basis'' (n + 1) (d + 1 - i)))
-/

-- takes number of variables n and degree d and returns list representing the set
-- {f : fin n → ℕ | Σᵢ f i = d}
-- for each i : fin n, we read (f i) as the degree of the variable xᵢ
-- hence each f represents a monomial of degree d

/-- lists all n-variable monomials of degree d -/
@[simp] def homog_basis_list : Π (n d : ℕ), list (fin n → ℕ)
| 0 d := [fin_zero_elim]
| 1 d := [λ k, d]
| (n + 2) 0 := [λ k, 0]
| (n + 2) (d + 1) := list.join $ list.of_fn $
  λ i : fin (d + 2), list_image_append i (homog_basis_list (n + 1) (d + 1 - i))

/-- lists all n-variable monomials of degree < d -/
@[simp] def n_var_monomials_of_deg (n d : ℕ) : list (fin n → ℕ) :=
nat.natlist d (λ d', homog_basis_list n d')

-- counts all n-variable monomials of degree < d
@[simp] def n_var_monomials_of_deg_lt (n d : ℕ) : ℕ :=
list.length $ homog_basis_list n d
-- def n_var_monomials_of_deg_lt (n d : ℕ) : ℕ :=
-- finset.sum (finset.range d) (λ d', list.length $ homog_basis_list n d')

/-
def homog_dim'' (n d : ℕ) : ℕ := finset.card (homog_basis'' n d)

@[simp] def homog_dim : Π (n d : ℕ), ℕ
| 0 d := 0
| 1 d := 1
| (n + 2) 0 := 1
| (n + 2) (d + 1) :=
  finset.sum (finset.range (d + 2)) (λ i, homog_dim (n + 1) (d + 1 - i))
-/

/-
section

local attribute [instance] classical.prop_decidable

-- set of monomials (in n variables) of degree d.
def homog_basis''' (n d : ℕ) : finset (mv_polynomial (fin n) ℤ) :=
@finset.image (fin n → ℕ) (mv_polynomial (fin n) ℤ) _
  (λ ms : fin n → ℕ, big_mul (λ k : fin n, mv_polynomial.X k))
  (homog_basis'' n d)

-- set of monomials (in n variables) of degree < d
def monomials_of_bounded_degree'
  (n d : ℕ) : finset (mv_polynomial (fin n) ℤ) :=
finset.bUnion (finset.range d) (λ d', homog_basis''' n d')

-- indexing the set of monomials (in n variables) of degree at most d.
def monomials_of_bounded_degree (n d : ℕ) : ℕ :=
finset.card (monomials_of_bounded_degree' n d)

end
-/

-- TRIED LIST INSTEAD BECAUSE bounded_ring_term NOT COMMUTATIVE
-- def homog_poly_indexed_by_monos {n d : ℕ} (i : ℕ) :
--   bounded_ring_term (n * monomials_of_bounded_degree n d + 2 * n) :=
-- finset.sum (homog_basis'' n d)
--   (λ p, big_mul (λ j : fin n, x_ ⟨ j , _ ⟩))

#eval list.index_of 5 ([1,2])

#check list.mem_nil_iff

section

local attribute [instance] classical.prop_decidable

namespace list

def fin_index_of {α : Type u} (a : α) : Π (l : list α), (a ∈ l) → fin (list.length l)
| [] h :=
begin
  exfalso,
  rw ← list.mem_nil_iff a,
  apply h,
end
| (hd :: l) h := ⟨ list.index_of a (hd :: l) , begin rw list.index_of_lt_length, apply h end ⟩

-- λ a f, ⟨ list.index_of a f , (by rw list.index_of_lt_length; simp) ⟩

end list

-- #check nat.succ_le

-- def lemma_idk {α : Type u} {n d : ℕ} (l : list α) (x : ℕ) :
--  x
--  ≤ (n.succ * x + 2 * n.succ) :=
-- begin
--   induction n,
--   {
--     induction x with x hx,
--     {simp},
--     have hx' := nat.succ_le_succ hx,
--     apply nat.le_trans hx',
--     simp,

--   },
--   sorry

-- end

-- ∑ {f ∈ n_var_monomials_of_deg n.succ d} x₍ⱼ₊ₛ₎ ∏ {0 ≤ i < n} x₍ᵢ₊ₚ₎ᶠ⁽ⁱ⁾ in "context c"
-- where j is the index of f in n_var_monomials_of_deg n.succ d
def poly_indexed_by_monos (n d s p c : ℕ) (h : 0 < c) :
  bounded_ring_term c :=
-- sum indexed by the n-variable monomials of degree < d
list.sum
(list.map
  (λ f : (fin n.succ → ℕ),
    (x_ ⟨ (list.index_of f (n_var_monomials_of_deg n.succ d) + s) % c , nat.mod_lt _ h ⟩)
    *
    (nat.prod n.succ $ λ i, (x_ ⟨ (i + p) % c , nat.mod_lt _ h ⟩) ^ (f i) )
    )
(n_var_monomials_of_deg n.succ d))

-- NOTE s = 2 * n.succ
-- NOTE c = n.succ * n_var_monomials_of_deg_lt n.succ d + 2 * n.succ

end

-- finset.sum (homog_basis'' n d)
--  (λ p, big_mul (λ j : fin n, x_ ⟨ j , _ ⟩))

lemma inj_formula_aux {n d : ℕ} :
  0 < n.succ * n_var_monomials_of_deg_lt n.succ d + 2 * n.succ :=
begin
  apply nat.lt_add_left 0 (2 * n.succ) _ ,
  simp,
end

lemma inj_formula_aux' {n d : ℕ} :
  0 < n.succ * n_var_monomials_of_deg_lt n.succ d + n.succ + n.succ :=
begin
  apply nat.lt_add_left 0 (n.succ) _ ,
  simp,
end

-- in the context of having n.succ polynomials pⱼ indexed by
-- their monomial coefficients,
-- if for all xᵢ and all yᵢ, every polynomial satisfies pⱼ xᵢ = pⱼ yᵢ
-- then each xᵢ = yᵢ.
-- This says the polynomial map formed by the pⱼs is injective
def inj_formula (n d : ℕ) :
  bounded_ring_formula (n.succ * (n_var_monomials_of_deg_lt n.succ d)) :=
let c := n.succ * (n_var_monomials_of_deg_lt n.succ d) + 2 * n.succ,
    monom := n_var_monomials_of_deg_lt n.succ d in
-- for all pairs in the domain x₋ ∈ Kⁿ⁺¹ and y₋ ∈ Kⁿ⁺¹
bd_alls' (2 * n.succ) _
$
-- if at each pⱼ
(bd_big_and n.succ
-- pⱼ xᵢ = pⱼ yᵢ
  (λ j,
    (poly_indexed_by_monos n.succ d (2 * n.succ + j * monom) 0 _ inj_formula_aux)
    ≃
    (poly_indexed_by_monos n.succ d (2 * n.succ + j * monom) (n.succ) _ inj_formula_aux)
  )
)
-- then
⟹
-- at each 0 ≤ i < n.succ,
(bd_big_and n.succ $
-- xᵢ = yᵢ (where yᵢ is written as xᵢ₊ₙ₊₁)
  λ i, x_ ⟨ i % c , nat.mod_lt _ inj_formula_aux ⟩
  ≃
  x_ ⟨ (i + n.succ) % c , nat.mod_lt _ inj_formula_aux ⟩
)

def surj_formula (n d : ℕ) :
  bounded_ring_formula (n.succ * n_var_monomials_of_deg_lt n.succ d) :=
let monom := n_var_monomials_of_deg_lt n.succ d in
-- for all z₋ ∈ Kⁿ⁺¹ in the codomain
bd_alls' n.succ _
$
-- there exists x₋ ∈ Kⁿ⁺¹ in the domain such that
bd_exs' n.succ _
$
-- at each 0 ≤ j < n.succ
bd_big_and n.succ
$
-- zⱼ = pⱼ x₋
λ j, x_ j ≃ poly_indexed_by_monos n.succ d (n.succ + n.succ + j * monom) 0 _ inj_formula_aux'

def Ax_Groth_Formula {n d : ℕ} : sentence ring_signature :=
-- quantify over (n.succ) many (n.succ-variable polynomials) called ps;
-- i.e. the data of a polynomial map
-- by quantifying over (n.succ * monomials_of_bounded_degree) monomial coefficients
bd_alls (n.succ * (n_var_monomials_of_deg_lt n.succ d))
-- if the polynomial function is injective then it is surjective
$ inj_formula n d ⟹ surj_formula n d

theorem Ax_Grothendieck {K : Type} [field K] [is_alg_closed K]
  (h0 : char_zero K) {n : ℕ}
  (ps : poly_map_data K n) (hinj : function.injective (poly_map ps)) :
  function.surjective (poly_map ps) := sorry

end AxGroth


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

Type of functions with finite support.

Functions with finite support provide the basis for the following concrete instances:

 * ℕ →₀ α: Polynomials (where α is a ring)
 * (σ →₀ ℕ) →₀ α: Multivariate Polynomials (again α is a ring, and σ are variable names)
 * α →₀ ℕ: Multisets
 * α →₀ ℤ: Abelian groups freely generated by α
 * β →₀ α: Linear combinations over β where α is the scalar ring

Most of the theory assumes that the range is a commutative monoid. This gives us the big sum
operator as a powerful way to construct `finsupp` elements.

A general advice is to not use α →₀ β directly, as the type class setup might not be fitting.
The best is to define a copy and select the instances best suited.

-/
import data.finset data.set.finite algebra.big_operators algebra.module
open finset
variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*} {ι : Type*}
  {α₁ : Type*} {α₂ : Type*} {β₁ : Type*} {β₂ : Type*}

reserve infix ` →₀ `:25

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

infix →₀ := finsupp

namespace finsupp

section basic
variable [has_zero β]

instance : has_coe_to_fun (α →₀ β) := ⟨λ_, α → β, finsupp.to_fun⟩

instance : has_zero (α →₀ β) := ⟨⟨∅, (λ_, 0), by simp⟩⟩

@[simp] lemma zero_apply {a : α} : (0 : α →₀ β) a = 0 := rfl

@[simp] lemma support_zero : (0 : α →₀ β).support = ∅ := rfl

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

@[simp] lemma mem_support_iff (f : α →₀ β) : ∀a:α, a ∈ f.support ↔ f a ≠ 0 :=
f.mem_support_to_fun

@[extensionality]
lemma ext : ∀{f g : α →₀ β}, (∀a, f a = g a) → f = g
| ⟨s, f, hf⟩ ⟨t, g, hg⟩ h :=
  begin
    have : f = g, { funext a, exact h a },
    subst this,
    have : s = t, { simp [finset.ext, hf, hg] },
    subst this
  end

@[simp] lemma support_eq_empty [decidable_eq β] {f : α →₀ β} : f.support = ∅ ↔ f = 0 :=
⟨assume h, ext $ assume a, by simp [finset.ext] at h; exact h a, by simp {contextual:=tt}⟩

instance [decidable_eq α] [decidable_eq β] : decidable_eq (α →₀ β) :=
assume f g, decidable_of_iff (f.support = g.support ∧ (∀a∈f.support, f a = g a))
  ⟨assume ⟨h₁, h₂⟩, ext $ assume a,
      if h : a ∈ f.support then h₂ a h else
        have hf : f a = 0, by rwa [f.mem_support_iff, not_not] at h,
        have hg : g a = 0, by rwa [h₁, g.mem_support_iff, not_not] at h,
        by rw [hf, hg],
    by intro h; subst h; simp⟩

lemma finite_supp (f : α →₀ β) : set.finite {a | f a ≠ 0} :=
⟨set.fintype_of_finset f.support f.mem_support_iff⟩

lemma support_subset_iff {s : set α} {f : α →₀ β} [decidable_eq α] :
  ↑f.support ⊆ s ↔ (∀a∉s, f a = 0) :=
by simp [set.subset_def];
   exact forall_congr (assume a, @not_imp_comm _ _ (classical.dec _) (classical.dec _))

end basic

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

/-- `single a b` is the finitely supported function which has
  value `b` at `a` and zero otherwise. -/
def single (a : α) (b : β) : α →₀ β :=
⟨(if b = 0 then ∅ else {a}), (λa', if a = a' then b else 0),
  begin intro a', by_cases hb : b = 0; by_cases a = a'; simp [h, hb], simp [ne.symm h, h] end⟩

lemma single_apply : (single a b : α →₀ β) a' = (if a = a' then b else 0) :=
rfl

@[simp] lemma single_eq_same : (single a b : α →₀ β) a = b :=
by simp [single_apply]

@[simp] lemma single_eq_of_ne (h : a ≠ a') : (single a b : α →₀ β) a' = 0 :=
by simp [single_apply, h]

@[simp] lemma single_zero : (single a 0 : α →₀ β) = 0 :=
ext $ assume a',
begin
  by_cases h : a = a',
  { rw [h, single_eq_same, zero_apply] },
  { rw [single_eq_of_ne h, zero_apply] }
end

lemma support_single_ne_zero (hb : b ≠ 0) : (single a b).support = {a} :=
if_neg hb

lemma support_single_subset : (single a b).support ⊆ {a} :=
by by_cases b = 0; simp [support_single_ne_zero, h]

end single

section on_finset
variables [decidable_eq β] [has_zero β]

/-- `on_finset s f hf` is the finsupp function representing `f` restricted to the set `s`.
The function needs to be 0 outside of `s`. Use this when the set needs filtered anyway, otherwise
often better set representation is available. -/
def on_finset (s : finset α) (f : α → β) (hf : ∀a, f a ≠ 0 → a ∈ s) : α →₀ β :=
⟨s.filter (λa, f a ≠ 0), f,
  assume a, classical.by_cases
    (assume h : f a = 0, by simp [h])
    (assume h : f a ≠ 0, by simp [h, hf])⟩

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

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

end on_finset

section map_range
variables [has_zero β₁] [has_zero β₂] [decidable_eq β₂]

/-- The composition of `f : β₁ → β₂` and `g : α →₀ β₁` is
  `map_range f hf g : α →₀ β₂`, well defined when `f 0 = 0`. -/
def map_range (f : β₁ → β₂) (hf : f 0 = 0) (g : α →₀ β₁) : α →₀ β₂ :=
on_finset g.support (f ∘ g) $
  assume a, by rw [mem_support_iff, not_imp_not]; simp [hf] {contextual := tt}

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

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

variables [decidable_eq α] [decidable_eq β₁]
@[simp] lemma map_range_single {f : β₁ → β₂} {hf : f 0 = 0} {a : α} {b : β₁} :
  map_range f hf (single a b) = single a (f b) :=
finsupp.ext $ λ a', by by_cases a = a'; [{subst a', simp}, simp [h, hf]]

end map_range

section zip_with
variables [has_zero β] [has_zero β₁] [has_zero β₂] [decidable_eq α] [decidable_eq β]

/-- `zip_with f hf g₁ g₂` is the finitely supported function satisfying
  `zip_with f hf g₁ g₂ a = f (g₁ a) (g₂ a)`, and well defined when `f 0 0 = 0`. -/
def zip_with (f : β₁ → β₂ → β) (hf : f 0 0 = 0) (g₁ : α →₀ β₁) (g₂ : α →₀ β₂) : (α →₀ β) :=
on_finset (g₁.support ∪ g₂.support) (λa, f (g₁ a) (g₂ a)) $
  assume a, classical.by_cases
    (assume h : g₁ a = 0, by simp [h]; rw [not_imp_not]; simp [hf] {contextual := tt})
    (assume h : g₁ a ≠ 0, by simp [h])

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

lemma support_zip_with {f : β₁ → β₂ → β} {hf : f 0 0 = 0} {g₁ : α →₀ β₁} {g₂ : α →₀ β₂} :
  (zip_with f hf g₁ g₂).support ⊆ g₁.support ∪ g₂.support :=
support_on_finset_subset

end zip_with

section erase
variables [decidable_eq α] [decidable_eq β]

def erase [has_zero β] (a : α) (f : α →₀ β) : α →₀ β :=
⟨f.support.erase a, (λa', if a' = a then 0 else f a'),
  assume a', by by_cases a' = a; simp [h]⟩

@[simp] lemma support_erase [has_zero β] {a : α} {f : α →₀ β} :
  (f.erase a).support = f.support.erase a :=
rfl

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

@[simp] lemma erase_ne [has_zero β] {a a' : α} {f : α →₀ β} (h : a' ≠ a) : (f.erase a) a' = f a' :=
if_neg h

end erase

-- [to_additive finsupp.sum] for finsupp.prod doesn't work, the equation lemmas are not generated
/-- `sum f g` is the sum of `g a (f a)` over the support of `f`. -/
def sum [has_zero β] [add_comm_monoid γ] (f : α →₀ β) (g : α → β → γ) : γ :=
f.support.sum (λa, g a (f a))

/-- `prod f g` is the product of `g a (f a)` over the support of `f`. -/
@[to_additive finsupp.sum]
def prod [has_zero β] [comm_monoid γ] (f : α →₀ β) (g : α → β → γ) : γ :=
f.support.prod (λa, g a (f a))
attribute [to_additive finsupp.sum.equations._eqn_1] finsupp.prod.equations._eqn_1

@[to_additive finsupp.sum_map_range_index]
lemma prod_map_range_index [has_zero β₁] [has_zero β₂] [comm_monoid γ] [decidable_eq β₂]
  {f : β₁ → β₂} {hf : f 0 = 0} {g : α →₀ β₁} {h : α → β₂ → γ} (h0 : ∀a, h a 0 = 1) :
  (map_range f hf g).prod h = g.prod (λa b, h a (f b)) :=
finset.prod_subset support_map_range $ by simp [h0] {contextual := tt}

@[to_additive finsupp.sum_zero_index]
lemma prod_zero_index [add_comm_monoid β] [comm_monoid γ] {h : α → β → γ} :
  (0 : α →₀ β).prod h = 1 :=
by simp [finsupp.prod]

section decidable
variables [decidable_eq α] [decidable_eq β]

section add_monoid
variables [add_monoid β]

@[to_additive finsupp.sum_single_index]
lemma prod_single_index [comm_monoid γ] {a : α} {b : β} {h : α → β → γ} (h_zero : h a 0 = 1) :
  (single a b).prod h = h a b :=
begin
  by_cases h : b = 0,
  { simp [h, prod_zero_index, h_zero], refl },
  { simp [finsupp.prod, support_single_ne_zero h] }
end

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

@[simp] lemma add_apply {g₁ g₂ : α →₀ β} {a : α} : (g₁ + g₂) a = g₁ a + g₂ a :=
rfl

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

lemma support_add_eq {g₁ g₂ : α →₀ β} (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 * at *)
  (assume ha, have a ∉ g₁.support, from disjoint_right.1 h ha, by simp * at *)

@[simp] lemma single_add {a : α} {b₁ b₂ : β} : 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_monoid (α →₀ β) :=
{ add_monoid .
  zero      := 0,
  add       := (+),
  add_assoc := assume ⟨s, f, hf⟩ ⟨t, g, hg⟩ ⟨u, h, hh⟩, ext $ assume a, add_assoc _ _ _,
  zero_add  := assume ⟨s, f, hf⟩, ext $ assume a, zero_add _,
  add_zero  := assume ⟨s, f, hf⟩, ext $ assume a, add_zero _ }

lemma single_add_erase {a : α} {f : α →₀ β} : single a (f a) + f.erase a = f :=
ext $ λ a',
if h : a = a' then by subst h; simp
else by simp [ne.symm h, h]

lemma erase_add_single {a : α} {f : α →₀ β} : f.erase a + single a (f a) = f :=
ext $ λ a',
if h : a = a' then by subst h; simp
else by simp [ne.symm h, h]

protected theorem induction {p : (α →₀ β) → Prop} (f : α →₀ β)
  (h0 : p 0) (ha : ∀a b (f : α →₀ β), a ∉ f.support → b ≠ 0 → p f → p (single a b + f)) :
  p f :=
suffices ∀s (f : α →₀ β), f.support = s → p f, from this _ _ rfl,
assume s, finset.induction_on s (by simp [h0] {contextual := tt}) $
assume a s has ih f hf,
suffices p (single a (f a) + f.erase a), by rwa [single_add_erase] at this,
begin
  apply ha,
  { simp },
  { rw [← mem_support_iff _ a, hf], simp },
  { apply ih _ _,
    simp [hf, has, finset.erase_insert] }
end

lemma induction₂ {p : (α →₀ β) → Prop} (f : α →₀ β)
  (h0 : p 0) (ha : ∀a b (f : α →₀ β), a ∉ f.support → b ≠ 0 → p f → p (f + single a b)) :
  p f :=
suffices ∀s (f : α →₀ β), f.support = s → p f, from this _ _ rfl,
assume s, finset.induction_on s (by simp [h0] {contextual := tt}) $
assume a s has ih f hf,
suffices p (f.erase a + single a (f a)), by rwa [erase_add_single] at this,
begin
  apply ha,
  { simp },
  { rw [← mem_support_iff _ a, hf], simp },
  { apply ih _ _,
    simp [hf, has, finset.erase_insert] }
end

end add_monoid

instance [add_comm_monoid β] : add_comm_monoid (α →₀ β) :=
{ add_comm := assume ⟨s, f, _⟩ ⟨t, g, _⟩, ext $ assume a, add_comm _ _,
  .. finsupp.add_monoid }

instance [add_group β] : add_group (α →₀ β) :=
{ neg          := map_range (has_neg.neg) neg_zero,
  add_left_neg := assume ⟨s, f, _⟩, ext $ assume x, add_left_neg _,
  .. finsupp.add_monoid }

lemma single_multiset_sum [add_comm_monoid β] [decidable_eq α] [decidable_eq β]
  (s : multiset β) (a : α) : single a s.sum = (s.map (single a)).sum :=
multiset.induction_on s (by simp) (by simp {contextual := tt})

lemma single_finset_sum [add_comm_monoid β] [decidable_eq α] [decidable_eq β]
  (s : finset γ) (f : γ → β) (a : α) : single a (s.sum f) = s.sum (λb, single a (f b)) :=
begin
  transitivity,
  apply single_multiset_sum,
  rw [multiset.map_map],
  refl
end

lemma single_sum [has_zero γ] [add_comm_monoid β] [decidable_eq α] [decidable_eq β]
  (s : δ →₀ γ) (f : δ → γ → β) (a : α) : single a (s.sum f) = s.sum (λd c, single a (f d c)) :=
single_finset_sum _ _ _

@[to_additive finsupp.sum_neg_index]
lemma prod_neg_index [add_group β] [comm_monoid γ]
  {g : α →₀ β} {h : α → β → γ} (h0 : ∀a, h a 0 = 1) :
  (-g).prod h = g.prod (λa b, h a (- b)) :=
prod_map_range_index h0

@[simp] lemma neg_apply [add_group β] {g : α →₀ β} {a : α} : (- g) a = - g a := rfl

@[simp] lemma sub_apply [add_group β] {g₁ g₂ : α →₀ β} {a : α} : (g₁ - g₂) a = g₁ a - g₂ a := rfl

@[simp] lemma support_neg [add_group β] {f : α →₀ β} : support (-f) = support f :=
finset.subset.antisymm
  support_map_range
  (calc support f = support (- (- f)) : by simp
     ... ⊆ support (- f) : support_map_range)

instance [add_comm_group β] : add_comm_group (α →₀ β) :=
{ add_comm := add_comm, ..finsupp.add_group }

@[simp] lemma sum_apply [has_zero β₁] [add_comm_monoid β]
  {f : α₁ →₀ β₁} {g : α₁ → β₁ → α →₀ β} {a₂ : α} :
  (f.sum g) a₂ = f.sum (λa₁ b, g a₁ b a₂) :=
(finset.sum_hom (λf : α →₀ β, f a₂) rfl (assume a b, rfl)).symm

lemma support_sum [has_zero β₁] [add_comm_monoid β]
  {f : α₁ →₀ β₁} {g : α₁ → β₁ → (α →₀ β)} :
  (f.sum g).support ⊆ f.support.bind (λa, (g a (f a)).support) :=
have ∀a₁ : α, f.sum (λ (a : α₁) (b : β₁), (g a b) a₁) ≠ 0 →
    (∃ (a : α₁), f a ≠ 0 ∧ ¬ (g a (f a)) a₁ = 0),
  from assume a₁ h,
  let ⟨a, ha, ne⟩ := finset.exists_ne_zero_of_sum_ne_zero h in
  ⟨a, (f.mem_support_iff a).mp ha, ne⟩,
by simpa [finset.subset_iff, mem_support_iff, finset.mem_bind, sum_apply] using this

@[simp] lemma sum_zero [add_comm_monoid β] [add_comm_monoid γ] {f : α →₀ β} :
  f.sum (λa b, (0 : γ)) = 0 :=
finset.sum_const_zero

@[simp] lemma sum_add  [add_comm_monoid β] [add_comm_monoid γ] {f : α →₀ β}
  {h₁ h₂ : α → β → γ} :
  f.sum (λa b, h₁ a b + h₂ a b) = f.sum h₁ + f.sum h₂ :=
finset.sum_add_distrib

@[simp] lemma sum_neg [add_comm_monoid β] [add_comm_group γ] {f : α →₀ β}
  {h : α → β → γ} : f.sum (λa b, - h a b) = - f.sum h :=
finset.sum_hom (@has_neg.neg γ _) neg_zero (assume a b, neg_add _ _)

@[simp] lemma sum_single [add_comm_monoid β] {f : α →₀ β} :
  f.sum single = f :=
have ∀a:α, f.sum (λa' b, ite (a' = a) b 0) =
    ({a} : finset α).sum (λa', ite (a' = a) (f a') 0),
begin
  intro a,
  by_cases h : a ∈ f.support,
  { have : (finset.singleton a : finset α) ⊆ f.support,
      { simp [finset.subset_iff, *] at * },
    refine (finset.sum_subset this _).symm,
    simp {contextual := tt} },
  { transitivity (f.support.sum (λa, (0 : β))),
    { refine (finset.sum_congr rfl _),
      intros a' ha',
      have h: a' ≠ a,
        { assume eq, simp * at * },
      simp * at * },
    { simp * at * } }
end,
ext $ assume a, by simp [single_apply, this]

@[to_additive finsupp.sum_add_index]
lemma prod_add_index [add_comm_monoid β] [comm_monoid γ] {f g : α →₀ β}
  {h : α → β → γ} (h_zero : ∀a, h a 0 = 1) (h_add : ∀a b₁ b₂, h a (b₁ + b₂) = h a b₁ * h a b₂) :
  (f + g).prod h = f.prod h * g.prod h :=
have f_eq : (f.support ∪ g.support).prod (λa, h a (f a)) = f.prod h,
  from (finset.prod_subset finset.subset_union_left $
    by simp [mem_support_iff, h_zero] {contextual := tt}).symm,
have g_eq : (f.support ∪ g.support).prod (λa, h a (g a)) = g.prod h,
  from (finset.prod_subset finset.subset_union_right $
    by simp [mem_support_iff, h_zero] {contextual := tt}).symm,
calc (f + g).support.prod (λa, h a ((f + g) a)) =
      (f.support ∪ g.support).prod (λa, h a ((f + g) a)) :
    finset.prod_subset support_add $
      by simp [mem_support_iff, h_zero] {contextual := tt}
  ... = (f.support ∪ g.support).prod (λa, h a (f a)) *
      (f.support ∪ g.support).prod (λa, h a (g a)) :
    by simp [h_add, finset.prod_mul_distrib]
  ... = _ : by rw [f_eq, g_eq]

lemma sum_sub_index [add_comm_group β] [add_comm_group γ] {f g : α →₀ β}
  {h : α → β → γ} (h_sub : ∀a b₁ b₂, h a (b₁ - b₂) = h a b₁ - h a b₂) :
  (f - g).sum h = f.sum h - g.sum h :=
have h_zero : ∀a, h a 0 = 0,
  from assume a,
  have h a (0 - 0) = h a 0 - h a 0, from h_sub a 0 0,
  by simpa using this,
have h_neg : ∀a b, h a (- b) = - h a b,
  from assume a b,
  have h a (0 - b) = h a 0 - h a b, from h_sub a 0 b,
  by simpa [h_zero] using this,
have h_add : ∀a b₁ b₂, h a (b₁ + b₂) = h a b₁ + h a b₂,
  from assume a b₁ b₂,
  have h a (b₁ - (- b₂)) = h a b₁ - h a (- b₂), from h_sub a b₁ (-b₂),
  by simpa [h_neg] using this,
calc (f - g).sum h = (f + - g).sum h : by simp
  ... = f.sum h + - g.sum h : by simp [sum_add_index, sum_neg_index, h_add, h_zero, h_neg]
  ... = _ : by simp

@[to_additive finsupp.sum_finset_sum_index]
lemma prod_finset_sum_index [add_comm_monoid β] [comm_monoid γ] [decidable_eq ι]
  {s : finset ι} {g : ι → α →₀ β}
  {h : α → β → γ} (h_zero : ∀a, h a 0 = 1) (h_add : ∀a b₁ b₂, h a (b₁ + b₂) = h a b₁ * h a b₂):
  s.prod (λi, (g i).prod h) = (s.sum g).prod h :=
finset.induction_on s
  (by simp [prod_zero_index])
  (by simp [prod_add_index, h_zero, h_add] {contextual := tt})

@[to_additive finsupp.sum_sum_index]
lemma prod_sum_index
  [decidable_eq α₁] [add_comm_monoid β₁] [add_comm_monoid β] [comm_monoid γ]
  {f : α₁ →₀ β₁} {g : α₁ → β₁ → α →₀ β}
  {h : α → β → γ} (h_zero : ∀a, h a 0 = 1) (h_add : ∀a b₁ b₂, h a (b₁ + b₂) = h a b₁ * h a b₂):
  (f.sum g).prod h = f.prod (λa b, (g a b).prod h) :=
(prod_finset_sum_index h_zero h_add).symm

lemma multiset_sum_sum_index
  [decidable_eq α] [decidable_eq β] [add_comm_monoid β] [add_comm_monoid γ]
  (f : multiset (α →₀ β)) (h : α → β → γ)
  (h₀ : ∀a, h a 0 = 0) (h₁ : ∀ (a : α) (b₁ b₂ : β), h a (b₁ + b₂) = h a b₁ + h a b₂) :
  (f.sum.sum h) = (f.map $ λg:α →₀ β, g.sum h).sum :=
multiset.induction_on f (by simp [finsupp.sum_zero_index])
  (assume a s ih, by simp [finsupp.sum_add_index h₀ h₁, ih] {contextual := tt})

lemma multiset_map_sum [has_zero β] {f : α →₀ β} {m : γ → δ} {h : α → β → multiset γ} :
  multiset.map m (f.sum h) = f.sum (λa b, (h a b).map m) :=
(finset.sum_hom _ (multiset.map_zero m) (multiset.map_add m)).symm

lemma multiset_sum_sum [has_zero β] [add_comm_monoid γ] {f : α →₀ β} {h : α → β → multiset γ} :
  multiset.sum (f.sum h) = f.sum (λa b, multiset.sum (h a b)) :=
begin
  refine (finset.sum_hom multiset.sum _ _).symm,
  exact multiset.sum_zero,
  exact multiset.sum_add
end

section map_domain
variables [decidable_eq α₁] [decidable_eq α₂] [add_comm_monoid β] {v v₁ v₂ : α →₀ β}

/-- Given `f : α₁ → α₂` and `v : α₁ →₀ β`, `map_domain f v : α₂ →₀ β`
  is the finitely supported function whose value at `a : α₂` is the sum
  of `v x` over all `x` such that `f x = a`. -/
def map_domain (f : α₁ → α₂) (v : α₁ →₀ β) : α₂ →₀ β :=
v.sum $ λa, single (f a)

lemma map_domain_id : map_domain id v = v :=
sum_single

lemma map_domain_comp {f : α → α₁} {g : α₁ → α₂} :
  map_domain (g ∘ f) v = map_domain g (map_domain f v) :=
by simp [map_domain, sum_sum_index, sum_single_index]

lemma map_domain_single {f : α → α₁} {a : α} {b : β} : map_domain f (single a b) = single (f a) b :=
sum_single_index (by simp)

lemma map_domain_zero {f : α → α₂} : map_domain f 0 = (0 : α₂ →₀ β) :=
sum_zero_index

lemma map_domain_congr {f g : α → α₂} (h : ∀x∈v.support, f x = g x) :
  v.map_domain f = v.map_domain g :=
finset.sum_congr rfl $ by simp [*] at * {contextual := tt}

lemma map_domain_add {f : α → α₂} : map_domain f (v₁ + v₂) = map_domain f v₁ + map_domain f v₂ :=
sum_add_index (by simp) (by simp)

lemma map_domain_finset_sum [decidable_eq ι] {f : α → α₂} {s : finset ι} {v : ι → α →₀ β} :
  map_domain f (s.sum v) = s.sum (λi, map_domain f (v i)) :=
by refine (sum_finset_sum_index _ _).symm; simp

lemma map_domain_sum [has_zero β₁] {f : α → α₂} {s : α →₀ β₁} {v : α → β₁ → α →₀ β} :
  map_domain f (s.sum v) = s.sum (λa b, map_domain f (v a b)) :=
by refine (sum_finset_sum_index _ _).symm; simp

lemma map_domain_support {f : α → α₂} {s : α →₀ β} :
  (s.map_domain f).support ⊆ s.support.image f :=
finset.subset.trans support_sum $
  finset.subset.trans (finset.bind_mono $ assume a ha, support_single_subset) $
  by rw [finset.bind_singleton]; exact subset.refl _

@[to_additive finsupp.sum_map_domain_index]
lemma prod_map_domain_index [comm_monoid γ] {f : α → α₂} {s : α →₀ β}
  {h : α₂ → β → γ} (h_zero : ∀a, h a 0 = 1) (h_add : ∀a b₁ b₂, h a (b₁ + b₂) = h a b₁ * h a b₂) :
  (s.map_domain f).prod h = s.prod (λa b, h (f a) b) :=
by simp [map_domain, prod_sum_index, h_zero, h_add, prod_single_index]

end map_domain

/-- The product of `f g : α →₀ β` is the finitely supported function
  whose value at `a` is the sum of `f x * g y` over all pairs `x, y`
  such that `x + y = a`. (Think of the product of multivariate
  polynomials where `α` is the monoid of monomial exponents.) -/
instance [has_add α] [semiring β] : has_mul (α →₀ β) :=
⟨λf g, f.sum $ λa₁ b₁, g.sum $ λa₂ b₂, single (a₁ + a₂) (b₁ * b₂)⟩

lemma mul_def [has_add α] [semiring β] {f g : α →₀ β} :
  f * g = (f.sum $ λa₁ b₁, g.sum $ λa₂ b₂, single (a₁ + a₂) (b₁ * b₂)) := rfl

/-- The unit of the multiplication is `single 0 1`, i.e. the function
  that is 1 at 0 and zero elsewhere. -/
instance [has_zero α] [has_zero β] [has_one β] : has_one (α →₀ β) :=
⟨single 0 1⟩

lemma one_def [has_zero α] [has_zero β] [has_one β] : 1 = (single 0 1 : α →₀ β) := rfl

section filter -- TODO: remove filter? build upon subtype_domain?
section has_zero
variables [has_zero β] {p : α → Prop} [decidable_pred p] {f : α →₀ β}

/-- `filter p f` is the function which is `f a` if `p a` is true and 0 otherwise. -/
def filter (p : α → Prop) [decidable_pred p] (f : α →₀ β) : α →₀ β :=
on_finset f.support (λa, if p a then f a else 0) (assume a, by by_cases (p a); simp [h])

@[simp] lemma filter_apply_pos {a : α} (h : p a) : f.filter p a = f a :=
if_pos h

@[simp] lemma filter_apply_neg {a : α} (h : ¬ p a) : f.filter p a = 0 :=
if_neg h

@[simp] lemma support_filter : (f.filter p).support = f.support.filter p :=
finset.ext.mpr $ assume a, by by_cases p a; simp *

end has_zero

lemma filter_pos_add_filter_neg [add_monoid β] {f : α →₀ β} {p : α → Prop}
  [decidable_pred p] [decidable_pred (λa, ¬ p a)] :
  f.filter p + f.filter (λa, ¬ p a) = f :=
finsupp.ext $ assume a, by by_cases p a; simp *

end filter

section subtype_domain

variables {α' : Type*} [has_zero δ] {p : α → Prop} [decidable_pred p]

section zero
variables [has_zero β] {v v' : α' →₀ β}

/-- `subtype_domain p f` is the restriction of the finitely supported function
  `f` to the subtype `p`. -/
def subtype_domain (p : α → Prop) [decidable_pred p] (f : α →₀ β) : (subtype p →₀ β) :=
⟨f.support.subtype p, f ∘ subtype.val, by simp⟩

@[simp] lemma support_subtype_domain {f : α →₀ β} :
  (subtype_domain p f).support = f.support.subtype p :=
rfl

@[simp] lemma subtype_domain_apply {a : subtype p} {v : α →₀ β} :
  (subtype_domain p v) a = v (a.val) :=
rfl

@[simp] lemma subtype_domain_zero : subtype_domain p (0 : α →₀ β) = 0 :=
rfl

@[to_additive finsupp.sum_subtype_domain_index]
lemma prod_subtype_domain_index [comm_monoid γ] {v : α →₀ β}
  {h : α → β → γ} (hp : ∀x∈v.support, p x) :
  (v.subtype_domain p).prod (λa b, h a.1 b) = v.prod h :=
prod_bij (λp _, p.val)
  (by simp)
  (by simp)
  (assume ⟨a₀, ha₀⟩ ⟨a₁, ha₁⟩, by simp)
  (begin simp; exact assume b hb, ⟨b, hp _ (by simp [hb]), by simp [hb]⟩ end)

end zero

section monoid
variables [add_monoid β] {v v' : α' →₀ β}

@[simp] lemma subtype_domain_add {v v' : α →₀ β} :
  (v + v').subtype_domain p = v.subtype_domain p + v'.subtype_domain p :=
ext $ by simp

end monoid

section comm_monoid
variables [add_comm_monoid β]

lemma subtype_domain_sum {s : finset γ} {h : γ → α →₀ β} :
  (s.sum h).subtype_domain p = s.sum (λc, (h c).subtype_domain p) :=
eq.symm (finset.sum_hom _ subtype_domain_zero $ assume v v', subtype_domain_add)

lemma subtype_domain_finsupp_sum {s : γ →₀ δ} {h : γ → δ → α →₀ β} :
  (s.sum h).subtype_domain p = s.sum (λc d, (h c d).subtype_domain p) :=
subtype_domain_sum

end comm_monoid

section group
variables [add_group β] {v v' : α' →₀ β}

@[simp] lemma subtype_domain_neg {v : α →₀ β} :
  (- v).subtype_domain p = - v.subtype_domain p :=
ext $ by simp

@[simp] lemma subtype_domain_sub {v v' : α →₀ β} :
  (v - v').subtype_domain p = v.subtype_domain p - v'.subtype_domain p :=
ext $ by simp

end group

end subtype_domain

section multiset

def to_multiset (f : α →₀ ℕ) : multiset α :=
f.sum (λa n, add_monoid.smul n {a})

@[simp] lemma count_to_multiset [decidable_eq α] (f : α →₀ ℕ) (a : α) :
  f.to_multiset.count a = f a :=
calc f.to_multiset.count a = f.sum (λx n, (add_monoid.smul n {x} : multiset α).count a) :
    (finset.sum_hom _ (multiset.count_zero a) (multiset.count_add a)).symm
  ... = f.sum (λx n, n * ({x} : multiset α).count a) : by simp
  ... = f.sum (λx n, n * (x :: 0 : multiset α).count a) : rfl
  ... = f a * (a :: 0 : multiset α).count a :
    begin
      refine sum_eq_single _ _ _,
      { simp [multiset.count_cons_of_ne, nat.mul_eq_zero, multiset.count_eq_zero, eq_comm]
        {contextual := tt} },
      { simp }
    end
  ... = f a : by simp [multiset.count_singleton]

def of_multiset [decidable_eq α] (m : multiset α) : α →₀ ℕ :=
on_finset m.to_finset (λa, m.count a) $ by simp [multiset.count_eq_zero]

@[simp] lemma of_multiset_apply [decidable_eq α] (m : multiset α) (a : α) :
  of_multiset m a = m.count a :=
rfl

def equiv_multiset [decidable_eq α] : (α →₀ ℕ) ≃ (multiset α) :=
⟨ to_multiset, of_multiset, assume f, finsupp.ext $ by simp, assume m, multiset.ext.2 $ by simp ⟩

lemma mem_support_multiset_sum [decidable_eq α] [decidable_eq β] [add_comm_monoid β]
  {s : multiset (α →₀ β)} (a : α) :
  a ∈ s.sum.support → ∃f∈s, a ∈ (f : α →₀ β).support :=
multiset.induction_on s (by simp)
  begin
    assume f s ih ha,
    by_cases a ∈ f.support,
    { exact ⟨f, multiset.mem_cons_self _ _, h⟩ },
    { simp at h,
      simp [h] at ha,
      simp [ha] at ih,
      rcases ih with ⟨f', h₀, h₁⟩,
      exact ⟨f', multiset.mem_cons_of_mem h₀, by simpa using h₁⟩ }
  end

lemma mem_support_finset_sum [decidable_eq α] [decidable_eq β] [add_comm_monoid β]
  {s : finset γ} {h : γ → α →₀ β} (a : α) (ha : a ∈ (s.sum h).support) : ∃c∈s, a ∈ (h c).support :=
let ⟨f, hf, hfa⟩ := mem_support_multiset_sum a ha in
let ⟨c, hc, eq⟩ := multiset.mem_map.1 hf in
⟨c, hc, eq.symm ▸ hfa⟩

lemma mem_support_single [decidable_eq α] [decidable_eq β] [has_zero β] (a a' : α) (b : β) :
  a ∈ (single a' b).support ↔ a = a' ∧ b ≠ 0 :=
classical.by_cases
  (assume : b = 0, by simp [this])
  (assume : b ≠ 0, by simp [this, -mem_support_iff, support_single_ne_zero])

end multiset

section curry_uncurry

protected def curry [decidable_eq α] [decidable_eq β] [decidable_eq γ] [add_comm_monoid γ]
  (f : (α × β) →₀ γ) : α →₀ (β →₀ γ) :=
f.sum $ λp c, single p.1 (single p.2 c)

lemma sum_curry_index
  [decidable_eq α] [decidable_eq β] [decidable_eq γ] [add_comm_monoid γ] [add_comm_monoid δ]
  (f : (α × β) →₀ γ) (g : α → β → γ → δ)
  (hg₀ : ∀ a b, g a b 0 = 0) (hg₁ : ∀a b c₀ c₁, g a b (c₀ + c₁) = g a b c₀ + g a b c₁) :
  f.curry.sum (λa f, f.sum (g a)) = f.sum (λp c, g p.1 p.2 c) :=
begin
  rw [finsupp.curry],
  transitivity,
  { exact sum_sum_index (assume a, sum_zero_index)
      (assume a b₀ b₁, sum_add_index (assume a, hg₀ _ _) (assume c d₀ d₁, hg₁ _ _ _ _)) },
  congr, funext p c,
  transitivity,
  { exact sum_single_index sum_zero_index },
  exact sum_single_index (hg₀ _ _)
end

protected def uncurry [decidable_eq α] [decidable_eq β] [decidable_eq γ] [add_comm_monoid γ]
  (f : α →₀ (β →₀ γ)) : (α × β) →₀ γ :=
f.sum $ λa g, g.sum $ λb c, single (a, b) c

def finsupp_prod_equiv [add_comm_monoid γ] [decidable_eq α] [decidable_eq β] [decidable_eq γ] :
  ((α × β) →₀ γ) ≃ (α →₀ (β →₀ γ)) :=
⟨ finsupp.curry, finsupp.uncurry,
  assume f, by simp [finsupp.curry, finsupp.uncurry, sum_sum_index, sum_zero_index, sum_add_index,
    sum_single_index],
  assume f, by simp [finsupp.curry, finsupp.uncurry, sum_sum_index, sum_zero_index, sum_add_index,
    sum_single_index, (single_sum _ _ _).symm] ⟩

end curry_uncurry

section
variables [add_monoid α] [semiring β]

-- TODO: the simplifier unfolds 0 in the instance proof!
private lemma zero_mul (f : α →₀ β) : 0 * f = 0 := by simp [mul_def, sum_zero_index]
private lemma mul_zero (f : α →₀ β) : f * 0 = 0 := by simp [mul_def, sum_zero_index]
private lemma left_distrib (a b c : α →₀ β) : a * (b + c) = a * b + a * c :=
by simp [mul_def, sum_add_index, mul_add]
private lemma right_distrib (a b c : α →₀ β) : (a + b) * c = a * c + b * c :=
by simp [mul_def, sum_add_index, add_mul]

def to_semiring : semiring (α →₀ β) :=
{ one       := 1,
  mul       := (*),
  one_mul   := assume f, by simp [mul_def, one_def, sum_single_index],
  mul_one   := assume f, by simp [mul_def, one_def, sum_single_index],
  zero_mul  := zero_mul,
  mul_zero  := mul_zero,
  mul_assoc := assume f g h,
    by simp [mul_def, sum_sum_index, sum_zero_index, sum_add_index, sum_single_index,
        add_mul, mul_add, mul_assoc],
  left_distrib  := left_distrib,
  right_distrib := right_distrib,
  .. finsupp.add_comm_monoid }

end

local attribute [instance] to_semiring

def to_comm_semiring [add_comm_monoid α] [comm_semiring β] : comm_semiring (α →₀ β) :=
{ mul_comm := assume f g,
  begin
    simp [mul_def, finsupp.sum, mul_comm],
    rw [finset.sum_comm],
    simp
  end,
  .. finsupp.to_semiring }

local attribute [instance] to_comm_semiring

def to_ring [add_monoid α] [ring β] : ring (α →₀ β) :=
{ neg := has_neg.neg,
  add_left_neg := add_left_neg,
  .. finsupp.to_semiring }

def to_comm_ring [add_comm_monoid α] [comm_ring β] : comm_ring (α →₀ β) :=
{ mul_comm := mul_comm, .. finsupp.to_ring}

lemma single_mul_single [has_add α] [semiring β] {a₁ a₂ : α} {b₁ b₂ : β}:
  single a₁ b₁ * single a₂ b₂ = single (a₁ + a₂) (b₁ * b₂) :=
by simp [mul_def, sum_single_index]

lemma prod_single [decidable_eq ι] [add_comm_monoid α] [comm_semiring β]
  {s : finset ι} {a : ι → α} {b : ι → β} :
  s.prod (λi, single (a i) (b i)) = single (s.sum a) (s.prod b) :=
finset.induction_on s (by simp [one_def]) (by simp [single_mul_single] {contextual := tt})

section
variable (β)

def to_has_scalar' [ring γ] [module γ β] : has_scalar γ (α →₀ β) := ⟨λa v, v.map_range ((•) a) (smul_zero)⟩
local attribute [instance] to_has_scalar'

@[simp] lemma smul_apply' [ring γ] [module γ β] {a : α} {b : γ} {v : α →₀ β} :
  (b • v) a = b • (v a) := rfl

def to_module [ring γ] [module γ β] : module γ (α →₀ β) :=
{ smul     := (•),
  smul_add := assume a x y, finsupp.ext $ by simp [smul_add],
  add_smul := assume a x y, finsupp.ext $ by simp [add_smul],
  one_smul := assume x, finsupp.ext $ by simp,
  mul_smul := assume r s x, finsupp.ext $ by simp [smul_smul],
  .. finsupp.add_comm_group }

end

def to_has_scalar [ring β] : has_scalar β (α →₀ β) := to_has_scalar' β
local attribute [instance] to_has_scalar

@[simp] lemma smul_apply [ring β] {a : α} {b : β} {v : α →₀ β} :
  (b • v) a = b • (v a) := rfl

lemma sum_smul_index [ring β] [add_comm_monoid γ] {g : α →₀ β} {b : β} {h : α → β → γ}
  (h0 : ∀i, h i 0 = 0) : (b • g).sum h = g.sum (λi a, h i (b * a)) :=
finsupp.sum_map_range_index h0

end decidable

section
variables [semiring β] [semiring γ]

lemma sum_mul (b : γ) (s : α →₀ β) {f : α → β → γ} :
  (s.sum f) * b = s.sum (λ a c, (f a (s a)) * b) :=
by simp [finsupp.sum, finset.sum_mul]

lemma mul_sum [semiring β] [semiring γ] (b : γ) (s : α →₀ β) {f : α → β → γ} :
  b * (s.sum f) = s.sum (λ a c, b * (f a (s a))) :=
by simp [finsupp.sum, finset.mul_sum]

end

end finsupp


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

import data.set.Union_lift
import topology.homeomorph

/-!
# Continuous bundled maps

In this file we define the type `continuous_map` of continuous bundled maps.

We use the `fun_like` design, so each type of morphisms has a companion typeclass which is meant to
be satisfied by itself and all stricter types.
-/

open function

/-- The type of continuous maps from `α` to `β`.

When possible, instead of parametrizing results over `(f : C(α, β))`,
you should parametrize over `{F : Type*} [continuous_map_class F α β] (f : F)`.

When you extend this structure, make sure to extend `continuous_map_class`. -/
@[protect_proj]
structure continuous_map (α β : Type*) [topological_space α] [topological_space β] :=
(to_fun             : α → β)
(continuous_to_fun  : continuous to_fun . tactic.interactive.continuity')

notation `C(` α `, ` β `)` := continuous_map α β

/-- `continuous_map_class F α β` states that `F` is a type of continuous maps.

You should extend this class when you extend `continuous_map`. -/
class continuous_map_class (F : Type*) (α β : out_param $ Type*) [topological_space α]
  [topological_space β]
  extends fun_like F α (λ _, β) :=
(map_continuous (f : F) : continuous f)

export continuous_map_class (map_continuous)

attribute [continuity] map_continuous

section continuous_map_class
variables {F α β : Type*} [topological_space α] [topological_space β] [continuous_map_class F α β]
include β

lemma map_continuous_at (f : F) (a : α) : continuous_at f a := (map_continuous f).continuous_at

lemma map_continuous_within_at (f : F) (s : set α) (a : α) : continuous_within_at f s a :=
(map_continuous f).continuous_within_at

instance : has_coe_t F C(α, β) := ⟨λ f, { to_fun := f, continuous_to_fun := map_continuous f }⟩

end continuous_map_class

/-! ### Continuous maps-/

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

instance : continuous_map_class C(α, β) α β :=
{ coe := continuous_map.to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr',
  map_continuous := continuous_map.continuous_to_fun }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (C(α, β)) (λ _, α → β) := fun_like.has_coe_to_fun

@[simp] lemma to_fun_eq_coe {f : C(α, β)} : f.to_fun = (f : α → β) := rfl

@[ext]

/-- Copy of a `continuous_map` with a new `to_fun` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (f : C(α, β)) (f' : α → β) (h : f' = f) : C(α, β) :=
{ to_fun := f',
  continuous_to_fun := h.symm ▸ f.continuous_to_fun }

variables {α β} {f g : C(α, β)}

/-- Deprecated. Use `map_continuous` instead. -/
protected lemma continuous (f : C(α, β)) : continuous f := f.continuous_to_fun
@[continuity] lemma continuous_set_coe (s : set C(α, β)) (f : s) : continuous f := f.1.continuous

/-- Deprecated. Use `map_continuous_at` instead. -/
protected lemma continuous_at (f : C(α, β)) (x : α) : continuous_at f x :=
f.continuous.continuous_at

/-- Deprecated. Use `fun_like.congr_fun` instead. -/
protected lemma congr_fun {f g : C(α, β)} (H : f = g) (x : α) : f x = g x := H ▸ rfl
/-- Deprecated. Use `fun_like.congr_arg` instead. -/
protected lemma congr_arg (f : C(α, β)) {x y : α} (h : x = y) : f x = f y := h ▸ rfl

instance [inhabited β] : inhabited C(α, β) :=
⟨{ to_fun := λ _, default, }⟩

lemma coe_injective : @function.injective (C(α, β)) (α → β) coe_fn :=
λ f g h, by cases f; cases g; congr'

@[simp] lemma coe_mk (f : α → β) (h : continuous f) :
  ⇑(⟨f, h⟩ : C(α, β)) = f := rfl

section
variables (α β)

/--
The continuous functions from `α` to `β` are the same as the plain functions when `α` is discrete.
-/
@[simps]
def equiv_fn_of_discrete [discrete_topology α] : C(α, β) ≃ (α → β) :=
⟨(λ f, f), (λ f, ⟨f, continuous_of_discrete_topology⟩),
  λ f, by { ext, refl, }, λ f, by { ext, refl, }⟩

end

variables (α)

/-- The identity as a continuous map. -/
protected def id : C(α, α) := ⟨id⟩

@[simp] lemma coe_id : ⇑(continuous_map.id α) = id := rfl

/-- The constant map as a continuous map. -/
def const (b : β) : C(α, β) := ⟨const α b⟩

@[simp] lemma coe_const (b : β) : ⇑(const α b) = function.const α b := rfl

variables {α}

@[simp] lemma id_apply (a : α) : continuous_map.id α a = a := rfl
@[simp] lemma const_apply (b : β) (a : α) : const α b a = b := rfl

/-- The composition of continuous maps, as a continuous map. -/
def comp (f : C(β, γ)) (g : C(α, β)) : C(α, γ) := ⟨f ∘ g⟩

@[simp] lemma coe_comp (f : C(β, γ)) (g : C(α, β)) : ⇑(comp f g) = f ∘ g := rfl
@[simp] lemma comp_apply (f : C(β, γ)) (g : C(α, β)) (a : α) : comp f g a = f (g a) := rfl
@[simp] lemma comp_assoc (f : C(γ, δ)) (g : C(β, γ)) (h : C(α, β)) :
  (f.comp g).comp h = f.comp (g.comp h) := rfl
@[simp] lemma id_comp (f : C(α, β)) : (continuous_map.id _).comp f = f := ext $ λ _, rfl
@[simp] lemma comp_id (f : C(α, β)) : f.comp (continuous_map.id _) = f := ext $ λ _, rfl
@[simp] lemma const_comp (c : γ) (f : C(α, β)) : (const β c).comp f = const α c := ext $ λ _, rfl
@[simp] lemma comp_const (f : C(β, γ)) (b : β) : f.comp (const α b) = const α (f b) :=
ext $ λ _, rfl

lemma cancel_right {f₁ f₂ : C(β, γ)} {g : C(α, β)} (hg : surjective g) :
  f₁.comp g = f₂.comp g ↔ f₁ = f₂ :=
⟨λ h, ext $ hg.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩

lemma cancel_left {f : C(β, γ)} {g₁ g₂ : C(α, β)} (hf : injective f) :
  f.comp g₁ = f.comp g₂ ↔ g₁ = g₂ :=
⟨λ h, ext $ λ a, hf $ by rw [←comp_apply, h, comp_apply], congr_arg _⟩

instance [nonempty α] [nontrivial β] : nontrivial C(α, β) :=
⟨let ⟨b₁, b₂, hb⟩ := exists_pair_ne β in
    ⟨const _ b₁, const _ b₂, λ h, hb $ fun_like.congr_fun h $ classical.arbitrary α⟩⟩

section prod

variables {α₁ α₂ β₁ β₂ : Type*}
          [topological_space α₁] [topological_space α₂]
          [topological_space β₁] [topological_space β₂]

/-- Given two continuous maps `f` and `g`, this is the continuous map `x ↦ (f x, g x)`. -/
def prod_mk (f : C(α, β₁)) (g : C(α, β₂)) :
  C(α, β₁ × β₂) :=
{ to_fun := (λ x, (f x, g x)),
  continuous_to_fun := continuous.prod_mk f.continuous g.continuous }

/-- Given two continuous maps `f` and `g`, this is the continuous map `(x, y) ↦ (f x, g y)`. -/
def prod_map (f : C(α₁, α₂)) (g : C(β₁, β₂)) :
  C(α₁ × β₁, α₂ × β₂) :=
{ to_fun := prod.map f g,
  continuous_to_fun := continuous.prod_map f.continuous g.continuous }

@[simp] lemma prod_eval (f : C(α, β₁)) (g : C(α, β₂)) (a : α) :
  (prod_mk f g) a = (f a, g a) := rfl

end prod

section pi

variables {I A : Type*} {X : I → Type*}
          [topological_space A] [∀ i, topological_space (X i)]

/-- Abbreviation for product of continuous maps, which is continuous -/
def pi (f : Π i, C(A, X i)) : C(A, Π i, X i) :=
{ to_fun := λ (a : A) (i : I), f i a, }

@[simp] lemma pi_eval (f : Π i, C(A, X i)) (a : A) :
  (pi f) a = λ i : I, (f i) a := rfl

end pi

section restrict

variables (s : set α)

/-- The restriction of a continuous function `α → β` to a subset `s` of `α`. -/
def restrict (f : C(α, β)) : C(s, β) := ⟨f ∘ coe⟩

@[simp] lemma coe_restrict (f : C(α, β)) : ⇑(f.restrict s) = f ∘ coe := rfl

end restrict

section gluing

variables {ι : Type*}
  (S : ι → set α)
  (φ : Π i : ι, C(S i, β))
  (hφ : ∀ i j (x : α) (hxi : x ∈ S i) (hxj : x ∈ S j), φ i ⟨x, hxi⟩ = φ j ⟨x, hxj⟩)
  (hS : ∀ x : α, ∃ i, S i ∈ nhds x)

include hφ hS

/-- A family `φ i` of continuous maps `C(S i, β)`, where the domains `S i` contain a neighbourhood
of each point in `α` and the functions `φ i` agree pairwise on intersections, can be glued to
construct a continuous map in `C(α, β)`. -/
noncomputable def lift_cover : C(α, β) :=
begin
  have H : (⋃ i, S i) = set.univ,
  { rw set.eq_univ_iff_forall,
    intros x,
    rw set.mem_Union,
    obtain ⟨i, hi⟩ := hS x,
    exact ⟨i, mem_of_mem_nhds hi⟩ },
  refine ⟨set.lift_cover S (λ i, φ i) hφ H, continuous_subtype_nhds_cover hS _⟩,
  intros i,
  convert (φ i).continuous,
  ext x,
  exact set.lift_cover_coe x,
end

variables {S φ hφ hS}

@[simp] lemma lift_cover_coe {i : ι} (x : S i) : lift_cover S φ hφ hS x = φ i x :=
set.lift_cover_coe _

@[simp] lemma lift_cover_restrict {i : ι} : (lift_cover S φ hφ hS).restrict (S i) = φ i :=
ext $ lift_cover_coe

omit hφ hS

variables (A : set (set α))
  (F : Π (s : set α) (hi : s ∈ A), C(s, β))
  (hF : ∀ s (hs : s ∈ A) t (ht : t ∈ A) (x : α) (hxi : x ∈ s) (hxj : x ∈ t),
    F s hs ⟨x, hxi⟩ = F t ht ⟨x, hxj⟩)
  (hA : ∀ x : α, ∃ i ∈ A, i ∈ nhds x)

include hF hA

/-- A family `F s` of continuous maps `C(s, β)`, where (1) the domains `s` are taken from a set `A`
of sets in `α` which contain a neighbourhood of each point in `α` and (2) the functions `F s` agree
pairwise on intersections, can be glued to construct a continuous map in `C(α, β)`. -/
noncomputable def lift_cover' : C(α, β) :=
begin
  let S : A → set α := coe,
  let F : Π i : A, C(i, β) := λ i, F i i.prop,
  refine lift_cover S F (λ i j, hF i i.prop j j.prop) _,
  intros x,
  obtain ⟨s, hs, hsx⟩ := hA x,
  exact ⟨⟨s, hs⟩, hsx⟩
end

variables {A F hF hA}

@[simp] lemma lift_cover_coe' {s : set α} {hs : s ∈ A} (x : s) :
  lift_cover' A F hF hA x = F s hs x :=
let x' : (coe : A → set α) ⟨s, hs⟩ := x in lift_cover_coe x'

@[simp] lemma lift_cover_restrict' {s : set α} {hs : s ∈ A} :
  (lift_cover' A F hF hA).restrict s = F s hs :=
ext $ lift_cover_coe'

end gluing

end continuous_map

/--
The forward direction of a homeomorphism, as a bundled continuous map.
-/
@[simps]
def homeomorph.to_continuous_map {α β : Type*} [topological_space α] [topological_space β]
  (e : α ≃ₜ β) : C(α, β) := ⟨e⟩


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

import topology.continuous_on

/-!
# Bases of topologies. Countability axioms.

A topological basis on a topological space `t` is a collection of sets,
such that all open sets can be generated as unions of these sets, without the need to take
finite intersections of them. This file introduces a framework for dealing with these collections,
and also what more we can say under certain countability conditions on bases,
which are referred to as first- and second-countable.
We also briefly cover the theory of separable spaces, which are those with a countable, dense
subset. If a space is second-countable, and also has a countably generated uniformity filter
(for example, if `t` is a metric space), it will automatically be separable (and indeed, these
conditions are equivalent in this case).

## Main definitions

* `is_topological_basis s`: The topological space `t` has basis `s`.
* `separable_space α`: The topological space `t` has a countable, dense subset.
* `first_countable_topology α`: A topology in which `𝓝 x` is countably generated for every `x`.
* `second_countable_topology α`: A topology which has a topological basis which is countable.

## Main results

* `first_countable_topology.tendsto_subseq`: In a first-countable space,
  cluster points are limits of subsequences.
* `second_countable_topology.is_open_Union_countable`: In a second-countable space, the union of
  arbitrarily-many open sets is equal to a sub-union of only countably many of these sets.
* `second_countable_topology.countable_cover_nhds`: Consider `f : α → set α` with the property that
  `f x ∈ 𝓝 x` for all `x`. Then there is some countable set `s` whose image covers the space.

## Implementation Notes
For our applications we are interested that there exists a countable basis, but we do not need the
concrete basis itself. This allows us to declare these type classes as `Prop` to use them as mixins.

### TODO:
More fine grained instances for `first_countable_topology`, `separable_space`, `t2_space`, and more
(see the comment below `subtype.second_countable_topology`.)
-/

open set filter classical
open_locale topological_space filter
noncomputable theory

namespace topological_space

universe u
variables {α : Type u} [t : topological_space α]
include t

/-- A topological basis is one that satisfies the necessary conditions so that
  it suffices to take unions of the basis sets to get a topology (without taking
  finite intersections as well). -/
structure is_topological_basis (s : set (set α)) : Prop :=
(exists_subset_inter : ∀t₁∈s, ∀t₂∈s, ∀ x ∈ t₁ ∩ t₂, ∃ t₃∈s, x ∈ t₃ ∧ t₃ ⊆ t₁ ∩ t₂)
(sUnion_eq : (⋃₀ s) = univ)
(eq_generate_from : t = generate_from s)

/-- If a family of sets `s` generates the topology, then nonempty intersections of finite
subcollections of `s` form a topological basis. -/
lemma is_topological_basis_of_subbasis {s : set (set α)} (hs : t = generate_from s) :
  is_topological_basis ((λ f, ⋂₀ f) '' {f : set (set α) | finite f ∧ f ⊆ s ∧ (⋂₀ f).nonempty}) :=
begin
  refine ⟨_, _, _⟩,
  { rintro _ ⟨t₁, ⟨hft₁, ht₁b, ht₁⟩, rfl⟩ _ ⟨t₂, ⟨hft₂, ht₂b, ht₂⟩, rfl⟩ x h,
    have : ⋂₀ (t₁ ∪ t₂) = ⋂₀ t₁ ∩ ⋂₀ t₂ := sInter_union t₁ t₂,
    exact ⟨_, ⟨t₁ ∪ t₂, ⟨hft₁.union hft₂, union_subset ht₁b ht₂b, this.symm ▸ ⟨x, h⟩⟩, this⟩, h,
      subset.rfl⟩ },
  { rw [sUnion_image, bUnion_eq_univ_iff],
    intro x, have : x ∈ ⋂₀ ∅, { rw sInter_empty, exact mem_univ x },
    exact ⟨∅, ⟨finite_empty, empty_subset _, x, this⟩, this⟩ },
  { rw hs,
    apply le_antisymm; apply le_generate_from,
    { rintro _ ⟨t, ⟨hft, htb, ht⟩, rfl⟩,
      exact @is_open_sInter _ (generate_from s) _ hft (λ s hs, generate_open.basic _ $ htb hs) },
    { intros t ht,
      rcases t.eq_empty_or_nonempty with rfl|hne, { apply @is_open_empty _ _ },
      rw ← sInter_singleton t at hne ⊢,
      exact generate_open.basic _ ⟨{t}, ⟨finite_singleton t, singleton_subset_iff.2 ht, hne⟩,
        rfl⟩ } }
end

/-- If a family of open sets `s` is such that every open neighbourhood contains some
member of `s`, then `s` is a topological basis. -/
lemma is_topological_basis_of_open_of_nhds {s : set (set α)}
  (h_open : ∀ u ∈ s, is_open u)
  (h_nhds : ∀(a:α) (u : set α), a ∈ u → is_open u → ∃v ∈ s, a ∈ v ∧ v ⊆ u) :
  is_topological_basis s :=
begin
  refine ⟨λ t₁ ht₁ t₂ ht₂ x hx, h_nhds _ _ hx (is_open_inter (h_open _ ht₁) (h_open _ ht₂)), _, _⟩,
  { refine sUnion_eq_univ_iff.2 (λ a, _),
    rcases h_nhds a univ trivial is_open_univ with ⟨u, h₁, h₂, -⟩,
    exact ⟨u, h₁, h₂⟩ },
  { refine (le_generate_from h_open).antisymm (λ u hu, _),
    refine (@is_open_iff_nhds α (generate_from s) u).mpr (λ a ha, _),
    rcases h_nhds a u ha hu with ⟨v, hvs, hav, hvu⟩,
    rw nhds_generate_from,
    exact binfi_le_of_le v ⟨hav, hvs⟩ (le_principal_iff.2 hvu) }
end

/-- A set `s` is in the neighbourhood of `a` iff there is some basis set `t`, which
contains `a` and is itself contained in `s`. -/
lemma is_topological_basis.mem_nhds_iff {a : α} {s : set α} {b : set (set α)}
  (hb : is_topological_basis b) : s ∈ 𝓝 a ↔ ∃t∈b, a ∈ t ∧ t ⊆ s :=
begin
  change s ∈ (𝓝 a).sets ↔ ∃t∈b, a ∈ t ∧ t ⊆ s,
  rw [hb.eq_generate_from, nhds_generate_from, binfi_sets_eq],
  { simp only [mem_bUnion_iff, exists_prop, mem_set_of_eq, and_assoc, and.left_comm], refl },
  { exact assume s ⟨hs₁, hs₂⟩ t ⟨ht₁, ht₂⟩,
      have a ∈ s ∩ t, from ⟨hs₁, ht₁⟩,
      let ⟨u, hu₁, hu₂, hu₃⟩ := hb.1 _ hs₂ _ ht₂ _ this in
      ⟨u, ⟨hu₂, hu₁⟩, le_principal_iff.2 (subset.trans hu₃ (inter_subset_left _ _)),
        le_principal_iff.2 (subset.trans hu₃ (inter_subset_right _ _))⟩ },
  { rcases eq_univ_iff_forall.1 hb.sUnion_eq a with ⟨i, h1, h2⟩,
    exact ⟨i, h2, h1⟩ }
end

lemma is_topological_basis.nhds_has_basis {b : set (set α)} (hb : is_topological_basis b) {a : α} :
  (𝓝 a).has_basis (λ t : set α, t ∈ b ∧ a ∈ t) (λ t, t) :=
⟨λ s, hb.mem_nhds_iff.trans $ by simp only [exists_prop, and_assoc]⟩

protected lemma is_topological_basis.is_open {s : set α} {b : set (set α)}
  (hb : is_topological_basis b) (hs : s ∈ b) : is_open s :=
by { rw hb.eq_generate_from, exact generate_open.basic s hs }

lemma is_topological_basis.exists_subset_of_mem_open {b : set (set α)}
  (hb : is_topological_basis b) {a:α} {u : set α} (au : a ∈ u)
  (ou : is_open u) : ∃v ∈ b, a ∈ v ∧ v ⊆ u :=
hb.mem_nhds_iff.1 $ mem_nhds_sets ou au

 /-- Any open set is the union of the basis sets contained in it. -/
lemma is_topological_basis.open_eq_sUnion' {B : set (set α)}
  (hB : is_topological_basis B) {u : set α} (ou : is_open u) :
  u = ⋃₀ {s ∈ B | s ⊆ u} :=
ext $ λ a,
⟨λ ha, let ⟨b, hb, ab, bu⟩ := hB.exists_subset_of_mem_open ha ou in ⟨b, ⟨hb, bu⟩, ab⟩,
  λ ⟨b, ⟨hb, bu⟩, ab⟩, bu ab⟩

lemma is_topological_basis.open_eq_sUnion {B : set (set α)}
  (hB : is_topological_basis B) {u : set α} (ou : is_open u) :
  ∃ S ⊆ B, u = ⋃₀ S :=
⟨{s ∈ B | s ⊆ u}, λ s h, h.1, hB.open_eq_sUnion' ou⟩

lemma is_topological_basis.open_eq_Union {B : set (set α)}
  (hB : is_topological_basis B) {u : set α} (ou : is_open u) :
  ∃ (β : Type u) (f : β → set α), u = (⋃ i, f i) ∧ ∀ i, f i ∈ B :=
⟨↥{s ∈ B | s ⊆ u}, coe, by { rw ← sUnion_eq_Union, apply hB.open_eq_sUnion' ou }, λ s, and.left s.2⟩

 /-- A point `a` is in the closure of `s` iff all basis sets containing `a` intersect `s`. -/
lemma is_topological_basis.mem_closure_iff {b : set (set α)} (hb : is_topological_basis b)
  {s : set α} {a : α} :
  a ∈ closure s ↔ ∀ o ∈ b, a ∈ o → (o ∩ s).nonempty :=
(mem_closure_iff_nhds_basis' hb.nhds_has_basis).trans $ by simp only [and_imp]

 /-- A set is dense iff it has non-trivial intersection with all basis sets. -/
lemma is_topological_basis.dense_iff {b : set (set α)} (hb : is_topological_basis b) {s : set α} :
  dense s ↔ ∀ o ∈ b, set.nonempty o → (o ∩ s).nonempty :=
begin
  simp only [dense, hb.mem_closure_iff],
  exact ⟨λ h o hb ⟨a, ha⟩, h a o hb ha, λ h a o hb ha, h o hb ⟨a, ha⟩⟩
end

protected lemma is_topological_basis.prod {β} [topological_space β] {B₁ : set (set α)}
  {B₂ : set (set β)} (h₁ : is_topological_basis B₁) (h₂ : is_topological_basis B₂) :
  is_topological_basis (image2 set.prod B₁ B₂) :=
begin
  refine is_topological_basis_of_open_of_nhds _ _,
  { rintro _ ⟨u₁, u₂, hu₁, hu₂, rfl⟩,
    exact (h₁.is_open hu₁).prod (h₂.is_open hu₂) },
  { rintro ⟨a, b⟩ u hu uo,
    rcases (h₁.nhds_has_basis.prod_nhds h₂.nhds_has_basis).mem_iff.1 (mem_nhds_sets uo hu)
      with ⟨⟨s, t⟩, ⟨⟨hs, ha⟩, ht, hb⟩, hu⟩,
    exact ⟨s.prod t, mem_image2_of_mem hs ht, ⟨ha, hb⟩, hu⟩ }
end

lemma is_topological_basis_of_cover {ι} {U  : ι → set α} (Uo : ∀ i, is_open (U i))
  (Uc : (⋃ i, U i) = univ) {b : Π i, set (set (U i))} (hb : ∀ i, is_topological_basis (b i)) :
  is_topological_basis (⋃ i : ι, image (coe : U i → α) '' (b i)) :=
begin
  refine is_topological_basis_of_open_of_nhds (λ u hu, _) _,
  { simp only [mem_Union, mem_image] at hu,
    rcases hu with ⟨i, s, sb, rfl⟩,
    exact (Uo i).is_open_map_subtype_coe _ ((hb i).is_open sb) },
  { intros a u ha uo,
    rcases Union_eq_univ_iff.1 Uc a with ⟨i, hi⟩,
    lift a to ↥(U i) using hi,
    rcases (hb i).exists_subset_of_mem_open (by exact ha) (uo.preimage continuous_subtype_coe)
      with ⟨v, hvb, hav, hvu⟩,
    exact ⟨coe '' v, mem_Union.2 ⟨i, mem_image_of_mem _ hvb⟩, mem_image_of_mem _ hav,
      image_subset_iff.2 hvu⟩ }
end

variables (α)

/-- A separable space is one with a countable dense subset, available through
`topological_space.exists_countable_dense`. If `α` is also known to be nonempty, then
`topological_space.dense_seq` provides a sequence `ℕ → α` with dense range, see
`topological_space.dense_range_dense_seq`.

If `α` is a uniform space with countably generated uniformity filter (e.g., an `emetric_space`),
then this condition is equivalent to `topological_space.second_countable_topology α`. In this case
the latter should be used as a typeclass argument in theorems because Lean can automatically deduce
`separable_space` from `second_countable_topology` but it can't deduce `second_countable_topology`
and `emetric_space`. -/
class separable_space : Prop :=
(exists_countable_dense : ∃s:set α, countable s ∧ dense s)

lemma exists_countable_dense [separable_space α] :
  ∃ s : set α, countable s ∧ dense s :=
separable_space.exists_countable_dense

/-- A nonempty separable space admits a sequence with dense range. Instead of running `cases` on the
conclusion of this lemma, you might want to use `topological_space.dense_seq` and
`topological_space.dense_range_dense_seq`.

If `α` might be empty, then `exists_countable_dense` is the main way to use separability of `α`. -/
lemma exists_dense_seq [separable_space α] [nonempty α] : ∃ u : ℕ → α, dense_range u :=
begin
  obtain ⟨s : set α, hs, s_dense⟩ := exists_countable_dense α,
  cases countable_iff_exists_surjective.mp hs with u hu,
  exact ⟨u, s_dense.mono hu⟩,
end

/-- A dense sequence in a non-empty separable topological space.

If `α` might be empty, then `exists_countable_dense` is the main way to use separability of `α`. -/
def dense_seq [separable_space α] [nonempty α] : ℕ → α := classical.some (exists_dense_seq α)

/-- The sequence `dense_seq α` has dense range. -/
@[simp] lemma dense_range_dense_seq [separable_space α] [nonempty α] :
  dense_range (dense_seq α) := classical.some_spec (exists_dense_seq α)

end topological_space

open topological_space

/-- If `α` is a separable space and `f : α → β` is a continuous map with dense range, then `β` is
a separable space as well. E.g., the completion of a separable uniform space is separable. -/
protected lemma dense_range.separable_space {α β : Type*} [topological_space α] [separable_space α]
  [topological_space β] {f : α → β} (h : dense_range f) (h' : continuous f) :
  separable_space β :=
let ⟨s, s_cnt, s_dense⟩ := exists_countable_dense α in
⟨⟨f '' s, countable.image s_cnt f, h.dense_image h' s_dense⟩⟩

namespace topological_space
universe u
variables (α : Type u) [t : topological_space α]
include t

/-- A first-countable space is one in which every point has a
  countable neighborhood basis. -/
class first_countable_topology : Prop :=
(nhds_generated_countable : ∀a:α, (𝓝 a).is_countably_generated)

namespace first_countable_topology
variable {α}

/-- In a first-countable space, a cluster point `x` of a sequence
is the limit of some subsequence. -/
lemma tendsto_subseq [first_countable_topology α] {u : ℕ → α} {x : α}
  (hx : map_cluster_pt x at_top u) :
  ∃ (ψ : ℕ → ℕ), (strict_mono ψ) ∧ (tendsto (u ∘ ψ) at_top (𝓝 x)) :=
(nhds_generated_countable x).subseq_tendsto hx

end first_countable_topology

variables {α}

lemma is_countably_generated_nhds [first_countable_topology α] (x : α) :
  is_countably_generated (𝓝 x) :=
first_countable_topology.nhds_generated_countable x

lemma is_countably_generated_nhds_within [first_countable_topology α] (x : α) (s : set α) :
  is_countably_generated (𝓝[s] x) :=
(is_countably_generated_nhds x).inf_principal s

variable (α)

/-- A second-countable space is one with a countable basis. -/
class second_countable_topology : Prop :=
(is_open_generated_countable [] :
  ∃ b : set (set α), countable b ∧ t = topological_space.generate_from b)

variable {α}

protected lemma is_topological_basis.second_countable_topology
  {b : set (set α)} (hb : is_topological_basis b) (hc : countable b) :
  second_countable_topology α :=
⟨⟨b, hc, hb.eq_generate_from⟩⟩

variable (α)

lemma exists_countable_basis [second_countable_topology α] :
  ∃b:set (set α), countable b ∧ ∅ ∉ b ∧ is_topological_basis b :=
let ⟨b, hb₁, hb₂⟩ := second_countable_topology.is_open_generated_countable α in
let b' := (λs, ⋂₀ s) '' {s:set (set α) | finite s ∧ s ⊆ b ∧ (⋂₀ s).nonempty} in
⟨b',
  ((countable_set_of_finite_subset hb₁).mono
    (by { simp only [← and_assoc], apply inter_subset_left })).image _,
  assume ⟨s, ⟨_, _, hn⟩, hp⟩, absurd hn (not_nonempty_iff_eq_empty.2 hp),
  is_topological_basis_of_subbasis hb₂⟩

/-- A countable topological basis of `α`. -/
def countable_basis [second_countable_topology α] : set (set α) :=
(exists_countable_basis α).some

lemma countable_countable_basis [second_countable_topology α] : countable (countable_basis α) :=
(exists_countable_basis α).some_spec.1

instance encodable_countable_basis [second_countable_topology α] :
  encodable (countable_basis α) :=
(countable_countable_basis α).to_encodable

lemma empty_nmem_countable_basis [second_countable_topology α] : ∅ ∉ countable_basis α :=
(exists_countable_basis α).some_spec.2.1

lemma is_basis_countable_basis [second_countable_topology α] :
  is_topological_basis (countable_basis α) :=
(exists_countable_basis α).some_spec.2.2

lemma eq_generate_from_countable_basis [second_countable_topology α] :
  ‹topological_space α› = generate_from (countable_basis α) :=
(is_basis_countable_basis α).eq_generate_from

variable {α}

lemma is_open_of_mem_countable_basis [second_countable_topology α] {s : set α}
  (hs : s ∈ countable_basis α) : is_open s :=
(is_basis_countable_basis α).is_open hs

lemma nonempty_of_mem_countable_basis [second_countable_topology α] {s : set α}
  (hs : s ∈ countable_basis α) : s.nonempty :=
ne_empty_iff_nonempty.1 $ ne_of_mem_of_not_mem hs $ empty_nmem_countable_basis α

variable (α)

@[priority 100] -- see Note [lower instance priority]
instance second_countable_topology.to_first_countable_topology
  [second_countable_topology α] : first_countable_topology α :=
⟨λ x, has_countable_basis.is_countably_generated $
  ⟨(is_basis_countable_basis α).nhds_has_basis, (countable_countable_basis α).mono $
    inter_subset_left _ _⟩⟩

/-- If `β` is a second-countable space, then its induced topology
via `f` on `α` is also second-countable. -/
lemma second_countable_topology_induced (β)
  [t : topological_space β] [second_countable_topology β] (f : α → β) :
  @second_countable_topology α (t.induced f) :=
begin
  rcases second_countable_topology.is_open_generated_countable β with ⟨b, hb, eq⟩,
  refine { is_open_generated_countable := ⟨preimage f '' b, hb.image _, _⟩ },
  rw [eq, induced_generate_from_eq]
end

instance subtype.second_countable_topology (s : set α) [second_countable_topology α] :
  second_countable_topology s :=
second_countable_topology_induced s α coe

/- TODO: more fine grained instances for first_countable_topology, separable_space, t2_space, ... -/
instance {β : Type*} [topological_space β]
  [second_countable_topology α] [second_countable_topology β] : second_countable_topology (α × β) :=
((is_basis_countable_basis α).prod (is_basis_countable_basis β)).second_countable_topology $
  (countable_countable_basis α).image2 (countable_countable_basis β) _

instance second_countable_topology_fintype {ι : Type*} {π : ι → Type*}
  [fintype ι] [t : ∀a, topological_space (π a)] [sc : ∀a, second_countable_topology (π a)] :
  second_countable_topology (∀a, π a) :=
begin
  have : t = (λa, generate_from (countable_basis (π a))),
    from funext (assume a, (is_basis_countable_basis (π a)).eq_generate_from),
  rw this,
  constructor,
  refine ⟨pi univ '' pi univ (λ a, countable_basis (π a)), countable.image _ _, _⟩,
  { suffices : countable {f : Πa, set (π a) | ∀a, f a ∈ countable_basis (π a)}, { simpa [pi] },
    exact countable_pi (assume i, (countable_countable_basis _)), },
  rw [pi_generate_from_eq_fintype],
  { congr' 1 with f, simp [pi, eq_comm] },
  exact assume a, (is_basis_countable_basis (π a)).sUnion_eq
end

@[priority 100] -- see Note [lower instance priority]
instance second_countable_topology.to_separable_space
  [second_countable_topology α] : separable_space α :=
begin
  choose p hp using λ s : countable_basis α, nonempty_of_mem_countable_basis s.2,
  exact ⟨⟨range p, countable_range _,
    (is_basis_countable_basis α).dense_iff.2 $ λ o ho _, ⟨p ⟨o, ho⟩, hp _, mem_range_self _⟩⟩⟩
end

variables {α}

/-- A countable open cover induces a second-countable topology if all open covers
are themselves second countable. -/
lemma second_countable_topology_of_countable_cover {ι} [encodable ι] {U : ι → set α}
  [∀ i, second_countable_topology (U i)] (Uo : ∀ i, is_open (U i))  (hc : (⋃ i, U i) = univ) :
  second_countable_topology α :=
begin
  have : is_topological_basis (⋃ i, image (coe : U i → α) '' (countable_basis (U i))),
    from is_topological_basis_of_cover Uo hc (λ i, is_basis_countable_basis (U i)),
  exact this.second_countable_topology
    (countable_Union $ λ i, (countable_countable_basis _).image _)
end

/-- In a second-countable space, an open set, given as a union of open sets,
is equal to the union of countably many of those sets. -/
lemma is_open_Union_countable [second_countable_topology α]
  {ι} (s : ι → set α) (H : ∀ i, is_open (s i)) :
  ∃ T : set ι, countable T ∧ (⋃ i ∈ T, s i) = ⋃ i, s i :=
begin
  let B := {b ∈ countable_basis α | ∃ i, b ⊆ s i},
  choose f hf using λ b : B, b.2.2,
  haveI : encodable B := ((countable_countable_basis α).mono (sep_subset _ _)).to_encodable,
  refine ⟨_, countable_range f,
    subset.antisymm (bUnion_subset_Union _ _) (sUnion_subset _)⟩,
  rintro _ ⟨i, rfl⟩ x xs,
  rcases (is_basis_countable_basis α).exists_subset_of_mem_open xs (H _) with ⟨b, hb, xb, bs⟩,
  exact ⟨_, ⟨_, rfl⟩, _, ⟨⟨⟨_, hb, _, bs⟩, rfl⟩, rfl⟩, hf _ (by exact xb)⟩
end

lemma is_open_sUnion_countable [second_countable_topology α]
  (S : set (set α)) (H : ∀ s ∈ S, is_open s) :
  ∃ T : set (set α), countable T ∧ T ⊆ S ∧ ⋃₀ T = ⋃₀ S :=
let ⟨T, cT, hT⟩ := is_open_Union_countable (λ s:S, s.1) (λ s, H s.1 s.2) in
⟨subtype.val '' T, cT.image _,
  image_subset_iff.2 $ λ ⟨x, xs⟩ xt, xs,
  by rwa [sUnion_image, sUnion_eq_Union]⟩

/-- In a topological space with second countable topology, if `f` is a function that sends each
point `x` to a neighborhood of `x`, then for some countable set `s`, the neighborhoods `f x`,
`x ∈ s`, cover the whole space. -/
lemma countable_cover_nhds [second_countable_topology α] {f : α → set α}
  (hf : ∀ x, f x ∈ 𝓝 x) : ∃ s : set α, countable s ∧ (⋃ x ∈ s, f x) = univ :=
begin
  rcases is_open_Union_countable (λ x, interior (f x)) (λ x, is_open_interior) with ⟨s, hsc, hsU⟩,
  suffices : (⋃ x ∈ s, interior (f x)) = univ,
    from ⟨s, hsc, flip eq_univ_of_subset this (bUnion_mono $ λ _ _, interior_subset)⟩,
  simp only [hsU, eq_univ_iff_forall, mem_Union],
  exact λ x, ⟨x, mem_interior_iff_mem_nhds.2 (hf x)⟩
end

end topological_space

open topological_space

variables {α β : Type*} [topological_space α] [topological_space β] {f : α → β}

protected lemma inducing.second_countable_topology [second_countable_topology β]
  (hf : inducing f) : second_countable_topology α :=
by { rw hf.1, exact second_countable_topology_induced α β f }

protected lemma embedding.second_countable_topology [second_countable_topology β]
  (hf : embedding f) : second_countable_topology α :=
hf.1.second_countable_topology


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Bhavik Mehta

! This file was ported from Lean 3 source module category_theory.punit
! leanprover-community/mathlib commit 23aa88e32dcc9d2a24cca7bc23268567ed4cd7d6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Functor.Const
import Mathbin.CategoryTheory.DiscreteCategory

/-!
# The category `discrete punit`

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

We define `star : C ⥤ discrete punit` sending everything to `punit.star`,
show that any two functors to `discrete punit` are naturally isomorphic,
and construct the equivalence `(discrete punit ⥤ C) ≌ C`.
-/

universe v u

-- morphism levels before object levels. See note [category_theory universes].
namespace CategoryTheory

variable (C : Type u) [Category.{v} C]

namespace Functor

#print CategoryTheory.Functor.star /-
/-- The constant functor sending everything to `punit.star`. -/
@[simps]
def star : C ⥤ Discrete PUnit :=
  (Functor.const _).obj ⟨⟨⟩⟩
#align category_theory.functor.star CategoryTheory.Functor.star
-/

variable {C}

#print CategoryTheory.Functor.pUnitExt /-
/-- Any two functors to `discrete punit` are isomorphic. -/
@[simps]
def pUnitExt (F G : C ⥤ Discrete PUnit) : F ≅ G :=
  NatIso.ofComponents (fun _ => eqToIso (by decide)) fun _ _ _ => by decide
#align category_theory.functor.punit_ext CategoryTheory.Functor.pUnitExt
-/

/- warning: category_theory.functor.punit_ext' -> CategoryTheory.Functor.pUnit_ext' is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C] (F : CategoryTheory.Functor.{u1, u3, u2, u3} C _inst_1 (CategoryTheory.Discrete.{u3} PUnit.{succ u3}) (CategoryTheory.discreteCategory.{u3} PUnit.{succ u3})) (G : CategoryTheory.Functor.{u1, u3, u2, u3} C _inst_1 (CategoryTheory.Discrete.{u3} PUnit.{succ u3}) (CategoryTheory.discreteCategory.{u3} PUnit.{succ u3})), Eq.{succ (max u1 u2 u3)} (CategoryTheory.Functor.{u1, u3, u2, u3} C _inst_1 (CategoryTheory.Discrete.{u3} PUnit.{succ u3}) (CategoryTheory.discreteCategory.{u3} PUnit.{succ u3})) F G
but is expected to have type
  forall {C : Type.{u3}} [_inst_1 : CategoryTheory.Category.{u2, u3} C] (F : CategoryTheory.Functor.{u2, u1, u3, u1} C _inst_1 (CategoryTheory.Discrete.{u1} PUnit.{succ u1}) (CategoryTheory.discreteCategory.{u1} PUnit.{succ u1})) (G : CategoryTheory.Functor.{u2, u1, u3, u1} C _inst_1 (CategoryTheory.Discrete.{u1} PUnit.{succ u1}) (CategoryTheory.discreteCategory.{u1} PUnit.{succ u1})), Eq.{max (max (succ u3) (succ u2)) (succ u1)} (CategoryTheory.Functor.{u2, u1, u3, u1} C _inst_1 (CategoryTheory.Discrete.{u1} PUnit.{succ u1}) (CategoryTheory.discreteCategory.{u1} PUnit.{succ u1})) F G
Case conversion may be inaccurate. Consider using '#align category_theory.functor.punit_ext' CategoryTheory.Functor.pUnit_ext'ₓ'. -/
/-- Any two functors to `discrete punit` are *equal*.
You probably want to use `punit_ext` instead of this.
-/
theorem pUnit_ext' (F G : C ⥤ Discrete PUnit) : F = G :=
  Functor.ext (fun _ => by decide) fun _ _ _ => by decide
#align category_theory.functor.punit_ext' CategoryTheory.Functor.pUnit_ext'

#print CategoryTheory.Functor.fromPUnit /-
/-- The functor from `discrete punit` sending everything to the given object. -/
abbrev fromPUnit (X : C) : Discrete PUnit.{v + 1} ⥤ C :=
  (Functor.const _).obj X
#align category_theory.functor.from_punit CategoryTheory.Functor.fromPUnit
-/

/- warning: category_theory.functor.equiv -> CategoryTheory.Functor.equiv is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C], CategoryTheory.Equivalence.{max u3 u1, u1, max u3 u1 u3 u2, u2} (CategoryTheory.Functor.{u3, u1, u3, u2} (CategoryTheory.Discrete.{u3} PUnit.{succ u3}) (CategoryTheory.discreteCategory.{u3} PUnit.{succ u3}) C _inst_1) (CategoryTheory.Functor.category.{u3, u1, u3, u2} (CategoryTheory.Discrete.{u3} PUnit.{succ u3}) (CategoryTheory.discreteCategory.{u3} PUnit.{succ u3}) C _inst_1) C _inst_1
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Category.{u1, u2} C], CategoryTheory.Equivalence.{max u1 u3, u1, max (max (max u2 u3) u1) u3, u2} (CategoryTheory.Functor.{u3, u1, u3, u2} (CategoryTheory.Discrete.{u3} PUnit.{succ u3}) (CategoryTheory.discreteCategory.{u3} PUnit.{succ u3}) C _inst_1) C (CategoryTheory.Functor.category.{u3, u1, u3, u2} (CategoryTheory.Discrete.{u3} PUnit.{succ u3}) (CategoryTheory.discreteCategory.{u3} PUnit.{succ u3}) C _inst_1) _inst_1
Case conversion may be inaccurate. Consider using '#align category_theory.functor.equiv CategoryTheory.Functor.equivₓ'. -/
/-- Functors from `discrete punit` are equivalent to the category itself. -/
@[simps]
def equiv : Discrete PUnit ⥤ C ≌ C
    where
  Functor :=
    { obj := fun F => F.obj ⟨⟨⟩⟩
      map := fun F G θ => θ.app ⟨⟨⟩⟩ }
  inverse := Functor.const _
  unitIso := by
    apply nat_iso.of_components _ _
    intro X
    apply discrete.nat_iso
    rintro ⟨⟨⟩⟩
    apply iso.refl _
    intros
    ext ⟨⟨⟩⟩
    simp
  counitIso := by
    refine' nat_iso.of_components iso.refl _
    intro X Y f
    dsimp; simp
#align category_theory.functor.equiv CategoryTheory.Functor.equiv

-- See note [dsimp, simp].
end Functor

/- warning: category_theory.equiv_punit_iff_unique -> CategoryTheory.equiv_pUnit_iff_unique is a dubious translation:
lean 3 declaration is
  forall (C : Type.{u2}) [_inst_1 : CategoryTheory.Category.{u1, u2} C], Iff (Nonempty.{max (succ u2) (succ u1) (succ u3)} (CategoryTheory.Equivalence.{u1, u3, u2, u3} C _inst_1 (CategoryTheory.Discrete.{u3} PUnit.{succ u3}) (CategoryTheory.discreteCategory.{u3} PUnit.{succ u3}))) (And (Nonempty.{succ u2} C) (forall (x : C) (y : C), Nonempty.{succ u1} (Unique.{succ u1} (Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C _inst_1)) x y))))
but is expected to have type
  forall (C : Type.{u3}) [_inst_1 : CategoryTheory.Category.{u2, u3} C], Iff (Nonempty.{max (max (succ u1) (succ u3)) (succ u2)} (CategoryTheory.Equivalence.{u2, u1, u3, u1} C (CategoryTheory.Discrete.{u1} PUnit.{succ u1}) _inst_1 (CategoryTheory.discreteCategory.{u1} PUnit.{succ u1}))) (And (Nonempty.{succ u3} C) (forall (x : C) (y : C), Nonempty.{succ u2} (Unique.{succ u2} (Quiver.Hom.{succ u2, u3} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u3} C (CategoryTheory.Category.toCategoryStruct.{u2, u3} C _inst_1)) x y))))
Case conversion may be inaccurate. Consider using '#align category_theory.equiv_punit_iff_unique CategoryTheory.equiv_pUnit_iff_uniqueₓ'. -/
/-- A category being equivalent to `punit` is equivalent to it having a unique morphism between
  any two objects. (In fact, such a category is also a groupoid; see `groupoid.of_hom_unique`) -/
theorem equiv_pUnit_iff_unique :
    Nonempty (C ≌ Discrete PUnit) ↔ Nonempty C ∧ ∀ x y : C, Nonempty <| Unique (x ⟶ y) :=
  by
  constructor
  · rintro ⟨h⟩
    refine' ⟨⟨h.inverse.obj ⟨⟨⟩⟩⟩, fun x y => Nonempty.intro _⟩
    apply uniqueOfSubsingleton _
    swap
    · have hx : x ⟶ h.inverse.obj ⟨⟨⟩⟩ := by convert h.unit.app x
      have hy : h.inverse.obj ⟨⟨⟩⟩ ⟶ y := by convert h.unit_inv.app y
      exact hx ≫ hy
    have : ∀ z, z = h.unit.app x ≫ (h.functor ⋙ h.inverse).map z ≫ h.unit_inv.app y :=
      by
      intro z
      simpa using congr_arg (· ≫ h.unit_inv.app y) (h.unit.naturality z)
    apply Subsingleton.intro
    intro a b
    rw [this a, this b]
    simp only [functor.comp_map]
    congr
  · rintro ⟨⟨p⟩, h⟩
    haveI := fun x y => (h x y).some
    refine'
      Nonempty.intro
        (CategoryTheory.Equivalence.mk ((Functor.Const _).obj ⟨⟨⟩⟩) ((Functor.Const _).obj p) _
          (by apply functor.punit_ext))
    exact
      nat_iso.of_components
        (fun _ =>
          { Hom := default
            inv := default })
        fun _ _ _ => by tidy
#align category_theory.equiv_punit_iff_unique CategoryTheory.equiv_pUnit_iff_unique

end CategoryTheory