/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import algebra.big_operators.finsupp
import data.finset.pointwise
import data.finsupp.indicator
import data.fintype.big_operators

/-!
# Finitely supported product of finsets

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

This file defines the finitely supported product of finsets as a `finset (ι →₀ α)`.

## Main declarations

* `finset.finsupp`: Finitely supported product of finsets. `s.finset t` is the product of the `t i`
  over all `i ∈ s`.
* `finsupp.pi`: `f.pi` is the finset of `finsupp`s whose `i`-th value lies in `f i`. This is the
  special case of `finset.finsupp` where we take the product of the `f i` over the support of `f`.

## Implementation notes

We make heavy use of the fact that `0 : finset α` is `{0}`. This scalar actions convention turns out
to be precisely what we want here too.
-/

noncomputable theory

open finsupp
open_locale big_operators classical pointwise

variables {ι α : Type*} [has_zero α] {s : finset ι} {f : ι →₀ α}

namespace finset

/-- Finitely supported product of finsets. -/
protected def finsupp (s : finset ι) (t : ι → finset α) : finset (ι →₀ α) :=
(s.pi t).map ⟨indicator s, indicator_injective s⟩

lemma mem_finsupp_iff {t : ι → finset α} : f ∈ s.finsupp t ↔ f.support ⊆ s ∧ ∀ i ∈ s, f i ∈ t i :=
begin
  refine mem_map.trans ⟨_, _⟩,
  { rintro ⟨f, hf, rfl⟩,
    refine ⟨support_indicator_subset _ _, λ i hi, _⟩,
    convert mem_pi.1 hf i hi,
    exact indicator_of_mem hi _ },
  { refine λ h, ⟨λ i _, f i, mem_pi.2 h.2, _⟩,
    ext i,
    exact ite_eq_left_iff.2 (λ hi, (not_mem_support_iff.1 $ λ H, hi $ h.1 H).symm) }
end

/-- When `t` is supported on `s`, `f ∈ s.finsupp t` precisely means that `f` is pointwise in `t`. -/
@[simp] lemma mem_finsupp_iff_of_support_subset {t : ι →₀ finset α} (ht : t.support ⊆ s) :
  f ∈ s.finsupp t ↔ ∀ i, f i ∈ t i :=
begin
  refine mem_finsupp_iff.trans (forall_and_distrib.symm.trans $ forall_congr $ λ i, ⟨λ h, _,
    λ h, ⟨λ hi, ht $ mem_support_iff.2 $ λ H, mem_support_iff.1 hi _, λ _, h⟩⟩),
  { by_cases hi : i ∈ s,
    { exact h.2 hi },
    { rw [not_mem_support_iff.1 (mt h.1 hi), not_mem_support_iff.1 (λ H, hi $ ht H)],
      exact zero_mem_zero } },
  { rwa [H, mem_zero] at h }
end

@[simp] lemma card_finsupp (s : finset ι) (t : ι → finset α) :
  (s.finsupp t).card = ∏ i in s, (t i).card :=
(card_map _).trans $ card_pi _ _

end finset

open finset

namespace finsupp

/-- Given a finitely supported function `f : ι →₀ finset α`, one can define the finset
`f.pi` of all finitely supported functions whose value at `i` is in `f i` for all `i`. -/
def pi (f : ι →₀ finset α) : finset (ι →₀ α) := f.support.finsupp f

@[simp] lemma mem_pi {f : ι →₀ finset α} {g : ι →₀ α} : g ∈ f.pi ↔ ∀ i, g i ∈ f i :=
mem_finsupp_iff_of_support_subset $ subset.refl _

@[simp] lemma card_pi (f : ι →₀ finset α) : f.pi.card = f.prod (λ i, (f i).card) :=
begin
  rw [pi, card_finsupp],
  exact finset.prod_congr rfl (λ i _, by simp only [pi.nat_apply, nat.cast_id]),
end

end finsupp


import data.list.basic
open list
universe u
variables {α : Type} (x y z : α) (xs ys zs : list α)

def mk_symm (xs : list α) := xs ++ reverse xs

theorem reverse_mk_symm (xs : list α) :
  reverse (mk_symm xs) = mk_symm xs :=
  by simp [mk_symm]

example (xs ys : list ℕ) :
  reverse (xs ++ mk_symm ys) = mk_symm ys ++ reverse xs :=
  by simp [reverse_mk_symm]

example (xs ys : list ℕ) (p : list ℕ → Prop) (h : p (reverse (xs ++ (mk_symm ys)))) :
  p (mk_symm ys ++ reverse xs) :=
  by simp [reverse_mk_symm] at h; assumption


/-
Algebraic geometry M4P33, Jan-Mar 2020, formalised in Lean.

Copyright (c) 2020 Kevin Buzzard
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Alexander Uhlmann, and whoever else in the class
wants to join in.

Thoughts about how much of the 𝕍 and 𝕀 theory
goes through abstractly.

Note: I think that this file is now pretty much done.
-/

-- This is set theory. But we want to do some type theory as well.
-- Types are a convenient way of gathering mathematical objects
-- into well-defined collections, such as rings.
import data.type.basic

-- We want to prove that the images of 𝕍 and 𝕀 are in natural
-- bijection with each other so we need the general theory
-- of bijections
import data.equiv.basic

-- the lattice structure on subsets (infinite unions etc)
import data.set.lattice

universes u v -- set theorists can set these both to be 0.
              -- (R : Type 0) means "let R be a set".

-- Let R be a set.
-- For example R could be the ring `k[X₁,…,Xₙ]`
variables (R : Type u)
-- When we're talking about 𝕍 and 𝕀, we will not mention R as part
-- of the notation even though it is playing a role
{R}

-- Let 𝔸ⁿ be another set.
variables (A : Type v)
-- Similarly we will not explicitly mention A most of the time
{A}

-- Let `P` be a way of getting a true/false statement from a pair of
-- elements f ∈ R and x ∈ 𝔸ⁿ. For example P(f,x) can be
-- the statement that `f(x) = 0`. You can think of `P` as being a subset
-- of R × 𝔸ⁿ if you like.
variable (P : R → A → Prop)
include P

-- Let 𝕍, a function from subsets of R to subsets of
-- 𝔸ⁿ, and 𝕀, a function from subsets of 𝔸ⁿ
-- to subsets of R, be defined in the usual way.
-- One can think of 𝕍(S) as being the largest U such that S × U ⊆ P,
-- and 𝕀(U) as being the largest S such that S × U ⊆ P.

-- The main theorem we will prove today is

-- *Theorem* For all S ⊆ R, 𝕍(𝕀(𝕍(S)))=𝕍(S),
-- assuming some irrelevant extra hypotheses, such as the assumption
-- that k is algebraically closed, or S is an ideal.

def 𝕍_ (S : set R) : set A :=
{x : A | ∀ f ∈ S, P f x}
notation `𝕍`:max := 𝕍_ (by exact P)

-- Type of 𝕍_ is Π {R : Type*} {A : Type*}, (R → A → Prop) → set R → set A
-- i.e. (R → A → Prop) → (R → Prop) → (A → Prop)

def 𝕀_ (X : set A) : set R :=
{f : R | ∀ x ∈ X, P f x}
notation `𝕀`:max := 𝕀_ (by exact P)

-- restate definitions
lemma mem_𝕍_iff (S : set R) (x : A) : x ∈ 𝕍 S ↔ ∀ f ∈ S, P f x := iff.rfl
lemma mem_𝕀_iff (V : set A) (f : R) : f ∈ 𝕀 V ↔ ∀ x ∈ V, P f x := iff.rfl

-- we're going to be doing set theory
open set

/-- 𝕍(∅) is everything. -/
lemma 𝕍_empty : 𝕍 ∅ = univ :=
begin
  -- It suffices to show that every x of type A is in 𝕍 ∅
  rw eq_univ_iff_forall,
  -- so let x be in A
  intro x,
  -- we need to show that every f in the empty set satisfies (f,x) ∈ P
  rw mem_𝕍_iff,
  -- so say f is in the empty set
  intros f hf,
  -- but there are no elements in the empty set so we must be done
  cases hf,
end

/-- 𝕀(∅) is everything -/
lemma 𝕀_empty : 𝕀 ∅ = univ :=
-- computer science proof
eq_univ_iff_forall.2 $ λ x f, by rintro ⟨⟩

-- 𝕍 is inclusion-reversing
lemma 𝕍_antimono (S T : set R) (h : S ⊆ T) : 𝕍 T ⊆ 𝕍 S :=
begin
  -- say x ∈ 𝕍(T)
  intros x hx,
  -- and s in S,
  intros s hs,
  -- We want to show P(s,x) is true, or (s,x) ∈ P or s(x) = 0 or however
  -- you think about it.
  -- Because x ∈ 𝕍(T), we know P(t,x) is true for all t ∈ T,
  -- so it suffices to prove s ∈ T
  apply hx,
  -- But S ⊆ T
  apply h,
  -- and s ∈ S so we're done
  exact hs
end

-- Here is how a computer scientist would write this proof:
lemma 𝕍_antimono' (S T : set R) (h : S ⊆ T) : 𝕍 T ⊆ 𝕍 S :=
λ x hx s hs, hx _ (h hs)

-- The advantage of writing it this way is that it also proves the converse!
lemma 𝕀_antimono (U V : set A) (h : U ⊆ V) : 𝕀 V ⊆ 𝕀 U :=
λ x hx s hs, hx _ (h hs)

-- Exercise: prove 𝕀_antimono the way a mathematician would, using only
-- intros, apply and exact. Need help? Try the natural number game.

-- Thanks to Alexander Uhlmann for spotting definition 3.1 here:
-- https://ncatlab.org/nlab/show/Galois+connection#GaloisTheory
lemma is_galois_connection {Y : set A} {J : set R} :
Y ⊆ 𝕍 J ↔ 𝕀 Y ⊇ J :=
begin
  split,
  { intros hY f hf,
    rw mem_𝕀_iff,
    intros x hx,
    exact hY hx f hf,
  },
  { intros hJ x hx f hf,
    exact hJ hf x hx,
  }
end

lemma 𝕍_union (S T : set R) : 𝕍 (S ∪ T) = 𝕍 S ∩ 𝕍 T :=
begin
  -- we prove both inclusions
  apply set.subset.antisymm,
  { -- say x ∈ 𝕍(S ∪ T)
    intros x hx,
    -- we need to prove x ∈ 𝕍 S and x ∈ 𝕍 T
    split,
    -- both of these follow easily from 𝕍_antimono
    -- exact 𝕍_antimono _ _ _ _ hx, -- TODO(kmb)
        -- why is the wrong underscore marked in red??
      exact 𝕍_antimono _ _ _ (subset_union_left _ _) hx,
      exact 𝕍_antimono _ _ _ (subset_union_right _ _) hx,
  },
  { -- say x ∈ 𝕍(S) ∩ 𝕍(T)
    rintros x ⟨hxS, hxT⟩,
    -- we need to prove that for all f ∈ S ∪ T, f(x) = 0
    intros f hf,
    -- well f is either in S or T (or both)
    cases hf,
    { -- and if f ∈ S then we're done because x ∈ 𝕍(S)
      exact hxS _ hf
    },
    { -- whereas if f ∈ T then we're done because x ∈ 𝕍(T)
      exact hxT _ hf
    }
  }
end

-- We prove this one in a slightly different way.
lemma 𝕀_union (W X : set A) : 𝕀 (W ∪ X) = 𝕀 W ∩ 𝕀 X :=
begin
  -- By extensionality, two sets are equal iff they have the same elements
  ext x,
  -- To be in the intersection of two sets just means being in both of them
  show _ ↔ x ∈ 𝕀 W ∧ x ∈ 𝕀 X,
  -- By the definition of 𝕀,...
  rw [mem_𝕀_iff, mem_𝕀_iff, mem_𝕀_iff],
  --- we have to prove that
  -- W ∪ X ⊆ {f : f(x) = 0} iff W ⊆ {f : f(x) = 0} and X ⊆ {f : f(x) = 0}
  show W ∪ X ⊆ _ ↔ W ⊆ _ ∧ X ⊆ _, -- the underscore just means "guess the set"
  -- We prove the iff by proving both directions separately
  split,
  { -- Here we prove W ∪ X ⊆ Z → W ⊆ Z ∧ X ⊆ Z
    intro hWX,
    split,
      refine set.subset.trans _ hWX, apply subset_union_left,
    refine set.subset.trans _ hWX, apply subset_union_right,
  },
  { -- and here we prove W ⊆ Z ∧ X ⊆ Z → W ∪ X ⊆ Z
    rintros ⟨hW, hX⟩, apply union_subset; assumption
  }
end

lemma 𝕍_Union (ι : Type*) (S : ι → set R) : 𝕍 (⋃ i, S i) = ⋂ i, 𝕍 (S i) :=
begin
  -- two sets are equal iff they have the same elements
  ext x,
  -- To be in the intersection of a bunch of sets just means
  -- being in all of them
  rw mem_Inter,
  -- By the definition of 𝕍,
  rw [mem_𝕍_iff],
  show (∀ (f : R), (f ∈ ⋃ (i : ι), S i) → P f x) ↔ ∀ (i : ι), ∀ f ∈ S i, P f x,
  -- Now prove both inclusions separately
  split,
    intros,
    apply a,
    rw mem_Union,
    use i,
    assumption,
  intros h f hf,
  rw mem_Union at hf,
  cases hf with i hi,
  apply h i,
  assumption,
end

-- an AI can find a proof of this too:
lemma 𝕀_Union (ι : Type*) (J : ι → set A) : 𝕀 (⋃ i, J i) = ⋂ i, 𝕀 (J i) :=
begin
  ext,
  simp [𝕀_],
  tauto,
end

lemma 𝕍𝕀_mono (U V : set A) (h : U ⊆ V) : 𝕍 (𝕀 U) ⊆ 𝕍 (𝕀 V) :=
begin
  -- 𝕍 is anti-monotonic
  apply 𝕍_antimono,
  -- and 𝕀 is too
  apply 𝕀_antimono,
  -- so we just have to prove U ⊆ V, which is an assumption
  exact h
end

-- computer science proof of the other direction
lemma 𝕀𝕍_mono (S T : set R) (h : S ⊆ T) : 𝕀 (𝕍 S) ⊆ 𝕀 (𝕍 T) :=
𝕀_antimono P _ _ (𝕍_antimono P _ _ h)

-- During the lecture today (17/01/20), it was pointed out that 𝕍(S) was the
-- largest U such that S × U was a subset of P, and 𝕀(U) was the largest S
-- such that S × U was a subset of P. This geometric way of thinking
-- about things makes the next lemma trivial. Can you understand the Lean proof?

/-- U ⊆ 𝕍(𝕀(U)) -/
lemma sub_𝕍𝕀 (U : set A) : U ⊆ 𝕍 (𝕀 U) :=
begin
  intros x hx,
  rw mem_𝕍_iff,
  intros f hf,
  rw mem_𝕀_iff at hf,
  apply hf,
  exact hx,
end

-- Because the proofs of sub_𝕍𝕀 and sub_𝕀𝕍 are basically
-- the same, it might come as no surprise to see that you
-- can prove one of them using the other one! The trick is
-- to make sure you allow quantification over all R and A
-- so you can switch them around.

/-- S ⊆ 𝕀(𝕍(S)) -/
lemma sub_𝕀𝕍 (S : set R) : S ⊆ 𝕀 (𝕍 S) :=
sub_𝕍𝕀 _ _

-- the big theorem
lemma 𝕍𝕀𝕍_eq_𝕍 (S : set R) : 𝕍 (𝕀 (𝕍 S)) = 𝕍 S :=
begin
  apply set.subset.antisymm,
  { apply 𝕍_antimono,
    apply sub_𝕀𝕍
  },
  { apply sub_𝕍𝕀,
  }
end

-- the same theorem again (permute R and A)
lemma 𝕀𝕍𝕀_eq_𝕀 (V : set A) : (𝕀 (𝕍 (𝕀 V))) = 𝕀 V :=
𝕍𝕀𝕍_eq_𝕍 _ V -- same proof but with a different P

open set

