/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import algebra.invertible
import algebra.indicator_function
import linear_algebra.affine_space.affine_map
import linear_algebra.affine_space.affine_subspace
import linear_algebra.finsupp
import tactic.fin_cases

/-!
# Affine combinations of points

This file defines affine combinations of points.

## Main definitions

* `weighted_vsub_of_point` is a general weighted combination of
  subtractions with an explicit base point, yielding a vector.

* `weighted_vsub` uses an arbitrary choice of base point and is intended
  to be used when the sum of weights is 0, in which case the result is
  independent of the choice of base point.

* `affine_combination` adds the weighted combination to the arbitrary
  base point, yielding a point rather than a vector, and is intended
  to be used when the sum of weights is 1, in which case the result is
  independent of the choice of base point.

These definitions are for sums over a `finset`; versions for a
`fintype` may be obtained using `finset.univ`, while versions for a
`finsupp` may be obtained using `finsupp.support`.

## References

* https://en.wikipedia.org/wiki/Affine_space

-/

noncomputable theory
open_locale big_operators classical affine

namespace finset

lemma univ_fin2 : (univ : finset (fin 2)) = {0, 1} :=
by { ext x, fin_cases x; simp }

variables {k : Type*} {V : Type*} {P : Type*} [ring k] [add_comm_group V] [module k V]
variables [S : affine_space V P]
include S

variables {ι : Type*} (s : finset ι)
variables {ι₂ : Type*} (s₂ : finset ι₂)

/-- A weighted sum of the results of subtracting a base point from the
given points, as a linear map on the weights.  The main cases of
interest are where the sum of the weights is 0, in which case the sum
is independent of the choice of base point, and where the sum of the
weights is 1, in which case the sum added to the base point is
independent of the choice of base point. -/
def weighted_vsub_of_point (p : ι → P) (b : P) : (ι → k) →ₗ[k] V :=
∑ i in s, (linear_map.proj i : (ι → k) →ₗ[k] k).smul_right (p i -ᵥ b)

@[simp] lemma weighted_vsub_of_point_apply (w : ι → k) (p : ι → P) (b : P) :
  s.weighted_vsub_of_point p b w = ∑ i in s, w i • (p i -ᵥ b) :=
by simp [weighted_vsub_of_point, linear_map.sum_apply]

/-- Given a family of points, if we use a member of the family as a base point, the
`weighted_vsub_of_point` does not depend on the value of the weights at this point. -/
lemma weighted_vsub_of_point_eq_of_weights_eq
  (p : ι → P) (j : ι) (w₁ w₂ : ι → k) (hw : ∀ i, i ≠ j → w₁ i = w₂ i) :
  s.weighted_vsub_of_point p (p j) w₁ = s.weighted_vsub_of_point p (p j) w₂ :=
begin
  simp only [finset.weighted_vsub_of_point_apply],
  congr,
  ext i,
  cases eq_or_ne i j with h h,
  { simp [h], },
  { simp [hw i h], },
end

/-- The weighted sum is independent of the base point when the sum of
the weights is 0. -/
lemma weighted_vsub_of_point_eq_of_sum_eq_zero (w : ι → k) (p : ι → P) (h : ∑ i in s, w i = 0)
    (b₁ b₂ : P) : s.weighted_vsub_of_point p b₁ w = s.weighted_vsub_of_point p b₂ w :=
begin
  apply eq_of_sub_eq_zero,
  rw [weighted_vsub_of_point_apply, weighted_vsub_of_point_apply, ←sum_sub_distrib],
  conv_lhs
  { congr,
    skip,
    funext,
    rw [←smul_sub, vsub_sub_vsub_cancel_left] },
  rw [←sum_smul, h, zero_smul]
end

/-- The weighted sum, added to the base point, is independent of the
base point when the sum of the weights is 1. -/
lemma weighted_vsub_of_point_vadd_eq_of_sum_eq_one (w : ι → k) (p : ι → P) (h : ∑ i in s, w i = 1)
    (b₁ b₂ : P) :
  s.weighted_vsub_of_point p b₁ w +ᵥ b₁ = s.weighted_vsub_of_point p b₂ w +ᵥ b₂ :=
begin
  erw [weighted_vsub_of_point_apply, weighted_vsub_of_point_apply, ←@vsub_eq_zero_iff_eq V,
       vadd_vsub_assoc, vsub_vadd_eq_vsub_sub, ←add_sub_assoc, add_comm, add_sub_assoc,
       ←sum_sub_distrib],
  conv_lhs
  { congr,
    skip,
    congr,
    skip,
    funext,
    rw [←smul_sub, vsub_sub_vsub_cancel_left] },
  rw [←sum_smul, h, one_smul, vsub_add_vsub_cancel, vsub_self]
end

/-- The weighted sum is unaffected by removing the base point, if
present, from the set of points. -/
@[simp] lemma weighted_vsub_of_point_erase (w : ι → k) (p : ι → P) (i : ι) :
  (s.erase i).weighted_vsub_of_point p (p i) w = s.weighted_vsub_of_point p (p i) w :=
begin
  rw [weighted_vsub_of_point_apply, weighted_vsub_of_point_apply],
  apply sum_erase,
  rw [vsub_self, smul_zero]
end

/-- The weighted sum is unaffected by adding the base point, whether
or not present, to the set of points. -/
@[simp] lemma weighted_vsub_of_point_insert [decidable_eq ι] (w : ι → k) (p : ι → P) (i : ι) :
  (insert i s).weighted_vsub_of_point p (p i) w = s.weighted_vsub_of_point p (p i) w :=
begin
  rw [weighted_vsub_of_point_apply, weighted_vsub_of_point_apply],
  apply sum_insert_zero,
  rw [vsub_self, smul_zero]
end

/-- The weighted sum is unaffected by changing the weights to the
corresponding indicator function and adding points to the set. -/
lemma weighted_vsub_of_point_indicator_subset (w : ι → k) (p : ι → P) (b : P) {s₁ s₂ : finset ι}
    (h : s₁ ⊆ s₂) :
  s₁.weighted_vsub_of_point p b w = s₂.weighted_vsub_of_point p b (set.indicator ↑s₁ w) :=
begin
  rw [weighted_vsub_of_point_apply, weighted_vsub_of_point_apply],
  exact set.sum_indicator_subset_of_eq_zero w (λ i wi, wi • (p i -ᵥ b : V)) h (λ i, zero_smul k _)
end

/-- A weighted sum, over the image of an embedding, equals a weighted
sum with the same points and weights over the original
`finset`. -/
lemma weighted_vsub_of_point_map (e : ι₂ ↪ ι) (w : ι → k) (p : ι → P) (b : P) :
  (s₂.map e).weighted_vsub_of_point p b w = s₂.weighted_vsub_of_point (p ∘ e) b (w ∘ e) :=
begin
  simp_rw [weighted_vsub_of_point_apply],
  exact finset.sum_map _ _ _
end

/-- A weighted sum of the results of subtracting a default base point
from the given points, as a linear map on the weights.  This is
intended to be used when the sum of the weights is 0; that condition
is specified as a hypothesis on those lemmas that require it. -/
def weighted_vsub (p : ι → P) : (ι → k) →ₗ[k] V :=
s.weighted_vsub_of_point p (classical.choice S.nonempty)

/-- Applying `weighted_vsub` with given weights.  This is for the case
where a result involving a default base point is OK (for example, when
that base point will cancel out later); a more typical use case for
`weighted_vsub` would involve selecting a preferred base point with
`weighted_vsub_eq_weighted_vsub_of_point_of_sum_eq_zero` and then
using `weighted_vsub_of_point_apply`. -/
lemma weighted_vsub_apply (w : ι → k) (p : ι → P) :
  s.weighted_vsub p w = ∑ i in s, w i • (p i -ᵥ (classical.choice S.nonempty)) :=
by simp [weighted_vsub, linear_map.sum_apply]

/-- `weighted_vsub` gives the sum of the results of subtracting any
base point, when the sum of the weights is 0. -/
lemma weighted_vsub_eq_weighted_vsub_of_point_of_sum_eq_zero (w : ι → k) (p : ι → P)
    (h : ∑ i in s, w i = 0) (b : P) : s.weighted_vsub p w = s.weighted_vsub_of_point p b w :=
s.weighted_vsub_of_point_eq_of_sum_eq_zero w p h _ _

/-- The `weighted_vsub` for an empty set is 0. -/
@[simp] lemma weighted_vsub_empty (w : ι → k) (p : ι → P) :
  (∅ : finset ι).weighted_vsub p w = (0:V) :=
by simp [weighted_vsub_apply]

/-- The weighted sum is unaffected by changing the weights to the
corresponding indicator function and adding points to the set. -/
lemma weighted_vsub_indicator_subset (w : ι → k) (p : ι → P) {s₁ s₂ : finset ι} (h : s₁ ⊆ s₂) :
  s₁.weighted_vsub p w = s₂.weighted_vsub p (set.indicator ↑s₁ w) :=
weighted_vsub_of_point_indicator_subset _ _ _ h

/-- A weighted subtraction, over the image of an embedding, equals a
weighted subtraction with the same points and weights over the
original `finset`. -/
lemma weighted_vsub_map (e : ι₂ ↪ ι) (w : ι → k) (p : ι → P) :
  (s₂.map e).weighted_vsub p w = s₂.weighted_vsub (p ∘ e) (w ∘ e) :=
s₂.weighted_vsub_of_point_map _ _ _ _

