/-
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, Kevin Buzzard, Yury Kudryashov, Frédéric Dupuis,
  Heather Macbeth
-/
import linear_algebra.basic
import order.omega_complete_partial_order

/-!
# The span of a set of vectors, as a submodule

* `submodule.span s` is defined to be the smallest submodule containing the set `s`.

## Notations

* We introduce the notation `R ∙ v` for the span of a singleton, `submodule.span R {v}`.  This is
  `\.`, not the same as the scalar multiplication `•`/`\bub`.

-/
variables {R R₂ K M M₂ V S : Type*}

namespace submodule

open function set
open_locale pointwise

section add_comm_monoid

variables [semiring R] [add_comm_monoid M] [module R M]
variables {x : M} (p p' : submodule R M)
variables [semiring R₂] {σ₁₂ : R →+* R₂}
variables [add_comm_monoid M₂] [module R₂ M₂]

section
variables (R)

/-- The span of a set `s ⊆ M` is the smallest submodule of M that contains `s`. -/
def span (s : set M) : submodule R M := Inf {p | s ⊆ p}
end

variables {s t : set M}
lemma mem_span : x ∈ span R s ↔ ∀ p : submodule R M, s ⊆ p → x ∈ p := mem_Inter₂

lemma subset_span : s ⊆ span R s :=
λ x h, mem_span.2 $ λ p hp, hp h

lemma span_le {p} : span R s ≤ p ↔ s ⊆ p :=
⟨subset.trans subset_span, λ ss x h, mem_span.1 h _ ss⟩

lemma span_mono (h : s ⊆ t) : span R s ≤ span R t :=
span_le.2 $ subset.trans h subset_span

lemma span_eq_of_le (h₁ : s ⊆ p) (h₂ : p ≤ span R s) : span R s = p :=
le_antisymm (span_le.2 h₁) h₂

lemma span_eq : span R (p : set M) = p :=
span_eq_of_le _ (subset.refl _) subset_span

lemma span_eq_span (hs : s ⊆ span R t) (ht : t ⊆ span R s) : span R s = span R t :=
le_antisymm (span_le.2 hs) (span_le.2 ht)

/-- A version of `submodule.span_eq` for when the span is by a smaller ring. -/
@[simp] lemma span_coe_eq_restrict_scalars
  [semiring S] [has_smul S R] [module S M] [is_scalar_tower S R M] :
  span S (p : set M) = p.restrict_scalars S :=
span_eq (p.restrict_scalars S)

lemma map_span [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) (s : set M) :
  (span R s).map f = span R₂ (f '' s) :=
eq.symm $ span_eq_of_le _ (set.image_subset f subset_span) $
map_le_iff_le_comap.2 $ span_le.2 $ λ x hx, subset_span ⟨x, hx, rfl⟩

alias submodule.map_span ← _root_.linear_map.map_span

lemma map_span_le [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) (s : set M)
  (N : submodule R₂ M₂) : map f (span R s) ≤ N ↔ ∀ m ∈ s, f m ∈ N :=
begin
  rw [f.map_span, span_le, set.image_subset_iff],
  exact iff.rfl
end

alias submodule.map_span_le ← _root_.linear_map.map_span_le

@[simp] lemma span_insert_zero : span R (insert (0 : M) s) = span R s :=
begin
  refine le_antisymm _ (submodule.span_mono (set.subset_insert 0 s)),
  rw [span_le, set.insert_subset],
  exact ⟨by simp only [set_like.mem_coe, submodule.zero_mem], submodule.subset_span⟩,
end

/- See also `span_preimage_eq` below. -/
lemma span_preimage_le (f : M →ₛₗ[σ₁₂] M₂) (s : set M₂) :
  span R (f ⁻¹' s) ≤ (span R₂ s).comap f :=
by { rw [span_le, comap_coe], exact preimage_mono (subset_span), }

alias submodule.span_preimage_le ← _root_.linear_map.span_preimage_le

lemma closure_subset_span {s : set M} :
  (add_submonoid.closure s : set M) ⊆ span R s :=
(@add_submonoid.closure_le _ _ _ (span R s).to_add_submonoid).mpr subset_span

lemma closure_le_to_add_submonoid_span {s : set M} :
  add_submonoid.closure s ≤ (span R s).to_add_submonoid :=
closure_subset_span

@[simp] lemma span_closure {s : set M} : span R (add_submonoid.closure s : set M) = span R s :=
le_antisymm (span_le.mpr closure_subset_span) (span_mono add_submonoid.subset_closure)

/-- An induction principle for span membership. If `p` holds for 0 and all elements of `s`, and is
preserved under addition and scalar multiplication, then `p` holds for all elements of the span of
`s`. -/
@[elab_as_eliminator] lemma span_induction {p : M → Prop} (h : x ∈ span R s)
  (Hs : ∀ x ∈ s, p x) (H0 : p 0)
  (H1 : ∀ x y, p x → p y → p (x + y))
  (H2 : ∀ (a:R) x, p x → p (a • x)) : p x :=
(@span_le _ _ _ _ _ _ ⟨p, H1, H0, H2⟩).2 Hs h

/-- A dependent version of `submodule.span_induction`. -/
lemma span_induction' {p : Π x, x ∈ span R s → Prop}
  (Hs : ∀ x (h : x ∈ s), p x (subset_span h))
  (H0 : p 0 (submodule.zero_mem _))
  (H1 : ∀ x hx y hy, p x hx → p y hy → p (x + y) (submodule.add_mem _ ‹_› ‹_›))
  (H2 : ∀ (a : R) x hx, p x hx → p (a • x) (submodule.smul_mem _ _ ‹_›)) {x} (hx : x ∈ span R s) :
  p x hx :=
begin
  refine exists.elim _ (λ (hx : x ∈ span R s) (hc : p x hx), hc),
  refine span_induction hx (λ m hm, ⟨subset_span hm, Hs m hm⟩) ⟨zero_mem _, H0⟩
    (λ x y hx hy, exists.elim hx $ λ hx' hx, exists.elim hy $ λ hy' hy,
    ⟨add_mem hx' hy', H1 _ _ _ _ hx hy⟩) (λ r x hx, exists.elim hx $ λ hx' hx,
    ⟨smul_mem _ _ hx', H2 r _ _ hx⟩)
end

@[simp] lemma span_span_coe_preimage : span R ((coe : span R s → M) ⁻¹' s) = ⊤ :=
eq_top_iff.2 $ λ x, subtype.rec_on x $ λ x hx _, begin
  refine span_induction' (λ x hx, _) _ (λ x y _ _, _) (λ r x _, _) hx,
  { exact subset_span hx },
  { exact zero_mem _ },
  { exact add_mem },
  { exact smul_mem _ _ }
end

lemma span_nat_eq_add_submonoid_closure (s : set M) :
  (span ℕ s).to_add_submonoid = add_submonoid.closure s :=
begin
  refine eq.symm (add_submonoid.closure_eq_of_le subset_span _),
  apply add_submonoid.to_nat_submodule.symm.to_galois_connection.l_le _,
  rw span_le,
  exact add_submonoid.subset_closure,
end

@[simp] lemma span_nat_eq (s : add_submonoid M) : (span ℕ (s : set M)).to_add_submonoid = s :=
by rw [span_nat_eq_add_submonoid_closure, s.closure_eq]

lemma span_int_eq_add_subgroup_closure {M : Type*} [add_comm_group M] (s : set M) :
  (span ℤ s).to_add_subgroup = add_subgroup.closure s :=
eq.symm $ add_subgroup.closure_eq_of_le _ subset_span $ λ x hx, span_induction hx
  (λ x hx, add_subgroup.subset_closure hx) (add_subgroup.zero_mem _)
  (λ _ _, add_subgroup.add_mem _) (λ _ _ _, add_subgroup.zsmul_mem _ ‹_› _)

@[simp] lemma span_int_eq {M : Type*} [add_comm_group M] (s : add_subgroup M) :
  (span ℤ (s : set M)).to_add_subgroup = s :=
by rw [span_int_eq_add_subgroup_closure, s.closure_eq]

section
variables (R M)

/-- `span` forms a Galois insertion with the coercion from submodule to set. -/
protected def gi : galois_insertion (@span R M _ _ _) coe :=
{ choice := λ s _, span R s,
  gc := λ s t, span_le,
  le_l_u := λ s, subset_span,
  choice_eq := λ s h, rfl }

end

@[simp] lemma span_empty : span R (∅ : set M) = ⊥ :=
(submodule.gi R M).gc.l_bot

@[simp] lemma span_univ : span R (univ : set M) = ⊤ :=
eq_top_iff.2 $ set_like.le_def.2 $ subset_span

lemma span_union (s t : set M) : span R (s ∪ t) = span R s ⊔ span R t :=
(submodule.gi R M).gc.l_sup

lemma span_Union {ι} (s : ι → set M) : span R (⋃ i, s i) = ⨆ i, span R (s i) :=
(submodule.gi R M).gc.l_supr

lemma span_Union₂ {ι} {κ : ι → Sort*} (s : Π i, κ i → set M) :
  span R (⋃ i j, s i j) = ⨆ i j, span R (s i j) :=
(submodule.gi R M).gc.l_supr₂

lemma span_attach_bUnion [decidable_eq M] {α : Type*} (s : finset α) (f : s → finset M) :
  span R (s.attach.bUnion f : set M) = ⨆ x, span R (f x) :=
by simpa [span_Union]

lemma sup_span : p ⊔ span R s = span R (p ∪ s) :=
by rw [submodule.span_union, p.span_eq]

lemma span_sup : span R s ⊔ p = span R (s ∪ p) :=
by rw [submodule.span_union, p.span_eq]

/- Note that the character `∙` U+2219 used below is different from the scalar multiplication
character `•` U+2022 and the matrix multiplication character `⬝` U+2B1D. -/
notation R`∙`:1000 x := span R (@singleton _ _ set.has_singleton x)

lemma span_eq_supr_of_singleton_spans (s : set M) : span R s = ⨆ x ∈ s, R ∙ x :=
by simp only [←span_Union, set.bUnion_of_singleton s]

lemma span_range_eq_supr {ι : Type*} {v : ι → M} : span R (range v) = ⨆ i, R ∙ v i :=
by rw [span_eq_supr_of_singleton_spans, supr_range]

lemma span_smul_le (s : set M) (r : R) :
  span R (r • s) ≤ span R s :=
begin
  rw span_le,
  rintros _ ⟨x, hx, rfl⟩,
  exact smul_mem (span R s) r (subset_span hx),
end

lemma subset_span_trans {U V W : set M} (hUV : U ⊆ submodule.span R V)
  (hVW : V ⊆ submodule.span R W) :
  U ⊆ submodule.span R W :=
(submodule.gi R M).gc.le_u_l_trans hUV hVW

/-- See `submodule.span_smul_eq` (in `ring_theory.ideal.operations`) for
`span R (r • s) = r • span R s` that holds for arbitrary `r` in a `comm_semiring`. -/
lemma span_smul_eq_of_is_unit (s : set M) (r : R) (hr : is_unit r) :
  span R (r • s) = span R s :=
begin
  apply le_antisymm,
  { apply span_smul_le },
  { convert span_smul_le (r • s) ((hr.unit ⁻¹ : _) : R),
    rw smul_smul,
    erw hr.unit.inv_val,
    rw one_smul }
end

@[simp] theorem coe_supr_of_directed {ι} [hι : nonempty ι]
  (S : ι → submodule R M) (H : directed (≤) S) :
  ((supr S : submodule R M) : set M) = ⋃ i, S i :=
begin
  refine subset.antisymm _ (Union_subset $ le_supr S),
  suffices : (span R (⋃ i, (S i : set M)) : set M) ⊆ ⋃ (i : ι), ↑(S i),
    by simpa only [span_Union, span_eq] using this,
  refine (λ x hx, span_induction hx (λ _, id) _ _ _);
    simp only [mem_Union, exists_imp_distrib],
  { exact hι.elim (λ i, ⟨i, (S i).zero_mem⟩) },
  { intros x y i hi j hj,
    rcases H i j with ⟨k, ik, jk⟩,
    exact ⟨k, add_mem (ik hi) (jk hj)⟩ },
  { exact λ a x i hi, ⟨i, smul_mem _ a hi⟩ },
end

@[simp] theorem mem_supr_of_directed {ι} [nonempty ι]
  (S : ι → submodule R M) (H : directed (≤) S) {x} :
  x ∈ supr S ↔ ∃ i, x ∈ S i :=
by { rw [← set_like.mem_coe, coe_supr_of_directed S H, mem_Union], refl }

theorem mem_Sup_of_directed {s : set (submodule R M)}
  {z} (hs : s.nonempty) (hdir : directed_on (≤) s) :
  z ∈ Sup s ↔ ∃ y ∈ s, z ∈ y :=
begin
  haveI : nonempty s := hs.to_subtype,
  simp only [Sup_eq_supr', mem_supr_of_directed _ hdir.directed_coe, set_coe.exists, subtype.coe_mk]
end

@[norm_cast, simp] lemma coe_supr_of_chain (a : ℕ →o submodule R M) :
  (↑(⨆ k, a k) : set M) = ⋃ k, (a k : set M) :=
coe_supr_of_directed a a.monotone.directed_le

/-- We can regard `coe_supr_of_chain` as the statement that `coe : (submodule R M) → set M` is
Scott continuous for the ω-complete partial order induced by the complete lattice structures. -/
lemma coe_scott_continuous : omega_complete_partial_order.continuous'
  (coe : submodule R M → set M) :=
⟨set_like.coe_mono, coe_supr_of_chain⟩

@[simp] lemma mem_supr_of_chain (a : ℕ →o submodule R M) (m : M) :
  m ∈ (⨆ k, a k) ↔ ∃ k, m ∈ a k :=
mem_supr_of_directed a a.monotone.directed_le

section

variables {p p'}

lemma mem_sup : x ∈ p ⊔ p' ↔ ∃ (y ∈ p) (z ∈ p'), y + z = x :=
⟨λ h, begin
  rw [← span_eq p, ← span_eq p', ← span_union] at h,
  apply span_induction h,
  { rintro y (h | h),
    { exact ⟨y, h, 0, by simp, by simp⟩ },
    { exact ⟨0, by simp, y, h, by simp⟩ } },
  { exact ⟨0, by simp, 0, by simp⟩ },
  { rintro _ _ ⟨y₁, hy₁, z₁, hz₁, rfl⟩ ⟨y₂, hy₂, z₂, hz₂, rfl⟩,
    exact ⟨_, add_mem hy₁ hy₂, _, add_mem hz₁ hz₂, by simp [add_assoc]; cc⟩ },
  { rintro a _ ⟨y, hy, z, hz, rfl⟩,
    exact ⟨_, smul_mem _ a hy, _, smul_mem _ a hz, by simp [smul_add]⟩ }
end,
by rintro ⟨y, hy, z, hz, rfl⟩; exact add_mem
  ((le_sup_left : p ≤ p ⊔ p') hy)
  ((le_sup_right : p' ≤ p ⊔ p') hz)⟩

lemma mem_sup' : x ∈ p ⊔ p' ↔ ∃ (y : p) (z : p'), (y:M) + z = x :=
mem_sup.trans $ by simp only [set_like.exists, coe_mk]

variables (p p')

lemma coe_sup : ↑(p ⊔ p') = (p + p' : set M) :=
by { ext, rw [set_like.mem_coe, mem_sup, set.mem_add], simp, }

lemma sup_to_add_submonoid :
  (p ⊔ p').to_add_submonoid = p.to_add_submonoid ⊔ p'.to_add_submonoid :=
begin
  ext x,
  rw [mem_to_add_submonoid, mem_sup, add_submonoid.mem_sup],
  refl,
end

lemma sup_to_add_subgroup {R M : Type*} [ring R] [add_comm_group M] [module R M]
  (p p' : submodule R M) :
  (p ⊔ p').to_add_subgroup = p.to_add_subgroup ⊔ p'.to_add_subgroup :=
begin
  ext x,
  rw [mem_to_add_subgroup, mem_sup, add_subgroup.mem_sup],
  refl,
end

end

lemma mem_span_singleton_self (x : M) : x ∈ R ∙ x := subset_span rfl

lemma nontrivial_span_singleton {x : M} (h : x ≠ 0) : nontrivial (R ∙ x) :=
⟨begin
    use [0, x, submodule.mem_span_singleton_self x],
    intros H,
    rw [eq_comm, submodule.mk_eq_zero] at H,
    exact h H
end⟩

lemma mem_span_singleton {y : M} : x ∈ (R ∙ y) ↔ ∃ a:R, a • y = x :=
⟨λ h, begin
  apply span_induction h,
  { rintro y (rfl|⟨⟨⟩⟩), exact ⟨1, by simp⟩ },
  { exact ⟨0, by simp⟩ },
  { rintro _ _ ⟨a, rfl⟩ ⟨b, rfl⟩,
    exact ⟨a + b, by simp [add_smul]⟩ },
  { rintro a _ ⟨b, rfl⟩,
    exact ⟨a * b, by simp [smul_smul]⟩ }
end,
by rintro ⟨a, y, rfl⟩; exact
  smul_mem _ _ (subset_span $ by simp)⟩

lemma le_span_singleton_iff {s : submodule R M} {v₀ : M} :
  s ≤ (R ∙ v₀) ↔ ∀ v ∈ s, ∃ r : R, r • v₀ = v :=
by simp_rw [set_like.le_def, mem_span_singleton]

variables (R)

lemma span_singleton_eq_top_iff (x : M) : (R ∙ x) = ⊤ ↔ ∀ v, ∃ r : R, r • x = v :=
by { rw [eq_top_iff, le_span_singleton_iff], tauto }

@[simp] lemma span_zero_singleton : (R ∙ (0:M)) = ⊥ :=
by { ext, simp [mem_span_singleton, eq_comm] }

lemma span_singleton_eq_range (y : M) : ↑(R ∙ y) = range ((• y) : R → M) :=
set.ext $ λ x, mem_span_singleton

lemma span_singleton_smul_le {S} [monoid S] [has_smul S R] [mul_action S M]
  [is_scalar_tower S R M] (r : S) (x : M) : (R ∙ (r • x)) ≤ R ∙ x :=
begin
  rw [span_le, set.singleton_subset_iff, set_like.mem_coe],
  exact smul_of_tower_mem _ _ (mem_span_singleton_self _)
end

lemma span_singleton_group_smul_eq {G} [group G] [has_smul G R] [mul_action G M]
  [is_scalar_tower G R M] (g : G) (x : M) : (R ∙ (g • x)) = R ∙ x :=
begin
  refine le_antisymm (span_singleton_smul_le R g x) _,
  convert span_singleton_smul_le R (g⁻¹) (g • x),
  exact (inv_smul_smul g x).symm
end

variables {R}

lemma span_singleton_smul_eq {r : R} (hr : is_unit r) (x : M) : (R ∙ (r • x)) = R ∙ x :=
begin
  lift r to Rˣ using hr,
  rw ←units.smul_def,
  exact span_singleton_group_smul_eq R r x,
end

lemma disjoint_span_singleton {K E : Type*} [division_ring K] [add_comm_group E] [module K E]
  {s : submodule K E} {x : E} :
  disjoint s (K ∙ x) ↔ (x ∈ s → x = 0) :=
begin
  refine disjoint_def.trans ⟨λ H hx, H x hx $ subset_span $ mem_singleton x, _⟩,
  assume H y hy hyx,
  obtain ⟨c, rfl⟩ := mem_span_singleton.1 hyx,
  by_cases hc : c = 0,
  { rw [hc, zero_smul] },
  { rw [s.smul_mem_iff hc] at hy,
    rw [H hy, smul_zero] }
end

lemma disjoint_span_singleton' {K E : Type*} [division_ring K] [add_comm_group E] [module K E]
  {p : submodule K E} {x : E} (x0 : x ≠ 0) :
  disjoint p (K ∙ x) ↔ x ∉ p :=
disjoint_span_singleton.trans ⟨λ h₁ h₂, x0 (h₁ h₂), λ h₁ h₂, (h₁ h₂).elim⟩

lemma mem_span_singleton_trans {x y z : M} (hxy : x ∈ R ∙ y) (hyz : y ∈ R ∙ z) :
  x ∈ R ∙ z :=
begin
  rw [← set_like.mem_coe, ← singleton_subset_iff] at *,
  exact submodule.subset_span_trans hxy hyz
end

lemma mem_span_insert {y} : x ∈ span R (insert y s) ↔ ∃ (a:R) (z ∈ span R s), x = a • y + z :=
begin
  simp only [← union_singleton, span_union, mem_sup, mem_span_singleton, exists_prop,
    exists_exists_eq_and],
  rw [exists_comm],
  simp only [eq_comm, add_comm, exists_and_distrib_left]
end

lemma span_insert (x) (s : set M) : span R (insert x s) = span R ({x} : set M) ⊔ span R s :=
by rw [insert_eq, span_union]

lemma span_insert_eq_span (h : x ∈ span R s) : span R (insert x s) = span R s :=
span_eq_of_le _ (set.insert_subset.mpr ⟨h, subset_span⟩) (span_mono $ subset_insert _ _)

lemma span_span : span R (span R s : set M) = span R s := span_eq _

variables (R S s)

/-- If `R` is "smaller" ring than `S` then the span by `R` is smaller than the span by `S`. -/
lemma span_le_restrict_scalars [semiring S] [has_smul R S] [module S M] [is_scalar_tower R S M] :
  span R s ≤ (span S s).restrict_scalars R :=
submodule.span_le.2 submodule.subset_span

/-- A version of `submodule.span_le_restrict_scalars` with coercions. -/
@[simp] lemma span_subset_span [semiring S] [has_smul R S] [module S M] [is_scalar_tower R S M] :
  ↑(span R s) ⊆ (span S s : set M) :=
span_le_restrict_scalars R S s

/-- Taking the span by a large ring of the span by the small ring is the same as taking the span
by just the large ring. -/
lemma span_span_of_tower [semiring S] [has_smul R S] [module S M] [is_scalar_tower R S M] :
  span S (span R s : set M) = span S s :=
le_antisymm (span_le.2 $ span_subset_span R S s) (span_mono subset_span)

variables {R S s}

lemma span_eq_bot : span R (s : set M) = ⊥ ↔ ∀ x ∈ s, (x:M) = 0 :=
eq_bot_iff.trans ⟨
  λ H x h, (mem_bot R).1 $ H $ subset_span h,
  λ H, span_le.2 (λ x h, (mem_bot R).2 $ H x h)⟩

@[simp] lemma span_singleton_eq_bot : (R ∙ x) = ⊥ ↔ x = 0 :=
span_eq_bot.trans $ by simp

@[simp] lemma span_zero : span R (0 : set M) = ⊥ := by rw [←singleton_zero, span_singleton_eq_bot]

lemma span_singleton_eq_span_singleton {R M : Type*} [ring R] [add_comm_group M] [module R M]
  [no_zero_smul_divisors R M] {x y : M} : (R ∙ x) = (R ∙ y) ↔ ∃ z : Rˣ, z • x = y :=
begin
  by_cases hx : x = 0,
  { rw [hx, span_zero_singleton, eq_comm, span_singleton_eq_bot],
    exact ⟨λ hy, ⟨1, by rw [hy, smul_zero]⟩, λ ⟨_, hz⟩, by rw [← hz, smul_zero]⟩ },
  by_cases hy : y = 0,
  { rw [hy, span_zero_singleton, span_singleton_eq_bot],
    exact ⟨λ hx, ⟨1, by rw [hx, smul_zero]⟩, λ ⟨z, hz⟩, (smul_eq_zero_iff_eq z).mp hz⟩ },
  split,
  { intro hxy,
    cases mem_span_singleton.mp (by { rw [hxy], apply mem_span_singleton_self }) with v hv,
    cases mem_span_singleton.mp (by { rw [← hxy], apply mem_span_singleton_self }) with i hi,
    have vi : v * i = 1 :=
    by { rw [← one_smul R y, ← hi, smul_smul] at hv, exact smul_left_injective R hy hv },
    have iv : i * v = 1 :=
    by { rw [← one_smul R x, ← hv, smul_smul] at hi, exact smul_left_injective R hx hi },
    exact ⟨⟨v, i, vi, iv⟩, hv⟩ },
  { rintro ⟨v, rfl⟩,
    rw span_singleton_group_smul_eq }
end

@[simp] lemma span_image [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) :
  span R₂ (f '' s) = map f (span R s) :=
(map_span f s).symm

lemma apply_mem_span_image_of_mem_span
   [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) {x : M} {s : set M} (h : x ∈ submodule.span R s) :
   f x ∈ submodule.span R₂ (f '' s) :=
begin
  rw submodule.span_image,
  exact submodule.mem_map_of_mem h
end

@[simp] lemma map_subtype_span_singleton {p : submodule R M} (x : p) :
  map p.subtype (R ∙ x) = R ∙ (x : M) :=
by simp [← span_image]

/-- `f` is an explicit argument so we can `apply` this theorem and obtain `h` as a new goal. -/
lemma not_mem_span_of_apply_not_mem_span_image
   [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) {x : M} {s : set M}
   (h : f x ∉ submodule.span R₂ (f '' s)) :
   x ∉ submodule.span R s :=
h.imp (apply_mem_span_image_of_mem_span f)

lemma supr_eq_span {ι : Sort*} (p : ι → submodule R M) :
  (⨆ (i : ι), p i) = submodule.span R (⋃ (i : ι), ↑(p i)) :=
le_antisymm
  (supr_le $ assume i, subset.trans (assume m hm, set.mem_Union.mpr ⟨i, hm⟩) subset_span)
  (span_le.mpr $ Union_subset_iff.mpr $ assume i m hm, mem_supr_of_mem i hm)

lemma supr_to_add_submonoid {ι : Sort*} (p : ι → submodule R M) :
  (⨆ i, p i).to_add_submonoid = ⨆ i, (p i).to_add_submonoid :=
begin
  refine le_antisymm (λ x, _) (supr_le $ λ i, to_add_submonoid_mono $ le_supr _ i),
  simp_rw [supr_eq_span, add_submonoid.supr_eq_closure, mem_to_add_submonoid, coe_to_add_submonoid],
  intros hx,
  refine submodule.span_induction hx (λ x hx, _) _ (λ x y hx hy, _) (λ r x hx, _),
  { exact add_submonoid.subset_closure hx },
  { exact add_submonoid.zero_mem _ },
  { exact add_submonoid.add_mem _ hx hy },
  { apply add_submonoid.closure_induction hx,
    { rintros x ⟨_, ⟨i, rfl⟩, hix : x ∈ p i⟩,
      apply add_submonoid.subset_closure (set.mem_Union.mpr ⟨i, _⟩),
      exact smul_mem _ r hix },
    { rw smul_zero,
      exact add_submonoid.zero_mem _ },
    { intros x y hx hy,
      rw smul_add,
      exact add_submonoid.add_mem _ hx hy, } }
end

/-- An induction principle for elements of `⨆ i, p i`.
If `C` holds for `0` and all elements of `p i` for all `i`, and is preserved under addition,
then it holds for all elements of the supremum of `p`. -/
@[elab_as_eliminator]
lemma supr_induction {ι : Sort*} (p : ι → submodule R M) {C : M → Prop} {x : M} (hx : x ∈ ⨆ i, p i)
  (hp : ∀ i (x ∈ p i), C x)
  (h0 : C 0)
  (hadd : ∀ x y, C x → C y → C (x + y)) : C x :=
begin
  rw [←mem_to_add_submonoid, supr_to_add_submonoid] at hx,
  exact add_submonoid.supr_induction _ hx hp h0 hadd,
end

/-- A dependent version of `submodule.supr_induction`. -/
@[elab_as_eliminator]
lemma supr_induction' {ι : Sort*} (p : ι → submodule R M) {C : Π x, (x ∈ ⨆ i, p i) → Prop}
  (hp : ∀ i (x ∈ p i), C x (mem_supr_of_mem i ‹_›))
  (h0 : C 0 (zero_mem _))
  (hadd : ∀ x y hx hy, C x hx → C y hy → C (x + y) (add_mem ‹_› ‹_›))
  {x : M} (hx : x ∈ ⨆ i, p i) : C x hx :=
begin
  refine exists.elim _ (λ (hx : x ∈ ⨆ i, p i) (hc : C x hx), hc),
  refine supr_induction p hx (λ i x hx, _) _ (λ x y, _),
  { exact ⟨_, hp _ _ hx⟩ },
  { exact ⟨_, h0⟩ },
  { rintro ⟨_, Cx⟩ ⟨_, Cy⟩,
    refine ⟨_, hadd _ _ _ _ Cx Cy⟩ },
end

@[simp] lemma span_singleton_le_iff_mem (m : M) (p : submodule R M) : (R ∙ m) ≤ p ↔ m ∈ p :=
by rw [span_le, singleton_subset_iff, set_like.mem_coe]

lemma singleton_span_is_compact_element (x : M) :
  complete_lattice.is_compact_element (span R {x} : submodule R M) :=
begin
  rw complete_lattice.is_compact_element_iff_le_of_directed_Sup_le,
  intros d hemp hdir hsup,
  have : x ∈ Sup d, from (set_like.le_def.mp hsup) (mem_span_singleton_self x),
  obtain ⟨y, ⟨hyd, hxy⟩⟩ := (mem_Sup_of_directed hemp hdir).mp this,
  exact ⟨y, ⟨hyd, by simpa only [span_le, singleton_subset_iff]⟩⟩,
end

/-- The span of a finite subset is compact in the lattice of submodules. -/
lemma finset_span_is_compact_element (S : finset M) :
  complete_lattice.is_compact_element (span R S : submodule R M) :=
begin
  rw span_eq_supr_of_singleton_spans,
  simp only [finset.mem_coe],
  rw ←finset.sup_eq_supr,
  exact complete_lattice.finset_sup_compact_of_compact S
    (λ x _, singleton_span_is_compact_element x),
end

/-- The span of a finite subset is compact in the lattice of submodules. -/
lemma finite_span_is_compact_element (S : set M) (h : S.finite) :
  complete_lattice.is_compact_element (span R S : submodule R M) :=
finite.coe_to_finset h ▸ (finset_span_is_compact_element h.to_finset)

instance : is_compactly_generated (submodule R M) :=
⟨λ s, ⟨(λ x, span R {x}) '' s, ⟨λ t ht, begin
  rcases (set.mem_image _ _ _).1 ht with ⟨x, hx, rfl⟩,
  apply singleton_span_is_compact_element,
end, by rw [Sup_eq_supr, supr_image, ←span_eq_supr_of_singleton_spans, span_eq]⟩⟩⟩

lemma lt_sup_iff_not_mem {I : submodule R M} {a : M} : I < I ⊔ (R ∙ a) ↔ a ∉ I :=
begin
  split,
  { intro h,
    by_contra akey,
    have h1 : I ⊔ (R ∙ a) ≤ I,
    { simp only [sup_le_iff],
      split,
      { exact le_refl I, },
      { exact (span_singleton_le_iff_mem a I).mpr akey, } },
    have h2 := gt_of_ge_of_gt h1 h,
    exact lt_irrefl I h2, },
  { intro h,
    apply set_like.lt_iff_le_and_exists.mpr, split,
    simp only [le_sup_left],
    use a,
    split, swap, { assumption, },
    { have : (R ∙ a) ≤ I ⊔ (R ∙ a) := le_sup_right,
      exact this (mem_span_singleton_self a), } },
end

lemma mem_supr {ι : Sort*} (p : ι → submodule R M) {m : M} :
  (m ∈ ⨆ i, p i) ↔ (∀ N, (∀ i, p i ≤ N) → m ∈ N) :=
begin
  rw [← span_singleton_le_iff_mem, le_supr_iff],
  simp only [span_singleton_le_iff_mem],
end

section

open_locale classical

/-- For every element in the span of a set, there exists a finite subset of the set
such that the element is contained in the span of the subset. -/
lemma mem_span_finite_of_mem_span {S : set M} {x : M} (hx : x ∈ span R S) :
  ∃ T : finset M, ↑T ⊆ S ∧ x ∈ span R (T : set M) :=
begin
  refine span_induction hx (λ x hx, _) _ _ _,
  { refine ⟨{x}, _, _⟩,
    { rwa [finset.coe_singleton, set.singleton_subset_iff] },
    { rw finset.coe_singleton,
      exact submodule.mem_span_singleton_self x } },
  { use ∅, simp },
  { rintros x y ⟨X, hX, hxX⟩ ⟨Y, hY, hyY⟩,
    refine ⟨X ∪ Y, _, _⟩,
    { rw finset.coe_union,
      exact set.union_subset hX hY },
    rw [finset.coe_union, span_union, mem_sup],
    exact ⟨x, hxX, y, hyY, rfl⟩, },
  { rintros a x ⟨T, hT, h2⟩,
    exact ⟨T, hT, smul_mem _ _ h2⟩ }
end

end

variables {M' : Type*} [add_comm_monoid M'] [module R M'] (q₁ q₁' : submodule R M')

/-- The product of two submodules is a submodule. -/
def prod : submodule R (M × M') :=
{ carrier   := (p : set M) ×ˢ (q₁ : set M'),
  smul_mem' := by rintro a ⟨x, y⟩ ⟨hx, hy⟩; exact ⟨smul_mem _ a hx, smul_mem _ a hy⟩,
  .. p.to_add_submonoid.prod q₁.to_add_submonoid }

@[simp] lemma prod_coe :
  (prod p q₁ : set (M × M')) = (p : set M) ×ˢ (q₁ : set M') := rfl

@[simp] lemma mem_prod {p : submodule R M} {q : submodule R M'} {x : M × M'} :
  x ∈ prod p q ↔ x.1 ∈ p ∧ x.2 ∈ q := set.mem_prod

lemma span_prod_le (s : set M) (t : set M') :
  span R (s ×ˢ t) ≤ prod (span R s) (span R t) :=
span_le.2 $ set.prod_mono subset_span subset_span

@[simp] lemma prod_top : (prod ⊤ ⊤ : submodule R (M × M')) = ⊤ :=
by ext; simp

@[simp] lemma prod_bot : (prod ⊥ ⊥ : submodule R (M × M')) = ⊥ :=
by ext ⟨x, y⟩; simp [prod.zero_eq_mk]

lemma prod_mono {p p' : submodule R M} {q q' : submodule R M'} :
  p ≤ p' → q ≤ q' → prod p q ≤ prod p' q' := prod_mono

@[simp] lemma prod_inf_prod : prod p q₁ ⊓ prod p' q₁' = prod (p ⊓ p') (q₁ ⊓ q₁') :=
set_like.coe_injective set.prod_inter_prod

@[simp] lemma prod_sup_prod : prod p q₁ ⊔ prod p' q₁' = prod (p ⊔ p') (q₁ ⊔ q₁') :=
begin
  refine le_antisymm (sup_le
    (prod_mono le_sup_left le_sup_left)
    (prod_mono le_sup_right le_sup_right)) _,
  simp [set_like.le_def], intros xx yy hxx hyy,
  rcases mem_sup.1 hxx with ⟨x, hx, x', hx', rfl⟩,
  rcases mem_sup.1 hyy with ⟨y, hy, y', hy', rfl⟩,
  refine mem_sup.2 ⟨(x, y), ⟨hx, hy⟩, (x', y'), ⟨hx', hy'⟩, rfl⟩
end

end add_comm_monoid

section add_comm_group

variables [ring R] [add_comm_group M] [module R M]

@[simp] lemma span_neg (s : set M) : span R (-s) = span R s :=
calc span R (-s) = span R ((-linear_map.id : M →ₗ[R] M) '' s) : by simp
 ... = map (-linear_map.id) (span R s) : ((-linear_map.id).map_span _).symm
... = span R s : by simp

lemma mem_span_insert' {x y} {s : set M} : x ∈ span R (insert y s) ↔ ∃(a:R), x + a • y ∈ span R s :=
begin
  rw mem_span_insert, split,
  { rintro ⟨a, z, hz, rfl⟩, exact ⟨-a, by simp [hz, add_assoc]⟩ },
  { rintro ⟨a, h⟩, exact ⟨-a, _, h, by simp [add_comm, add_left_comm]⟩ }
end

instance : is_modular_lattice (submodule R M) :=
⟨λ x y z xz a ha, begin
  rw [mem_inf, mem_sup] at ha,
  rcases ha with ⟨⟨b, hb, c, hc, rfl⟩, haz⟩,
  rw mem_sup,
  refine ⟨b, hb, c, mem_inf.2 ⟨hc, _⟩, rfl⟩,
  rw [← add_sub_cancel c b, add_comm],
  apply z.sub_mem haz (xz hb),
end⟩

end add_comm_group

section add_comm_group

variables [semiring R] [semiring R₂]
variables [add_comm_group M] [module R M] [add_comm_group M₂] [module R₂ M₂]
variables {τ₁₂ : R →+* R₂} [ring_hom_surjective τ₁₂]

lemma comap_map_eq (f : M →ₛₗ[τ₁₂] M₂) (p : submodule R M) :
  comap f (map f p) = p ⊔ f.ker :=
begin
  refine le_antisymm _ (sup_le (le_comap_map _ _) (comap_mono bot_le)),
  rintro x ⟨y, hy, e⟩,
  exact mem_sup.2 ⟨y, hy, x - y, by simpa using sub_eq_zero.2 e.symm, by simp⟩
end

lemma comap_map_eq_self {f : M →ₛₗ[τ₁₂] M₂} {p : submodule R M} (h : f.ker ≤ p) :
  comap f (map f p) = p :=
by rw [submodule.comap_map_eq, sup_of_le_left h]

end add_comm_group

end submodule

namespace linear_map

open submodule function

section add_comm_group

variables [semiring R] [semiring R₂]
variables [add_comm_group M] [add_comm_group M₂]
variables [module R M] [module R₂ M₂]
variables {τ₁₂ : R →+* R₂} [ring_hom_surjective τ₁₂]
include R

protected lemma map_le_map_iff (f : M →ₛₗ[τ₁₂] M₂) {p p'} : map f p ≤ map f p' ↔ p ≤ p' ⊔ ker f :=
by rw [map_le_iff_le_comap, submodule.comap_map_eq]

theorem map_le_map_iff' {f : M →ₛₗ[τ₁₂] M₂} (hf : ker f = ⊥) {p p'} :
  map f p ≤ map f p' ↔ p ≤ p' :=
by rw [linear_map.map_le_map_iff, hf, sup_bot_eq]

theorem map_injective {f : M →ₛₗ[τ₁₂] M₂} (hf : ker f = ⊥) : injective (map f) :=
λ p p' h, le_antisymm ((map_le_map_iff' hf).1 (le_of_eq h)) ((map_le_map_iff' hf).1 (ge_of_eq h))

theorem map_eq_top_iff {f : M →ₛₗ[τ₁₂] M₂} (hf : range f = ⊤) {p : submodule R M} :
  p.map f = ⊤ ↔ p ⊔ f.ker = ⊤ :=
by simp_rw [← top_le_iff, ← hf, range_eq_map, linear_map.map_le_map_iff]

end add_comm_group

section
variables (R) (M) [semiring R] [add_comm_monoid M] [module R M]

/-- Given an element `x` of a module `M` over `R`, the natural map from
    `R` to scalar multiples of `x`.-/
@[simps] def to_span_singleton (x : M) : R →ₗ[R] M := linear_map.id.smul_right x

/-- The range of `to_span_singleton x` is the span of `x`.-/
lemma span_singleton_eq_range (x : M) : (R ∙ x) = (to_span_singleton R M x).range :=
submodule.ext $ λ y, by {refine iff.trans _ linear_map.mem_range.symm, exact mem_span_singleton }

@[simp] lemma to_span_singleton_one (x : M) : to_span_singleton R M x 1 = x := one_smul _ _

@[simp] lemma to_span_singleton_zero : to_span_singleton R M 0 = 0 := by { ext, simp, }

end

section add_comm_monoid

variables [semiring R] [add_comm_monoid M] [module R M]
variables [semiring R₂] [add_comm_monoid M₂] [module R₂ M₂]
variables {σ₁₂ : R →+* R₂}

/-- If two linear maps are equal on a set `s`, then they are equal on `submodule.span s`.

See also `linear_map.eq_on_span'` for a version using `set.eq_on`. -/
lemma eq_on_span {s : set M} {f g : M →ₛₗ[σ₁₂] M₂} (H : set.eq_on f g s) ⦃x⦄ (h : x ∈ span R s) :
  f x = g x :=
by apply span_induction h H; simp {contextual := tt}

/-- If two linear maps are equal on a set `s`, then they are equal on `submodule.span s`.

This version uses `set.eq_on`, and the hidden argument will expand to `h : x ∈ (span R s : set M)`.
See `linear_map.eq_on_span` for a version that takes `h : x ∈ span R s` as an argument. -/
lemma eq_on_span' {s : set M} {f g : M →ₛₗ[σ₁₂] M₂} (H : set.eq_on f g s) :
  set.eq_on f g (span R s : set M) :=
eq_on_span H

/-- If `s` generates the whole module and linear maps `f`, `g` are equal on `s`, then they are
equal. -/
lemma ext_on {s : set M} {f g : M →ₛₗ[σ₁₂] M₂} (hv : span R s = ⊤) (h : set.eq_on f g s) :
  f = g :=
linear_map.ext (λ x, eq_on_span h (eq_top_iff'.1 hv _))

/-- If the range of `v : ι → M` generates the whole module and linear maps `f`, `g` are equal at
each `v i`, then they are equal. -/
lemma ext_on_range {ι : Type*} {v : ι → M} {f g : M →ₛₗ[σ₁₂] M₂} (hv : span R (set.range v) = ⊤)
  (h : ∀i, f (v i) = g (v i)) : f = g :=
ext_on hv (set.forall_range_iff.2 h)

end add_comm_monoid

section field

variables {K V} [field K] [add_comm_group V] [module K V]

noncomputable theory
open_locale classical

lemma span_singleton_sup_ker_eq_top (f : V →ₗ[K] K) {x : V} (hx : f x ≠ 0) :
  (K ∙ x) ⊔ f.ker = ⊤ :=
eq_top_iff.2 (λ y hy, submodule.mem_sup.2 ⟨(f y * (f x)⁻¹) • x,
  submodule.mem_span_singleton.2 ⟨f y * (f x)⁻¹, rfl⟩,
    ⟨y - (f y * (f x)⁻¹) • x,
      by rw [linear_map.mem_ker, f.map_sub, f.map_smul, smul_eq_mul, mul_assoc,
             inv_mul_cancel hx, mul_one, sub_self],
      by simp only [add_sub_cancel'_right]⟩⟩)

variables (K V)

lemma ker_to_span_singleton {x : V} (h : x ≠ 0) : (to_span_singleton K V x).ker = ⊥ :=
begin
  ext c, split,
  { intros hc, rw submodule.mem_bot, rw mem_ker at hc, by_contra hc',
    have : x = 0,
      calc x = c⁻¹ • (c • x) : by rw [← mul_smul, inv_mul_cancel hc', one_smul]
      ... = c⁻¹ • ((to_span_singleton K V x) c) : rfl
      ... = 0 : by rw [hc, smul_zero],
    tauto },
  { rw [mem_ker, submodule.mem_bot], intros h, rw h, simp }
end

end field

end linear_map

open linear_map

namespace linear_equiv

section field

variables (K V) [field K] [add_comm_group V] [module K V]

/-- Given a nonzero element `x` of a vector space `V` over a field `K`, the natural
    map from `K` to the span of `x`, with invertibility check to consider it as an
    isomorphism.-/
def to_span_nonzero_singleton (x : V) (h : x ≠ 0) : K ≃ₗ[K] (K ∙ x) :=
linear_equiv.trans
  (linear_equiv.of_injective
    (linear_map.to_span_singleton K V x) (ker_eq_bot.1 $ linear_map.ker_to_span_singleton K V h))
  (linear_equiv.of_eq (to_span_singleton K V x).range (K ∙ x)
    (span_singleton_eq_range K V x).symm)

lemma to_span_nonzero_singleton_one (x : V) (h : x ≠ 0) :
  linear_equiv.to_span_nonzero_singleton K V x h 1 =
    (⟨x, submodule.mem_span_singleton_self x⟩ : K ∙ x) :=
begin
  apply set_like.coe_eq_coe.mp,
  have : ↑(to_span_nonzero_singleton K V x h 1) = to_span_singleton K V x 1 := rfl,
  rw [this, to_span_singleton_one, submodule.coe_mk],
end

/-- Given a nonzero element `x` of a vector space `V` over a field `K`, the natural map
    from the span of `x` to `K`.-/
abbreviation coord (x : V) (h : x ≠ 0) : (K ∙ x) ≃ₗ[K] K :=
(to_span_nonzero_singleton K V x h).symm

lemma coord_self (x : V) (h : x ≠ 0) :
  (coord K V x h) (⟨x, submodule.mem_span_singleton_self x⟩ : K ∙ x) = 1 :=
by rw [← to_span_nonzero_singleton_one K V x h, linear_equiv.symm_apply_apply]

end field

end linear_equiv


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Nicolò Cavalleri
-/
import topology.algebra.module.basic
import topology.continuous_function.ordered
import topology.algebra.uniform_group
import topology.uniform_space.compact_convergence
import algebra.algebra.subalgebra
import tactic.field_simp

/-!
# Algebraic structures over continuous functions

In this file we define instances of algebraic structures over the type `continuous_map α β`
(denoted `C(α, β)`) of **bundled** continuous maps from `α` to `β`. For example, `C(α, β)`
is a group when `β` is a group, a ring when `β` is a ring, etc.

For each type of algebraic structure, we also define an appropriate subobject of `α → β`
with carrier `{ f : α → β | continuous f }`. For example, when `β` is a group, a subgroup
`continuous_subgroup α β` of `α → β` is constructed with carrier `{ f : α → β | continuous f }`.

Note that, rather than using the derived algebraic structures on these subobjects
(for example, when `β` is a group, the derived group structure on `continuous_subgroup α β`),
one should use `C(α, β)` with the appropriate instance of the structure.
-/

local attribute [elab_simple] continuous.comp

namespace continuous_functions

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

instance : has_coe_to_fun {f : α → β | continuous f} (λ _, α → β) :=  ⟨subtype.val⟩

end continuous_functions

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

@[to_additive]
instance has_mul [has_mul β] [has_continuous_mul β] : has_mul C(α, β) :=
⟨λ f g, ⟨f * g, continuous_mul.comp (f.continuous.prod_mk g.continuous : _)⟩⟩

@[simp, norm_cast, to_additive]
lemma coe_mul [has_mul β] [has_continuous_mul β] (f g : C(α, β)) :
  ((f * g : C(α, β)) : α → β) = (f : α → β) * (g : α → β) := rfl

@[to_additive]
instance [has_one β] : has_one C(α, β) := ⟨const (1 : β)⟩

@[simp, norm_cast, to_additive]
lemma coe_one [has_one β]  :
  ((1 : C(α, β)) : α → β) = (1 : α → β) := rfl

@[simp, to_additive] lemma mul_comp {α : Type*} {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [topological_space γ]
  [semigroup γ] [has_continuous_mul γ] (f₁ f₂ : C(β, γ)) (g : C(α, β)) :
  (f₁ * f₂).comp g = f₁.comp g * f₂.comp g :=
by { ext, simp, }

@[simp, to_additive] lemma one_comp {α : Type*} {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [topological_space γ] [has_one γ] (g : C(α, β)) :
  (1 : C(β, γ)).comp g = 1 :=
by { ext, simp, }

end continuous_map

section group_structure

/-!
### Group stucture

In this section we show that continuous functions valued in a topological group inherit
the structure of a group.
-/

section subtype

/-- The `submonoid` of continuous maps `α → β`. -/
@[to_additive "The `add_submonoid` of continuous maps `α → β`. "]
def continuous_submonoid (α : Type*) (β : Type*) [topological_space α] [topological_space β]
  [monoid β] [has_continuous_mul β] : submonoid (α → β) :=
{ carrier := { f : α → β | continuous f },
  one_mem' := @continuous_const _ _ _ _ 1,
  mul_mem' := λ f g fc gc, continuous.comp
    has_continuous_mul.continuous_mul (continuous.prod_mk fc gc : _) }

/-- The subgroup of continuous maps `α → β`. -/
@[to_additive "The `add_subgroup` of continuous maps `α → β`. "]
def continuous_subgroup (α : Type*) (β : Type*) [topological_space α] [topological_space β]
  [group β] [topological_group β] : subgroup (α → β) :=
{ inv_mem' := λ f fc, continuous.comp (@topological_group.continuous_inv β _ _ _) fc,
  ..continuous_submonoid α β, }.

end subtype

namespace continuous_map

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α]
  [topological_space β] [semigroup β] [has_continuous_mul β] : semigroup C(α, β) :=
{ mul_assoc := λ a b c, by ext; exact mul_assoc _ _ _,
  ..continuous_map.has_mul}

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [monoid β] [has_continuous_mul β] : monoid C(α, β) :=
{ one_mul := λ a, by ext; exact one_mul _,
  mul_one := λ a, by ext; exact mul_one _,
  ..continuous_map.semigroup,
  ..continuous_map.has_one }

/-- Coercion to a function as an `monoid_hom`. Similar to `monoid_hom.coe_fn`. -/
@[to_additive "Coercion to a function as an `add_monoid_hom`. Similar to `add_monoid_hom.coe_fn`.",
  simps]
def coe_fn_monoid_hom {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [monoid β] [has_continuous_mul β] : C(α, β) →* (α → β) :=
{ to_fun := coe_fn, map_one' := coe_one, map_mul' := coe_mul }

/-- Composition on the left by a (continuous) homomorphism of topological monoids, as a
`monoid_hom`. Similar to `monoid_hom.comp_left`. -/
@[to_additive "Composition on the left by a (continuous) homomorphism of topological `add_monoid`s,
as an `add_monoid_hom`. Similar to `add_monoid_hom.comp_left`.", simps]
protected def _root_.monoid_hom.comp_left_continuous (α : Type*) {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [monoid β] [has_continuous_mul β]
  [topological_space γ] [monoid γ] [has_continuous_mul γ] (g : β →* γ) (hg : continuous g)  :
  C(α, β) →* C(α, γ) :=
{ to_fun := λ f, (⟨g, hg⟩ : C(β, γ)).comp f,
  map_one' := ext $ λ x, g.map_one,
  map_mul' := λ f₁ f₂, ext $ λ x, g.map_mul _ _ }

/-- Composition on the right as a `monoid_hom`. Similar to `monoid_hom.comp_hom'`. -/
@[to_additive "Composition on the right as an `add_monoid_hom`. Similar to
`add_monoid_hom.comp_hom'`.", simps]
def comp_monoid_hom' {α : Type*} {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [topological_space γ]
  [monoid γ] [has_continuous_mul γ] (g : C(α, β)) : C(β, γ) →* C(α, γ) :=
{ to_fun := λ f, f.comp g, map_one' := one_comp g, map_mul' := λ f₁ f₂, mul_comp f₁ f₂ g }

@[simp, norm_cast]
lemma coe_pow {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [monoid β] [has_continuous_mul β] (f : C(α, β)) (n : ℕ) :
  ((f^n : C(α, β)) : α → β) = (f : α → β)^n :=
(coe_fn_monoid_hom : C(α, β) →* _).map_pow f n

@[simp] lemma pow_comp {α : Type*} {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [topological_space γ]
  [monoid γ] [has_continuous_mul γ] (f : C(β, γ)) (n : ℕ) (g : C(α, β)) :
  (f^n).comp g = (f.comp g)^n :=
(comp_monoid_hom' g).map_pow f n

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α]
[topological_space β] [comm_monoid β] [has_continuous_mul β] : comm_monoid C(α, β) :=
{ one_mul := λ a, by ext; exact one_mul _,
  mul_one := λ a, by ext; exact mul_one _,
  mul_comm := λ a b, by ext; exact mul_comm _ _,
  ..continuous_map.semigroup,
  ..continuous_map.has_one }

open_locale big_operators
@[simp, to_additive] lemma coe_prod {α : Type*} {β : Type*} [comm_monoid β]
  [topological_space α] [topological_space β] [has_continuous_mul β]
  {ι : Type*} (s : finset ι) (f : ι → C(α, β)) :
  ⇑(∏ i in s, f i) = (∏ i in s, (f i : α → β)) :=
(coe_fn_monoid_hom : C(α, β) →* _).map_prod f s

@[to_additive]
lemma prod_apply {α : Type*} {β : Type*} [comm_monoid β]
  [topological_space α] [topological_space β] [has_continuous_mul β]
  {ι : Type*} (s : finset ι) (f : ι → C(α, β)) (a : α) :
  (∏ i in s, f i) a = (∏ i in s, f i a) :=
by simp

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [group β] [topological_group β] : group C(α, β) :=
{ inv := λ f, ⟨λ x, (f x)⁻¹, continuous_inv.comp f.continuous⟩,
  mul_left_inv := λ a, by ext; exact mul_left_inv _,
  ..continuous_map.monoid }

@[simp, norm_cast, to_additive]
lemma coe_inv {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [group β] [topological_group β] (f : C(α, β)) :
  ((f⁻¹ : C(α, β)) : α → β) = (f⁻¹ : α → β) :=
rfl

@[simp, norm_cast, to_additive]
lemma coe_div {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [group β] [topological_group β] (f g : C(α, β)) :
  ((f / g : C(α, β)) : α → β) = (f : α → β) / (g : α → β) :=
by { simp only [div_eq_mul_inv], refl, }

@[simp, to_additive] lemma inv_comp {α : Type*} {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [topological_space γ]
  [group γ] [topological_group γ] (f : C(β, γ)) (g : C(α, β)) :
  (f⁻¹).comp g = (f.comp g)⁻¹ :=
by { ext, simp, }

@[simp, to_additive] lemma div_comp {α : Type*} {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [topological_space γ]
  [group γ] [topological_group γ] (f g : C(β, γ)) (h : C(α, β)) :
  (f / g).comp h = (f.comp h) / (g.comp h) :=
by { ext, simp, }

@[to_additive]
instance {α : Type*} {β : Type*} [topological_space α]
  [topological_space β] [comm_group β] [topological_group β] : comm_group C(α, β) :=
{ ..continuous_map.group,
  ..continuous_map.comm_monoid }

@[to_additive] instance {α : Type*} {β : Type*} [topological_space α]
  [topological_space β] [comm_group β] [topological_group β] : topological_group C(α, β) :=
{ continuous_mul := by
  { letI : uniform_space β := topological_group.to_uniform_space β,
    have : uniform_group β := topological_group_is_uniform,
    rw continuous_iff_continuous_at,
    rintros ⟨f, g⟩,
    rw [continuous_at, tendsto_iff_forall_compact_tendsto_uniformly_on, nhds_prod_eq],
    exactI λ K hK, ((tendsto_iff_forall_compact_tendsto_uniformly_on.mp filter.tendsto_id K hK).prod
      (tendsto_iff_forall_compact_tendsto_uniformly_on.mp filter.tendsto_id K hK)).comp'
      uniform_continuous_mul },
  continuous_inv := by
  { letI : uniform_space β := topological_group.to_uniform_space β,
    have : uniform_group β := topological_group_is_uniform,
    rw continuous_iff_continuous_at,
    intro f,
    rw [continuous_at, tendsto_iff_forall_compact_tendsto_uniformly_on],
    exactI λ K hK, (tendsto_iff_forall_compact_tendsto_uniformly_on.mp filter.tendsto_id K hK).comp'
      uniform_continuous_inv } }

end continuous_map

end group_structure

section ring_structure

/-!
### Ring stucture

In this section we show that continuous functions valued in a topological ring `R` inherit
the structure of a ring.
-/

section subtype

/-- The subsemiring of continuous maps `α → β`. -/
def continuous_subsemiring (α : Type*) (R : Type*) [topological_space α] [topological_space R]
  [semiring R] [topological_ring R] : subsemiring (α → R) :=
{ ..continuous_add_submonoid α R,
  ..continuous_submonoid α R }.

/-- The subring of continuous maps `α → β`. -/
def continuous_subring (α : Type*) (R : Type*) [topological_space α] [topological_space R]
  [ring R] [topological_ring R] : subring (α → R) :=
{ ..continuous_subsemiring α R,
  ..continuous_add_subgroup α R }.

end subtype

namespace continuous_map

instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [semiring β] [topological_ring β] : semiring C(α, β) :=
{ left_distrib := λ a b c, by ext; exact left_distrib _ _ _,
  right_distrib := λ a b c, by ext; exact right_distrib _ _ _,
  zero_mul := λ a, by ext; exact zero_mul _,
  mul_zero := λ a, by ext; exact mul_zero _,
  ..continuous_map.add_comm_monoid,
  ..continuous_map.monoid }

instance {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [ring β] [topological_ring β] : ring C(α, β) :=
{ ..continuous_map.semiring,
  ..continuous_map.add_comm_group, }

instance {α : Type*} {β : Type*} [topological_space α]
  [topological_space β] [comm_ring β] [topological_ring β] : comm_ring C(α, β) :=
{ ..continuous_map.semiring,
  ..continuous_map.add_comm_group,
  ..continuous_map.comm_monoid,}

/-- Composition on the left by a (continuous) homomorphism of topological rings, as a `ring_hom`.
Similar to `ring_hom.comp_left`. -/
@[simps] protected def _root_.ring_hom.comp_left_continuous (α : Type*) {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [semiring β] [topological_ring β]
  [topological_space γ] [semiring γ] [topological_ring γ] (g : β →+* γ) (hg : continuous g) :
  C(α, β) →+* C(α, γ) :=
{ .. g.to_monoid_hom.comp_left_continuous α hg,
  .. g.to_add_monoid_hom.comp_left_continuous α hg }

/-- Coercion to a function as a `ring_hom`. -/
@[simps]
def coe_fn_ring_hom {α : Type*} {β : Type*} [topological_space α] [topological_space β]
  [ring β] [topological_ring β] : C(α, β) →+* (α → β) :=
{ to_fun := coe_fn,
  ..(coe_fn_monoid_hom : C(α, β) →* _),
  ..(coe_fn_add_monoid_hom : C(α, β) →+ _) }

end continuous_map

end ring_structure

local attribute [ext] subtype.eq

section module_structure

/-!
### Semiodule stucture

In this section we show that continuous functions valued in a topological module `M` over a
topological semiring `R` inherit the structure of a module.
-/

section subtype

variables (α : Type*) [topological_space α]
variables (R : Type*) [semiring R] [topological_space R]
variables (M : Type*) [topological_space M] [add_comm_group M]
variables [module R M] [has_continuous_smul R M] [topological_add_group M]

/-- The `R`-submodule of continuous maps `α → M`. -/
def continuous_submodule : submodule R (α → M) :=
{ carrier := { f : α → M | continuous f },
  smul_mem' := λ c f hf, continuous_smul.comp
    (continuous.prod_mk (continuous_const : continuous (λ x, c)) hf),
  ..continuous_add_subgroup α M }

end subtype

namespace continuous_map
variables {α : Type*} [topological_space α]
  {R : Type*} [semiring R] [topological_space R]
  {M : Type*} [topological_space M] [add_comm_monoid M]
  {M₂ : Type*} [topological_space M₂] [add_comm_monoid M₂]

instance
  [module R M] [has_continuous_smul R M] :
  has_scalar R C(α, M) :=
⟨λ r f, ⟨r • f, f.continuous.const_smul r⟩⟩

@[simp, norm_cast]
lemma coe_smul [module R M] [has_continuous_smul R M]
  (c : R) (f : C(α, M)) : ⇑(c • f) = c • f := rfl

lemma smul_apply [module R M] [has_continuous_smul R M]
  (c : R) (f : C(α, M)) (a : α) : (c • f) a = c • (f a) :=
by simp

@[simp] lemma smul_comp {α : Type*} {β : Type*}
  [topological_space α] [topological_space β]
   [module R M] [has_continuous_smul R M] (r : R) (f : C(β, M)) (g : C(α, β)) :
  (r • f).comp g = r • (f.comp g) :=
by { ext, simp, }

variables [has_continuous_add M] [module R M] [has_continuous_smul R M]
variables [has_continuous_add M₂] [module R M₂] [has_continuous_smul R M₂]

instance module : module R C(α, M) :=
{ smul     := (•),
  smul_add := λ c f g, by { ext, exact smul_add c (f x) (g x) },
  add_smul := λ c₁ c₂ f, by { ext, exact add_smul c₁ c₂ (f x) },
  mul_smul := λ c₁ c₂ f, by { ext, exact mul_smul c₁ c₂ (f x) },
  one_smul := λ f, by { ext, exact one_smul R (f x) },
  zero_smul := λ f, by { ext, exact zero_smul _ _ },
  smul_zero := λ r, by { ext, exact smul_zero _ } }

variables (R)

/-- Composition on the left by a continuous linear map, as a `linear_map`.
Similar to `linear_map.comp_left`. -/
@[simps] protected def _root_.continuous_linear_map.comp_left_continuous (α : Type*)
  [topological_space α] (g : M →L[R] M₂) :
  C(α, M) →ₗ[R] C(α, M₂) :=
{ map_smul' := λ c f, ext $ λ x, g.map_smul' c _,
  .. g.to_linear_map.to_add_monoid_hom.comp_left_continuous α g.continuous }

/-- Coercion to a function as a `linear_map`. -/
@[simps]
def coe_fn_linear_map : C(α, M) →ₗ[R] (α → M) :=
{ to_fun := coe_fn,
  map_smul' := coe_smul,
  ..(coe_fn_add_monoid_hom : C(α, M) →+ _) }

end continuous_map

end module_structure

section algebra_structure

/-!
### Algebra structure

In this section we show that continuous functions valued in a topological algebra `A` over a ring
`R` inherit the structure of an algebra. Note that the hypothesis that `A` is a topological algebra
is obtained by requiring that `A` be both a `has_continuous_smul` and a `topological_ring`.-/

section subtype

variables {α : Type*} [topological_space α]
{R : Type*} [comm_semiring R]
{A : Type*} [topological_space A] [semiring A]
[algebra R A] [topological_ring A]

/-- The `R`-subalgebra of continuous maps `α → A`. -/
def continuous_subalgebra : subalgebra R (α → A) :=
{ carrier := { f : α → A | continuous f },
  algebra_map_mem' := λ r, (continuous_const : continuous $ λ (x : α), algebra_map R A r),
  ..continuous_subsemiring α A }

end subtype

section continuous_map

variables {α : Type*} [topological_space α]
{R : Type*} [comm_semiring R]
{A : Type*} [topological_space A] [semiring A]
[algebra R A] [topological_ring A]
{A₂ : Type*} [topological_space A₂] [semiring A₂]
[algebra R A₂] [topological_ring A₂]

/-- Continuous constant functions as a `ring_hom`. -/
def continuous_map.C : R →+* C(α, A) :=
{ to_fun    := λ c : R, ⟨λ x: α, ((algebra_map R A) c), continuous_const⟩,
  map_one'  := by ext x; exact (algebra_map R A).map_one,
  map_mul'  := λ c₁ c₂, by ext x; exact (algebra_map R A).map_mul _ _,
  map_zero' := by ext x; exact (algebra_map R A).map_zero,
  map_add'  := λ c₁ c₂, by ext x; exact (algebra_map R A).map_add _ _ }

@[simp] lemma continuous_map.C_apply (r : R) (a : α) : continuous_map.C r a = algebra_map R A r :=
rfl

variables [topological_space R] [has_continuous_smul R A] [has_continuous_smul R A₂]

instance continuous_map.algebra : algebra R C(α, A) :=
{ to_ring_hom := continuous_map.C,
  commutes' := λ c f, by ext x; exact algebra.commutes' _ _,
  smul_def' := λ c f, by ext x; exact algebra.smul_def' _ _, }

variables (R)

/-- Composition on the left by a (continuous) homomorphism of topological `R`-algebras, as an
`alg_hom`. Similar to `alg_hom.comp_left`. -/
@[simps] protected def alg_hom.comp_left_continuous {α : Type*} [topological_space α]
  (g : A →ₐ[R] A₂) (hg : continuous g) :
  C(α, A) →ₐ[R] C(α, A₂) :=
{ commutes' := λ c, continuous_map.ext $ λ _, g.commutes' _,
  .. g.to_ring_hom.comp_left_continuous α hg }

/-- Coercion to a function as an `alg_hom`. -/
@[simps]
def continuous_map.coe_fn_alg_hom : C(α, A) →ₐ[R] (α → A) :=
{ to_fun := coe_fn,
  commutes' := λ r, rfl,
  -- `..(continuous_map.coe_fn_ring_hom : C(α, A) →+* _)` times out for some reason
  map_zero' := continuous_map.coe_zero,
  map_one' := continuous_map.coe_one,
  map_add' := continuous_map.coe_add,
  map_mul' := continuous_map.coe_mul }

instance: is_scalar_tower R A C(α, A) :=
{ smul_assoc := λ _ _ _, by { ext, simp } }

variables {R}

/--
A version of `separates_points` for subalgebras of the continuous functions,
used for stating the Stone-Weierstrass theorem.
-/
abbreviation subalgebra.separates_points (s : subalgebra R C(α, A)) : Prop :=
set.separates_points ((λ f : C(α, A), (f : α → A)) '' (s : set C(α, A)))

lemma subalgebra.separates_points_monotone :
  monotone (λ s : subalgebra R C(α, A), s.separates_points) :=
λ s s' r h x y n,
begin
  obtain ⟨f, m, w⟩ := h n,
  rcases m with ⟨f, ⟨m, rfl⟩⟩,
  exact ⟨_, ⟨f, ⟨r m, rfl⟩⟩, w⟩,
end

@[simp] lemma algebra_map_apply (k : R) (a : α) :
  algebra_map R C(α, A) k a = k • 1 :=
by { rw algebra.algebra_map_eq_smul_one, refl, }

variables {𝕜 : Type*} [topological_space 𝕜]

/--
A set of continuous maps "separates points strongly"
if for each pair of distinct points there is a function with specified values on them.

We give a slightly unusual formulation, where the specified values are given by some
function `v`, and we ask `f x = v x ∧ f y = v y`. This avoids needing a hypothesis `x ≠ y`.

In fact, this definition would work perfectly well for a set of non-continuous functions,
but as the only current use case is in the Stone-Weierstrass theorem,
writing it this way avoids having to deal with casts inside the set.
(This may need to change if we do Stone-Weierstrass on non-compact spaces,
where the functions would be continuous functions vanishing at infinity.)
-/
def set.separates_points_strongly (s : set C(α, 𝕜)) : Prop :=
∀ (v : α → 𝕜) (x y : α), ∃ f : s, (f x : 𝕜) = v x ∧ f y = v y

variables [field 𝕜] [topological_ring 𝕜]

/--
Working in continuous functions into a topological field,
a subalgebra of functions that separates points also separates points strongly.

By the hypothesis, we can find a function `f` so `f x ≠ f y`.
By an affine transformation in the field we can arrange so that `f x = a` and `f x = b`.
-/
lemma subalgebra.separates_points.strongly {s : subalgebra 𝕜 C(α, 𝕜)} (h : s.separates_points) :
  (s : set C(α, 𝕜)).separates_points_strongly :=
λ v x y,
begin
  by_cases n : x = y,
  { subst n,
    use ((v x) • 1 : C(α, 𝕜)),
    { apply s.smul_mem,
      apply s.one_mem, },
    { simp [coe_fn_coe_base'] }, },
  obtain ⟨f, ⟨f, ⟨m, rfl⟩⟩, w⟩ := h n,
  replace w : f x - f y ≠ 0 := sub_ne_zero_of_ne w,
  let a := v x,
  let b := v y,
  let f' := ((b - a) * (f x - f y)⁻¹) • (continuous_map.C (f x) - f) + continuous_map.C a,
  refine ⟨⟨f', _⟩, _, _⟩,
  { simp only [f', set_like.mem_coe, subalgebra.mem_to_submodule],
    -- TODO should there be a tactic for this?
    -- We could add an attribute `@[subobject_mem]`, and a tactic
    -- ``def subobject_mem := `[solve_by_elim with subobject_mem { max_depth := 10 }]``
    solve_by_elim
      [subalgebra.add_mem, subalgebra.smul_mem, subalgebra.sub_mem, subalgebra.algebra_map_mem]
      { max_depth := 6 }, },
  { simp [f', coe_fn_coe_base'], },
  { simp [f', coe_fn_coe_base', inv_mul_cancel_right₀ w], },
end

end continuous_map

-- TODO[gh-6025]: make this an instance once safe to do so
lemma continuous_map.subsingleton_subalgebra (α : Type*) [topological_space α]
  (R : Type*) [comm_semiring R] [topological_space R] [topological_ring R]
  [subsingleton α] : subsingleton (subalgebra R C(α, R)) :=
begin
  fsplit,
  intros s₁ s₂,
  by_cases n : nonempty α,
  { obtain ⟨x⟩ := n,
    ext f,
    have h : f = algebra_map R C(α, R) (f x),
    { ext x', simp only [mul_one, algebra.id.smul_eq_mul, algebra_map_apply], congr, },
    rw h,
    simp only [subalgebra.algebra_map_mem], },
  { ext f,
    have h : f = 0,
    { ext x', exact false.elim (n ⟨x'⟩), },
    subst h,
    simp only [subalgebra.zero_mem], },
end

end algebra_structure

section module_over_continuous_functions

/-!
### Structure as module over scalar functions

If `M` is a module over `R`, then we show that the space of continuous functions from `α` to `M`
is naturally a module over the ring of continuous functions from `α` to `R`. -/

namespace continuous_map

instance has_scalar' {α : Type*} [topological_space α]
  {R : Type*} [semiring R] [topological_space R]
  {M : Type*} [topological_space M] [add_comm_monoid M]
  [module R M] [has_continuous_smul R M] :
  has_scalar C(α, R) C(α, M) :=
⟨λ f g, ⟨λ x, (f x) • (g x), (continuous.smul f.2 g.2)⟩⟩

instance module' {α : Type*} [topological_space α]
  (R : Type*) [ring R] [topological_space R] [topological_ring R]
  (M : Type*) [topological_space M] [add_comm_monoid M] [has_continuous_add M]
  [module R M] [has_continuous_smul R M] :
  module C(α, R) C(α, M) :=
{ smul     := (•),
  smul_add := λ c f g, by ext x; exact smul_add (c x) (f x) (g x),
  add_smul := λ c₁ c₂ f, by ext x; exact add_smul (c₁ x) (c₂ x) (f x),
  mul_smul := λ c₁ c₂ f, by ext x; exact mul_smul (c₁ x) (c₂ x) (f x),
  one_smul := λ f, by ext x; exact one_smul R (f x),
  zero_smul := λ f, by ext x; exact zero_smul _ _,
  smul_zero := λ r, by ext x; exact smul_zero _, }

end continuous_map

end module_over_continuous_functions

/-!
We now provide formulas for `f ⊓ g` and `f ⊔ g`, where `f g : C(α, β)`,
in terms of `continuous_map.abs`.
-/

section
variables {R : Type*} [linear_ordered_field R]

-- TODO:
-- This lemma (and the next) could go all the way back in `algebra.order.field`,
-- except that it is tedious to prove without tactics.
-- Rather than stranding it at some intermediate location,
-- it's here, immediately prior to the point of use.
lemma min_eq_half_add_sub_abs_sub {x y : R} : min x y = 2⁻¹ * (x + y - |x - y|) :=
by cases le_total x y with h h; field_simp [h, abs_of_nonneg, abs_of_nonpos, mul_two]; abel

lemma max_eq_half_add_add_abs_sub {x y : R} : max x y = 2⁻¹ * (x + y + |x - y|) :=
by cases le_total x y with h h; field_simp [h, abs_of_nonneg, abs_of_nonpos, mul_two]; abel

end

namespace continuous_map

section lattice
variables {α : Type*} [topological_space α]
variables {β : Type*} [linear_ordered_field β] [topological_space β]
  [order_topology β] [topological_ring β]

lemma inf_eq (f g : C(α, β)) : f ⊓ g = (2⁻¹ : β) • (f + g - |f - g|) :=
ext (λ x, by simpa using min_eq_half_add_sub_abs_sub)

-- Not sure why this is grosser than `inf_eq`:
lemma sup_eq (f g : C(α, β)) : f ⊔ g = (2⁻¹ : β) • (f + g + |f - g|) :=
ext (λ x, by simpa [mul_add] using @max_eq_half_add_add_abs_sub _ _ (f x) (g x))

end lattice

end continuous_map


import tactic
import data.complex.basic
import data.real.basic
import data.real.irrational
import data.nat.prime_norm_num
import algebra.group.ext
variables (α β γ R : Type)
variables (A B C : set α)
variables (a x y: α)
open_locale classical polynomial
variables [ring R] {p q : R[X]}

open set complex
section ext

/-
# New tactic: ext

`Extensionality` says that two sets are equal iff they have the same elements.

In Lean we can use the `ext` tactic to prove equality between sets.

We can also use it to prove equality of functions and many, many other objects
see the end of this file for some examples.

 -/
-- 01
example : A ∩ B = B ∩ A:=
begin
  ext,
  split,
  intro hx, exact ⟨hx.2,hx.1⟩,
  intro hx, exact ⟨hx.2,hx.1⟩,
end

-- 02
example :  A ∩ univ = A:=
begin
  ext a,
  sorry,
end

-- 03
example : A ∩ B ∪ C = C ∪ B ∩ A :=
begin
  ext,
  sorry,
end

-- 04
example : A ∪ Aᶜ = univ:=
begin
  sorry,
end

-- 05
example : A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C):=
begin
  sorry,
end

/- Using `ext` with functions is identical. -/
-- 06
example (f g : α → β) (h :∀ x:α, f x = g x) : f = g:=
begin
  ext,
  sorry,
end

-- Lets define two functions that are obviously equal.

def fun1 : ℕ → ℕ := λ n , (n+1)^2   -- this is just CS notation for  `n ↦ (n + 1)²`

def fun2 : ℕ → ℕ:= λ n, n^2 + 2*n + 1     -- and `n ↦ n² + 2n + 1`

-- We can use ext to prove that `fun1 = fun2`
-- 07
example  : fun1 = fun2 :=
begin
  ext n,
  unfold fun1 fun2,
  linarith,
end

/-
# have

In our next example it is useful to prove an intermediate result.
To do this we use the tactic: `have`.

The general form of this tactic is as follows:
If we want to prove a proposition `P` we do the following:

have h : P,
{
  proof of P,
},
-- now have `h : P` in the local context

-/
-- 07
example : A ∪ B ⊆ B ∪ C → A \ B ⊆ C :=
begin
  intros h x hab,
  cases hab with ha hnb,
  have h2 : x ∈ A ∪ B,
  {
    sorry,
  },
  sorry,
end

/- # New tactic : by_cases

If we have a proposition `P` then we can do a cases split on `P ∨ ¬ P`
using `by_cases P` -/

-- 08 If f and g agree on A and agree on Aᶜ then they are equal.
example  (f g : α → β) (A : set α) (hA: ∀ x, x ∈ A → f x = g x) (hAc: ∀ x, x ∈ Aᶜ → f x = g x):
f = g:=
begin
  ext,
  by_cases (x ∈ A),
  {
    sorry,
  },
  {
    sorry,
  },
end

/-
# New tactic: rintro

`rintro` allows us to do cases/intros recursively and quickly introduce
and breakup complicated expressions.

If the goal is `⊢ (P ∧ Q) → R` then `rintro ⟨hP,hQ⟩` will introduce two
terms `hP : P` and `hQ : Q` and change the goal to `⊢ R`
(So equivalent to `intro h` followed by `cases h with hP hQ`)

If the goal is `⊢ (P ∨ Q) → R` then `rintro (hP | hQ)` will split the goal into two
goals both `⊢ R`. In the 1st local context  you have `hP : P` and in the 2nd `hQ : Q`
(So equivalent to `intro h` followed by `cases h with hP hQ`)

If you have `⊢ (P ∧ Q ∧ (A ∨ B)) → C` then `rintro ⟨hP ,hQ, (hA | hB)⟩` will do what you need.

The easiest way to learn its syntax is to use `rintro?` which will then suggest a way
to use it (although you will probably want to change the variable names it introduces).

# New tactic: refine

`refine` is like exact but with the advantage that you can put `_` as placeholders
 for terms that you can't immediately fill-in.   -/
-- 09
example : (A \ B) ∪ (B \ A) = (A ∪ B) \ (A ∩ B) :=
begin
  ext,
  refine ⟨_,_⟩, -- equivalent to split,
  {
    rintro (⟨hA, hnB⟩ | ⟨hB, hnA⟩),
    split,
    left,
    exact hA,
    intro hAB,
    exact hnB hAB.2,
    sorry,
  },
  {
    rintro ⟨ha | hb, hnab⟩,
    {
      left,
      refine ⟨ha, _⟩, -- recall `x ∈ A \ B` is `x ∈ A ∧ x ∉ B`
      sorry
    },
    {
      sorry
    },
  },
end

-- 10
example :  A ∩ univ = A:=
begin
  sorry,
end

-- 11 At some point you might want to start looking in mathlib for one-line proofs..
example : (A ∪ B) ∪ C = A ∪ (B ∪ C):=
begin
  sorry,
end

-- 12
example : (A ∪ B) ∩ C = (A ∩ C) ∪ (B ∩ C):=
begin
  sorry,
end

-- Another way of proving that two sets are equal is to use anti-symmetry of ⊆
-- i.e. A ⊆ B → B ⊆ A →  A = B
-- 13
example : A ∪ B = B ∪ A:=
begin
  apply subset_antisymm,
  {
    sorry
  },
  {
    sorry
  },
end

-- 14
example : (A ∪ B ) ∩ (A ∪ C) = A ∪ (B ∩ C)  :=
begin
  symmetry, -- useful if  you'd prefer to prove `x = y` rather than `y = x`
  apply subset_antisymm,
  {
    rintro x (ha | ⟨hb,hc⟩),
    refine ⟨_,_⟩; {left, exact ha},
    refine ⟨_,_⟩; right, exact hb, exact hc,
  },
  {
    sorry
  },
end

/-
Some other uses of `ext` are given below
-/

-- two complex numbers are equal iff ...
example (z w : ℂ) : z = w :=
begin
  ext,
  sorry,
  sorry,
end

-- two rational numbers are equal iff ...
example (a b : ℚ ) : a = b :=
begin
  ext,
  sorry,
  sorry,
end

-- two terms in a product type are equal iff...
example (x y : α × β ) : x = y :=
begin
  ext,
  sorry,
  sorry,
end

-- polynomials in X over a ring R are equal iff all their coefficients agree
example (p q : R[X]) : p = q:=
begin
  ext,
  sorry,
end

-- two vectors in ℝ^5 agree iff..
example (v w : vector ℝ 5) : v = w:=
begin
  ext,
  sorry,
end

variables (m n : ℕ)
-- Two m x n matrices are equal iff..
example (M1 M2 : matrix (fin m) (fin n) α) : M1 = M2 :=
begin
  ext,
  sorry,
end

-- ext for finite sets is the same as for sets
example (s t : finset α) : s = t:=
begin
  ext,
  sorry,
end

-- two multisets with elements of type α are equal iff they contain the same number
-- of each term of α
example (M N : multiset α) : M = N:=
begin
  ext a,
  sorry,
end

-- two lists are equal iff they agree in all positions
example (l1 l2 : list α) : l1 = l2:=
begin
  ext n a,
sorry,
end

-- an equivalence relation  on α bundled with a proof that it is an equiv rel is called a setoid
example (r s : setoid α) : r = s:=
begin
  ext,
  sorry,
end

-- Two group structures on the same type α are equal iff their definitions of multiplication agree
example (G H : group α) : G = H :=
begin
  ext a b,
  sorry
end

-- A filters is a family of sets closed under taking super-sets and finite intersections
example (F G : filter α) : F = G:=
begin
  ext,
  sorry,
end

/- ETC...-/

end ext


-- Si_a_es_un_punto_de_acumulacion_de_u,_entonces_a_tiene_puntos_cercanos.lean
-- Si a es un punto de acumulación de u, entonces ∀ε>0, ∀ N, ∃k≥N, |u(k)−a| < ε
-- José A. Alonso Jiménez
-- Sevilla, 31 de agosto de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Para extraer una subsucesión se aplica una función de extracción que
-- conserva el orden; por ejemplo, la subsucesión
--    uₒ, u₂, u₄, u₆, ...
-- se ha obtenido con la función de extracción φ tal que φ(n) = 2*n.
--
-- En Lean, se puede definir que φ es una función de extracción por
--    def extraccion (φ : ℕ → ℕ) :=
--      ∀ n m, n < m → φ n < φ m
-- También se puede definir que a es un límite de u por
--    def limite (u : ℕ → ℝ) (a : ℝ) :=
--      ∀ ε > 0, ∃ N, ∀ k ≥ N, |u k - a| < ε
--
-- Los puntos de acumulación de una sucesión son los límites de sus
-- subsucesiones. En Lean se puede definir por
--    def punto_acumulacion (u : ℕ → ℝ) (a : ℝ) :=
--      ∃ φ, extraccion φ ∧ limite (u ∘ φ) a
--
-- Demostrar que si a es un punto de acumulación de u, entonces
--    ∀ ε > 0, ∀ N, ∃ k ≥ N, |u k - a| < ε
-- ---------------------------------------------------------------------

import data.real.basic
open nat

variable  {u : ℕ → ℝ}
variables {a : ℝ}
variable  {φ : ℕ → ℕ}

def extraccion (φ : ℕ → ℕ):=
  ∀ n m, n < m → φ n < φ m

notation `|`x`|` := abs x

def limite (u : ℕ → ℝ) (a : ℝ) :=
  ∀ ε > 0, ∃ N, ∀ k ≥ N, |u k - a| < ε

def punto_acumulacion (u : ℕ → ℝ) (a : ℝ) :=
  ∃ φ, extraccion φ ∧ limite (u ∘ φ) a

-- En la demostración se usarán los siguientes lemas.

lemma aux1
  (h : extraccion φ)
  : ∀ n, n ≤ φ n :=
begin
  intro n,
  induction n with m HI,
  { exact nat.zero_le (φ 0), },
  { apply nat.succ_le_of_lt,
    calc m ≤ φ m        : HI
       ... < φ (succ m) : h m (m+1) (lt_add_one m), },
end

lemma aux2
  (h : extraccion φ)
  : ∀ N N', ∃ n ≥ N', φ n ≥ N :=
λ N N', ⟨max N N', ⟨le_max_right N N',
                    le_trans (le_max_left N N')
                             (aux1 h (max N N'))⟩⟩

-- 1ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ k ≥ N, |u k - a| < ε :=
begin
  intros ε hε N,
  unfold punto_acumulacion at h,
  rcases h with ⟨φ, hφ1, hφ2⟩,
  unfold limite at hφ2,
  cases hφ2 ε hε with N' hN',
  rcases aux2 hφ1 N N' with ⟨m, hm, hm'⟩,
  clear hφ1 hφ2,
  use φ m,
  split,
  { exact hm', },
  { exact hN' m hm, },
end

-- 2ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| < ε :=
begin
  intros ε hε N,
  rcases h with ⟨φ, hφ1, hφ2⟩,
  cases hφ2 ε hε with N' hN',
  rcases aux2 hφ1 N N' with ⟨m, hm, hm'⟩,
  use φ m,
  exact ⟨hm', hN' m hm⟩,
end

-- 3ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| < ε :=
begin
  intros ε hε N,
  rcases h with ⟨φ, hφ1, hφ2⟩,
  cases hφ2 ε hε with N' hN',
  rcases aux2 hφ1 N N' with ⟨m, hm, hm'⟩,
  exact ⟨φ m, hm', hN' _ hm⟩,
end

-- 4ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| < ε :=
begin
  intros ε hε N,
  rcases h with ⟨φ, hφ1, hφ2⟩,
  cases hφ2 ε hε with N' hN',
  rcases aux2 hφ1 N N' with ⟨m, hm, hm'⟩,
  use φ m ; finish,
end

-- 5ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| < ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  ( assume φ,
    assume hφ : extraccion φ ∧ limite (u ∘ φ) a,
    exists.elim (hφ.2 ε hε)
      ( assume N',
        assume hN' : ∀ (n : ℕ), n ≥ N' → |(u ∘ φ) n - a| < ε,
        have h1 : ∃ n ≥ N', φ n ≥ N,
          from aux2 hφ.1 N N',
        exists.elim h1
          ( assume m,
            assume hm : ∃ (H : m ≥ N'), φ m ≥ N,
            exists.elim hm
              ( assume hm1 : m ≥ N',
                assume hm2 : φ m ≥ N,
                have h2 : |u (φ m) - a| < ε,
                  from hN' m hm1,
                show ∃ n ≥ N, |u n - a| < ε,
                  from exists.intro (φ m) (exists.intro hm2 h2)))))

-- 6ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| < ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  ( assume φ,
    assume hφ : extraccion φ ∧ limite (u ∘ φ) a,
    exists.elim (hφ.2 ε hε)
      ( assume N',
        assume hN' : ∀ (n : ℕ), n ≥ N' → |(u ∘ φ) n - a| < ε,
        have h1 : ∃ n ≥ N', φ n ≥ N,
          from aux2 hφ.1 N N',
        exists.elim h1
          ( assume m,
            assume hm : ∃ (H : m ≥ N'), φ m ≥ N,
            exists.elim hm
              ( assume hm1 : m ≥ N',
                assume hm2 : φ m ≥ N,
                have h2 : |u (φ m) - a| < ε,
                  from hN' m hm1,
                show ∃ n ≥ N, |u n - a| < ε,
                  from ⟨φ m, hm2, h2⟩))))

-- 7ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| < ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  ( assume φ,
    assume hφ : extraccion φ ∧ limite (u ∘ φ) a,
    exists.elim (hφ.2 ε hε)
      ( assume N',
        assume hN' : ∀ (n : ℕ), n ≥ N' → |(u ∘ φ) n - a| < ε,
        have h1 : ∃ n ≥ N', φ n ≥ N,
          from aux2 hφ.1 N N',
        exists.elim h1
          ( assume m,
            assume hm : ∃ (H : m ≥ N'), φ m ≥ N,
            exists.elim hm
              ( assume hm1 : m ≥ N',
                assume hm2 : φ m ≥ N,
                have h2 : |u (φ m) - a| < ε,
                  from hN' m hm1,
                ⟨φ m, hm2, h2⟩))))

-- 8ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| < ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  ( assume φ,
    assume hφ : extraccion φ ∧ limite (u ∘ φ) a,
    exists.elim (hφ.2 ε hε)
      ( assume N',
        assume hN' : ∀ (n : ℕ), n ≥ N' → |(u ∘ φ) n - a| < ε,
        have h1 : ∃ n ≥ N', φ n ≥ N,
          from aux2 hφ.1 N N',
        exists.elim h1
          ( assume m,
            assume hm : ∃ (H : m ≥ N'), φ m ≥ N,
            exists.elim hm
              ( assume hm1 : m ≥ N',
                assume hm2 : φ m ≥ N,
                ⟨φ m, hm2, hN' m hm1⟩))))

-- 9ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| < ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  ( assume φ,
    assume hφ : extraccion φ ∧ limite (u ∘ φ) a,
    exists.elim (hφ.2 ε hε)
      ( assume N',
        assume hN' : ∀ (n : ℕ), n ≥ N' → |(u ∘ φ) n - a| < ε,
        have h1 : ∃ n ≥ N', φ n ≥ N,
          from aux2 hφ.1 N N',
        exists.elim h1
          ( assume m,
            assume hm : ∃ (H : m ≥ N'), φ m ≥ N,
            exists.elim hm
              (λ hm1 hm2, ⟨φ m, hm2, hN' m hm1⟩))))

-- 10ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| < ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  ( assume φ,
    assume hφ : extraccion φ ∧ limite (u ∘ φ) a,
    exists.elim (hφ.2 ε hε)
      ( assume N',
        assume hN' : ∀ (n : ℕ), n ≥ N' → |(u ∘ φ) n - a| < ε,
        have h1 : ∃ n ≥ N', φ n ≥ N,
          from aux2 hφ.1 N N',
        exists.elim h1
          (λ m hm, exists.elim hm (λ hm1 hm2, ⟨φ m, hm2, hN' m hm1⟩))))

-- 11ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| < ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  ( assume φ,
    assume hφ : extraccion φ ∧ limite (u ∘ φ) a,
    exists.elim (hφ.2 ε hε)
      ( assume N',
        assume hN' : ∀ (n : ℕ), n ≥ N' → |(u ∘ φ) n - a| < ε,
        exists.elim (aux2 hφ.1 N N')
          (λ m hm, exists.elim hm (λ hm1 hm2, ⟨φ m, hm2, hN' m hm1⟩))))

-- 12ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| < ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  ( assume φ,
    assume hφ : extraccion φ ∧ limite (u ∘ φ) a,
    exists.elim (hφ.2 ε hε)
      (λ N' hN', exists.elim (aux2 hφ.1 N N')
        (λ m hm, exists.elim hm
          (λ hm1 hm2, ⟨φ m, hm2, hN' m hm1⟩))))

-- 13ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| < ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  (λ φ hφ, exists.elim (hφ.2 ε hε)
    (λ N' hN', exists.elim (aux2 hφ.1 N N')
      (λ m hm, exists.elim hm
        (λ hm1 hm2, ⟨φ m, hm2, hN' m hm1⟩))))

-- 14ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| < ε :=
λ ε hε N, exists.elim h
  (λ φ hφ, exists.elim (hφ.2 ε hε)
    (λ N' hN', exists.elim (aux2 hφ.1 N N')
      (λ m hm, exists.elim hm
        (λ hm1 hm2, ⟨φ m, hm2, hN' m hm1⟩))))


import tactic

/-
# Level 7 : Using if-then
-/

namespace math3345 -- hide

/-
P and Q are propositions.
-/

variable P : Prop
variable Q : Prop

/- Lemma : no-side-bar

We must prove `Q` given the hypothesis `hPQ` which is evidence that
`P` implies `Q` and using the hypothesis `hP`, which is evidence that
`P` holds.

We can achieve this with `exact` with the term `hPQ(hP)`.  You don't
even need to use the parentheses.

How is an implication like `hPQ` like a function from `P`s to `Q`s?
-/
lemma using_implication (hPQ : P → Q) (hP : P) : Q :=
begin
  sorry,

end

end math3345 -- hide


/-
Copyright (c) 2022 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import data.complex.module
import linear_algebra.determinant

/-!
# Determinants of maps in the complex numbers as a vector space over `ℝ`

This file provides results about the determinants of maps in the complex numbers as a vector
space over `ℝ`.

-/

namespace complex

/-- The determinant of `conj_ae`, as a linear map. -/
@[simp] lemma det_conj_ae : conj_ae.to_linear_map.det = -1 :=
begin
  rw [←linear_map.det_to_matrix basis_one_I, to_matrix_conj_ae, matrix.det_fin_two_of],
  simp
end

/-- The determinant of `conj_ae`, as a linear equiv. -/
@[simp] lemma linear_equiv_det_conj_ae : conj_ae.to_linear_equiv.det = -1 :=
by rw [←units.eq_iff, linear_equiv.coe_det, ←linear_equiv.to_linear_map_eq_coe,
       alg_equiv.to_linear_equiv_to_linear_map, det_conj_ae, units.coe_neg_one]

end complex


import .complex .algebra .macros .sets

theorem problem16
  : ∀ (a z : ℂ), |z| = 1 → 1 - (complex.conj a)*z ≠ 0
               → |z - a|/|1 - (complex.conj a) * z| = 1 :=
begin
  intros a z h1' h2, have h1 := eq_one_of_sqrt_eq_one h1',
  suffices : complex.norm (z - a)
           = complex.norm (1 - (complex.conj a) * z),
  { rw div_eq_one_iff_eq, assumption,
    revert h2, apply mt, intro h2,
    apply norm_zero_implies_zero, assumption, },
  apply congr_arg sqrt,
  cases z with x y, simp [complex.norm_squared] at h1,
  cases a with a b,
  simp [complex.conj],
  transitivity (x - a)*(x - a) + (y - b)*(y - b), refl,
  transitivity (1-a*x - b*y)*(1-a*x - b*y) + (-a*y + b*x)*(-a*y + b*x),
  { rw ← sub_add_eq_sub_sub,
    rw FOIL, rw (_ : -a * y * (-a * y) = (a*a)*(y*y)),
    rw (_ : b*x*(b*x) = (b*b)*(x*x)),
    rw sub_eq_add_neg (1 : ℝ), rw FOIL,
    rw mul_one, rw mul_one, rw one_mul,
    rw neg_mul_neg, rw FOIL,
    rw (_ : a * x * (a * x) = a * a * (x * x)),
    rw (_ : b * y * (b * y) = b * b * (y * y)),
    rw add_assoc,
    rw (_ : (a * a * (x * x) + a * x * (b * y) + b * y * (a * x) + b * b * (y * y))
          + (a * a * (y * y) + -a * y * (b * x) + b * x * (-a * y) + b * b * (x * x))
          = ((a * a * (x * x) + a * a * (y * y)) + a * x * (b * y) + b * y * (a * x))
          + (-a * y * (b * x) + b * x * (-a * y) + (b * b * (x * x) + b * b * (y * y)))),
    tactic.swap,
    { repeat { rw add_assoc }, apply congr_arg,
      repeat { rw ← add_left_comm ((a*a)*(y*y)) }, repeat { apply congr_arg },
      repeat { rw add_left_comm ((b*b)*(y*y)) }, repeat { apply congr_arg },
      apply add_comm },
    rw [← left_distrib (a*a) (x*x) (y*y), ← left_distrib (b*b) (x*x) (y*y)],
    rw [h1, mul_one, mul_one],
    rw [add_assoc, add_assoc, add_assoc, add_assoc, add_assoc],
    repeat { rw ← add_left_comm (a*a) },
    rw add_comm _ (b*b),
    repeat { rw ← add_left_comm (b*b) },
    rw [← add_assoc, ← add_assoc],
    rw [FOIL_neg_square, FOIL_neg_square],
    transitivity b * b + a * a + (x * x + y*y) + ((-(x * a) + -(x * a)) + (-(y * b) + -(y * b))),
    { generalize : -(x * a) = u, generalize : -(y * b) = v, ac_refl },
    apply congr, { congr, assumption },
    rw neg_add, rw mul_comm a x, rw mul_comm b y,
    generalize hu : -(x * a) = u,
    generalize hv : -(y * b) = v,
    rw add_assoc, rw add_assoc, rw add_assoc,
    rw add_left_comm u v v,
    transitivity u + (v + (u + (v + 0))), rw add_zero,
    congr, transitivity a * b * x * y + (a * b * x * y + (-(a * b * x * y) + -(a * b * x * y))),
    rw [← add_assoc, ← neg_add, add_neg_self],
    apply congr, { apply congr_arg, ac_refl },
    apply congr, { apply congr_arg, ac_refl },
    apply congr, { apply congr_arg, tactic.unwrap_neg, ac_refl },
    { tactic.unwrap_neg, ac_refl },
    ac_refl, ac_refl, ac_refl,
    rw [mul_left_comm, mul_assoc, ← mul_assoc, neg_mul_neg] },
  { rw (_ : 1 = complex.mk 1 0), simp,
    simp [complex.norm_squared], refl },
end

-- a set of complex numbers is a circle if it is a set of points
-- a fixed distance from some other point
def mk_circle (center : ℂ) (radius : ℝ) := { z : ℂ | |z - center| = radius }
def is_circle (S : set ℂ) := ∃ center radius, S = mk_circle center radius

lemma shift_sends_circles_to_circles
  : ∀ r z₀ c, fun.im (λ z, z - c) (mk_circle z₀ r)
            = mk_circle (z₀ - c) r :=
begin
  intros, funext, apply propext,
  suffices : (∃w, |w - z₀| = r ∧ b = w - c) ↔ |b - (z₀ - c)| = r, exact this,
  constructor; intro h,
  { cases h with w h, cases h with hdist hb,
    rw hb, rw [sub_eq_add_neg _ c, sub_eq_add_neg _ c],
    rw add_sub_add_right_eq_sub, assumption },
  { rw [sub_eq_add_neg, neg_sub, ← add_sub_assoc] at h,
    existsi b + c, constructor, assumption, rw add_sub_cancel }
end

noncomputable def center_of_inverted_circle (r : ℝ) (z₀ : ℂ) : ℂ :=
  complex.conj (complex.scalar_mul (1 / (complex.norm_squared z₀ - r * r)) z₀)

noncomputable def radius_of_inverted_circle (r : ℝ) (z₀ : ℂ) : ℝ :=
  √(complex.norm_squared (center_of_inverted_circle r z₀) - 1 / (complex.norm_squared z₀ - r * r))

lemma random_inversion_inequality
  (z₀ : ℂ) (r : ℝ) (h1 : r ≠ |z₀| ) (h2 : 0 < r) : 1 / (complex.norm_squared z₀ - r * r) ≤
    complex.norm_squared (complex.conj (complex.scalar_mul (1 / (complex.norm_squared z₀ - r * r)) z₀)) :=
begin
  rw (_ : complex.norm_squared (complex.conj (complex.scalar_mul (1 / (complex.norm_squared z₀ - r * r)) z₀))
          = complex.norm_squared z₀/(abs(complex.norm_squared z₀ - r*r)*abs(complex.norm_squared z₀ - r*r))),
  apply le_div_of_mul_le,
  have h2 : abs (complex.norm_squared z₀ - r * r) > 0,
  { apply lt_of_le_of_ne, apply abs_nonneg,
    apply ne.symm, apply mt eq_zero_of_abs_eq_zero,
    apply mt eq_of_sub_eq_zero, rw ← squared_norm_eq_norm_squared,
    apply mt (eq_of_nonneg_and_sq_eq _ _), apply ne.symm, assumption,
    apply complex.norm_nonneg, apply le_of_lt, assumption, },
  apply mul_pos h2 h2, rw ← mul_assoc,
  rw mul_comm (1 / (complex.norm_squared z₀ - r * r)) (abs (complex.norm_squared z₀ - r * r)),
  rw ← div_eq_mul_one_div, rw abs_div_self_eq_sgn,
  rw sgn_mul_abs_eq_self,
  apply sub_le_self, apply mul_self_nonneg,
  rw ← norm_squared_eq_norm_squared_of_conj,
  rw norm_squared_of_scale, rw [mul_comm, ← mul_assoc],
  rw [← div_eq_mul_one_div, ← div_eq_mul_one_div],
  rw div_div_eq_div_mul, rw abs_mul_abs_eq_self_mul_self,
end

lemma inverted_radius_eq_iverted_center_implies_center_eq_radius
  (z₀ : ℂ) (r : ℝ) (r_pos : r > 0)
  : |center_of_inverted_circle r z₀| = radius_of_inverted_circle r z₀
  → |z₀| = r :=
begin
  intro h, by_cases h' : |z₀| = r, assumption,
  have := eq_of_sqrt_eq _ _ h,
  have := eq_sub_implies_sub_zero _ _ this,
  have : complex.norm_squared z₀ - r * r = 0,
  apply classical.by_contradiction,
  intro h, apply inv_ne_zero h, rw inv_eq_one_div, assumption,
  have := eq_of_sub_eq_zero this,
  transitivity √ (r*r), apply congr_arg sqrt this,
  symmetry, apply sqrt_unique, apply mul_self_nonneg,
  apply le_of_lt, assumption, refl, apply complex.norm_squared_nonneg,
  dunfold center_of_inverted_circle,
  apply sub_nonneg_of_le,
  apply random_inversion_inequality,
  apply ne.symm, assumption, assumption
end

lemma inversion_sends_nonzero_circles_to_circles.helper
  (z z₀ : ℂ) (r : ℝ) (r_pos : r > 0) (z_not_zero : z ≠ 0) (hz : r ≠ |z₀| )
  : |z - z₀| = r ↔ |(1/z) - center_of_inverted_circle r z₀| = radius_of_inverted_circle r z₀ :=
begin
  dunfold center_of_inverted_circle radius_of_inverted_circle,
  have : |z - z₀| = r ↔ ( z₀.norm_squared - r*r)*|1/z|*|1/z| - 2 * complex.Re (z₀*(1/z)) + 1 = 0, {
    constructor; intro h,
    { have : |z - z₀|*|z - z₀| = r*r, rw h,
      transitivity complex.Re ((1 - z₀*(1/z))*complex.conj (1 - z₀*(1/z))) - r*r*( |1/z|*|1/z| ),
      { rw sub_mul, rw sub_mul,
        transitivity complex.norm_squared z₀ * |1 / z| * |1 / z| - 2 * (z₀ * (1 / z)).Re + 1 - r * r * |1 / z| * |1 / z|,
        { repeat { rw sub_eq_add_neg }, ac_refl },
        rw mul_assoc (r*r), congr,
        rw conj_sub, rw (_ : complex.conj 1 = 1),
        tactic.swap, transitivity complex.conj (complex.mk 1 0), refl, dsimp [complex.conj], rw neg_zero, refl,
        rw FOIL_sub, rw [one_mul, one_mul, mul_one],
        rw [Re_additive, Re_sub, Re_sub, sub_sub, ← Re_additive],
        transitivity 1 - 2 * (z₀ * (1 / z)).Re + complex.norm_squared z₀ * |1 / z| * |1 / z|,
        { repeat { rw sub_eq_add_neg }, ac_refl },
        congr, rw two_mul, rw Re_additive, apply congr_fun,
        apply congr_arg, apply Re_conj,
        rw ← squared_norm_eq_norm_squared,
        rw mul_right_comm ( |z₀| ), rw mul_assoc,
        rw ← norm_mul, rw squared_norm_eq_norm_squared,
        apply norm_squared_eq_mul_conj'' },
      rw ← norm_squared_eq_mul_conj'',
      rw [← h, mul_assoc, mul_left_comm _ ( |1/z| ) _, ← mul_assoc],
      rw ← norm_mul, rw sub_mul,
      rw ← div_eq_mul_one_div z, rw div_self z_not_zero,
      rw squared_norm_eq_norm_squared, apply sub_self },
    { have : (complex.norm_squared z₀ - r * r) * ( |1 / z| * |1 / z| ) - (2 * (z₀ * (1 / z)).Re) / ( |1 / z| * |1 / z| ) * ( |1 / z| * |1 / z| ) + 1/( |1 / z| * |1 / z| ) *  ( |1 / z| * |1 / z| ) = 0,
      rw ← mul_assoc, rw div_eq_mul_one_div _ ( |1 / z| * |1 / z| ),
      rw mul_assoc _ _ ( |1 / z| * |1 / z| ),
      rw mul_comm _ ( |1 / z| * |1 / z| ),
      rw ← div_eq_mul_one_div _ ( |1 / z| * |1 / z| ),
      rw div_self, rw mul_one, assumption,
      rw ← norm_mul, apply mt (norm_zero_implies_zero _),
      rw ← div_mul_eq_div_mul_one_div, intro h,
      apply z_not_zero, apply eq_zero_of_sqr_eq_zero,
      have := mt (@inv_ne_zero _ _ (z*z)),
      rw [classical.dne, classical.dne] at this,
      rw inv_eq_one_div at this, apply this, assumption,
      rw [← sub_mul, ← right_distrib] at this,
      have h1 : |1/z| * |1/z| ≠ 0,
      { rw ← norm_mul, apply mt (norm_zero_implies_zero _),
        intro h, have := classical.l_or_r_eq_zero_of_mul_eq_zero h,
        rw or_self at this, rw ← inv_eq_one_div at this,
        apply mt (@inv_ne_zero _ _ z), rw classical.dne, assumption,
        assumption },
      have := or.resolve_right (classical.l_or_r_eq_zero_of_mul_eq_zero this) h1,
      suffices : |z - z₀|*|z - z₀| = r*r,
      { transitivity √( |z - z₀|*|z - z₀| ),
        apply sqrt_unique, apply mul_self_nonneg, apply complex.norm_nonneg, refl,
        transitivity √(r*r), rw this, symmetry,
        apply sqrt_unique, apply mul_self_nonneg, apply le_of_lt, assumption, refl, },
      rw complex.squared_dist, apply eq_of_sub_eq_zero,
      transitivity complex.norm_squared z₀ - r * r - 2 * (z * complex.conj z₀).Re + complex.norm_squared z,
      { repeat { rw sub_eq_add_neg }, ac_refl },
      rw ← this,
      have : ∀ q, q / ( |1 / z| * |1 / z| ) = q * complex.norm_squared z,
      { intro q, rw div_eq_mul_one_div, congr, rw ← norm_mul,
        rw ← div_mul_eq_div_mul_one_div,
        rw ← inv_eq_one_div (z*z), rw norm_inv,
        rw ← inv_eq_one_div, rw division_ring.inv_inv,
        rw norm_mul, rw squared_norm_eq_norm_squared,
        rw norm_mul, apply division_ring.mul_ne_zero;
        apply mt (norm_zero_implies_zero _); assumption,
        apply division_ring.mul_ne_zero; assumption, },
      apply congr,
      { apply congr_arg, apply congr_arg,
        rw this, rw mul_assoc, rw mul_comm _ (complex.norm_squared _),
        rw ← Re_of_scale (complex.norm_squared _),
        rw [Re_conj, conj_mul, conj_of_conj],
        congr, rw scalar_mul_comm_mul', rw mul_comm, congr,
        rw norm_squared_div_self, },
      { rw this, rw one_mul } } },
  generalize hw : 1/z = w, rw hw at this,
  generalize hA : complex.norm_squared z₀ - r*r = A,
  have hA' : A ≠ 0,
  { rw ← hA, apply mt eq_of_sub_eq_zero, intro h, apply hz,
    transitivity √(r*r), apply sqrt_unique, apply mul_self_nonneg,
    apply le_of_lt, assumption, refl, rw ← h },
  rw mul_assoc at this, rw hA at this,
  have : |z - z₀| = r ↔ |w| * |w| - (2 * (z₀ * w).Re)/A + 1/A = 0,
  { rw this,
    rw (_ : |w| * |w| - 2 * (z₀ * w).Re / A + 1 / A = (A * ( |w| * |w| ) - 2 * (z₀ * w).Re + 1)/A),
    rw (_ : ((A * ( |w| * |w| ) - 2 * (z₀ * w).Re + 1) / A = 0) ↔
            (0 = (A * ( |w| * |w| ) - 2 * (z₀ * w).Re + 1) / A)),
    rw eq_div_iff_mul_eq _ _ hA', rw zero_mul,
    apply eq_symm_iff, apply eq_symm_iff,
    transitivity (A/A) * ( |w| * |w| ) - 2 * (z₀ * w).Re / A + 1 / A,
    rw [div_self hA', one_mul],
    rw div_eq_mul_one_div, rw div_eq_mul_one_div (_ * _),
    transitivity A * (1 / A) * ( |w| * |w| ) - 2 * (z₀ * w).Re * (1 / A) + 1 * (1 / A), rw one_mul,
    rw mul_right_comm, rw ← sub_mul, rw ← right_distrib,
    rw ← div_eq_mul_one_div },
  rw [mul_div_assoc, div_eq_mul_one_div] at this,
  rw [mul_comm _ (1/A), ← Re_of_scale] at this,
  rw (_ : complex.scalar_mul (1 / A) (z₀ * w) = complex.scalar_mul (1 / A) z₀ * w) at this,
  tactic.swap, rw mul_comm, transitivity complex.scalar_mul (1/A) (complex.mul w z₀),
  refl, rw scalar_mul_comm_mul, transitivity w * (complex.scalar_mul (1 / A) z₀), refl,
  apply mul_comm, rw ← conj_of_conj (complex.scalar_mul (1 / A) z₀) at this,
  rw squared_norm_eq_norm_squared at this,
  rw mul_comm _ w at this,
  have : |z - z₀| = r ↔ complex.norm_squared w - 2 * (w * complex.conj (complex.conj (complex.scalar_mul (1 / A) z₀))).Re  = -(1 / A),
  { transitivity (complex.norm_squared w - 2 * (w * complex.conj (complex.conj (complex.scalar_mul (1 / A) z₀))).Re  + (1 / A) = 0),
    assumption, constructor; intro h,
    apply eq_of_sub_eq_zero, rw sub_eq_add_neg, rw neg_neg, assumption,
    rw h, apply neg_add_self, },
  have h1 := complex.squared_dist w (complex.conj (complex.scalar_mul (1 / A) z₀)),
  transitivity complex.norm_squared w - 2 * (w * complex.conj (complex.conj (complex.scalar_mul (1 / A) z₀))).Re = -(1 / A), assumption,
  transitivity complex.norm_squared w - 2 * (w * complex.conj (complex.conj (complex.scalar_mul (1 / A) z₀))).Re + complex.norm_squared (complex.conj (complex.scalar_mul (1 / A) z₀)) = complex.norm_squared (complex.conj (complex.scalar_mul (1 / A) z₀)) - (1 / A),
  { constructor; intro h,
    rw h, rw [add_comm, ← sub_eq_add_neg],
    rw sub_eq_add_neg _ (1/A) at h,
    rw add_comm _ (-(1/A)) at h,
    apply add_right_cancel, assumption, },
  rw ← h1, rw squared_norm_eq_norm_squared,
  constructor; intro h,
  { apply congr_arg sqrt, assumption },
  { rw ← squared_norm_eq_norm_squared,
    rw h, apply sqrt_sq, apply sub_nonneg_of_le,
    rw ← hA,
    apply random_inversion_inequality,
    assumption', }
end

lemma inversion_sends_nonzero_circles_to_circles
  : ∀ r z₀, r ≠ |z₀| → r > 0 →
      fun.im (λ z : ℂ, 1/z) (mk_circle z₀ r)
      = mk_circle (center_of_inverted_circle r z₀)
                  (radius_of_inverted_circle r z₀) :=
begin
  intros _ _ hnon_zero hpos, funext z, apply propext,
  constructor; intro h',
  { cases h' with w hw, cases hw,
    have : |w - z₀| = r := hw_left,
    rw inversion_sends_nonzero_circles_to_circles.helper at this,
    have h1 : z = 1/w := hw_right,
    rw ← h1 at this, exact this, assumption',
    intro h, apply hnon_zero,
    rw ← this, rw h, rw norm_sub, rw sub_zero },
  { have : |z - center_of_inverted_circle r z₀| = radius_of_inverted_circle r z₀ := h',
    have h1 : z = 1/(1/z),
    { rw div_of_div_eq_self, apply one_ne_zero,
      intro h, apply hnon_zero, rw h at this, symmetry,
      apply inverted_radius_eq_iverted_center_implies_center_eq_radius,
      assumption, rw ← this, rw norm_sub, rw sub_zero },
    rw h1 at this,
    rw ← inversion_sends_nonzero_circles_to_circles.helper at this,
    existsi 1/z, constructor, assumption,
    simp, rw division_ring.inv_inv,
    { intro hz, have h1 : 1/z = 0, rw hz, rw div_zero,
      rw [h1, norm_sub, sub_zero] at this, apply hnon_zero, symmetry, assumption },
    assumption,
    { intro hz, rw [hz, norm_sub, div_zero, sub_zero] at this,
      apply hnon_zero, symmetry,
      apply inverted_radius_eq_iverted_center_implies_center_eq_radius,
      assumption, assumption },
    assumption }
end

lemma scale_sends_circles_to_circles
  : ∀ (r : ℝ) (z₀ c : ℂ), c ≠ 0 →
   fun.im (λ z, c * z) (mk_circle z₀ r)
   = mk_circle (c * z₀) ( |c| * r) :=
begin
  intros, funext, apply propext,
  suffices : (∃w, |w - z₀| = r ∧ b = c*w) ↔ |b - c*z₀| = |c|*r, exact this,
  constructor; intro h,
  { cases h with w h, cases h with hdist hb,
    rw hb, rw ← mul_sub, rw norm_mul, rw hdist },
  { existsi (b/c), constructor,
    { rw (_ : z₀ = (z₀*c)/c), rw div_sub_div_same,
    rw div_eq_mul_one_div, rw norm_mul,
    rw ← inv_eq_one_div, rw norm_inv, rw inv_eq_one_div,
    rw ←  div_eq_mul_one_div, apply mul_eq_of_eq_div,
    apply inv_ne_zero, apply mt (norm_zero_implies_zero _),
    assumption,
    rw inv_eq_one_div, rw div_eq_mul_one_div,
    rw div_of_div_eq_self, rw [mul_comm, mul_comm r],
    assumption, apply one_ne_zero,
    apply mt (norm_zero_implies_zero _), assumption,
    assumption, rw mul_div_cancel, assumption },
    rw mul_comm, rw div_mul_cancel, assumption },
end

theorem problem17
  : ∀ (ρ : ℝ), ρ > 0 → ρ ≠ 1
  → ∀ (z₀ z₁ : ℂ),
    z₀ ≠ z₁ → is_circle ({ z : ℂ | |z - z₀| = ρ * |z - z₁|}) :=
begin
  intros ρ h0 h1 z₀ z₁ hz,
  have : {z : ℂ | |z - z₀| = ρ * |z - z₁|} = {z : ℂ | |z - z₀|/|z - z₁| = ρ },
  { funext, apply propext, suffices : |z - z₀| = ρ * |z - z₁| ↔ |z - z₀|/|z - z₁| = ρ, exact this,
    constructor; intro h,
    { have : z - z₁ ≠ 0,
      { intro hz0, rw [hz0, norm_of_zero, mul_zero] at h,
        apply hz, transitivity z,
        apply eq_of_sub_eq_zero, apply neg_inj, rw neg_zero,
        rw neg_sub, apply norm_zero_implies_zero, assumption,
        apply eq_of_sub_eq_zero, assumption, },
      symmetry, rw eq_div_iff_mul_eq, symmetry, assumption,
      exact mt (norm_zero_implies_zero _) this },
    { symmetry, rw ← eq_div_iff_mul_eq, symmetry, assumption,
      intro hz, rw [hz, div_zero] at h,
      apply ne_of_gt h0, symmetry, assumption } },
  rw this,
  have : {z : ℂ | |z - z₀|/|z - z₁| = ρ } = {z : ℂ | |(z - z₀)/(z - z₁)| = ρ },
  { funext, apply propext, suffices : |z - z₀|/|z - z₁| = ρ ↔ |(z - z₀)/(z - z₁)| = ρ, exact this,
    constructor; intro h,
    { rw norm_div, exact h, intro hz, rw hz at h,
      rw [norm_of_zero, div_zero] at h, rw h at h0,
      apply lt_irrefl ρ, exact h0 },
    { rw ← norm_div, exact h, intro hz, rw hz at h,
      rw [div_zero, norm_of_zero] at h, rw h at h0,
      apply lt_irrefl ρ, exact h0 } },
  rw this,
  have h1 : ∀ z, z - z₁ ≠ 0 → 1 + (z₁ - z₀) / (z - z₁) = (z - z₀) / (z - z₁),
  { intros z hz, rw ← div_self hz, rw [div_add_div_same, ← add_sub_assoc, sub_add_cancel] },
  have : {z : ℂ | |(z - z₀)/(z - z₁)| = ρ } = {z : ℂ | |1 + (z₁ - z₀)/(z - z₁)| = ρ },
  { funext, apply propext, suffices : |(z - z₀)/(z - z₁)| = ρ ↔ |1 + (z₁ - z₀) / (z - z₁)| = ρ,
    exact this, constructor; intro h,
    { rw h1, exact h, intro hz, rw hz at h,
      rw [div_zero, norm_of_zero] at h, rw h at h0,
      apply lt_irrefl ρ, exact h0 },
    { rw ← h1, exact h, intro hz, rw hz at h,
      rw [div_zero, add_zero, norm_of_one] at h,
      refine ((_ : ρ ≠ 1) (eq.symm h)), assumption } },
  rw this,
  let f := λ z, 1 + (z₁ - z₀)/(z - z₁),
  let g := λ z, (z₁ - z₀)/(z - 1) + z₁,
  have gf_id : ∀ z, f (g z) = z,
  { intros z, dsimp [f, g],
    by_cases z = 1, { rw h, simp, rw [div_zero, div_zero, add_zero] },
    rw [add_assoc, add_neg_self, add_zero],
    rw [← sub_eq_add_neg, div_of_div_eq_self],
    rw [add_comm, add_assoc, neg_add_self, add_zero],
    apply mt eq_of_sub_eq_zero, apply ne.symm, assumption,
    rw ← sub_eq_add_neg, apply mt eq_of_sub_eq_zero, assumption },
  have fg_id : ∀ z, g (f z) = z,
  { intros z, dsimp [f, g],
    by_cases z = z₁, { rw h, simp, rw [div_zero, div_zero, add_zero] },
    rw [add_right_comm, add_neg_self, zero_add],
    rw [← sub_eq_add_neg, div_of_div_eq_self],
    rw [add_assoc, neg_add_self, add_zero],
    apply mt eq_of_sub_eq_zero, apply ne.symm, assumption,
    rw ← sub_eq_add_neg, intro hz, apply h, apply eq_of_sub_eq_zero hz },
  have : {z : ℂ | |1 + (z₁ - z₀)/(z - z₁)| = ρ } = {z : ℂ | |f z| = ρ }, refl,
  rw this,
  have : {z : ℂ | |f z| = ρ } = fun.pre_im f (mk_circle 0 ρ),
  { funext, apply propext, transitivity |f z| = ρ, refl,
    transitivity |f z - 0| = ρ, rw sub_zero, refl },
  rw this, clear this, clear this, clear this, clear this,
  rw fun.pre_im_of_inv_eq_im f g _ gf_id fg_id,
  let T0 : ℂ → ℂ := λ z, z - 1,
  let T1 : ℂ → ℂ := λ z, 1/z,
  let T2 : ℂ → ℂ := λ z, (z₁ - z₀) * z,
  let T3 : ℂ → ℂ := λ z, z - -z₁,
  have : g = T3 ∘ T2 ∘ T1 ∘ T0,
  { funext, simp [T0, T1, T2, T3, g, (/)],
    delta algebra.div, rw one_mul },
  rw this, clear this,
  rw [im_of_comp, im_of_comp], rw im_of_comp T0 T1,
  rw shift_sends_circles_to_circles, simp,
  rw inversion_sends_nonzero_circles_to_circles,
  rw scale_sends_circles_to_circles,
  rw shift_sends_circles_to_circles,
  existsi ((z₁ - z₀) * center_of_inverted_circle ρ (-1) - -z₁),
  existsi ( |z₁ - z₀| * radius_of_inverted_circle ρ (-1)),
  refl,
  apply mt eq_of_sub_eq_zero, apply ne.symm, assumption,
  rw norm_neg, rw norm_of_one, assumption,
  assumption
end