-- this final proof is written in a very computer-science way
/-- The images of 𝕍 and of 𝕀 are naturally in bijection -/
lemma not_the_nullstellensatz : {V // ∃ J, 𝕍 J = V} ≃ {I // ∃ V, 𝕀 V = I} :=
{ to_fun := λ V, ⟨𝕀 (V.1), V, rfl⟩,
  inv_fun := λ I, ⟨𝕍 I.1, I, rfl⟩,
  left_inv := begin
    rintro ⟨V, J, hJ⟩,
    rw subtype.ext,
    change 𝕍 (𝕀 V) = V,
    rw ←hJ,
    refine 𝕍𝕀𝕍_eq_𝕍 _ _,
  end,
  right_inv := begin
    rintro ⟨J, V, hV⟩,
    rw subtype.ext,
    change 𝕀 (𝕍 J) = J,
    rw ←hV,
    refine 𝕀𝕍𝕀_eq_𝕀 _ _,
  end
}

-- The Nullstellensatz says that the image of 𝕀 is precisely the
-- radical ideals. One inclusion is clear (which?)


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import analysis.normed_space.affine_isometry
import analysis.normed_space.operator_norm
import analysis.asymptotics.asymptotic_equivalent
import linear_algebra.matrix.to_lin
import topology.algebra.matrix

/-!
# Finite dimensional normed spaces over complete fields

Over a complete nondiscrete field, in finite dimension, all norms are equivalent and all linear maps
are continuous. Moreover, a finite-dimensional subspace is always complete and closed.

## Main results:

* `linear_map.continuous_of_finite_dimensional` : a linear map on a finite-dimensional space over a
  complete field is continuous.
* `finite_dimensional.complete` : a finite-dimensional space over a complete field is complete. This
  is not registered as an instance, as the field would be an unknown metavariable in typeclass
  resolution.
* `submodule.closed_of_finite_dimensional` : a finite-dimensional subspace over a complete field is
  closed
* `finite_dimensional.proper` : a finite-dimensional space over a proper field is proper. This
  is not registered as an instance, as the field would be an unknown metavariable in typeclass
  resolution. It is however registered as an instance for `𝕜 = ℝ` and `𝕜 = ℂ`. As properness
  implies completeness, there is no need to also register `finite_dimensional.complete` on `ℝ` or
  `ℂ`.
* `finite_dimensional_of_is_compact_closed_ball`: Riesz' theorem: if the closed unit ball is
  compact, then the space is finite-dimensional.

## Implementation notes

The fact that all norms are equivalent is not written explicitly, as it would mean having two norms
on a single space, which is not the way type classes work. However, if one has a
finite-dimensional vector space `E` with a norm, and a copy `E'` of this type with another norm,
then the identities from `E` to `E'` and from `E'`to `E` are continuous thanks to
`linear_map.continuous_of_finite_dimensional`. This gives the desired norm equivalence.
-/

universes u v w x

noncomputable theory

open set finite_dimensional topological_space filter asymptotics
open_locale classical big_operators filter topological_space asymptotics nnreal

namespace linear_isometry

open linear_map

variables {R : Type*} [semiring R]

variables {F E₁ : Type*} [semi_normed_group F]
  [normed_group E₁] [module R E₁]

variables {R₁ : Type*} [field R₁] [module R₁ E₁] [module R₁ F]
  [finite_dimensional R₁ E₁] [finite_dimensional R₁ F]

/-- A linear isometry between finite dimensional spaces of equal dimension can be upgraded
    to a linear isometry equivalence. -/
def to_linear_isometry_equiv
  (li : E₁ →ₗᵢ[R₁] F) (h : finrank R₁ E₁ = finrank R₁ F) : E₁ ≃ₗᵢ[R₁] F :=
{ to_linear_equiv :=
    li.to_linear_map.linear_equiv_of_injective li.injective h,
  norm_map' := li.norm_map' }

@[simp] lemma coe_to_linear_isometry_equiv
  (li : E₁ →ₗᵢ[R₁] F) (h : finrank R₁ E₁ = finrank R₁ F) :
  (li.to_linear_isometry_equiv h : E₁ → F) = li := rfl

@[simp] lemma to_linear_isometry_equiv_apply
  (li : E₁ →ₗᵢ[R₁] F) (h : finrank R₁ E₁ = finrank R₁ F) (x : E₁) :
  (li.to_linear_isometry_equiv h) x = li x := rfl

end linear_isometry

namespace affine_isometry

open affine_map

variables {𝕜 : Type*} {V₁ V₂  : Type*} {P₁ P₂ : Type*}
  [normed_field 𝕜]
  [normed_group V₁] [semi_normed_group V₂]
  [normed_space 𝕜 V₁] [normed_space 𝕜 V₂]
  [metric_space P₁] [pseudo_metric_space P₂]
  [normed_add_torsor V₁ P₁] [normed_add_torsor V₂ P₂]

variables [finite_dimensional 𝕜 V₁] [finite_dimensional 𝕜 V₂]

/-- An affine isometry between finite dimensional spaces of equal dimension can be upgraded
    to an affine isometry equivalence. -/
def to_affine_isometry_equiv [inhabited P₁]
  (li : P₁ →ᵃⁱ[𝕜] P₂) (h : finrank 𝕜 V₁ = finrank 𝕜 V₂) : P₁ ≃ᵃⁱ[𝕜] P₂ :=
affine_isometry_equiv.mk' li (li.linear_isometry.to_linear_isometry_equiv h) (arbitrary P₁)
  (λ p, by simp)

@[simp] lemma coe_to_affine_isometry_equiv [inhabited P₁]
  (li : P₁ →ᵃⁱ[𝕜] P₂) (h : finrank 𝕜 V₁ = finrank 𝕜 V₂) :
  (li.to_affine_isometry_equiv h : P₁ → P₂) = li := rfl

@[simp] lemma to_affine_isometry_equiv_apply [inhabited P₁]
  (li : P₁ →ᵃⁱ[𝕜] P₂) (h : finrank 𝕜 V₁ = finrank 𝕜 V₂) (x : P₁) :
  (li.to_affine_isometry_equiv h) x = li x := rfl

end affine_isometry

/-- A linear map on `ι → 𝕜` (where `ι` is a fintype) is continuous -/
lemma linear_map.continuous_on_pi {ι : Type w} [fintype ι] {𝕜 : Type u} [normed_field 𝕜]
  {E : Type v}  [add_comm_group E] [module 𝕜 E] [topological_space E]
  [topological_add_group E] [has_continuous_smul 𝕜 E] (f : (ι → 𝕜) →ₗ[𝕜] E) : continuous f :=
begin
  -- for the proof, write `f` in the standard basis, and use that each coordinate is a continuous
  -- function.
  have : (f : (ι → 𝕜) → E) =
         (λx, ∑ i : ι, x i • (f (λj, if i = j then 1 else 0))),
    by { ext x, exact f.pi_apply_eq_sum_univ x },
  rw this,
  refine continuous_finset_sum _ (λi hi, _),
  exact (continuous_apply i).smul continuous_const
end

/-- The space of continuous linear maps between finite-dimensional spaces is finite-dimensional. -/
instance {𝕜 E F : Type*} [field 𝕜] [topological_space 𝕜]
  [topological_space E] [add_comm_group E] [module 𝕜 E] [finite_dimensional 𝕜 E]
  [topological_space F] [add_comm_group F] [module 𝕜 F] [topological_add_group F]
  [has_continuous_smul 𝕜 F] [finite_dimensional 𝕜 F] :
  finite_dimensional 𝕜 (E →L[𝕜] F) :=
begin
  haveI : is_noetherian 𝕜 (E →ₗ[𝕜] F) := is_noetherian.iff_fg.mpr (by apply_instance),
  let I : (E →L[𝕜] F) →ₗ[𝕜] (E →ₗ[𝕜] F) := continuous_linear_map.coe_lm 𝕜,
  exact module.finite.of_injective I continuous_linear_map.coe_injective
end

section complete_field

variables {𝕜 : Type u} [nondiscrete_normed_field 𝕜]
{E : Type v} [normed_group E] [normed_space 𝕜 E]
{F : Type w} [normed_group F] [normed_space 𝕜 F]
{F' : Type x} [add_comm_group F'] [module 𝕜 F'] [topological_space F']
[topological_add_group F'] [has_continuous_smul 𝕜 F']
[complete_space 𝕜]

/-- In finite dimension over a complete field, the canonical identification (in terms of a basis)
with `𝕜^n` together with its sup norm is continuous. This is the nontrivial part in the fact that
all norms are equivalent in finite dimension.

This statement is superceded by the fact that every linear map on a finite-dimensional space is
continuous, in `linear_map.continuous_of_finite_dimensional`. -/
lemma continuous_equiv_fun_basis {ι : Type v} [fintype ι] (ξ : basis ι 𝕜 E) :
  continuous ξ.equiv_fun :=
begin
  unfreezingI { induction hn : fintype.card ι with n IH generalizing ι E },
  { apply ξ.equiv_fun.to_linear_map.continuous_of_bound 0 (λx, _),
    have : ξ.equiv_fun x = 0,
      by { ext i, exact (fintype.card_eq_zero_iff.1 hn).elim i },
    change ∥ξ.equiv_fun x∥ ≤ 0 * ∥x∥,
    rw this,
    simp [norm_nonneg] },
  { haveI : finite_dimensional 𝕜 E := of_fintype_basis ξ,
    -- first step: thanks to the inductive assumption, any n-dimensional subspace is equivalent
    -- to a standard space of dimension n, hence it is complete and therefore closed.
    have H₁ : ∀s : submodule 𝕜 E, finrank 𝕜 s = n → is_closed (s : set E),
    { assume s s_dim,
      let b := basis.of_vector_space 𝕜 s,
      have U : uniform_embedding b.equiv_fun.symm.to_equiv,
      { have : fintype.card (basis.of_vector_space_index 𝕜 s) = n,
          by { rw ← s_dim, exact (finrank_eq_card_basis b).symm },
        have : continuous b.equiv_fun := IH b this,
        exact b.equiv_fun.symm.uniform_embedding b.equiv_fun.symm.to_linear_map.continuous_on_pi
          this },
      have : is_complete (s : set E),
        from complete_space_coe_iff_is_complete.1 ((complete_space_congr U).1 (by apply_instance)),
      exact this.is_closed },
    -- second step: any linear form is continuous, as its kernel is closed by the first step
    have H₂ : ∀f : E →ₗ[𝕜] 𝕜, continuous f,
    { assume f,
      have : finrank 𝕜 f.ker = n ∨ finrank 𝕜 f.ker = n.succ,
      { have Z := f.finrank_range_add_finrank_ker,
        rw [finrank_eq_card_basis ξ, hn] at Z,
        by_cases H : finrank 𝕜 f.range = 0,
        { right,
          rw H at Z,
          simpa using Z },
        { left,
          have : finrank 𝕜 f.range = 1,
          { refine le_antisymm _ (zero_lt_iff.mpr H),
            simpa [finrank_self] using f.range.finrank_le },
          rw [this, add_comm, nat.add_one] at Z,
          exact nat.succ.inj Z } },
      have : is_closed (f.ker : set E),
      { cases this,
        { exact H₁ _ this },
        { have : f.ker = ⊤,
            by { apply eq_top_of_finrank_eq, rw [finrank_eq_card_basis ξ, hn, this] },
          simp [this] } },
      exact linear_map.continuous_iff_is_closed_ker.2 this },
    -- third step: applying the continuity to the linear form corresponding to a coefficient in the
    -- basis decomposition, deduce that all such coefficients are controlled in terms of the norm
    have : ∀i:ι, ∃C, 0 ≤ C ∧ ∀(x:E), ∥ξ.equiv_fun x i∥ ≤ C * ∥x∥,
    { assume i,
      let f : E →ₗ[𝕜] 𝕜 := (linear_map.proj i) ∘ₗ ↑ξ.equiv_fun,
      let f' : E →L[𝕜] 𝕜 := { cont := H₂ f, ..f },
      exact ⟨∥f'∥, norm_nonneg _, λx, continuous_linear_map.le_op_norm f' x⟩ },
    -- fourth step: combine the bound on each coefficient to get a global bound and the continuity
    choose C0 hC0 using this,
    let C := ∑ i, C0 i,
    have C_nonneg : 0 ≤ C := finset.sum_nonneg (λi hi, (hC0 i).1),
    have C0_le : ∀i, C0 i ≤ C :=
      λi, finset.single_le_sum (λj hj, (hC0 j).1) (finset.mem_univ _),
    apply ξ.equiv_fun.to_linear_map.continuous_of_bound C (λx, _),
    rw pi_norm_le_iff,
    { exact λi, le_trans ((hC0 i).2 x) (mul_le_mul_of_nonneg_right (C0_le i) (norm_nonneg _)) },
    { exact mul_nonneg C_nonneg (norm_nonneg _) } }
end

/-- Any linear map on a finite dimensional space over a complete field is continuous. -/
theorem linear_map.continuous_of_finite_dimensional [finite_dimensional 𝕜 E] (f : E →ₗ[𝕜] F') :
  continuous f :=
begin
  -- for the proof, go to a model vector space `b → 𝕜` thanks to `continuous_equiv_fun_basis`, and
  -- argue that all linear maps there are continuous.
  let b := basis.of_vector_space 𝕜 E,
  have A : continuous b.equiv_fun :=
    continuous_equiv_fun_basis b,
  have B : continuous (f.comp (b.equiv_fun.symm : (basis.of_vector_space_index 𝕜 E → 𝕜) →ₗ[𝕜] E)) :=
    linear_map.continuous_on_pi _,
  have : continuous ((f.comp (b.equiv_fun.symm : (basis.of_vector_space_index 𝕜 E → 𝕜) →ₗ[𝕜] E))
                      ∘ b.equiv_fun) := B.comp A,
  convert this,
  ext x,
  dsimp,
  rw [basis.equiv_fun_symm_apply, basis.sum_repr]
end

theorem affine_map.continuous_of_finite_dimensional {PE PF : Type*}
  [metric_space PE] [normed_add_torsor E PE] [metric_space PF] [normed_add_torsor F PF]
  [finite_dimensional 𝕜 E] (f : PE →ᵃ[𝕜] PF) : continuous f :=
affine_map.continuous_linear_iff.1 f.linear.continuous_of_finite_dimensional

lemma continuous_linear_map.continuous_det :
  continuous (λ (f : E →L[𝕜] E), f.det) :=
begin
  change continuous (λ (f : E →L[𝕜] E), (f : E →ₗ[𝕜] E).det),
  classical,
  by_cases h : ∃ (s : finset E), nonempty (basis ↥s 𝕜 E),
  { rcases h with ⟨s, ⟨b⟩⟩,
    haveI : finite_dimensional 𝕜 E := finite_dimensional.of_finset_basis b,
    letI : normed_group (matrix s s 𝕜) := matrix.normed_group,
    letI : normed_space 𝕜 (matrix s s 𝕜) := matrix.normed_space,
    simp_rw linear_map.det_eq_det_to_matrix_of_finset b,
    have A : continuous (λ (f : E →L[𝕜] E), linear_map.to_matrix b b f),
    { change continuous ((linear_map.to_matrix b b).to_linear_map.comp
        (continuous_linear_map.coe_lm 𝕜)),
      exact linear_map.continuous_of_finite_dimensional _ },
    convert continuous_det.comp A,
    ext f,
    congr },
  { unfold linear_map.det,
    simpa only [h, monoid_hom.one_apply, dif_neg, not_false_iff] using continuous_const }
end

namespace linear_map

variables [finite_dimensional 𝕜 E]

/-- The continuous linear map induced by a linear map on a finite dimensional space -/
def to_continuous_linear_map : (E →ₗ[𝕜] F') ≃ₗ[𝕜] E →L[𝕜] F' :=
{ to_fun := λ f, ⟨f, f.continuous_of_finite_dimensional⟩,
  inv_fun := coe,
  map_add' := λ f g, rfl,
  map_smul' := λ c f, rfl,
  left_inv := λ f, rfl,
  right_inv := λ f, continuous_linear_map.coe_injective rfl }

@[simp] lemma coe_to_continuous_linear_map' (f : E →ₗ[𝕜] F') :
  ⇑f.to_continuous_linear_map = f := rfl

@[simp] lemma coe_to_continuous_linear_map (f : E →ₗ[𝕜] F') :
  (f.to_continuous_linear_map : E →ₗ[𝕜] F') = f := rfl

@[simp] lemma coe_to_continuous_linear_map_symm :
  ⇑(to_continuous_linear_map : (E →ₗ[𝕜] F') ≃ₗ[𝕜] E →L[𝕜] F').symm = coe := rfl

end linear_map

namespace linear_equiv

variables [finite_dimensional 𝕜 E]

/-- The continuous linear equivalence induced by a linear equivalence on a finite dimensional
space. -/
def to_continuous_linear_equiv (e : E ≃ₗ[𝕜] F) : E ≃L[𝕜] F :=
{ continuous_to_fun := e.to_linear_map.continuous_of_finite_dimensional,
  continuous_inv_fun := begin
    haveI : finite_dimensional 𝕜 F := e.finite_dimensional,
    exact e.symm.to_linear_map.continuous_of_finite_dimensional
  end,
  ..e }

@[simp] lemma coe_to_continuous_linear_equiv (e : E ≃ₗ[𝕜] F) :
  (e.to_continuous_linear_equiv : E →ₗ[𝕜] F) = e := rfl

@[simp] lemma coe_to_continuous_linear_equiv' (e : E ≃ₗ[𝕜] F) :
  (e.to_continuous_linear_equiv : E → F) = e := rfl

@[simp] lemma coe_to_continuous_linear_equiv_symm (e : E ≃ₗ[𝕜] F) :
  (e.to_continuous_linear_equiv.symm : F →ₗ[𝕜] E) = e.symm := rfl

@[simp] lemma coe_to_continuous_linear_equiv_symm' (e : E ≃ₗ[𝕜] F) :
  (e.to_continuous_linear_equiv.symm : F → E) = e.symm := rfl

@[simp] lemma to_linear_equiv_to_continuous_linear_equiv (e : E ≃ₗ[𝕜] F) :
  e.to_continuous_linear_equiv.to_linear_equiv = e :=
by { ext x, refl }

@[simp] lemma to_linear_equiv_to_continuous_linear_equiv_symm (e : E ≃ₗ[𝕜] F) :
  e.to_continuous_linear_equiv.symm.to_linear_equiv = e.symm :=
by { ext x, refl }

end linear_equiv

/-- Any `K`-Lipschitz map from a subset `s` of a metric space `α` to a finite-dimensional real
vector space `E'` can be extended to a Lipschitz map on the whole space `α`, with a slightly worse
constant `C * K` where `C` only depends on `E'`. We record a working value for this constant `C`
as `lipschitz_extension_constant E'`. -/
@[irreducible] def lipschitz_extension_constant
  (E' : Type*) [normed_group E'] [normed_space ℝ E'] [finite_dimensional ℝ E'] : ℝ≥0 :=
let A := (basis.of_vector_space ℝ E').equiv_fun.to_continuous_linear_equiv in
  max (∥A.symm.to_continuous_linear_map∥₊ * ∥A.to_continuous_linear_map∥₊) 1

lemma lipschitz_extension_constant_pos
  (E' : Type*) [normed_group E'] [normed_space ℝ E'] [finite_dimensional ℝ E'] :
  0 < lipschitz_extension_constant E' :=
by { rw lipschitz_extension_constant, exact zero_lt_one.trans_le (le_max_right _ _) }

/-- Any `K`-Lipschitz map from a subset `s` of a metric space `α` to a finite-dimensional real
vector space `E'` can be extended to a Lipschitz map on the whole space `α`, with a slightly worse
constant `lipschitz_extension_constant E' * K`. -/
theorem lipschitz_on_with.extend_finite_dimension
  {α : Type*} [pseudo_metric_space α]
  {E' : Type*} [normed_group E'] [normed_space ℝ E'] [finite_dimensional ℝ E']
  {s : set α} {f : α → E'} {K : ℝ≥0} (hf : lipschitz_on_with K f s) :
  ∃ (g : α → E'), lipschitz_with (lipschitz_extension_constant E' * K) g ∧ eq_on f g s :=
begin
  /- This result is already known for spaces `ι → ℝ`. We use a continuous linear equiv between
  `E'` and such a space to transfer the result to `E'`. -/
  let ι : Type* := basis.of_vector_space_index ℝ E',
  let A := (basis.of_vector_space ℝ E').equiv_fun.to_continuous_linear_equiv,
  have LA : lipschitz_with (∥A.to_continuous_linear_map∥₊) A, by apply A.lipschitz,
  have L : lipschitz_on_with (∥A.to_continuous_linear_map∥₊ * K) (A ∘ f) s :=
    LA.comp_lipschitz_on_with hf,
  obtain ⟨g, hg, gs⟩ : ∃ g : α → (ι → ℝ), lipschitz_with (∥A.to_continuous_linear_map∥₊ * K) g ∧
    eq_on (A ∘ f) g s := L.extend_pi,
  refine ⟨A.symm ∘ g, _, _⟩,
  { have LAsymm : lipschitz_with (∥A.symm.to_continuous_linear_map∥₊) A.symm,
      by apply A.symm.lipschitz,
    apply (LAsymm.comp hg).weaken,
    rw [lipschitz_extension_constant, ← mul_assoc],
    refine mul_le_mul' (le_max_left _ _) le_rfl },
  { assume x hx,
    have : A (f x) = g x := gs hx,
    simp only [(∘), ← this, A.symm_apply_apply] }
end

lemma linear_map.exists_antilipschitz_with [finite_dimensional 𝕜 E] (f : E →ₗ[𝕜] F)
  (hf : f.ker = ⊥) : ∃ K > 0, antilipschitz_with K f :=
begin
  cases subsingleton_or_nontrivial E; resetI,
  { exact ⟨1, zero_lt_one, antilipschitz_with.of_subsingleton⟩ },
  { rw linear_map.ker_eq_bot at hf,
    let e : E ≃L[𝕜] f.range := (linear_equiv.of_injective f hf).to_continuous_linear_equiv,
    exact ⟨_, e.nnnorm_symm_pos, e.antilipschitz⟩ }
end

protected lemma linear_independent.eventually {ι} [fintype ι] {f : ι → E}
  (hf : linear_independent 𝕜 f) : ∀ᶠ g in 𝓝 f, linear_independent 𝕜 g :=
begin
  simp only [fintype.linear_independent_iff'] at hf ⊢,
  rcases linear_map.exists_antilipschitz_with _ hf with ⟨K, K0, hK⟩,
  have : tendsto (λ g : ι → E, ∑ i, ∥g i - f i∥) (𝓝 f) (𝓝 $ ∑ i, ∥f i - f i∥),
    from tendsto_finset_sum _ (λ i hi, tendsto.norm $
      ((continuous_apply i).tendsto _).sub tendsto_const_nhds),
  simp only [sub_self, norm_zero, finset.sum_const_zero] at this,
  refine (this.eventually (gt_mem_nhds $ inv_pos.2 K0)).mono (λ g hg, _),
  replace hg : ∑ i, nnnorm (g i - f i) < K⁻¹, by { rw ← nnreal.coe_lt_coe, push_cast, exact hg },
  rw linear_map.ker_eq_bot,
  refine (hK.add_sub_lipschitz_with (lipschitz_with.of_dist_le_mul $ λ v u, _) hg).injective,
  simp only [dist_eq_norm, linear_map.lsum_apply, pi.sub_apply, linear_map.sum_apply,
    linear_map.comp_apply, linear_map.proj_apply, linear_map.smul_right_apply, linear_map.id_apply,
    ← finset.sum_sub_distrib, ← smul_sub, ← sub_smul, nnreal.coe_sum, coe_nnnorm, finset.sum_mul],
  refine norm_sum_le_of_le _ (λ i _, _),
  rw [norm_smul, mul_comm],
  exact mul_le_mul_of_nonneg_left (norm_le_pi_norm (v - u) i) (norm_nonneg _)
end

lemma is_open_set_of_linear_independent {ι : Type*} [fintype ι] :
  is_open {f : ι → E | linear_independent 𝕜 f} :=
is_open_iff_mem_nhds.2 $ λ f, linear_independent.eventually

lemma is_open_set_of_nat_le_rank (n : ℕ) : is_open {f : E →L[𝕜] F | ↑n ≤ rank (f : E →ₗ[𝕜] F)} :=
begin
  simp only [le_rank_iff_exists_linear_independent_finset, set_of_exists, ← exists_prop],
  refine is_open_bUnion (λ t ht, _),
  have : continuous (λ f : E →L[𝕜] F, (λ x : (t : set E), f x)),
    from continuous_pi (λ x, (continuous_linear_map.apply 𝕜 F (x : E)).continuous),
  exact is_open_set_of_linear_independent.preimage this
end

/-- Two finite-dimensional normed spaces are continuously linearly equivalent if they have the same
(finite) dimension. -/
theorem finite_dimensional.nonempty_continuous_linear_equiv_of_finrank_eq
  [finite_dimensional 𝕜 E] [finite_dimensional 𝕜 F] (cond : finrank 𝕜 E = finrank 𝕜 F) :
  nonempty (E ≃L[𝕜] F) :=
(nonempty_linear_equiv_of_finrank_eq cond).map linear_equiv.to_continuous_linear_equiv

/-- Two finite-dimensional normed spaces are continuously linearly equivalent if and only if they
have the same (finite) dimension. -/
theorem finite_dimensional.nonempty_continuous_linear_equiv_iff_finrank_eq
  [finite_dimensional 𝕜 E] [finite_dimensional 𝕜 F] :
   nonempty (E ≃L[𝕜] F) ↔ finrank 𝕜 E = finrank 𝕜 F :=
⟨ λ ⟨h⟩, h.to_linear_equiv.finrank_eq,
  λ h, finite_dimensional.nonempty_continuous_linear_equiv_of_finrank_eq h ⟩

/-- A continuous linear equivalence between two finite-dimensional normed spaces of the same
(finite) dimension. -/
def continuous_linear_equiv.of_finrank_eq [finite_dimensional 𝕜 E] [finite_dimensional 𝕜 F]
  (cond : finrank 𝕜 E = finrank 𝕜 F) :
  E ≃L[𝕜] F :=
(linear_equiv.of_finrank_eq E F cond).to_continuous_linear_equiv

variables {ι : Type*} [fintype ι]

/-- Construct a continuous linear map given the value at a finite basis. -/
def basis.constrL (v : basis ι 𝕜 E) (f : ι → F) :
  E →L[𝕜] F :=
by haveI : finite_dimensional 𝕜 E := finite_dimensional.of_fintype_basis v;
  exact (v.constr 𝕜 f).to_continuous_linear_map

@[simp, norm_cast] lemma basis.coe_constrL (v : basis ι 𝕜 E) (f : ι → F) :
  (v.constrL f : E →ₗ[𝕜] F) = v.constr 𝕜 f := rfl

/-- The continuous linear equivalence between a vector space over `𝕜` with a finite basis and
functions from its basis indexing type to `𝕜`. -/
def basis.equiv_funL (v : basis ι 𝕜 E) : E ≃L[𝕜] (ι → 𝕜) :=
{ continuous_to_fun := begin
    haveI : finite_dimensional 𝕜 E := finite_dimensional.of_fintype_basis v,
    exact v.equiv_fun.to_linear_map.continuous_of_finite_dimensional,
  end,
  continuous_inv_fun := begin
    change continuous v.equiv_fun.symm.to_fun,
    exact v.equiv_fun.symm.to_linear_map.continuous_of_finite_dimensional,
  end,
  ..v.equiv_fun }

@[simp] lemma basis.constrL_apply (v : basis ι 𝕜 E) (f : ι → F) (e : E) :
  (v.constrL f) e = ∑ i, (v.equiv_fun e i) • f i :=
v.constr_apply_fintype 𝕜 _ _

@[simp] lemma basis.constrL_basis (v : basis ι 𝕜 E) (f : ι → F) (i : ι) :
  (v.constrL f) (v i) = f i :=
v.constr_basis 𝕜 _ _

lemma basis.sup_norm_le_norm (v : basis ι 𝕜 E) :
  ∃ C > (0 : ℝ), ∀ e : E, ∑ i, ∥v.equiv_fun e i∥ ≤ C * ∥e∥ :=
begin
  set φ := v.equiv_funL.to_continuous_linear_map,
  set C := ∥φ∥ * (fintype.card ι),
  use [max C 1, lt_of_lt_of_le (zero_lt_one) (le_max_right C 1)],
  intros e,
  calc ∑ i, ∥φ e i∥ ≤ ∑ i : ι, ∥φ e∥ : by { apply finset.sum_le_sum,
                                           exact λ i hi, norm_le_pi_norm (φ e) i }
  ... = ∥φ e∥*(fintype.card ι) : by simpa only [mul_comm, finset.sum_const, nsmul_eq_mul]
  ... ≤ ∥φ∥ * ∥e∥ * (fintype.card ι) : mul_le_mul_of_nonneg_right (φ.le_op_norm e)
                                                                 (fintype.card ι).cast_nonneg
  ... = ∥φ∥ * (fintype.card ι) * ∥e∥ : by ring
  ... ≤ max C 1 * ∥e∥ :  mul_le_mul_of_nonneg_right (le_max_left _ _) (norm_nonneg _)
end

lemma basis.op_norm_le  {ι : Type*} [fintype ι] (v : basis ι 𝕜 E) :
  ∃ C > (0 : ℝ), ∀ {u : E →L[𝕜] F} {M : ℝ}, 0 ≤ M → (∀ i, ∥u (v i)∥ ≤ M) → ∥u∥ ≤ C*M :=
begin
  obtain ⟨C, C_pos, hC⟩ : ∃ C > (0 : ℝ), ∀ (e : E), ∑ i, ∥v.equiv_fun e i∥ ≤ C * ∥e∥,
    from v.sup_norm_le_norm,
  use [C, C_pos],
  intros u M hM hu,
  apply u.op_norm_le_bound (mul_nonneg (le_of_lt C_pos) hM),
  intros e,
  calc
  ∥u e∥ = ∥u (∑ i, v.equiv_fun e i • v i)∥ :   by rw [v.sum_equiv_fun]
  ... = ∥∑ i, (v.equiv_fun e i) • (u $ v i)∥ : by simp [u.map_sum, linear_map.map_smul]
  ... ≤ ∑ i, ∥(v.equiv_fun e i) • (u $ v i)∥ : norm_sum_le _ _
  ... = ∑ i, ∥v.equiv_fun e i∥ * ∥u (v i)∥ :   by simp only [norm_smul]
  ... ≤ ∑ i, ∥v.equiv_fun e i∥ * M : finset.sum_le_sum (λ i hi,
                                                  mul_le_mul_of_nonneg_left (hu i) (norm_nonneg _))
  ... = (∑ i, ∥v.equiv_fun e i∥) * M : finset.sum_mul.symm
  ... ≤ C * ∥e∥ * M : mul_le_mul_of_nonneg_right (hC e) hM
  ... = C * M * ∥e∥ : by ring
end

instance [finite_dimensional 𝕜 E] [second_countable_topology F] :
  second_countable_topology (E →L[𝕜] F) :=
begin
  set d := finite_dimensional.finrank 𝕜 E,
  suffices :
    ∀ ε > (0 : ℝ), ∃ n : (E →L[𝕜] F) → fin d → ℕ, ∀ (f g : E →L[𝕜] F), n f = n g → dist f g ≤ ε,
  from metric.second_countable_of_countable_discretization
    (λ ε ε_pos, ⟨fin d → ℕ, by apply_instance, this ε ε_pos⟩),
  intros ε ε_pos,
  obtain ⟨u : ℕ → F, hu : dense_range u⟩ := exists_dense_seq F,
  let v := finite_dimensional.fin_basis 𝕜 E,
  obtain ⟨C : ℝ, C_pos : 0 < C,
          hC : ∀ {φ : E →L[𝕜] F} {M : ℝ}, 0 ≤ M → (∀ i, ∥φ (v i)∥ ≤ M) → ∥φ∥ ≤ C * M⟩ :=
    v.op_norm_le,
  have h_2C : 0 < 2*C := mul_pos zero_lt_two C_pos,
  have hε2C : 0 < ε/(2*C) := div_pos ε_pos h_2C,
  have : ∀ φ : E →L[𝕜] F, ∃ n : fin d → ℕ, ∥φ - (v.constrL $ u ∘ n)∥ ≤ ε/2,
  { intros φ,
    have : ∀ i, ∃ n, ∥φ (v i) - u n∥ ≤ ε/(2*C),
    { simp only [norm_sub_rev],
      intro i,
      have : φ (v i) ∈ closure (range u) := hu _,
      obtain ⟨n, hn⟩ : ∃ n, ∥u n - φ (v i)∥ < ε / (2 * C),
      { rw mem_closure_iff_nhds_basis metric.nhds_basis_ball at this,
        specialize this (ε/(2*C)) hε2C,
        simpa [dist_eq_norm] },
      exact ⟨n, le_of_lt hn⟩ },
    choose n hn using this,
    use n,
    replace hn : ∀ i : fin d, ∥(φ - (v.constrL $ u ∘ n)) (v i)∥ ≤ ε / (2 * C), by simp [hn],
    have : C * (ε / (2 * C)) = ε/2,
    { rw [eq_div_iff (two_ne_zero : (2 : ℝ) ≠ 0), mul_comm, ← mul_assoc,
          mul_div_cancel' _ (ne_of_gt h_2C)] },
    specialize hC (le_of_lt hε2C) hn,
    rwa this at hC },
  choose n hn using this,
  set Φ := λ φ : E →L[𝕜] F, (v.constrL $ u ∘ (n φ)),
  change ∀ z, dist z (Φ z) ≤ ε/2 at hn,
  use n,
  intros x y hxy,
  calc dist x y ≤ dist x (Φ x) + dist (Φ x) y : dist_triangle _ _ _
  ... = dist x (Φ x) + dist y (Φ y) : by simp [Φ, hxy, dist_comm]
  ... ≤ ε : by linarith [hn x, hn y]
end

/-- Any finite-dimensional vector space over a complete field is complete.
We do not register this as an instance to avoid an instance loop when trying to prove the
completeness of `𝕜`, and the search for `𝕜` as an unknown metavariable. Declare the instance
explicitly when needed. -/
variables (𝕜 E)
lemma finite_dimensional.complete [finite_dimensional 𝕜 E] : complete_space E :=
begin
  set e := continuous_linear_equiv.of_finrank_eq (@finrank_fin_fun 𝕜 _ (finrank 𝕜 E)).symm,
  have : uniform_embedding e.to_linear_equiv.to_equiv.symm := e.symm.uniform_embedding,
  exact (complete_space_congr this).1 (by apply_instance)
end

variables {𝕜 E}
/-- A finite-dimensional subspace is complete. -/
lemma submodule.complete_of_finite_dimensional (s : submodule 𝕜 E) [finite_dimensional 𝕜 s] :
  is_complete (s : set E) :=
complete_space_coe_iff_is_complete.1 (finite_dimensional.complete 𝕜 s)

/-- A finite-dimensional subspace is closed. -/
lemma submodule.closed_of_finite_dimensional (s : submodule 𝕜 E) [finite_dimensional 𝕜 s] :
  is_closed (s : set E) :=
s.complete_of_finite_dimensional.is_closed

section riesz

/-- In an infinite dimensional space, given a finite number of points, one may find a point
with norm at most `R` which is at distance at least `1` of all these points. -/
theorem exists_norm_le_le_norm_sub_of_finset {c : 𝕜} (hc : 1 < ∥c∥) {R : ℝ} (hR : ∥c∥ < R)
  (h : ¬ (finite_dimensional 𝕜 E)) (s : finset E) :
  ∃ (x : E), ∥x∥ ≤ R ∧ ∀ y ∈ s, 1 ≤ ∥y - x∥ :=
begin
  let F := submodule.span 𝕜 (s : set E),
  haveI : finite_dimensional 𝕜 F := module.finite_def.2
    ((submodule.fg_top _).2 (submodule.fg_def.2 ⟨s, finset.finite_to_set _, rfl⟩)),
  have Fclosed : is_closed (F : set E) := submodule.closed_of_finite_dimensional _,
  have : ∃ x, x ∉ F,
  { contrapose! h,
    have : (⊤ : submodule 𝕜 E) = F, by { ext x, simp [h] },
    have : finite_dimensional 𝕜 (⊤ : submodule 𝕜 E), by rwa this,
    refine module.finite_def.2 ((submodule.fg_top _).1 (module.finite_def.1 this)) },
  obtain ⟨x, xR, hx⟩ : ∃ (x : E), ∥x∥ ≤ R ∧ ∀ (y : E), y ∈ F → 1 ≤ ∥x - y∥ :=
    riesz_lemma_of_norm_lt hc hR Fclosed this,
  have hx' : ∀ (y : E), y ∈ F → 1 ≤ ∥y - x∥,
  { assume y hy, rw ← norm_neg, simpa using hx y hy },
  exact ⟨x, xR, λ y hy, hx' _ (submodule.subset_span hy)⟩,
end

/-- In an infinite-dimensional normed space, there exists a sequence of points which are all
bounded by `R` and at distance at least `1`. For a version not assuming `c` and `R`, see
`exists_seq_norm_le_one_le_norm_sub`. -/
theorem exists_seq_norm_le_one_le_norm_sub' {c : 𝕜} (hc : 1 < ∥c∥) {R : ℝ} (hR : ∥c∥ < R)
  (h : ¬ (finite_dimensional 𝕜 E)) :
  ∃ f : ℕ → E, (∀ n, ∥f n∥ ≤ R) ∧ (∀ m n, m ≠ n → 1 ≤ ∥f m - f n∥) :=
begin
  haveI : is_symm E (λ (x y : E), 1 ≤ ∥x - y∥),
  { constructor,
    assume x y hxy,
    rw ← norm_neg,
    simpa },
  apply exists_seq_of_forall_finset_exists' (λ (x : E), ∥x∥ ≤ R) (λ (x : E) (y : E), 1 ≤ ∥x - y∥),
  assume s hs,
  exact exists_norm_le_le_norm_sub_of_finset hc hR h s,
end

theorem exists_seq_norm_le_one_le_norm_sub (h : ¬ (finite_dimensional 𝕜 E)) :
  ∃ (R : ℝ) (f : ℕ → E), (1 < R) ∧ (∀ n, ∥f n∥ ≤ R) ∧ (∀ m n, m ≠ n → 1 ≤ ∥f m - f n∥) :=
begin
  obtain ⟨c, hc⟩ : ∃ (c : 𝕜), 1 < ∥c∥ := normed_field.exists_one_lt_norm 𝕜,
  have A : ∥c∥ < ∥c∥ + 1, by linarith,
  rcases exists_seq_norm_le_one_le_norm_sub' hc A h with ⟨f, hf⟩,
  exact ⟨∥c∥ + 1, f, hc.trans A, hf.1, hf.2⟩
end

variable (𝕜)
/-- Riesz's theorem: if the unit ball is compact in a vector space, then the space is
finite-dimensional. -/
theorem finite_dimensional_of_is_compact_closed_ball {r : ℝ} (rpos : 0 < r)
  (h : is_compact (metric.closed_ball (0 : E) r)) : finite_dimensional 𝕜 E :=
begin
  by_contra hfin,
  obtain ⟨R, f, Rgt, fle, lef⟩ :
    ∃ (R : ℝ) (f : ℕ → E), (1 < R) ∧ (∀ n, ∥f n∥ ≤ R) ∧ (∀ m n, m ≠ n → 1 ≤ ∥f m - f n∥) :=
      exists_seq_norm_le_one_le_norm_sub hfin,
  have rRpos : 0 < r / R := div_pos rpos (zero_lt_one.trans Rgt),
  obtain ⟨c, hc⟩ : ∃ (c : 𝕜), 0 < ∥c∥ ∧ ∥c∥ < (r / R) := normed_field.exists_norm_lt _ rRpos,
  let g := λ (n : ℕ), c • f n,
  have A : ∀ n, g n ∈ metric.closed_ball (0 : E) r,
  { assume n,
    simp only [norm_smul, dist_zero_right, metric.mem_closed_ball],
    calc ∥c∥ * ∥f n∥ ≤ (r / R) * R : mul_le_mul hc.2.le (fle n) (norm_nonneg _) rRpos.le
    ... = r : by field_simp [(zero_lt_one.trans Rgt).ne'] },
  obtain ⟨x, hx, φ, φmono, φlim⟩ : ∃ (x : E) (H : x ∈ metric.closed_ball (0 : E) r) (φ : ℕ → ℕ),
    strict_mono φ ∧ tendsto (g ∘ φ) at_top (𝓝 x) := h.tendsto_subseq A,
  have B : cauchy_seq (g ∘ φ) := φlim.cauchy_seq,
  obtain ⟨N, hN⟩ : ∃ (N : ℕ), ∀ (n : ℕ), N ≤ n → dist ((g ∘ φ) n) ((g ∘ φ) N) < ∥c∥ :=
    metric.cauchy_seq_iff'.1 B (∥c∥) hc.1,
  apply lt_irrefl (∥c∥),
  calc ∥c∥ ≤ dist (g (φ (N+1))) (g (φ N)) : begin
    conv_lhs { rw [← mul_one (∥c∥)] },
    simp only [g, dist_eq_norm, ←smul_sub, norm_smul, -mul_one],
    apply mul_le_mul_of_nonneg_left (lef _ _ (ne_of_gt _)) (norm_nonneg _),
    exact φmono (nat.lt_succ_self N)
  end
  ... < ∥c∥ : hN (N+1) (nat.le_succ N)
end

end riesz

/-- An injective linear map with finite-dimensional domain is a closed embedding. -/
lemma linear_equiv.closed_embedding_of_injective {f : E →ₗ[𝕜] F} (hf : f.ker = ⊥)
  [finite_dimensional 𝕜 E] :
  closed_embedding ⇑f :=
let g := linear_equiv.of_injective f (linear_map.ker_eq_bot.mp hf) in
{ closed_range := begin
    haveI := f.finite_dimensional_range,
    simpa [f.range_coe] using f.range.closed_of_finite_dimensional
  end,
  .. embedding_subtype_coe.comp g.to_continuous_linear_equiv.to_homeomorph.embedding }

lemma continuous_linear_map.exists_right_inverse_of_surjective [finite_dimensional 𝕜 F]
  (f : E →L[𝕜] F) (hf : f.range = ⊤) :
  ∃ g : F →L[𝕜] E, f.comp g = continuous_linear_map.id 𝕜 F :=
let ⟨g, hg⟩ := (f : E →ₗ[𝕜] F).exists_right_inverse_of_surjective hf in
⟨g.to_continuous_linear_map, continuous_linear_map.ext $ linear_map.ext_iff.1 hg⟩

lemma closed_embedding_smul_left {c : E} (hc : c ≠ 0) : closed_embedding (λ x : 𝕜, x • c) :=
linear_equiv.closed_embedding_of_injective (linear_equiv.ker_to_span_singleton 𝕜 E hc)

/- `smul` is a closed map in the first argument. -/
lemma is_closed_map_smul_left (c : E) : is_closed_map (λ x : 𝕜, x • c) :=
begin
  by_cases hc : c = 0,
  { simp_rw [hc, smul_zero], exact is_closed_map_const },
  { exact (closed_embedding_smul_left hc).is_closed_map }
end

end complete_field

section proper_field
variables (𝕜 : Type u) [nondiscrete_normed_field 𝕜]
(E : Type v) [normed_group E] [normed_space 𝕜 E] [proper_space 𝕜]

/-- Any finite-dimensional vector space over a proper field is proper.
We do not register this as an instance to avoid an instance loop when trying to prove the
properness of `𝕜`, and the search for `𝕜` as an unknown metavariable. Declare the instance
explicitly when needed. -/
lemma finite_dimensional.proper [finite_dimensional 𝕜 E] : proper_space E :=
begin
  set e := continuous_linear_equiv.of_finrank_eq (@finrank_fin_fun 𝕜 _ (finrank 𝕜 E)).symm,
  exact e.symm.antilipschitz.proper_space e.symm.continuous e.symm.surjective
end

end proper_field

/- Over the real numbers, we can register the previous statement as an instance as it will not
cause problems in instance resolution since the properness of `ℝ` is already known. -/
@[priority 900]
instance finite_dimensional.proper_real
  (E : Type u) [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E] : proper_space E :=
finite_dimensional.proper ℝ E

/-- If `E` is a finite dimensional normed real vector space, `x : E`, and `s` is a neighborhood of
`x` that is not equal to the whole space, then there exists a point `y ∈ frontier s` at distance
`metric.inf_dist x sᶜ` from `x`. -/
lemma exists_mem_frontier_inf_dist_compl_eq_dist {E : Type*} [normed_group E]
  [normed_space ℝ E] [finite_dimensional ℝ E] {x : E} {s : set E} (hx : x ∈ s) (hs : s ≠ univ) :
  ∃ y ∈ frontier s, metric.inf_dist x sᶜ = dist x y :=
begin
  rcases metric.exists_mem_closure_inf_dist_eq_dist (nonempty_compl.2 hs) x with ⟨y, hys, hyd⟩,
  rw closure_compl at hys,
  refine ⟨y, ⟨metric.closed_ball_inf_dist_compl_subset_closure hx hs $
    metric.mem_closed_ball.2 $ ge_of_eq _, hys⟩, hyd⟩,
  rwa dist_comm
end

/-- In a finite dimensional vector space over `ℝ`, the series `∑ x, ∥f x∥` is unconditionally
summable if and only if the series `∑ x, f x` is unconditionally summable. One implication holds in
any complete normed space, while the other holds only in finite dimensional spaces. -/
lemma summable_norm_iff {α E : Type*} [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
  {f : α → E} : summable (λ x, ∥f x∥) ↔ summable f :=
begin
  refine ⟨summable_of_summable_norm, λ hf, _⟩,
  -- First we use a finite basis to reduce the problem to the case `E = fin N → ℝ`
  suffices : ∀ {N : ℕ} {g : α → fin N → ℝ}, summable g → summable (λ x, ∥g x∥),
  { obtain v := fin_basis ℝ E,
    set e := v.equiv_funL,
    have : summable (λ x, ∥e (f x)∥) := this (e.summable.2 hf),
    refine summable_of_norm_bounded _ (this.mul_left
      ↑(nnnorm (e.symm : (fin (finrank ℝ E) → ℝ) →L[ℝ] E))) (λ i, _),
    simpa using (e.symm : (fin (finrank ℝ E) → ℝ) →L[ℝ] E).le_op_norm (e $ f i) },
  unfreezingI { clear_dependent E },
  -- Now we deal with `g : α → fin N → ℝ`
  intros N g hg,
  have : ∀ i, summable (λ x, ∥g x i∥) := λ i, (pi.summable.1 hg i).abs,
  refine summable_of_norm_bounded _ (summable_sum (λ i (hi : i ∈ finset.univ), this i)) (λ x, _),
  rw [norm_norm, pi_norm_le_iff],
  { refine λ i, finset.single_le_sum (λ i hi, _) (finset.mem_univ i),
    exact norm_nonneg (g x i) },
  { exact finset.sum_nonneg (λ _ _, norm_nonneg _) }
end

lemma summable_of_is_O' {ι E F : Type*} [normed_group E] [complete_space E] [normed_group F]
  [normed_space ℝ F] [finite_dimensional ℝ F] {f : ι → E} {g : ι → F}
  (hg : summable g) (h : is_O f g cofinite) : summable f :=
summable_of_is_O (summable_norm_iff.mpr hg) h.norm_right

lemma summable_of_is_O_nat' {E F : Type*} [normed_group E] [complete_space E] [normed_group F]
  [normed_space ℝ F] [finite_dimensional ℝ F] {f : ℕ → E} {g : ℕ → F}
  (hg : summable g) (h : is_O f g at_top) : summable f :=
summable_of_is_O_nat (summable_norm_iff.mpr hg) h.norm_right

lemma summable_of_is_equivalent {ι E : Type*} [normed_group E] [normed_space ℝ E]
  [finite_dimensional ℝ E] {f : ι → E} {g : ι → E}
  (hg : summable g) (h : f ~[cofinite] g) : summable f :=
hg.trans_sub (summable_of_is_O' hg h.is_o.is_O)

lemma summable_of_is_equivalent_nat {E : Type*} [normed_group E] [normed_space ℝ E]
  [finite_dimensional ℝ E] {f : ℕ → E} {g : ℕ → E}
  (hg : summable g) (h : f ~[at_top] g) : summable f :=
hg.trans_sub (summable_of_is_O_nat' hg h.is_o.is_O)

lemma is_equivalent.summable_iff {ι E : Type*} [normed_group E] [normed_space ℝ E]
  [finite_dimensional ℝ E] {f : ι → E} {g : ι → E}
  (h : f ~[cofinite] g) : summable f ↔ summable g :=
⟨λ hf, summable_of_is_equivalent hf h.symm, λ hg, summable_of_is_equivalent hg h⟩

lemma is_equivalent.summable_iff_nat {E : Type*} [normed_group E] [normed_space ℝ E]
  [finite_dimensional ℝ E] {f : ℕ → E} {g : ℕ → E}
  (h : f ~[at_top] g) : summable f ↔ summable g :=
⟨λ hf, summable_of_is_equivalent_nat hf h.symm, λ hg, summable_of_is_equivalent_nat hg h⟩


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import algebra.group_with_zero.power
import data.list.big_operators
import data.multiset.basic

/-!
# Sums and products over multisets

In this file we define products and sums indexed by multisets. This is later used to define products
and sums indexed by finite sets.

## Main declarations

* `multiset.prod`: `s.prod f` is the product of `f i` over all `i ∈ s`. Not to be mistaken with
  the cartesian product `multiset.product`.
* `multiset.sum`: `s.sum f` is the sum of `f i` over all `i ∈ s`.
-/

variables {ι α β γ : Type*}

namespace multiset
section comm_monoid
variables [comm_monoid α] {s t : multiset α} {a : α} {m : multiset ι} {f g : ι → α}

/-- Product of a multiset given a commutative monoid structure on `α`.
  `prod {a, b, c} = a * b * c` -/
@[to_additive "Sum of a multiset given a commutative additive monoid structure on `α`.
  `sum {a, b, c} = a + b + c`"]
def prod : multiset α → α := foldr (*) (λ x y z, by simp [mul_left_comm]) 1

@[to_additive]
lemma prod_eq_foldr (s : multiset α) : prod s = foldr (*) (λ x y z, by simp [mul_left_comm]) 1 s :=
rfl

@[to_additive]
lemma prod_eq_foldl (s : multiset α) : prod s = foldl (*) (λ x y z, by simp [mul_right_comm]) 1 s :=
(foldr_swap _ _ _ _).trans (by simp [mul_comm])

@[simp, norm_cast, to_additive] lemma coe_prod (l : list α) : prod ↑l = l.prod := prod_eq_foldl _

@[simp, to_additive]
lemma prod_to_list (s : multiset α) : s.to_list.prod = s.prod :=
begin
  conv_rhs { rw ←coe_to_list s },
  rw coe_prod,
end

@[simp, to_additive] lemma prod_zero : @prod α _ 0 = 1 := rfl

@[simp, to_additive]
lemma prod_cons (a : α) (s) : prod (a ::ₘ s) = a * prod s := foldr_cons _ _ _ _ _

@[simp, to_additive]
lemma prod_erase [decidable_eq α] (h : a ∈ s) : a * (s.erase a).prod = s.prod :=
by rw [← s.coe_to_list, coe_erase, coe_prod, coe_prod, list.prod_erase ((s.mem_to_list a).2 h)]

@[simp, to_additive]
lemma prod_singleton (a : α) : prod {a} = a :=
by simp only [mul_one, prod_cons, singleton_eq_cons, eq_self_iff_true, prod_zero]

@[to_additive]
lemma prod_pair (a b : α) : ({a, b} : multiset α).prod = a * b :=
by rw [insert_eq_cons, prod_cons, prod_singleton]

@[simp, to_additive]
lemma prod_add (s t : multiset α) : prod (s + t) = prod s * prod t :=
quotient.induction_on₂ s t $ λ l₁ l₂, by simp

lemma prod_nsmul (m : multiset α) : ∀ (n : ℕ), (n • m).prod = m.prod ^ n
| 0       := by { rw [zero_nsmul, pow_zero], refl }
| (n + 1) :=
  by rw [add_nsmul, one_nsmul, pow_add, pow_one, prod_add, prod_nsmul n]

@[simp, to_additive] lemma prod_repeat (a : α) (n : ℕ) : (repeat a n).prod = a ^ n :=
by simp [repeat, list.prod_repeat]

@[to_additive]
lemma pow_count [decidable_eq α] (a : α) : a ^ s.count a = (s.filter (eq a)).prod :=
by rw [filter_eq, prod_repeat]

@[to_additive]
lemma prod_hom [comm_monoid β] (s : multiset α) {F : Type*} [monoid_hom_class F α β] (f : F) :
  (s.map f).prod = f s.prod :=
quotient.induction_on s $ λ l, by simp only [l.prod_hom f, quot_mk_to_coe, coe_map, coe_prod]

@[to_additive]
lemma prod_hom' [comm_monoid β] (s : multiset ι) {F : Type*} [monoid_hom_class F α β] (f : F)
  (g : ι → α) : (s.map $ λ i, f $ g i).prod = f (s.map g).prod :=
by { convert (s.map g).prod_hom f, exact (map_map _ _ _).symm }

@[to_additive]
lemma prod_hom₂ [comm_monoid β] [comm_monoid γ] (s : multiset ι) (f : α → β → γ)
  (hf : ∀ a b c d, f (a * b) (c * d) = f a c * f b d) (hf' : f 1 1 = 1) (f₁ : ι → α) (f₂ : ι → β) :
  (s.map $ λ i, f (f₁ i) (f₂ i)).prod = f (s.map f₁).prod (s.map f₂).prod :=
quotient.induction_on s $ λ l,
  by simp only [l.prod_hom₂ f hf hf', quot_mk_to_coe, coe_map, coe_prod]

@[to_additive]
lemma prod_hom_rel [comm_monoid β] (s : multiset ι) {r : α → β → Prop} {f : ι → α} {g : ι → β}
  (h₁ : r 1 1) (h₂ : ∀ ⦃a b c⦄, r b c → r (f a * b) (g a * c)) :
  r (s.map f).prod (s.map g).prod :=
quotient.induction_on s $ λ l,
  by simp only [l.prod_hom_rel h₁ h₂, quot_mk_to_coe, coe_map, coe_prod]

@[to_additive]
lemma prod_map_one : prod (m.map (λ i, (1 : α))) = 1 := by rw [map_const, prod_repeat, one_pow]

@[simp, to_additive]
lemma prod_map_mul : (m.map $ λ i, f i * g i).prod = (m.map f).prod * (m.map g).prod :=
m.prod_hom₂ (*) mul_mul_mul_comm (mul_one _) _ _

@[to_additive]
lemma prod_map_pow {n : ℕ} : (m.map $ λ i, f i ^ n).prod = (m.map f).prod ^ n :=
m.prod_hom' (pow_monoid_hom n : α →* α) f

@[to_additive]
lemma prod_map_prod_map (m : multiset β) (n : multiset γ) {f : β → γ → α} :
  prod (m.map $ λ a, prod $ n.map $ λ b, f a b) = prod (n.map $ λ b, prod $ m.map $ λ a, f a b) :=
multiset.induction_on m (by simp) (λ a m ih, by simp [ih])

@[to_additive]
lemma prod_induction (p : α → Prop) (s : multiset α) (p_mul : ∀ a b, p a → p b → p (a * b))
  (p_one : p 1) (p_s : ∀ a ∈ s, p a) :
  p s.prod :=
begin
  rw prod_eq_foldr,
  exact foldr_induction (*) (λ x y z, by simp [mul_left_comm]) 1 p s p_mul p_one p_s,
end

@[to_additive]
lemma prod_induction_nonempty (p : α → Prop) (p_mul : ∀ a b, p a → p b → p (a * b))
  (hs : s ≠ ∅) (p_s : ∀ a ∈ s, p a) :
  p s.prod :=
begin
  revert s,
  refine multiset.induction _ _,
  { intro h,
    exfalso,
    simpa using h },
  intros a s hs hsa hpsa,
  rw prod_cons,
  by_cases hs_empty : s = ∅,
  { simp [hs_empty, hpsa a] },
  have hps : ∀ x, x ∈ s → p x, from λ x hxs, hpsa x (mem_cons_of_mem hxs),
  exact p_mul a s.prod (hpsa a (mem_cons_self a s)) (hs hs_empty hps),
end

lemma dvd_prod : a ∈ s → a ∣ s.prod :=
quotient.induction_on s (λ l a h, by simpa using list.dvd_prod h) a

lemma prod_dvd_prod_of_le (h : s ≤ t) : s.prod ∣ t.prod :=
begin
  obtain ⟨z, rfl⟩ := multiset.le_iff_exists_add.1 h,
  simp only [prod_add, dvd_mul_right],
end

end comm_monoid

lemma prod_dvd_prod_of_dvd [comm_monoid β] {S : multiset α} (g1 g2 : α → β)
  (h : ∀ a ∈ S, g1 a ∣ g2 a) :
  (multiset.map g1 S).prod ∣ (multiset.map g2 S).prod :=
begin
  apply multiset.induction_on' S, { simp },
  intros a T haS _ IH,
  simp [mul_dvd_mul (h a haS) IH]
end

section add_comm_monoid
variables [add_comm_monoid α]

/-- `multiset.sum`, the sum of the elements of a multiset, promoted to a morphism of
`add_comm_monoid`s. -/
def sum_add_monoid_hom : multiset α →+ α :=
{ to_fun := sum,
  map_zero' := sum_zero,
  map_add' := sum_add }

@[simp] lemma coe_sum_add_monoid_hom : (sum_add_monoid_hom : multiset α → α) = sum := rfl

end add_comm_monoid

section comm_monoid_with_zero
variables [comm_monoid_with_zero α]

lemma prod_eq_zero {s : multiset α} (h : (0 : α) ∈ s) : s.prod = 0 :=
begin
  rcases multiset.exists_cons_of_mem h with ⟨s', hs'⟩,
  simp [hs', multiset.prod_cons]
end

variables [no_zero_divisors α] [nontrivial α] {s : multiset α}

lemma prod_eq_zero_iff : s.prod = 0 ↔ (0 : α) ∈ s :=
quotient.induction_on s $ λ l, by { rw [quot_mk_to_coe, coe_prod], exact list.prod_eq_zero_iff }

lemma prod_ne_zero (h : (0 : α) ∉ s) : s.prod ≠ 0 := mt prod_eq_zero_iff.1 h

end comm_monoid_with_zero

section division_comm_monoid
variables [division_comm_monoid α] {m : multiset ι} {f g : ι → α}

@[to_additive] lemma prod_map_inv' (m : multiset α) : (m.map has_inv.inv).prod = m.prod⁻¹ :=
m.prod_hom (inv_monoid_hom : α →* α)

@[simp, to_additive] lemma prod_map_inv : (m.map $ λ i, (f i)⁻¹).prod = (m.map f).prod ⁻¹ :=
by { convert (m.map f).prod_map_inv', rw map_map }

@[simp, to_additive]
lemma prod_map_div : (m.map $ λ i, f i / g i).prod = (m.map f).prod / (m.map g).prod :=
m.prod_hom₂ (/) mul_div_mul_comm (div_one _) _ _

@[to_additive]
lemma prod_map_zpow {n : ℤ} : (m.map $ λ i, f i ^ n).prod = (m.map f).prod ^ n :=
by { convert (m.map f).prod_hom (zpow_group_hom _ : α →* α), rw map_map, refl }

end division_comm_monoid

section non_unital_non_assoc_semiring
variables [non_unital_non_assoc_semiring α] {a : α} {s : multiset ι} {f : ι → α}

lemma _root_.commute.multiset_sum_right (s : multiset α) (a : α) (h : ∀ b ∈ s, commute a b) :
  commute a s.sum :=
begin
  induction s using quotient.induction_on,
  rw [quot_mk_to_coe, coe_sum],
  exact commute.list_sum_right _ _ h,
end

lemma _root_.commute.multiset_sum_left (s : multiset α) (b : α) (h : ∀ a ∈ s, commute a b) :
  commute s.sum b :=
(commute.multiset_sum_right _ _ $ λ a ha, (h _ ha).symm).symm

lemma sum_map_mul_left : sum (s.map (λ i, a * f i)) = a * sum (s.map f) :=
multiset.induction_on s (by simp) (λ i s ih, by simp [ih, mul_add])

lemma sum_map_mul_right : sum (s.map (λ i, f i * a)) = sum (s.map f) * a :=
multiset.induction_on s (by simp) (λ a s ih, by simp [ih, add_mul])

end non_unital_non_assoc_semiring

section semiring
variables [semiring α]

lemma dvd_sum {a : α} {s : multiset α} : (∀ x ∈ s, a ∣ x) → a ∣ s.sum :=
multiset.induction_on s (λ _, dvd_zero _)
  (λ x s ih h, by { rw sum_cons, exact dvd_add
    (h _ (mem_cons_self _ _)) (ih $ λ y hy, h _ $ mem_cons.2 $ or.inr hy) })

end semiring

/-! ### Order -/

section ordered_comm_monoid
variables [ordered_comm_monoid α] {s t : multiset α} {a : α}

@[to_additive sum_nonneg]
lemma one_le_prod_of_one_le : (∀ x ∈ s, (1 : α) ≤ x) → 1 ≤ s.prod :=
quotient.induction_on s $ λ l hl, by simpa using list.one_le_prod_of_one_le hl

@[to_additive]
lemma single_le_prod : (∀ x ∈ s, (1 : α) ≤ x) → ∀ x ∈ s, x ≤ s.prod :=
quotient.induction_on s $ λ l hl x hx, by simpa using list.single_le_prod hl x hx

@[to_additive sum_le_card_nsmul]
lemma prod_le_pow_card (s : multiset α) (n : α) (h : ∀ x ∈ s, x ≤ n) : s.prod ≤ n ^ s.card :=
begin
  induction s using quotient.induction_on,
  simpa using list.prod_le_pow_card _ _ h,
end

@[to_additive all_zero_of_le_zero_le_of_sum_eq_zero]
lemma all_one_of_le_one_le_of_prod_eq_one :
  (∀ x ∈ s, (1 : α) ≤ x) → s.prod = 1 → ∀ x ∈ s, x = (1 : α) :=
begin
  apply quotient.induction_on s,
  simp only [quot_mk_to_coe, coe_prod, mem_coe],
  exact λ l, list.all_one_of_le_one_le_of_prod_eq_one,
end

@[to_additive]
lemma prod_le_prod_of_rel_le (h : s.rel (≤) t) : s.prod ≤ t.prod :=
begin
  induction h with _ _ _ _ rh _ rt,
  { refl },
  { rw [prod_cons, prod_cons],
    exact mul_le_mul' rh rt }
end

@[to_additive]
lemma prod_map_le_prod (f : α → α) (h : ∀ x, x ∈ s → f x ≤ x) : (s.map f).prod ≤ s.prod :=
prod_le_prod_of_rel_le $ rel_map_left.2 $ rel_refl_of_refl_on h

@[to_additive]
lemma prod_le_sum_prod (f : α → α) (h : ∀ x, x ∈ s → x ≤ f x) : s.prod ≤ (s.map f).prod :=
@prod_map_le_prod αᵒᵈ _ _ f h

@[to_additive card_nsmul_le_sum]
lemma pow_card_le_prod (h : ∀ x ∈ s, a ≤ x) : a ^ s.card ≤ s.prod :=
by { rw [←multiset.prod_repeat, ←multiset.map_const], exact prod_map_le_prod _ h }

end ordered_comm_monoid

lemma prod_nonneg [ordered_comm_semiring α] {m : multiset α} (h : ∀ a ∈ m, (0 : α) ≤ a) :
  0 ≤ m.prod :=
begin
  revert h,
  refine m.induction_on _ _,
  { rintro -, rw prod_zero, exact zero_le_one },
  intros a s hs ih,
  rw prod_cons,
  exact mul_nonneg (ih _ $ mem_cons_self _ _) (hs $ λ a ha, ih _ $ mem_cons_of_mem ha),
end

@[to_additive]
lemma prod_eq_one_iff [canonically_ordered_monoid α] {m : multiset α} :
  m.prod = 1 ↔ ∀ x ∈ m, x = (1 : α) :=
quotient.induction_on m $ λ l, by simpa using list.prod_eq_one_iff l

@[to_additive]
lemma le_prod_of_mem [canonically_ordered_monoid α] {m : multiset α} {a : α} (h : a ∈ m) :
  a ≤ m.prod :=
begin
  obtain ⟨m', rfl⟩ := exists_cons_of_mem h,
  rw [prod_cons],
  exact _root_.le_mul_right (le_refl a),
end

@[to_additive le_sum_of_subadditive_on_pred]
lemma le_prod_of_submultiplicative_on_pred [comm_monoid α] [ordered_comm_monoid β]
  (f : α → β) (p : α → Prop) (h_one : f 1 = 1) (hp_one : p 1)
  (h_mul : ∀ a b, p a → p b → f (a * b) ≤ f a * f b)
  (hp_mul : ∀ a b, p a → p b → p (a * b)) (s : multiset α) (hps : ∀ a, a ∈ s → p a) :
  f s.prod ≤ (s.map f).prod :=
begin
  revert s,
  refine multiset.induction _ _,
  { simp [le_of_eq h_one] },
  intros a s hs hpsa,
  have hps : ∀ x, x ∈ s → p x, from λ x hx, hpsa x (mem_cons_of_mem hx),
  have hp_prod : p s.prod, from prod_induction p s hp_mul hp_one hps,
  rw [prod_cons, map_cons, prod_cons],
  exact (h_mul a s.prod (hpsa a (mem_cons_self a s)) hp_prod).trans (mul_le_mul_left' (hs hps) _),
end

@[to_additive le_sum_of_subadditive]
lemma le_prod_of_submultiplicative [comm_monoid α] [ordered_comm_monoid β]
  (f : α → β) (h_one : f 1 = 1) (h_mul : ∀ a b, f (a * b) ≤ f a * f b) (s : multiset α) :
  f s.prod ≤ (s.map f).prod :=
le_prod_of_submultiplicative_on_pred f (λ i, true) h_one trivial (λ x y _ _ , h_mul x y) (by simp)
  s (by simp)

@[to_additive le_sum_nonempty_of_subadditive_on_pred]
lemma le_prod_nonempty_of_submultiplicative_on_pred [comm_monoid α] [ordered_comm_monoid β]
  (f : α → β) (p : α → Prop) (h_mul : ∀ a b, p a → p b → f (a * b) ≤ f a * f b)
  (hp_mul : ∀ a b, p a → p b → p (a * b)) (s : multiset α) (hs_nonempty : s ≠ ∅)
  (hs : ∀ a, a ∈ s → p a) :
  f s.prod ≤ (s.map f).prod :=
begin
  revert s,
  refine multiset.induction _ _,
  { intro h,
    exfalso,
    exact h rfl },
  rintros a s hs hsa_nonempty hsa_prop,
  rw [prod_cons, map_cons, prod_cons],
  by_cases hs_empty : s = ∅,
  { simp [hs_empty] },
  have hsa_restrict : (∀ x, x ∈ s → p x), from λ x hx, hsa_prop x (mem_cons_of_mem hx),
  have hp_sup : p s.prod,
    from prod_induction_nonempty p hp_mul hs_empty hsa_restrict,
  have hp_a : p a, from hsa_prop a (mem_cons_self a s),
  exact (h_mul a _ hp_a hp_sup).trans (mul_le_mul_left' (hs hs_empty hsa_restrict) _),
end

@[to_additive le_sum_nonempty_of_subadditive]
lemma le_prod_nonempty_of_submultiplicative [comm_monoid α] [ordered_comm_monoid β]
  (f : α → β) (h_mul : ∀ a b, f (a * b) ≤ f a * f b) (s : multiset α) (hs_nonempty : s ≠ ∅) :
  f s.prod ≤ (s.map f).prod :=
le_prod_nonempty_of_submultiplicative_on_pred f (λ i, true) (by simp [h_mul]) (by simp) s
  hs_nonempty (by simp)

@[simp] lemma sum_map_singleton (s : multiset α) : (s.map (λ a, ({a} : multiset α))).sum = s :=
multiset.induction_on s (by simp) (by simp [singleton_eq_cons])

lemma abs_sum_le_sum_abs [linear_ordered_add_comm_group α] {s : multiset α} :
  abs s.sum ≤ (s.map abs).sum :=
le_sum_of_subadditive _ abs_zero abs_add s

end multiset

@[to_additive]
lemma map_multiset_prod [comm_monoid α] [comm_monoid β] {F : Type*} [monoid_hom_class F α β]
  (f : F) (s : multiset α) : f s.prod = (s.map f).prod :=
(s.prod_hom f).symm

@[to_additive]
protected lemma monoid_hom.map_multiset_prod [comm_monoid α] [comm_monoid β] (f : α →* β)
  (s : multiset α) : f s.prod = (s.map f).prod :=
(s.prod_hom f).symm


import data.nat.basic
import data.int.basic
import data.rat.basic

import algebra.field_power

import tactic

import data.finset
import algebra.big_operators
import data.real.basic
import data.set.lattice

open finset
open nat

local notation `edges_of `X := powerset_len 2 X

universe u
variables {α : Type u} (K : finset α) {n : ℕ} --[decidable_eq α]

/-

lemma number_of_colorings_of_K_with_monochromatic_K_subgraph (k : ℕ) (hn : card(K_1) = n)
    := card (colorings_of_K_with_monochromatic_K_subgraph k) = 2^(n.choose(2) - n.choose(k)) * 2 * n.choose(k)

----------
-/

/-
  The set of all two colorings of the complete graph
-/
--Note: Present implementation only works with 2 colorings
def colorings : finset (finset (finset α)) := powerset (edges_of K)

/-
  The cardinality of colorings
-/
lemma num_complete_colorings (hn : card K = n) :
    card (colorings K) = 2^(nat.choose n 2) :=
begin
    rw colorings,
    rw card_powerset,
    rw card_powerset_len,
    rw hn,
end

/-
  The set of all 2 colorings of the compelte graph such that the coloring is monochromatic
  on a complete subgraph of order k
-/
def mono_sub_colorings (n : ℕ) (k : ℕ) : finset (finset (finset α)) :=
begin
  sorry,
end

/-
  The cardinality of mono_sub_colorings
-/
lemma num_mono_sub_colorings (n k : ℕ) (h : n ≥ k) :
  (card (@mono_sub_colorings α n k) : ℚ) = ((2 : ℚ)^((n.choose(2)) - (k.choose(2))) : ℚ) * 2 * n.choose(k) :=
begin
  sorry,
end

/-
  Central inequality of the next theorem, except without binomial coefficients
  (for readability and convenience).
-/
lemma core_ineq
  {a b c : ℕ}
  (h : ((2 : ℚ)^(1 - b : ℤ) * c : ℚ) < 1) :
  ((2 : ℚ)^(a - b : ℤ) * 2 * c : ℚ) < (2:ℚ)^(a : ℤ) :=
begin
  --rw fpow_add two_ne_zero a (-b),
  --fpow_add alt approach above

  rw @fpow_sub ℚ _ _ two_ne_zero 1 b at h,
  rw fpow_one (2: ℚ) at h,

  rw @fpow_sub ℚ _ _ two_ne_zero a b,

  rw div_mul_eq_mul_div_comm (2) ((2 : ℚ)^(a : ℤ)) ((2 : ℚ)^(b : ℤ)),
  rw mul_assoc ((2 : ℚ)^(a : ℤ)) (2 / 2 ^ ↑b) (↑c),
  rw mul_comm ((2 : ℚ) ^ ↑a) (2 / 2 ^ ↑b * ↑c),

  apply mul_lt_of_lt_div,

  exact nat.fpow_pos_of_pos (nat.pos_of_ne_zero(two_ne_zero)) (a : ℤ),
  rw div_self,

  exact h,

  apply fpow_ne_zero_of_ne_zero,
  exact dec_trivial,
end

/-
  Proof that the cardinality of colorings is strictly less than the
  cardinality of mono_sub_colorings given a certain hypothesis.
-/
theorem card_strict_inequality (n k : ℕ) (hnk : n ≥ k) (hn : card (K) = n)
  (h : (2^(1 - k.choose(2) : ℤ) * n.choose(k) : ℚ) < 1) :
  (card (@mono_sub_colorings α n k) : ℚ) < (card (colorings K) : ℚ) :=
begin
  rw num_complete_colorings K hn,
  rw num_mono_sub_colorings n k hnk,

  exact @core_ineq (n.choose 2) (k.choose 2) (n.choose k) (h),
end


import Lib.Algebra.Group

class LeftDistrib (α : Type u) [Mul α] [Add α] where
  left_distrib {x y z : α} : x * (y + z) = x * y + x * z

class RightDistrib (α : Type u) [Mul α] [Add α] where
  right_distrib {x y z : α} : (x + y) * z = x*z + y*z

class SemiRing (α : Type u) where
-- extends AddCommMonoid α, Monoid α where
  [mul_monoid : Monoid α]
  [add_monoid : AddCommMonoid α]
  [left_distr : LeftDistrib α]
  [right_distr : RightDistrib α]
  mul_zero {x : α} : x * 0 = 0
  zero_mul {x : α} : 0 * x = 0

namespace SemiRing
attribute [instance] mul_monoid add_monoid left_distr right_distr

variable [SemiRing α]

end SemiRing

class Ring (α : Type u) where
  [mul_monoid : Monoid α]
  [add_group : CommAddGroup α]
  [left_distr : LeftDistrib α]
  [right_distr : RightDistrib α]
  mul_zero {x : α} : x * 0 = 0
  zero_mul {x : α} : 0 * x = 0

attribute [instance] Ring.mul_monoid Ring.add_group
attribute [instance] Ring.left_distr Ring.right_distr

namespace Ring
variable [Ring α]
variable {x y z : α}
open LeftDistrib RightDistrib AddGroup Ring

theorem neg_mul : -x * y = -(x * y) := by
symmetry
rw [neg_eq_iff_l, ← right_distrib, add_neg, zero_mul]

theorem mul_neg : x * -y = -(x * y) := by
symmetry
rw [neg_eq_iff_l, ← left_distrib, add_neg, mul_zero]

theorem neg_mul_eq_mul_neg : -x * y = x * -y := by
rw [neg_mul, mul_neg]

end Ring

class OrderedRing (α : Type u) [LE α] where
  [mul_monoid : OrderedMonoid α]
  [add_group : OrderedCommAddGroup α]
  [left_distr : LeftDistrib α]
  [right_distr : RightDistrib α]
  mul_zero {x : α} : x * 0 = 0
  zero_mul {x : α} : 0 * x = 0

attribute [instance] OrderedRing.mul_monoid OrderedRing.add_group
attribute [instance] OrderedRing.left_distr OrderedRing.right_distr

instance [LE α] [OrderedRing α] : OfNat α (nat_lit 1) := inferInstance
instance [LE α] [OrderedRing α] : OfNat α (nat_lit 0) := inferInstance
-- instance [LE α] [Ring α] : Monoid α := inferInstance
-- instance [LE α] [Ring α] : AddGroup α := inferInstance

namespace OrderedRing
variable [LE α] [OrderedRing α]

instance : Ring α where
  mul_monoid := inferInstance
  add_group  := inferInstance
  left_distr := inferInstance
  right_distr := inferInstance
  mul_zero := OrderedRing.mul_zero
  zero_mul := OrderedRing.zero_mul

instance : CommAddGroup α :=
OrderedRing.add_group.toCommGroup (α := Additive α)

instance : AddCommMonoid α := inferInstance
-- OrderedRing.add_group.toCommGroup (α := Additive α)

end OrderedRing

namespace Nat

instance : LeftDistrib Nat where
  left_distrib := @Nat.left_distrib

instance : RightDistrib Nat where
  right_distrib := @Nat.right_distrib

instance : SemiRing Nat where
  mul_monoid := inferInstanceAs (Monoid Nat)
  add_monoid := inferInstanceAs (AddCommMonoid Nat)
  left_distr := inferInstance
  right_distr := inferInstance
  mul_zero := @Nat.mul_zero
  zero_mul := @Nat.zero_mul

end Nat


import Mathlib.Data.List.Sort
import Mathlib.Data.Nat.Log
import Runtime.MergeSort.LogLemmas

section timedSort

universe u

variable {α : Type u} [DecidableRel r]

@[simp] def split : List α → (List α × List α × Nat)
  | []       => ([], [], 0)
  | (h :: t) => let (l₁, l₂, n) := split t
                (h :: l₂, l₁, n + 1)

theorem split_equivalence : ∀ (l : List α) ,
  (split l).fst = (List.split l).fst ∧ (split l).snd.fst = (List.split l).snd
  | [] => by simp
  | (h :: t) => by
    simp
    have ⟨ih_fst, ih_snd⟩ := split_equivalence t
    exact And.intro ih_snd ih_fst

theorem split_complexity : ∀ (l : List α) , (split l).snd.snd = l.length
| [] => by simp
| (h :: t) => by
  simp
  exact split_complexity t

theorem length_split_lt {a b: α} {l l₁ l₂ : List α} {n : Nat}
  (h : split (a::b::l) = (l₁, l₂, n)):
    List.length l₁ < List.length (a::b::l) ∧
    List.length l₂ < List.length (a::b::l) := by
  have split_eq_full : l₁ = (a::b::l).split.fst ∧ l₂ = (a::b::l).split.snd := by
    have l₂_n_id : (l₂, n) = (split (a :: b :: l)).snd :=
      (congrArg Prod.snd h).congr_right.mpr rfl
    have l₂_id : l₂ = (split (a :: b :: l)).snd.fst :=
      (congrArg Prod.fst l₂_n_id).congr_right.mp rfl
    have l₁_id : l₁ = (split (a :: b :: l)).fst :=
      (congrArg Prod.fst h).congr_right.mpr rfl
    have ⟨l₁_id', l₂_id'⟩ := split_equivalence (a :: b :: l)
    apply And.intro
    { rw [l₁_id'] at l₁_id; exact l₁_id }
    rw [l₂_id'] at l₂_id
    exact l₂_id
  have ⟨l₁_id, l₂_id⟩ := split_eq_full
  have reconstruct : List.split (a :: b :: l) = (l₁, l₂) := by
    rw [l₁_id, l₂_id]
  exact List.length_split_lt reconstruct

theorem split_halves_length : ∀ {l l₁ l₂ : List α} {n : Nat},
  split l = (l₁, l₂, n) →
    2 * List.length l₁ ≤ List.length l + 1 ∧ 2 * List.length l₂ ≤ List.length l
| []       => by
  intros h
  unfold split at h
  simp at h
  have ⟨h₁, ⟨h₂, _⟩⟩ := h
  rw [← h₁, ← h₂]
  simp
| (a :: t) => by
  intros h'
  cases e: split t with
  | mk t₁ t₂m =>
    have ⟨t₂, m⟩ := t₂m
    have split_id : split (a :: t) = (a :: t₂, t₁, m + 1) := by
      unfold split
      rw [e]
    rw [split_id] at h'
    injection h' with h₁' h''
    injection h'' with h₂' h₃'
    have ⟨ih₁, ih₂⟩ := split_halves_length e
    apply And.intro
    { rw [← h₁']
      simp
      exact @Nat.add_le_add (2 * List.length t₂) (List.length t) 2 2 ih₂ le_rfl
    }
    { rw [← h₂']
      simp
      exact ih₁
    }

theorem split_lengths : ∀ (l l₁ l₂ : List α) {n : Nat},
  split l = (l₁, l₂, n) → l₁.length + l₂.length = l.length
| []  => by
  intros l₁ l₂ n
  simp
  intros h₁ h₂ _
  rw [← h₁, ← h₂]
  simp
| [a] => by
  intros l₁ l₂ n
  simp
  intros h₁ h₂ _
  rw [← h₁, ← h₂]
  simp
| (a :: b :: t) => by
  intros l₁ l₂ n h
  cases e : split t with
  | mk l₁' l₂'m =>
    have ⟨l₂', m⟩ := l₂'m
    simp at h
    rw [e] at h
    unfold split at h
    have ih := split_lengths t l₁' l₂' e
    have ⟨h₁, ⟨h₂, _⟩⟩ := h
    rw [← h₁, ← h₂]
    simp
    show List.length l₁' + 1 + List.length l₂' + 1 = List.length t + 2
    rw [add_comm, add_comm (List.length l₁'), add_assoc, ih]
    ring_nf

end timedSort


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau

More operations on modules and ideals.
-/

import ring_theory.ideals data.nat.choose order.zorn
import linear_algebra.tensor_product
import data.equiv.algebra

universes u v w x

open lattice

namespace submodule

variables {R : Type u} {M : Type v}
variables [comm_ring R] [add_comm_group M] [module R M]

instance has_scalar' : has_scalar (ideal R) (submodule R M) :=
⟨λ I N, ⨆ r : I, N.map (r.1 • linear_map.id)⟩

def annihilator (N : submodule R M) : ideal R :=
(linear_map.lsmul R N).ker

def colon (N P : submodule R M) : ideal R :=
annihilator (P.map N.mkq)

variables {I J : ideal R} {N N₁ N₂ P P₁ P₂ : submodule R M}

theorem mem_annihilator {r} : r ∈ N.annihilator ↔ ∀ n ∈ N, r • n = (0:M) :=
⟨λ hr n hn, congr_arg subtype.val (linear_map.ext_iff.1 (linear_map.mem_ker.1 hr) ⟨n, hn⟩),
λ h, linear_map.mem_ker.2 $ linear_map.ext $ λ n, subtype.eq $ h n.1 n.2⟩

theorem mem_annihilator' {r} : r ∈ N.annihilator ↔ N ≤ comap (r • linear_map.id) ⊥ :=
mem_annihilator.trans ⟨λ H n hn, (mem_bot R).2 $ H n hn, λ H n hn, (mem_bot R).1 $ H hn⟩

theorem annihilator_bot : (⊥ : submodule R M).annihilator = ⊤ :=
(ideal.eq_top_iff_one _).2 $ mem_annihilator'.2 bot_le

theorem annihilator_eq_top_iff : N.annihilator = ⊤ ↔ N = ⊥ :=
⟨λ H, eq_bot_iff.2 $ λ (n:M) hn, (mem_bot R).2 $ one_smul R n ▸ mem_annihilator.1 ((ideal.eq_top_iff_one _).1 H) n hn,
λ H, H.symm ▸ annihilator_bot⟩

theorem annihilator_mono (h : N ≤ P) : P.annihilator ≤ N.annihilator :=
λ r hrp, mem_annihilator.2 $ λ n hn, mem_annihilator.1 hrp n $ h hn

theorem annihilator_supr (ι : Type w) (f : ι → submodule R M) :
  (annihilator ⨆ i, f i) = ⨅ i, annihilator (f i) :=
le_antisymm (le_infi $ λ i, annihilator_mono $ le_supr _ _)
(λ r H, mem_annihilator'.2 $ supr_le $ λ i,
  have _ := (mem_infi _).1 H i, mem_annihilator'.1 this)

theorem mem_colon {r} : r ∈ N.colon P ↔ ∀ p ∈ P, r • p ∈ N :=
mem_annihilator.trans ⟨λ H p hp, (quotient.mk_eq_zero N).1 (H (quotient.mk p) (mem_map_of_mem hp)),
λ H m ⟨p, hp, hpm⟩, hpm ▸ (N.mkq).map_smul r p ▸ (quotient.mk_eq_zero N).2 $ H p hp⟩

theorem mem_colon' {r} : r ∈ N.colon P ↔ P ≤ comap (r • linear_map.id) N :=
mem_colon

theorem colon_mono (hn : N₁ ≤ N₂) (hp : P₁ ≤ P₂) : N₁.colon P₂ ≤ N₂.colon P₁ :=
λ r hrnp, mem_colon.2 $ λ p₁ hp₁, hn $ mem_colon.1 hrnp p₁ $ hp hp₁

theorem infi_colon_supr (ι₁ : Type w) (f : ι₁ → submodule R M)
  (ι₂ : Type x) (g : ι₂ → submodule R M) :
  (⨅ i, f i).colon (⨆ j, g j) = ⨅ i j, (f i).colon (g j) :=
le_antisymm (le_infi $ λ i, le_infi $ λ j, colon_mono (infi_le _ _) (le_supr _ _))
(λ r H, mem_colon'.2 $ supr_le $ λ j, map_le_iff_le_comap.1 $ le_infi $ λ i,
  map_le_iff_le_comap.2 $ mem_colon'.1 $ have _ := ((mem_infi _).1 H i),
  have _ := ((mem_infi _).1 this j), this)

theorem smul_mem_smul {r} {n} (hr : r ∈ I) (hn : n ∈ N) : r • n ∈ I • N :=
(le_supr _ ⟨r, hr⟩ : _ ≤ I • N) ⟨n, hn, rfl⟩

theorem smul_le {P : submodule R M} : I • N ≤ P ↔ ∀ (r ∈ I) (n ∈ N), r • n ∈ P :=
⟨λ H r hr n hn, H $ smul_mem_smul hr hn,
λ H, supr_le $ λ r, map_le_iff_le_comap.2 $ λ n hn, H r.1 r.2 n hn⟩

@[elab_as_eliminator]
theorem smul_induction_on {p : M → Prop} {x} (H : x ∈ I • N)
  (Hb : ∀ (r ∈ I) (n ∈ N), p (r • n)) (H0 : p 0)
  (H1 : ∀ x y, p x → p y → p (x + y))
  (H2 : ∀ (c:R) n, p n → p (c • n)) : p x :=
(@smul_le _ _ _ _ _ _ _ ⟨p, H0, H1, H2⟩).2 Hb H

theorem mem_smul_span_singleton {I : ideal R} {m : M} {x : M} :
  x ∈ I • span R ({m} : set M) ↔ ∃ y ∈ I, y • m = x :=
⟨λ hx, smul_induction_on hx
  (λ r hri n hnm, let ⟨s, hs⟩ := mem_span_singleton.1 hnm in ⟨r * s, I.mul_mem_right hri, hs ▸ mul_smul r s m⟩)
  ⟨0, I.zero_mem, by rw [zero_smul]⟩
  (λ m1 m2 ⟨y1, hyi1, hy1⟩ ⟨y2, hyi2, hy2⟩, ⟨y1 + y2, I.add_mem hyi1 hyi2, by rw [add_smul, hy1, hy2]⟩)
  (λ c r ⟨y, hyi, hy⟩, ⟨c * y, I.mul_mem_left hyi, by rw [mul_smul, hy]⟩),
λ ⟨y, hyi, hy⟩, hy ▸ smul_mem_smul hyi (subset_span $ set.mem_singleton m)⟩

theorem smul_le_right : I • N ≤ N :=
smul_le.2 $ λ r hr n, N.smul_mem r

theorem smul_mono (hij : I ≤ J) (hnp : N ≤ P) : I • N ≤ J • P :=
smul_le.2 $ λ r hr n hn, smul_mem_smul (hij hr) (hnp hn)

theorem smul_mono_left (h : I ≤ J) : I • N ≤ J • N :=
smul_mono h (le_refl N)

theorem smul_mono_right (h : N ≤ P) : I • N ≤ I • P :=
smul_mono (le_refl I) h

variables (I J N P)
theorem smul_bot : I • (⊥ : submodule R M) = ⊥ :=
eq_bot_iff.2 $ smul_le.2 $ λ r hri s hsb,
(submodule.mem_bot R).2 $ ((submodule.mem_bot R).1 hsb).symm ▸ smul_zero r

theorem bot_smul : (⊥ : ideal R) • N = ⊥ :=
eq_bot_iff.2 $ smul_le.2 $ λ r hrb s hsi,
(submodule.mem_bot R).2 $ ((submodule.mem_bot R).1 hrb).symm ▸ zero_smul _ s

theorem top_smul : (⊤ : ideal R) • N = N :=
le_antisymm smul_le_right $ λ r hri, one_smul R r ▸ smul_mem_smul mem_top hri

theorem smul_sup : I • (N ⊔ P) = I • N ⊔ I • P :=
le_antisymm (smul_le.2 $ λ r hri m hmnp, let ⟨n, hn, p, hp, hnpm⟩ := mem_sup.1 hmnp in
  mem_sup.2 ⟨_, smul_mem_smul hri hn, _, smul_mem_smul hri hp, hnpm ▸ (smul_add _ _ _).symm⟩)
(sup_le (smul_mono_right le_sup_left)
  (smul_mono_right le_sup_right))

theorem sup_smul : (I ⊔ J) • N = I • N ⊔ J • N :=
le_antisymm (smul_le.2 $ λ r hrij n hn, let ⟨ri, hri, rj, hrj, hrijr⟩ := mem_sup.1 hrij in
  mem_sup.2 ⟨_, smul_mem_smul hri hn, _, smul_mem_smul hrj hn, hrijr ▸ (add_smul _ _ _).symm⟩)
(sup_le (smul_mono_left le_sup_left)
  (smul_mono_left le_sup_right))

theorem smul_assoc : (I • J) • N = I • (J • N) :=
le_antisymm (smul_le.2 $ λ rs hrsij t htn,
  smul_induction_on hrsij
  (λ r hr s hs, (@smul_eq_mul R _ r s).symm ▸ smul_smul _ r s t ▸ smul_mem_smul hr (smul_mem_smul hs htn))
  ((zero_smul R t).symm ▸ submodule.zero_mem _)
  (λ x y, (add_smul x y t).symm ▸ submodule.add_mem _)
  (λ r s h, (@smul_eq_mul R _ r s).symm ▸ smul_smul _ r s t ▸ submodule.smul_mem _ _ h))
(smul_le.2 $ λ r hr sn hsn, suffices J • N ≤ submodule.comap (r • linear_map.id) ((I • J) • N), from this hsn,
smul_le.2 $ λ s hs n hn, show r • (s • n) ∈ (I • J) • N, from mul_smul r s n ▸ smul_mem_smul (smul_mem_smul hr hs) hn)

variables (S : set R) (T : set M)

theorem span_smul_span : (ideal.span S) • (span R T) =
  span R (⋃ (s ∈ S) (t ∈ T), {s • t}) :=
le_antisymm (smul_le.2 $ λ r hrS n hnT, span_induction hrS
  (λ r hrS, span_induction hnT
    (λ n hnT, subset_span $ set.mem_bUnion hrS $
      set.mem_bUnion hnT $ set.mem_singleton _)
    ((smul_zero r : r • 0 = (0:M)).symm ▸ submodule.zero_mem _)
    (λ x y, (smul_add r x y).symm ▸ submodule.add_mem _)
    (λ c m, by rw [smul_smul, mul_comm, mul_smul]; exact submodule.smul_mem _ _))
  ((zero_smul R n).symm ▸ submodule.zero_mem _)
  (λ r s, (add_smul r s n).symm ▸ submodule.add_mem _)
  (λ c r, by rw [smul_eq_mul, mul_smul]; exact submodule.smul_mem _ _)) $
span_le.2 $ set.bUnion_subset $ λ r hrS, set.bUnion_subset $ λ n hnT, set.singleton_subset_iff.2 $
smul_mem_smul (subset_span hrS) (subset_span hnT)

end submodule

namespace ideal

section chinese_remainder
variables {R : Type u} [comm_ring R] {ι : Type v}

theorem exists_sub_one_mem_and_mem (s : finset ι) {f : ι → ideal R}
  (hf : ∀ i ∈ s, ∀ j ∈ s, i ≠ j → f i ⊔ f j = ⊤) (i : ι) (his : i ∈ s) :
  ∃ r : R, r - 1 ∈ f i ∧ ∀ j ∈ s, j ≠ i → r ∈ f j :=
begin
  have : ∀ j ∈ s, j ≠ i → ∃ r : R, ∃ H : r - 1 ∈ f i, r ∈ f j,
  { intros j hjs hji, specialize hf i his j hjs hji.symm,
    rw [eq_top_iff_one, submodule.mem_sup] at hf,
    rcases hf with ⟨r, hri, s, hsj, hrs⟩, refine ⟨1 - r, _, _⟩,
    { rw [sub_right_comm, sub_self, zero_sub], exact (f i).neg_mem hri },
    { rw [← hrs, add_sub_cancel'], exact hsj } },
  classical,
  have : ∃ g : ι → R, (∀ j, g j - 1 ∈ f i) ∧ ∀ j ∈ s, j ≠ i → g j ∈ f j,
  { choose g hg1 hg2,
    refine ⟨λ j, if H : j ∈ s ∧ j ≠ i then g j H.1 H.2 else 1, λ j, _, λ j, _⟩,
    { split_ifs with h, { apply hg1 }, rw sub_self, exact (f i).zero_mem },
    { intros hjs hji, rw dif_pos, { apply hg2 }, exact ⟨hjs, hji⟩ } },
  rcases this with ⟨g, hgi, hgj⟩, use (s.erase i).prod g, split,
  { rw [← quotient.eq, quotient.mk_one, ← finset.prod_hom (quotient.mk (f i))],
    apply finset.prod_eq_one, intros, rw [← quotient.mk_one, quotient.eq], apply hgi },
  intros j hjs hji, rw [← quotient.eq_zero_iff_mem, ← finset.prod_hom (quotient.mk (f j))],
  refine finset.prod_eq_zero (finset.mem_erase_of_ne_of_mem hji hjs) _,
  rw quotient.eq_zero_iff_mem, exact hgj j hjs hji
end

theorem exists_sub_mem [fintype ι] {f : ι → ideal R}
  (hf : ∀ i j, i ≠ j → f i ⊔ f j = ⊤) (g : ι → R) :
  ∃ r : R, ∀ i, r - g i ∈ f i :=
begin
  have : ∃ φ : ι → R, (∀ i, φ i - 1 ∈ f i) ∧ (∀ i j, i ≠ j → φ i ∈ f j),
  { have := exists_sub_one_mem_and_mem (finset.univ : finset ι) (λ i _ j _ hij, hf i j hij),
    choose φ hφ, use λ i, φ i (finset.mem_univ i),
    exact ⟨λ i, (hφ i _).1, λ i j hij, (hφ i _).2 j (finset.mem_univ j) hij.symm⟩ },
  rcases this with ⟨φ, hφ1, hφ2⟩,
  use finset.univ.sum (λ i, g i * φ i),
  intros i,
  rw [← quotient.eq, ← finset.sum_hom (quotient.mk (f i))],
  refine eq.trans (finset.sum_eq_single i _ _) _,
  { intros j _ hji, rw quotient.eq_zero_iff_mem, exact (f i).mul_mem_left (hφ2 j i hji) },
  { intros hi, exact (hi $ finset.mem_univ i).elim },
  specialize hφ1 i, rw [← quotient.eq, quotient.mk_one] at hφ1,
  rw [quotient.mk_mul, hφ1, mul_one]
end

def quotient_inf_to_pi_quotient (f : ι → ideal R) :
  (⨅ i, f i).quotient → Π i, (f i).quotient :=
@@quotient.lift _ _ (⨅ i, f i) (λ r i, ideal.quotient.mk (f i) r)
  (@pi.is_ring_hom_pi ι (λ i, (f i).quotient) _ R _ _ _)
  (λ r hr, funext $ λ i, quotient.eq_zero_iff_mem.2 $ (submodule.mem_infi _).1 hr i)

theorem is_ring_hom_quotient_inf_to_pi_quotient (f : ι → ideal R) :
  is_ring_hom (quotient_inf_to_pi_quotient f) :=
@@quotient.is_ring_hom _ _ _
  (@pi.is_ring_hom_pi ι (λ i, (f i).quotient) _ R _ _ _) _

theorem bijective_quotient_inf_to_pi_quotient [fintype ι] {f : ι → ideal R}
  (hf : ∀ i j, i ≠ j → f i ⊔ f j = ⊤) :
  function.bijective (quotient_inf_to_pi_quotient f) :=
⟨λ x y, quotient.induction_on₂' x y $ λ r s hrs, quotient.eq.2 $
  (submodule.mem_infi _).2 $ λ i, quotient.eq.1 $
  show quotient_inf_to_pi_quotient f (quotient.mk' r) i = _, by rw hrs; refl,
λ g, let ⟨r, hr⟩ := exists_sub_mem hf (λ i, quotient.out' (g i)) in
⟨quotient.mk _ r, funext $ λ i, quotient.out_eq' (g i) ▸ quotient.eq.2 (hr i)⟩⟩

/-- Chinese Remainder Theorem. Eisenbud Ex.2.6. Similar to Atiyah-Macdonald 1.10 and Stacks 00DT -/
noncomputable def quotient_inf_ring_equiv_pi_quotient [fintype ι] (f : ι → ideal R)
  (hf : ∀ i j, i ≠ j → f i ⊔ f j = ⊤) :
  (⨅ i, f i).quotient ≃r Π i, (f i).quotient :=
{ hom := is_ring_hom_quotient_inf_to_pi_quotient f,
  .. equiv.of_bijective (bijective_quotient_inf_to_pi_quotient hf) }

end chinese_remainder

section mul_and_radical
variables {R : Type u} [comm_ring R]
variables {I J K L: ideal R}

instance : has_mul (ideal R) := ⟨(•)⟩

theorem mul_mem_mul {r s} (hr : r ∈ I) (hs : s ∈ J) : r * s ∈ I * J :=
submodule.smul_mem_smul hr hs

theorem mul_mem_mul_rev {r s} (hr : r ∈ I) (hs : s ∈ J) : s * r ∈ I * J :=
mul_comm r s ▸ mul_mem_mul hr hs

theorem mul_le : I * J ≤ K ↔ ∀ (r ∈ I) (s ∈ J), r * s ∈ K :=
submodule.smul_le

variables (I J K)
protected theorem mul_comm : I * J = J * I :=
le_antisymm (mul_le.2 $ λ r hrI s hsJ, mul_mem_mul_rev hsJ hrI)
(mul_le.2 $ λ r hrJ s hsI, mul_mem_mul_rev hsI hrJ)

protected theorem mul_assoc : (I * J) * K = I * (J * K) :=
submodule.smul_assoc I J K

theorem span_mul_span (S T : set R) : span S * span T =
  span ⋃ (s ∈ S) (t ∈ T), {s * t} :=
submodule.span_smul_span S T
variables {I J K}

theorem mul_le_inf : I * J ≤ I ⊓ J :=
mul_le.2 $ λ r hri s hsj, ⟨I.mul_mem_right hri, J.mul_mem_left hsj⟩

theorem mul_eq_inf_of_coprime (h : I ⊔ J = ⊤) : I * J = I ⊓ J :=
le_antisymm mul_le_inf $ λ r ⟨hri, hrj⟩,
let ⟨s, hsi, t, htj, hst⟩ := submodule.mem_sup.1 ((eq_top_iff_one _).1 h) in
mul_one r ▸ hst ▸ (mul_add r s t).symm ▸ ideal.add_mem (I * J) (mul_mem_mul_rev hsi hrj) (mul_mem_mul hri htj)

variables (I)
theorem mul_bot : I * ⊥ = ⊥ :=
submodule.smul_bot I

theorem bot_mul : ⊥ * I = ⊥ :=
submodule.bot_smul I

theorem mul_top : I * ⊤ = I :=
ideal.mul_comm ⊤ I ▸ submodule.top_smul I

theorem top_mul : ⊤ * I = I :=
submodule.top_smul I
variables {I}

theorem mul_mono (hik : I ≤ K) (hjl : J ≤ L) : I * J ≤ K * L :=
submodule.smul_mono hik hjl

theorem mul_mono_left (h : I ≤ J) : I * K ≤ J * K :=
submodule.smul_mono_left h

theorem mul_mono_right (h : J ≤ K) : I * J ≤ I * K :=
submodule.smul_mono_right h

variables (I J K)
theorem mul_sup : I * (J ⊔ K) = I * J ⊔ I * K :=
submodule.smul_sup I J K

theorem sup_mul : (I ⊔ J) * K = I * K ⊔ J * K :=
submodule.sup_smul I J K
variables {I J K}

def radical (I : ideal R) : ideal R :=
{ carrier := { r | ∃ n : ℕ, r ^ n ∈ I },
  zero := ⟨1, (pow_one (0:R)).symm ▸ I.zero_mem⟩,
  add := λ x y ⟨m, hxmi⟩ ⟨n, hyni⟩, ⟨m + n,
    (add_pow x y (m + n)).symm ▸ I.sum_mem $
    show ∀ c ∈ finset.range (nat.succ (m + n)), x ^ c * y ^ (m + n - c) * (choose (m + n) c) ∈ I,
    from λ c hc, or.cases_on (le_total c m)
      (λ hcm, I.mul_mem_right $ I.mul_mem_left $ nat.add_comm n m ▸ (nat.add_sub_assoc hcm n).symm ▸
        (pow_add y n (m-c)).symm ▸ I.mul_mem_right hyni)
      (λ hmc, I.mul_mem_right $ I.mul_mem_right $ nat.add_sub_cancel' hmc ▸
        (pow_add x m (c-m)).symm ▸ I.mul_mem_right hxmi)⟩,
  smul := λ r s ⟨n, hsni⟩, ⟨n, show (r * s)^n ∈ I,
    from (mul_pow r s n).symm ▸ I.mul_mem_left hsni⟩ }

theorem le_radical : I ≤ radical I :=
λ r hri, ⟨1, (pow_one r).symm ▸ hri⟩

variables (R)
theorem radical_top : (radical ⊤ : ideal R) = ⊤ :=
(eq_top_iff_one _).2 ⟨0, submodule.mem_top⟩
variables {R}

theorem radical_mono (H : I ≤ J) : radical I ≤ radical J :=
λ r ⟨n, hrni⟩, ⟨n, H hrni⟩

variables (I)
theorem radical_idem : radical (radical I) = radical I :=
le_antisymm (λ r ⟨n, k, hrnki⟩, ⟨n * k, (pow_mul r n k).symm ▸ hrnki⟩) le_radical
variables {I}

theorem radical_eq_top : radical I = ⊤ ↔ I = ⊤ :=
⟨λ h, (eq_top_iff_one _).2 $ let ⟨n, hn⟩ := (eq_top_iff_one _).1 h in
  @one_pow R _ n ▸ hn, λ h, h.symm ▸ radical_top R⟩

theorem is_prime.radical (H : is_prime I) : radical I = I :=
le_antisymm (λ r ⟨n, hrni⟩, H.mem_of_pow_mem n hrni) le_radical

variables (I J)
theorem radical_sup : radical (I ⊔ J) = radical (radical I ⊔ radical J) :=
le_antisymm (radical_mono $ sup_le_sup le_radical le_radical) $
λ r ⟨n, hrnij⟩, let ⟨s, hs, t, ht, hst⟩ := submodule.mem_sup.1 hrnij in
@radical_idem _ _ (I ⊔ J) ▸ ⟨n, hst ▸ ideal.add_mem _
  (radical_mono le_sup_left hs) (radical_mono le_sup_right ht)⟩

theorem radical_inf : radical (I ⊓ J) = radical I ⊓ radical J :=
le_antisymm (le_inf (radical_mono inf_le_left) (radical_mono inf_le_right))
(λ r ⟨⟨m, hrm⟩, ⟨n, hrn⟩⟩, ⟨m + n, (pow_add r m n).symm ▸ I.mul_mem_right hrm,
(pow_add r m n).symm ▸ J.mul_mem_left hrn⟩)

theorem radical_mul : radical (I * J) = radical I ⊓ radical J :=
le_antisymm (radical_inf I J ▸ radical_mono $ @mul_le_inf _ _ I J)
(λ r ⟨⟨m, hrm⟩, ⟨n, hrn⟩⟩, ⟨m + n, (pow_add r m n).symm ▸ mul_mem_mul hrm hrn⟩)
variables {I J}

theorem is_prime.radical_le_iff (hj : is_prime J) :
  radical I ≤ J ↔ I ≤ J :=
⟨le_trans le_radical, λ hij r ⟨n, hrni⟩, hj.mem_of_pow_mem n $ hij hrni⟩

theorem radical_eq_Inf (I : ideal R) :
  radical I = Inf { J : ideal R | I ≤ J ∧ is_prime J } :=
le_antisymm (le_Inf $ λ J hJ, hJ.2.radical_le_iff.2 hJ.1) $
λ r hr, classical.by_contradiction $ λ hri,
let ⟨m, (hrm : r ∉ radical m), him, hm⟩ := zorn.zorn_partial_order₀ {K : ideal R | r ∉ radical K}
  (λ c hc hcc y hyc, ⟨Sup c, λ ⟨n, hrnc⟩, let ⟨y, hyc, hrny⟩ :=
      submodule.mem_Sup_of_directed hrnc y hyc hcc.directed_on in hc hyc ⟨n, hrny⟩,
    λ z, le_Sup⟩) I hri in
have ∀ x ∉ m, r ∈ radical (m ⊔ span {x}) := λ x hxm, classical.by_contradiction $ λ hrmx, hxm $
  hm (m ⊔ span {x}) hrmx le_sup_left ▸ (le_sup_right : _ ≤ m ⊔ span {x}) (subset_span $ set.mem_singleton _),
have is_prime m, from ⟨by rintro rfl; rw radical_top at hrm; exact hrm trivial,
  λ x y hxym, classical.or_iff_not_imp_left.2 $ λ hxm, classical.by_contradiction $ λ hym,
  let ⟨n, hrn⟩ := this _ hxm, ⟨p, hpm, q, hq, hpqrn⟩ := submodule.mem_sup.1 hrn, ⟨c, hcxq⟩ := mem_span_singleton'.1 hq in
  let ⟨k, hrk⟩ := this _ hym, ⟨f, hfm, g, hg, hfgrk⟩ := submodule.mem_sup.1 hrk, ⟨d, hdyg⟩ := mem_span_singleton'.1 hg in
  hrm ⟨n + k, by rw [pow_add, ← hpqrn, ← hcxq, ← hfgrk, ← hdyg, add_mul, mul_add (c*x), mul_assoc c x (d*y), mul_left_comm x, ← mul_assoc];
    refine m.add_mem (m.mul_mem_right hpm) (m.add_mem (m.mul_mem_left hfm) (m.mul_mem_left hxym))⟩⟩,
hrm $ this.radical.symm ▸ (Inf_le ⟨him, this⟩ : Inf {J : ideal R | I ≤ J ∧ is_prime J} ≤ m) hr

instance : comm_semiring (ideal R) :=
{ mul := (*),
  mul_assoc := ideal.mul_assoc,
  zero_mul := bot_mul,
  mul_zero := mul_bot,
  one := ⊤,
  one_mul := top_mul,
  mul_one := mul_top,
  left_distrib := mul_sup,
  right_distrib := sup_mul,
  mul_comm := ideal.mul_comm,
  .. submodule.add_comm_monoid }

@[simp] lemma add_eq_sup : I + J = I ⊔ J := rfl
@[simp] lemma zero_eq_bot : (0 : ideal R) = ⊥ := rfl
@[simp] lemma one_eq_top : (1 : ideal R) = ⊤ := rfl

variables (I)
theorem radical_pow (n : ℕ) (H : n > 0) : radical (I^n) = radical I :=
nat.rec_on n (not.elim dec_trivial) (λ n ih H,
or.cases_on (lt_or_eq_of_le $ nat.le_of_lt_succ H)
  (λ H, calc radical (I^(n+1))
           = radical I ⊓ radical (I^n) : radical_mul _ _
       ... = radical I ⊓ radical I : by rw ih H
       ... = radical I : inf_idem)
  (λ H, H ▸ (pow_one I).symm ▸ rfl)) H

end mul_and_radical

section map_and_comap
variables {R : Type u} {S : Type v} [comm_ring R] [comm_ring S]
variables (f : R → S) [is_ring_hom f]
variables {I J : ideal R} {K L : ideal S}

def map (I : ideal R) : ideal S :=
span (f '' I)

def comap (I : ideal S) : ideal R :=
{ carrier := f ⁻¹' I,
  zero := show f 0 ∈ I, by rw is_ring_hom.map_zero f; exact I.zero_mem,
  add := λ x y hx hy, show f (x + y) ∈ I, by rw is_ring_hom.map_add f; exact I.add_mem hx hy,
  smul := λ c x hx, show f (c * x) ∈ I, by rw is_ring_hom.map_mul f; exact I.mul_mem_left hx }

variables {f}
theorem map_mono (h : I ≤ J) : map f I ≤ map f J :=
span_mono $ set.image_subset _ h

theorem mem_map_of_mem {x} (h : x ∈ I) : f x ∈ map f I :=
subset_span ⟨x, h, rfl⟩

theorem map_le_iff_le_comap :
  map f I ≤ K ↔ I ≤ comap f K :=
span_le.trans set.image_subset_iff

@[simp] theorem mem_comap {x} : x ∈ comap f K ↔ f x ∈ K := iff.rfl

theorem comap_mono (h : K ≤ L) : comap f K ≤ comap f L :=
set.preimage_mono h
variables (f)

theorem comap_ne_top (hK : K ≠ ⊤) : comap f K ≠ ⊤ :=
(ne_top_iff_one _).2 $ by rw [mem_comap, is_ring_hom.map_one f];
  exact (ne_top_iff_one _).1 hK

instance is_prime.comap {hK : K.is_prime} : (comap f K).is_prime :=
⟨comap_ne_top _ hK.1, λ x y,
  by simp only [mem_comap, is_ring_hom.map_mul f]; apply hK.2⟩

variables (I J K L)
theorem map_bot : map f ⊥ = ⊥ :=
le_antisymm (map_le_iff_le_comap.2 bot_le) bot_le

theorem map_top : map f ⊤ = ⊤ :=
(eq_top_iff_one _).2 $ subset_span ⟨1, trivial, is_ring_hom.map_one f⟩

theorem comap_top : comap f ⊤ = ⊤ :=
(eq_top_iff_one _).2 trivial

theorem map_sup : map f (I ⊔ J) = map f I ⊔ map f J :=
le_antisymm (map_le_iff_le_comap.2 $ sup_le
  (map_le_iff_le_comap.1 le_sup_left)
  (map_le_iff_le_comap.1 le_sup_right))
(sup_le (map_mono le_sup_left) (map_mono le_sup_right))

theorem map_mul : map f (I * J) = map f I * map f J :=
le_antisymm (map_le_iff_le_comap.2 $ mul_le.2 $ λ r hri s hsj,
  show f (r * s) ∈ _, by rw is_ring_hom.map_mul f;
  exact mul_mem_mul (mem_map_of_mem hri) (mem_map_of_mem hsj))
(trans_rel_right _ (span_mul_span _ _) $ span_le.2 $
  set.bUnion_subset $ λ i ⟨r, hri, hfri⟩,
  set.bUnion_subset $ λ j ⟨s, hsj, hfsj⟩,
  set.singleton_subset_iff.2 $ hfri ▸ hfsj ▸
  by rw [← is_ring_hom.map_mul f];
  exact mem_map_of_mem (mul_mem_mul hri hsj))

theorem comap_inf : comap f (K ⊓ L) = comap f K ⊓ comap f L := rfl

theorem comap_radical : comap f (radical K) = radical (comap f K) :=
le_antisymm (λ r ⟨n, hfrnk⟩, ⟨n, show f (r ^ n) ∈ K,
  from (is_semiring_hom.map_pow f r n).symm ▸ hfrnk⟩)
(λ r ⟨n, hfrnk⟩, ⟨n, is_semiring_hom.map_pow f r n ▸ hfrnk⟩)
variables {I J K L}

theorem map_inf_le : map f (I ⊓ J) ≤ map f I ⊓ map f J :=
map_le_iff_le_comap.2 $ (comap_inf f (map f I) (map f J)).symm ▸
inf_le_inf (map_le_iff_le_comap.1 $ le_refl _) (map_le_iff_le_comap.1 $ le_refl _)

theorem map_radical_le : map f (radical I) ≤ radical (map f I) :=
map_le_iff_le_comap.2 $ λ r ⟨n, hrni⟩, ⟨n, is_semiring_hom.map_pow f r n ▸ mem_map_of_mem hrni⟩

theorem le_comap_sup : comap f K ⊔ comap f L ≤ comap f (K ⊔ L) :=
map_le_iff_le_comap.1 $ (map_sup f (comap f K) (comap f L)).symm ▸
sup_le_sup (map_le_iff_le_comap.2 $ le_refl _) (map_le_iff_le_comap.2 $ le_refl _)

theorem le_comap_mul : comap f K * comap f L ≤ comap f (K * L) :=
map_le_iff_le_comap.1 $ (map_mul f (comap f K) (comap f L)).symm ▸
mul_mono (map_le_iff_le_comap.2 $ le_refl _) (map_le_iff_le_comap.2 $ le_refl _)

section surjective
variables (hf : function.surjective f)
include hf

theorem map_comap_of_surjective (I : ideal S) :
  map f (comap f I) = I :=
le_antisymm (map_le_iff_le_comap.2 (le_refl _))
(λ s hsi, let ⟨r, hfrs⟩ := hf s in
  hfrs ▸ (mem_map_of_mem $ show f r ∈ I, from hfrs.symm ▸ hsi))

theorem mem_image_of_mem_map_of_surjective {I : ideal R} {y}
  (H : y ∈ map f I) : y ∈ f '' I :=
submodule.span_induction H (λ _, id) ⟨0, I.zero_mem, is_ring_hom.map_zero f⟩
(λ y1 y2 ⟨x1, hx1i, hxy1⟩ ⟨x2, hx2i, hxy2⟩, ⟨x1 + x2, I.add_mem hx1i hx2i, hxy1 ▸ hxy2 ▸ is_ring_hom.map_add f⟩)
(λ c y ⟨x, hxi, hxy⟩, let ⟨d, hdc⟩ := hf c in ⟨d • x, I.smul_mem _ hxi, hdc ▸ hxy ▸ is_ring_hom.map_mul f⟩)

theorem comap_map_of_surjective (I : ideal R) :
  comap f (map f I) = I ⊔ comap f ⊥ :=
le_antisymm (assume r h, let ⟨s, hsi, hfsr⟩ := mem_image_of_mem_map_of_surjective f hf h in
  submodule.mem_sup.2 ⟨s, hsi, r - s, (submodule.mem_bot S).2 $ by rw [is_ring_hom.map_sub f, hfsr, sub_self],
  add_sub_cancel'_right s r⟩)
(sup_le (map_le_iff_le_comap.1 (le_refl _)) (comap_mono bot_le))

/-- Correspondence theorem -/
def order_iso_of_surjective :
  ((≤) : ideal S → ideal S → Prop) ≃o
  ((≤) : { p : ideal R // comap f ⊥ ≤ p } → { p : ideal R // comap f ⊥ ≤ p } → Prop) :=
{ to_fun := λ J, ⟨comap f J, comap_mono bot_le⟩,
  inv_fun := λ I, map f I.1,
  left_inv := λ J, map_comap_of_surjective f hf J,
  right_inv := λ I, subtype.eq $ show comap f (map f I.1) = I.1,
    from (comap_map_of_surjective f hf I).symm ▸ le_antisymm
      (sup_le (le_refl _) I.2) le_sup_left,
  ord := λ I1 I2, ⟨comap_mono, λ H, map_comap_of_surjective f hf I1 ▸
    map_comap_of_surjective f hf I2 ▸ map_mono H⟩ }

def le_order_embedding_of_surjective :
  ((≤) : ideal S → ideal S → Prop) ≼o ((≤) : ideal R → ideal R → Prop) :=
(order_iso_of_surjective f hf).to_order_embedding.trans (subtype.order_embedding _ _)

def lt_order_embedding_of_surjective :
  ((<) : ideal S → ideal S → Prop) ≼o ((<) : ideal R → ideal R → Prop) :=
(le_order_embedding_of_surjective f hf).lt_embedding_of_le_embedding

end surjective

end map_and_comap

end ideal

namespace submodule

variables {R : Type u} {M : Type v}
variables [comm_ring R] [add_comm_group M] [module R M]
variables (I J : ideal R) (N P : submodule R M)

instance : semimodule (ideal R) (submodule R M) :=
{ smul_add := smul_sup,
  add_smul := sup_smul,
  mul_smul := smul_assoc,
  one_smul := top_smul,
  zero_smul := bot_smul,
  smul_zero := smul_bot }

end submodule