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

! This file was ported from Lean 3 source module analysis.inner_product_space.l2_space
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.InnerProductSpace.Projection
import Mathbin.Analysis.NormedSpace.LpSpace
import Mathbin.Analysis.InnerProductSpace.PiL2

/-!
# Hilbert sum of a family of inner product spaces

Given a family `(G : ι → Type*) [Π i, inner_product_space 𝕜 (G i)]` of inner product spaces, this
file equips `lp G 2` with an inner product space structure, where `lp G 2` consists of those
dependent functions `f : Π i, G i` for which `∑' i, ‖f i‖ ^ 2`, the sum of the norms-squared, is
summable.  This construction is sometimes called the *Hilbert sum* of the family `G`.  By choosing
`G` to be `ι → 𝕜`, the Hilbert space `ℓ²(ι, 𝕜)` may be seen as a special case of this construction.

We also define a *predicate* `is_hilbert_sum 𝕜 G V`, where `V : Π i, G i →ₗᵢ[𝕜] E`, expressing that
`V` is an `orthogonal_family` and that the associated map `lp G 2 →ₗᵢ[𝕜] E` is surjective.

## Main definitions

* `orthogonal_family.linear_isometry`: Given a Hilbert space `E`, a family `G` of inner product
  spaces and a family `V : Π i, G i →ₗᵢ[𝕜] E` of isometric embeddings of the `G i` into `E` with
  mutually-orthogonal images, there is an induced isometric embedding of the Hilbert sum of `G`
  into `E`.

* `is_hilbert_sum`: Given a Hilbert space `E`, a family `G` of inner product
  spaces and a family `V : Π i, G i →ₗᵢ[𝕜] E` of isometric embeddings of the `G i` into `E`,
  `is_hilbert_sum 𝕜 G V` means that `V` is an `orthogonal_family` and that the above
  linear isometry is surjective.

* `is_hilbert_sum.linear_isometry_equiv`: If a Hilbert space `E` is a Hilbert sum of the
  inner product spaces `G i` with respect to the family `V : Π i, G i →ₗᵢ[𝕜] E`, then the
  corresponding `orthogonal_family.linear_isometry` can be upgraded to a `linear_isometry_equiv`.

* `hilbert_basis`: We define a *Hilbert basis* of a Hilbert space `E` to be a structure whose single
  field `hilbert_basis.repr` is an isometric isomorphism of `E` with `ℓ²(ι, 𝕜)` (i.e., the Hilbert
  sum of `ι` copies of `𝕜`).  This parallels the definition of `basis`, in `linear_algebra.basis`,
  as an isomorphism of an `R`-module with `ι →₀ R`.

* `hilbert_basis.has_coe_to_fun`: More conventionally a Hilbert basis is thought of as a family
  `ι → E` of vectors in `E` satisfying certain properties (orthonormality, completeness).  We obtain
  this interpretation of a Hilbert basis `b` by defining `⇑b`, of type `ι → E`, to be the image
  under `b.repr` of `lp.single 2 i (1:𝕜)`.  This parallels the definition `basis.has_coe_to_fun` in
  `linear_algebra.basis`.

* `hilbert_basis.mk`: Make a Hilbert basis of `E` from an orthonormal family `v : ι → E` of vectors
  in `E` whose span is dense.  This parallels the definition `basis.mk` in `linear_algebra.basis`.

* `hilbert_basis.mk_of_orthogonal_eq_bot`: Make a Hilbert basis of `E` from an orthonormal family
  `v : ι → E` of vectors in `E` whose span has trivial orthogonal complement.

## Main results

* `lp.inner_product_space`: Construction of the inner product space instance on the Hilbert sum
  `lp G 2`.  Note that from the file `analysis.normed_space.lp_space`, the space `lp G 2` already
  held a normed space instance (`lp.normed_space`), and if each `G i` is a Hilbert space (i.e.,
  complete), then `lp G 2` was already known to be complete (`lp.complete_space`).  So the work
  here is to define the inner product and show it is compatible.

* `orthogonal_family.range_linear_isometry`: Given a family `G` of inner product spaces and a family
  `V : Π i, G i →ₗᵢ[𝕜] E` of isometric embeddings of the `G i` into `E` with mutually-orthogonal
  images, the image of the embedding `orthogonal_family.linear_isometry` of the Hilbert sum of `G`
  into `E` is the closure of the span of the images of the `G i`.

* `hilbert_basis.repr_apply_apply`: Given a Hilbert basis `b` of `E`, the entry `b.repr x i` of
  `x`'s representation in `ℓ²(ι, 𝕜)` is the inner product `⟪b i, x⟫`.

* `hilbert_basis.has_sum_repr`: Given a Hilbert basis `b` of `E`, a vector `x` in `E` can be
  expressed as the "infinite linear combination" `∑' i, b.repr x i • b i` of the basis vectors
  `b i`, with coefficients given by the entries `b.repr x i` of `x`'s representation in `ℓ²(ι, 𝕜)`.

* `exists_hilbert_basis`: A Hilbert space admits a Hilbert basis.

## Keywords

Hilbert space, Hilbert sum, l2, Hilbert basis, unitary equivalence, isometric isomorphism
-/

open IsROrC Submodule Filter

open BigOperators NNReal ENNReal Classical ComplexConjugate Topology

noncomputable section

variable {ι : Type _}

variable {𝕜 : Type _} [IsROrC 𝕜] {E : Type _}

variable [NormedAddCommGroup E] [InnerProductSpace 𝕜 E] [cplt : CompleteSpace E]

variable {G : ι → Type _} [∀ i, NormedAddCommGroup (G i)] [∀ i, InnerProductSpace 𝕜 (G i)]

-- mathport name: «expr⟪ , ⟫»
local notation "⟪" x ", " y "⟫" => @inner 𝕜 _ _ x y

-- mathport name: «exprℓ²( , )»
notation "ℓ²(" ι ", " 𝕜 ")" => lp (fun i : ι => 𝕜) 2

/-! ### Inner product space structure on `lp G 2` -/

namespace lp

theorem summable_inner (f g : lp G 2) : Summable fun i => ⟪f i, g i⟫ :=
  by
  -- Apply the Direct Comparison Test, comparing with ∑' i, ‖f i‖ * ‖g i‖ (summable by Hölder)
  refine' summable_of_norm_bounded (fun i => ‖f i‖ * ‖g i‖) (lp.summable_mul _ f g) _
  · rw [Real.isConjugateExponent_iff] <;> norm_num
  intro i
  -- Then apply Cauchy-Schwarz pointwise
  exact norm_inner_le_norm _ _
#align lp.summable_inner lp.summable_inner

