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

import analysis.specific_limits.normed

/-!
# Normed groups homomorphisms

This file gathers definitions and elementary constructions about bounded group homomorphisms
between normed (abelian) groups (abbreviated to "normed group homs").

The main lemmas relate the boundedness condition to continuity and Lipschitzness.

The main construction is to endow the type of normed group homs between two given normed groups
with a group structure and a norm, giving rise to a normed group structure. We provide several
simple constructions for normed group homs, like kernel, range and equalizer.

Some easy other constructions are related to subgroups of normed groups.

Since a lot of elementary properties don't require `∥x∥ = 0 → x = 0` we start setting up the
theory of `semi_normed_group_hom` and we specialize to `normed_group_hom` when needed.
-/

noncomputable theory
open_locale nnreal big_operators

/-- A morphism of seminormed abelian groups is a bounded group homomorphism. -/
structure normed_group_hom (V W : Type*) [semi_normed_group V] [semi_normed_group W] :=
(to_fun : V → W)
(map_add' : ∀ v₁ v₂, to_fun (v₁ + v₂) = to_fun v₁ + to_fun v₂)
(bound' : ∃ C, ∀ v, ∥to_fun v∥ ≤ C * ∥v∥)

namespace add_monoid_hom

variables {V W : Type*} [semi_normed_group V] [semi_normed_group W] {f g : normed_group_hom V W}

/-- Associate to a group homomorphism a bounded group homomorphism under a norm control condition.

See `add_monoid_hom.mk_normed_group_hom'` for a version that uses `ℝ≥0` for the bound. -/
def mk_normed_group_hom (f : V →+ W)
  (C : ℝ) (h : ∀ v, ∥f v∥ ≤ C * ∥v∥) : normed_group_hom V W :=
{ bound' := ⟨C, h⟩, ..f }

/-- Associate to a group homomorphism a bounded group homomorphism under a norm control condition.

See `add_monoid_hom.mk_normed_group_hom` for a version that uses `ℝ` for the bound. -/
def mk_normed_group_hom' (f : V →+ W) (C : ℝ≥0) (hC : ∀ x, ∥f x∥₊ ≤ C * ∥x∥₊) :
  normed_group_hom V W :=
{ bound' := ⟨C, hC⟩ .. f}

end add_monoid_hom

lemma exists_pos_bound_of_bound {V W : Type*} [semi_normed_group V] [semi_normed_group W]
  {f : V → W} (M : ℝ) (h : ∀x, ∥f x∥ ≤ M * ∥x∥) :
  ∃ N, 0 < N ∧ ∀x, ∥f x∥ ≤ N * ∥x∥ :=
⟨max M 1, lt_of_lt_of_le zero_lt_one (le_max_right _ _), λx, calc
  ∥f x∥ ≤ M * ∥x∥ : h x
  ... ≤ max M 1 * ∥x∥ : mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg _) ⟩

namespace normed_group_hom

variables {V V₁ V₂ V₃ : Type*}
variables [semi_normed_group V] [semi_normed_group V₁] [semi_normed_group V₂] [semi_normed_group V₃]
variables {f g : normed_group_hom V₁ V₂}

instance : has_coe_to_fun (normed_group_hom V₁ V₂) (λ _, V₁ → V₂) := ⟨normed_group_hom.to_fun⟩

initialize_simps_projections normed_group_hom (to_fun → apply)

lemma coe_inj (H : (f : V₁ → V₂) = g) : f = g :=
by cases f; cases g; congr'; exact funext H

lemma coe_injective : @function.injective (normed_group_hom V₁ V₂) (V₁ → V₂) coe_fn :=
by apply coe_inj

lemma coe_inj_iff : f = g ↔ (f : V₁ → V₂) = g := ⟨congr_arg _, coe_inj⟩

@[ext] lemma ext (H : ∀ x, f x = g x) : f = g := coe_inj $ funext H

lemma ext_iff : f = g ↔ ∀ x, f x = g x := ⟨by rintro rfl x; refl, ext⟩

variables (f g)

@[simp] lemma to_fun_eq_coe : f.to_fun = f := rfl

@[simp] lemma coe_mk (f) (h₁) (h₂) (h₃) : ⇑(⟨f, h₁, h₂, h₃⟩ : normed_group_hom V₁ V₂) = f := rfl

@[simp] lemma coe_mk_normed_group_hom (f : V₁ →+ V₂) (C) (hC) :
  ⇑(f.mk_normed_group_hom C hC) = f := rfl

@[simp] lemma coe_mk_normed_group_hom' (f : V₁ →+ V₂) (C) (hC) :
  ⇑(f.mk_normed_group_hom' C hC) = f := rfl

/-- The group homomorphism underlying a bounded group homomorphism. -/
def to_add_monoid_hom (f : normed_group_hom V₁ V₂) : V₁ →+ V₂ :=
add_monoid_hom.mk' f f.map_add'

@[simp] lemma coe_to_add_monoid_hom : ⇑f.to_add_monoid_hom = f := rfl

lemma to_add_monoid_hom_injective :
  function.injective (@normed_group_hom.to_add_monoid_hom V₁ V₂ _ _) :=
λ f g h, coe_inj $ show ⇑f.to_add_monoid_hom = g, by { rw h, refl }

@[simp]

@[simp] lemma map_zero : f 0 = 0 := f.to_add_monoid_hom.map_zero

@[simp] lemma map_add (x y) : f (x + y) = f x + f y := f.to_add_monoid_hom.map_add _ _

@[simp] lemma map_sum {ι : Type*} (v : ι → V₁) (s : finset ι) :
  f (∑ i in s, v i) = ∑ i in s, f (v i) :=
f.to_add_monoid_hom.map_sum _ _

@[simp] lemma map_sub (x y) : f (x - y) = f x - f y := f.to_add_monoid_hom.map_sub _ _

@[simp] lemma map_neg (x) : f (-x) = -(f x) := f.to_add_monoid_hom.map_neg _

lemma bound : ∃ C, 0 < C ∧ ∀ x, ∥f x∥ ≤ C * ∥x∥ :=
let ⟨C, hC⟩ := f.bound' in exists_pos_bound_of_bound _ hC

theorem antilipschitz_of_norm_ge {K : ℝ≥0} (h : ∀ x, ∥x∥ ≤ K * ∥f x∥) :
  antilipschitz_with K f :=
antilipschitz_with.of_le_mul_dist $
λ x y, by simpa only [dist_eq_norm, f.map_sub] using h (x - y)

/-- A normed group hom is surjective on the subgroup `K` with constant `C` if every element
`x` of `K` has a preimage whose norm is bounded above by `C*∥x∥`. This is a more
abstract version of `f` having a right inverse defined on `K` with operator norm
at most `C`. -/
def surjective_on_with (f : normed_group_hom V₁ V₂) (K : add_subgroup V₂) (C : ℝ) : Prop :=
  ∀ h ∈ K, ∃ g, f g = h ∧ ∥g∥ ≤ C*∥h∥

lemma surjective_on_with.mono {f : normed_group_hom V₁ V₂} {K : add_subgroup V₂} {C C' : ℝ}
  (h : f.surjective_on_with K C) (H : C ≤ C') : f.surjective_on_with K C' :=
begin
  intros k k_in,
  rcases h k k_in with ⟨g, rfl, hg⟩,
  use [g, rfl],
  by_cases Hg : ∥f g∥ = 0,
  { simpa [Hg] using hg },
  { exact hg.trans ((mul_le_mul_right $ (ne.symm Hg).le_iff_lt.mp (norm_nonneg _)).mpr H) }
end

lemma surjective_on_with.exists_pos {f : normed_group_hom V₁ V₂} {K : add_subgroup V₂} {C : ℝ}
  (h : f.surjective_on_with K C) : ∃ C' > 0, f.surjective_on_with K C' :=
begin
  refine ⟨|C| + 1, _, _⟩,
  { linarith [abs_nonneg C] },
  { apply h.mono,
    linarith [le_abs_self C] }
end

lemma surjective_on_with.surj_on {f : normed_group_hom V₁ V₂} {K : add_subgroup V₂} {C : ℝ}
  (h : f.surjective_on_with K C) : set.surj_on f set.univ K :=
λ x hx, (h x hx).imp $ λ a ⟨ha, _⟩, ⟨set.mem_univ _, ha⟩

/-! ### The operator norm -/

/-- The operator norm of a seminormed group homomorphism is the inf of all its bounds. -/
def op_norm (f : normed_group_hom V₁ V₂) := Inf {c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥}
instance has_op_norm : has_norm (normed_group_hom V₁ V₂) := ⟨op_norm⟩

lemma norm_def : ∥f∥ = Inf {c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥} := rfl

-- So that invocations of `le_cInf` make sense: we show that the set of
-- bounds is nonempty and bounded below.
lemma bounds_nonempty {f : normed_group_hom V₁ V₂} :
  ∃ c, c ∈ { c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥ } :=
let ⟨M, hMp, hMb⟩ := f.bound in ⟨M, le_of_lt hMp, hMb⟩

lemma bounds_bdd_below {f : normed_group_hom V₁ V₂} :
  bdd_below {c | 0 ≤ c ∧ ∀ x, ∥f x∥ ≤ c * ∥x∥} :=
⟨0, λ _ ⟨hn, _⟩, hn⟩

lemma op_norm_nonneg : 0 ≤ ∥f∥ :=
le_cInf bounds_nonempty (λ _ ⟨hx, _⟩, hx)

/-- The fundamental property of the operator norm: `∥f x∥ ≤ ∥f∥ * ∥x∥`. -/
theorem le_op_norm (x : V₁) : ∥f x∥ ≤ ∥f∥ * ∥x∥ :=
begin
  obtain ⟨C, Cpos, hC⟩ := f.bound,
  replace hC := hC x,
  by_cases h : ∥x∥ = 0,
  { rwa [h, mul_zero] at ⊢ hC },
  have hlt : 0 < ∥x∥ := lt_of_le_of_ne (norm_nonneg x) (ne.symm h),
  exact (div_le_iff hlt).mp (le_cInf bounds_nonempty (λ c ⟨_, hc⟩,
    (div_le_iff hlt).mpr $ by { apply hc })),
end

theorem le_op_norm_of_le {c : ℝ} {x} (h : ∥x∥ ≤ c) : ∥f x∥ ≤ ∥f∥ * c :=
le_trans (f.le_op_norm x) (mul_le_mul_of_nonneg_left h f.op_norm_nonneg)

theorem le_of_op_norm_le {c : ℝ} (h : ∥f∥ ≤ c) (x : V₁) : ∥f x∥ ≤ c * ∥x∥ :=
(f.le_op_norm x).trans (mul_le_mul_of_nonneg_right h (norm_nonneg x))

/-- continuous linear maps are Lipschitz continuous. -/
theorem lipschitz : lipschitz_with ⟨∥f∥, op_norm_nonneg f⟩ f :=
lipschitz_with.of_dist_le_mul $ λ x y,
  by { rw [dist_eq_norm, dist_eq_norm, ←map_sub], apply le_op_norm }

protected lemma uniform_continuous (f : normed_group_hom V₁ V₂) :
  uniform_continuous f := f.lipschitz.uniform_continuous

@[continuity]
protected lemma continuous (f : normed_group_hom V₁ V₂) : continuous f :=
f.uniform_continuous.continuous

lemma ratio_le_op_norm (x : V₁) : ∥f x∥ / ∥x∥ ≤ ∥f∥ :=
div_le_of_nonneg_of_le_mul (norm_nonneg _) f.op_norm_nonneg (le_op_norm _ _)

/-- If one controls the norm of every `f x`, then one controls the norm of `f`. -/
lemma op_norm_le_bound {M : ℝ} (hMp: 0 ≤ M) (hM : ∀ x, ∥f x∥ ≤ M * ∥x∥) :
  ∥f∥ ≤ M :=
cInf_le bounds_bdd_below ⟨hMp, hM⟩

lemma op_norm_eq_of_bounds {M : ℝ} (M_nonneg : 0 ≤ M)
  (h_above : ∀ x, ∥f x∥ ≤ M*∥x∥) (h_below : ∀ N ≥ 0, (∀ x, ∥f x∥ ≤ N*∥x∥) → M ≤ N) :
  ∥f∥ = M :=
le_antisymm (f.op_norm_le_bound M_nonneg h_above)
  ((le_cInf_iff normed_group_hom.bounds_bdd_below ⟨M, M_nonneg, h_above⟩).mpr $
   λ N ⟨N_nonneg, hN⟩, h_below N N_nonneg hN)

theorem op_norm_le_of_lipschitz {f : normed_group_hom V₁ V₂} {K : ℝ≥0} (hf : lipschitz_with K f) :
  ∥f∥ ≤ K :=
f.op_norm_le_bound K.2 $ λ x, by simpa only [dist_zero_right, f.map_zero] using hf.dist_le_mul x 0

/-- If a bounded group homomorphism map is constructed from a group homomorphism via the constructor
`mk_normed_group_hom`, then its norm is bounded by the bound given to the constructor if it is
nonnegative. -/
lemma mk_normed_group_hom_norm_le (f : V₁ →+ V₂) {C : ℝ} (hC : 0 ≤ C) (h : ∀x, ∥f x∥ ≤ C * ∥x∥) :
  ∥f.mk_normed_group_hom C h∥ ≤ C :=
op_norm_le_bound _ hC h

/-- If a bounded group homomorphism map is constructed from a group homomorphism
via the constructor `mk_normed_group_hom`, then its norm is bounded by the bound
given to the constructor or zero if this bound is negative. -/
lemma mk_normed_group_hom_norm_le' (f : V₁ →+ V₂) {C : ℝ} (h : ∀x, ∥f x∥ ≤ C * ∥x∥) :
  ∥f.mk_normed_group_hom C h∥ ≤ max C 0 :=
op_norm_le_bound _ (le_max_right _ _) $ λ x, (h x).trans $
  mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg x)

alias mk_normed_group_hom_norm_le ← add_monoid_hom.mk_normed_group_hom_norm_le
alias mk_normed_group_hom_norm_le' ← add_monoid_hom.mk_normed_group_hom_norm_le'

/-! ### Addition of normed group homs -/

/-- Addition of normed group homs. -/
instance : has_add (normed_group_hom V₁ V₂) :=
⟨λ f g, (f.to_add_monoid_hom + g.to_add_monoid_hom).mk_normed_group_hom (∥f∥ + ∥g∥) $ λ v, calc
  ∥f v + g v∥
      ≤ ∥f v∥ + ∥g v∥ : norm_add_le _ _
  ... ≤ ∥f∥ * ∥v∥ + ∥g∥ * ∥v∥ : add_le_add (le_op_norm f v) (le_op_norm g v)
  ... = (∥f∥ + ∥g∥) * ∥v∥ : by rw add_mul⟩

/-- The operator norm satisfies the triangle inequality. -/
theorem op_norm_add_le : ∥f + g∥ ≤ ∥f∥ + ∥g∥ :=
mk_normed_group_hom_norm_le _ (add_nonneg (op_norm_nonneg _) (op_norm_nonneg _)) _

/--
Terms containing `@has_add.add (has_coe_to_fun.F ...) pi.has_add`
seem to cause leanchecker to [crash due to an out-of-memory
condition](https://github.com/leanprover-community/lean/issues/543).
As a workaround, we add a type annotation: `(f + g : V₁ → V₂)`
-/
library_note "addition on function coercions"

-- see Note [addition on function coercions]
@[simp] lemma coe_add (f g : normed_group_hom V₁ V₂) : ⇑(f + g) = (f + g : V₁ → V₂) := rfl
@[simp] lemma add_apply (f g : normed_group_hom V₁ V₂) (v : V₁) :
  (f + g : normed_group_hom V₁ V₂) v = f v + g v := rfl

/-! ### The zero normed group hom -/

instance : has_zero (normed_group_hom V₁ V₂) :=
⟨(0 : V₁ →+ V₂).mk_normed_group_hom 0 (by simp)⟩

instance : inhabited (normed_group_hom V₁ V₂) := ⟨0⟩

/-- The norm of the `0` operator is `0`. -/
theorem op_norm_zero : ∥(0 : normed_group_hom V₁ V₂)∥ = 0 :=
le_antisymm (cInf_le bounds_bdd_below
    ⟨ge_of_eq rfl, λ _, le_of_eq (by { rw [zero_mul], exact norm_zero })⟩)
    (op_norm_nonneg _)

/-- For normed groups, an operator is zero iff its norm vanishes. -/
theorem op_norm_zero_iff {V₁ V₂ : Type*} [normed_group V₁] [normed_group V₂]
  {f : normed_group_hom V₁ V₂} : ∥f∥ = 0 ↔ f = 0 :=
iff.intro
  (λ hn, ext (λ x, norm_le_zero_iff.1
    (calc _ ≤ ∥f∥ * ∥x∥ : le_op_norm _ _
     ...     = _ : by rw [hn, zero_mul])))
  (λ hf, by rw [hf, op_norm_zero] )

-- see Note [addition on function coercions]
@[simp] lemma coe_zero : ⇑(0 : normed_group_hom V₁ V₂) = (0 : V₁ → V₂) := rfl
@[simp] lemma zero_apply (v : V₁) : (0 : normed_group_hom V₁ V₂) v = 0 := rfl

variables {f g}

/-! ### The identity normed group hom -/

variable (V)

/-- The identity as a continuous normed group hom. -/
@[simps]
def id : normed_group_hom V V :=
(add_monoid_hom.id V).mk_normed_group_hom 1 (by simp [le_refl])

/-- The norm of the identity is at most `1`. It is in fact `1`, except when the norm of every
element vanishes, where it is `0`. (Since we are working with seminorms this can happen even if the
space is non-trivial.) It means that one can not do better than an inequality in general. -/
lemma norm_id_le : ∥(id V : normed_group_hom V V)∥ ≤ 1 :=
op_norm_le_bound _ zero_le_one (λx, by simp)

/-- If there is an element with norm different from `0`, then the norm of the identity equals `1`.
(Since we are working with seminorms supposing that the space is non-trivial is not enough.) -/
lemma norm_id_of_nontrivial_seminorm (h : ∃ (x : V), ∥x∥ ≠ 0 ) :
  ∥(id V)∥ = 1 :=
le_antisymm (norm_id_le V) $ let ⟨x, hx⟩ := h in
have _ := (id V).ratio_le_op_norm x,
by rwa [id_apply, div_self hx] at this

/-- If a normed space is non-trivial, then the norm of the identity equals `1`. -/
lemma norm_id {V : Type*} [normed_group V] [nontrivial V] : ∥(id V)∥ = 1 :=
begin
  refine norm_id_of_nontrivial_seminorm V _,
  obtain ⟨x, hx⟩ := exists_ne (0 : V),
  exact ⟨x, ne_of_gt (norm_pos_iff.2 hx)⟩,
end

lemma coe_id : ((normed_group_hom.id V) : V → V) = (_root_.id : V → V) := rfl

/-! ### The negation of a normed group hom -/

/-- Opposite of a normed group hom. -/
instance : has_neg (normed_group_hom V₁ V₂) :=
⟨λ f, (-f.to_add_monoid_hom).mk_normed_group_hom (∥f∥) (λ v, by simp [le_op_norm f v])⟩

-- see Note [addition on function coercions]
@[simp] lemma coe_neg (f : normed_group_hom V₁ V₂) : ⇑(-f) = (-f : V₁ → V₂) := rfl
@[simp] lemma neg_apply (f : normed_group_hom V₁ V₂) (v : V₁) :
  (-f : normed_group_hom V₁ V₂) v = - (f v) := rfl

lemma op_norm_neg (f : normed_group_hom V₁ V₂) : ∥-f∥ = ∥f∥ :=
by simp only [norm_def, coe_neg, norm_neg, pi.neg_apply]

/-! ### Subtraction of normed group homs -/

/-- Subtraction of normed group homs. -/
instance : has_sub (normed_group_hom V₁ V₂) :=
⟨λ f g,
{ bound' :=
  begin
    simp only [add_monoid_hom.sub_apply, add_monoid_hom.to_fun_eq_coe, sub_eq_add_neg],
    exact (f + -g).bound'
  end,
  .. (f.to_add_monoid_hom - g.to_add_monoid_hom) }⟩

-- see Note [addition on function coercions]
@[simp] lemma coe_sub (f g : normed_group_hom V₁ V₂) : ⇑(f - g) = (f - g : V₁ → V₂) := rfl
@[simp] lemma sub_apply (f g : normed_group_hom V₁ V₂) (v : V₁) :
  (f - g : normed_group_hom V₁ V₂) v = f v - g v := rfl

/-! ### Scalar actions on normed group homs -/

section has_scalar

variables {R R' : Type*}
  [monoid_with_zero R] [distrib_mul_action R V₂] [pseudo_metric_space R] [has_bounded_smul R V₂]
  [monoid_with_zero R'] [distrib_mul_action R' V₂] [pseudo_metric_space R'] [has_bounded_smul R' V₂]

instance : has_scalar R (normed_group_hom V₁ V₂) :=
{ smul := λ r f,
  { to_fun := r • f,
    map_add' := (r • f.to_add_monoid_hom).map_add',
    bound' := let ⟨b, hb⟩ := f.bound' in  ⟨dist r 0 * b, λ x, begin
      have := dist_smul_pair r (f x) (f 0),
      rw [f.map_zero, smul_zero, dist_zero_right, dist_zero_right] at this,
      rw mul_assoc,
      refine this.trans _,
      refine mul_le_mul_of_nonneg_left _ dist_nonneg,
      exact hb x
    end⟩ } }

@[simp] lemma coe_smul (r : R) (f : normed_group_hom V₁ V₂) : ⇑(r • f) = r • f := rfl
@[simp] lemma smul_apply (r : R) (f : normed_group_hom V₁ V₂) (v : V₁) : (r • f) v = r • f v := rfl

instance [smul_comm_class R R' V₂] : smul_comm_class R R' (normed_group_hom V₁ V₂) :=
{ smul_comm := λ r r' f, ext $ λ v, smul_comm _ _ _ }

instance [has_scalar R R'] [is_scalar_tower R R' V₂] :
  is_scalar_tower R R' (normed_group_hom V₁ V₂) :=
{ smul_assoc := λ r r' f, ext $ λ v, smul_assoc _ _ _ }

instance [distrib_mul_action Rᵐᵒᵖ V₂] [is_central_scalar R V₂] :
  is_central_scalar R (normed_group_hom V₁ V₂) :=
{ op_smul_eq_smul := λ r f, ext $ λ v, op_smul_eq_smul _ _ }

end has_scalar

instance has_nat_scalar : has_scalar ℕ (normed_group_hom V₁ V₂) :=
{ smul := λ n f,
  { to_fun := n • f,
    map_add' := (n • f.to_add_monoid_hom).map_add',
    bound' := let ⟨b, hb⟩ := f.bound' in ⟨n • b, λ v, begin
      rw [pi.smul_apply, nsmul_eq_mul, mul_assoc],
      exact (norm_nsmul_le _ _).trans (mul_le_mul_of_nonneg_left (hb _) (nat.cast_nonneg _)),
    end⟩ } }

@[simp] lemma coe_nsmul (r : ℕ) (f : normed_group_hom V₁ V₂) : ⇑(r • f) = r • f := rfl
@[simp] lemma nsmul_apply (r : ℕ) (f : normed_group_hom V₁ V₂) (v : V₁) : (r • f) v = r • f v := rfl

instance has_int_scalar : has_scalar ℤ (normed_group_hom V₁ V₂) :=
{ smul := λ z f,
  { to_fun := z • f,
    map_add' := (z • f.to_add_monoid_hom).map_add',
    bound' := let ⟨b, hb⟩ := f.bound' in ⟨∥z∥ • b, λ v, begin
      rw [pi.smul_apply, smul_eq_mul, mul_assoc],
      exact (norm_zsmul_le _ _).trans  (mul_le_mul_of_nonneg_left (hb _) $ norm_nonneg _),
    end⟩ } }

@[simp] lemma coe_zsmul (r : ℤ) (f : normed_group_hom V₁ V₂) : ⇑(r • f) = r • f := rfl
@[simp] lemma zsmul_apply (r : ℤ) (f : normed_group_hom V₁ V₂) (v : V₁) : (r • f) v = r • f v := rfl

/-! ### Normed group structure on normed group homs -/

/-- Homs between two given normed groups form a commutative additive group. -/
instance : add_comm_group (normed_group_hom V₁ V₂) :=
coe_injective.add_comm_group _ rfl (λ _ _, rfl) (λ _, rfl) (λ _ _, rfl) (λ _ _, rfl) (λ _ _, rfl)

/-- Normed group homomorphisms themselves form a seminormed group with respect to
    the operator norm. -/
instance to_semi_normed_group : semi_normed_group (normed_group_hom V₁ V₂) :=
semi_normed_group.of_core _ ⟨op_norm_zero, op_norm_add_le, op_norm_neg⟩

/-- Normed group homomorphisms themselves form a normed group with respect to
    the operator norm. -/
instance to_normed_group {V₁ V₂ : Type*} [normed_group V₁] [normed_group V₂] :
  normed_group (normed_group_hom V₁ V₂) :=
normed_group.of_core _ ⟨λ f, op_norm_zero_iff, op_norm_add_le, op_norm_neg⟩

/-- Coercion of a `normed_group_hom` is an `add_monoid_hom`. Similar to `add_monoid_hom.coe_fn` -/
@[simps]
def coe_fn_add_hom : normed_group_hom V₁ V₂ →+ (V₁ → V₂) :=
{ to_fun := coe_fn, map_zero' := coe_zero, map_add' := coe_add}

@[simp] lemma coe_sum {ι : Type*} (s : finset ι) (f : ι → normed_group_hom V₁ V₂) :
  ⇑(∑ i in s, f i) = ∑ i in s, (f i) :=
(coe_fn_add_hom : _ →+ (V₁ → V₂)).map_sum f s

lemma sum_apply {ι : Type*} (s : finset ι) (f : ι → normed_group_hom V₁ V₂) (v : V₁) :
  (∑ i in s, f i) v = ∑ i in s, (f i v) :=
by simp only [coe_sum, finset.sum_apply]

/-! ### Module structure on normed group homs -/

instance {R : Type*} [monoid_with_zero R] [distrib_mul_action R V₂]
  [pseudo_metric_space R] [has_bounded_smul R V₂] :
  distrib_mul_action R (normed_group_hom V₁ V₂) :=
function.injective.distrib_mul_action coe_fn_add_hom coe_injective coe_smul

instance {R : Type*} [semiring R] [module R V₂]
  [pseudo_metric_space R] [has_bounded_smul R V₂] :
  module R (normed_group_hom V₁ V₂) :=
function.injective.module _ coe_fn_add_hom coe_injective coe_smul

/-! ### Composition of normed group homs -/

/-- The composition of continuous normed group homs. -/
@[simps]
protected def comp (g : normed_group_hom V₂ V₃) (f : normed_group_hom V₁ V₂) :
  normed_group_hom V₁ V₃ :=
(g.to_add_monoid_hom.comp f.to_add_monoid_hom).mk_normed_group_hom (∥g∥ * ∥f∥) $ λ v, calc
∥g (f v)∥ ≤ ∥g∥ * ∥f v∥ : le_op_norm _ _
... ≤ ∥g∥ * (∥f∥ * ∥v∥) : mul_le_mul_of_nonneg_left (le_op_norm _ _) (op_norm_nonneg _)
... = ∥g∥ * ∥f∥ * ∥v∥   : by rw mul_assoc

lemma norm_comp_le (g : normed_group_hom V₂ V₃) (f : normed_group_hom V₁ V₂) :
  ∥g.comp f∥ ≤ ∥g∥ * ∥f∥ :=
mk_normed_group_hom_norm_le _ (mul_nonneg (op_norm_nonneg _) (op_norm_nonneg _)) _

lemma norm_comp_le_of_le {g : normed_group_hom V₂ V₃} {C₁ C₂ : ℝ} (hg : ∥g∥ ≤ C₂) (hf : ∥f∥ ≤ C₁) :
  ∥g.comp f∥ ≤ C₂ * C₁ :=
le_trans (norm_comp_le g f) $ mul_le_mul hg hf (norm_nonneg _) (le_trans (norm_nonneg _) hg)

lemma norm_comp_le_of_le' {g : normed_group_hom V₂ V₃} (C₁ C₂ C₃ : ℝ) (h : C₃ = C₂ * C₁)
  (hg : ∥g∥ ≤ C₂) (hf : ∥f∥ ≤ C₁) : ∥g.comp f∥ ≤ C₃ :=
by { rw h, exact norm_comp_le_of_le hg hf }

/-- Composition of normed groups hom as an additive group morphism. -/
def comp_hom : (normed_group_hom V₂ V₃) →+ (normed_group_hom V₁ V₂) →+ (normed_group_hom V₁ V₃) :=
add_monoid_hom.mk' (λ g, add_monoid_hom.mk' (λ f, g.comp f)
  (by { intros, ext, exact g.map_add _ _ }))
  (by { intros, ext, simp only [comp_apply, pi.add_apply, function.comp_app,
                                add_monoid_hom.add_apply, add_monoid_hom.mk'_apply, coe_add] })

@[simp] lemma comp_zero (f : normed_group_hom V₂ V₃) : f.comp (0 : normed_group_hom V₁ V₂) = 0 :=
by { ext, exact f.map_zero }

@[simp] lemma zero_comp (f : normed_group_hom V₁ V₂) : (0 : normed_group_hom V₂ V₃).comp f = 0 :=
by { ext, refl }

lemma comp_assoc {V₄: Type* } [semi_normed_group V₄] (h : normed_group_hom V₃ V₄)
  (g : normed_group_hom V₂ V₃) (f : normed_group_hom V₁ V₂) :
  (h.comp g).comp f = h.comp (g.comp f) :=
by { ext, refl }

lemma coe_comp (f : normed_group_hom V₁ V₂) (g : normed_group_hom V₂ V₃) :
  (g.comp f : V₁ → V₃) = (g : V₂ → V₃) ∘ (f : V₁ → V₂) := rfl

end normed_group_hom

namespace normed_group_hom

variables {V W V₁ V₂ V₃ : Type*}
variables [semi_normed_group V] [semi_normed_group W] [semi_normed_group V₁] [semi_normed_group V₂]
[semi_normed_group V₃]

/-- The inclusion of an `add_subgroup`, as bounded group homomorphism. -/
@[simps] def incl (s : add_subgroup V) : normed_group_hom s V :=
{ to_fun := (coe : s → V),
  map_add' := λ v w, add_subgroup.coe_add _ _ _,
  bound' := ⟨1, λ v, by { rw [one_mul], refl }⟩ }

lemma norm_incl {V' : add_subgroup V} (x : V') : ∥incl _ x∥ = ∥x∥ :=
rfl

/-!### Kernel -/
section kernels
variables (f : normed_group_hom V₁ V₂) (g : normed_group_hom V₂ V₃)

/-- The kernel of a bounded group homomorphism. Naturally endowed with a
`semi_normed_group` instance. -/
def ker : add_subgroup V₁ := f.to_add_monoid_hom.ker

lemma mem_ker (v : V₁) : v ∈ f.ker ↔ f v = 0 :=
by { erw f.to_add_monoid_hom.mem_ker, refl }

/-- Given a normed group hom `f : V₁ → V₂` satisfying `g.comp f = 0` for some `g : V₂ → V₃`,
    the corestriction of `f` to the kernel of `g`. -/
@[simps] def ker.lift (h : g.comp f = 0) :
  normed_group_hom V₁ g.ker :=
{ to_fun := λ v, ⟨f v, by { erw g.mem_ker, show (g.comp f) v = 0, rw h, refl }⟩,
  map_add' := λ v w, by { simp only [map_add], refl },
  bound' := f.bound' }

@[simp] lemma ker.incl_comp_lift (h : g.comp f = 0) :
  (incl g.ker).comp (ker.lift f g h) = f :=
by { ext, refl }

@[simp]
lemma ker_zero : (0 : normed_group_hom V₁ V₂).ker = ⊤ :=
by { ext, simp [mem_ker] }

lemma coe_ker : (f.ker : set V₁) = (f : V₁ → V₂) ⁻¹' {0} := rfl

lemma is_closed_ker {V₂ : Type*} [normed_group V₂] (f : normed_group_hom V₁ V₂) :
  is_closed (f.ker : set V₁) :=
f.coe_ker ▸ is_closed.preimage f.continuous (t1_space.t1 0)

end kernels

/-! ### Range -/
section range

variables (f : normed_group_hom V₁ V₂) (g : normed_group_hom V₂ V₃)

/-- The image of a bounded group homomorphism. Naturally endowed with a
`semi_normed_group` instance. -/
def range : add_subgroup V₂ := f.to_add_monoid_hom.range

lemma mem_range (v : V₂) : v ∈ f.range ↔ ∃ w, f w = v :=
by { rw [range, add_monoid_hom.mem_range], refl }

@[simp]
lemma mem_range_self (v : V₁) : f v ∈ f.range :=
⟨v, rfl⟩

lemma comp_range : (g.comp f).range = add_subgroup.map g.to_add_monoid_hom f.range :=
by { erw add_monoid_hom.map_range, refl }

lemma incl_range (s : add_subgroup V₁) : (incl s).range = s :=
by { ext x, exact ⟨λ ⟨y, hy⟩, by { rw ← hy; simp }, λ hx, ⟨⟨x, hx⟩, by simp⟩⟩ }

@[simp]
lemma range_comp_incl_top : (f.comp (incl (⊤ : add_subgroup V₁))).range = f.range :=
by simpa [comp_range, incl_range, ← add_monoid_hom.range_eq_map]

end range

variables {f : normed_group_hom V W}

/-- A `normed_group_hom` is *norm-nonincreasing* if `∥f v∥ ≤ ∥v∥` for all `v`. -/
def norm_noninc (f : normed_group_hom V W) : Prop :=
∀ v, ∥f v∥ ≤ ∥v∥

namespace norm_noninc

lemma norm_noninc_iff_norm_le_one : f.norm_noninc ↔ ∥f∥ ≤ 1 :=
begin
  refine ⟨λ h, _, λ h, λ v, _⟩,
  { refine op_norm_le_bound _ (zero_le_one) (λ v, _),
    simpa [one_mul] using h v },
  { simpa using le_of_op_norm_le f h v }
end

lemma zero : (0 : normed_group_hom V₁ V₂).norm_noninc :=
λ v, by simp

lemma id : (id V).norm_noninc :=
λ v, le_rfl

lemma comp {g : normed_group_hom V₂ V₃} {f : normed_group_hom V₁ V₂}
  (hg : g.norm_noninc) (hf : f.norm_noninc) :
  (g.comp f).norm_noninc :=
λ v, (hg (f v)).trans (hf v)

@[simp] lemma neg_iff {f : normed_group_hom V₁ V₂} : (-f).norm_noninc ↔ f.norm_noninc :=
⟨λ h x, by { simpa using h x }, λ h x, (norm_neg (f x)).le.trans (h x)⟩

end norm_noninc

section isometry

lemma isometry_iff_norm (f : normed_group_hom V W) :
  isometry f ↔ ∀ v, ∥f v∥ = ∥v∥ :=
add_monoid_hom.isometry_iff_norm f.to_add_monoid_hom

lemma isometry_of_norm (f : normed_group_hom V W) (hf : ∀ v, ∥f v∥ = ∥v∥) :
  isometry f :=
f.isometry_iff_norm.mpr hf

lemma norm_eq_of_isometry {f : normed_group_hom V W} (hf : isometry f) (v : V) :
  ∥f v∥ = ∥v∥ :=
f.isometry_iff_norm.mp hf v

lemma isometry_id : @isometry V V _ _ (id V) :=
isometry_id

lemma isometry_comp {g : normed_group_hom V₂ V₃} {f : normed_group_hom V₁ V₂}
  (hg : isometry g) (hf : isometry f) :
  isometry (g.comp f) :=
hg.comp hf

lemma norm_noninc_of_isometry (hf : isometry f) : f.norm_noninc :=
λ v, le_of_eq $ norm_eq_of_isometry hf v

end isometry

variables {W₁ W₂ W₃ : Type*} [semi_normed_group W₁] [semi_normed_group W₂] [semi_normed_group W₃]
variables (f) (g : normed_group_hom V W)
variables {f₁ g₁ : normed_group_hom V₁ W₁}
variables {f₂ g₂ : normed_group_hom V₂ W₂}
variables {f₃ g₃ : normed_group_hom V₃ W₃}

/-- The equalizer of two morphisms `f g : normed_group_hom V W`. -/
def equalizer := (f - g).ker

namespace equalizer

/-- The inclusion of `f.equalizer g` as a `normed_group_hom`. -/
def ι : normed_group_hom (f.equalizer g) V := incl _

lemma comp_ι_eq : f.comp (ι f g) = g.comp (ι f g) :=
by { ext, rw [comp_apply, comp_apply, ← sub_eq_zero, ← normed_group_hom.sub_apply], exact x.2 }

variables {f g}

/-- If `φ : normed_group_hom V₁ V` is such that `f.comp φ = g.comp φ`, the induced morphism
`normed_group_hom V₁ (f.equalizer g)`. -/
@[simps]
def lift (φ : normed_group_hom V₁ V) (h : f.comp φ = g.comp φ) :
  normed_group_hom V₁ (f.equalizer g) :=
{ to_fun := λ v, ⟨φ v, show (f - g) (φ v) = 0,
    by rw [normed_group_hom.sub_apply, sub_eq_zero, ← comp_apply, h, comp_apply]⟩,
  map_add' := λ v₁ v₂, by { ext, simp only [map_add, add_subgroup.coe_add, subtype.coe_mk] },
  bound' := by { obtain ⟨C, C_pos, hC⟩ := φ.bound, exact ⟨C, hC⟩ } }

@[simp] lemma ι_comp_lift (φ : normed_group_hom V₁ V) (h : f.comp φ = g.comp φ) :
  (ι _ _).comp (lift φ h) = φ :=
by { ext, refl }

/-- The lifting property of the equalizer as an equivalence. -/
@[simps]
def lift_equiv : {φ : normed_group_hom V₁ V // f.comp φ = g.comp φ} ≃
  normed_group_hom V₁ (f.equalizer g) :=
{ to_fun := λ φ, lift φ φ.prop,
  inv_fun := λ ψ, ⟨(ι f g).comp ψ, by { rw [← comp_assoc, ← comp_assoc, comp_ι_eq] }⟩,
  left_inv := λ φ, by simp,
  right_inv := λ ψ, by { ext, refl } }

/-- Given `φ : normed_group_hom V₁ V₂` and `ψ : normed_group_hom W₁ W₂` such that
`ψ.comp f₁ = f₂.comp φ` and `ψ.comp g₁ = g₂.comp φ`, the induced morphism
`normed_group_hom (f₁.equalizer g₁) (f₂.equalizer g₂)`. -/
def map (φ : normed_group_hom V₁ V₂) (ψ : normed_group_hom W₁ W₂)
  (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ) :
  normed_group_hom (f₁.equalizer g₁) (f₂.equalizer g₂) :=
lift (φ.comp $ ι _ _) $
by { simp only [← comp_assoc, ← hf, ← hg], simp only [comp_assoc, comp_ι_eq] }

variables {φ : normed_group_hom V₁ V₂} {ψ : normed_group_hom W₁ W₂}
variables {φ' : normed_group_hom V₂ V₃} {ψ' : normed_group_hom W₂ W₃}

@[simp] lemma ι_comp_map (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ) :
  (ι f₂ g₂).comp (map φ ψ hf hg) = φ.comp (ι _ _) :=
ι_comp_lift _ _

@[simp] lemma map_id : map (id V₁) (id W₁) rfl rfl = id (f₁.equalizer g₁) :=
by { ext, refl }

lemma comm_sq₂ (hf : ψ.comp f₁ = f₂.comp φ) (hf' : ψ'.comp f₂ = f₃.comp φ') :
  (ψ'.comp ψ).comp f₁ = f₃.comp (φ'.comp φ) :=
by rw [comp_assoc, hf, ← comp_assoc, hf', comp_assoc]

lemma map_comp_map (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ)
  (hf' : ψ'.comp f₂ = f₃.comp φ') (hg' : ψ'.comp g₂ = g₃.comp φ') :
  (map φ' ψ' hf' hg').comp (map φ ψ hf hg) =
    map (φ'.comp φ) (ψ'.comp ψ) (comm_sq₂ hf hf') (comm_sq₂ hg hg') :=
by { ext, refl }

lemma ι_norm_noninc : (ι f g).norm_noninc := λ v, le_rfl

/-- The lifting of a norm nonincreasing morphism is norm nonincreasing. -/
lemma lift_norm_noninc (φ : normed_group_hom V₁ V) (h : f.comp φ = g.comp φ) (hφ : φ.norm_noninc) :
  (lift φ h).norm_noninc :=
hφ

/-- If `φ` satisfies `∥φ∥ ≤ C`, then the same is true for the lifted morphism. -/
lemma norm_lift_le (φ : normed_group_hom V₁ V) (h : f.comp φ = g.comp φ)
  (C : ℝ) (hφ : ∥φ∥ ≤ C) : ∥(lift φ h)∥ ≤ C := hφ

lemma map_norm_noninc (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ)
  (hφ : φ.norm_noninc) : (map φ ψ hf hg).norm_noninc :=
lift_norm_noninc _ _ $ hφ.comp ι_norm_noninc

lemma norm_map_le (hf : ψ.comp f₁ = f₂.comp φ) (hg : ψ.comp g₁ = g₂.comp φ)
  (C : ℝ) (hφ : ∥φ.comp (ι f₁ g₁)∥ ≤ C) : ∥map φ ψ hf hg∥ ≤ C :=
norm_lift_le _ _ _ hφ

end equalizer

end normed_group_hom

section controlled_closure
open filter finset
open_locale topological_space
variables {G : Type*} [normed_group G] [complete_space G]
variables {H : Type*} [normed_group H]

/-- Given `f : normed_group_hom G H` for some complete `G` and a subgroup `K` of `H`, if every
element `x` of `K` has a preimage under `f` whose norm is at most `C*∥x∥` then the same holds for
elements of the (topological) closure of `K` with constant `C+ε` instead of `C`, for any
positive `ε`.
-/
lemma controlled_closure_of_complete  {f : normed_group_hom G H} {K : add_subgroup H}
  {C ε : ℝ} (hC : 0 < C) (hε : 0 < ε) (hyp : f.surjective_on_with K C) :
  f.surjective_on_with K.topological_closure (C + ε) :=
begin
  rintros (h : H) (h_in : h ∈ K.topological_closure),
  /- We first get rid of the easy case where `h = 0`.-/
  by_cases hyp_h : h = 0,
  { rw hyp_h,
    use 0,
    simp },
  /- The desired preimage will be constructed as the sum of a series. Convergence of
  the series will be guaranteed by completeness of `G`. We first write `h` as the sum
  of a sequence `v` of elements of `K` which starts close to `h` and then quickly goes to zero.
  The sequence `b` below quantifies this. -/
  set b : ℕ → ℝ := λ i, (1/2)^i*(ε*∥h∥/2)/C,
  have b_pos : ∀ i, 0 < b i,
  { intro i,
    field_simp [b, hC],
    exact div_pos (mul_pos hε (norm_pos_iff.mpr hyp_h))
                  (mul_pos (by norm_num : (0 : ℝ) < 2^i*2) hC) },
  obtain ⟨v : ℕ → H, lim_v : tendsto (λ (n : ℕ), ∑ k in range (n + 1), v k) at_top (𝓝 h),
    v_in : ∀ n, v n ∈ K, hv₀ : ∥v 0 - h∥ < b 0, hv : ∀ n > 0, ∥v n∥ < b n⟩ :=
    controlled_sum_of_mem_closure h_in b_pos,
  /- The controlled surjectivity assumption on `f` allows to build preimages `u n` for all
  elements `v n` of the `v` sequence.-/
  have : ∀ n, ∃ m' : G, f m' = v n ∧ ∥m'∥ ≤ C * ∥v n∥ := λ (n : ℕ), hyp (v n) (v_in n),
  choose u hu hnorm_u using this,
  /- The desired series `s` is then obtained by summing `u`. We then check our choice of
  `b` ensures `s` is Cauchy. -/
  set s : ℕ → G := λ n, ∑ k in range (n+1), u k,
  have : cauchy_seq s,
  { apply normed_group.cauchy_series_of_le_geometric'' (by norm_num) one_half_lt_one,
    rintro n (hn : n ≥ 1),
    calc ∥u n∥ ≤ C*∥v n∥ : hnorm_u n
    ... ≤ C * b n : mul_le_mul_of_nonneg_left (hv _ $ nat.succ_le_iff.mp hn).le hC.le
    ... = (1/2)^n * (ε * ∥h∥/2) : by simp [b, mul_div_cancel' _ hC.ne.symm]
    ... = (ε * ∥h∥/2) * (1/2)^n : mul_comm _ _ },
  /- We now show that the limit `g` of `s` is the desired preimage. -/
  obtain ⟨g : G, hg⟩ := cauchy_seq_tendsto_of_complete this,
  refine ⟨g, _, _⟩,
  { /- We indeed get a preimage. First note: -/
    have : f ∘ s = λ n, ∑ k in range (n + 1), v k,
    { ext n,
      simp [f.map_sum, hu] },
    /- In the above equality, the left-hand-side converges to `f g` by continuity of `f` and
       definition of `g` while the right-hand-side converges to `h` by construction of `v` so
       `g` is indeed a preimage of `h`. -/
    rw ← this at lim_v,
    exact tendsto_nhds_unique ((f.continuous.tendsto g).comp hg) lim_v },
  { /- Then we need to estimate the norm of `g`, using our careful choice of `b`. -/
    suffices : ∀ n, ∥s n∥ ≤ (C + ε) * ∥h∥,
      from le_of_tendsto' (continuous_norm.continuous_at.tendsto.comp hg) this,
    intros n,
    have hnorm₀ : ∥u 0∥ ≤ C*b 0 + C*∥h∥,
    { have := calc
      ∥v 0∥ ≤ ∥h∥ + ∥v 0 - h∥ : norm_le_insert' _ _
      ... ≤ ∥h∥ + b 0 : by apply add_le_add_left hv₀.le,
      calc ∥u 0∥ ≤ C*∥v 0∥ : hnorm_u 0
      ... ≤ C*(∥h∥ + b 0) : mul_le_mul_of_nonneg_left this hC.le
      ... = C * b 0 + C * ∥h∥ : by rw [add_comm, mul_add] },
    have : ∑ k in range (n + 1), C * b k ≤ ε * ∥h∥ := calc
      ∑ k in range (n + 1), C * b k = (∑ k in range (n + 1), (1 / 2) ^ k) * (ε * ∥h∥ / 2) :
                     by simp only [b, mul_div_cancel' _ hC.ne.symm, ← sum_mul]
      ... ≤  2 * (ε * ∥h∥ / 2) : mul_le_mul_of_nonneg_right (sum_geometric_two_le _)
                                                            (by nlinarith [hε, norm_nonneg h])
      ... = ε * ∥h∥ : mul_div_cancel' _ two_ne_zero,
    calc ∥s n∥ ≤ ∑ k in range (n+1), ∥u k∥ : norm_sum_le _ _
    ... = ∑ k in range n, ∥u (k + 1)∥ + ∥u 0∥ : sum_range_succ' _ _
    ... ≤ ∑ k in range n, C*∥v (k + 1)∥ + ∥u 0∥ : add_le_add_right (sum_le_sum (λ _ _, hnorm_u _)) _
    ... ≤ ∑ k in range n, C*b (k+1) + (C*b 0 + C*∥h∥) :
      add_le_add (sum_le_sum (λ k _, mul_le_mul_of_nonneg_left (hv _ k.succ_pos).le hC.le)) hnorm₀
    ... = ∑ k in range (n+1), C*b k + C*∥h∥ : by rw [← add_assoc, sum_range_succ']
    ... ≤ (C+ε)*∥h∥ : by { rw [add_comm, add_mul], apply add_le_add_left this } }
end

/-- Given `f : normed_group_hom G H` for some complete `G`, if every element `x` of the image of
an isometric immersion `j : normed_group_hom K H` has a preimage under `f` whose norm is at most
`C*∥x∥` then the same holds for elements of the (topological) closure of this image with constant
`C+ε` instead of `C`, for any positive `ε`.
This is useful in particular if `j` is the inclusion of a normed group into its completion
(in this case the closure is the full target group).
-/
lemma controlled_closure_range_of_complete {f : normed_group_hom G H}
  {K : Type*} [semi_normed_group K] {j : normed_group_hom K H} (hj : ∀ x, ∥j x∥ = ∥x∥)
  {C ε : ℝ} (hC : 0 < C) (hε : 0 < ε) (hyp : ∀ k, ∃ g, f g = j k ∧ ∥g∥ ≤ C*∥k∥) :
  f.surjective_on_with j.range.topological_closure (C + ε) :=
begin
  replace hyp : ∀ h ∈ j.range, ∃ g, f g = h ∧ ∥g∥ ≤ C*∥h∥,
  { intros h h_in,
    rcases (j.mem_range _).mp h_in with ⟨k, rfl⟩,
    rw hj,
    exact hyp k },
  exact controlled_closure_of_complete hC hε hyp
end
end controlled_closure


/-
Copyright (c) 2022 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import Std.Data.Ord
import Std.Tactic.Simpa

/-! ## Ordering -/

@[simp] theorem Ordering.swap_swap {o : Ordering} : o.swap.swap = o := by cases o <;> rfl

@[simp] theorem Ordering.swap_inj {o₁ o₂ : Ordering} : o₁.swap = o₂.swap ↔ o₁ = o₂ :=
  ⟨fun h => by simpa using congrArg swap h, congrArg _⟩

namespace Std

/-- `TotalBLE le` asserts that `le` has a total order, that is, `le a b ∨ le b a`. -/
class TotalBLE (le : α → α → Bool) : Prop where
  /-- `le` is total: either `le a b` or `le b a`. -/
  total : le a b ∨ le b a

/-- `OrientedCmp cmp` asserts that `cmp` is determined by the relation `cmp x y = .lt`. -/
class OrientedCmp (cmp : α → α → Ordering) : Prop where
  /-- The comparator operation is symmetric, in the sense that if `cmp x y` equals `.lt` then
  `cmp y x = .gt` and vice versa. -/
  symm (x y) : (cmp x y).swap = cmp y x

namespace OrientedCmp

theorem cmp_eq_gt [OrientedCmp cmp] : cmp x y = .gt ↔ cmp y x = .lt := by
  rw [← Ordering.swap_inj, symm]; exact .rfl

theorem cmp_eq_eq_symm [OrientedCmp cmp] : cmp x y = .eq ↔ cmp y x = .eq := by
  rw [← Ordering.swap_inj, symm]; exact .rfl

theorem cmp_refl [OrientedCmp cmp] : cmp x x = .eq :=
  match e : cmp x x with
  | .lt => nomatch e.symm.trans (cmp_eq_gt.2 e)
  | .eq => rfl
  | .gt => nomatch (cmp_eq_gt.1 e).symm.trans e

end OrientedCmp

/-- `TransCmp cmp` asserts that `cmp` induces a transitive relation. -/
class TransCmp (cmp : α → α → Ordering) extends OrientedCmp cmp : Prop where
  /-- The comparator operation is transitive. -/
  le_trans : cmp x y ≠ .gt → cmp y z ≠ .gt → cmp x z ≠ .gt

namespace TransCmp
variable [TransCmp cmp]
open OrientedCmp Decidable

theorem ge_trans (h₁ : cmp x y ≠ .lt) (h₂ : cmp y z ≠ .lt) : cmp x z ≠ .lt := by
  have := @TransCmp.le_trans _ cmp _ z y x
  simp [cmp_eq_gt] at *; exact this h₂ h₁

theorem lt_asymm (h : cmp x y = .lt) : cmp y x ≠ .lt :=
  fun h' => nomatch h.symm.trans (cmp_eq_gt.2 h')

theorem gt_asymm (h : cmp x y = .gt) : cmp y x ≠ .gt :=
  mt cmp_eq_gt.1 <| lt_asymm <| cmp_eq_gt.1 h

theorem le_lt_trans (h₁ : cmp x y ≠ .gt) (h₂ : cmp y z = .lt) : cmp x z = .lt :=
  byContradiction fun h₃ => ge_trans (mt cmp_eq_gt.2 h₁) h₃ h₂

theorem lt_le_trans (h₁ : cmp x y = .lt) (h₂ : cmp y z ≠ .gt) : cmp x z = .lt :=
  byContradiction fun h₃ => ge_trans h₃ (mt cmp_eq_gt.2 h₂) h₁

theorem lt_trans (h₁ : cmp x y = .lt) (h₂ : cmp y z = .lt) : cmp x z = .lt :=
  le_lt_trans (gt_asymm <| cmp_eq_gt.2 h₁) h₂

theorem gt_trans (h₁ : cmp x y = .gt) (h₂ : cmp y z = .gt) : cmp x z = .gt := by
  rw [cmp_eq_gt] at h₁ h₂ ⊢; exact lt_trans h₂ h₁

theorem cmp_congr_left (xy : cmp x y = .eq) : cmp x z = cmp y z :=
  match yz : cmp y z with
  | .lt => byContradiction (ge_trans (nomatch ·.symm.trans (cmp_eq_eq_symm.1 xy)) · yz)
  | .gt => byContradiction (le_trans (nomatch ·.symm.trans (cmp_eq_eq_symm.1 xy)) · yz)
  | .eq => match xz : cmp x z with
    | .lt => nomatch ge_trans (nomatch ·.symm.trans xy) (nomatch ·.symm.trans yz) xz
    | .gt => nomatch le_trans (nomatch ·.symm.trans xy) (nomatch ·.symm.trans yz) xz
    | .eq => rfl

theorem cmp_congr_right [TransCmp cmp] (yz : cmp y z = .eq) : cmp x y = cmp x z := by
  rw [← Ordering.swap_inj, symm, symm, cmp_congr_left yz]

end TransCmp

/-- Pull back a comparator by a function `f`, by applying the comparator to both arguments. -/
@[inline] def byKey (f : α → β) (cmp : β → β → Ordering) (a b : α) : Ordering := cmp (f a) (f b)

instance (f : α → β) (cmp : β → β → Ordering) [OrientedCmp cmp] : OrientedCmp (byKey f cmp) where
  symm a b := OrientedCmp.symm (f a) (f b)

instance (f : α → β) (cmp : β → β → Ordering) [TransCmp cmp] : TransCmp (byKey f cmp) where
  le_trans h₁ h₂ := TransCmp.le_trans (α := β) h₁ h₂

instance (f : α → β) (cmp : β → β → Ordering) [TransCmp cmp] : TransCmp (byKey f cmp) where
  le_trans h₁ h₂ := TransCmp.le_trans (α := β) h₁ h₂


import algebra.pi_instances algebra.half_ring data.finset

/-- A function which is defined everywhere, but only has "interesting" values in
    a finite set of locations.

    This is used to define a basic vector space, where every defined basis is
    known. -/
structure fin_fn (α : Type*) (β : Type*) [has_zero β] :=
  (space : α → β)
  (support : finset α)
  (support_iff : ∀ x, space x ≠ 0 ↔ x ∈ support)

namespace fin_fn

section helpers
  variables {α : Type*} {β₁ : Type*} {β₂ : Type*} {β : Type*} [has_zero β₁] [has_zero β₂] [has_zero β]

  /-- Map over a finite set, assuming the support set doesn't grow. -/
  def on_finset [decidable_eq β] (s : finset α) (f : α → β) (hf : ∀a, f a ≠ 0 → a ∈ s) : fin_fn α β :=
    ⟨ f,
      s.filter (λa, f a ≠ 0),
      λ x, ⟨ λ h, finset.mem_filter.mpr ⟨ hf x h, h ⟩, λ h, (finset.mem_filter.mp h).2 ⟩ ⟩

  /-- Zip over two support sets, assuming the operation preserves 0. -/
  def zip_with [decidable_eq α] [decidable_eq β₁] [decidable_eq β]
    (f : β₁ → β₂ → β) (zero : f 0 0 = 0) (g₁ : fin_fn α β₁) (g₂ : fin_fn α β₂) : (fin_fn α β) :=
    on_finset (g₁.support ∪ g₂.support) (λa, f (g₁.space a) (g₂.space a)) (λ a not_zero, begin
      rw [finset.mem_union, (g₁.support_iff _).symm, (g₂.support_iff _).symm, ne, ← not_and_distrib],
      rintro ⟨ h₁, h₂ ⟩, rw [h₁, h₂] at not_zero, from not_zero zero,
    end)

  /-- Function extensionality lifted to fin_fns. -/
  @[ext]
  lemma ext : ∀ {f g : fin_fn α β}, (∀ a, f.space a = g.space a) → f = g
  | ⟨ f, sf, iff_f ⟩ ⟨ g, sg, iff_g ⟩ lift := begin
    have : f = g := funext lift, subst this,
    have : sf = sg := finset.ext' (λ a, (iff_f a).symm.trans (iff_g a)), subst this,
  end

  /-- Apply a 0-preserving function over the range of our fin_fn. -/
  def map_range [decidable_eq β] (f : β₁ → β) (zero : f 0 = 0) (g : fin_fn α β₁) : fin_fn α β :=
    on_finset g.support (f ∘ g.space) (λ a not_zero, begin
      rw [(g.support_iff _).symm],
      assume is_zero, rw [function.comp_app, is_zero] at not_zero, from not_zero zero,
    end)

  lemma unsupported_zero [decidable_eq β] {x : α} {f : fin_fn α β} : x ∉ f.support ↔ f.space x = 0
    := ⟨ λ nmem, by_contradiction (λ h, nmem ((f.support_iff x).mp h)),
         λ zero mem, (f.support_iff x).mpr mem zero ⟩

  /-- Function extensionality lifted to fin_fns. -/
  lemma ext' [decidable_eq β] : ∀ {f g : fin_fn α β}, f.support = g.support → (∀ a ∈ f.support, f.space a = g.space a) → f = g
  | ⟨ f, sf, iff_f ⟩ ⟨ g, _, iff_g ⟩ eql lift := begin
    simp only [] at eql, subst eql,
    suffices : ∀ a, f a = g a, from ext this,

    assume a,
    cases classical.prop_decidable (a ∈ sf),
    case is_true { from lift a h },
    case is_false {
      have : f a = 0,
      { have : a ∉ (fin_fn.mk f sf iff_f).support := h,
        from (unsupported_zero.mp this) },
      have : g a = 0,
      { have : a ∉ (fin_fn.mk g sf iff_g).support := h,
        from (unsupported_zero.mp this) },

      rw [‹f a = 0›, ‹g a = 0›],
    }
  end

  /-- Convert this fin_fn to a string, using a specific separator (such as "+"). -/
  protected def to_string [has_repr α] [has_repr β] : string → fin_fn α β → string
  | sep x := string.intercalate sep ((x.support.val.map (λ a, repr (x.space a) ++ " • " ++ repr a)).sort (≤))
end helpers

section monoid_instances
  variables (α : Type*) (β : Type*)

  instance [has_repr α] [has_repr β] [has_zero β] : has_repr (fin_fn α β) := ⟨ fin_fn.to_string "+" ⟩

  instance [has_zero β] : has_zero (fin_fn α β)
    := ⟨ { space := λ _, 0,
          support := finset.empty,
          support_iff := λ x, ⟨ λ nZero, by contradiction, λ x, by cases x ⟩ } ⟩

  instance [has_zero β] : inhabited (fin_fn α β) := ⟨ 0 ⟩

  instance [add_monoid β] [decidable_eq α] [decidable_eq β] : has_add (fin_fn α β) :=
    { add := zip_with (+) (add_zero 0) }

  instance [add_monoid β] [decidable_eq α] [decidable_eq β] : add_monoid (fin_fn α β) :=
    { add_assoc := λ a b c, ext (λ x, add_assoc _ _ _),
      zero_add := λ a, ext (λ x, zero_add _),
      add_zero := λ a, ext (λ x, add_zero _),
      ..fin_fn.has_add α β,
      ..fin_fn.has_zero α β }

  instance [add_comm_monoid β] [decidable_eq α] [decidable_eq β]
    : add_comm_monoid (fin_fn α β) :=
    { add_comm := λ a b, ext (λ x, add_comm _ _),
      ..fin_fn.add_monoid α β }

  instance [add_group β] [decidable_eq β] : has_neg (fin_fn α β) :=
    { neg := map_range has_neg.neg neg_zero }

  instance [add_comm_group β] [decidable_eq α] [decidable_eq β] : add_comm_group (fin_fn α β) :=
    { add_left_neg := λ f, ext (λ a, add_left_neg _),
      ..fin_fn.add_comm_monoid α β,
      ..fin_fn.has_neg α β  }

  instance [semiring β] [decidable_eq β]
    : has_scalar β (fin_fn α β)
    := { smul := λ a, map_range ((•) a) (smul_zero _) }

  instance [comm_ring β] [decidable_eq β]
    : mul_action β (fin_fn α β) :=
    { one_smul := λ f, ext (λ a, one_smul _ _),
      mul_smul := λ x y f, ext (λ a, mul_smul _ _ _),
    ..fin_fn.has_scalar α β }

  instance [comm_ring β] [decidable_eq α] [decidable_eq β]
    : distrib_mul_action β (fin_fn α β) :=
    { smul_add := λ r x y, ext (λ a, smul_add _ _ _),
      smul_zero := λ r, ext (λ a, smul_zero _),
      ..fin_fn.mul_action α β }

  instance [comm_ring β] [decidable_eq α] [decidable_eq β]
    : semimodule β (fin_fn α β) :=
    { add_smul := λ r s f, ext (λ a, right_distrib _ _ _),
      zero_smul := λ f, ext (λ a, zero_mul _),
      ..fin_fn.distrib_mul_action α β,
    }

  instance [has_zero β] [decidable_eq α] [decidable_eq β] : decidable_eq (fin_fn α β)
  | ⟨ a_f, a_space, a_iff ⟩ ⟨ b_f, b_space, b_iff ⟩ :=
    if eq_space : a_space = b_space then
      if eq_f : ∀ a ∈ a_space, a_f a = b_f a then
        is_true (ext' eq_space eq_f)
      else is_false (λ x, begin
        have h := (fin_fn.mk.inj x).1, subst h,
        from eq_f (λ x mem, rfl),
      end)
    else is_false (λ x, eq_space (fin_fn.mk.inj x).2)

  instance [add_monoid β] [decidable_eq α] [decidable_eq β] (a : α) : is_add_monoid_hom (λ f : fin_fn α β, f.space a)
    := { map_add := λ a b, rfl, map_zero := rfl }

end monoid_instances

section bulk_operations
variables {α : Type*} {β : Type*}

/-- Construct a fin_fn from a single value A. This returns a unit vector in the
    basis of 'A'. -/
def single [has_zero β] [decidable_eq α] [decidable_eq β] (A : α) (b : β) : fin_fn α β :=
  { space := λ B, if A = B then b else 0,
    support := if 0 = b then ∅ else finset.singleton A,
    support_iff := λ B, begin
      by_cases is_zero : 0 = b; by_cases is_eq : A = B; simp only [is_zero, is_eq, if_pos, if_false],
      { from ⟨ λ x, by contradiction, false.elim ⟩ },
      { from ⟨ λ x, by contradiction, false.elim ⟩ },
      { from ⟨ λ _, finset.mem_singleton.mpr rfl, λ _, ne.symm is_zero ⟩ },
      { from ⟨ λ x, by contradiction, λ mem, absurd (finset.mem_singleton.mp mem).symm is_eq ⟩ },
    end }

lemma single.inj [has_zero β] [decidable_eq α] [decidable_eq β] (A : α)
  : function.injective (@single α β _ _ _ A)
| b₁ b₂ eql := begin
  have : (single A b₁).space A = (single A b₂).space A, rw eql,
  simpa only [single, if_pos] using this,
end

@[simp]
lemma single_zero [has_zero β] [decidable_eq α] [decidable_eq β] (a : α) : single a (0 : β) = 0
  := by { simp only [single, if_pos, if_t_t], from rfl }

@[simp]
lemma single_add [add_monoid β] [decidable_eq α] [decidable_eq β] (a : α) (b₁ b₂ : β) :
  single a (b₁ + b₂) = single a b₁ + single a b₂
  := ext (λ x, begin
    show ite (a = x) (b₁ + b₂) 0 = ite (a = x) b₁ 0 + ite (a = x) b₂ 0,
    by_cases a = x; simp only [h, if_pos, if_false, add_zero],
  end)

/-- `sum f g` is the sum of `g a (f a)` over the support of `f`. -/
def sum {γ : Type*} [has_zero β] [add_comm_monoid γ] (f : fin_fn α β) (g : α → β → γ) : γ
  := f.support.sum (λa, g a (f.space a))

@[simp]
lemma sum_single_index {γ : Type*} [add_comm_monoid γ] [comm_ring β] [decidable_eq α] [decidable_eq β]
  (a : α) (b : β) (f : α → β → γ) (zero : ∀ x, f x 0 = 0): (single a b).sum f = f a b := begin
  by_cases 0 = b; simp only [sum, single, if_pos, if_false, h],
  { simp only [finset.sum_empty, h.symm, zero] },
  { simp only [finset.sum_singleton, if_pos] },
end

lemma sum_distrib {γ : Type*} [decidable_eq α] [decidable_eq β] [add_comm_monoid β] [add_comm_monoid γ] {x y : fin_fn α β}
  {h : α → β → γ} (h_zero : ∀ a, h a 0 = 0) (h_add : ∀a b₁ b₂, h a (b₁ + b₂) = h a b₁ + h a b₂) :
  (x + y).sum h = x.sum h + y.sum h := begin
  show finset.sum (finset.filter (λ a, x.space a + y.space a ≠ 0) (x.support ∪ y.support))
          (λ a, h a (x.space a + y.space a))
     = x.sum h + y.sum h,

  have : finset.sum (finset.filter (λ a, x.space a + y.space a ≠ 0) (x.support ∪ y.support))
           (λ a, h a (x.space a + y.space a))
       = finset.sum (x.support ∪ y.support) (λ a, h a (x.space a + y.space a))
       := finset.sum_subset (finset.filter_subset (x.support ∪ y.support)) (λ a mem not_mem, begin
      suffices : x.space a + y.space a = 0, simp only [h_zero, this],

      by_contradiction not_zero,
      have h := finset.mem_sdiff.mpr ⟨ mem, not_mem ⟩,
      rw ← finset.filter_not at h,
      from (finset.mem_filter.mp h).2 not_zero,
    end),
  rw this,

  have hx : x.sum h = finset.sum (x.support ∪ y.support) (λ a, h a (x.space a))
    := finset.sum_subset (finset.subset_union_left x.support y.support)
        (λ a mem not_x, by simp only [unsupported_zero.mp not_x, h_zero]),
  have hy : y.sum h = finset.sum (x.support ∪ y.support) (λ a, h a (y.space a))
    := finset.sum_subset (finset.subset_union_right x.support y.support)
        (λ a mem not_y, by simp only [unsupported_zero.mp not_y, h_zero]),

  simp only [hx, hy, h_add, finset.sum_add_distrib],
end

@[simp]
lemma sum_zero {γ : Type*} [has_zero β] [add_comm_monoid γ] (f : α → β → γ) : sum 0 f = 0 := rfl

@[simp]
lemma sum_const_zero {γ : Type*} [has_zero β] [add_comm_monoid γ] (f : fin_fn α β): sum f (λ _ _, (0 : γ)) = 0
  := finset.sum_const_zero

/-- Map every basis in the fin_fn to another fin_fn, accumulating them together. -/
def bind {γ : Type*} [decidable_eq γ] [decidable_eq β] [semiring β] (f : fin_fn α β) (g : α → fin_fn γ β) : fin_fn γ β
  := sum f (λ x c, c • g x)

@[simp]
lemma bind_zero {γ : Type} [decidable_eq γ] [decidable_eq β] [semiring β] (f : α → fin_fn γ β) : bind 0 f = 0 := sum_zero _

lemma empty_zero [has_zero β] [decidable_eq β] : ∀ (f : fin_fn α β), f.support = ∅ → f = 0
| ⟨ f, _, iff ⟩ ⟨ _ ⟩ := ext (λ x, by_contradiction (iff x).mp)

@[simp]
lemma sum_sum_index {γ : Type*} {α₁: Type*} {β₁ : Type*} [decidable_eq α] [decidable_eq α₁] [decidable_eq β]
  [add_comm_monoid β₁] [add_comm_monoid β] [add_comm_monoid γ]
  {f : fin_fn α₁ β₁} {g : α₁ → β₁ → fin_fn α β}
  {h : α → β → γ} (h_zero : ∀a, h a 0 = 0) (h_add : ∀a b₁ b₂, h a (b₁ + b₂) = h a b₁ + h a b₂) :
  (f.sum g).sum h = f.sum (λa b, (g a b).sum h) := begin
    show (finset.sum f.support (λ (a : α₁), g a (f.space a))).sum h
       = finset.sum f.support _,
    induction f.support using finset.induction_on with a s not_mem ih,
    from rfl,
    { rw [finset.sum_insert not_mem, finset.sum_insert not_mem, ← ih, sum_distrib h_zero h_add], },
  end

lemma bind_distrib {γ : Type} [comm_ring β] [decidable_eq α] [decidable_eq γ] [decidable_eq β] :
  ∀ (x y : fin_fn α β) (f : α → fin_fn γ β)
  , bind (x + y) f = bind x f + bind y f
| x y f := begin
  have zero : ∀ a, (λ (x : α) (c : β), c • f x) a 0 = 0 := λ _, by simp only [zero_smul],
  have add : ∀ (a : α) (b₁ b₂ : β)
           , (λ (x : α) (c : β), c • f x) a (b₁ + b₂)
           = (λ (x : α) (c : β), c • f x) a b₁ + (λ (x : α) (c : β), c • f x) a b₂
           := λ _ _ _, by simp only [add_smul],
  simp only [sum_distrib zero add, bind],
end

lemma bind_smul {γ : Type} [comm_ring β] [decidable_eq α] [decidable_eq γ] [decidable_eq β] :
  ∀ (c : β) (x : fin_fn α β) (f : α → fin_fn γ β)
  , c • bind x f = bind (c • x) f
| c x f := begin
  simp only [bind, sum],

  have : (c • x).support ⊆ x.support := finset.filter_subset _,
  rw finset.sum_subset this (λ a mem not_mem, begin
    show (λ a, (c • x).space a • f a) a = 0,
    simp only [],
    rw [unsupported_zero.mp not_mem, zero_smul],
  end), simp only [], clear this,

  -- Then follow the same proof as prod_pow.
  induction x.support using finset.induction_on with a f not_mem ih,
  { simp only [finset.sum_empty, smul_zero] },
  {
    simp only [finset.sum_insert not_mem],
    rw [smul_add, ← mul_smul, ih],
    from rfl,
  },
end

/-- `bind`, lifted to two `fin_fn`s. -/
def bind₂ {γ η : Type} [decidable_eq η] [decidable_eq β] [semiring β]
  : fin_fn α β → fin_fn γ β → (α → γ → fin_fn η β) → fin_fn η β
| x y f := bind x (λ a, bind y (f a))

lemma bind₂_zero {γ η : Type} [decidable_eq η] [decidable_eq β] [semiring β]  (f : α → γ → fin_fn η β) :
  bind₂ 0 0 f = 0 := rfl

lemma bind₂_zero_right {γ η : Type} [decidable_eq η] [decidable_eq β] [semiring β]
  (x : fin_fn γ β) (f : α → γ → fin_fn η β) :
  bind₂ 0 x f = 0 := rfl

/-- It doesn't matter which order we do our bind in! -/
lemma bind₂_swap {α β γ η : Type*} [decidable_eq η] [decidable_eq β] [comm_ring β] :
  ∀ (x : fin_fn α β) (y : fin_fn γ β) (f : (α → γ → fin_fn η β))
  , bind₂ x y f = bind₂ y x (λ x y, f y x)
| x y f := begin
  show finset.sum x.support (λ a, x.space a • finset.sum y.support (λ b, y.space b • f a b))
     = finset.sum y.support (λ a, y.space a • finset.sum x.support (λ b, x.space b • f b a)),

  have : ∀ a b, y.space a • x.space b • f b a = x.space b • y.space a • f b a
    := λ a b, smul_comm (y.space a) _ _,
  simp only [finset.smul_sum, this],

  simp only [finset.sum_eq_multiset_sum],
  from multiset.sum_map_sum_map x.support.val y.support.val,
end

lemma bind₂_zero_left {α β γ η : Type} [decidable_eq β] [decidable_eq η] [comm_ring β]
  (x : fin_fn α β) (f : α → γ → fin_fn η β) :
  bind₂ x 0 f = 0 := by { rw (bind₂_swap x 0 f), from rfl }

@[simp]
lemma bind_single {γ : Type} [comm_ring β] [decidable_eq α] [decidable_eq γ] [decidable_eq β] :
  ∀ (a : α) (b : β) (f : α → fin_fn γ β)
  , bind (single a b) f = b • f a
| a b f := sum_single_index a b _ (λ x, zero_smul _ _)

@[simp]
lemma sum_single [decidable_eq α] [decidable_eq β] [add_comm_monoid β] (f : fin_fn α β)
  : f.sum single = f := begin
  suffices : ∀ (a : α), (sum f single).space a = f.space a, from ext this,
  assume a,

  suffices : finset.sum f.support (λ (x : α), ite (x = a) (f.space x) 0) = f.space a,
  { have h := (f.support.sum_hom (λ f : fin_fn α β, f.space a)).symm,
    refine trans h _,
    simp only [single, this] },

  by_cases h : a ∈ f.support,
  { have : (finset.singleton a : finset α) ⊆ f.support,
    { simpa only [finset.subset_iff, finset.mem_singleton, forall_eq] },

    rw ← finset.sum_subset this (λ b mem not_mem, begin
      show ite (b = a) (f.space b) 0 = 0,
      simp only [if_neg (finset.not_mem_singleton.mp not_mem)],
    end),
    simp only [finset.sum_singleton, if_pos (eq.refl a)],
  },

  {
    calc  finset.sum f.support (λ (x : α), ite (x = a) (f.space x) 0)
        = f.support.sum (λ a, (0 : β)) : finset.sum_congr rfl (λ b mem, begin
            by_cases (b = a), { subst h, contradiction },
            simp only [if_neg h],
          end)
    ... = 0 : finset.sum_const_zero
    ... = f.space a : (unsupported_zero.mp h).symm
  },
end

end bulk_operations

section group_instances
  variables (α : Type*) (β : Type*)

  instance [decidable_eq α] [decidable_eq β] [has_zero α] [has_zero β] [has_one β] : has_one (fin_fn α β) :=
    { one := single 0 1 }

  instance [decidable_eq α] [decidable_eq β] [has_add α] [semiring β] : has_mul (fin_fn α β) :=
    { mul := λ f g, f.sum $ λ a₁ b₁, g.sum $ λ a₂ b₂, single (a₁ + a₂) (b₁ * b₂) }

  instance [decidable_eq α] [decidable_eq β] [add_semigroup α] [comm_ring β] : semigroup (fin_fn α β)
    := { mul_assoc := λ a b c, begin
      show sum
        (sum a (λ (a₁ : α) (b₁ : β), sum b (λ (a₂ : α) (b₂ : β), single (a₁ + a₂) (b₁ * b₂))))
          (λ (a₁ : α) (b₁ : β), sum c (λ (a₂ : α) (b₂ : β), single (a₁ + a₂) (b₁ * b₂)))
      = sum a (λ (a₁ : α) (b₁ : β)
              , sum (sum b (λ (a₁ : α) (b₁ : β), sum c (λ (a₂ : α) (b₂ : β), single (a₁ + a₂) (b₁ * b₂))))
                    (λ (a₂ : α) (b₂ : β), single (a₁ + a₂) (b₁ * b₂))),

      have zero : ∀ (a' : α) (b' : β) a, (λ a b, single (a' + a) (b' * b)) a 0 = 0
        := λ _ _ a, by simp only [mul_zero, single_zero, sum_const_zero],

      have add : ∀ (a' : α) (b' : β) (a : α) (b₁ b₂ : β)
               , single (a' + a) (b' * (b₁ + b₂))
               = single (a' + a) (b' * b₁) + single (a' + a) (b' * b₂)
        := λ _ _ a b₁ b₂, by simp only [left_distrib, single_add],

      have this :
        ∀ (a : fin_fn α β) (f : α → β → fin_fn α β)
        , sum (sum a f) (λ a₁ b₁, sum c (λ a₂ b₂, single (a₁ + a₂) (b₁ * b₂)))
        = sum a (λ a b, sum (f a b) (λ a₁ b₁, sum c (λ a₂ b₂, single (a₁ + a₂) (b₁ * b₂))))
        := λ a f, sum_sum_index
            (λ a, by { simp only [zero_mul, single_zero, sum_const_zero] })
            (λ a b₁ b₂, by simp only [sum, right_distrib, single_add, finset.sum_add_distrib]),
      simp only [this], clear this,
      simp [sum_single_index, sum_sum_index (zero _ _) (add _ _), mul_assoc],
    end,
    ..fin_fn.has_mul α β }

  instance [decidable_eq α] [decidable_eq β] [add_monoid α] [comm_ring β] : monoid (fin_fn α β) :=
    { one_mul := λ a, begin
        show sum (single 0 1) (λ a₁ b₁, sum a (λ a₂ b₂, single (a₁ + a₂) (b₁ * b₂))) = a,
        simp,
      end,
      mul_one := λ a, begin
        show sum a (λ a₁ b₁, sum (single (0 : α) (1 : β)) (λ a₂ b₂, single (a₁ + a₂) (b₁ * b₂))) = a,
        simp,
      end,
      ..fin_fn.has_one α β,
      ..fin_fn.semigroup α β }

  instance [decidable_eq α] [decidable_eq β] [add_comm_monoid α] [comm_ring β] : comm_monoid (fin_fn α β) :=
    { mul_comm := λ a b, begin
        show sum a (λ a₁ b₁, sum b (λ a₂ b₂, single (a₁ + a₂) (b₁ * b₂)))
           = sum b (λ a₁ b₁, sum a (λ a₂ b₂, single (a₁ + a₂) (b₁ * b₂))),

        suffices : sum a (λ a₁ b₁, sum b (λ a₂ b₂, single (a₁ + a₂) (b₁ * b₂)))
                 = sum b (λ a₁ b₁, sum a (λ a₂ b₂, single (a₂ + a₁) (b₂ * b₁))),
        { simpa only [add_comm, mul_comm] using this },

        simp only [sum, finset.sum_eq_multiset_sum],
        from multiset.sum_map_sum_map a.support.val b.support.val,
      end
      ..fin_fn.monoid α β }

  instance [decidable_eq α] [decidable_eq β] [has_add α] [semiring β] : mul_zero_class (fin_fn α β) :=
    { zero_mul := λ x, by simp only [has_mul.mul, sum_zero],
      mul_zero := λ x, by simp only [has_mul.mul, sum_zero, sum_const_zero],
      ..fin_fn.has_zero α β,
      ..fin_fn.has_mul α β }

  instance [decidable_eq α] [decidable_eq β] [has_add α] [semiring β] : distrib (fin_fn α β) :=
    { left_distrib := λ a b c, begin
        show sum a (λ a₁ b₁, sum (b + c) (λ a₂ b₂, single (a₁ + a₂) (b₁ * b₂)))
           = sum a (λ a₁ b₁, sum b (λ a₂ b₂, single (a₁ + a₂) (b₁ * b₂)))
           + sum a (λ a₁ b₁, sum c (λ a₂ b₂, single (a₁ + a₂) (b₁ * b₂))),

        have zero : ∀ (a' : α) (b' : β) a, (λ a b, single (a' + a) (b' * b)) a 0 = 0
          := λ _ _ a, by simp only [mul_zero, single_zero, sum_const_zero],

        have add : ∀ (a' : α) (b' : β) (a : α) (b₁ b₂ : β)
                , single (a' + a) (b' * (b₁ + b₂))
                = single (a' + a) (b' * b₁) + single (a' + a) (b' * b₂)
          := λ _ _ a b₁ b₂, by simp only [left_distrib, single_add],

        simp only [sum_distrib (zero _ _) (add _ _)],
        from finset.sum_add_distrib,
      end,
      right_distrib := λ a b c, sum_distrib
          (λ a, by { simp only [zero_mul, single_zero, sum_const_zero] })
          (λ a b₁ b₂, by simp only [sum, right_distrib, single_add, finset.sum_add_distrib]),
      ..fin_fn.has_add α β,
      ..fin_fn.has_mul α β }

  instance [decidable_eq α] [decidable_eq β] [add_comm_monoid α] [comm_ring β] : comm_ring (fin_fn α β) :=
    { ..fin_fn.add_comm_group α β,
      ..fin_fn.comm_monoid α β,
      ..fin_fn.distrib α β }

  instance [decidable_eq α] [decidable_eq β] [add_comm_monoid α] [half_ring β] : half_ring (fin_fn α β) :=
    { half := fin_fn.single 0 ½,
      one_is_two_halves := ext (λ a, begin
        show ite (0 = a) (1 : β) 0 = ite (0 = a) ½ 0 + ite (0 = a) ½ 0,
        by_cases h : 0 = a; simp only [if_pos, if_false, h],
        from half_ring.one_is_two_halves _,
        from (add_zero 0).symm,
      end),
      ..fin_fn.comm_ring _ β }

end group_instances

end fin_fn

#lint-


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

! This file was ported from Lean 3 source module data.fintype.prod
! leanprover-community/mathlib commit 327c3c0d9232d80e250dc8f65e7835b82b266ea5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fintype.Card
import Mathbin.Data.Finset.Prod

/-!
# fintype instance for the product of two fintypes.

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

-/

open Function

open Nat

universe u v

variable {α β γ : Type _}

open Finset Function

namespace Set

variable {s t : Set α}

/- warning: set.to_finset_prod -> Set.toFinset_prod is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} (s : Set.{u1} α) (t : Set.{u2} β) [_inst_1 : Fintype.{u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) s)] [_inst_2 : Fintype.{u2} (coeSort.{succ u2, succ (succ u2)} (Set.{u2} β) Type.{u2} (Set.hasCoeToSort.{u2} β) t)] [_inst_3 : Fintype.{max u1 u2} (coeSort.{succ (max u1 u2), succ (succ (max u1 u2))} (Set.{max u1 u2} (Prod.{u1, u2} α β)) Type.{max u1 u2} (Set.hasCoeToSort.{max u1 u2} (Prod.{u1, u2} α β)) (Set.prod.{u1, u2} α β s t))], Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Set.toFinset.{max u1 u2} (Prod.{u1, u2} α β) (Set.prod.{u1, u2} α β s t) _inst_3) (Finset.product.{u1, u2} α β (Set.toFinset.{u1} α s _inst_1) (Set.toFinset.{u2} β t _inst_2))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} (s : Set.{u2} α) (t : Set.{u1} β) [_inst_1 : Fintype.{u2} (Set.Elem.{u2} α s)] [_inst_2 : Fintype.{u1} (Set.Elem.{u1} β t)] [_inst_3 : Fintype.{max u2 u1} (Set.Elem.{max u2 u1} (Prod.{u2, u1} α β) (Set.prod.{u2, u1} α β s t))], Eq.{max (succ u2) (succ u1)} (Finset.{max u2 u1} (Prod.{u2, u1} α β)) (Set.toFinset.{max u2 u1} (Prod.{u2, u1} α β) (Set.prod.{u2, u1} α β s t) _inst_3) (Finset.product.{u2, u1} α β (Set.toFinset.{u2} α s _inst_1) (Set.toFinset.{u1} β t _inst_2))
Case conversion may be inaccurate. Consider using '#align set.to_finset_prod Set.toFinset_prodₓ'. -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
theorem toFinset_prod (s : Set α) (t : Set β) [Fintype s] [Fintype t] [Fintype (s ×ˢ t)] :
    (s ×ˢ t).toFinset = s.toFinset ×ˢ t.toFinset :=
  by
  ext
  simp
#align set.to_finset_prod Set.toFinset_prod

#print Set.toFinset_off_diag /-
theorem toFinset_off_diag {s : Set α} [DecidableEq α] [Fintype s] [Fintype s.offDiag] :
    s.offDiag.toFinset = s.toFinset.offDiag :=
  Finset.ext <| by simp
#align set.to_finset_off_diag Set.toFinset_off_diag
-/

end Set

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
instance (α β : Type _) [Fintype α] [Fintype β] : Fintype (α × β) :=
  ⟨univ ×ˢ univ, fun ⟨a, b⟩ => by simp⟩

/- warning: finset.univ_product_univ -> Finset.univ_product_univ is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Fintype.{u1} α] [_inst_2 : Fintype.{u2} β], Eq.{succ (max u1 u2)} (Finset.{max u1 u2} (Prod.{u1, u2} α β)) (Finset.product.{u1, u2} α β (Finset.univ.{u1} α _inst_1) (Finset.univ.{u2} β _inst_2)) (Finset.univ.{max u1 u2} (Prod.{u1, u2} α β) (Prod.fintype.{u1, u2} α β _inst_1 _inst_2))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : Fintype.{u2} α] [_inst_2 : Fintype.{u1} β], Eq.{max (succ u2) (succ u1)} (Finset.{max u1 u2} (Prod.{u2, u1} α β)) (Finset.product.{u2, u1} α β (Finset.univ.{u2} α _inst_1) (Finset.univ.{u1} β _inst_2)) (Finset.univ.{max u2 u1} (Prod.{u2, u1} α β) (instFintypeProd.{u2, u1} α β _inst_1 _inst_2))
Case conversion may be inaccurate. Consider using '#align finset.univ_product_univ Finset.univ_product_univₓ'. -/
/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
@[simp]
theorem Finset.univ_product_univ {α β : Type _} [Fintype α] [Fintype β] :
    (univ : Finset α) ×ˢ (univ : Finset β) = univ :=
  rfl
#align finset.univ_product_univ Finset.univ_product_univ

/- warning: fintype.card_prod -> Fintype.card_prod is a dubious translation:
lean 3 declaration is
  forall (α : Type.{u1}) (β : Type.{u2}) [_inst_1 : Fintype.{u1} α] [_inst_2 : Fintype.{u2} β], Eq.{1} Nat (Fintype.card.{max u1 u2} (Prod.{u1, u2} α β) (Prod.fintype.{u1, u2} α β _inst_1 _inst_2)) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat Nat.hasMul) (Fintype.card.{u1} α _inst_1) (Fintype.card.{u2} β _inst_2))
but is expected to have type
  forall (α : Type.{u2}) (β : Type.{u1}) [_inst_1 : Fintype.{u2} α] [_inst_2 : Fintype.{u1} β], Eq.{1} Nat (Fintype.card.{max u1 u2} (Prod.{u2, u1} α β) (instFintypeProd.{u2, u1} α β _inst_1 _inst_2)) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat instMulNat) (Fintype.card.{u2} α _inst_1) (Fintype.card.{u1} β _inst_2))
Case conversion may be inaccurate. Consider using '#align fintype.card_prod Fintype.card_prodₓ'. -/
@[simp]
theorem Fintype.card_prod (α β : Type _) [Fintype α] [Fintype β] :
    Fintype.card (α × β) = Fintype.card α * Fintype.card β :=
  card_product _ _
#align fintype.card_prod Fintype.card_prod

section

open Classical

#print infinite_prod /-
@[simp]
theorem infinite_prod : Infinite (α × β) ↔ Infinite α ∧ Nonempty β ∨ Nonempty α ∧ Infinite β :=
  by
  refine'
    ⟨fun H => _, fun H =>
      H.elim (and_imp.2 <| @Prod.infinite_of_left α β) (and_imp.2 <| @Prod.infinite_of_right α β)⟩
  rw [and_comm]; contrapose! H; intro H'
  rcases Infinite.nonempty (α × β) with ⟨a, b⟩
  haveI := fintypeOfNotInfinite (H.1 ⟨b⟩); haveI := fintypeOfNotInfinite (H.2 ⟨a⟩)
  exact H'.false
#align infinite_prod infinite_prod
-/

#print Pi.infinite_of_left /-
instance Pi.infinite_of_left {ι : Sort _} {π : ι → Sort _} [∀ i, Nontrivial <| π i] [Infinite ι] :
    Infinite (∀ i : ι, π i) :=
  by
  choose m n hm using fun i => exists_pair_ne (π i)
  refine'
    Infinite.of_injective (fun i => m.update i (n i)) fun x y h => Classical.not_not.1 fun hne => _
  simp_rw [update_eq_iff, update_noteq hne] at h
  exact (hm x h.1.symm).elim
#align pi.infinite_of_left Pi.infinite_of_left
-/

/- warning: pi.infinite_of_exists_right -> Pi.infinite_of_exists_right is a dubious translation:
lean 3 declaration is
  forall {ι : Type.{u1}} {π : ι -> Type.{u2}} (i : ι) [_inst_1 : Infinite.{succ u2} (π i)] [_inst_2 : forall (i : ι), Nonempty.{succ u2} (π i)], Infinite.{max (succ u1) (succ u2)} (forall (i : ι), π i)
but is expected to have type
  forall {ι : Type.{u2}} {π : ι -> Type.{u1}} (i : ι) [_inst_1 : Infinite.{succ u1} (π i)] [_inst_2 : forall (i : ι), Nonempty.{succ u1} (π i)], Infinite.{max (succ u2) (succ u1)} (forall (i : ι), π i)
Case conversion may be inaccurate. Consider using '#align pi.infinite_of_exists_right Pi.infinite_of_exists_rightₓ'. -/
/-- If at least one `π i` is infinite and the rest nonempty, the pi type of all `π` is infinite. -/
theorem Pi.infinite_of_exists_right {ι : Type _} {π : ι → Type _} (i : ι) [Infinite <| π i]
    [∀ i, Nonempty <| π i] : Infinite (∀ i : ι, π i) :=
  let ⟨m⟩ := @Pi.nonempty ι π _
  Infinite.of_injective _ (update_injective m i)
#align pi.infinite_of_exists_right Pi.infinite_of_exists_right

#print Pi.infinite_of_right /-
/-- See `pi.infinite_of_exists_right` for the case that only one `π i` is infinite. -/
instance Pi.infinite_of_right {ι : Sort _} {π : ι → Sort _} [∀ i, Infinite <| π i] [Nonempty ι] :
    Infinite (∀ i : ι, π i) :=
  Pi.infinite_of_exists_right (Classical.arbitrary ι)
#align pi.infinite_of_right Pi.infinite_of_right
-/

#print Function.infinite_of_left /-
/-- Non-dependent version of `pi.infinite_of_left`. -/
instance Function.infinite_of_left {ι π : Sort _} [Nontrivial π] [Infinite ι] : Infinite (ι → π) :=
  Pi.infinite_of_left
#align function.infinite_of_left Function.infinite_of_left
-/

#print Function.infinite_of_right /-
/-- Non-dependent version of `pi.infinite_of_exists_right` and `pi.infinite_of_right`. -/
instance Function.infinite_of_right {ι π : Sort _} [Infinite π] [Nonempty ι] : Infinite (ι → π) :=
  Pi.infinite_of_right
#align function.infinite_of_right Function.infinite_of_right
-/

end


/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Sébastien Gouëzel, Zhouhang Zhou, Reid Barton
-/
import logic.equiv.fin
import topology.dense_embedding
import topology.support

/-!
# Homeomorphisms

This file defines homeomorphisms between two topological spaces. They are bijections with both
directions continuous. We denote homeomorphisms with the notation `≃ₜ`.

# Main definitions

* `homeomorph α β`: The type of homeomorphisms from `α` to `β`.
  This type can be denoted using the following notation: `α ≃ₜ β`.

# Main results

* Pretty much every topological property is preserved under homeomorphisms.
* `homeomorph.homeomorph_of_continuous_open`: A continuous bijection that is
  an open map is a homeomorphism.

-/

open set filter
open_locale topological_space

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

/-- Homeomorphism between `α` and `β`, also called topological isomorphism -/
@[nolint has_inhabited_instance] -- not all spaces are homeomorphic to each other
structure homeomorph (α : Type*) (β : Type*) [topological_space α] [topological_space β]
  extends α ≃ β :=
(continuous_to_fun  : continuous to_fun . tactic.interactive.continuity')
(continuous_inv_fun : continuous inv_fun . tactic.interactive.continuity')

infix ` ≃ₜ `:25 := homeomorph

namespace homeomorph
variables [topological_space α] [topological_space β] [topological_space γ] [topological_space δ]

instance : has_coe_to_fun (α ≃ₜ β) (λ _, α → β) := ⟨λe, e.to_equiv⟩

@[simp] lemma homeomorph_mk_coe (a : equiv α β) (b c) :
  ((homeomorph.mk a b c) : α → β) = a :=
rfl

@[simp] lemma coe_to_equiv (h : α ≃ₜ β) : ⇑h.to_equiv = h := rfl

/-- Inverse of a homeomorphism. -/
protected def symm (h : α ≃ₜ β) : β ≃ₜ α :=
{ continuous_to_fun  := h.continuous_inv_fun,
  continuous_inv_fun := h.continuous_to_fun,
  to_equiv := h.to_equiv.symm }

/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
  because it is a composition of multiple projections. -/
def simps.apply (h : α ≃ₜ β) : α → β := h
/-- See Note [custom simps projection] -/
def simps.symm_apply (h : α ≃ₜ β) : β → α := h.symm

initialize_simps_projections homeomorph
  (to_equiv_to_fun → apply, to_equiv_inv_fun → symm_apply, -to_equiv)

lemma to_equiv_injective : function.injective (to_equiv : α ≃ₜ β → α ≃ β)
| ⟨e, h₁, h₂⟩ ⟨e', h₁', h₂'⟩ rfl := rfl

@[ext] lemma ext {h h' : α ≃ₜ β} (H : ∀ x, h x = h' x) : h = h' :=
to_equiv_injective $ equiv.ext H

/-- Identity map as a homeomorphism. -/
@[simps apply {fully_applied := ff}]
protected def refl (α : Type*) [topological_space α] : α ≃ₜ α :=
{ continuous_to_fun := continuous_id,
  continuous_inv_fun := continuous_id,
  to_equiv := equiv.refl α }

/-- Composition of two homeomorphisms. -/
protected def trans (h₁ : α ≃ₜ β) (h₂ : β ≃ₜ γ) : α ≃ₜ γ :=
{ continuous_to_fun  := h₂.continuous_to_fun.comp h₁.continuous_to_fun,
  continuous_inv_fun := h₁.continuous_inv_fun.comp h₂.continuous_inv_fun,
  to_equiv := equiv.trans h₁.to_equiv h₂.to_equiv }

@[simp] lemma trans_apply (h₁ : α ≃ₜ β) (h₂ : β ≃ₜ γ) (a : α) : h₁.trans h₂ a = h₂ (h₁ a) := rfl

@[simp] lemma homeomorph_mk_coe_symm (a : equiv α β) (b c) :
  ((homeomorph.mk a b c).symm : β → α) = a.symm :=
rfl

@[simp] lemma refl_symm : (homeomorph.refl α).symm = homeomorph.refl α := rfl

@[continuity]
protected lemma continuous (h : α ≃ₜ β) : continuous h := h.continuous_to_fun

@[continuity] -- otherwise `by continuity` can't prove continuity of `h.to_equiv.symm`
protected lemma continuous_symm (h : α ≃ₜ β) : continuous (h.symm) := h.continuous_inv_fun

@[simp] lemma apply_symm_apply (h : α ≃ₜ β) (x : β) : h (h.symm x) = x :=
h.to_equiv.apply_symm_apply x

@[simp] lemma symm_apply_apply (h : α ≃ₜ β) (x : α) : h.symm (h x) = x :=
h.to_equiv.symm_apply_apply x

protected lemma bijective (h : α ≃ₜ β) : function.bijective h := h.to_equiv.bijective
protected lemma injective (h : α ≃ₜ β) : function.injective h := h.to_equiv.injective
protected lemma surjective (h : α ≃ₜ β) : function.surjective h := h.to_equiv.surjective

/-- Change the homeomorphism `f` to make the inverse function definitionally equal to `g`. -/
def change_inv (f : α ≃ₜ β) (g : β → α) (hg : function.right_inverse g f) : α ≃ₜ β :=
have g = f.symm, from funext (λ x, calc g x = f.symm (f (g x)) : (f.left_inv (g x)).symm
                                        ... = f.symm x : by rw hg x),
{ to_fun := f,
  inv_fun := g,
  left_inv := by convert f.left_inv,
  right_inv := by convert f.right_inv,
  continuous_to_fun := f.continuous,
  continuous_inv_fun := by convert f.symm.continuous }

@[simp] lemma symm_comp_self (h : α ≃ₜ β) : ⇑h.symm ∘ ⇑h = id :=
funext h.symm_apply_apply

@[simp] lemma self_comp_symm (h : α ≃ₜ β) : ⇑h ∘ ⇑h.symm = id :=
funext h.apply_symm_apply

@[simp] lemma range_coe (h : α ≃ₜ β) : range h = univ :=
h.surjective.range_eq

lemma image_symm (h : α ≃ₜ β) : image h.symm = preimage h :=
funext h.symm.to_equiv.image_eq_preimage

lemma preimage_symm (h : α ≃ₜ β) : preimage h.symm = image h :=
(funext h.to_equiv.image_eq_preimage).symm

@[simp] lemma image_preimage (h : α ≃ₜ β) (s : set β) : h '' (h ⁻¹' s) = s :=
h.to_equiv.image_preimage s

@[simp] lemma preimage_image (h : α ≃ₜ β) (s : set α) : h ⁻¹' (h '' s) = s :=
h.to_equiv.preimage_image s

protected lemma inducing (h : α ≃ₜ β) : inducing h :=
inducing_of_inducing_compose h.continuous h.symm.continuous $
  by simp only [symm_comp_self, inducing_id]

lemma induced_eq (h : α ≃ₜ β) : topological_space.induced h ‹_› = ‹_› := h.inducing.1.symm

protected lemma quotient_map (h : α ≃ₜ β) : quotient_map h :=
quotient_map.of_quotient_map_compose h.symm.continuous h.continuous $
  by simp only [self_comp_symm, quotient_map.id]

lemma coinduced_eq (h : α ≃ₜ β) : topological_space.coinduced h ‹_› = ‹_› :=
h.quotient_map.2.symm

protected lemma embedding (h : α ≃ₜ β) : embedding h :=
⟨h.inducing, h.injective⟩

/-- Homeomorphism given an embedding. -/
noncomputable def of_embedding (f : α → β) (hf : embedding f) : α ≃ₜ (set.range f) :=
{ continuous_to_fun := continuous_subtype_mk _ hf.continuous,
  continuous_inv_fun := by simp [hf.continuous_iff, continuous_subtype_coe],
  .. equiv.of_injective f hf.inj }

protected lemma second_countable_topology [topological_space.second_countable_topology β]
  (h : α ≃ₜ β) :
  topological_space.second_countable_topology α :=
h.inducing.second_countable_topology

lemma compact_image {s : set α} (h : α ≃ₜ β) : is_compact (h '' s) ↔ is_compact s :=
h.embedding.is_compact_iff_is_compact_image.symm

lemma compact_preimage {s : set β} (h : α ≃ₜ β) : is_compact (h ⁻¹' s) ↔ is_compact s :=
by rw ← image_symm; exact h.symm.compact_image

protected lemma compact_space [compact_space α] (h : α ≃ₜ β) : compact_space β :=
{ compact_univ := by { rw [← image_univ_of_surjective h.surjective, h.compact_image],
    apply compact_space.compact_univ } }

protected lemma t2_space [t2_space α] (h : α ≃ₜ β) : t2_space β :=
{ t2 :=
  begin
    intros x y hxy,
    obtain ⟨u, v, hu, hv, hxu, hyv, huv⟩ := t2_separation (h.symm.injective.ne hxy),
    refine ⟨h.symm ⁻¹' u, h.symm ⁻¹' v,
      h.symm.continuous.is_open_preimage _ hu,
      h.symm.continuous.is_open_preimage _ hv,
      hxu, hyv, _⟩,
    rw [← preimage_inter, huv, preimage_empty],
  end }

protected lemma dense_embedding (h : α ≃ₜ β) : dense_embedding h :=
{ dense   := h.surjective.dense_range,
  .. h.embedding }

@[simp] lemma is_open_preimage (h : α ≃ₜ β) {s : set β} : is_open (h ⁻¹' s) ↔ is_open s :=
h.quotient_map.is_open_preimage

@[simp] lemma is_open_image (h : α ≃ₜ β) {s : set α} : is_open (h '' s) ↔ is_open s :=
by rw [← preimage_symm, is_open_preimage]

protected lemma is_open_map (h : α ≃ₜ β) : is_open_map h := λ s, h.is_open_image.2

@[simp] lemma is_closed_preimage (h : α ≃ₜ β) {s : set β} : is_closed (h ⁻¹' s) ↔ is_closed s :=
by simp only [← is_open_compl_iff, ← preimage_compl, is_open_preimage]

@[simp] lemma is_closed_image (h : α ≃ₜ β) {s : set α} : is_closed (h '' s) ↔ is_closed s :=
by rw [← preimage_symm, is_closed_preimage]

protected lemma is_closed_map (h : α ≃ₜ β) : is_closed_map h := λ s, h.is_closed_image.2

protected lemma open_embedding (h : α ≃ₜ β) : open_embedding h :=
open_embedding_of_embedding_open h.embedding h.is_open_map

protected lemma closed_embedding (h : α ≃ₜ β) : closed_embedding h :=
closed_embedding_of_embedding_closed h.embedding h.is_closed_map

lemma preimage_closure (h : α ≃ₜ β) (s : set β) : h ⁻¹' (closure s) = closure (h ⁻¹' s) :=
h.is_open_map.preimage_closure_eq_closure_preimage h.continuous _

lemma image_closure (h : α ≃ₜ β) (s : set α) : h '' (closure s) = closure (h '' s) :=
by rw [← preimage_symm, preimage_closure]

lemma image_interior (h : α ≃ₜ β) (s : set α) : h '' (interior s) = interior (h '' s) :=
by rw [← preimage_symm, preimage_interior]

lemma preimage_frontier (h : α ≃ₜ β) (s : set β) : h ⁻¹' (frontier s) = frontier (h ⁻¹' s) :=
h.is_open_map.preimage_frontier_eq_frontier_preimage h.continuous _

@[to_additive]
lemma _root_.has_compact_mul_support.comp_homeomorph {M} [has_one M] {f : β → M}
  (hf : has_compact_mul_support f) (φ : α ≃ₜ β) : has_compact_mul_support (f ∘ φ) :=
hf.comp_closed_embedding φ.closed_embedding

@[simp] lemma map_nhds_eq (h : α ≃ₜ β) (x : α) : map h (𝓝 x) = 𝓝 (h x) :=
h.embedding.map_nhds_of_mem _ (by simp)

lemma symm_map_nhds_eq (h : α ≃ₜ β) (x : α) : map h.symm (𝓝 (h x)) = 𝓝 x :=
by rw [h.symm.map_nhds_eq, h.symm_apply_apply]

lemma nhds_eq_comap (h : α ≃ₜ β) (x : α) : 𝓝 x = comap h (𝓝 (h x)) :=
h.embedding.to_inducing.nhds_eq_comap x

@[simp] lemma comap_nhds_eq (h : α ≃ₜ β) (y : β) : comap h (𝓝 y) = 𝓝 (h.symm y) :=
by rw [h.nhds_eq_comap, h.apply_symm_apply]

/-- If an bijective map `e : α ≃ β` is continuous and open, then it is a homeomorphism. -/
def homeomorph_of_continuous_open (e : α ≃ β) (h₁ : continuous e) (h₂ : is_open_map e) :
  α ≃ₜ β :=
{ continuous_to_fun := h₁,
  continuous_inv_fun := begin
    rw continuous_def,
    intros s hs,
    convert ← h₂ s hs using 1,
    apply e.image_eq_preimage
  end,
  to_equiv := e }

@[simp] lemma comp_continuous_on_iff (h : α ≃ₜ β) (f : γ → α) (s : set γ) :
  continuous_on (h ∘ f) s ↔ continuous_on f s :=
h.inducing.continuous_on_iff.symm

@[simp] lemma comp_continuous_iff (h : α ≃ₜ β) {f : γ → α} :
  continuous (h ∘ f) ↔ continuous f :=
h.inducing.continuous_iff.symm

@[simp] lemma comp_continuous_iff' (h : α ≃ₜ β) {f : β → γ} :
  continuous (f ∘ h) ↔ continuous f :=
h.quotient_map.continuous_iff.symm

lemma comp_continuous_at_iff (h : α ≃ₜ β) (f : γ → α) (x : γ) :
  continuous_at (h ∘ f) x ↔ continuous_at f x :=
h.inducing.continuous_at_iff.symm

lemma comp_continuous_at_iff' (h : α ≃ₜ β) (f : β → γ) (x : α) :
  continuous_at (f ∘ h) x ↔ continuous_at f (h x) :=
h.inducing.continuous_at_iff' (by simp)

lemma comp_continuous_within_at_iff (h : α ≃ₜ β) (f : γ → α) (s : set γ) (x : γ) :
  continuous_within_at f s x ↔ continuous_within_at (h ∘ f) s x :=
h.inducing.continuous_within_at_iff

@[simp] lemma comp_is_open_map_iff (h : α ≃ₜ β) {f : γ → α} :
  is_open_map (h ∘ f) ↔ is_open_map f :=
begin
  refine ⟨_, λ hf, h.is_open_map.comp hf⟩,
  intros hf,
  rw [← function.comp.left_id f, ← h.symm_comp_self, function.comp.assoc],
  exact h.symm.is_open_map.comp hf,
end

@[simp] lemma comp_is_open_map_iff' (h : α ≃ₜ β) {f : β → γ} :
  is_open_map (f ∘ h) ↔ is_open_map f :=
begin
  refine ⟨_, λ hf, hf.comp h.is_open_map⟩,
  intros hf,
  rw [← function.comp.right_id f, ← h.self_comp_symm, ← function.comp.assoc],
  exact hf.comp h.symm.is_open_map,
end

/-- If two sets are equal, then they are homeomorphic. -/
def set_congr {s t : set α} (h : s = t) : s ≃ₜ t :=
{ continuous_to_fun := continuous_subtype_mk _ continuous_subtype_val,
  continuous_inv_fun := continuous_subtype_mk _ continuous_subtype_val,
  to_equiv := equiv.set_congr h }

/-- Sum of two homeomorphisms. -/
def sum_congr (h₁ : α ≃ₜ β) (h₂ : γ ≃ₜ δ) : α ⊕ γ ≃ₜ β ⊕ δ :=
{ continuous_to_fun  :=
  begin
    convert continuous_sum_rec (continuous_inl.comp h₁.continuous)
      (continuous_inr.comp h₂.continuous),
    ext x, cases x; refl,
  end,
  continuous_inv_fun :=
  begin
    convert continuous_sum_rec (continuous_inl.comp h₁.symm.continuous)
      (continuous_inr.comp h₂.symm.continuous),
    ext x, cases x; refl
  end,
  to_equiv := h₁.to_equiv.sum_congr h₂.to_equiv }

/-- Product of two homeomorphisms. -/
def prod_congr (h₁ : α ≃ₜ β) (h₂ : γ ≃ₜ δ) : α × γ ≃ₜ β × δ :=
{ continuous_to_fun  := (h₁.continuous.comp continuous_fst).prod_mk
    (h₂.continuous.comp continuous_snd),
  continuous_inv_fun := (h₁.symm.continuous.comp continuous_fst).prod_mk
    (h₂.symm.continuous.comp continuous_snd),
  to_equiv := h₁.to_equiv.prod_congr h₂.to_equiv }

@[simp] lemma prod_congr_symm (h₁ : α ≃ₜ β) (h₂ : γ ≃ₜ δ) :
  (h₁.prod_congr h₂).symm = h₁.symm.prod_congr h₂.symm := rfl

@[simp] lemma coe_prod_congr (h₁ : α ≃ₜ β) (h₂ : γ ≃ₜ δ) :
  ⇑(h₁.prod_congr h₂) = prod.map h₁ h₂ := rfl

section
variables (α β γ)

/-- `α × β` is homeomorphic to `β × α`. -/
def prod_comm : α × β ≃ₜ β × α :=
{ continuous_to_fun  := continuous_snd.prod_mk continuous_fst,
  continuous_inv_fun := continuous_snd.prod_mk continuous_fst,
  to_equiv := equiv.prod_comm α β }

@[simp] lemma prod_comm_symm : (prod_comm α β).symm = prod_comm β α := rfl
@[simp] lemma coe_prod_comm : ⇑(prod_comm α β) = prod.swap := rfl

/-- `(α × β) × γ` is homeomorphic to `α × (β × γ)`. -/
def prod_assoc : (α × β) × γ ≃ₜ α × (β × γ) :=
{ continuous_to_fun  := (continuous_fst.comp continuous_fst).prod_mk
    ((continuous_snd.comp continuous_fst).prod_mk continuous_snd),
  continuous_inv_fun := (continuous_fst.prod_mk (continuous_fst.comp continuous_snd)).prod_mk
    (continuous_snd.comp continuous_snd),
  to_equiv := equiv.prod_assoc α β γ }

/-- `α × {*}` is homeomorphic to `α`. -/
@[simps apply {fully_applied := ff}]
def prod_punit : α × punit ≃ₜ α :=
{ to_equiv := equiv.prod_punit α,
  continuous_to_fun := continuous_fst,
  continuous_inv_fun := continuous_id.prod_mk continuous_const }

/-- `{*} × α` is homeomorphic to `α`. -/
def punit_prod : punit × α ≃ₜ α :=
(prod_comm _ _).trans (prod_punit _)

@[simp] lemma coe_punit_prod : ⇑(punit_prod α) = prod.snd := rfl

end

/-- `ulift α` is homeomorphic to `α`. -/
def {u v} ulift {α : Type u} [topological_space α] : ulift.{v u} α ≃ₜ α :=
{ continuous_to_fun := continuous_ulift_down,
  continuous_inv_fun := continuous_ulift_up,
  to_equiv := equiv.ulift }

section distrib

/-- `(α ⊕ β) × γ` is homeomorphic to `α × γ ⊕ β × γ`. -/
def sum_prod_distrib : (α ⊕ β) × γ ≃ₜ α × γ ⊕ β × γ :=
begin
  refine (homeomorph.homeomorph_of_continuous_open (equiv.sum_prod_distrib α β γ).symm _ _).symm,
  { convert continuous_sum_rec
      ((continuous_inl.comp continuous_fst).prod_mk continuous_snd)
      ((continuous_inr.comp continuous_fst).prod_mk continuous_snd),
    ext1 x, cases x; refl, },
  { exact (is_open_map_sum
    (open_embedding_inl.prod open_embedding_id).is_open_map
    (open_embedding_inr.prod open_embedding_id).is_open_map) }
end

/-- `α × (β ⊕ γ)` is homeomorphic to `α × β ⊕ α × γ`. -/
def prod_sum_distrib : α × (β ⊕ γ) ≃ₜ α × β ⊕ α × γ :=
(prod_comm _ _).trans $
sum_prod_distrib.trans $
sum_congr (prod_comm _ _) (prod_comm _ _)

variables {ι : Type*} {σ : ι → Type*} [Π i, topological_space (σ i)]

/-- `(Σ i, σ i) × β` is homeomorphic to `Σ i, (σ i × β)`. -/
def sigma_prod_distrib : ((Σ i, σ i) × β) ≃ₜ (Σ i, (σ i × β)) :=
homeomorph.symm $
homeomorph_of_continuous_open (equiv.sigma_prod_distrib σ β).symm
  (continuous_sigma $ λ i,
    (continuous_sigma_mk.comp continuous_fst).prod_mk continuous_snd)
  (is_open_map_sigma $ λ i,
    (open_embedding_sigma_mk.prod open_embedding_id).is_open_map)

end distrib

/-- If `ι` has a unique element, then `ι → α` is homeomorphic to `α`. -/
@[simps { fully_applied := ff }]
def fun_unique (ι α : Type*) [unique ι] [topological_space α] : (ι → α) ≃ₜ α :=
{ to_equiv := equiv.fun_unique ι α,
  continuous_to_fun := continuous_apply _,
  continuous_inv_fun := continuous_pi (λ _, continuous_id) }

/-- Homeomorphism between dependent functions `Π i : fin 2, α i` and `α 0 × α 1`. -/
@[simps { fully_applied := ff }]
def {u} pi_fin_two (α : fin 2 → Type u) [Π i, topological_space (α i)] : (Π i, α i) ≃ₜ α 0 × α 1 :=
{ to_equiv := pi_fin_two_equiv α,
  continuous_to_fun := (continuous_apply 0).prod_mk (continuous_apply 1),
  continuous_inv_fun := continuous_pi $ fin.forall_fin_two.2 ⟨continuous_fst, continuous_snd⟩ }

/-- Homeomorphism between `α² = fin 2 → α` and `α × α`. -/
@[simps { fully_applied := ff }] def fin_two_arrow : (fin 2 → α) ≃ₜ α × α :=
{ to_equiv := fin_two_arrow_equiv α, ..  pi_fin_two (λ _, α) }

/--
A subset of a topological space is homeomorphic to its image under a homeomorphism.
-/
def image (e : α ≃ₜ β) (s : set α) : s ≃ₜ e '' s :=
{ continuous_to_fun := by continuity!,
  continuous_inv_fun := by continuity!,
  ..e.to_equiv.image s, }

end homeomorph

/-- An inducing equiv between topological spaces is a homeomorphism. -/
@[simps] def equiv.to_homeomorph_of_inducing [topological_space α] [topological_space β] (f : α ≃ β)
  (hf : inducing f) :
  α ≃ₜ β :=
{ continuous_to_fun := hf.continuous,
  continuous_inv_fun := hf.continuous_iff.2 $ by simpa using continuous_id,
  .. f }

namespace continuous
variables [topological_space α] [topological_space β]

lemma continuous_symm_of_equiv_compact_to_t2 [compact_space α] [t2_space β]
  {f : α ≃ β} (hf : continuous f) : continuous f.symm :=
begin
  rw continuous_iff_is_closed,
  intros C hC,
  have hC' : is_closed (f '' C) := (hC.is_compact.image hf).is_closed,
  rwa equiv.image_eq_preimage at hC',
end

/-- Continuous equivalences from a compact space to a T2 space are homeomorphisms.

This is not true when T2 is weakened to T1
(see `continuous.homeo_of_equiv_compact_to_t2.t1_counterexample`). -/
@[simps]
def homeo_of_equiv_compact_to_t2 [compact_space α] [t2_space β]
  {f : α ≃ β} (hf : continuous f) : α ≃ₜ β :=
{ continuous_to_fun := hf,
  continuous_inv_fun := hf.continuous_symm_of_equiv_compact_to_t2,
  ..f }

end continuous


/- Library 3.2: Program Semantics — Hoare Logic -/

/- This file contains some basic material for the Hoare logic lecture, exercise, and homework.

This file contains the following concepts:

* `state`: representing the state space of an imperative program (defined as `string → ℕ`)
  * `∅` is the empty state; mapping every variable to `0`
  * `s.update n v` or `s & n ::= v`: replace the name `n` in the state `s` by value `v`
  * `s n` variable `n` of state `s`

* `program` syntax for WHILE programs over `state` as state space.
  This is a slight modification of the lecture 3.1. Instead of over an arbitrary state space `σ` we
  are now fixed on `state`; and also `assign` only allows changing one variable.

* `(p, s) ⟹ t`: big-step semantics over `program`

It is all under the `lecture` namespace. -/

meta def tactic.dec_trivial := `[exact dec_trivial]

@[simp] lemma not_not_iff (p : Prop) [decidable p] : ¬ (¬ p) ↔ p :=
by by_cases p; simp [h]

@[simp] lemma and_imp (p q r : Prop) : ((p ∧ q) → r) ↔ (p → q → r) :=
iff.intro
  (assume h hp hq, h ⟨hp, hq⟩)
  (assume h ⟨hp, hq⟩, h hp hq)

namespace lecture

/- `state` to represent state spaces -/

def state := string → ℕ

def state.update (name : string) (val : ℕ) (s : state) : state :=
λn, if n = name then val else s n

notation s ` & ` n ` ::= ` v := state.update n v s

namespace state

instance : has_emptyc state := ⟨λ_, 0⟩

@[simp] lemma update_apply (name : string) (val : ℕ) (s : state) :
  (s & name ::= val) name = val :=
if_pos rfl

@[simp] lemma update_apply_ne (name name' : string) (val : ℕ) (s : state)
  (h : name' ≠ name . tactic.dec_trivial):
  (s & name ::= val) name' = s name' :=
if_neg h

@[simp] lemma update_override (name : string) (val₁ val₂ : ℕ) (s : state) :
  (s & name ::= val₂ & name ::= val₁) = (s & name ::= val₁) :=
by funext name'; by_cases name' = name; simp [h]

@[simp] lemma update_swap
  (name₁ name₂ : string) (val₁ val₂ : ℕ) (s : state) (h : name₁ ≠ name₂ . tactic.dec_trivial):
  (s & name₂ ::= val₂ & name₁ ::= val₁) = (s & name₁ ::= val₁ & name₂ ::= val₂) :=
by funext name'; by_cases h₁ : name' = name₁; by_cases h₂ : name' = name₂; simp * at *

end state

example (s : state) : (s & "a" ::= 0 & "a" ::= 2) = (s & "a" ::= 2) :=
by simp

example (s : state) : (s & "a" ::= 0 & "b" ::= 2) = (s & "b" ::= 2 & "a" ::= 0) :=
by simp

/- A WHILE programming language -/

inductive program : Type
| skip {} : program
| assign  : string → (state → ℕ) → program
| seq     : program → program → program
| ite     : (state → Prop) → program → program → program
| while   : (state → Prop) → program → program
| unless  : program → (state → Prop) → program
| do_while: program → (state → Prop) → program

infixr ` ;; `:90 := program.seq

open program

/- We use the **big step** semantics -/

inductive big_step : (program × state) → state → Prop
| skip {s} :
  big_step (skip, s) s
| assign {n f s} :
  big_step (assign n f, s) (s.update n (f s))
| seq {p₁ p₂ s u} (t) (h₁ : big_step (p₁, s) t) (h₂ : big_step (p₂, t) u) :
  big_step (seq p₁ p₂, s) u

| ite_true {c : state → Prop} {p₁ p₀ s t} (hs : c s) (h : big_step (p₁, s) t) :
  big_step (ite c p₁ p₀, s) t
| ite_false {c : state → Prop} {p₁ p₀ s t} (hs : ¬ c s) (h : big_step (p₀, s) t) :
  big_step (ite c p₁ p₀, s) t

| while_true {c : state → Prop} {p s u} (t) (hs : c s) (hp : big_step (p, s) t)
  (hw : big_step (while c p, t) u) :
  big_step (while c p, s) u
| while_false {c : state → Prop} {p s} (hs : ¬ c s) : big_step (while c p, s) s

|unless_false {c : state → Prop} {p s t} (hs: ¬ c s) (h: big_step (p, s) t):
  big_step (unless p c, s) t

|unless_true {c : state → Prop} {p s t} (hs: c s) (h: big_step (p, s) t) :
  big_step (skip, s) t

 |do_while_true {c : state → Prop} {p s u} (t) (hp : big_step (p, s) t)
  (hw : big_step (while c p, t) u) (hs : c s)  :
  big_step (do_while p c, s) u
| do_while_false {c : state → Prop} {p s} (hs : ¬ c s) : big_step (do_while p c, s) s

infix ` ⟹ `:110 := big_step

end lecture


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.list.basic

/-!
# Boolean quantifiers

This proves a few properties about `list.all` and `list.any`, which are the `bool` universal and
existential quantifiers. Their definitions are in core Lean.
-/

variables {α : Type*} {p : α → Prop} [decidable_pred p] {l : list α} {a : α}

namespace list

@[simp] theorem all_nil (p : α → bool) : all [] p = tt := rfl

@[simp] theorem all_cons (p : α → bool) (a : α) (l : list α) : all (a::l) p = (p a && all l p) :=
rfl

theorem all_iff_forall_prop : all l (λ a, p a) ↔ ∀ a ∈ l, p a :=
by simp only [all_iff_forall, bool.of_to_bool_iff]

@[simp] theorem any_nil (p : α → bool) : any [] p = ff := rfl

@[simp] theorem any_cons (p : α → bool) (a : α) (l : list α) : any (a :: l) p = (p a || any l p) :=
rfl

theorem any_iff_exists {p : α → bool} : any l p ↔ ∃ a ∈ l, p a :=
begin
  induction l with a l ih,
  { exact iff_of_false bool.not_ff (not_exists_mem_nil _) },
  simp only [any_cons, bor_coe_iff, ih, exists_mem_cons_iff]
end

theorem any_iff_exists_prop : any l (λ a, p a) ↔ ∃ a ∈ l, p a := by simp [any_iff_exists]

theorem any_of_mem {p : α → bool} (h₁ : a ∈ l) (h₂ : p a) : any l p := any_iff_exists.2 ⟨_, h₁, h₂⟩

@[priority 500] instance decidable_forall_mem (l : list α) : decidable (∀ x ∈ l, p x) :=
decidable_of_iff _ all_iff_forall_prop

instance decidable_exists_mem (l : list α) : decidable (∃ x ∈ l, p x) :=
decidable_of_iff _ any_iff_exists_prop

end list