/-- A weighted sum of the results of subtracting a default base point
from the given points, added to that base point, as an affine map on
the weights.  This is intended to be used when the sum of the weights
is 1, in which case it is an affine combination (barycenter) of the
points with the given weights; that condition is specified as a
hypothesis on those lemmas that require it. -/
def affine_combination (p : ι → P) : (ι → k) →ᵃ[k] P :=
{ to_fun := λ w,
    s.weighted_vsub_of_point p (classical.choice S.nonempty) w +ᵥ (classical.choice S.nonempty),
  linear := s.weighted_vsub p,
  map_vadd' := λ w₁ w₂, by simp_rw [vadd_vadd, weighted_vsub, vadd_eq_add, linear_map.map_add] }

/-- The linear map corresponding to `affine_combination` is
`weighted_vsub`. -/
@[simp] lemma affine_combination_linear (p : ι → P) :
  (s.affine_combination p : (ι → k) →ᵃ[k] P).linear = s.weighted_vsub p :=
rfl

/-- Applying `affine_combination` with given weights.  This is for the
case where a result involving a default base point is OK (for example,
when that base point will cancel out later); a more typical use case
for `affine_combination` would involve selecting a preferred base
point with
`affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one` and
then using `weighted_vsub_of_point_apply`. -/
lemma affine_combination_apply (w : ι → k) (p : ι → P) :
  s.affine_combination p w =
    s.weighted_vsub_of_point p (classical.choice S.nonempty) w +ᵥ (classical.choice S.nonempty) :=
rfl

/-- `affine_combination` gives the sum with any base point, when the
sum of the weights is 1. -/
lemma affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one (w : ι → k) (p : ι → P)
    (h : ∑ i in s, w i = 1) (b : P) :
  s.affine_combination p w = s.weighted_vsub_of_point p b w +ᵥ b :=
s.weighted_vsub_of_point_vadd_eq_of_sum_eq_one w p h _ _

/-- Adding a `weighted_vsub` to an `affine_combination`. -/
lemma weighted_vsub_vadd_affine_combination (w₁ w₂ : ι → k) (p : ι → P) :
  s.weighted_vsub p w₁ +ᵥ s.affine_combination p w₂ = s.affine_combination p (w₁ + w₂) :=
by rw [←vadd_eq_add, affine_map.map_vadd, affine_combination_linear]

/-- Subtracting two `affine_combination`s. -/
lemma affine_combination_vsub (w₁ w₂ : ι → k) (p : ι → P) :
  s.affine_combination p w₁ -ᵥ s.affine_combination p w₂ = s.weighted_vsub p (w₁ - w₂) :=
by rw [←affine_map.linear_map_vsub, affine_combination_linear, vsub_eq_sub]

lemma attach_affine_combination_of_injective
  (s : finset P) (w : P → k) (f : s → P) (hf : function.injective f) :
  s.attach.affine_combination f (w ∘ f) = (image f univ).affine_combination id w :=
begin
  simp only [affine_combination, weighted_vsub_of_point_apply, id.def, vadd_right_cancel_iff,
    function.comp_app, affine_map.coe_mk],
  let g₁ : s → V := λ i, w (f i) • (f i -ᵥ classical.choice S.nonempty),
  let g₂ : P → V := λ i, w i • (i -ᵥ classical.choice S.nonempty),
  change univ.sum g₁ = (image f univ).sum g₂,
  have hgf : g₁ = g₂ ∘ f, { ext, simp, },
  rw [hgf, sum_image],
  exact λ _ _ _ _ hxy, hf hxy,
end

lemma attach_affine_combination_coe (s : finset P) (w : P → k) :
  s.attach.affine_combination (coe : s → P) (w ∘ coe) = s.affine_combination id w :=
by rw [attach_affine_combination_of_injective s w (coe : s → P) subtype.coe_injective,
  univ_eq_attach, attach_image_coe]

omit S

/-- Viewing a module as an affine space modelled on itself, affine combinations are just linear
combinations. -/
@[simp] lemma affine_combination_eq_linear_combination (s : finset ι) (p : ι → V) (w : ι → k)
  (hw : ∑ i in s, w i = 1) :
  s.affine_combination p w = ∑ i in s, w i • p i :=
by simp [s.affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one w p hw 0]

include S

/-- An `affine_combination` equals a point if that point is in the set
and has weight 1 and the other points in the set have weight 0. -/
@[simp]

/-- An affine combination is unaffected by changing the weights to the
corresponding indicator function and adding points to the set. -/
lemma affine_combination_indicator_subset (w : ι → k) (p : ι → P) {s₁ s₂ : finset ι}
    (h : s₁ ⊆ s₂) :
  s₁.affine_combination p w = s₂.affine_combination p (set.indicator ↑s₁ w) :=
by rw [affine_combination_apply, affine_combination_apply,
       weighted_vsub_of_point_indicator_subset _ _ _ h]

/-- An affine combination, over the image of an embedding, equals an
affine combination with the same points and weights over the original
`finset`. -/
lemma affine_combination_map (e : ι₂ ↪ ι) (w : ι → k) (p : ι → P) :
  (s₂.map e).affine_combination p w = s₂.affine_combination (p ∘ e) (w ∘ e) :=
by simp_rw [affine_combination_apply, weighted_vsub_of_point_map]

variables {V}

/-- Suppose an indexed family of points is given, along with a subset
of the index type.  A vector can be expressed as
`weighted_vsub_of_point` using a `finset` lying within that subset and
with a given sum of weights if and only if it can be expressed as
`weighted_vsub_of_point` with that sum of weights for the
corresponding indexed family whose index type is the subtype
corresponding to that subset. -/
lemma eq_weighted_vsub_of_point_subset_iff_eq_weighted_vsub_of_point_subtype {v : V} {x : k}
    {s : set ι} {p : ι → P} {b : P} :
  (∃ (fs : finset ι) (hfs : ↑fs ⊆ s) (w : ι → k) (hw : ∑ i in fs, w i = x),
    v = fs.weighted_vsub_of_point p b w) ↔
  ∃ (fs : finset s) (w : s → k) (hw : ∑ i in fs, w i = x),
    v = fs.weighted_vsub_of_point (λ (i : s), p i) b w :=
begin
  simp_rw weighted_vsub_of_point_apply,
  split,
  { rintros ⟨fs, hfs, w, rfl, rfl⟩,
    use [fs.subtype s, λ i, w i, sum_subtype_of_mem _ hfs, (sum_subtype_of_mem _ hfs).symm] },
  { rintros ⟨fs, w, rfl, rfl⟩,
    refine ⟨fs.map (function.embedding.subtype _), map_subtype_subset _,
         λ i, if h : i ∈ s then w ⟨i, h⟩ else 0, _, _⟩;
      simp }
end

variables (k)

/-- Suppose an indexed family of points is given, along with a subset
of the index type.  A vector can be expressed as `weighted_vsub` using
a `finset` lying within that subset and with sum of weights 0 if and
only if it can be expressed as `weighted_vsub` with sum of weights 0
for the corresponding indexed family whose index type is the subtype
corresponding to that subset. -/
lemma eq_weighted_vsub_subset_iff_eq_weighted_vsub_subtype {v : V} {s : set ι} {p : ι → P} :
  (∃ (fs : finset ι) (hfs : ↑fs ⊆ s) (w : ι → k) (hw : ∑ i in fs, w i = 0),
    v = fs.weighted_vsub p w) ↔
  ∃ (fs : finset s) (w : s → k) (hw : ∑ i in fs, w i = 0),
    v = fs.weighted_vsub (λ (i : s), p i) w :=
eq_weighted_vsub_of_point_subset_iff_eq_weighted_vsub_of_point_subtype

variables (V)

/-- Suppose an indexed family of points is given, along with a subset
of the index type.  A point can be expressed as an
`affine_combination` using a `finset` lying within that subset and
with sum of weights 1 if and only if it can be expressed an
`affine_combination` with sum of weights 1 for the corresponding
indexed family whose index type is the subtype corresponding to that
subset. -/
lemma eq_affine_combination_subset_iff_eq_affine_combination_subtype {p0 : P} {s : set ι}
    {p : ι → P} :
  (∃ (fs : finset ι) (hfs : ↑fs ⊆ s) (w : ι → k) (hw : ∑ i in fs, w i = 1),
    p0 = fs.affine_combination p w) ↔
  ∃ (fs : finset s) (w : s → k) (hw : ∑ i in fs, w i = 1),
    p0 = fs.affine_combination (λ (i : s), p i) w :=
begin
  simp_rw [affine_combination_apply, eq_vadd_iff_vsub_eq],
  exact eq_weighted_vsub_of_point_subset_iff_eq_weighted_vsub_of_point_subtype
end

variables {k V}

/-- Affine maps commute with affine combinations. -/
lemma map_affine_combination {V₂ P₂ : Type*} [add_comm_group V₂] [module k V₂] [affine_space V₂ P₂]
  (p : ι → P) (w : ι → k) (hw : s.sum w = 1) (f : P →ᵃ[k] P₂) :
  f (s.affine_combination p w) = s.affine_combination (f ∘ p) w :=
begin
  have b := classical.choice (infer_instance : affine_space V P).nonempty,
  have b₂ := classical.choice (infer_instance : affine_space V₂ P₂).nonempty,
  rw [s.affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one w p hw b,
      s.affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one w (f ∘ p) hw b₂,
      ← s.weighted_vsub_of_point_vadd_eq_of_sum_eq_one w (f ∘ p) hw (f b) b₂],
  simp only [weighted_vsub_of_point_apply, ring_hom.id_apply, affine_map.map_vadd,
    linear_map.map_smulₛₗ, affine_map.linear_map_vsub, linear_map.map_sum],
end

end finset

namespace finset

variables (k : Type*) {V : Type*} {P : Type*} [division_ring k] [add_comm_group V] [module k V]
variables [affine_space V P] {ι : Type*} (s : finset ι) {ι₂ : Type*} (s₂ : finset ι₂)

/-- The weights for the centroid of some points. -/
def centroid_weights : ι → k := function.const ι (card s : k) ⁻¹

/-- `centroid_weights` at any point. -/
@[simp] lemma centroid_weights_apply (i : ι) : s.centroid_weights k i = (card s : k) ⁻¹ :=
rfl

/-- `centroid_weights` equals a constant function. -/
lemma centroid_weights_eq_const :
  s.centroid_weights k = function.const ι ((card s : k) ⁻¹) :=
rfl

variables {k}

/-- The weights in the centroid sum to 1, if the number of points,
converted to `k`, is not zero. -/
lemma sum_centroid_weights_eq_one_of_cast_card_ne_zero (h : (card s : k) ≠ 0) :
  ∑ i in s, s.centroid_weights k i = 1 :=
by simp [h]

variables (k)

/-- In the characteristic zero case, the weights in the centroid sum
to 1 if the number of points is not zero. -/
lemma sum_centroid_weights_eq_one_of_card_ne_zero [char_zero k] (h : card s ≠ 0) :
  ∑ i in s, s.centroid_weights k i = 1 :=
by simp [h]

/-- In the characteristic zero case, the weights in the centroid sum
to 1 if the set is nonempty. -/
lemma sum_centroid_weights_eq_one_of_nonempty [char_zero k] (h : s.nonempty) :
  ∑ i in s, s.centroid_weights k i = 1 :=
s.sum_centroid_weights_eq_one_of_card_ne_zero k (ne_of_gt (card_pos.2 h))

/-- In the characteristic zero case, the weights in the centroid sum
to 1 if the number of points is `n + 1`. -/
lemma sum_centroid_weights_eq_one_of_card_eq_add_one [char_zero k] {n : ℕ}
  (h : card s = n + 1) : ∑ i in s, s.centroid_weights k i = 1 :=
s.sum_centroid_weights_eq_one_of_card_ne_zero k (h.symm ▸ nat.succ_ne_zero n)

include V

/-- The centroid of some points.  Although defined for any `s`, this
is intended to be used in the case where the number of points,
converted to `k`, is not zero. -/
def centroid (p : ι → P) : P :=
s.affine_combination p (s.centroid_weights k)

/-- The definition of the centroid. -/
lemma centroid_def (p : ι → P) :
  s.centroid k p = s.affine_combination p (s.centroid_weights k) :=
rfl

lemma centroid_univ (s : finset P) :
  univ.centroid k (coe : s → P) = s.centroid k id :=
by { rw [centroid, centroid, ← s.attach_affine_combination_coe], congr, ext, simp, }

/-- The centroid of a single point. -/
@[simp] lemma centroid_singleton (p : ι → P) (i : ι) :
  ({i} : finset ι).centroid k p = p i :=
by simp [centroid_def, affine_combination_apply]

/-- The centroid of two points, expressed directly as adding a vector
to a point. -/
lemma centroid_insert_singleton [invertible (2 : k)] (p : ι → P) (i₁ i₂ : ι) :
  ({i₁, i₂} : finset ι).centroid k p = (2 ⁻¹ : k) • (p i₂ -ᵥ p i₁) +ᵥ p i₁ :=
begin
  by_cases h : i₁ = i₂,
  { simp [h] },
  { have hc : (card ({i₁, i₂} : finset ι) : k) ≠ 0,
    { rw [card_insert_of_not_mem (not_mem_singleton.2 h), card_singleton],
      norm_num,
      exact nonzero_of_invertible _ },
    rw [centroid_def,
        affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one _ _ _
          (sum_centroid_weights_eq_one_of_cast_card_ne_zero _ hc) (p i₁)],
    simp [h],
    norm_num }
end

/-- The centroid of two points indexed by `fin 2`, expressed directly
as adding a vector to the first point. -/
lemma centroid_insert_singleton_fin [invertible (2 : k)] (p : fin 2 → P) :
  univ.centroid k p = (2 ⁻¹ : k) • (p 1 -ᵥ p 0) +ᵥ p 0 :=
begin
  rw univ_fin2,
  convert centroid_insert_singleton k p 0 1
end

/-- A centroid, over the image of an embedding, equals a centroid with
the same points and weights over the original `finset`. -/
lemma centroid_map (e : ι₂ ↪ ι) (p : ι → P) : (s₂.map e).centroid k p = s₂.centroid k (p ∘ e) :=
by simp [centroid_def, affine_combination_map, centroid_weights]

omit V

/-- `centroid_weights` gives the weights for the centroid as a
constant function, which is suitable when summing over the points
whose centroid is being taken.  This function gives the weights in a
form suitable for summing over a larger set of points, as an indicator
function that is zero outside the set whose centroid is being taken.
In the case of a `fintype`, the sum may be over `univ`. -/
def centroid_weights_indicator : ι → k := set.indicator ↑s (s.centroid_weights k)

/-- The definition of `centroid_weights_indicator`. -/
lemma centroid_weights_indicator_def :
  s.centroid_weights_indicator k = set.indicator ↑s (s.centroid_weights k) :=
rfl

/-- The sum of the weights for the centroid indexed by a `fintype`. -/
lemma sum_centroid_weights_indicator [fintype ι] :
  ∑ i, s.centroid_weights_indicator k i = ∑ i in s, s.centroid_weights k i :=
(set.sum_indicator_subset _ (subset_univ _)).symm

/-- In the characteristic zero case, the weights in the centroid
indexed by a `fintype` sum to 1 if the number of points is not
zero. -/
lemma sum_centroid_weights_indicator_eq_one_of_card_ne_zero [char_zero k] [fintype ι]
  (h : card s ≠ 0) : ∑ i, s.centroid_weights_indicator k i = 1 :=
begin
  rw sum_centroid_weights_indicator,
  exact s.sum_centroid_weights_eq_one_of_card_ne_zero k h
end

/-- In the characteristic zero case, the weights in the centroid
indexed by a `fintype` sum to 1 if the set is nonempty. -/
lemma sum_centroid_weights_indicator_eq_one_of_nonempty [char_zero k] [fintype ι]
  (h : s.nonempty) : ∑ i, s.centroid_weights_indicator k i = 1 :=
begin
  rw sum_centroid_weights_indicator,
  exact s.sum_centroid_weights_eq_one_of_nonempty k h
end

/-- In the characteristic zero case, the weights in the centroid
indexed by a `fintype` sum to 1 if the number of points is `n + 1`. -/
lemma sum_centroid_weights_indicator_eq_one_of_card_eq_add_one [char_zero k] [fintype ι] {n : ℕ}
  (h : card s = n + 1) : ∑ i, s.centroid_weights_indicator k i = 1 :=
begin
  rw sum_centroid_weights_indicator,
  exact s.sum_centroid_weights_eq_one_of_card_eq_add_one k h
end

include V

/-- The centroid as an affine combination over a `fintype`. -/
lemma centroid_eq_affine_combination_fintype [fintype ι] (p : ι → P) :
  s.centroid k p = univ.affine_combination p (s.centroid_weights_indicator k) :=
affine_combination_indicator_subset _ _ (subset_univ _)

/-- An indexed family of points that is injective on the given
`finset` has the same centroid as the image of that `finset`.  This is
stated in terms of a set equal to the image to provide control of
definitional equality for the index type used for the centroid of the
image. -/
lemma centroid_eq_centroid_image_of_inj_on {p : ι → P} (hi : ∀ i j ∈ s, p i = p j → i = j)
  {ps : set P} [fintype ps] (hps : ps = p '' ↑s) :
  s.centroid k p = (univ : finset ps).centroid k (λ x, x) :=
begin
  let f : p '' ↑s → ι := λ x, x.property.some,
  have hf : ∀ x, f x ∈ s ∧ p (f x) = x := λ x, x.property.some_spec,
  let f' : ps → ι := λ x, f ⟨x, hps ▸ x.property⟩,
  have hf' : ∀ x, f' x ∈ s ∧ p (f' x) = x := λ x, hf ⟨x, hps ▸ x.property⟩,
  have hf'i : function.injective f',
  { intros x y h,
    rw [subtype.ext_iff, ←(hf' x).2, ←(hf' y).2, h] },
  let f'e : ps ↪ ι := ⟨f', hf'i⟩,
  have hu : finset.univ.map f'e = s,
  { ext x,
    rw mem_map,
    split,
    { rintros ⟨i, _, rfl⟩,
      exact (hf' i).1 },
    { intro hx,
      use [⟨p x, hps.symm ▸ set.mem_image_of_mem _ hx⟩, mem_univ _],
      refine hi _ _ (hf' _).1 hx _,
      rw (hf' _).2,
      refl } },
  rw [←hu, centroid_map],
  congr' with x,
  change p (f' x) = ↑x,
  rw (hf' x).2
end

/-- Two indexed families of points that are injective on the given
`finset`s and with the same points in the image of those `finset`s
have the same centroid. -/
lemma centroid_eq_of_inj_on_of_image_eq {p : ι → P} (hi : ∀ i j ∈ s, p i = p j → i = j)
  {p₂ : ι₂ → P} (hi₂ : ∀ i j ∈ s₂, p₂ i = p₂ j → i = j) (he : p '' ↑s = p₂ '' ↑s₂) :
  s.centroid k p = s₂.centroid k p₂ :=
by rw [s.centroid_eq_centroid_image_of_inj_on k hi rfl,
       s₂.centroid_eq_centroid_image_of_inj_on k hi₂ he]

end finset

section affine_space'

variables {k : Type*} {V : Type*} {P : Type*} [ring k] [add_comm_group V] [module k V]
          [affine_space V P]
variables {ι : Type*}
include V

/-- A `weighted_vsub` with sum of weights 0 is in the `vector_span` of
an indexed family. -/
lemma weighted_vsub_mem_vector_span {s : finset ι} {w : ι → k}
    (h : ∑ i in s, w i = 0) (p : ι → P) :
    s.weighted_vsub p w ∈ vector_span k (set.range p) :=
begin
  rcases is_empty_or_nonempty ι with hι|⟨⟨i0⟩⟩,
  { resetI, simp [finset.eq_empty_of_is_empty s] },
  { rw [vector_span_range_eq_span_range_vsub_right k p i0, ←set.image_univ,
        finsupp.mem_span_image_iff_total,
        finset.weighted_vsub_eq_weighted_vsub_of_point_of_sum_eq_zero s w p h (p i0),
        finset.weighted_vsub_of_point_apply],
    let w' := set.indicator ↑s w,
    have hwx : ∀ i, w' i ≠ 0 → i ∈ s := λ i, set.mem_of_indicator_ne_zero,
    use [finsupp.on_finset s w' hwx, set.subset_univ _],
    rw [finsupp.total_apply, finsupp.on_finset_sum hwx],
    { apply finset.sum_congr rfl,
      intros i hi,
      simp [w', set.indicator_apply, if_pos hi] },
    { exact λ _, zero_smul k _ } },
end

/-- An `affine_combination` with sum of weights 1 is in the
`affine_span` of an indexed family, if the underlying ring is
nontrivial. -/
lemma affine_combination_mem_affine_span [nontrivial k] {s : finset ι} {w : ι → k}
    (h : ∑ i in s, w i = 1) (p : ι → P) :
  s.affine_combination p w ∈ affine_span k (set.range p) :=
begin
  have hnz : ∑ i in s, w i ≠ 0 := h.symm ▸ one_ne_zero,
  have hn : s.nonempty := finset.nonempty_of_sum_ne_zero hnz,
  cases hn with i1 hi1,
  let w1 : ι → k := function.update (function.const ι 0) i1 1,
  have hw1 : ∑ i in s, w1 i = 1,
  { rw [finset.sum_update_of_mem hi1, finset.sum_const_zero, add_zero] },
  have hw1s : s.affine_combination p w1 = p i1 :=
    s.affine_combination_of_eq_one_of_eq_zero w1 p hi1 (function.update_same _ _ _)
                                              (λ _ _ hne, function.update_noteq hne _ _),
  have hv : s.affine_combination p w -ᵥ p i1 ∈ (affine_span k (set.range p)).direction,
  { rw [direction_affine_span, ←hw1s, finset.affine_combination_vsub],
    apply weighted_vsub_mem_vector_span,
    simp [pi.sub_apply, h, hw1] },
  rw ←vsub_vadd (s.affine_combination p w) (p i1),
  exact affine_subspace.vadd_mem_of_mem_direction hv (mem_affine_span k (set.mem_range_self _))
end

variables (k) {V}

/-- A vector is in the `vector_span` of an indexed family if and only
if it is a `weighted_vsub` with sum of weights 0. -/
lemma mem_vector_span_iff_eq_weighted_vsub {v : V} {p : ι → P} :
  v ∈ vector_span k (set.range p) ↔
    ∃ (s : finset ι) (w : ι → k) (h : ∑ i in s, w i = 0), v = s.weighted_vsub p w :=
begin
  split,
  { rcases is_empty_or_nonempty ι with hι|⟨⟨i0⟩⟩, swap,
    { rw [vector_span_range_eq_span_range_vsub_right k p i0, ←set.image_univ,
          finsupp.mem_span_image_iff_total],
      rintros ⟨l, hl, hv⟩,
      use insert i0 l.support,
      set w := (l : ι → k) -
        function.update (function.const ι 0 : ι → k) i0 (∑ i in l.support, l i) with hwdef,
      use w,
      have hw : ∑ i in insert i0 l.support, w i = 0,
      { rw hwdef,
        simp_rw [pi.sub_apply, finset.sum_sub_distrib,
                 finset.sum_update_of_mem (finset.mem_insert_self _ _), finset.sum_const_zero,
                 finset.sum_insert_of_eq_zero_if_not_mem finsupp.not_mem_support_iff.1,
                 add_zero, sub_self] },
      use hw,
      have hz : w i0 • (p i0 -ᵥ p i0 : V) = 0 := (vsub_self (p i0)).symm ▸ smul_zero _,
      change (λ i, w i • (p i -ᵥ p i0 : V)) i0 = 0 at hz,
      rw [finset.weighted_vsub_eq_weighted_vsub_of_point_of_sum_eq_zero _ w p hw (p i0),
          finset.weighted_vsub_of_point_apply, ←hv, finsupp.total_apply,
          finset.sum_insert_zero hz],
      change ∑ i in l.support, l i • _ = _,
      congr' with i,
      by_cases h : i = i0,
      { simp [h] },
      { simp [hwdef, h] } },
    { resetI,
      rw [set.range_eq_empty, vector_span_empty, submodule.mem_bot],
      rintro rfl,
      use [∅],
      simp } },
  { rintros ⟨s, w, hw, rfl⟩,
    exact weighted_vsub_mem_vector_span hw p }
end

variables {k}

/-- A point in the `affine_span` of an indexed family is an
`affine_combination` with sum of weights 1. See also
`eq_affine_combination_of_mem_affine_span_of_fintype`. -/
lemma eq_affine_combination_of_mem_affine_span {p1 : P} {p : ι → P}
    (h : p1 ∈ affine_span k (set.range p)) :
  ∃ (s : finset ι) (w : ι → k) (hw : ∑ i in s, w i = 1), p1 = s.affine_combination p w :=
begin
  have hn : ((affine_span k (set.range p)) : set P).nonempty := ⟨p1, h⟩,
  rw [affine_span_nonempty, set.range_nonempty_iff_nonempty] at hn,
  cases hn with i0,
  have h0 : p i0 ∈ affine_span k (set.range p) := mem_affine_span k (set.mem_range_self i0),
  have hd : p1 -ᵥ p i0 ∈ (affine_span k (set.range p)).direction :=
    affine_subspace.vsub_mem_direction h h0,
  rw [direction_affine_span, mem_vector_span_iff_eq_weighted_vsub] at hd,
  rcases hd with ⟨s, w, h, hs⟩,
  let s' := insert i0 s,
  let w' := set.indicator ↑s w,
  have h' : ∑ i in s', w' i = 0,
  { rw [←h, set.sum_indicator_subset _ (finset.subset_insert i0 s)] },
  have hs' : s'.weighted_vsub p w' = p1 -ᵥ p i0,
  { rw hs,
    exact (finset.weighted_vsub_indicator_subset _ _ (finset.subset_insert i0 s)).symm },
  let w0 : ι → k := function.update (function.const ι 0) i0 1,
  have hw0 : ∑ i in s', w0 i = 1,
  { rw [finset.sum_update_of_mem (finset.mem_insert_self _ _), finset.sum_const_zero, add_zero] },
  have hw0s : s'.affine_combination p w0 = p i0 :=
    s'.affine_combination_of_eq_one_of_eq_zero w0 p
                                               (finset.mem_insert_self _ _)
                                               (function.update_same _ _ _)
                                               (λ _ _ hne, function.update_noteq hne _ _),
  use [s', w0 + w'],
  split,
  { simp [pi.add_apply, finset.sum_add_distrib, hw0, h'] },
  { rw [add_comm, ←finset.weighted_vsub_vadd_affine_combination, hw0s, hs', vsub_vadd] }
end

lemma eq_affine_combination_of_mem_affine_span_of_fintype [fintype ι] {p1 : P} {p : ι → P}
  (h : p1 ∈ affine_span k (set.range p)) :
  ∃ (w : ι → k) (hw : ∑ i, w i = 1), p1 = finset.univ.affine_combination p w :=
begin
  obtain ⟨s, w, hw, rfl⟩ := eq_affine_combination_of_mem_affine_span h,
  refine ⟨(s : set ι).indicator w, _, finset.affine_combination_indicator_subset w p s.subset_univ⟩,
  simp only [finset.mem_coe, set.indicator_apply, ← hw],
  convert fintype.sum_extend_by_zero s w,
  ext i,
  congr,
end

variables (k V)

/-- A point is in the `affine_span` of an indexed family if and only
if it is an `affine_combination` with sum of weights 1, provided the
underlying ring is nontrivial. -/
lemma mem_affine_span_iff_eq_affine_combination [nontrivial k] {p1 : P} {p : ι → P} :
  p1 ∈ affine_span k (set.range p) ↔
    ∃ (s : finset ι) (w : ι → k) (hw : ∑ i in s, w i = 1), p1 = s.affine_combination p w :=
begin
  split,
  { exact eq_affine_combination_of_mem_affine_span },
  { rintros ⟨s, w, hw, rfl⟩,
    exact affine_combination_mem_affine_span hw p }
end

/-- Given a family of points together with a chosen base point in that family, membership of the
affine span of this family corresponds to an identity in terms of `weighted_vsub_of_point`, with
weights that are not required to sum to 1. -/
lemma mem_affine_span_iff_eq_weighted_vsub_of_point_vadd
  [nontrivial k] (p : ι → P) (j : ι) (q : P) :
  q ∈ affine_span k (set.range p) ↔
  ∃ (s : finset ι) (w : ι → k), q = s.weighted_vsub_of_point p (p j) w +ᵥ (p j) :=
begin
  split,
  { intros hq,
    obtain ⟨s, w, hw, rfl⟩ := eq_affine_combination_of_mem_affine_span hq,
    exact ⟨s, w, s.affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one w p hw (p j)⟩, },
  { rintros ⟨s, w, rfl⟩,
    classical,
    let w' : ι → k := function.update w j (1 - (s \ {j}).sum w),
    have h₁ : (insert j s).sum w' = 1,
    { by_cases hj : j ∈ s,
      { simp [finset.sum_update_of_mem hj, finset.insert_eq_of_mem hj], },
      { simp [w', finset.sum_insert hj, finset.sum_update_of_not_mem hj, hj], }, },
    have hww : ∀ i, i ≠ j → w i = w' i, { intros i hij, simp [w', hij], },
    rw [s.weighted_vsub_of_point_eq_of_weights_eq p j w w' hww,
      ← s.weighted_vsub_of_point_insert w' p j,
      ← (insert j s).affine_combination_eq_weighted_vsub_of_point_vadd_of_sum_eq_one w' p h₁ (p j)],
    exact affine_combination_mem_affine_span h₁ p, },
end

variables {k V}

/-- Given a set of points, together with a chosen base point in this set, if we affinely transport
all other members of the set along the line joining them to this base point, the affine span is
unchanged. -/
lemma affine_span_eq_affine_span_line_map_units [nontrivial k]
  {s : set P} {p : P} (hp : p ∈ s) (w : s → units k) :
  affine_span k (set.range (λ (q : s), affine_map.line_map p ↑q (w q : k))) = affine_span k s :=
begin
  have : s = set.range (coe : s → P), { simp, },
  conv_rhs { rw this, },
  apply le_antisymm;
  intros q hq;
  erw mem_affine_span_iff_eq_weighted_vsub_of_point_vadd k V _ (⟨p, hp⟩ : s) q at hq ⊢;
  obtain ⟨t, μ, rfl⟩ := hq;
  use t;
  [use λ x, (μ x) * ↑(w x), use λ x, (μ x) * ↑(w x)⁻¹];
  simp [smul_smul],
end

end affine_space'

section division_ring

variables {k : Type*} {V : Type*} {P : Type*} [division_ring k] [add_comm_group V] [module k V]
variables [affine_space V P] {ι : Type*}
include V

open set finset

/-- The centroid lies in the affine span if the number of points,
converted to `k`, is not zero. -/
lemma centroid_mem_affine_span_of_cast_card_ne_zero {s : finset ι} (p : ι → P)
  (h : (card s : k) ≠ 0) : s.centroid k p ∈ affine_span k (range p) :=
affine_combination_mem_affine_span (s.sum_centroid_weights_eq_one_of_cast_card_ne_zero h) p

variables (k)

/-- In the characteristic zero case, the centroid lies in the affine
span if the number of points is not zero. -/
lemma centroid_mem_affine_span_of_card_ne_zero [char_zero k] {s : finset ι} (p : ι → P)
  (h : card s ≠ 0) : s.centroid k p ∈ affine_span k (range p) :=
affine_combination_mem_affine_span (s.sum_centroid_weights_eq_one_of_card_ne_zero k h) p

/-- In the characteristic zero case, the centroid lies in the affine
span if the set is nonempty. -/
lemma centroid_mem_affine_span_of_nonempty [char_zero k] {s : finset ι} (p : ι → P)
  (h : s.nonempty) : s.centroid k p ∈ affine_span k (range p) :=
affine_combination_mem_affine_span (s.sum_centroid_weights_eq_one_of_nonempty k h) p

/-- In the characteristic zero case, the centroid lies in the affine
span if the number of points is `n + 1`. -/
lemma centroid_mem_affine_span_of_card_eq_add_one [char_zero k] {s : finset ι} (p : ι → P)
  {n : ℕ} (h : card s = n + 1) : s.centroid k p ∈ affine_span k (range p) :=
affine_combination_mem_affine_span (s.sum_centroid_weights_eq_one_of_card_eq_add_one k h) p

end division_ring

namespace affine_map
variables {k : Type*} {V : Type*} (P : Type*) [comm_ring k] [add_comm_group V] [module k V]
variables [affine_space V P] {ι : Type*} (s : finset ι)
include V

-- TODO: define `affine_map.proj`, `affine_map.fst`, `affine_map.snd`
/-- A weighted sum, as an affine map on the points involved. -/
def weighted_vsub_of_point (w : ι → k) : ((ι → P) × P) →ᵃ[k] V :=
{ to_fun := λ p, s.weighted_vsub_of_point p.fst p.snd w,
  linear := ∑ i in s,
    w i • ((linear_map.proj i).comp (linear_map.fst _ _ _) - linear_map.snd _ _ _),
  map_vadd' := begin
    rintros ⟨p, b⟩ ⟨v, b'⟩,
    simp [linear_map.sum_apply, finset.weighted_vsub_of_point, vsub_vadd_eq_vsub_sub,
          vadd_vsub_assoc, add_sub, ← sub_add_eq_add_sub, smul_add, finset.sum_add_distrib]
  end }

end affine_map


/-
  A concrete characterisation of the ideal map induced by a ring homomorphism
  with the localization property.
-/

import ring_theory.ideal_operations
import ring_theory.localization
import to_mathlib.localization.localization_alt

open localization_alt

universe u

section

parameters {R : Type u} [comm_ring R]
parameters {Rf : Type u} [comm_ring Rf] {h : R → Rf} [is_ring_hom h]
parameters {f : R} (HL : is_localization_data (powers f) h)

include HL

lemma localization.zero (I : ideal R) [PI : ideal.is_prime I]
(Hfn : (0 : R) ∈ powers f)
: (ideal.map h I : ideal Rf) = ⊥ :=
begin
  have HL' := HL,
  rcases HL' with ⟨Hinv, Hden, Hker⟩,
  apply ideal.ext,
  intros x,
  split,
  swap,
  { intros H,
    simp at H,
    rw H,
    rw ←is_ring_hom.map_zero h,
    apply ideal.mem_map_of_mem,
    simp, },
  { intros Hx,
    rcases (Hden x) with ⟨⟨a, b⟩, Hab⟩,
    simp at Hab,
    rcases (Hinv a) with ⟨w, Hw⟩,
    have Hall : ∀ (y : R), y ∈ submonoid_ann (powers f),
      intros y,
      simp [submonoid_ann, set.range, ann_aux],
      use [⟨y, ⟨0, Hfn⟩⟩],
      simp,
    have Htop : submonoid_ann (powers f) = ⊤,
      apply ideal.ext,
      intros x,
      split,
      { intros Hx,
        cases Hx,
        unfold ann_aux at Hx_w, },
      { intros Hx,
        exact (Hall x), },
    replace Hker := inverts_ker (powers f) h (inverts_of_data (powers f) h Hinv),
    unfold ker at Hker,
    rw Htop at Hker,
    have Hx : (1 : R) ∈ (⊤ : ideal R),
      trivial,
    replace Hx := Hker Hx,
    replace Hx : h 1 = 0 := Hx,
    rw (is_ring_hom.map_one h) at Hx,
    rw ←mul_one x,
    rw Hx,
    simp, },
end

-- Concrete ideal.

def localisation_map_ideal (I : ideal R) : ideal Rf :=
{ carrier := { x | ∃ (y ∈ h '' I) (r : Rf), x = y * r },
  zero :=
    begin
      use [h 0, 0],
      exact ⟨I.2, rfl⟩,
      use 1,
      rw mul_one,
      rw ←is_ring_hom.map_zero h,
    end,
  add :=
    begin
      intros x y Hx Hy,
      rcases Hx with ⟨a, ⟨Ha, ⟨r, Hx⟩⟩⟩,
      rcases Hy with ⟨b, ⟨Hb, ⟨t, Hy⟩⟩⟩,
      rcases Ha with ⟨v, ⟨Hv, Ha⟩⟩,
      rcases Hb with ⟨w, ⟨Hw, Hb⟩⟩,
      rw ←Ha at Hx,
      rw ←Hb at Hy,
      rw [Hx, Hy],
      rcases HL with ⟨Hinv, Hden, Hker⟩,
      rcases (Hden r) with ⟨⟨fn, l⟩, Hl⟩,
      rcases (Hinv fn) with ⟨hfninv, Hfn⟩,
      simp at Hl,
      rw mul_comm at Hfn,
      rcases (Hden t) with ⟨⟨fm, k⟩, Hk⟩,
      rcases (Hinv fm) with ⟨hfminv, Hfm⟩,
      simp at Hk,
      rw mul_comm at Hfm,
      -- Get rid of r.
      rw [←one_mul (_ + _), ←Hfn, mul_assoc, mul_add, mul_comm _ r, ←mul_assoc _ r _, Hl],
      -- Get rid of t.
      rw [←one_mul (_ * _), ←Hfm, mul_assoc, ←mul_assoc (h _) _ _, mul_comm (h _)],
      rw [mul_assoc _ (h _) _, mul_add, ←mul_assoc _ _ t, add_comm],
      rw [←mul_assoc (h fm) _ _, mul_comm (h fm), mul_assoc _ _ t, Hk],
      -- Rearrange.
      repeat { rw ←is_ring_hom.map_mul h, },
      rw [←mul_assoc _ _ v, mul_assoc ↑fn, mul_comm w, ←mul_assoc ↑fn],
      rw [←is_ring_hom.map_add h, ←mul_assoc, mul_comm],
      -- Ready to prove it.
      have HyI : ↑fn * k * w + ↑fm * l * v ∈ ↑I,
        apply I.3,
        { apply I.4,
          exact Hw, },
        { apply I.4,
          exact Hv, },
      use [h (↑fn * k * w + ↑fm * l * v)],
      use [⟨↑fn * k * w + ↑fm * l * v, ⟨HyI, rfl⟩⟩],
      use [hfminv * hfninv],
    end,
  smul :=
    begin
      intros c x Hx,
      rcases Hx with ⟨a, ⟨Ha, ⟨r, Hx⟩⟩⟩,
      rcases Ha with ⟨v, ⟨Hv, Ha⟩⟩,
      rw [Hx, ←Ha],
      rw mul_comm _ r,
      unfold has_scalar.smul,
      rw [mul_comm r, mul_comm c, mul_assoc],
      use [h v, ⟨v, ⟨Hv, rfl⟩⟩, r * c],
    end, }

-- They coincide

lemma localisation_map_ideal.eq (I : ideal R) [PI : ideal.is_prime I]
: ideal.map h I = localisation_map_ideal I :=
begin
  have HL' := HL,
  rcases HL' with ⟨Hinv, Hden, Hker⟩,
  apply le_antisymm,
  { have Hgen : h '' I ⊆ localisation_map_ideal I,
      intros x Hx,
      use [x, Hx, 1],
      simp,
    replace Hgen := ideal.span_mono Hgen,
    rw ideal.span_eq at Hgen,
    exact Hgen, },
  { intros x Hx,
    rcases Hx with ⟨y, ⟨z, ⟨HzI, Hzy⟩⟩, ⟨r, Hr⟩⟩,
    rw [Hr, ←Hzy],
    exact ideal.mul_mem_right _ (ideal.mem_map_of_mem HzI), }
end

end


inductive Expr where
  | var (i : Nat)
  | op  (lhs rhs : Expr)

def List.getIdx : List α → Nat → α → α
  | [],    i,   u => u
  | a::as, 0,   u => a
  | a::as, i+1, u => getIdx as i u

structure Context (α : Type u) where
  op    : α → α → α
  unit  : α
  assoc : (a b c : α) → op (op a b) c = op a (op b c)
  vars  : List α

def Expr.denote (ctx : Context α) : Expr → α
  | Expr.op a b => ctx.op (denote ctx a) (denote ctx b)
  | Expr.var i  => ctx.vars.getIdx i ctx.unit

theorem Expr.denote_op (ctx : Context α) (a b : Expr) : denote ctx (Expr.op a b) = ctx.op (denote ctx a) (denote ctx b) :=
  rfl

theorem Expr.denote_var (ctx : Context α) (i : Nat) : denote ctx (Expr.var i) = ctx.vars.getIdx i ctx.unit :=
  rfl

def Expr.concat : Expr → Expr → Expr
  | Expr.op a b, c => Expr.op a (concat b c)
  | Expr.var i, c  => Expr.op (Expr.var i) c

theorem Expr.concat_op (a b c : Expr) : concat (Expr.op a b) c = Expr.op a (concat b c) :=
  rfl

theorem Expr.concat_var (i : Nat) (c : Expr) : concat (Expr.var i) c = Expr.op (Expr.var i) c :=
  rfl

theorem Expr.denote_concat (ctx : Context α) (a b : Expr) : denote ctx (concat a b) = denote ctx (Expr.op a b) := by
  induction a with
  | var i => rfl
  | op _ _ _ ih => rw [concat_op, denote_op, ih, denote_op, denote_op, denote_op, ctx.assoc]

def Expr.flat : Expr → Expr
  | Expr.op a b => concat (flat a) (flat b)
  | Expr.var i  => Expr.var i

theorem Expr.flat_op (a b : Expr) : flat (Expr.op a b) = concat (flat a) (flat b) :=
  rfl

theorem Expr.denote_flat (ctx : Context α) (a : Expr) : denote ctx (flat a) = denote ctx a := by
  induction a with
  | var i => rfl
  | op a b ih₁ ih₂ => rw [flat_op, denote_concat, denote_op, denote_op, ih₁, ih₂]

theorem Expr.eq_of_flat (ctx : Context α) (a b : Expr) (h : flat a = flat b) : denote ctx a = denote ctx b := by
  rw [← Expr.denote_flat _ a, ← Expr.denote_flat _ b, h]

theorem test (x₁ x₂ x₃ x₄ : Nat) : (x₁ + x₂) + (x₃ + x₄) = x₁ + x₂ + x₃ + x₄ :=
  Expr.eq_of_flat
    { op    := Nat.add
      assoc := Nat.add_assoc
      unit  := Nat.zero
      vars  := [x₁, x₂, x₃, x₄] }
    (Expr.op (Expr.op (Expr.var 0) (Expr.var 1)) (Expr.op (Expr.var 2) (Expr.var 3)))
    (Expr.op (Expr.op (Expr.op (Expr.var 0) (Expr.var 1)) (Expr.var 2)) (Expr.var 3))
    rfl


/-
  Author: Conor Newton
  Email: conornewton@gmail.com

  I promise that I will get around to fixing this up eventually, it is a bit messy!
-/

open nat
open int
open classical

local attribute [instance] classical.prop_decidable

@[simp]
def even (n : nat) := ∃ a : nat, n = 2 * a
@[simp]
def odd  (n : nat) := ¬ even n

--I dont like haveing to use leans gcd and coprime definition, mine is better!
@[simp]
def relatively_prime (a b : nat) := ∀ d : nat, (∃ m n : nat, a = d * m ∧ b = d * n) → d = 1

--Every natural number is even or odd.
lemma even_or_odd (n : nat) : even n ∨ odd n := em (even n)

--Basic congruency
lemma succ_eq_succ {a b : nat} : a = b → succ a = succ b := congr_arg succ

--Useful lemma
lemma odd_shape_neq_even_shape : ∀ a b : nat, 2 * a ≠ 2 * b + 1:=
begin
  intros a b,
  intro h,
  have p, from congr_arg (λ x, x % 2) h,
  rw mul_mod_right at p,
  rw add_comm at p,
  rw add_mul_mod_self_left at p,
  have h : 1 < 2, from succ_lt_succ zero_lt_one,
  rw mod_eq_of_lt h at p,
  simp at p,
  exact p,
end

--odd numbers are of the form 2n + 1
theorem odd_form {a : nat} : odd a → ∃ x : nat, a = 2 * x + 1 :=
begin
  induction a with n ih,
    --base case
    have h' : even 0 , from ⟨ 0, refl 0⟩,
    contradiction,
    --induction step
    cases even_or_odd n,
      --even
      intro q,
      simp at h,
      cases h with a p,
      have c : succ n = 2 * a + 1, from succ_eq_succ p,
      exact ⟨a, c⟩,
      --odd
      intro q,
      have h2 : ∃ x : nat, n = 2 * x + 1, from ih h,
      cases h2 with  x h2,
      have h3 : succ n = 2 * x + 2, from (congr_arg succ) h2,
      rw [←mul_one 2, mul_assoc, ←left_distrib 2 (1 * x) 1] at h3,
      have h4 : even (succ n), from ⟨ 1 * x + 1, h3⟩,
      contradiction, -- we have shown succ is both odd and even,
end

--reverse of the previous theorem
theorem form_odd {a : nat} : (∃ x : nat, a = 2 * x + 1) → odd a :=
begin
  intro h,
  cases h with x h,
  intro a,
  simp at a,
  cases a with y p,
  rw h at p,
  have p', from eq.symm p,
  have p'', from  odd_shape_neq_even_shape y x,
  contradiction,
end

--not sure im using this
theorem succ_odd_even (n : nat) : odd n → even (n + 1) :=
begin
  intro h,
  have h2 : ∃ x, n = 2 * x + 1, from odd_form h,
  cases h2 with  x h2,
  have h3 : succ n = 2 * x + 2, from (congr_arg succ) h2,
  rw [←mul_one 2, mul_assoc, ←left_distrib 2 (1 * x) 1] at h3,
  have h4 : even (succ n), from ⟨1 * x + 1, h3⟩,
  exact h4,
end

lemma odd_squared_odd (n : nat) : odd n → odd (n * n) :=
begin
  intro h,
  have p, from odd_form h,
  cases p with x p,
  have p' : n * n = (2 * x + 1) * (2 * x + 1), from congr_arg (λ x, x * x) p,
  rw right_distrib at p',
  rw left_distrib at p',
  rw mul_one at p',
  rw one_mul at p',
  rw add_comm at p',
  rw mul_assoc at p',
  rw ←left_distrib at p',
  rw add_comm at p',
  rw ←add_assoc at p',
  rw ←left_distrib at p',
  have o : odd (n * n), from form_odd ⟨ x* ( 2 * x) + x + x, p'⟩,
  exact o,
end

--Just the contrapositive of the above
--How do i just use the contrapositive?
lemma even_squared_even (n : nat) : even (n * n) → even n :=
begin
  intro a,
  by_contradiction h,
  have o : odd n, from h, --what is the easier way of doing this
  have od : odd (n * n), from odd_squared_odd n o,
  contradiction,
end

--How can i tidy this up?
lemma evens_not_coprime {a b : nat} : even a → even b → ¬ relatively_prime a b :=
begin
  intros e1 e2,
  simp,
  intro h,

  simp at e1 e2,
  cases e1 with x e1,
  cases e2 with y e2,

  have h', from h 2,

  have p : ∃ m n : nat, a = 2 * m ∧ b = 2 * n, from ⟨x, ⟨y, and.intro e1 e2 ⟩⟩,
  have c : 2 = 1, from h' p,
  have c' : 2 ≠ 1, from succ_ne_self 1,
  simp at c',
  contradiction,
end

theorem sqrt2_irrational (a b : nat) : b ≠ 0 ∧ relatively_prime a b → a * a ≠ 2 * b * b :=
begin
  intro h,
  by_contradiction f,
  simp at f,
  have g :  a * a = 2 * b * b, from (decidable.of_not_not f),
  cases even_or_odd a with j k,
    --a is even
    begin --aim to contradict gcd a b = 1
      simp at j,
      cases j with c j,
        rw j at g,
        rw [mul_assoc] at g,
        --how else can i flip an equation??
        have h2 : 2 * b * b = 2 * (c * (2 * c)), from eq.symm g,
        rw [mul_assoc] at g,
        have p : 2 > 0,
          begin
             cases eq_zero_or_pos 2,
               cases h_1,
               exact h_1,
          end,
        have h3 : c * (2 * c) = b * b, from (eq_of_mul_eq_mul_left p g),
        rw [mul_comm] at h3,
        rw [mul_assoc] at h3,

        have h4 : 2 * (c * c) % 2 = b * b % 2, from (congr_arg (λ x, x % 2)) h3,
        rw [mul_mod_right] at h4,

        ----FIX HERE AND ABOVE
        have h4 : even (b * b), from ⟨c * c, eq.symm h3⟩,
        have h5 : even b, from even_squared_even b h4,
        simp at h5,
        cases h5 with d k,
        have ea : even a, from ⟨c, j⟩,
        have eb : even b, from ⟨d, k⟩,
        have h6 : ¬ relatively_prime a b, from (evens_not_coprime ea eb),
        have h7 : relatively_prime a b, from h.right,
        contradiction,
    end,
    --a is odd
    begin
      --We know that a^2 is even so we find a contradiciton.
      cases odd_form k with x l,
      rw l at g,
      have g2 : (2 * x + 1) * (2 * x + 1) % 2 = (2 * b * b) % 2, from (congr_arg (λ x, x % 2)) g,
      rw [mul_assoc] at g2,
      rw [mul_mod_right 2 (b*b)] at g2,
      rw [left_distrib] at g2,
      rw [right_distrib] at g2,
      rw [mul_one] at g2,
      rw [one_mul] at g2,
      rw mul_assoc at g2,
      rw ←add_assoc at g2,
      rw ←left_distrib at g2,
      rw ←left_distrib at g2,
      rw add_comm at g2,
      rw [add_mul_mod_self_left] at g2,
      rw [mod_eq_of_lt (lt.base 1)] at g2,
      contradiction,
    end,
end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.monoid_algebra
import algebra.char_p.invertible
import linear_algebra.basis
import ring_theory.simple_module

/-!
# Maschke's theorem

We prove Maschke's theorem for finite groups,
in the formulation that every submodule of a `k[G]` module has a complement,
when `k` is a field with `invertible (fintype.card G : k)`.

We do the core computation in greater generality.
For any `[comm_ring k]` in which  `[invertible (fintype.card G : k)]`,
and a `k[G]`-linear map `i : V → W` which admits a `k`-linear retraction `π`,
we produce a `k[G]`-linear retraction by
taking the average over `G` of the conjugates of `π`.

## Implementation Notes
* These results assume `invertible (fintype.card G : k)` which is equivalent to the more
familiar `¬(ring_char k ∣ fintype.card G)`. It is possible to convert between them using
`invertible_of_ring_char_not_dvd` and `not_ring_char_dvd_of_invertible`.

## Future work
It's not so far to give the usual statement, that every finite dimensional representation
of a finite group is semisimple (i.e. a direct sum of irreducibles).
-/

universes u

noncomputable theory
open module
open monoid_algebra
open_locale big_operators

section

-- At first we work with any `[comm_ring k]`, and add the assumption that
-- `[invertible (fintype.card G : k)]` when it is required.
variables {k : Type u} [comm_ring k] {G : Type u} [group G]

variables {V : Type u} [add_comm_group V] [module k V] [module (monoid_algebra k G) V]
variables [is_scalar_tower k (monoid_algebra k G) V]
variables {W : Type u} [add_comm_group W] [module k W] [module (monoid_algebra k G) W]
variables [is_scalar_tower k (monoid_algebra k G) W]

/-!
We now do the key calculation in Maschke's theorem.

Given `V → W`, an inclusion of `k[G]` modules,,
assume we have some retraction `π` (i.e. `∀ v, π (i v) = v`),
just as a `k`-linear map.
(When `k` is a field, this will be available cheaply, by choosing a basis.)

We now construct a retraction of the inclusion as a `k[G]`-linear map,
by the formula
$$ \frac{1}{|G|} \sum_{g \in G} g⁻¹ • π(g • -). $$
-/

namespace linear_map

variables (π : W →ₗ[k] V)
include π

/--
We define the conjugate of `π` by `g`, as a `k`-linear map.
-/
def conjugate (g : G) : W →ₗ[k] V :=
((group_smul.linear_map k V g⁻¹).comp π).comp (group_smul.linear_map k W g)

variables (i : V →ₗ[monoid_algebra k G] W) (h : ∀ v : V, π (i v) = v)

section
include h

lemma conjugate_i (g : G) (v : V) : (conjugate π g) (i v) = v :=
begin
  dsimp [conjugate],
  simp only [←i.map_smul, h, ←mul_smul, single_mul_single, mul_one, mul_left_inv],
  change (1 : monoid_algebra k G) • v = v,
  simp,
end
end

variables (G) [fintype G]

/--
The sum of the conjugates of `π` by each element `g : G`, as a `k`-linear map.

(We postpone dividing by the size of the group as long as possible.)
-/
def sum_of_conjugates : W →ₗ[k] V :=
∑ g : G, π.conjugate g

/--
In fact, the sum over `g : G` of the conjugate of `π` by `g` is a `k[G]`-linear map.
-/
def sum_of_conjugates_equivariant : W →ₗ[monoid_algebra k G] V :=
monoid_algebra.equivariant_of_linear_of_comm (π.sum_of_conjugates G) (λ g v,
begin
  dsimp [sum_of_conjugates],
  simp only [linear_map.sum_apply, finset.smul_sum],
  dsimp [conjugate],
  conv_lhs {
    rw [←finset.univ_map_embedding (mul_right_embedding g⁻¹)],
    simp only [mul_right_embedding],
  },
  simp only [←mul_smul, single_mul_single, mul_inv_rev, mul_one, function.embedding.coe_fn_mk,
    finset.sum_map, inv_inv, inv_mul_cancel_right],
  recover,
end)

section
variables [inv : invertible (fintype.card G : k)]
include inv

/--
We construct our `k[G]`-linear retraction of `i` as
$$ \frac{1}{|G|} \sum_{g \in G} g⁻¹ • π(g • -). $$
-/
def equivariant_projection : W →ₗ[monoid_algebra k G] V :=
⅟(fintype.card G : k) • (π.sum_of_conjugates_equivariant G)

include h

lemma equivariant_projection_condition (v : V) : (π.equivariant_projection G) (i v) = v :=
begin
  rw [equivariant_projection, smul_apply, sum_of_conjugates_equivariant,
    equivariant_of_linear_of_comm_apply, sum_of_conjugates],
  rw [linear_map.sum_apply],
  simp only [conjugate_i π i h],
  rw [finset.sum_const, finset.card_univ, nsmul_eq_smul_cast k,
    ←mul_smul, invertible.inv_of_mul_self, one_smul],
end
end
end linear_map
end

namespace char_zero

variables {k : Type u} [field k] {G : Type u} [fintype G] [group G] [char_zero k]

instance : invertible (fintype.card G : k) :=
invertible_of_ring_char_not_dvd (by simp [fintype.card_eq_zero_iff])

end char_zero

namespace monoid_algebra

-- Now we work over a `[field k]`.
variables {k : Type u} [field k] {G : Type u} [fintype G] [invertible (fintype.card G : k)]
variables [group G]
variables {V : Type u} [add_comm_group V] [module k V] [module (monoid_algebra k G) V]
variables [is_scalar_tower k (monoid_algebra k G) V]
variables {W : Type u} [add_comm_group W] [module k W] [module (monoid_algebra k G) W]
variables [is_scalar_tower k (monoid_algebra k G) W]

lemma exists_left_inverse_of_injective
  (f : V →ₗ[monoid_algebra k G] W) (hf : f.ker = ⊥) :
  ∃ (g : W →ₗ[monoid_algebra k G] V), g.comp f = linear_map.id :=
begin
  obtain ⟨φ, hφ⟩ := (f.restrict_scalars k).exists_left_inverse_of_injective
    (by simp only [hf, submodule.restrict_scalars_bot, linear_map.ker_restrict_scalars]),
  refine ⟨φ.equivariant_projection G, _⟩,
  ext v,
  simp only [linear_map.id_coe, id.def, linear_map.comp_apply],
  apply linear_map.equivariant_projection_condition,
  intro v,
  have := congr_arg linear_map.to_fun hφ,
  exact congr_fun this v
end

namespace submodule

lemma exists_is_compl
  (p : submodule (monoid_algebra k G) V) :
  ∃ q : submodule (monoid_algebra k G) V, is_compl p q :=
let ⟨f, hf⟩ := monoid_algebra.exists_left_inverse_of_injective p.subtype p.ker_subtype in
⟨f.ker, linear_map.is_compl_of_proj $ linear_map.ext_iff.1 hf⟩

/-- This also implies an instance `is_semisimple_module (monoid_algebra k G) V`. -/
instance is_complemented : is_complemented (submodule (monoid_algebra k G) V) :=
⟨exists_is_compl⟩

end submodule
end monoid_algebra


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import data.finsupp.basic
import data.finsupp.order

/-!
# Equivalence between `multiset` and `ℕ`-valued finitely supported functions

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

This defines `finsupp.to_multiset` the equivalence between `α →₀ ℕ` and `multiset α`, along
with `multiset.to_finsupp` the reverse equivalence and `finsupp.order_iso_multiset` the equivalence
promoted to an order isomorphism.
-/

open finset
open_locale big_operators classical
noncomputable theory

variables {α β ι  : Type*}

namespace finsupp

/-- Given `f : α →₀ ℕ`, `f.to_multiset` is the multiset with multiplicities given by the values of
`f` on the elements of `α`. We define this function as an `add_equiv`. -/
def to_multiset : (α →₀ ℕ) ≃+ multiset α :=
{ to_fun := λ f, f.sum (λa n, n • {a}),
  inv_fun := λ s, ⟨s.to_finset, λ a, s.count a, λ a, by simp⟩,
  left_inv := λ f, ext $ λ a, by
    { simp only [sum, multiset.count_sum', multiset.count_singleton, mul_boole, coe_mk,
        mem_support_iff, multiset.count_nsmul, finset.sum_ite_eq, ite_not, ite_eq_right_iff],
      exact eq.symm },
  right_inv := λ s, by simp only [sum, coe_mk, multiset.to_finset_sum_count_nsmul_eq],
  map_add' := λ f g, sum_add_index' (λ a, zero_nsmul _) (λ a, add_nsmul _) }

lemma to_multiset_zero : (0 : α →₀ ℕ).to_multiset = 0 := rfl

lemma to_multiset_add (m n : α →₀ ℕ) : (m + n).to_multiset = m.to_multiset + n.to_multiset :=
to_multiset.map_add m n

lemma to_multiset_apply (f : α →₀ ℕ) : f.to_multiset = f.sum (λ a n, n • {a}) := rfl

@[simp]
lemma to_multiset_symm_apply [decidable_eq α] (s : multiset α) (x : α) :
  finsupp.to_multiset.symm s x = s.count x :=
by convert rfl

@[simp] lemma to_multiset_single (a : α) (n : ℕ) : to_multiset (single a n) = n • {a} :=
by rw [to_multiset_apply, sum_single_index]; apply zero_nsmul

lemma to_multiset_sum {f : ι → α →₀ ℕ} (s : finset ι) :
  finsupp.to_multiset (∑ i in s, f i) = ∑ i in s, finsupp.to_multiset (f i) :=
add_equiv.map_sum _ _ _

lemma to_multiset_sum_single (s : finset ι) (n : ℕ) :
  finsupp.to_multiset (∑ i in s, single i n) = n • s.val :=
by simp_rw [to_multiset_sum, finsupp.to_multiset_single, sum_nsmul, sum_multiset_singleton]

lemma card_to_multiset (f : α →₀ ℕ) : f.to_multiset.card = f.sum (λ a, id) :=
by simp [to_multiset_apply, add_monoid_hom.map_finsupp_sum, function.id_def]

lemma to_multiset_map (f : α →₀ ℕ) (g : α → β) :
  f.to_multiset.map g = (f.map_domain g).to_multiset :=
begin
  refine f.induction _ _,
  { rw [to_multiset_zero, multiset.map_zero, map_domain_zero, to_multiset_zero] },
  { assume a n f _ _ ih,
    rw [to_multiset_add, multiset.map_add, ih, map_domain_add, map_domain_single,
        to_multiset_single, to_multiset_add, to_multiset_single,
        ← multiset.coe_map_add_monoid_hom, (multiset.map_add_monoid_hom g).map_nsmul],
    refl }
end

@[simp] lemma prod_to_multiset [comm_monoid α] (f : α →₀ ℕ) :
  f.to_multiset.prod = f.prod (λ a n, a ^ n) :=
begin
  refine f.induction _ _,
  { rw [to_multiset_zero, multiset.prod_zero, finsupp.prod_zero_index] },
  { assume a n f _ _ ih,
    rw [to_multiset_add, multiset.prod_add, ih, to_multiset_single, multiset.prod_nsmul,
      finsupp.prod_add_index' pow_zero pow_add, finsupp.prod_single_index, multiset.prod_singleton],
    { exact pow_zero a } }
end

@[simp] lemma to_finset_to_multiset [decidable_eq α] (f : α →₀ ℕ) :
  f.to_multiset.to_finset = f.support :=
begin
  refine f.induction _ _,
  { rw [to_multiset_zero, multiset.to_finset_zero, support_zero] },
  { assume a n f ha hn ih,
    rw [to_multiset_add, multiset.to_finset_add, ih, to_multiset_single, support_add_eq,
      support_single_ne_zero _ hn, multiset.to_finset_nsmul _ _ hn, multiset.to_finset_singleton],
    refine disjoint.mono_left support_single_subset _,
    rwa [finset.disjoint_singleton_left] }
end

@[simp] lemma count_to_multiset [decidable_eq α] (f : α →₀ ℕ) (a : α) :
  f.to_multiset.count a = f a :=
calc f.to_multiset.count a = f.sum (λx n, (n • {x} : multiset α).count a) :
  (multiset.count_add_monoid_hom a).map_sum _ f.support
  ... = f.sum (λx n, n * ({x} : multiset α).count a) : by simp only [multiset.count_nsmul]
  ... = f a * ({a} : multiset α).count a : sum_eq_single _
    (λ a' _ H, by simp only [multiset.count_singleton, if_false, H.symm, mul_zero])
    (λ H, by simp only [not_mem_support_iff.1 H, zero_mul])
  ... = f a : by rw [multiset.count_singleton_self, mul_one]

@[simp] lemma mem_to_multiset (f : α →₀ ℕ) (i : α) : i ∈ f.to_multiset ↔ i ∈ f.support :=
by rw [←multiset.count_ne_zero, finsupp.count_to_multiset, finsupp.mem_support_iff]

end finsupp

namespace multiset

/-- Given a multiset `s`, `s.to_finsupp` returns the finitely supported function on `ℕ` given by
the multiplicities of the elements of `s`. -/
def to_finsupp : multiset α ≃+ (α →₀ ℕ) := finsupp.to_multiset.symm

@[simp] lemma to_finsupp_support [decidable_eq α] (s : multiset α) :
  s.to_finsupp.support = s.to_finset :=
by convert rfl

@[simp] lemma to_finsupp_apply [decidable_eq α] (s : multiset α) (a : α) :
  to_finsupp s a = s.count a :=
by convert rfl

lemma to_finsupp_zero : to_finsupp (0 : multiset α) = 0 := add_equiv.map_zero _

lemma to_finsupp_add (s t : multiset α) : to_finsupp (s + t) = to_finsupp s + to_finsupp t :=
to_finsupp.map_add s t

@[simp] lemma to_finsupp_singleton (a : α) : to_finsupp ({a} : multiset α) = finsupp.single a 1 :=
finsupp.to_multiset.symm_apply_eq.2 $ by simp

@[simp] lemma to_finsupp_to_multiset (s : multiset α) : s.to_finsupp.to_multiset = s :=
finsupp.to_multiset.apply_symm_apply s

lemma to_finsupp_eq_iff {s : multiset α} {f : α →₀ ℕ} : s.to_finsupp = f ↔ s = f.to_multiset :=
finsupp.to_multiset.symm_apply_eq

end multiset

@[simp] lemma finsupp.to_multiset_to_finsupp (f : α →₀ ℕ) : f.to_multiset.to_finsupp = f :=
finsupp.to_multiset.symm_apply_apply f

/-! ### As an order isomorphism -/

namespace finsupp

/-- `finsupp.to_multiset` as an order isomorphism. -/
def order_iso_multiset : (ι →₀ ℕ) ≃o multiset ι :=
{ to_equiv := to_multiset.to_equiv,
  map_rel_iff' := λ f g, by simp [multiset.le_iff_count, le_def] }

@[simp] lemma coe_order_iso_multiset : ⇑(@order_iso_multiset ι) = to_multiset := rfl

@[simp] lemma coe_order_iso_multiset_symm : ⇑(@order_iso_multiset ι).symm = multiset.to_finsupp :=
rfl

lemma to_multiset_strict_mono : strict_mono (@to_multiset ι) := (@order_iso_multiset ι).strict_mono

lemma sum_id_lt_of_lt (m n : ι →₀ ℕ) (h : m < n) : m.sum (λ _, id) < n.sum (λ _, id) :=
begin
  rw [←card_to_multiset, ←card_to_multiset],
  apply multiset.card_lt_of_lt,
  exact to_multiset_strict_mono h
end

variable (ι)

/-- The order on `ι →₀ ℕ` is well-founded. -/
lemma lt_wf : well_founded (@has_lt.lt (ι →₀ ℕ) _) :=
subrelation.wf (sum_id_lt_of_lt) $ inv_image.wf _ nat.lt_wf

end finsupp

lemma multiset.to_finsupp_strict_mono : strict_mono (@multiset.to_finsupp ι) :=
(@finsupp.order_iso_multiset ι).symm.strict_mono


theorem ex1 (x : Nat) (y : { v // v > x }) (z : Nat) : Nat :=
by {
  clear y x;
  exact z
}

theorem ex2 (x : Nat) (y : { v // v > x }) (z : Nat) : Nat :=
by {
  clear x y;
  exact z
}

theorem ex3 (x y z : Nat) (h₁ : x = y) (h₂ : z = y) : x = z :=
by {
  have : y = z := h₂.symm;
  apply Eq.trans;
  exact h₁;
  assumption
}

theorem ex4 (x y z : Nat) (h₁ : x = y) (h₂ : z = y) : x = z :=
by {
  let h₃ : y = z := h₂.symm;
  apply Eq.trans;
  exact h₁;
  exact h₃
}

theorem ex5 (x y z : Nat) (h₁ : x = y) (h₂ : z = y) : x = z :=
by {
  have h₃ : y = z := h₂.symm;
  apply Eq.trans;
  exact h₁;
  exact h₃
}

theorem ex6 (x y z : Nat) (h₁ : x = y) (h₂ : z = y) : id (x + 0 = z) :=
by {
  show x = z;
  have h₃ : y = z := h₂.symm;
  apply Eq.trans;
  exact h₁;
  exact h₃
}

theorem ex7 (x y z : Nat) (h₁ : x = y) (h₂ : z = y) : x = z := by
have : y = z := by apply Eq.symm; assumption
apply Eq.trans
exact h₁
assumption

theorem ex8 (x y z : Nat) (h₁ : x = y) (h₂ : z = y) : x = z :=
by apply Eq.trans h₁;
   have : y = z := by
     apply Eq.symm;
     assumption;
   exact this


/-
Copyright (c) 2021 Yourong Zang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yourong Zang
-/
import analysis.normed_space.basic
import analysis.normed_space.linear_isometry

/-!
# Conformal Linear Maps

A continuous linear map between `R`-normed spaces `X` and `Y` `is_conformal_map` if it is
a nonzero multiple of a linear isometry.

## Main definitions

* `is_conformal_map`: the main definition of conformal linear maps

## Main results

* The conformality of the composition of two conformal linear maps, the identity map
  and multiplications by nonzero constants as continuous linear maps
* `is_conformal_map_of_subsingleton`: all continuous linear maps on singleton spaces are conformal
* `is_conformal_map.preserves_angle`: if a continuous linear map is conformal, then it
                                      preserves all angles in the normed space

See `analysis.normed_space.conformal_linear_map.inner_product` for
* `is_conformal_map_iff`: a map between inner product spaces is conformal
  iff it preserves inner products up to a fixed scalar factor.

## Tags

conformal

## Warning

The definition of conformality in this file does NOT require the maps to be orientation-preserving.
-/

noncomputable theory

open linear_isometry continuous_linear_map

/-- A continuous linear map `f'` is said to be conformal if it's
    a nonzero multiple of a linear isometry. -/
def is_conformal_map {R : Type*} {X Y : Type*} [normed_field R]
  [semi_normed_group X] [semi_normed_group Y] [normed_space R X] [normed_space R Y]
  (f' : X →L[R] Y) :=
∃ (c : R) (hc : c ≠ 0) (li : X →ₗᵢ[R] Y), (f' : X → Y) = c • li

variables {R M N G M' : Type*} [normed_field R]
  [semi_normed_group M] [semi_normed_group N] [semi_normed_group G]
  [normed_space R M] [normed_space R N] [normed_space R G]
  [normed_group M'] [normed_space R M']

lemma is_conformal_map_id : is_conformal_map (id R M) :=
⟨1, one_ne_zero, id, by { ext, simp }⟩

lemma is_conformal_map_const_smul {c : R} (hc : c ≠ 0) : is_conformal_map (c • (id R M)) :=
⟨c, hc, id, by { ext, simp }⟩

lemma linear_isometry.is_conformal_map (f' : M →ₗᵢ[R] N) :
  is_conformal_map f'.to_continuous_linear_map :=
⟨1, one_ne_zero, f', by { ext, simp }⟩

lemma is_conformal_map_of_subsingleton [h : subsingleton M] (f' : M →L[R] N) :
  is_conformal_map f' :=
begin
  rw subsingleton_iff at h,
  have minor : (f' : M → N) = function.const M 0 := by ext x'; rw h x' 0; exact f'.map_zero,
  have key : ∀ (x' : M), ∥(0 : M →ₗ[R] N) x'∥ = ∥x'∥ := λ x',
    by { rw [linear_map.zero_apply, h x' 0], repeat { rw norm_zero }, },
  exact ⟨(1 : R), one_ne_zero, ⟨0, key⟩,
    by { rw pi.smul_def, ext p, rw [one_smul, minor], refl, }⟩,
end

namespace is_conformal_map

lemma comp {f' : M →L[R] N} {g' : N →L[R] G}
  (hg' : is_conformal_map g') (hf' : is_conformal_map f') :
  is_conformal_map (g'.comp f') :=
begin
  rcases hf' with ⟨cf, hcf, lif, hlif⟩,
  rcases hg' with ⟨cg, hcg, lig, hlig⟩,
  refine ⟨cg * cf, mul_ne_zero hcg hcf, lig.comp lif, funext (λ x, _)⟩,
  simp only [coe_comp', linear_isometry.coe_comp, hlif, hlig, pi.smul_apply,
             function.comp_app, linear_isometry.map_smul, smul_smul],
end

lemma injective {f' : M' →L[R] N} (h : is_conformal_map f') : function.injective f' :=
let ⟨c, hc, li, hf'⟩ := h in by simp only [hf', pi.smul_def];
  exact (smul_right_injective _ hc).comp li.injective

lemma ne_zero [nontrivial M'] {f' : M' →L[R] N} (hf' : is_conformal_map f') :
  f' ≠ 0 :=
begin
  intros w,
  rcases exists_ne (0 : M') with ⟨a, ha⟩,
  have : f' a = f' 0,
  { simp_rw [w, continuous_linear_map.zero_apply], },
  exact ha (hf'.injective this),
end

end is_conformal_map


/-
Copyright (c) 2022 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker

! This file was ported from Lean 3 source module topology.algebra.uniform_convergence
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.UniformSpace.UniformConvergenceTopology
import Mathbin.Analysis.LocallyConvex.Bounded
import Mathbin.Topology.Algebra.FilterBasis

/-!
# Algebraic facts about the topology of uniform convergence

This file contains algebraic compatibility results about the uniform structure of uniform
convergence / `𝔖`-convergence. They will mostly be useful for defining strong topologies on the
space of continuous linear maps between two topological vector spaces.

## Main statements

* `uniform_fun.uniform_group` : if `G` is a uniform group, then `α →ᵤ G` a uniform group
* `uniform_on_fun.uniform_group` : if `G` is a uniform group, then for any `𝔖 : set (set α)`,
  `α →ᵤ[𝔖] G` a uniform group.
* `uniform_on_fun.has_continuous_smul_of_image_bounded` : let `E` be a TVS, `𝔖 : set (set α)` and
  `H` a submodule of `α →ᵤ[𝔖] E`. If the image of any `S ∈ 𝔖` by any `u ∈ H` is bounded (in the
  sense of `bornology.is_vonN_bounded`), then `H`, equipped with the topology induced from
  `α →ᵤ[𝔖] E`, is a TVS.

## Implementation notes

Like in `topology/uniform_space/uniform_convergence_topology`, we use the type aliases
`uniform_fun` (denoted `α →ᵤ β`) and `uniform_on_fun` (denoted `α →ᵤ[𝔖] β`) for functions from `α`
to `β` endowed with the structures of uniform convergence and `𝔖`-convergence.

## TODO

* `uniform_on_fun.has_continuous_smul_of_image_bounded` unnecessarily asks for `𝔖` to be
  nonempty and directed. This will be easy to solve once we know that replacing `𝔖` by its
  ***noncovering*** bornology (i.e ***not*** what `bornology` currently refers to in mathlib)
  doesn't change the topology.

## References

* [N. Bourbaki, *General Topology, Chapter X*][bourbaki1966]
* [N. Bourbaki, *Topological Vector Spaces*][bourbaki1987]

## Tags

uniform convergence, strong dual

-/

open Filter

open Topology Pointwise UniformConvergence

section AlgebraicInstances

variable {α β ι R : Type _} {𝔖 : Set <| Set α}

@[to_additive]
instance [Monoid β] : Monoid (α →ᵤ β) :=
  Pi.monoid

@[to_additive]
instance [Monoid β] : Monoid (α →ᵤ[𝔖] β) :=
  Pi.monoid

@[to_additive]
instance [CommMonoid β] : CommMonoid (α →ᵤ β) :=
  Pi.commMonoid

@[to_additive]
instance [CommMonoid β] : CommMonoid (α →ᵤ[𝔖] β) :=
  Pi.commMonoid

@[to_additive]
instance [Group β] : Group (α →ᵤ β) :=
  Pi.group

@[to_additive]
instance [Group β] : Group (α →ᵤ[𝔖] β) :=
  Pi.group

@[to_additive]
instance [CommGroup β] : CommGroup (α →ᵤ β) :=
  Pi.commGroup

@[to_additive]
instance [CommGroup β] : CommGroup (α →ᵤ[𝔖] β) :=
  Pi.commGroup

instance [Semiring R] [AddCommMonoid β] [Module R β] : Module R (α →ᵤ β) :=
  Pi.module _ _ _

instance [Semiring R] [AddCommMonoid β] [Module R β] : Module R (α →ᵤ[𝔖] β) :=
  Pi.module _ _ _

end AlgebraicInstances

section Group

variable {α G ι : Type _} [Group G] {𝔖 : Set <| Set α} [UniformSpace G] [UniformGroup G]

/-- If `G` is a uniform group, then `α →ᵤ G` is a uniform group as well. -/
@[to_additive
      "If `G` is a uniform additive group, then `α →ᵤ G` is a uniform additive group\nas well."]
instance : UniformGroup (α →ᵤ G) :=
  ⟨(-- Since `(/) : G × G → G` is uniformly continuous,
          -- `uniform_fun.postcomp_uniform_continuous` tells us that
          -- `((/) ∘ —) : (α →ᵤ G × G) → (α →ᵤ G)` is uniformly continuous too. By precomposing with
          -- `uniform_fun.uniform_equiv_prod_arrow`, this gives that
          -- `(/) : (α →ᵤ G) × (α →ᵤ G) → (α →ᵤ G)` is also uniformly continuous
          UniformFun.postcomp_uniformContinuous
          uniformContinuous_div).comp
      UniformFun.uniformEquivProdArrow.symm.UniformContinuous⟩

@[to_additive]
protected theorem UniformFun.hasBasis_nhds_one_of_basis {p : ι → Prop} {b : ι → Set G}
    (h : (𝓝 1 : Filter G).HasBasis p b) :
    (𝓝 1 : Filter (α →ᵤ G)).HasBasis p fun i => { f : α →ᵤ G | ∀ x, f x ∈ b i } :=
  by
  have := h.comap fun p : G × G => p.2 / p.1
  rw [← uniformity_eq_comap_nhds_one] at this
  convert UniformFun.hasBasis_nhds_of_basis α _ 1 this
  ext (i f)
  simp [UniformFun.gen]
#align uniform_fun.has_basis_nhds_one_of_basis UniformFun.hasBasis_nhds_one_of_basis
#align uniform_fun.has_basis_nhds_zero_of_basis UniformFun.hasBasis_nhds_zero_of_basis

@[to_additive]
protected theorem UniformFun.hasBasis_nhds_one :
    (𝓝 1 : Filter (α →ᵤ G)).HasBasis (fun V : Set G => V ∈ (𝓝 1 : Filter G)) fun V =>
      { f : α → G | ∀ x, f x ∈ V } :=
  UniformFun.hasBasis_nhds_one_of_basis (basis_sets _)
#align uniform_fun.has_basis_nhds_one UniformFun.hasBasis_nhds_one
#align uniform_fun.has_basis_nhds_zero UniformFun.hasBasis_nhds_zero

/-- Let `𝔖 : set (set α)`. If `G` is a uniform group, then `α →ᵤ[𝔖] G` is a uniform group as
well. -/
@[to_additive
      "Let `𝔖 : set (set α)`. If `G` is a uniform additive group, then `α →ᵤ[𝔖] G` is a\nuniform additive group as well. "]
instance : UniformGroup (α →ᵤ[𝔖] G) :=
  ⟨(-- Since `(/) : G × G → G` is uniformly continuous,
          -- `uniform_on_fun.postcomp_uniform_continuous` tells us that
          -- `((/) ∘ —) : (α →ᵤ[𝔖] G × G) → (α →ᵤ[𝔖] G)` is uniformly continuous too. By precomposing with
          -- `uniform_on_fun.uniform_equiv_prod_arrow`, this gives that
          -- `(/) : (α →ᵤ[𝔖] G) × (α →ᵤ[𝔖] G) → (α →ᵤ[𝔖] G)` is also uniformly continuous
          UniformOnFun.postcomp_uniformContinuous
          uniformContinuous_div).comp
      UniformOnFun.uniformEquivProdArrow.symm.UniformContinuous⟩

@[to_additive]
protected theorem UniformOnFun.hasBasis_nhds_one_of_basis (𝔖 : Set <| Set α) (h𝔖₁ : 𝔖.Nonempty)
    (h𝔖₂ : DirectedOn (· ⊆ ·) 𝔖) {p : ι → Prop} {b : ι → Set G}
    (h : (𝓝 1 : Filter G).HasBasis p b) :
    (𝓝 1 : Filter (α →ᵤ[𝔖] G)).HasBasis (fun Si : Set α × ι => Si.1 ∈ 𝔖 ∧ p Si.2) fun Si =>
      { f : α →ᵤ[𝔖] G | ∀ x ∈ Si.1, f x ∈ b Si.2 } :=
  by
  have := h.comap fun p : G × G => p.1 / p.2
  rw [← uniformity_eq_comap_nhds_one_swapped] at this
  convert UniformOnFun.hasBasis_nhds_of_basis α _ 𝔖 1 h𝔖₁ h𝔖₂ this
  ext (i f)
  simp [UniformOnFun.gen]
#align uniform_on_fun.has_basis_nhds_one_of_basis UniformOnFun.hasBasis_nhds_one_of_basis
#align uniform_on_fun.has_basis_nhds_zero_of_basis UniformOnFun.hasBasis_nhds_zero_of_basis

@[to_additive]
protected theorem UniformOnFun.hasBasis_nhds_one (𝔖 : Set <| Set α) (h𝔖₁ : 𝔖.Nonempty)
    (h𝔖₂ : DirectedOn (· ⊆ ·) 𝔖) :
    (𝓝 1 : Filter (α →ᵤ[𝔖] G)).HasBasis
      (fun SV : Set α × Set G => SV.1 ∈ 𝔖 ∧ SV.2 ∈ (𝓝 1 : Filter G)) fun SV =>
      { f : α →ᵤ[𝔖] G | ∀ x ∈ SV.1, f x ∈ SV.2 } :=
  UniformOnFun.hasBasis_nhds_one_of_basis 𝔖 h𝔖₁ h𝔖₂ (basis_sets _)
#align uniform_on_fun.has_basis_nhds_one UniformOnFun.hasBasis_nhds_one
#align uniform_on_fun.has_basis_nhds_zero UniformOnFun.hasBasis_nhds_zero

end Group

section Module

variable (𝕜 α E H : Type _) {hom : Type _} [NormedField 𝕜] [AddCommGroup H] [Module 𝕜 H]
  [AddCommGroup E] [Module 𝕜 E] [TopologicalSpace H] [UniformSpace E] [UniformAddGroup E]
  [ContinuousSMul 𝕜 E] {𝔖 : Set <| Set α} [LinearMapClass hom 𝕜 H (α →ᵤ[𝔖] E)]

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
/-- Let `E` be a TVS, `𝔖 : set (set α)` and `H` a submodule of `α →ᵤ[𝔖] E`. If the image of any
`S ∈ 𝔖` by any `u ∈ H` is bounded (in the sense of `bornology.is_vonN_bounded`), then `H`,
equipped with the topology of `𝔖`-convergence, is a TVS.

For convenience, we don't literally ask for `H : submodule (α →ᵤ[𝔖] E)`. Instead, we prove the
result for any vector space `H` equipped with a linear inducing to `α →ᵤ[𝔖] E`, which is often
easier to use. We also state the `submodule` version as
`uniform_on_fun.has_continuous_smul_submodule_of_image_bounded`. -/
theorem UniformOnFun.continuousSMul_induced_of_image_bounded (h𝔖₁ : 𝔖.Nonempty)
    (h𝔖₂ : DirectedOn (· ⊆ ·) 𝔖) (φ : hom) (hφ : Inducing φ)
    (h : ∀ u : H, ∀ s ∈ 𝔖, Bornology.IsVonNBounded 𝕜 ((φ u : α → E) '' s)) : ContinuousSMul 𝕜 H :=
  by
  have : TopologicalAddGroup H := by
    rw [hφ.induced]
    exact topologicalAddGroup_induced φ
  have : (𝓝 0 : Filter H).HasBasis _ _ :=
    by
    rw [hφ.induced, nhds_induced, map_zero]
    exact (UniformOnFun.hasBasis_nhds_zero 𝔖 h𝔖₁ h𝔖₂).comap φ
  refine' ContinuousSMul.of_basis_zero this _ _ _
  · rintro ⟨S, V⟩ ⟨hS, hV⟩
    have : tendsto (fun kx : 𝕜 × E => kx.1 • kx.2) (𝓝 (0, 0)) (𝓝 <| (0 : 𝕜) • 0) :=
      continuous_smul.tendsto (0 : 𝕜 × E)
    rw [zero_smul, nhds_prod_eq] at this
    have := this hV
    rw [mem_map, mem_prod_iff] at this
    rcases this with ⟨U, hU, W, hW, hUW⟩
    refine' ⟨U, hU, ⟨S, W⟩, ⟨hS, hW⟩, _⟩
    rw [Set.smul_subset_iff]
    intro a ha u hu x hx
    rw [SMulHomClass.map_smul]
    exact hUW (⟨ha, hu x hx⟩ : (a, φ u x) ∈ U ×ˢ W)
  · rintro a ⟨S, V⟩ ⟨hS, hV⟩
    have : tendsto (fun x : E => a • x) (𝓝 0) (𝓝 <| a • 0) := tendsto_id.const_smul a
    rw [smul_zero] at this
    refine' ⟨⟨S, (· • ·) a ⁻¹' V⟩, ⟨hS, this hV⟩, fun f hf x hx => _⟩
    rw [SMulHomClass.map_smul]
    exact hf x hx
  · rintro u ⟨S, V⟩ ⟨hS, hV⟩
    rcases h u S hS hV with ⟨r, hrpos, hr⟩
    rw [Metric.eventually_nhds_iff_ball]
    refine' ⟨r⁻¹, inv_pos.mpr hrpos, fun a ha x hx => _⟩
    by_cases ha0 : a = 0
    · rw [ha0]
      simp [mem_of_mem_nhds hV]
    · rw [mem_ball_zero_iff] at ha
      rw [SMulHomClass.map_smul, Pi.smul_apply]
      have : φ u x ∈ a⁻¹ • V :=
        by
        have ha0 : 0 < ‖a‖ := norm_pos_iff.mpr ha0
        refine' (hr a⁻¹ _) (Set.mem_image_of_mem (φ u) hx)
        rw [norm_inv, le_inv hrpos ha0]
        exact ha.le
      rwa [Set.mem_inv_smul_set_iff₀ ha0] at this
#align uniform_on_fun.has_continuous_smul_induced_of_image_bounded UniformOnFun.continuousSMul_induced_of_image_bounded

/-- Let `E` be a TVS, `𝔖 : set (set α)` and `H` a submodule of `α →ᵤ[𝔖] E`. If the image of any
`S ∈ 𝔖` by any `u ∈ H` is bounded (in the sense of `bornology.is_vonN_bounded`), then `H`,
equipped with the topology of `𝔖`-convergence, is a TVS.

If you have a hard time using this lemma, try the one above instead. -/
theorem UniformOnFun.continuousSMul_submodule_of_image_bounded (h𝔖₁ : 𝔖.Nonempty)
    (h𝔖₂ : DirectedOn (· ⊆ ·) 𝔖) (H : Submodule 𝕜 (α →ᵤ[𝔖] E))
    (h : ∀ u ∈ H, ∀ s ∈ 𝔖, Bornology.IsVonNBounded 𝕜 (u '' s)) :
    @ContinuousSMul 𝕜 H _ _ ((UniformOnFun.topologicalSpace α E 𝔖).induced (coe : H → α →ᵤ[𝔖] E)) :=
  haveI : TopologicalAddGroup H :=
    topologicalAddGroup_induced (linear_map.id.dom_restrict H : H →ₗ[𝕜] α → E)
  UniformOnFun.continuousSMul_induced_of_image_bounded 𝕜 α E H h𝔖₁ h𝔖₂
    (linear_map.id.dom_restrict H : H →ₗ[𝕜] α → E) inducing_subtype_val fun ⟨u, hu⟩ => h u hu
#align uniform_on_fun.has_continuous_smul_submodule_of_image_bounded UniformOnFun.continuousSMul_submodule_of_image_bounded

end Module


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

import linear_algebra.free_module.rank
import linear_algebra.free_module.finite.basic

/-!

# Rank of finite free modules

This is a basic API for the rank of finite free modules.

-/

--TODO: `linear_algebra/finite_dimensional` should import this file, and a lot of results should
--be moved here.

universes u v w

variables (R : Type u) (M : Type v) (N : Type w)

open_locale tensor_product direct_sum big_operators cardinal

open cardinal finite_dimensional fintype

namespace module.free

section ring

variables [ring R] [strong_rank_condition R]
variables [add_comm_group M] [module R M] [module.free R M] [module.finite R M]
variables [add_comm_group N] [module R N] [module.free R N] [module.finite R N]

/-- The rank of a finite and free module is finite. -/
lemma rank_lt_aleph_0 : module.rank R M < ℵ₀ :=
begin
  letI := nontrivial_of_invariant_basis_number R,
  rw [← (choose_basis R M).mk_eq_dim'', lt_aleph_0_iff_fintype],
  exact nonempty.intro infer_instance
end

/-- If `M` is finite and free, `finrank M = rank M`. -/
@[simp] lemma finrank_eq_rank : ↑(finrank R M) = module.rank R M :=
by { rw [finrank, cast_to_nat_of_lt_aleph_0 (rank_lt_aleph_0 R M)] }

/-- The finrank of a free module `M` over `R` is the cardinality of `choose_basis_index R M`. -/
lemma finrank_eq_card_choose_basis_index : finrank R M = @card (choose_basis_index R M)
  (@choose_basis_index.fintype R M _ _ _ _ (nontrivial_of_invariant_basis_number R) _) :=
begin
  letI := nontrivial_of_invariant_basis_number R,
  simp [finrank, rank_eq_card_choose_basis_index]
end

/-- The finrank of `(ι →₀ R)` is `fintype.card ι`. -/
@[simp] lemma finrank_finsupp {ι : Type v} [fintype ι] : finrank R (ι →₀ R) = card ι :=
by { rw [finrank, rank_finsupp, ← mk_to_nat_eq_card, to_nat_lift] }

/-- The finrank of `(ι → R)` is `fintype.card ι`. -/
lemma finrank_pi {ι : Type v} [fintype ι] : finrank R (ι → R) = card ι :=
by simp [finrank]

/-- The finrank of the direct sum is the sum of the finranks. -/
@[simp] lemma finrank_direct_sum  {ι : Type v} [fintype ι] (M : ι → Type w)
  [Π (i : ι), add_comm_group (M i)] [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)]
  [Π (i : ι), module.finite R (M i)] : finrank R (⨁ i, M i) = ∑ i, finrank R (M i) :=
begin
  letI := nontrivial_of_invariant_basis_number R,
  simp only [finrank, λ i, rank_eq_card_choose_basis_index R (M i), rank_direct_sum,
    ← mk_sigma, mk_to_nat_eq_card, card_sigma],
end

/-- The finrank of `M × N` is `(finrank R M) + (finrank R N)`. -/
@[simp] lemma finrank_prod : finrank R (M × N) = (finrank R M) + (finrank R N) :=
by { simp [finrank, rank_lt_aleph_0 R M, rank_lt_aleph_0 R N] }

/-- The finrank of a finite product is the sum of the finranks. -/
--TODO: this should follow from `linear_equiv.finrank_eq`, that is over a field.
lemma finrank_pi_fintype {ι : Type v} [fintype ι] {M : ι → Type w}
  [Π (i : ι), add_comm_group (M i)] [Π (i : ι), module R (M i)] [Π (i : ι), module.free R (M i)]
  [Π (i : ι), module.finite R (M i)] : finrank R (Π i, M i) = ∑ i, finrank R (M i) :=
begin
  letI := nontrivial_of_invariant_basis_number R,
  simp only [finrank, λ i, rank_eq_card_choose_basis_index R (M i), rank_pi_fintype,
    ← mk_sigma, mk_to_nat_eq_card, card_sigma],
end

/-- If `m` and `n` are `fintype`, the finrank of `m × n` matrices is
  `(fintype.card m) * (fintype.card n)`. -/
lemma finrank_matrix (m n : Type v) [fintype m] [fintype n] :
  finrank R (matrix m n R) = (card m) * (card n) :=
by { simp [finrank] }

end ring

section comm_ring

variables [comm_ring R] [strong_rank_condition R]
variables [add_comm_group M] [module R M] [module.free R M] [module.finite R M]
variables [add_comm_group N] [module R N] [module.free R N] [module.finite R N]

/-- The finrank of `M →ₗ[R] N` is `(finrank R M) * (finrank R N)`. -/
--TODO: this should follow from `linear_equiv.finrank_eq`, that is over a field.
lemma finrank_linear_hom : finrank R (M →ₗ[R] N) = (finrank R M) * (finrank R N) :=
begin
  classical,
  letI := nontrivial_of_invariant_basis_number R,
  have h := (linear_map.to_matrix (choose_basis R M) (choose_basis R N)),
  let b := (matrix.std_basis _ _ _).map h.symm,
  rw [finrank, dim_eq_card_basis b, ← mk_fintype, mk_to_nat_eq_card, finrank, finrank,
    rank_eq_card_choose_basis_index, rank_eq_card_choose_basis_index, mk_to_nat_eq_card,
    mk_to_nat_eq_card, card_prod, mul_comm]
end

/-- The finrank of `M ⊗[R] N` is `(finrank R M) * (finrank R N)`. -/
@[simp] lemma finrank_tensor_product (M : Type v) (N : Type w) [add_comm_group M] [module R M]
  [module.free R M] [add_comm_group N] [module R N] [module.free R N] :
finrank R (M ⊗[R] N) = (finrank R M) * (finrank R N) :=
by { simp [finrank] }

end comm_ring

end module.free


import game.world8.level13 -- hide
import game.world3.level9
namespace mynat -- hide

/-
# Advanced Multiplication World

## Level 1: `mul_pos`

Welcome to Advanced Multiplication World! Before attempting this
world you should have completed seven other worlds, including
Multiplication World and Advanced Addition World. There are four
levels in this world.

Recall that if `b : mynat` is a hypothesis and you do `cases b with n`,
your one goal will split into two goals,
namely the cases `b = 0` and `b = succ(n)`. So `cases` here is like
a weaker version of induction (you don't get the inductive hypothesis).

## Tricks

1) if your goal is `⊢ X ≠ Y` then `intro h` will give you `h : X = Y` and
a goal of `⊢ false`. This is because `X ≠ Y` *means* `(X = Y) → false`.
Conversely if your goal is `false` and you have `h : X ≠ Y` as a hypothesis
then `apply h` will turn the goal into `X = Y`.

2) if `hab : succ (3 * x + 2 * y + 1) = 0` is a hypothesis and your goal is `⊢ false`,
then `exact succ_ne_zero _ hab` will solve the goal, because Lean will figure
out that `_` is supposed to be `3 * x + 2 * y + 1`.

-/

/- Theorem
The product of two non-zero natural numbers is non-zero.
-/
theorem mul_pos (a b : mynat) : a ≠ 0 → b ≠ 0 → a * b ≠ 0 :=
begin [nat_num_game]
  intros ha hb,
  intro hab,
  cases b with b,
    apply hb,
    refl,
  rw mul_succ at hab,
  apply ha,
  cases a with a,
    refl,
  rw add_succ at hab,
  exfalso,
  exact succ_ne_zero _ hab,

end

end mynat -- hide


namespace hidden
  def divides (m n : ℕ) : Prop := ∃ k, m * k = n

  instance : has_dvd nat := ⟨divides⟩

  def even (n : ℕ) : Prop := 2 ∣ n -- You can enter the '∣' character by typing \mid

  section
    variables m n : ℕ

    #check m ∣ n
    #check m^n
    #check even (m^n +3)
  end

  def prime (n : ℕ) : Prop := ∀ m : ℕ, m > 1 ∧ m < n → ¬ (m ∣ n)

  def infinitely_many_primes : Prop := ∀ n : ℕ, ∃ p : ℕ, prime p ∧ p > n

  def Fermat_prime (n : ℕ) : Prop := (∃ m : ℕ, 2^(2^m) = n) ∧ prime n

  def infinitely_many_Fermat_primes : Prop := ∀ n : ℕ, ∃ p : ℕ, Fermat_prime p ∧ p > n

  def goldbach_conjecture : Prop := ∀ n : ℕ, n > 2 → even n → (∃ a b : ℕ, prime a ∧ prime b ∧ a + b = n)

  def Goldbach's_weak_conjecture : Prop := ∀ n : ℕ, n > 5 → ¬ even n → (∃ a b c : ℕ, prime a ∧ prime b ∧ prime c ∧ a + b + c = n)

  def Fermat's_last_theorem : Prop := ∀ n : ℕ, n > 2 → ¬ (∃ a b c : ℕ, a^n + b^n = c^n)
end hidden


/-
Copyright (c) 2022 Praneeth Kolichala. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Praneeth Kolichala
-/

import category_theory.groupoid
import algebraic_topology.fundamental_groupoid.basic
import topology.category.Top.limits
import topology.homotopy.product

/-!
# Fundamental groupoid preserves products
In this file, we give the following definitions/theorems:

  - `fundamental_groupoid_functor.pi_iso` An isomorphism between Π i, (π Xᵢ) and π (Πi, Xᵢ), whose
    inverse is precisely the product of the maps π (Π i, Xᵢ) → π (Xᵢ), each induced by
    the projection in `Top` Π i, Xᵢ → Xᵢ.

  - `fundamental_groupoid_functor.prod_iso` An isomorphism between πX × πY and π (X × Y), whose
    inverse is precisely the product of the maps π (X × Y) → πX and π (X × Y) → Y, each induced by
    the projections X × Y → X and X × Y → Y

  - `fundamental_groupoid_functor.preserves_product` A proof that the fundamental groupoid functor
    preserves all products.
-/

noncomputable theory

namespace fundamental_groupoid_functor

open_locale fundamental_groupoid

universes u

section pi

variables {I : Type u} (X : I → Top.{u})

/--
The projection map Π i, X i → X i induces a map π(Π i, X i) ⟶ π(X i).
-/
def proj (i : I) : πₓ (Top.of (Π i, X i)) ⥤ πₓ (X i) := πₘ ⟨_, continuous_apply i⟩

/-- The projection map is precisely path.homotopic.proj interpreted as a functor -/
@[simp] lemma proj_map (i : I) (x₀ x₁ : πₓ (Top.of (Π i, X i))) (p : x₀ ⟶ x₁) :
  (proj X i).map p = (@path.homotopic.proj _ _ _ _ _ i p) := rfl

/--
The map taking the pi product of a family of fundamental groupoids to the fundamental
groupoid of the pi product. This is actually an isomorphism (see `pi_iso`)
-/
@[simps]
def pi_to_pi_Top : (Π i, πₓ (X i)) ⥤ πₓ (Top.of (Π i, X i)) :=
{ obj := λ g, g,
  map := λ v₁ v₂ p, path.homotopic.pi p,
  map_id' :=
  begin
    intro x,
    change path.homotopic.pi (λ i, 𝟙 (x i)) = _,
    simp only [fundamental_groupoid.id_eq_path_refl, path.homotopic.pi_lift],
    refl,
  end,
  map_comp' := λ x y z f g, (path.homotopic.comp_pi_eq_pi_comp f g).symm, }

/--
Shows `pi_to_pi_Top` is an isomorphism, whose inverse is precisely the pi product
of the induced projections. This shows that `fundamental_groupoid_functor` preserves products.
-/
@[simps]
def pi_iso : category_theory.Groupoid.of (Π i : I, πₓ (X i)) ≅ πₓ (Top.of (Π i, X i)) :=
{ hom := pi_to_pi_Top X,
  inv := category_theory.functor.pi' (proj X),
  hom_inv_id' :=
  begin
    change pi_to_pi_Top X ⋙ (category_theory.functor.pi' (proj X)) = 𝟭 _,
    apply category_theory.functor.ext; intros,
    { ext, simp, }, { refl, },
  end,
  inv_hom_id' :=
  begin
    change (category_theory.functor.pi' (proj X)) ⋙ pi_to_pi_Top X = 𝟭 _,
    apply category_theory.functor.ext; intros,
    { suffices : path.homotopic.pi ((category_theory.functor.pi' (proj X)).map f) = f, { simpa, },
      change (category_theory.functor.pi' (proj X)).map f
        with λ i, (category_theory.functor.pi' (proj X)).map f i,
      simp, }, { refl, }
  end }

section preserves
open category_theory

/-- Equivalence between the categories of cones over the objects `π Xᵢ` written in two ways -/
def cone_discrete_comp : limits.cone (discrete.functor X ⋙ π) ≌
  limits.cone (discrete.functor (λ i, πₓ (X i))) :=
limits.cones.postcompose_equivalence (discrete.comp_nat_iso_discrete X π)

lemma cone_discrete_comp_obj_map_cone :
  (cone_discrete_comp X).functor.obj ((π).map_cone (Top.pi_fan.{u} X))
  = limits.fan.mk (πₓ (Top.of (Π i, X i))) (proj X) := rfl

/-- This is `pi_iso.inv` as a cone morphism (in fact, isomorphism) -/
def pi_Top_to_pi_cone : (limits.fan.mk (πₓ (Top.of (Π i, X i))) (proj X)) ⟶
  Groupoid.pi_limit_fan (λ i : I, (πₓ (X i))) := { hom := category_theory.functor.pi' (proj X) }

instance : is_iso (pi_Top_to_pi_cone X) :=
begin
  haveI : is_iso (pi_Top_to_pi_cone X).hom := (infer_instance : is_iso (pi_iso X).inv),
  exact limits.cones.cone_iso_of_hom_iso (pi_Top_to_pi_cone X),
end

/-- The fundamental groupoid functor preserves products -/
def preserves_product : limits.preserves_limit (discrete.functor X) π :=
begin
  apply limits.preserves_limit_of_preserves_limit_cone (Top.pi_fan_is_limit.{u} X),
  apply (limits.is_limit.of_cone_equiv (cone_discrete_comp X)).to_fun,
  simp only [cone_discrete_comp_obj_map_cone],
  apply limits.is_limit.of_iso_limit _ (as_iso (pi_Top_to_pi_cone X)).symm,
  exact Groupoid.pi_limit_fan_is_limit _,
end

end preserves

end pi

section prod

variables (A B : Top.{u})

/-- The induced map of the left projection map X × Y → X -/
def proj_left : πₓ (Top.of (A × B)) ⥤ πₓ A := πₘ ⟨_, continuous_fst⟩

/-- The induced map of the right projection map X × Y → Y -/
def proj_right : πₓ (Top.of (A × B)) ⥤ πₓ B := πₘ ⟨_, continuous_snd⟩

@[simp] lemma proj_left_map (x₀ x₁ : πₓ (Top.of (A × B))) (p : x₀ ⟶ x₁) :
  (proj_left A B).map p = path.homotopic.proj_left p := rfl

@[simp] lemma proj_right_map (x₀ x₁ : πₓ (Top.of (A × B))) (p : x₀ ⟶ x₁) :
  (proj_right A B).map p = path.homotopic.proj_right p := rfl

/--
The map taking the product of two fundamental groupoids to the fundamental groupoid of the product
of the two topological spaces. This is in fact an isomorphism (see `prod_iso`).
-/
@[simps obj]
def prod_to_prod_Top : (πₓ A) × (πₓ B) ⥤ πₓ (Top.of (A × B)) :=
{ obj := λ g, g,
  map := λ x y p, match x, y, p with
    | (x₀, x₁), (y₀, y₁), (p₀, p₁) := path.homotopic.prod p₀ p₁
  end,
  map_id' :=
  begin
    rintro ⟨x₀, x₁⟩,
    simp only [category_theory.prod_id, fundamental_groupoid.id_eq_path_refl],
    unfold_aux, rw path.homotopic.prod_lift, refl,
  end,
  map_comp' := λ x y z f g, match x, y, z, f, g with
    | (x₀, x₁), (y₀, y₁), (z₀, z₁), (f₀, f₁), (g₀, g₁) :=
    (path.homotopic.comp_prod_eq_prod_comp f₀ f₁ g₀ g₁).symm
  end }

lemma prod_to_prod_Top_map {x₀ x₁ : πₓ A} {y₀ y₁ : πₓ B}
  (p₀ : x₀ ⟶ x₁) (p₁ : y₀ ⟶ y₁) :
  @category_theory.functor.map _ _ _ _
  (prod_to_prod_Top A B) (x₀, y₀) (x₁, y₁) (p₀, p₁) = path.homotopic.prod p₀ p₁ := rfl

/--
Shows `prod_to_prod_Top` is an isomorphism, whose inverse is precisely the product
of the induced left and right projections.
-/
@[simps]
def prod_iso : category_theory.Groupoid.of ((πₓ A) × (πₓ B)) ≅ (πₓ (Top.of (A × B))) :=
{ hom := prod_to_prod_Top A B,
  inv := (proj_left A B).prod' (proj_right A B),
  hom_inv_id' :=
  begin
    change prod_to_prod_Top A B ⋙ ((proj_left A B).prod' (proj_right A B)) = 𝟭 _,
    apply category_theory.functor.hext, { intros, ext; simp; refl, },
    rintros ⟨x₀, x₁⟩ ⟨y₀, y₁⟩ ⟨f₀, f₁⟩,
    have := and.intro (path.homotopic.proj_left_prod f₀ f₁) (path.homotopic.proj_right_prod f₀ f₁),
    simpa,
  end,
  inv_hom_id' :=
  begin
    change ((proj_left A B).prod' (proj_right A B)) ⋙ prod_to_prod_Top A B = 𝟭 _,
    apply category_theory.functor.hext, { intros, ext; simp; refl, },
    rintros ⟨x₀, x₁⟩ ⟨y₀, y₁⟩ f,
    have := path.homotopic.prod_proj_left_proj_right f,
    simpa,
  end }

end prod

end fundamental_groupoid_functor