instance : InnerProductSpace 𝕜 (lp G 2) :=
  { lp.normedSpace with
    inner := fun f g => ∑' i, ⟪f i, g i⟫
    norm_sq_eq_inner := fun f =>
      by
      calc
        ‖f‖ ^ 2 = ‖f‖ ^ (2 : ℝ≥0∞).toReal := by norm_cast
        _ = ∑' i, ‖f i‖ ^ (2 : ℝ≥0∞).toReal := (lp.norm_rpow_eq_tsum _ f)
        _ = ∑' i, ‖f i‖ ^ 2 := by norm_cast
        _ = ∑' i, re ⟪f i, f i⟫ := by simp only [@norm_sq_eq_inner 𝕜]
        _ = re (∑' i, ⟪f i, f i⟫) := (is_R_or_C.re_clm.map_tsum _).symm
        _ = _ := by congr

      · norm_num
      · exact summable_inner f f
    conj_symm := fun f g => by
      calc
        conj _ = conj (∑' i, ⟪g i, f i⟫) := by congr
        _ = ∑' i, conj ⟪g i, f i⟫ := is_R_or_C.conj_cle.map_tsum
        _ = ∑' i, ⟪f i, g i⟫ := by simp only [inner_conj_symm]
        _ = _ := by congr

    add_left := fun f₁ f₂ g =>
      by
      calc
        _ = ∑' i, ⟪(f₁ + f₂) i, g i⟫ := _
        _ = ∑' i, ⟪f₁ i, g i⟫ + ⟪f₂ i, g i⟫ := by
          simp only [inner_add_left, Pi.add_apply, coe_fn_add]
        _ = (∑' i, ⟪f₁ i, g i⟫) + ∑' i, ⟪f₂ i, g i⟫ := (tsum_add _ _)
        _ = _ := by congr

      · congr
      · exact summable_inner f₁ g
      · exact summable_inner f₂ g
    smul_left := fun f g c =>
      by
      calc
        _ = ∑' i, ⟪c • f i, g i⟫ := _
        _ = ∑' i, conj c * ⟪f i, g i⟫ := by simp only [inner_smul_left]
        _ = conj c * ∑' i, ⟪f i, g i⟫ := tsum_mul_left
        _ = _ := _

      · simp only [coe_fn_smul, Pi.smul_apply]
      · congr }

theorem inner_eq_tsum (f g : lp G 2) : ⟪f, g⟫ = ∑' i, ⟪f i, g i⟫ :=
  rfl
#align lp.inner_eq_tsum lp.inner_eq_tsum

theorem hasSum_inner (f g : lp G 2) : HasSum (fun i => ⟪f i, g i⟫) ⟪f, g⟫ :=
  (summable_inner f g).HasSum
#align lp.has_sum_inner lp.hasSum_inner

theorem inner_single_left (i : ι) (a : G i) (f : lp G 2) : ⟪lp.single 2 i a, f⟫ = ⟪a, f i⟫ :=
  by
  refine' (has_sum_inner (lp.single 2 i a) f).unique _
  convert hasSum_ite_eq i ⟪a, f i⟫
  ext j
  rw [lp.single_apply]
  split_ifs
  · subst h
  · simp
#align lp.inner_single_left lp.inner_single_left

theorem inner_single_right (i : ι) (a : G i) (f : lp G 2) : ⟪f, lp.single 2 i a⟫ = ⟪f i, a⟫ := by
  simpa [inner_conj_symm] using congr_arg conj (@inner_single_left _ 𝕜 _ _ _ _ i a f)
#align lp.inner_single_right lp.inner_single_right

end lp

/-! ### Identification of a general Hilbert space `E` with a Hilbert sum -/

namespace OrthogonalFamily

variable {V : ∀ i, G i →ₗᵢ[𝕜] E} (hV : OrthogonalFamily 𝕜 G V)

include cplt hV

protected theorem summable_of_lp (f : lp G 2) : Summable fun i => V i (f i) :=
  by
  rw [hV.summable_iff_norm_sq_summable]
  convert(lp.memℓp f).Summable _
  · norm_cast
  · norm_num
#align orthogonal_family.summable_of_lp OrthogonalFamily.summable_of_lp

/-- A mutually orthogonal family of subspaces of `E` induce a linear isometry from `lp 2` of the
subspaces into `E`. -/
protected def linearIsometry : lp G 2 →ₗᵢ[𝕜] E
    where
  toFun f := ∑' i, V i (f i)
  map_add' f g := by
    simp only [tsum_add (hV.summable_of_lp f) (hV.summable_of_lp g), lp.coeFn_add, Pi.add_apply,
      LinearIsometry.map_add]
  map_smul' c f := by
    simpa only [LinearIsometry.map_smul, Pi.smul_apply, lp.coeFn_smul] using
      tsum_const_smul c (hV.summable_of_lp f)
  norm_map' f := by
    classical
      -- needed for lattice instance on `finset ι`, for `filter.at_top_ne_bot`
      have H : 0 < (2 : ℝ≥0∞).toReal := by norm_num
      suffices ‖∑' i : ι, V i (f i)‖ ^ (2 : ℝ≥0∞).toReal = ‖f‖ ^ (2 : ℝ≥0∞).toReal by
        exact Real.rpow_left_injOn H.ne' (norm_nonneg _) (norm_nonneg _) this
      refine' tendsto_nhds_unique _ (lp.hasSum_norm H f)
      convert(hV.summable_of_lp f).HasSum.norm.rpow_const (Or.inr H.le)
      ext s
      exact_mod_cast (hV.norm_sum f s).symm
#align orthogonal_family.linear_isometry OrthogonalFamily.linearIsometry

protected theorem linearIsometry_apply (f : lp G 2) : hV.LinearIsometry f = ∑' i, V i (f i) :=
  rfl
#align orthogonal_family.linear_isometry_apply OrthogonalFamily.linearIsometry_apply

protected theorem hasSum_linearIsometry (f : lp G 2) :
    HasSum (fun i => V i (f i)) (hV.LinearIsometry f) :=
  (hV.summable_of_lp f).HasSum
#align orthogonal_family.has_sum_linear_isometry OrthogonalFamily.hasSum_linearIsometry

@[simp]
protected theorem linearIsometry_apply_single {i : ι} (x : G i) :
    hV.LinearIsometry (lp.single 2 i x) = V i x :=
  by
  rw [hV.linear_isometry_apply, ← tsum_ite_eq i (V i x)]
  congr
  ext j
  rw [lp.single_apply]
  split_ifs
  · subst h
  · simp
#align orthogonal_family.linear_isometry_apply_single OrthogonalFamily.linearIsometry_apply_single

@[simp]
protected theorem linearIsometry_apply_dfinsupp_sum_single (W₀ : Π₀ i : ι, G i) :
    hV.LinearIsometry (W₀.Sum (lp.single 2)) = W₀.Sum fun i => V i :=
  by
  have :
    hV.linear_isometry (∑ i in W₀.support, lp.single 2 i (W₀ i)) =
      ∑ i in W₀.support, hV.linear_isometry (lp.single 2 i (W₀ i)) :=
    hV.linear_isometry.to_linear_map.map_sum
  simp (config := { contextual := true }) [Dfinsupp.sum, this]
#align orthogonal_family.linear_isometry_apply_dfinsupp_sum_single OrthogonalFamily.linearIsometry_apply_dfinsupp_sum_single

/-- The canonical linear isometry from the `lp 2` of a mutually orthogonal family of subspaces of
`E` into E, has range the closure of the span of the subspaces. -/
protected theorem range_linearIsometry [∀ i, CompleteSpace (G i)] :
    hV.LinearIsometry.toLinearMap.range = (⨆ i, (V i).toLinearMap.range).topologicalClosure :=
  by
  refine' le_antisymm _ _
  · rintro x ⟨f, rfl⟩
    refine' mem_closure_of_tendsto (hV.has_sum_linear_isometry f) (eventually_of_forall _)
    intro s
    rw [SetLike.mem_coe]
    refine' sum_mem _
    intro i hi
    refine' mem_supr_of_mem i _
    exact LinearMap.mem_range_self _ (f i)
  · apply topological_closure_minimal
    · refine' supᵢ_le _
      rintro i x ⟨x, rfl⟩
      use lp.single 2 i x
      exact hV.linear_isometry_apply_single x
    exact hV.linear_isometry.isometry.uniform_inducing.is_complete_range.is_closed
#align orthogonal_family.range_linear_isometry OrthogonalFamily.range_linearIsometry

end OrthogonalFamily

section IsHilbertSum

variable (𝕜 G) (V : ∀ i, G i →ₗᵢ[𝕜] E) (F : ι → Submodule 𝕜 E)

include cplt

/-- Given a family of Hilbert spaces `G : ι → Type*`, a Hilbert sum of `G` consists of a Hilbert
space `E` and an orthogonal family `V : Π i, G i →ₗᵢ[𝕜] E` such that the induced isometry
`Φ : lp G 2 → E` is surjective.

Keeping in mind that `lp G 2` is "the" external Hilbert sum of `G : ι → Type*`, this is analogous
to `direct_sum.is_internal`, except that we don't express it in terms of actual submodules. -/
@[protect_proj]
structure IsHilbertSum : Prop where ofSurjective ::
  OrthogonalFamily : OrthogonalFamily 𝕜 G V
  surjective_isometry : Function.Surjective OrthogonalFamily.LinearIsometry
#align is_hilbert_sum IsHilbertSum

variable {𝕜 G V}

/-- If `V : Π i, G i →ₗᵢ[𝕜] E` is an orthogonal family such that the supremum of the ranges of
`V i` is dense, then `(E, V)` is a Hilbert sum of `G`. -/
theorem IsHilbertSum.mk [∀ i, CompleteSpace <| G i] (hVortho : OrthogonalFamily 𝕜 G V)
    (hVtotal : ⊤ ≤ (⨆ i, (V i).toLinearMap.range).topologicalClosure) : IsHilbertSum 𝕜 G V :=
  { OrthogonalFamily := hVortho
    surjective_isometry := by
      rw [← LinearIsometry.coe_toLinearMap]
      exact
        linear_map.range_eq_top.mp
          (eq_top_iff.mpr <| hVtotal.trans_eq hVortho.range_linear_isometry.symm) }
#align is_hilbert_sum.mk IsHilbertSum.mk

/-- This is `orthogonal_family.is_hilbert_sum` in the case of actual inclusions from subspaces. -/
theorem IsHilbertSum.mkInternal [∀ i, CompleteSpace <| F i]
    (hFortho : OrthogonalFamily 𝕜 (fun i => F i) fun i => (F i).subtypeₗᵢ)
    (hFtotal : ⊤ ≤ (⨆ i, F i).topologicalClosure) :
    IsHilbertSum 𝕜 (fun i => F i) fun i => (F i).subtypeₗᵢ :=
  IsHilbertSum.mk hFortho (by simpa [subtypeₗᵢ_to_linear_map, range_subtype] using hFtotal)
#align is_hilbert_sum.mk_internal IsHilbertSum.mkInternal

/-- *A* Hilbert sum `(E, V)` of `G` is canonically isomorphic to *the* Hilbert sum of `G`,
i.e `lp G 2`.

Note that this goes in the opposite direction from `orthogonal_family.linear_isometry`. -/
noncomputable def IsHilbertSum.linearIsometryEquiv (hV : IsHilbertSum 𝕜 G V) : E ≃ₗᵢ[𝕜] lp G 2 :=
  LinearIsometryEquiv.symm <|
    LinearIsometryEquiv.ofSurjective hV.OrthogonalFamily.LinearIsometry hV.surjective_isometry
#align is_hilbert_sum.linear_isometry_equiv IsHilbertSum.linearIsometryEquiv

/-- In the canonical isometric isomorphism between a Hilbert sum `E` of `G` and `lp G 2`,
a vector `w : lp G 2` is the image of the infinite sum of the associated elements in `E`. -/
protected theorem IsHilbertSum.linearIsometryEquiv_symm_apply (hV : IsHilbertSum 𝕜 G V)
    (w : lp G 2) : hV.LinearIsometryEquiv.symm w = ∑' i, V i (w i) := by
  simp [IsHilbertSum.linearIsometryEquiv, OrthogonalFamily.linearIsometry_apply]
#align is_hilbert_sum.linear_isometry_equiv_symm_apply IsHilbertSum.linearIsometryEquiv_symm_apply

/-- In the canonical isometric isomorphism between a Hilbert sum `E` of `G` and `lp G 2`,
a vector `w : lp G 2` is the image of the infinite sum of the associated elements in `E`, and this
sum indeed converges. -/
protected theorem IsHilbertSum.hasSum_linearIsometryEquiv_symm (hV : IsHilbertSum 𝕜 G V)
    (w : lp G 2) : HasSum (fun i => V i (w i)) (hV.LinearIsometryEquiv.symm w) := by
  simp [IsHilbertSum.linearIsometryEquiv, OrthogonalFamily.hasSum_linearIsometry]
#align is_hilbert_sum.has_sum_linear_isometry_equiv_symm IsHilbertSum.hasSum_linearIsometryEquiv_symm

/-- In the canonical isometric isomorphism between a Hilbert sum `E` of `G : ι → Type*` and
`lp G 2`, an "elementary basis vector" in `lp G 2` supported at `i : ι` is the image of the
associated element in `E`. -/
@[simp]
protected theorem IsHilbertSum.linearIsometryEquiv_symm_apply_single (hV : IsHilbertSum 𝕜 G V)
    {i : ι} (x : G i) : hV.LinearIsometryEquiv.symm (lp.single 2 i x) = V i x := by
  simp [IsHilbertSum.linearIsometryEquiv, OrthogonalFamily.linearIsometry_apply_single]
#align is_hilbert_sum.linear_isometry_equiv_symm_apply_single IsHilbertSum.linearIsometryEquiv_symm_apply_single

/-- In the canonical isometric isomorphism between a Hilbert sum `E` of `G : ι → Type*` and
`lp G 2`, a finitely-supported vector in `lp G 2` is the image of the associated finite sum of
elements of `E`. -/
@[simp]
protected theorem IsHilbertSum.linearIsometryEquiv_symm_apply_dfinsupp_sum_single
    (hV : IsHilbertSum 𝕜 G V) (W₀ : Π₀ i : ι, G i) :
    hV.LinearIsometryEquiv.symm (W₀.Sum (lp.single 2)) = W₀.Sum fun i => V i := by
  simp [IsHilbertSum.linearIsometryEquiv, OrthogonalFamily.linearIsometry_apply_dfinsupp_sum_single]
#align is_hilbert_sum.linear_isometry_equiv_symm_apply_dfinsupp_sum_single IsHilbertSum.linearIsometryEquiv_symm_apply_dfinsupp_sum_single

/-- In the canonical isometric isomorphism between a Hilbert sum `E` of `G : ι → Type*` and
`lp G 2`, a finitely-supported vector in `lp G 2` is the image of the associated finite sum of
elements of `E`. -/
@[simp]
protected theorem IsHilbertSum.linearIsometryEquiv_apply_dfinsupp_sum_single
    (hV : IsHilbertSum 𝕜 G V) (W₀ : Π₀ i : ι, G i) :
    (hV.LinearIsometryEquiv (W₀.Sum fun i => V i) : ∀ i, G i) = W₀ :=
  by
  rw [← hV.linear_isometry_equiv_symm_apply_dfinsupp_sum_single]
  rw [LinearIsometryEquiv.apply_symm_apply]
  ext i
  simp (config := { contextual := true }) [Dfinsupp.sum, lp.single_apply]
#align is_hilbert_sum.linear_isometry_equiv_apply_dfinsupp_sum_single IsHilbertSum.linearIsometryEquiv_apply_dfinsupp_sum_single

/-- Given a total orthonormal family `v : ι → E`, `E` is a Hilbert sum of `λ i : ι, 𝕜` relative to
the family of linear isometries `λ i, λ k, k • v i`. -/
theorem Orthonormal.isHilbertSum {v : ι → E} (hv : Orthonormal 𝕜 v)
    (hsp : ⊤ ≤ (span 𝕜 (Set.range v)).topologicalClosure) :
    IsHilbertSum 𝕜 (fun i : ι => 𝕜) fun i => LinearIsometry.toSpanSingleton 𝕜 E (hv.1 i) :=
  IsHilbertSum.mk hv.OrthogonalFamily
    (by
      convert hsp
      simp [← LinearMap.span_singleton_eq_range, ← Submodule.span_unionᵢ])
#align orthonormal.is_hilbert_sum Orthonormal.isHilbertSum

theorem Submodule.isHilbertSumOrthogonal (K : Submodule 𝕜 E) [hK : CompleteSpace K] :
    IsHilbertSum 𝕜 (fun b => ↥(cond b K Kᗮ)) fun b => (cond b K Kᗮ).subtypeₗᵢ :=
  by
  have : ∀ b, CompleteSpace ↥(cond b K Kᗮ) := by
    intro b
    cases b <;> first |exact orthogonal.complete_space K|assumption
  refine' IsHilbertSum.mkInternal _ K.orthogonal_family_self _
  refine' le_trans _ (Submodule.le_topologicalClosure _)
  rw [supᵢ_bool_eq, cond, cond]
  refine' Codisjoint.top_le _
  exact submodule.is_compl_orthogonal_of_complete_space.codisjoint
#align submodule.is_hilbert_sum_orthogonal Submodule.isHilbertSumOrthogonal

end IsHilbertSum

/-! ### Hilbert bases -/

section

variable (ι) (𝕜) (E)

/-- A Hilbert basis on `ι` for an inner product space `E` is an identification of `E` with the `lp`
space `ℓ²(ι, 𝕜)`. -/
structure HilbertBasis where ofRepr ::
  repr : E ≃ₗᵢ[𝕜] ℓ²(ι, 𝕜)
#align hilbert_basis HilbertBasis

end

namespace HilbertBasis

instance {ι : Type _} : Inhabited (HilbertBasis ι 𝕜 ℓ²(ι, 𝕜)) :=
  ⟨of_repr (LinearIsometryEquiv.refl 𝕜 _)⟩

/-- `b i` is the `i`th basis vector. -/
instance : CoeFun (HilbertBasis ι 𝕜 E) fun _ => ι → E
    where coe b i := b.repr.symm (lp.single 2 i (1 : 𝕜))

@[simp]
protected theorem repr_symm_single (b : HilbertBasis ι 𝕜 E) (i : ι) :
    b.repr.symm (lp.single 2 i (1 : 𝕜)) = b i :=
  rfl
#align hilbert_basis.repr_symm_single HilbertBasis.repr_symm_single

@[simp]
protected theorem repr_self (b : HilbertBasis ι 𝕜 E) (i : ι) :
    b.repr (b i) = lp.single 2 i (1 : 𝕜) := by
  rw [← b.repr_symm_single, LinearIsometryEquiv.apply_symm_apply]
#align hilbert_basis.repr_self HilbertBasis.repr_self

protected theorem repr_apply_apply (b : HilbertBasis ι 𝕜 E) (v : E) (i : ι) :
    b.repr v i = ⟪b i, v⟫ :=
  by
  rw [← b.repr.inner_map_map (b i) v, b.repr_self, lp.inner_single_left]
  simp
#align hilbert_basis.repr_apply_apply HilbertBasis.repr_apply_apply

@[simp]
protected theorem orthonormal (b : HilbertBasis ι 𝕜 E) : Orthonormal 𝕜 b :=
  by
  rw [orthonormal_iff_ite]
  intro i j
  rw [← b.repr.inner_map_map (b i) (b j), b.repr_self, b.repr_self, lp.inner_single_left,
    lp.single_apply]
  simp
#align hilbert_basis.orthonormal HilbertBasis.orthonormal

protected theorem hasSum_repr_symm (b : HilbertBasis ι 𝕜 E) (f : ℓ²(ι, 𝕜)) :
    HasSum (fun i => f i • b i) (b.repr.symm f) :=
  by
  suffices H :
    (fun i : ι => f i • b i) = fun b_1 : ι =>
      b.repr.symm.to_continuous_linear_equiv ((fun i : ι => lp.single 2 i (f i)) b_1)
  · rw [H]
    have : HasSum (fun i : ι => lp.single 2 i (f i)) f := lp.hasSum_single ENNReal.two_ne_top f
    exact (↑b.repr.symm.to_continuous_linear_equiv : ℓ²(ι, 𝕜) →L[𝕜] E).HasSum this
  ext i
  apply b.repr.injective
  letI : NormedSpace 𝕜 ↥(lp (fun i : ι => 𝕜) 2) := by infer_instance
  have : lp.single 2 i (f i * 1) = f i • lp.single 2 i 1 := lp.single_smul 2 i (1 : 𝕜) (f i)
  rw [mul_one] at this
  rw [LinearIsometryEquiv.map_smul, b.repr_self, ← this,
    LinearIsometryEquiv.coe_toContinuousLinearEquiv]
  exact (b.repr.apply_symm_apply (lp.single 2 i (f i))).symm
#align hilbert_basis.has_sum_repr_symm HilbertBasis.hasSum_repr_symm

protected theorem hasSum_repr (b : HilbertBasis ι 𝕜 E) (x : E) :
    HasSum (fun i => b.repr x i • b i) x := by simpa using b.has_sum_repr_symm (b.repr x)
#align hilbert_basis.has_sum_repr HilbertBasis.hasSum_repr

@[simp]
protected theorem dense_span (b : HilbertBasis ι 𝕜 E) :
    (span 𝕜 (Set.range b)).topologicalClosure = ⊤ := by
  classical
    rw [eq_top_iff]
    rintro x -
    refine' mem_closure_of_tendsto (b.has_sum_repr x) (eventually_of_forall _)
    intro s
    simp only [SetLike.mem_coe]
    refine' sum_mem _
    rintro i -
    refine' smul_mem _ _ _
    exact subset_span ⟨i, rfl⟩
#align hilbert_basis.dense_span HilbertBasis.dense_span

protected theorem hasSum_inner_mul_inner (b : HilbertBasis ι 𝕜 E) (x y : E) :
    HasSum (fun i => ⟪x, b i⟫ * ⟪b i, y⟫) ⟪x, y⟫ :=
  by
  convert(b.has_sum_repr y).mapL (innerSL _ x)
  ext i
  rw [innerSL_apply, b.repr_apply_apply, inner_smul_right, mul_comm]
#align hilbert_basis.has_sum_inner_mul_inner HilbertBasis.hasSum_inner_mul_inner

protected theorem summable_inner_mul_inner (b : HilbertBasis ι 𝕜 E) (x y : E) :
    Summable fun i => ⟪x, b i⟫ * ⟪b i, y⟫ :=
  (b.hasSum_inner_mul_inner x y).Summable
#align hilbert_basis.summable_inner_mul_inner HilbertBasis.summable_inner_mul_inner

protected theorem tsum_inner_mul_inner (b : HilbertBasis ι 𝕜 E) (x y : E) :
    (∑' i, ⟪x, b i⟫ * ⟪b i, y⟫) = ⟪x, y⟫ :=
  (b.hasSum_inner_mul_inner x y).tsum_eq
#align hilbert_basis.tsum_inner_mul_inner HilbertBasis.tsum_inner_mul_inner

-- Note : this should be `b.repr` composed with an identification of `lp (λ i : ι, 𝕜) p` with
-- `pi_Lp p (λ i : ι, 𝕜)` (in this case with `p = 2`), but we don't have this yet (July 2022).
/-- A finite Hilbert basis is an orthonormal basis. -/
protected def toOrthonormalBasis [Fintype ι] (b : HilbertBasis ι 𝕜 E) : OrthonormalBasis ι 𝕜 E :=
  OrthonormalBasis.mk b.Orthonormal
    (by
      refine' Eq.ge _
      have := (span 𝕜 (finset.univ.image b : Set E)).closed_of_finiteDimensional
      simpa only [Finset.coe_image, Finset.coe_univ, Set.image_univ, HilbertBasis.dense_span] using
        this.submodule_topological_closure_eq.symm)
#align hilbert_basis.to_orthonormal_basis HilbertBasis.toOrthonormalBasis

@[simp]
theorem coe_toOrthonormalBasis [Fintype ι] (b : HilbertBasis ι 𝕜 E) :
    (b.toOrthonormalBasis : ι → E) = b :=
  OrthonormalBasis.coe_mk _ _
#align hilbert_basis.coe_to_orthonormal_basis HilbertBasis.coe_toOrthonormalBasis

protected theorem hasSum_orthogonalProjection {U : Submodule 𝕜 E} [CompleteSpace U]
    (b : HilbertBasis ι 𝕜 U) (x : E) :
    HasSum (fun i => ⟪(b i : E), x⟫ • b i) (orthogonalProjection U x) := by
  simpa only [b.repr_apply_apply, inner_orthogonalProjection_eq_of_mem_left] using
    b.has_sum_repr (orthogonalProjection U x)
#align hilbert_basis.has_sum_orthogonal_projection HilbertBasis.hasSum_orthogonalProjection

theorem finite_spans_dense (b : HilbertBasis ι 𝕜 E) :
    (⨆ J : Finset ι, span 𝕜 (J.image b : Set E)).topologicalClosure = ⊤ :=
  eq_top_iff.mpr <|
    b.dense_span.ge.trans
      (by
        simp_rw [← Submodule.span_unionᵢ]
        exact
          topological_closure_mono
            (span_mono <|
              set.range_subset_iff.mpr fun i =>
                Set.mem_unionᵢ_of_mem {i} <|
                  finset.mem_coe.mpr <| Finset.mem_image_of_mem _ <| Finset.mem_singleton_self i))
#align hilbert_basis.finite_spans_dense HilbertBasis.finite_spans_dense

variable {v : ι → E} (hv : Orthonormal 𝕜 v)

include hv cplt

/-- An orthonormal family of vectors whose span is dense in the whole module is a Hilbert basis. -/
protected def mk (hsp : ⊤ ≤ (span 𝕜 (Set.range v)).topologicalClosure) : HilbertBasis ι 𝕜 E :=
  HilbertBasis.of_repr <| (hv.IsHilbertSum hsp).LinearIsometryEquiv
#align hilbert_basis.mk HilbertBasis.mk

theorem Orthonormal.linearIsometryEquiv_symm_apply_single_one (h i) :
    (hv.IsHilbertSum h).LinearIsometryEquiv.symm (lp.single 2 i 1) = v i := by
  rw [IsHilbertSum.linearIsometryEquiv_symm_apply_single, LinearIsometry.toSpanSingleton_apply,
    one_smul]
#align orthonormal.linear_isometry_equiv_symm_apply_single_one Orthonormal.linearIsometryEquiv_symm_apply_single_one

@[simp]
protected theorem coe_mk (hsp : ⊤ ≤ (span 𝕜 (Set.range v)).topologicalClosure) :
    ⇑(HilbertBasis.mk hv hsp) = v := by
  apply funext <| Orthonormal.linearIsometryEquiv_symm_apply_single_one hv hsp
#align hilbert_basis.coe_mk HilbertBasis.coe_mk

/-- An orthonormal family of vectors whose span has trivial orthogonal complement is a Hilbert
basis. -/
protected def mkOfOrthogonalEqBot (hsp : (span 𝕜 (Set.range v))ᗮ = ⊥) : HilbertBasis ι 𝕜 E :=
  HilbertBasis.mk hv
    (by rw [← orthogonal_orthogonal_eq_closure, ← eq_top_iff, orthogonal_eq_top_iff, hsp])
#align hilbert_basis.mk_of_orthogonal_eq_bot HilbertBasis.mkOfOrthogonalEqBot

@[simp]
protected theorem coe_of_orthogonal_eq_bot_mk (hsp : (span 𝕜 (Set.range v))ᗮ = ⊥) :
    ⇑(HilbertBasis.mkOfOrthogonalEqBot hv hsp) = v :=
  HilbertBasis.coe_mk hv _
#align hilbert_basis.coe_of_orthogonal_eq_bot_mk HilbertBasis.coe_of_orthogonal_eq_bot_mk

omit hv

-- Note : this should be `b.repr` composed with an identification of `lp (λ i : ι, 𝕜) p` with
-- `pi_Lp p (λ i : ι, 𝕜)` (in this case with `p = 2`), but we don't have this yet (July 2022).
/-- An orthonormal basis is an Hilbert basis. -/
protected def OrthonormalBasis.toHilbertBasis [Fintype ι] (b : OrthonormalBasis ι 𝕜 E) :
    HilbertBasis ι 𝕜 E :=
  HilbertBasis.mk b.Orthonormal <| by
    simpa only [← OrthonormalBasis.coe_toBasis, b.to_basis.span_eq, eq_top_iff] using
      @subset_closure E _ _
#align orthonormal_basis.to_hilbert_basis OrthonormalBasis.toHilbertBasis

@[simp]
theorem OrthonormalBasis.coe_toHilbertBasis [Fintype ι] (b : OrthonormalBasis ι 𝕜 E) :
    (b.toHilbertBasis : ι → E) = b :=
  HilbertBasis.coe_mk _ _
#align orthonormal_basis.coe_to_hilbert_basis OrthonormalBasis.coe_toHilbertBasis

/-- A Hilbert space admits a Hilbert basis extending a given orthonormal subset. -/
theorem Orthonormal.exists_hilbertBasis_extension {s : Set E} (hs : Orthonormal 𝕜 (coe : s → E)) :
    ∃ (w : Set E)(b : HilbertBasis w 𝕜 E), s ⊆ w ∧ ⇑b = (coe : w → E) :=
  let ⟨w, hws, hw_ortho, hw_max⟩ := exists_maximal_orthonormal hs
  ⟨w,
    HilbertBasis.mkOfOrthogonalEqBot hw_ortho
      (by simpa [maximal_orthonormal_iff_orthogonal_complement_eq_bot hw_ortho] using hw_max),
    hws, HilbertBasis.coe_of_orthogonal_eq_bot_mk _ _⟩
#align orthonormal.exists_hilbert_basis_extension Orthonormal.exists_hilbertBasis_extension

variable (𝕜 E)

/-- A Hilbert space admits a Hilbert basis. -/
theorem exists_hilbertBasis : ∃ (w : Set E)(b : HilbertBasis w 𝕜 E), ⇑b = (coe : w → E) :=
  let ⟨w, hw, hw', hw''⟩ := (orthonormal_empty 𝕜 E).exists_hilbertBasis_extension
  ⟨w, hw, hw''⟩
#align exists_hilbert_basis exists_hilbertBasis

end HilbertBasis


/-
Copyright (c) 2022 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import algebra.associated
import data.nat.factorization

/-!
# Prime powers

This file deals with prime powers: numbers which are positive integer powers of a single prime.
-/

variables {R : Type*} [comm_monoid_with_zero R] (n p : R) (k : ℕ)

/-- `n` is a prime power if there is a prime `p` and a positive natural `k` such that `n` can be
written as `p^k`. -/
def is_prime_pow : Prop :=
∃ (p : R) (k : ℕ), prime p ∧ 0 < k ∧ p ^ k = n

lemma is_prime_pow_def :
  is_prime_pow n ↔ ∃ (p : R) (k : ℕ), prime p ∧ 0 < k ∧ p ^ k = n := iff.rfl

/-- An equivalent definition for prime powers: `n` is a prime power iff there is a prime `p` and a
natural `k` such that `n` can be written as `p^(k+1)`. -/
lemma is_prime_pow_iff_pow_succ :
  is_prime_pow n ↔ ∃ (p : R) (k : ℕ), prime p ∧ p ^ (k + 1) = n :=
(is_prime_pow_def _).trans
⟨λ ⟨p, k, hp, hk, hn⟩, ⟨_, _, hp, by rwa [nat.sub_add_cancel hk]⟩,
  λ ⟨p, k, hp, hn⟩, ⟨_, _, hp, nat.succ_pos', hn⟩⟩

lemma not_is_prime_pow_zero [no_zero_divisors R] :
  ¬ is_prime_pow (0 : R) :=
begin
  simp only [is_prime_pow_def, not_exists, not_and', and_imp],
  intros x n hn hx,
  rw pow_eq_zero hx,
  simp,
end

lemma not_is_prime_pow_one : ¬ is_prime_pow (1 : R) :=
begin
  simp only [is_prime_pow_def, not_exists, not_and', and_imp],
  intros x n hn hx ht,
  exact ht.not_unit (is_unit_of_pow_eq_one x n hx hn),
end

lemma prime.is_prime_pow {p : R} (hp : prime p) : is_prime_pow p :=
⟨p, 1, hp, zero_lt_one, by simp⟩

lemma is_prime_pow.pow {n : R} (hn : is_prime_pow n)
  {k : ℕ} (hk : k ≠ 0) : is_prime_pow (n ^ k) :=
let ⟨p, k', hp, hk', hn⟩ := hn in ⟨p, k * k', hp, mul_pos hk.bot_lt hk', by rw [pow_mul', hn]⟩

theorem is_prime_pow.ne_zero [no_zero_divisors R] {n : R} (h : is_prime_pow n) : n ≠ 0 :=
λ t, eq.rec not_is_prime_pow_zero t.symm h

lemma is_prime_pow.ne_one {n : R} (h : is_prime_pow n) : n ≠ 1 :=
λ t, eq.rec not_is_prime_pow_one t.symm h

section unique_units

lemma eq_of_prime_pow_eq {R : Type*} [cancel_comm_monoid_with_zero R] [unique Rˣ] {p₁ p₂ : R}
  {k₁ k₂ : ℕ} (hp₁ : prime p₁) (hp₂ : prime p₂) (hk₁ : 0 < k₁) (h : p₁ ^ k₁ = p₂ ^ k₂) :
  p₁ = p₂ :=
by { rw [←associated_iff_eq] at h ⊢, apply h.of_pow_associated_of_prime hp₁ hp₂ hk₁ }

lemma eq_of_prime_pow_eq' {R : Type*} [cancel_comm_monoid_with_zero R] [unique Rˣ] {p₁ p₂ : R}
  {k₁ k₂ : ℕ} (hp₁ : prime p₁) (hp₂ : prime p₂) (hk₁ : 0 < k₂) (h : p₁ ^ k₁ = p₂ ^ k₂) :
  p₁ = p₂ :=
by { rw [←associated_iff_eq] at h ⊢, apply h.of_pow_associated_of_prime' hp₁ hp₂ hk₁ }

end unique_units

section nat

lemma is_prime_pow_nat_iff (n : ℕ) :
  is_prime_pow n ↔ ∃ (p k : ℕ), nat.prime p ∧ 0 < k ∧ p ^ k = n :=
by simp only [is_prime_pow_def, nat.prime_iff]

lemma is_prime_pow_nat_iff_bounded (n : ℕ) :
  is_prime_pow n ↔ ∃ (p : ℕ), p ≤ n ∧ ∃ (k : ℕ), k ≤ n ∧ p.prime ∧ 0 < k ∧ p ^ k = n :=
begin
  rw is_prime_pow_nat_iff,
  refine iff.symm ⟨λ ⟨p, _, k, _, hp, hk, hn⟩, ⟨p, k, hp, hk, hn⟩, _⟩,
  rintro ⟨p, k, hp, hk, rfl⟩,
  refine ⟨p, _, k, (nat.lt_pow_self hp.one_lt _).le, hp, hk, rfl⟩,
  simpa using nat.pow_le_pow_of_le_right hp.pos hk,
end

instance {n : ℕ} : decidable (is_prime_pow n) :=
decidable_of_iff' _ (is_prime_pow_nat_iff_bounded n)

lemma is_prime_pow.min_fac_pow_factorization_eq {n : ℕ} (hn : is_prime_pow n) :
  n.min_fac ^ n.factorization n.min_fac = n :=
begin
  obtain ⟨p, k, hp, hk, rfl⟩ := hn,
  rw ←nat.prime_iff at hp,
  rw [hp.pow_min_fac hk.ne', hp.factorization_pow, finsupp.single_eq_same],
end

lemma is_prime_pow_of_min_fac_pow_factorization_eq {n : ℕ}
  (h : n.min_fac ^ n.factorization n.min_fac = n) (hn : n ≠ 1) :
  is_prime_pow n :=
begin
  rcases n.eq_zero_or_pos with rfl | hn',
  { simpa using h },
  refine ⟨_, _, nat.prime_iff.1 (nat.min_fac_prime hn), _, h⟩,
  rw [pos_iff_ne_zero, ←finsupp.mem_support_iff, nat.factor_iff_mem_factorization,
    nat.mem_factors_iff_dvd hn' (nat.min_fac_prime hn)],
  apply nat.min_fac_dvd
end

lemma is_prime_pow_iff_min_fac_pow_factorization_eq {n : ℕ} (hn : n ≠ 1) :
  is_prime_pow n ↔ n.min_fac ^ n.factorization n.min_fac = n :=
⟨λ h, h.min_fac_pow_factorization_eq, λ h, is_prime_pow_of_min_fac_pow_factorization_eq h hn⟩

lemma is_prime_pow.dvd {n m : ℕ} (hn : is_prime_pow n) (hm : m ∣ n) (hm₁ : m ≠ 1) :
  is_prime_pow m :=
begin
  rw is_prime_pow_nat_iff at hn ⊢,
  rcases hn with ⟨p, k, hp, hk, rfl⟩,
  obtain ⟨i, hik, rfl⟩ := (nat.dvd_prime_pow hp).1 hm,
  refine ⟨p, i, hp, _, rfl⟩,
  apply nat.pos_of_ne_zero,
  rintro rfl,
  simpa using hm₁,
end

/-- An equivalent definition for prime powers: `n` is a prime power iff there is a unique prime
dividing it. -/
lemma is_prime_pow_iff_unique_prime_dvd {n : ℕ} :
  is_prime_pow n ↔ ∃! p : ℕ, p.prime ∧ p ∣ n :=
begin
  rw is_prime_pow_nat_iff,
  split,
  { rintro ⟨p, k, hp, hk, rfl⟩,
    refine ⟨p, ⟨hp, dvd_pow_self _ hk.ne'⟩, _⟩,
    rintro q ⟨hq, hq'⟩,
    exact (nat.prime_dvd_prime_iff_eq hq hp).1 (hq.dvd_of_dvd_pow hq') },
  rintro ⟨p, ⟨hp, hn⟩, hq⟩,
  -- Take care of the n = 0 case
  rcases n.eq_zero_or_pos with rfl | hn₀,
  { obtain ⟨q, hq', hq''⟩ := nat.exists_infinite_primes (p + 1),
    cases hq q ⟨hq'', by simp⟩,
    simpa using hq' },
  -- So assume 0 < n
  refine ⟨p, n.factors.count p, hp, _, _⟩,
  { apply list.count_pos.2,
    rwa nat.mem_factors_iff_dvd hn₀ hp },
  simp only [and_imp] at hq,
  apply nat.dvd_antisymm (nat.pow_factors_count_dvd _ _),
  -- We need to show n ∣ p ^ n.factors.count p
  apply nat.dvd_of_factors_subperm hn₀.ne',
  rw [hp.factors_pow, list.subperm_ext_iff],
  intros q hq',
  rw nat.mem_factors hn₀.ne' at hq',
  cases hq _ hq'.1 hq'.2,
  simp,
end

lemma is_prime_pow_pow_iff {n k : ℕ} (hk : k ≠ 0) :
  is_prime_pow (n ^ k) ↔ is_prime_pow n :=
begin
  simp only [is_prime_pow_iff_unique_prime_dvd],
  apply exists_unique_congr,
  simp only [and.congr_right_iff],
  intros p hp,
  exact ⟨hp.dvd_of_dvd_pow, λ t, t.trans (dvd_pow_self _ hk)⟩,
end

lemma nat.coprime.is_prime_pow_dvd_mul {n a b : ℕ} (hab : nat.coprime a b) (hn : is_prime_pow n) :
  n ∣ a * b ↔ n ∣ a ∨ n ∣ b :=
begin
  rcases eq_or_ne a 0 with rfl | ha,
  { simp only [nat.coprime_zero_left] at hab,
    simp [hab, finset.filter_singleton, not_is_prime_pow_one] },
  rcases eq_or_ne b 0 with rfl | hb,
  { simp only [nat.coprime_zero_right] at hab,
    simp [hab, finset.filter_singleton, not_is_prime_pow_one] },
  refine ⟨_, λ h, or.elim h (λ i, i.trans (dvd_mul_right _ _)) (λ i, i.trans (dvd_mul_left _ _))⟩,
  obtain ⟨p, k, hp, hk, rfl⟩ := (is_prime_pow_nat_iff _).1 hn,
  simp only [nat.prime_pow_dvd_iff_le_factorization _ _ _ hp (mul_ne_zero ha hb),
    nat.factorization_mul ha hb, nat.prime_pow_dvd_iff_le_factorization _ _ _ hp ha,
    nat.prime_pow_dvd_iff_le_factorization _ _ _ hp hb, pi.add_apply, finsupp.coe_add],
  have : a.factorization p = 0 ∨ b.factorization p = 0,
  { rw [←finsupp.not_mem_support_iff, ←finsupp.not_mem_support_iff, ←not_and_distrib,
      ←finset.mem_inter],
    exact λ t, nat.factorization_disjoint_of_coprime hab t },
  cases this;
  simp [this, imp_or_distrib],
end

lemma nat.disjoint_divisors_filter_prime_pow {a b : ℕ} (hab : a.coprime b) :
  disjoint (a.divisors.filter is_prime_pow) (b.divisors.filter is_prime_pow) :=
begin
  simp only [finset.disjoint_left, finset.mem_filter, and_imp, nat.mem_divisors, not_and],
  rintro n han ha hn hbn hb -,
  exact hn.ne_one (nat.eq_one_of_dvd_coprimes hab han hbn),
end

lemma nat.mul_divisors_filter_prime_pow {a b : ℕ} (hab : a.coprime b) :
  (a * b).divisors.filter is_prime_pow = (a.divisors ∪ b.divisors).filter is_prime_pow :=
begin
  rcases eq_or_ne a 0 with rfl | ha,
  { simp only [nat.coprime_zero_left] at hab,
    simp [hab, finset.filter_singleton, not_is_prime_pow_one] },
  rcases eq_or_ne b 0 with rfl | hb,
  { simp only [nat.coprime_zero_right] at hab,
    simp [hab, finset.filter_singleton, not_is_prime_pow_one] },
  ext n,
  simp only [ha, hb, finset.mem_union, finset.mem_filter, nat.mul_eq_zero, and_true, ne.def,
    and.congr_left_iff, not_false_iff, nat.mem_divisors, or_self],
  apply hab.is_prime_pow_dvd_mul,
end

lemma is_prime_pow.two_le : ∀ {n : ℕ}, is_prime_pow n → 2 ≤ n
| 0 h := (not_is_prime_pow_zero h).elim
| 1 h := (not_is_prime_pow_one h).elim
| (n+2) _ := le_add_self

theorem is_prime_pow.pos {n : ℕ} (hn : is_prime_pow n) : 0 < n := pos_of_gt hn.two_le

theorem is_prime_pow.one_lt {n : ℕ} (h : is_prime_pow n) : 1 < n := h.two_le

end nat


import data.int.basic
import data.nat.basic
import data.real.basic

namespace test

variables (α β : Type*) (p q : α → Prop)
variables a b : α
variables f g : α → ℕ
variable h1 : a = b
variable h2 : f = g
variables x y z : ℕ

example : (∀ x : α, p x ∧ q x) → ∀ y : α, p y :=
  λ h : ∀ x : α, p x ∧ q x,
  λ y : α,
  (h y).left

example (f : α → β) (a : α) : (λ x, f x) a = f a := eq.refl _
example : 2 + 3 = 5 := rfl

example (α : Type*) (a b : α) (p : α → Prop)
  (h1 : a = b) (h2 : p a) : p b :=
  eq.subst h1 h2
example (α : Type*) (a b : α) (p : α → Prop)
  (h1 : a = b) (h2 : p a) : p b :=
  h1 ▸ h2

example : f a = f b := congr_arg f h1
example : f a = g a := congr_fun h2 a
example : f a = g b := congr h2 h1

example : (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
  have h1 : (x + y) * (x + y) = (x + y) * x + (x + y) * y,
    from mul_add (x + y) x y,
  have h2 : (x + y) * (x + y) = x * x + y * x + (x * y + y * y),
    from (add_mul x y x) ▸ (add_mul x y y) ▸ h1,
  h2.trans (add_assoc (x * x + y * x) (x * y) (y * y)).symm

theorem T2 (a b c d : ℕ)
    (h1 : a = b) (h2 : b ≤ c) (h3 : c + 1 < d) : a < d :=
  calc
    a   = b     : h1
    ... < b + 1 : nat.lt_succ_self b
    ... ≤ c + 1 : nat.succ_le_succ h2
    ... < d     : h3

example (x y : ℕ) :
    (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
  calc
    (x + y) * (x + y) = (x + y) * x + (x + y) * y : by rw mul_add
    ... = x * x + y * x + (x + y) * y : by rw add_mul
    ... = x * x + y * x + (x * y + y * y) : by rw add_mul
    ... = x * x + y * x + x * y + y * y : by rw ←add_assoc

example (x y : ℕ) :
    (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
  by rw [mul_add, add_mul, add_mul, ←add_assoc]

example (x y : ℕ) :
    (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
  by simp [mul_add, add_mul, add_assoc, add_left_comm]

open nat

example : ∃ x : ℕ, x > 0 :=
  have h : 1 > 0, from zero_lt_succ 0,
  exists.intro 1 h

example (x : ℕ) (h : x > 0) : ∃ y, y < x :=
  exists.intro 0 h

example (x y z : ℕ) (hxy : x < y) (hyz : y < z) :
    ∃ w, x < w ∧ w < z :=
  exists.intro y (and.intro hxy hyz)

example : ∃ x : ℕ, x > 0 :=
  ⟨1, zero_lt_succ 0⟩

variable g2 : ℕ → ℕ → ℕ
variable hg2 : g2 0 0 = 0

theorem gex1 : ∃ x, g2 x x = x := exists.intro 0 hg2
theorem gex2 : ∃ x, g2 x 0 = x := exists.intro 0 hg2
theorem gex3 : ∃ x, g2 0 0 = x := exists.intro 0 hg2
theorem gex4 : ∃ x, g2 x x = 0 := exists.intro 0 hg2

set_option pp.implicit true
#print gex1
#print gex2
#print gex3
#print gex4

theorem T3 (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
  exists.elim h
    (assume w : α,
      assume hw : p w ∧ q w,
      show ∃ x, q x ∧ p x, from
        exists.intro w (and.intro hw.right hw.left))

example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
  match h with exists.intro (w : α) (hw : p w ∧ q w) :=
    exists.intro w (and.intro hw.right hw.left)
  end

example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
  match h with ⟨w, hpw, hqw⟩ :=
    exists.intro w (and.intro hqw hpw)
  end

example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
  let ⟨w, hpw, hqw⟩ := h in ⟨w, hqw, hpw⟩

-- implicit match
example : (∃ x, p x ∧ q x) → ∃ x, q x ∧ p x :=
  assume ⟨w, hpw, hqw⟩, ⟨w, hqw, hpw⟩

def is_even (a : ℕ) := ∃ b, a = 2 * b

theorem even_plus_even {a b : ℕ}
    (h1 : is_even a) (h2 : is_even b) : is_even (a + b) :=
  exists.elim h1 (assume half_a : ℕ, assume hw1 : a = 2 * half_a,
  exists.elim h2 (assume half_b : ℕ, assume hw2 : b = 2 * half_b,
    exists.intro (half_a + half_b)
      (calc
        a + b = 2 * half_a + 2 * half_b : by rw [hw1, hw2]
          ... = 2 * (half_a + half_b)   : by rw mul_add)))

theorem even_plus_even' {a b : ℕ}
    (h1 : is_even a) (h2 : is_even b) : is_even (a + b) :=
  match h1, h2 with ⟨w1, hw1⟩, ⟨w2, hw2⟩ :=
    ⟨w1 + w2, by rw [hw1, hw2, mul_add]⟩
  end

end test

section exercises

variables (α : Type*) (p q : α → Prop)
variable r : Prop

example : (∃ x : α, r) → r :=
  (assume h : (∃ x : α, r),
    exists.elim h
    (assume a : α,
      (assume b : r, b)))
example (h : (∃ x : α, r)) : r :=
  match h with ⟨x, r⟩ :=
    r
  end

example (a : α) : r → (∃ x : α, r) :=
  (assume h : r, exists.intro a h)

example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r :=
  iff.intro
    (assume h : (∃ x, p x ∧ r),
      match h with ⟨x, hpx, hr⟩ :=
        ⟨⟨x, hpx⟩, hr⟩
      end)
    (assume h : (∃ x, p x) ∧ r,
      match h with ⟨⟨x, hpx⟩, hr⟩ :=
        ⟨x, hpx, hr⟩
      end)

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
  iff.intro
    (assume h : (∃ x, p x ∨ q x),
      match h with ⟨x, hpx_or_qx⟩ :=
        or.elim hpx_or_qx
          (assume hpx : p x, or.inl (exists.intro x hpx))
          (assume hqx : q x, or.inr (exists.intro x hqx))
      end)
    (assume h : (∃ x, p x) ∨ (∃ x, q x),
      or.elim h
        (assume h1 : (∃ x, p x),
          match h1 with ⟨x, hpx⟩ :=
            ⟨x, or.inl hpx⟩
          end)
        (assume h2 : (∃ x, q x),
          match h2 with ⟨x, hqx⟩ :=
            ⟨x, or.inr hqx⟩
          end))

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) :=
  iff.intro
    (assume h : (∀ x, p x),
      (assume h2 : (∃ x, ¬ p x),
        match h2 with ⟨x, hnpx⟩ :=
          hnpx (h x)
        end))
    (assume h : ¬ (∃ x, ¬ p x),
      (assume x : α,
        by_contradiction
          (assume h2 : ¬ p x, h (exists.intro x h2))))

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
  iff.intro
    (assume h : (∃ x, p x),
      match h with ⟨x, hpx⟩ :=
        (assume h2 : ∀ x, ¬ p x, h2 x hpx)
      end)
    (assume h : ¬ (∀ x, ¬ p x),
      by_contradiction
        (assume h2 : ¬(∃ x, p x),
          have ∀ x, ¬p x, from
            (assume x : α, assume hpx : p x, h2 ⟨x, hpx⟩),
          h this))

example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) :=
  iff.intro
    (assume h : (¬ ∃ x, p x),
      (assume x : α, assume hpx : p x, h ⟨x, hpx⟩))
    (assume h : (∀ x, ¬ p x),
      assume h2 : ∃ x, p x,
        match h2 with ⟨x, hpx⟩ :=
          h x hpx
        end)

example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) :=
  iff.intro
    (assume h : (¬ ∀ x, p x),
      by_contradiction
        (assume h2 : (¬ ∃ x, ¬ p x),
          have ∀ x, p x, from
            (assume x : α,
              by_contradiction
                (assume h3 : ¬ p x,
                  h2 ⟨x, h3⟩)),
          show false, from h this))
    (assume h : (∃ x, ¬ p x),
      match h with ⟨x, hnpx⟩ :=
        (assume h2 : ∀ x, p x, hnpx (h2 x))
      end)

-- if, for all x, p x implies r, then if there exists
-- an x such that p x, r is true, and vice versa
example : (∀ x, p x → r) ↔ (∃ x, p x) → r :=
  iff.intro
    (assume h : (∀ x, p x → r),
      (assume hx : (∃ x, p x),
        match hx with ⟨x, hpx⟩ :=
          h x hpx
        end))
    (assume h : (∃ x, p x) → r,
      (assume x : α,
        assume hpx : p x,
          h (exists.intro x hpx)))

example (a : α) : (∃ x, p x → r) ↔ (∀ x, p x) → r :=
  iff.intro
    (assume h : (∃ x, p x → r),
      (assume h2 : (∀ x, p x),
        match h with ⟨x, hpx_to_r⟩ :=
          hpx_to_r (h2 x)
        end))
    (assume h : (∀ x, p x) → r,
      by_contradiction
        (assume h2 : ¬(∃ x, p x → r),
          have ∀ x, ¬(p x → r), from
            (assume x : α, assume hpxr : p x → r,
              h2 (exists.intro x hpxr)),
          have h3 : ∀ x, p x ∧ ¬r, from
            (assume x : α, not_imp.mp (this x)),
          have ∀ x, p x, from
            (assume x : α, (h3 x).left),
          show false, from (h3 a).right (h this)))

example (a : α) : (∃ x, r → p x) ↔ (r → ∃ x, p x) :=
  iff.intro
    (assume h : (∃ x, r → p x),
      match h with ⟨x, r_imp_px⟩ :=
        assume hr : r,
          exists.intro x (r_imp_px hr)
      end)
    (assume h : r → (∃ x, p x),
      by_contradiction
        (assume h2 : ¬(∃ x, r → p x),
          have ∀ x, ¬(r → p x), from
            forall_not_of_not_exists h2,
          have ∀ x, r ∧ ¬ p x, from
            (assume x : α, not_imp.mp (this x)),
          have r ∧ ∀ x, ¬ p x, from
            (and.intro (this a).left (assume x, (this x).right)),
          match (h this.left) with ⟨x, hpx⟩ :=
            (this.right x) hpx
          end))

end exercises

section exercises2

variables (α : Type*) (p q : α → Prop)
variable r : Prop

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
  iff.intro
    (assume : (∀ x, p x ∧ q x),
      and.intro
        (assume x, (this x).left)
        (assume x, (this x).right))
    (assume : (∀ x, p x) ∧ (∀ x, q x),
      (assume x,
        and.intro (this.left x) (this.right x)))

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
  (assume h : ∀ x, p x → q x,
    (assume hp : ∀ x, p x,
      assume x, (h x) (hp x)))

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
  (assume : (∀ x, p x) ∨ (∀ x, q x),
    or.elim this
      (assume : ∀ x, p x, assume x, or.inl (this x))
      (assume : ∀ x, q x, assume x, or.inr (this x)))

example : α → ((∀ x : α, r) ↔ r) :=
  (assume a : α,
    iff.intro
      (assume h : ∀ x, r, h a)
      (assume h : r, assume x, h))

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
  iff.intro
    (assume h : ∀ x, p x ∨ r,
      or.elim (em r)
        (assume hr : r, or.inr hr)
        (assume hnr : ¬r, or.inl
          (assume x, or.elim (h x)
            (assume : p x, this)
            (assume : r, absurd this hnr))))
    (assume h : (∀ x, p x) ∨ r,
      or.elim h
        (assume : ∀ x, p x, assume x, or.inl (this x))
        (assume : r, assume x, or.inr this))

variables (men : Type*) (barber : men)
variable  (shaves : men → men → Prop)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : false :=
  have barber_doesnt_shave_self : ¬ shaves barber barber, from
    (assume : shaves barber barber, absurd this ((h barber).mp this)),
  absurd ((h barber).mpr barber_doesnt_shave_self) barber_doesnt_shave_self

def divides (m n : ℕ) : Prop := ∃ k : ℕ, m * k = n
def even (n : ℕ) : Prop := ∃ k : ℕ, 2 * k = n

def prime (n : ℕ) : Prop := ¬∃ k : ℕ, k > 1 ∧ k ≠ n ∧ divides k n

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

def Fermat_prime (n : ℕ) : Prop := prime n ∧ ∃ k : ℕ, k > 0 ∧ n = 2 ^ k + 1

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

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

def Goldbach's_weak_conjecture : Prop :=
  ∀ n : ℕ, (n > 5 ∧ ¬ even n) → ∃ k j i : ℕ, (prime k ∧ prime j ∧ prime i ∧ n = k + j + i)

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

theorem inf_primes : infinitely_many_primes :=
  have prime 2, from
    have ∀ k : ℕ, k ≤ 1 ∨ k = 2 ∨ ¬ divides k 2, from
      (assume k, or.elim (em (k ≤ 1))
        (assume : k ≤ 1, or.inl this)
        (assume k_lt_1 : ¬(k ≤ 1), or.inr (or.elim (em (k = 2))
          (assume : k = 2, or.inl this)
          (assume : k ≠ 2,
            have k > 1, from
              lt_of_not_ge k_lt_1,
            have k > 2, from
              sorry,
            have ¬divides k 2, from
              sorry,
            or.inr this)))),
    sorry,
  sorry

variables log exp    : ℝ → ℝ
variable  log_exp_eq : ∀ x, log (exp x) = x
variable  exp_log_eq : ∀ {x}, x > 0 → exp (log x) = x
variable  exp_pos    : ∀ x, exp x > 0
variable  exp_add    : ∀ x y, exp (x + y) = exp x * exp y

include log_exp_eq exp_log_eq exp_pos exp_add

example (x y z : ℝ) :
  exp (x + y + z) = exp x * exp y * exp z :=
  by rw [exp_add, exp_add]

example (y : ℝ) (h : y > 0) : exp (log y) = y :=
  exp_log_eq h

theorem log_mul {x y : ℝ} (hx : x > 0) (hy : y > 0) :
    log (x * y) = log x + log y :=
  calc
    log (x * y) = log (exp (log x) * y)           : by rw exp_log_eq hx
    ...         = log (exp (log x) * exp (log y)) : by rw exp_log_eq hy
    ...         = log (exp (log x + log y))       : by rw exp_add
    ...         = log x + log y                   : by rw log_exp_eq

example (x : ℤ) : x * 0 = 0 :=
  calc
    x * 0 = x * (x - x)   : by rw sub_self x
    ...   = x * x - x * x : by rw mul_sub x x x
    ...   = 0             : by rw sub_self (x * x : ℤ)

end exercises2


example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
apply iff.intro,
    intro h,
    apply or.elim (and.right h),
      intro hq,
        apply or.inl,
        apply and.intro,
          apply and.left h,
          exact hq,
      intro hr,
        apply or.inr,
        apply and.intro,
          apply and.left h,
            exact hr,
    intro h,
      apply or.elim h,
        intro a,
        apply and.intro,
          apply and.elim_left a,
            apply or.intro_left,
              apply and.elim_right a,
        intro a,
          apply and.intro,
            apply and.elim_left a,
              apply or.intro_right,
              apply and.elim_right a,
end

example : ∀ a b c : ℕ, a = b → a = c → c = b :=
begin
  intros,
    transitivity a,
    symmetry,
    assumption,
    assumption,
end

example (p q r : Prop) : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
begin
apply iff.intro,
  intro h,
    cases h with hp hqr,
    cases hqr with hq hr,
      left, constructor,
        assumption, assumption,
      right, constructor,
        assumption, assumption,
  intro h,
    cases h with hpq hpr,
      cases hpq with hp hq,
        constructor, assumption,
        left, assumption,
      cases hpr with hp hr,
        constructor,assumption,
        right, assumption,
end

example (p q : ℕ → Prop) : (∃ x, p x) → ∃ x, p x ∨ q x :=
begin
  intro h,
    cases h with x px,
      constructor, left, exact px,
end

example (p q : ℕ → Prop) :
  (∃ x, p x ∧ q x) → ∃ x, q x ∧ p x :=
begin
  intro,
  cases a with x hx,
  cases hx,
  existsi x, constructor, assumption, assumption,
end

universes u v

def swap_pair {α : Type u} {β : Type v} : α × β → β × α :=
begin
  intro p,
  cases p,
  constructor, assumption, assumption,
end

example (x y : nat) (h : y = x + 7) : 2 * y = 2 * (x + 7) :=
begin
  rewrite h,
end


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

import group_theory.order_of_element

/-!
# Complements

In this file we define the complement of a subgroup.

## Main definitions

- `is_complement S T` where `S` and `T` are subsets of `G` states that every `g : G` can be
  written uniquely as a product `s * t` for `s ∈ S`, `t ∈ T`.
- `left_transversals T` where `T` is a subset of `G` is the set of all left-complements of `T`,
  i.e. the set of all `S : set G` that contain exactly one element of each left coset of `T`.
- `right_transversals S` where `S` is a subset of `G` is the set of all right-complements of `S`,
  i.e. the set of all `T : set G` that contain exactly one element of each right coset of `S`.

## Main results

- `is_complement_of_coprime` : Subgroups of coprime order are complements.
-/

open_locale big_operators

namespace subgroup

variables {G : Type*} [group G] (H K : subgroup G) (S T : set G)

/-- `S` and `T` are complements if `(*) : S × T → G` is a bijection.
  This notion generalizes left transversals, right transversals, and complementary subgroups. -/
@[to_additive "`S` and `T` are complements if `(*) : S × T → G` is a bijection"]
def is_complement : Prop := function.bijective (λ x : S × T, x.1.1 * x.2.1)

/-- `H` and `K` are complements if `(*) : H × K → G` is a bijection -/
@[to_additive "`H` and `K` are complements if `(*) : H × K → G` is a bijection"]
abbreviation is_complement' := is_complement (H : set G) (K : set G)

/-- The set of left-complements of `T : set G` -/
@[to_additive "The set of left-complements of `T : set G`"]
def left_transversals : set (set G) := {S : set G | is_complement S T}

/-- The set of right-complements of `S : set G` -/
@[to_additive "The set of right-complements of `S : set G`"]
def right_transversals : set (set G) := {T : set G | is_complement S T}

variables {H K S T}

@[to_additive] lemma is_complement'_def :
  is_complement' H K ↔ is_complement (H : set G) (K : set G) := iff.rfl

@[to_additive] lemma is_complement_iff_exists_unique :
  is_complement S T ↔ ∀ g : G, ∃! x : S × T, x.1.1 * x.2.1 = g :=
function.bijective_iff_exists_unique _

@[to_additive] lemma is_complement.exists_unique (h : is_complement S T) (g : G) :
  ∃! x : S × T, x.1.1 * x.2.1 = g :=
is_complement_iff_exists_unique.mp h g

@[to_additive] lemma is_complement'.symm (h : is_complement' H K) : is_complement' K H :=
begin
  let ϕ : H × K ≃ K × H := equiv.mk (λ x, ⟨x.2⁻¹, x.1⁻¹⟩) (λ x, ⟨x.2⁻¹, x.1⁻¹⟩)
    (λ x, prod.ext (inv_inv _) (inv_inv _)) (λ x, prod.ext (inv_inv _) (inv_inv _)),
  let ψ : G ≃ G := equiv.mk (λ g : G, g⁻¹) (λ g : G, g⁻¹) inv_inv inv_inv,
  suffices : ψ ∘ (λ x : H × K, x.1.1 * x.2.1) = (λ x : K × H, x.1.1 * x.2.1) ∘ ϕ,
  { rwa [is_complement'_def, is_complement, ←equiv.bijective_comp, ←this, equiv.comp_bijective] },
  exact funext (λ x, mul_inv_rev _ _),
end

@[to_additive] lemma is_complement'_comm : is_complement' H K ↔ is_complement' K H :=
⟨is_complement'.symm, is_complement'.symm⟩

@[to_additive] lemma is_complement_top_singleton {g : G} : is_complement (⊤ : set G) {g} :=
⟨λ ⟨x, _, rfl⟩ ⟨y, _, rfl⟩ h, prod.ext (subtype.ext (mul_right_cancel h)) rfl,
  λ x, ⟨⟨⟨x * g⁻¹, ⟨⟩⟩, g, rfl⟩, inv_mul_cancel_right x g⟩⟩

@[to_additive] lemma is_complement_singleton_top {g : G} : is_complement ({g} : set G) ⊤ :=
⟨λ ⟨⟨_, rfl⟩, x⟩ ⟨⟨_, rfl⟩, y⟩ h, prod.ext rfl (subtype.ext (mul_left_cancel h)),
  λ x, ⟨⟨⟨g, rfl⟩, g⁻¹ * x, ⟨⟩⟩, mul_inv_cancel_left g x⟩⟩

@[to_additive] lemma is_complement_singleton_left {g : G} : is_complement {g} S ↔ S = ⊤ :=
begin
  refine ⟨λ h, top_le_iff.mp (λ x hx, _), λ h, (congr_arg _ h).mpr is_complement_singleton_top⟩,
  obtain ⟨⟨⟨z, rfl : z = g⟩, y, _⟩, hy⟩ := h.2 (g * x),
  rwa ← mul_left_cancel hy,
end

@[to_additive] lemma is_complement_singleton_right {g : G} : is_complement S {g} ↔ S = ⊤ :=
begin
  refine ⟨λ h, top_le_iff.mp (λ x hx, _), λ h, (congr_arg _ h).mpr is_complement_top_singleton⟩,
  obtain ⟨y, hy⟩ := h.2 (x * g),
  conv_rhs at hy { rw ← (show y.2.1 = g, from y.2.2) },
  rw ← mul_right_cancel hy,
  exact y.1.2,
end

@[to_additive] lemma is_complement_top_left : is_complement ⊤ S ↔ ∃ g : G, S = {g} :=
begin
  refine ⟨λ h, set.exists_eq_singleton_iff_nonempty_unique_mem.mpr ⟨_, λ a b ha hb, _⟩, _⟩,
  { obtain ⟨a, ha⟩ := h.2 1,
    exact ⟨a.2.1, a.2.2⟩ },
  { have : (⟨⟨_, mem_top a⁻¹⟩, ⟨a, ha⟩⟩ : (⊤ : set G) × S) = ⟨⟨_, mem_top b⁻¹⟩, ⟨b, hb⟩⟩ :=
    h.1 ((inv_mul_self a).trans (inv_mul_self b).symm),
    exact subtype.ext_iff.mp ((prod.ext_iff.mp this).2) },
  { rintro ⟨g, rfl⟩,
    exact is_complement_top_singleton },
end

@[to_additive] lemma is_complement_top_right : is_complement S ⊤ ↔ ∃ g : G, S = {g} :=
begin
  refine ⟨λ h, set.exists_eq_singleton_iff_nonempty_unique_mem.mpr ⟨_, λ a b ha hb, _⟩, _⟩,
  { obtain ⟨a, ha⟩ := h.2 1,
    exact ⟨a.1.1, a.1.2⟩ },
  { have : (⟨⟨a, ha⟩, ⟨_, mem_top a⁻¹⟩⟩ : S × (⊤ : set G)) = ⟨⟨b, hb⟩, ⟨_, mem_top b⁻¹⟩⟩ :=
    h.1 ((mul_inv_self a).trans (mul_inv_self b).symm),
    exact subtype.ext_iff.mp ((prod.ext_iff.mp this).1) },
  { rintro ⟨g, rfl⟩,
    exact is_complement_singleton_top },
end

@[to_additive] lemma is_complement'_top_bot : is_complement' (⊤ : subgroup G) ⊥ :=
is_complement_top_singleton

@[to_additive] lemma is_complement'_bot_top : is_complement' (⊥ : subgroup G) ⊤ :=
is_complement_singleton_top

@[simp, to_additive] lemma is_complement'_bot_left : is_complement' ⊥ H ↔ H = ⊤ :=
is_complement_singleton_left.trans coe_eq_univ

@[simp, to_additive] lemma is_complement'_bot_right : is_complement' H ⊥ ↔ H = ⊤ :=
is_complement_singleton_right.trans coe_eq_univ

@[simp, to_additive] lemma is_complement'_top_left : is_complement' ⊤ H ↔ H = ⊥ :=
is_complement_top_left.trans coe_eq_singleton

@[simp, to_additive] lemma is_complement'_top_right : is_complement' H ⊤ ↔ H = ⊥ :=
is_complement_top_right.trans coe_eq_singleton

@[to_additive] lemma mem_left_transversals_iff_exists_unique_inv_mul_mem :
  S ∈ left_transversals T ↔ ∀ g : G, ∃! s : S, (s : G)⁻¹ * g ∈ T :=
begin
  rw [left_transversals, set.mem_set_of_eq, is_complement_iff_exists_unique],
  refine ⟨λ h g, _, λ h g, _⟩,
  { obtain ⟨x, h1, h2⟩ := h g,
    exact ⟨x.1, (congr_arg (∈ T) (eq_inv_mul_of_mul_eq h1)).mp x.2.2, λ y hy,
      (prod.ext_iff.mp (h2 ⟨y, y⁻¹ * g, hy⟩ (mul_inv_cancel_left y g))).1⟩ },
  { obtain ⟨x, h1, h2⟩ := h g,
    refine ⟨⟨x, x⁻¹ * g, h1⟩, mul_inv_cancel_left x g, λ y hy, _⟩,
    have := h2 y.1 ((congr_arg (∈ T) (eq_inv_mul_of_mul_eq hy)).mp y.2.2),
    exact prod.ext this (subtype.ext (eq_inv_mul_of_mul_eq ((congr_arg _ this).mp hy))) },
end

@[to_additive] lemma mem_right_transversals_iff_exists_unique_mul_inv_mem :
  S ∈ right_transversals T ↔ ∀ g : G, ∃! s : S, g * (s : G)⁻¹ ∈ T :=
begin
  rw [right_transversals, set.mem_set_of_eq, is_complement_iff_exists_unique],
  refine ⟨λ h g, _, λ h g, _⟩,
  { obtain ⟨x, h1, h2⟩ := h g,
    exact ⟨x.2, (congr_arg (∈ T) (eq_mul_inv_of_mul_eq h1)).mp x.1.2, λ y hy,
      (prod.ext_iff.mp (h2 ⟨⟨g * y⁻¹, hy⟩, y⟩ (inv_mul_cancel_right g y))).2⟩ },
  { obtain ⟨x, h1, h2⟩ := h g,
    refine ⟨⟨⟨g * x⁻¹, h1⟩, x⟩, inv_mul_cancel_right g x, λ y hy, _⟩,
    have := h2 y.2 ((congr_arg (∈ T) (eq_mul_inv_of_mul_eq hy)).mp y.1.2),
    exact prod.ext (subtype.ext (eq_mul_inv_of_mul_eq ((congr_arg _ this).mp hy))) this },
end

@[to_additive] lemma mem_left_transversals_iff_exists_unique_quotient_mk'_eq :
  S ∈ left_transversals (H : set G) ↔
  ∀ q : quotient (quotient_group.left_rel H), ∃! s : S, quotient.mk' s.1 = q :=
begin
  have key : ∀ g h, quotient.mk' g = quotient.mk' h ↔ g⁻¹ * h ∈ H :=
  @quotient.eq' G (quotient_group.left_rel H),
  simp_rw [mem_left_transversals_iff_exists_unique_inv_mul_mem, set_like.mem_coe, ←key],
  exact ⟨λ h q, quotient.induction_on' q h, λ h g, h (quotient.mk' g)⟩,
end

@[to_additive]

@[to_additive] lemma mem_left_transversals_iff_bijective : S ∈ left_transversals (H : set G) ↔
  function.bijective (S.restrict (quotient.mk' : G → quotient (quotient_group.left_rel H))) :=
mem_left_transversals_iff_exists_unique_quotient_mk'_eq.trans
  (function.bijective_iff_exists_unique (S.restrict quotient.mk')).symm

@[to_additive] lemma mem_right_transversals_iff_bijective : S ∈ right_transversals (H : set G) ↔
  function.bijective (set.restrict (quotient.mk' : G → quotient (quotient_group.right_rel H)) S) :=
mem_right_transversals_iff_exists_unique_quotient_mk'_eq.trans
  (function.bijective_iff_exists_unique (S.restrict quotient.mk')).symm

@[to_additive] instance : inhabited (left_transversals (H : set G)) :=
⟨⟨set.range quotient.out', mem_left_transversals_iff_bijective.mpr ⟨by
{ rintros ⟨_, q₁, rfl⟩ ⟨_, q₂, rfl⟩ hg,
  rw (q₁.out_eq'.symm.trans hg).trans q₂.out_eq' }, λ q, ⟨⟨q.out', q, rfl⟩, quotient.out_eq' q⟩⟩⟩⟩

@[to_additive] instance : inhabited (right_transversals (H : set G)) :=
⟨⟨set.range quotient.out', mem_right_transversals_iff_bijective.mpr ⟨by
{ rintros ⟨_, q₁, rfl⟩ ⟨_, q₂, rfl⟩ hg,
  rw (q₁.out_eq'.symm.trans hg).trans q₂.out_eq' }, λ q, ⟨⟨q.out', q, rfl⟩, quotient.out_eq' q⟩⟩⟩⟩

lemma is_complement'.is_compl (h : is_complement' H K) : is_compl H K :=
begin
  refine ⟨λ g ⟨p, q⟩, let x : H × K := ⟨⟨g, p⟩, 1⟩, y : H × K := ⟨1, g, q⟩ in subtype.ext_iff.mp
    (prod.ext_iff.mp (show x = y, from h.1 ((mul_one g).trans (one_mul g).symm))).1, λ g _, _⟩,
  obtain ⟨⟨h, k⟩, rfl⟩ := h.2 g,
  exact subgroup.mul_mem_sup h.2 k.2,
end

lemma is_complement'.sup_eq_top (h : subgroup.is_complement' H K) : H ⊔ K = ⊤ :=
h.is_compl.sup_eq_top

lemma is_complement'.disjoint (h : is_complement' H K) : disjoint H K :=
h.is_compl.disjoint

lemma is_complement.card_mul [fintype G] [fintype S] [fintype T] (h : is_complement S T) :
  fintype.card S * fintype.card T = fintype.card G :=
(fintype.card_prod _ _).symm.trans (fintype.card_of_bijective h)

lemma is_complement'.card_mul [fintype G] [fintype H] [fintype K] (h : is_complement' H K) :
  fintype.card H * fintype.card K = fintype.card G :=
h.card_mul

lemma is_complement'_of_card_mul_and_disjoint [fintype G] [fintype H] [fintype K]
  (h1 : fintype.card H * fintype.card K = fintype.card G) (h2 : disjoint H K) :
  is_complement' H K :=
begin
  refine (fintype.bijective_iff_injective_and_card _).mpr
    ⟨λ x y h, _, (fintype.card_prod H K).trans h1⟩,
  rw [←eq_inv_mul_iff_mul_eq, ←mul_assoc, ←mul_inv_eq_iff_eq_mul] at h,
  change ↑(x.2 * y.2⁻¹) = ↑(x.1⁻¹ * y.1) at h,
  rw [prod.ext_iff, ←@inv_mul_eq_one H _ x.1 y.1, ←@mul_inv_eq_one K _ x.2 y.2, subtype.ext_iff,
      subtype.ext_iff, coe_one, coe_one, h, and_self, ←mem_bot, ←h2.eq_bot, mem_inf],
  exact ⟨subtype.mem ((x.1)⁻¹ * (y.1)), (congr_arg (∈ K) h).mp (subtype.mem (x.2 * (y.2)⁻¹))⟩,
end

lemma is_complement'_iff_card_mul_and_disjoint [fintype G] [fintype H] [fintype K] :
  is_complement' H K ↔
    fintype.card H * fintype.card K = fintype.card G ∧ disjoint H K :=
⟨λ h, ⟨h.card_mul, h.disjoint⟩, λ h, is_complement'_of_card_mul_and_disjoint h.1 h.2⟩

lemma is_complement'_of_coprime [fintype G] [fintype H] [fintype K]
  (h1 : fintype.card H * fintype.card K = fintype.card G)
  (h2 : nat.coprime (fintype.card H) (fintype.card K)) :
  is_complement' H K :=
is_complement'_of_card_mul_and_disjoint h1 (disjoint_iff.mpr (inf_eq_bot_of_coprime h2))

end subgroup


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

import linear_algebra.clifford_algebra.fold
import linear_algebra.exterior_algebra.basic

/-!
# Extending an alternating map to the exterior algebra

## Main definitions

* `exterior_algebra.lift_alternating`: construct a linear map out of the exterior algebra
  given alternating maps (corresponding to maps out of the exterior powers).
* `exterior_algebra.lift_alternating_equiv`: the above as a linear equivalence

## Main results

* `exterior_algebra.lhom_ext`: linear maps from the exterior algebra agree if they agree on the
  exterior powers.

-/

variables {R M N N' : Type*}
variables [comm_ring R] [add_comm_group M] [add_comm_group N] [add_comm_group N']
variables [module R M] [module R N] [module R N']

-- This instance can't be found where it's needed if we don't remind lean that it exists.
instance alternating_map.module_add_comm_group {ι : Type*} [decidable_eq ι] :
  module R (alternating_map R M N ι) :=
by apply_instance

namespace exterior_algebra
open clifford_algebra (hiding ι)

/-- Build a map out of the exterior algebra given a collection of alternating maps acting on each
exterior power -/
def lift_alternating : (Π i, alternating_map R M N (fin i)) →ₗ[R] exterior_algebra R M →ₗ[R] N :=
begin
  suffices :
    (Π i, alternating_map R M N (fin i))
      →ₗ[R] exterior_algebra R M
      →ₗ[R] (Π i, alternating_map R M N (fin i)),
  { refine linear_map.compr₂ this _,
    refine linear_equiv.to_linear_map _ ∘ₗ linear_map.proj 0,
    exact alternating_map.const_linear_equiv_of_is_empty.symm },
  refine clifford_algebra.foldl _ _ _,
  { refine linear_map.mk₂ R
      (λ m f i, (f i.succ).curry_left m) (λ m₁ m₂ f, _) (λ c m f, _) (λ m f₁ f₂, _) (λ c m f, _),
    all_goals {
      ext i : 1,
      simp only [map_smul, map_add, pi.add_apply, pi.smul_apply, alternating_map.curry_left_add,
        alternating_map.curry_left_smul, map_add, map_smul, linear_map.add_apply,
        linear_map.smul_apply] } },
  { -- when applied twice with the same `m`, this recursive step produces 0
    intros m x,
    dsimp only [linear_map.mk₂_apply, quadratic_form.coe_fn_zero, pi.zero_apply],
    simp_rw zero_smul,
    ext i : 1,
    exact alternating_map.curry_left_same _ _, }
end

@[simp]
lemma lift_alternating_ι (f : Π i, alternating_map R M N (fin i)) (m : M) :
  lift_alternating f (ι R m) = f 1 ![m] :=
begin
  dsimp [lift_alternating],
  rw [foldl_ι, linear_map.mk₂_apply, alternating_map.curry_left_apply_apply],
  congr,
end

lemma lift_alternating_ι_mul (f : Π i, alternating_map R M N (fin i)) (m : M)
  (x : exterior_algebra R M):
  lift_alternating f (ι R m * x) = lift_alternating (λ i, (f i.succ).curry_left m) x :=
begin
  dsimp [lift_alternating],
  rw [foldl_mul, foldl_ι],
  refl,
end

@[simp]
lemma lift_alternating_one (f : Π i, alternating_map R M N (fin i)) :
  lift_alternating f (1 : exterior_algebra R M) = f 0 0 :=
begin
  dsimp [lift_alternating],
  rw foldl_one,
end

@[simp]
lemma lift_alternating_algebra_map (f : Π i, alternating_map R M N (fin i)) (r : R) :
  lift_alternating f (algebra_map _ (exterior_algebra R M) r) = r • f 0 0 :=
by rw [algebra.algebra_map_eq_smul_one, map_smul, lift_alternating_one]

@[simp]
lemma lift_alternating_apply_ι_multi {n : ℕ} (f : Π i, alternating_map R M N (fin i))
  (v : fin n → M) :
  lift_alternating f (ι_multi R n v) = f n v :=
begin
  rw ι_multi_apply,
  induction n with n ih generalizing f v,
  { rw [list.of_fn_zero, list.prod_nil, lift_alternating_one, subsingleton.elim 0 v] },
  { rw [list.of_fn_succ, list.prod_cons, lift_alternating_ι_mul, ih,
      alternating_map.curry_left_apply_apply],
    congr',
    exact matrix.cons_head_tail _ }
end

@[simp]
lemma lift_alternating_comp_ι_multi {n : ℕ} (f : Π i, alternating_map R M N (fin i)) :
  (lift_alternating f).comp_alternating_map (ι_multi R n) = f n :=
alternating_map.ext $ lift_alternating_apply_ι_multi f

@[simp]
lemma lift_alternating_comp (g : N →ₗ[R] N') (f : Π i, alternating_map R M N (fin i)) :
  lift_alternating (λ i, g.comp_alternating_map (f i)) = g ∘ₗ lift_alternating f :=
begin
  ext v,
  rw linear_map.comp_apply,
  induction v using clifford_algebra.left_induction with r x y hx hy x m hx generalizing f,
  { rw [lift_alternating_algebra_map, lift_alternating_algebra_map, map_smul,
      linear_map.comp_alternating_map_apply] },
  { rw [map_add, map_add, map_add, hx, hy] },
  { rw [lift_alternating_ι_mul, lift_alternating_ι_mul, ←hx],
    simp_rw alternating_map.curry_left_comp_alternating_map },
end

@[simp]
lemma lift_alternating_ι_multi :
  lift_alternating (by exact (ι_multi R)) =
    (linear_map.id : exterior_algebra R M →ₗ[R] exterior_algebra R M) :=
begin
  ext v,
  dsimp,
  induction v using clifford_algebra.left_induction with r x y hx hy x m hx,
  { rw [lift_alternating_algebra_map, ι_multi_zero_apply, algebra.algebra_map_eq_smul_one] },
  { rw [map_add, hx, hy] },
  { simp_rw [lift_alternating_ι_mul, ι_multi_succ_curry_left, lift_alternating_comp,
      linear_map.comp_apply, algebra.lmul_left_apply, hx] },
end

/-- `exterior_algebra.lift_alternating` is an equivalence. -/
@[simps apply symm_apply]
def lift_alternating_equiv :
  (Π i, alternating_map R M N (fin i)) ≃ₗ[R] exterior_algebra R M →ₗ[R] N :=
{ to_fun := lift_alternating,
  map_add' := map_add _,
  map_smul' := map_smul _,
  inv_fun := λ F i, F.comp_alternating_map (ι_multi R i),
  left_inv := λ f, funext $ λ i, lift_alternating_comp_ι_multi _,
  right_inv := λ F, (lift_alternating_comp _ _).trans $
    by rw [lift_alternating_ι_multi, linear_map.comp_id]}

/-- To show that two linear maps from the exterior algebra agree, it suffices to show they agree on
the exterior powers.

See note [partially-applied ext lemmas] -/
@[ext]
lemma lhom_ext ⦃f g : exterior_algebra R M →ₗ[R] N⦄
  (h : ∀ i, f.comp_alternating_map (ι_multi R i) = g.comp_alternating_map (ι_multi R i)) : f = g :=
lift_alternating_equiv.symm.injective $ funext h

end exterior_algebra


import GMLAlgebra.Basic
import GMLAlgebra.Monoid
import GMLAlgebra.Reflect.Semigroup

namespace Algebra.Monoid
open Algebra

inductive Expr {α} (xs : List α)
| ofSemigroup : Semigroup.Expr xs → Expr xs
| id : Expr xs

namespace Expr
variable {α} {xs : List α}

instance instDecidableEq : DecidableEq (Expr xs)
| ofSemigroup a, ofSemigroup b =>
  match inferDecidable (a = b) with
  | isTrue rfl => isTrue rfl
  | isFalse h => isFalse fun | rfl => h rfl
| ofSemigroup _, id => Decidable.isFalse Expr.noConfusion
| id, ofSemigroup _ => Decidable.isFalse Expr.noConfusion
| id, id => Decidable.isTrue rfl

def lift (x : α) {xs : List α} : Expr xs → Expr (x :: xs)
| ofSemigroup e => ofSemigroup (e.lift x)
| id => id

def op : Expr xs → Expr xs → Expr xs
| ofSemigroup a, ofSemigroup b => ofSemigroup (Semigroup.Expr.op a b)
| id, b => b
| a, id => a

section Eval
variable (s : MonoidSig α)

def eval {xs : List α} : Expr xs → α
| ofSemigroup e => e.eval s.toSemigroupSig
| id => s.id

variable [Monoid s]

@[simp] theorem eval_lift (x) {xs} : ∀ (a : Expr xs), (Expr.lift x a).eval s = a.eval s
| ofSemigroup _ => Semigroup.Expr.eval_lift _ _ _
| id => rfl

@[simp] theorem eval_ofSemigroup {xs} (a : Semigroup.Expr xs) : (ofSemigroup a).eval s = a.eval s.toSemigroupSig := rfl

@[simp] theorem eval_id {xs} : (Expr.id : Expr xs).eval s = s.id := rfl

@[simp] theorem eval_op {xs} : ∀ (a b : Expr xs), (Expr.op a b).eval s = s.op (a.eval s) (b.eval s)
| ofSemigroup a, ofSemigroup b => by simp [eval, op]
| id, ofSemigroup b => by simp [eval, op, Algebra.op_left_id s.op]
| ofSemigroup a, id => by simp [eval, op, Algebra.op_right_id s.op]
| id, id => by simp [eval, op, Algebra.op_right_id s.op s.id]

end Eval

section Completeness
variable (xs : List α)

def sig : MonoidSig (Expr xs) where
  op := Expr.op
  id := Expr.id

protected theorem op_assoc : ∀ (x y z : Expr xs), op (op x y) z = op x (op y z)
| id, id, id => rfl
| id, id, ofSemigroup _ => rfl
| id, ofSemigroup _, id => rfl
| id, ofSemigroup _, ofSemigroup _ => rfl
| ofSemigroup _, id, id => rfl
| ofSemigroup _, id, ofSemigroup _ => rfl
| ofSemigroup _, ofSemigroup _, id => rfl
| ofSemigroup x, ofSemigroup y, ofSemigroup z => by simp only [op, Semigroup.Expr.op_assoc xs x y z]

instance : Monoid (Expr.sig xs) where
  op_assoc := Expr.op_assoc xs
  op_right_id (x) := match x with
  | Expr.ofSemigroup _ => rfl
  | Expr.id => rfl
  op_left_id (x) := match x with
  | Expr.ofSemigroup _ => rfl
  | Expr.id => rfl

end Completeness

end Expr

class Reflect (s : MonoidSig α) (x : α) (xs : List α) where
  expr : Expr xs
  eval_eq : expr.eval s = x

protected def Reflect.eq {α} (s : MonoidSig α) (x xs) [inst : Reflect s x xs] : inst.expr.eval s = x := inst.eval_eq

namespace Reflect
variable {α} (s : MonoidSig α) [Monoid s]

class Var (x : α) (xs : List α) extends Reflect s x xs

instance (priority:=low) instVarLift (x y : α) (xs : List α) [Var s y xs] : Var s y (x :: xs) where
  expr := Expr.lift x (expr s y)
  eval_eq := by simp [eval_eq]

instance instVarSelf (x : α) (xs : List α) : Var s x (x :: xs) where
  expr := Expr.ofSemigroup (Semigroup.Expr.var Index.head)
  eval_eq := by simp

instance instId {xs : List α} : Reflect s (no_index s.id) xs where
  expr := Expr.id
  eval_eq := by simp

instance instOp (x y : α) {xs : List α} [Reflect s x xs] [Reflect s y xs] : Reflect s (no_index (s.op x y)) xs where
  expr := Expr.op (expr s x) (expr s y)
  eval_eq := by simp [eval_eq]

end Reflect

theorem reflect {α} (s : MonoidSig α) [Monoid s] (xs : List α) {a b : α} [Reflect s a xs] [Reflect s b xs] : Reflect.expr s a (xs:=xs) = Reflect.expr s b → a = b := by
  intro h
  rw [←Reflect.eq s a xs, ←Reflect.eq s b xs, h]

end Algebra.Monoid

section Example
open Algebra
variable {α} (s : MonoidSig α) [Monoid s] (a b c d : α)

local infix:70 " ⋆ " => s.op
local notation "e" => s.id

example : (a ⋆ b) ⋆ (c ⋆ (e ⋆ d)) = (a ⋆ e) ⋆ ((b ⋆ c) ⋆ d) :=
  open Monoid.Reflect in Monoid.reflect s [a,b,c,d] rfl

@[reducible] def Algebra.addMonoidSig (α) [HAdd α α α] [OfNat α 0] : MonoidSig α where
  op := (.+.)
  id := 0

instance : CancelCommMonoid (addMonoidSig Nat) where
  op_assoc := Nat.add_assoc
  op_comm := Nat.add_comm
  op_right_id := Nat.add_zero
  op_right_cancel _ := Nat.add_right_cancel

example (x y z : Nat) : x + (y + z) + 1 = (x + (0 + y)) + z + 1 :=
  open Monoid.Reflect in Monoid.reflect (addMonoidSig Nat) [1,x,y,z] rfl

end Example


/-
Copyright (c) 2020 James Arthur. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: James Arthur, Chris Hughes, Shing Tak Lam.
-/
import analysis.special_functions.trigonometric
import basic

open real
local attribute [pp_nodot] real.log
noncomputable theory

/-!
# Inverse of the sinh function

In this file we prove that sinh is bijective and hence has an
inverse, arsinh.

## Main Results

- `sinh_injective`: The proof that `sinh` is injective
- `sinm_surjective`: The proof that `sinh` is surjective
- `sinm_bijective`: The proof `sinh` is bijective
- `arsinh`: The inverse function of `sinh`

## Tags

arsinh, arcsinh, argsinh, asinh, sinh injective, sinh bijective, sinh surjective
-/

/-- `arsinh` is defined using a logarithm, `arsinh x = log (x + sqrt(1 + x^2))`. -/
def arsinh (x : ℝ) := log (x + sqrt (1 + x^2))

/-- `sinh` is injective, `∀ a b, sinh a = sinh b → a = b`. -/
lemma sinh_injective : function.injective sinh := sinh_strict_mono.injective

private lemma aux_lemma (x : ℝ) : 1 / (x + sqrt (1 + x ^ 2)) = -x + sqrt (1 + x ^ 2) :=
begin
  refine (eq_one_div_of_mul_eq_one _).symm,
  have : 0 ≤ 1 + x ^ 2 := add_nonneg zero_le_one (pow_two_nonneg x),
  rw [add_comm, ← sub_eq_neg_add, ← mul_self_sub_mul_self,
      mul_self_sqrt this, pow_two, add_sub_cancel]
end

private lemma b_lt_sqrt_b_one_add_sq (b : ℝ) : b < sqrt (1 + b ^ 2) :=
calc  b
    ≤ sqrt (b ^ 2)     : le_sqrt_of_sqr_le $ le_refl _
... < sqrt (1 + b ^ 2) : (sqrt_lt (pow_two_nonneg _) (add_nonneg zero_le_one (pow_two_nonneg _))).2
  (lt_one_add _)

private lemma add_sqrt_one_add_pow_two_pos (b : ℝ) : 0 < b + sqrt (1 + b ^ 2) :=
by { rw [← neg_neg b, ← sub_eq_neg_add, sub_pos, pow_two, neg_mul_neg, ← pow_two],
  exact b_lt_sqrt_b_one_add_sq (-b) }

/-- `arsinh` is the right inverse of `sinh`. -/
lemma sinh_arsinh (x : ℝ) : sinh (arsinh x) = x :=
by rw [sinh_eq, arsinh, ← log_inv, exp_log (add_sqrt_one_add_pow_two_pos x),
      exp_log (inv_pos.2 (add_sqrt_one_add_pow_two_pos x)),
      inv_eq_one_div, aux_lemma x, sub_eq_add_neg, neg_add, neg_neg, ← sub_eq_add_neg,
      add_add_sub_cancel, add_self_div_two]

/-- `sinh` is surjective, `∀ b, ∃ a, sinh a = b`. In this case, we use `a = arsinh b`. -/
lemma sinh_surjective : function.surjective sinh := function.left_inverse.surjective sinh_arsinh

/-- `sinh` is bijective, both injective and surjective. -/
lemma sinh_bijective : function.bijective sinh :=
⟨sinh_injective, sinh_surjective⟩

/-- A rearrangment and `sqrt` of `real.cosh_sq_sub_sinh_sq`. -/
lemma sqrt_one_add_sinh_sq (x : ℝ): sqrt (1 + sinh x ^ 2) = cosh x :=
begin
  have H := real.cosh_sq_sub_sinh_sq x,
  have G : cosh x ^ 2 - sinh x ^ 2 + sinh x ^ 2 = 1 + sinh x ^ 2 := by rw H,
  rw sub_add_cancel at G,
  rw [←G, sqrt_sqr],
  exact le_of_lt (cosh_pos x),
end

/-- `arsinh` is the left inverse of `sinh`. -/
lemma arsinh_sinh (x : ℝ) : arsinh (sinh x) = x :=
function.right_inverse_of_injective_of_left_inverse sinh_injective sinh_arsinh x

--------  NEW STUFF  -----------

lemma arsinh_eq (x : ℝ) : arsinh x = log (x + sqrt(1 + x^2)) := rfl

lemma arsinh_zero : arsinh 0 = 0 := by {rw arsinh_eq, norm_num}

lemma cosh_arsinh (x : ℝ) : cosh (arsinh x) = sqrt (1 + x ^ 2) :=
by rw [← sqrt_one_add_sinh_sq (arsinh x), sinh_arsinh]

lemma arsinh_add_arsinh (x y : ℝ) : arsinh x + arsinh y = arsinh (x * sqrt(1 + y^2) + y * sqrt(1 + x^2)) :=
begin
  apply sinh_injective,
  rw sinh_add,
  simp only [sinh_arsinh, cosh_arsinh],
  rw mul_comm y,
end


import topology.instances.real
import topology.instances.ennreal
import data.real.ennreal
import topology.algebra.ordered

open topological_space set real filter
open_locale topological_space classical filter

-- TODO: Move.
private lemma ennreal.continuous_at_of_real : ∀ x, continuous_at ennreal.of_real x :=
λ x, (continuous_iff_continuous_at.1 ennreal.continuous_of_real x)

private lemma ennreal.monotone_of_real : monotone ennreal.of_real :=
λ a b, ennreal.of_real_le_of_real

private lemma ennreal.of_real_supr
{ι : Type*} [nonempty ι] (h : ι → ℝ) (hbdd : bdd_above (range h))
: ennreal.of_real (supr h) = supr (λ t, ennreal.of_real (h t)) :=
begin
    have hcts := ennreal.continuous_at_of_real (supr h),
    have hmono := ennreal.monotone_of_real,
    exact (map_csupr_of_continuous_at_of_monotone hcts hmono hbdd),
end


import Mathlib.Data.Nat.Basic
import Mathlib.Data.List.Chain

def func : List ℕ → ℕ → List ℕ
| s, n =>
  if h : s.length ≤ n then
    s
  else
    have h2 : List.length s - (n + 1) < List.length s - n := by
      apply Nat.sub_add_lt_sub _ zero_lt_one
      push_neg at h
      exact Nat.succ_le_of_lt h
    func s (n + 1)
  termination_by _ s n => s.length - n

def filter' : List ℕ → List ℕ → List ℕ
| s, [] => s
| s, (p :: ps) => filter' (s.filter (λ n => n = p ∨ n % p ≠ 0)) ps

def isPrime_aux : ℕ → ℕ → Bool
| 0, _ => false
| 1, _ => false
| 2, _ => true
| n, k =>
  if h : n ≤ k then
    true
  else if n < k * k then
    true
  else if n % k = 0 then
    false
  else
    have h1 : n - (k + 1) < n - k := by
      rw [← Nat.sub_sub]
      apply Nat.pred_lt
      simp [h]
    have h2 : n - (k + 2) < n - k := by
      apply Nat.lt_of_le_of_lt (Nat.pred_le _) h1
    isPrime_aux n (k + 2)
  termination_by _ n k => n - k

def isPrime (n : ℕ) := isPrime_aux n 3

def prefilter (l r : ℕ) := (List.range' l (r - l + 1)).filter (λ n => n = 2 ∨ n % 2 ≠ 0)

set_option profiler true

-- #eval ((prefilter 2 100).filter isPrime).sum
-- #eval ((prefilter 2 100000).filter isPrime).sum
-- #eval ((prefilter 2 500000).filter isPrime).sum
-- #eval ((prefilter 2 2000000).filter isPrime).sum

-- #eval (List.)

-- #eval (overflow [] (List.range' 0 10000)).sum
-- #eval (overflow [] (List.range' 0 100000)).sum

def base : List ℕ := List.range' 2 2000000
def small_primes : List ℕ := filter' (List.range' 2 1499) [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37]

-- #eval (filter' (List.range' 2 500000) small_primes).sum

-----------------------------------------------------------------------------------------

open Array Std.RBMap

-- Array implementation - Apparently arrays have builtin VM implementation, so it should be faster
def prime_sieve (n : ℕ) : Array ℕ := Id.run do
  let mut primes : Array ℕ := Array.empty
  let mut isp : Array Bool := Array.mkArray (n + 1) true
  for i in [2 : n + 1] do
    if isp[i]! then
      primes ← primes.push i
      for j in [i : n : i] do
        isp ← isp.modify j (λ _ => false)
  return primes

-- 7.25s
-- #eval (prime_sieve 2000000).toList.sum

-----------------------------------------------------------------------------------------

def linear_prime_sieve (n : ℕ) : Array ℕ := Id.run do
  let mut primes : Array ℕ := Array.empty
  let mut isp : Array Bool := Array.mkArray (n + 1) true
  for i in [2 : n + 1] do
    if isp[i]! then
      primes ← primes.push i
    for j in [: primes.size] do
      if i * primes[j]! > n then
        break
      isp ← isp.modify (i * primes[j]!) (λ _ => false)
      if i % primes[j]! = 0 then
        break
  return primes

-- 5.8s
-- #eval (linear_prime_sieve 2000000).toList.sum

-----------------------------------------------------------------------------------------

-- Project Euler, Problem 10 forum, Lucy_Hedgehog
def lucy_hedgehog (n : ℕ) : ℕ := Id.run do
  let r := n.sqrt
  let mut V := Array.empty
  let mut S := Std.HashMap.empty
  for i in [1 : r + 1] do
    V ← V.push (n / i)
  let f := n / r
  for i in [1 : f] do
    V ← V.push (f - i)
  for k in V do
    S ← S.insert k (k * (k + 1) / 2 - 1)
  for p in [2 : r + 1] do
    if S.find! p > S.find! (p - 1) then
      let sp := S.find! (p - 1)
      let p2 := p ^ 2
      for v in V do
        if v < p2 then
          break
        S ← S.insert v (S.find! v - p * (S.find! (v / p) - sp))
  return S.find! n

#eval lucy_hedgehog 2000000
#eval lucy_hedgehog 20000000
-- n = 10^8, 5.21sec
#eval lucy_hedgehog 100000000

example : lucy_hedgehog 100 = 1060 := sorry


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

import data.set.finite
import group_theory.submonoid.operations
import group_theory.subgroup.basic

/-!
# Finitely generated monoids and groups

We define finitely generated monoids and groups. See also `submodule.fg` and `module.finite` for
finitely-generated modules.

## Main definition

* `submonoid.fg S`, `add_submonoid.fg S` : A submonoid `S` is finitely generated.
* `monoid.fg M`, `add_monoid.fg M` : A typeclass indicating a type `M` is finitely generated as a
monoid.
* `subgroup.fg S`, `add_subgroup.fg S` : A subgroup `S` is finitely generated.
* `group.fg M`, `add_group.fg M` : A typeclass indicating a type `M` is finitely generated as a
group.

-/

/-! ### Monoids and submonoids -/

open_locale pointwise
variables {M N : Type*} [monoid M] [add_monoid N]

section submonoid

/-- A submonoid of `M` is finitely generated if it is the closure of a finite subset of `M`. -/
@[to_additive]
def submonoid.fg (P : submonoid M) : Prop := ∃ S : finset M, submonoid.closure ↑S = P

/-- An additive submonoid of `N` is finitely generated if it is the closure of a finite subset of
`M`. -/
add_decl_doc add_submonoid.fg

/-- An equivalent expression of `submonoid.fg` in terms of `set.finite` instead of `finset`. -/
@[to_additive "An equivalent expression of `add_submonoid.fg` in terms of `set.finite` instead of
`finset`."]
lemma submonoid.fg_iff (P : submonoid M) : submonoid.fg P ↔
  ∃ S : set M, submonoid.closure S = P ∧ S.finite :=
⟨λ ⟨S, hS⟩, ⟨S, hS, finset.finite_to_set S⟩, λ ⟨S, hS, hf⟩, ⟨set.finite.to_finset hf, by simp [hS]⟩⟩

lemma submonoid.fg_iff_add_fg (P : submonoid M) : P.fg ↔ P.to_add_submonoid.fg :=
⟨λ h, let ⟨S, hS, hf⟩ := (submonoid.fg_iff _).1 h in (add_submonoid.fg_iff _).mpr
  ⟨additive.to_mul ⁻¹' S, by simp [← submonoid.to_add_submonoid_closure, hS], hf⟩,
 λ h, let ⟨T, hT, hf⟩ := (add_submonoid.fg_iff _).1 h in (submonoid.fg_iff _).mpr
  ⟨multiplicative.of_add ⁻¹' T, by simp [← add_submonoid.to_submonoid'_closure, hT], hf⟩⟩

lemma add_submonoid.fg_iff_mul_fg (P : add_submonoid N) : P.fg ↔ P.to_submonoid.fg :=
begin
  convert (submonoid.fg_iff_add_fg P.to_submonoid).symm,
  exact set_like.ext' rfl
end

end submonoid

section monoid

variables (M N)

/-- A monoid is finitely generated if it is finitely generated as a submonoid of itself. -/
class monoid.fg : Prop := (out : (⊤ : submonoid M).fg)

/-- An additive monoid is finitely generated if it is finitely generated as an additive submonoid of
itself. -/
class add_monoid.fg : Prop := (out : (⊤ : add_submonoid N).fg)

attribute [to_additive] monoid.fg

variables {M N}

lemma monoid.fg_def : monoid.fg M ↔ (⊤ : submonoid M).fg := ⟨λ h, h.1, λ h, ⟨h⟩⟩

lemma add_monoid.fg_def : add_monoid.fg N ↔ (⊤ : add_submonoid N).fg := ⟨λ h, h.1, λ h, ⟨h⟩⟩

/-- An equivalent expression of `monoid.fg` in terms of `set.finite` instead of `finset`. -/
@[to_additive "An equivalent expression of `add_monoid.fg` in terms of `set.finite` instead of
`finset`."]
lemma monoid.fg_iff : monoid.fg M ↔
  ∃ S : set M, submonoid.closure S = (⊤ : submonoid M) ∧ S.finite :=
⟨λ h, (submonoid.fg_iff ⊤).1 h.out, λ h, ⟨(submonoid.fg_iff ⊤).2 h⟩⟩

lemma monoid.fg_iff_add_fg : monoid.fg M ↔ add_monoid.fg (additive M) :=
⟨λ h, ⟨(submonoid.fg_iff_add_fg ⊤).1 h.out⟩, λ h, ⟨(submonoid.fg_iff_add_fg ⊤).2 h.out⟩⟩

lemma add_monoid.fg_iff_mul_fg : add_monoid.fg N ↔ monoid.fg (multiplicative N) :=
⟨λ h, ⟨(add_submonoid.fg_iff_mul_fg ⊤).1 h.out⟩, λ h, ⟨(add_submonoid.fg_iff_mul_fg ⊤).2 h.out⟩⟩

instance add_monoid.fg_of_monoid_fg [monoid.fg M] : add_monoid.fg (additive M) :=
monoid.fg_iff_add_fg.1 ‹_›

instance monoid.fg_of_add_monoid_fg [add_monoid.fg N] : monoid.fg (multiplicative N) :=
add_monoid.fg_iff_mul_fg.1 ‹_›

end monoid

/-! ### Groups and subgroups -/

variables {G H : Type*} [group G] [add_group H]

section subgroup

/-- A subgroup of `G` is finitely generated if it is the closure of a finite subset of `G`. -/
@[to_additive]
def subgroup.fg (P : subgroup G) : Prop := ∃ S : finset G, subgroup.closure ↑S = P

/-- An additive subgroup of `H` is finitely generated if it is the closure of a finite subset of
`H`. -/
add_decl_doc add_subgroup.fg

/-- An equivalent expression of `subgroup.fg` in terms of `set.finite` instead of `finset`. -/
@[to_additive "An equivalent expression of `add_subgroup.fg` in terms of `set.finite` instead of
`finset`."]
lemma subgroup.fg_iff (P : subgroup G) : subgroup.fg P ↔
  ∃ S : set G, subgroup.closure S = P ∧ S.finite :=
⟨λ⟨S, hS⟩, ⟨S, hS, finset.finite_to_set S⟩, λ⟨S, hS, hf⟩, ⟨set.finite.to_finset hf, by simp [hS]⟩⟩

/-- A subgroup is finitely generated if and only if it is finitely generated as a submonoid. -/
@[to_additive add_subgroup.fg_iff_add_submonoid.fg "An additive subgroup is finitely generated if
and only if it is finitely generated as an additive submonoid."]
lemma subgroup.fg_iff_submonoid_fg (P : subgroup G) : P.fg ↔ P.to_submonoid.fg :=
begin
  split,
  { rintro ⟨S, rfl⟩,
    rw submonoid.fg_iff,
    refine ⟨S ∪ S⁻¹, _, S.finite_to_set.union S.finite_to_set.inv⟩,
    exact (subgroup.closure_to_submonoid _).symm },
  { rintro ⟨S, hS⟩,
    refine ⟨S, le_antisymm _ _⟩,
    { rw [subgroup.closure_le, ←subgroup.coe_to_submonoid, ←hS],
      exact submonoid.subset_closure },
    { rw [← subgroup.to_submonoid_le, ← hS, submonoid.closure_le],
      exact subgroup.subset_closure } }
end

lemma subgroup.fg_iff_add_fg (P : subgroup G) : P.fg ↔ P.to_add_subgroup.fg :=
begin
  rw [subgroup.fg_iff_submonoid_fg, add_subgroup.fg_iff_add_submonoid.fg],
  exact (subgroup.to_submonoid P).fg_iff_add_fg
end

lemma add_subgroup.fg_iff_mul_fg (P : add_subgroup H) :
  P.fg ↔ P.to_subgroup.fg :=
begin
  rw [add_subgroup.fg_iff_add_submonoid.fg, subgroup.fg_iff_submonoid_fg],
  exact add_submonoid.fg_iff_mul_fg (add_subgroup.to_add_submonoid P)
end

end subgroup

section group

variables (G H)

/-- A group is finitely generated if it is finitely generated as a submonoid of itself. -/
class group.fg : Prop := (out : (⊤ : subgroup G).fg)

/-- An additive group is finitely generated if it is finitely generated as an additive submonoid of
itself. -/
class add_group.fg : Prop := (out : (⊤ : add_subgroup H).fg)

attribute [to_additive] group.fg

variables {G H}

lemma group.fg_def : group.fg G ↔ (⊤ : subgroup G).fg := ⟨λ h, h.1, λ h, ⟨h⟩⟩

lemma add_group.fg_def : add_group.fg H ↔ (⊤ : add_subgroup H).fg := ⟨λ h, h.1, λ h, ⟨h⟩⟩

/-- An equivalent expression of `group.fg` in terms of `set.finite` instead of `finset`. -/
@[to_additive "An equivalent expression of `add_group.fg` in terms of `set.finite` instead of
`finset`."]
lemma group.fg_iff : group.fg G ↔
  ∃ S : set G, subgroup.closure S = (⊤ : subgroup G) ∧ S.finite :=
⟨λ h, (subgroup.fg_iff ⊤).1 h.out, λ h, ⟨(subgroup.fg_iff ⊤).2 h⟩⟩

/-- A group is finitely generated if and only if it is finitely generated as a monoid. -/
@[to_additive add_group.fg_iff_add_monoid.fg "An additive group is finitely generated if and only
if it is finitely generated as an additive monoid."]
lemma group.fg_iff_monoid.fg : group.fg G ↔ monoid.fg G :=
⟨λ h, monoid.fg_def.2 $ (subgroup.fg_iff_submonoid_fg ⊤).1 (group.fg_def.1 h),
    λ h, group.fg_def.2 $ (subgroup.fg_iff_submonoid_fg ⊤).2 (monoid.fg_def.1 h)⟩

lemma group_fg.iff_add_fg : group.fg G ↔ add_group.fg (additive G) :=
⟨λ h, ⟨(subgroup.fg_iff_add_fg ⊤).1 h.out⟩, λ h, ⟨(subgroup.fg_iff_add_fg ⊤).2 h.out⟩⟩

lemma add_group.fg_iff_mul_fg : add_group.fg H ↔ group.fg (multiplicative H) :=
⟨λ h, ⟨(add_subgroup.fg_iff_mul_fg ⊤).1 h.out⟩, λ h, ⟨(add_subgroup.fg_iff_mul_fg ⊤).2 h.out⟩⟩

instance add_group.fg_of_group_fg [group.fg G] : add_group.fg (additive G) :=
group_fg.iff_add_fg.1 ‹_›

instance group.fg_of_mul_group_fg [add_group.fg H] : group.fg (multiplicative H) :=
add_group.fg_iff_mul_fg.1 ‹_›

end group


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

open list nat

namespace multiset

/- range -/

/-- `range n` is the multiset lifted from the list `range n`,
  that is, the set `{0, 1, ..., n-1}`. -/
def range (n : ℕ) : multiset ℕ := range n

@[simp] theorem range_zero : range 0 = 0 := rfl

@[simp] theorem range_succ (n : ℕ) : range (succ n) = n ::ₘ range n :=
by rw [range, range_succ, ← coe_add, add_comm]; refl

@[simp] theorem card_range (n : ℕ) : card (range n) = n := length_range _

theorem range_subset {m n : ℕ} : range m ⊆ range n ↔ m ≤ n := range_subset

@[simp] theorem mem_range {m n : ℕ} : m ∈ range n ↔ m < n := mem_range

@[simp] theorem not_mem_range_self {n : ℕ} : n ∉ range n := not_mem_range_self

theorem self_mem_range_succ (n : ℕ) : n ∈ range (n + 1) := list.self_mem_range_succ n

end multiset


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

! This file was ported from Lean 3 source module data.finsupp.big_operators
! leanprover-community/mathlib commit 59694bd07f0a39c5beccba34bd9f413a160782bf
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finsupp.Defs
import Mathlib.Data.Finset.Pairwise

/-!

# Sums of collections of Finsupp, and their support
This file provides results about the `Finsupp.support` of sums of collections of `Finsupp`,
including sums of `List`, `Multiset`, and `Finset`.

The support of the sum is a subset of the union of the supports:
* `List.support_sum_subset`
* `Multiset.support_sum_subset`
* `Finset.support_sum_subset`

The support of the sum of pairwise disjoint finsupps is equal to the union of the supports
* `List.support_sum_eq`
* `Multiset.support_sum_eq`
* `Finset.support_sum_eq`

Member in the support of the indexed union over a collection iff
it is a member of the support of a member of the collection:
* `List.mem_foldr_sup_support_iff`
* `Multiset.mem_sup_map_support_iff`
* `Finset.mem_sup_support_iff`

-/

variable {ι M : Type _} [DecidableEq ι]

theorem List.support_sum_subset [AddMonoid M] (l : List (ι →₀ M)) :
    l.sum.support ⊆ l.foldr ((· ⊔ ·) ∘ Finsupp.support) ∅ := by
  induction' l with hd tl IH
  · simp
  · simp only [List.sum_cons, Finset.union_comm]
    refine' Finsupp.support_add.trans (Finset.union_subset_union _ IH)
    rfl
#align list.support_sum_subset List.support_sum_subset

theorem Multiset.support_sum_subset [AddCommMonoid M] (s : Multiset (ι →₀ M)) :
    s.sum.support ⊆ (s.map Finsupp.support).sup := by
  induction s using Quot.inductionOn
  simpa only [Multiset.quot_mk_to_coe'', Multiset.coe_sum, Multiset.coe_map, Multiset.sup_coe,
    List.foldr_map] using List.support_sum_subset _
#align multiset.support_sum_subset Multiset.support_sum_subset

theorem Finset.support_sum_subset [AddCommMonoid M] (s : Finset (ι →₀ M)) :
    (s.sum id).support ⊆ Finset.sup s Finsupp.support := by
  classical convert Multiset.support_sum_subset s.1 ; simp
#align finset.support_sum_subset Finset.support_sum_subset

theorem List.mem_foldr_sup_support_iff [Zero M] {l : List (ι →₀ M)} {x : ι} :
    x ∈ l.foldr ((· ⊔ ·) ∘ Finsupp.support) ∅ ↔ ∃ (f : ι →₀ M)(_ : f ∈ l), x ∈ f.support := by
  simp only [Finset.sup_eq_union, List.foldr_map, Finsupp.mem_support_iff, exists_prop]
  induction' l with hd tl IH
  · simp
  · simp only [foldr, Function.comp_apply, Finset.mem_union, Finsupp.mem_support_iff, ne_eq, IH,
      find?, mem_cons, exists_eq_or_imp]
#align list.mem_foldr_sup_support_iff List.mem_foldr_sup_support_iff

theorem Multiset.mem_sup_map_support_iff [Zero M] {s : Multiset (ι →₀ M)} {x : ι} :
    x ∈ (s.map Finsupp.support).sup ↔ ∃ (f : ι →₀ M)(_ : f ∈ s), x ∈ f.support :=
  Quot.inductionOn s fun _ ↦ by
    simpa only [Multiset.quot_mk_to_coe'', Multiset.coe_map, Multiset.sup_coe, List.foldr_map]
    using List.mem_foldr_sup_support_iff
#align multiset.mem_sup_map_support_iff Multiset.mem_sup_map_support_iff

theorem Finset.mem_sup_support_iff [Zero M] {s : Finset (ι →₀ M)} {x : ι} :
    x ∈ s.sup Finsupp.support ↔ ∃ (f : ι →₀ M)(_ : f ∈ s), x ∈ f.support :=
  Multiset.mem_sup_map_support_iff
#align finset.mem_sup_support_iff Finset.mem_sup_support_iff

theorem List.support_sum_eq [AddMonoid M] (l : List (ι →₀ M))
    (hl : l.Pairwise (_root_.Disjoint on Finsupp.support)) :
    l.sum.support = l.foldr ((· ⊔ ·) ∘ Finsupp.support) ∅ := by
  induction' l with hd tl IH
  · simp
  · simp only [List.pairwise_cons] at hl
    simp only [List.sum_cons, List.foldr_cons, Function.comp_apply]
    rw [Finsupp.support_add_eq, IH hl.right, Finset.sup_eq_union]
    suffices _root_.Disjoint hd.support (tl.foldr (fun x y ↦ (Finsupp.support x ⊔ y)) ∅) by
      exact Finset.disjoint_of_subset_right (List.support_sum_subset _) this
    · rw [← List.foldr_map, ← Finset.bot_eq_empty, List.foldr_sup_eq_sup_toFinset,
        Finset.disjoint_sup_right]
      intro f hf
      simp only [List.mem_toFinset, List.mem_map] at hf
      obtain ⟨f, hf, rfl⟩ := hf
      exact hl.left _ hf
#align list.support_sum_eq List.support_sum_eq

theorem Multiset.support_sum_eq [AddCommMonoid M] (s : Multiset (ι →₀ M))
    (hs : s.Pairwise (_root_.Disjoint on Finsupp.support)) :
    s.sum.support = (s.map Finsupp.support).sup := by
  induction' s using Quot.inductionOn with a
  obtain ⟨l, hl, hd⟩ := hs
  suffices : a.Pairwise (_root_.Disjoint on Finsupp.support)
  · convert List.support_sum_eq a this
    · simp only [Multiset.quot_mk_to_coe'', Multiset.coe_sum]
    · dsimp only [Function.comp]
      simp only [quot_mk_to_coe'', coe_map, sup_coe, ge_iff_le, Finset.le_eq_subset,
        Finset.sup_eq_union, Finset.bot_eq_empty, List.foldr_map]
  · simp only [Multiset.quot_mk_to_coe'', Multiset.coe_map, Multiset.coe_eq_coe] at hl
    exact hl.symm.pairwise hd fun _ _ h ↦ _root_.Disjoint.symm h
#align multiset.support_sum_eq Multiset.support_sum_eq

theorem Finset.support_sum_eq [AddCommMonoid M] (s : Finset (ι →₀ M))
    (hs : (s : Set (ι →₀ M)).PairwiseDisjoint Finsupp.support) :
    (s.sum id).support = Finset.sup s Finsupp.support := by
  classical
    suffices : s.1.Pairwise (_root_.Disjoint on Finsupp.support)
    · convert Multiset.support_sum_eq s.1 this
      · exact (Finset.sum_val _).symm
    · obtain ⟨l, hl, hn⟩ : ∃ l : List (ι →₀ M), l.toFinset = s ∧ l.Nodup := by
        refine' ⟨s.toList, _, Finset.nodup_toList _⟩
        simp
      subst hl
      rwa [List.toFinset_val, List.dedup_eq_self.mpr hn, Multiset.pairwise_coe_iff_pairwise, ←
        List.pairwiseDisjoint_iff_coe_toFinset_pairwise_disjoint hn]
      intro x y hxy
      exact symmetric_disjoint hxy

#align finset.support_sum_eq Finset.support_sum_eq