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

! This file was ported from Lean 3 source module number_theory.cyclotomic.rat
! leanprover-community/mathlib commit 2032a878972d5672e7c27c957e7a6e297b044973
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.NumberTheory.Cyclotomic.Discriminant
import Mathbin.RingTheory.Polynomial.Eisenstein.IsIntegral

/-!
# Ring of integers of `p ^ n`-th cyclotomic fields
We gather results about cyclotomic extensions of `ℚ`. In particular, we compute the ring of
integers of a `p ^ n`-th cyclotomic extension of `ℚ`.

## Main results
* `is_cyclotomic_extension.rat.is_integral_closure_adjoin_singleton_of_prime_pow`: if `K` is a
  `p ^ k`-th cyclotomic extension of `ℚ`, then `(adjoin ℤ {ζ})` is the integral closure of
  `ℤ` in `K`.
* `is_cyclotomic_extension.rat.cyclotomic_ring_is_integral_closure_of_prime_pow`: the integral
  closure of `ℤ` inside `cyclotomic_field (p ^ k) ℚ` is `cyclotomic_ring (p ^ k) ℤ ℚ`.
-/

universe u

open Algebra IsCyclotomicExtension Polynomial NumberField

open Cyclotomic NumberField Nat

variable {p : ℕ+} {k : ℕ} {K : Type u} [Field K] [CharZero K] {ζ : K} [hp : Fact (p : ℕ).Prime]

include hp

namespace IsCyclotomicExtension.Rat

/-- The discriminant of the power basis given by `ζ - 1`. -/
theorem discr_prime_pow_ne_two' [IsCyclotomicExtension {p ^ (k + 1)} ℚ K]
    (hζ : IsPrimitiveRoot ζ ↑(p ^ (k + 1))) (hk : p ^ (k + 1) ≠ 2) :
    discr ℚ (hζ.subOnePowerBasis ℚ).basis =
      (-1) ^ ((p ^ (k + 1) : ℕ).totient / 2) * p ^ ((p : ℕ) ^ k * ((p - 1) * (k + 1) - 1)) :=
  by
  rw [← discr_prime_pow_ne_two hζ (cyclotomic.irreducible_rat (p ^ (k + 1)).Pos) hk]
  exact hζ.discr_zeta_eq_discr_zeta_sub_one.symm
#align is_cyclotomic_extension.rat.discr_prime_pow_ne_two' IsCyclotomicExtension.Rat.discr_prime_pow_ne_two'

theorem discr_odd_prime' [IsCyclotomicExtension {p} ℚ K] (hζ : IsPrimitiveRoot ζ p) (hodd : p ≠ 2) :
    discr ℚ (hζ.subOnePowerBasis ℚ).basis = (-1) ^ (((p : ℕ) - 1) / 2) * p ^ ((p : ℕ) - 2) :=
  by
  rw [← discr_odd_prime hζ (cyclotomic.irreducible_rat hp.out.pos) hodd]
  exact hζ.discr_zeta_eq_discr_zeta_sub_one.symm
#align is_cyclotomic_extension.rat.discr_odd_prime' IsCyclotomicExtension.Rat.discr_odd_prime'

/-- The discriminant of the power basis given by `ζ - 1`. Beware that in the cases `p ^ k = 1` and
`p ^ k = 2` the formula uses `1 / 2 = 0` and `0 - 1 = 0`. It is useful only to have a uniform
result. See also `is_cyclotomic_extension.rat.discr_prime_pow_eq_unit_mul_pow'`. -/
theorem discr_prime_pow' [IsCyclotomicExtension {p ^ k} ℚ K] (hζ : IsPrimitiveRoot ζ ↑(p ^ k)) :
    discr ℚ (hζ.subOnePowerBasis ℚ).basis =
      (-1) ^ ((p ^ k : ℕ).totient / 2) * p ^ ((p : ℕ) ^ (k - 1) * ((p - 1) * k - 1)) :=
  by
  rw [← discr_prime_pow hζ (cyclotomic.irreducible_rat (p ^ k).Pos)]
  exact hζ.discr_zeta_eq_discr_zeta_sub_one.symm
#align is_cyclotomic_extension.rat.discr_prime_pow' IsCyclotomicExtension.Rat.discr_prime_pow'

/-- If `p` is a prime and `is_cyclotomic_extension {p ^ k} K L`, then there are `u : ℤˣ` and
`n : ℕ` such that the discriminant of the power basis given by `ζ - 1` is `u * p ^ n`. Often this is
enough and less cumbersome to use than `is_cyclotomic_extension.rat.discr_prime_pow'`. -/
theorem discr_prime_pow_eq_unit_mul_pow' [IsCyclotomicExtension {p ^ k} ℚ K]
    (hζ : IsPrimitiveRoot ζ ↑(p ^ k)) :
    ∃ (u : ℤˣ)(n : ℕ), discr ℚ (hζ.subOnePowerBasis ℚ).basis = u * p ^ n :=
  by
  rw [hζ.discr_zeta_eq_discr_zeta_sub_one.symm]
  exact discr_prime_pow_eq_unit_mul_pow hζ (cyclotomic.irreducible_rat (p ^ k).Pos)
#align is_cyclotomic_extension.rat.discr_prime_pow_eq_unit_mul_pow' IsCyclotomicExtension.Rat.discr_prime_pow_eq_unit_mul_pow'

/-- If `K` is a `p ^ k`-th cyclotomic extension of `ℚ`, then `(adjoin ℤ {ζ})` is the
integral closure of `ℤ` in `K`. -/
theorem isIntegralClosure_adjoin_singleton_of_prime_pow [hcycl : IsCyclotomicExtension {p ^ k} ℚ K]
    (hζ : IsPrimitiveRoot ζ ↑(p ^ k)) : IsIntegralClosure (adjoin ℤ ({ζ} : Set K)) ℤ K :=
  by
  refine' ⟨Subtype.val_injective, fun x => ⟨fun h => ⟨⟨x, _⟩, rfl⟩, _⟩⟩
  swap
  · rintro ⟨y, rfl⟩
    exact
      IsIntegral.algebraMap
        (le_integralClosure_iff_isIntegral.1
          (adjoin_le_integralClosure (hζ.is_integral (p ^ k).Pos)) _)
  let B := hζ.sub_one_power_basis ℚ
  have hint : IsIntegral ℤ B.gen := isIntegral_sub (hζ.is_integral (p ^ k).Pos) isIntegral_one
  have H := discr_mul_is_integral_mem_adjoin ℚ hint h
  obtain ⟨u, n, hun⟩ := discr_prime_pow_eq_unit_mul_pow' hζ
  rw [hun] at H
  replace H := Subalgebra.smul_mem _ H u.inv
  rw [← smul_assoc, ← smul_mul_assoc, Units.inv_eq_val_inv, coe_coe, zsmul_eq_mul, ← Int.cast_mul,
    Units.inv_mul, Int.cast_one, one_mul,
    show (p : ℚ) ^ n • x = ((p : ℕ) : ℤ) ^ n • x by simp [smul_def]] at H
  cases k
  · haveI : IsCyclotomicExtension {1} ℚ K := by simpa using hcycl
    have : x ∈ (⊥ : Subalgebra ℚ K) := by
      rw [singleton_one ℚ K]
      exact mem_top
    obtain ⟨y, rfl⟩ := mem_bot.1 this
    replace h := (isIntegral_algebraMap_iff (algebraMap ℚ K).Injective).1 h
    obtain ⟨z, hz⟩ := IsIntegrallyClosed.isIntegral_iff.1 h
    rw [← hz, ← IsScalarTower.algebraMap_apply]
    exact Subalgebra.algebraMap_mem _ _
  · have hmin : (minpoly ℤ B.gen).IsEisensteinAt (Submodule.span ℤ {((p : ℕ) : ℤ)}) :=
      by
      have h₁ := minpoly.isIntegrallyClosed_eq_field_fractions' ℚ hint
      have h₂ := hζ.minpoly_sub_one_eq_cyclotomic_comp (cyclotomic.irreducible_rat (p ^ _).Pos)
      rw [IsPrimitiveRoot.subOnePowerBasis_gen] at h₁
      rw [h₁, ← map_cyclotomic_int, show Int.castRingHom ℚ = algebraMap ℤ ℚ by rfl,
        show X + 1 = map (algebraMap ℤ ℚ) (X + 1) by simp, ← map_comp] at h₂
      haveI : CharZero ℚ := StrictOrderedSemiring.to_charZero
      rw [IsPrimitiveRoot.subOnePowerBasis_gen,
        map_injective (algebraMap ℤ ℚ) (algebraMap ℤ ℚ).injective_int h₂]
      exact cyclotomic_prime_pow_comp_x_add_one_isEisensteinAt _ _
    refine'
      adjoin_le _
        (mem_adjoin_of_smul_prime_pow_smul_of_minpoly_is_eiseinstein_at
          (Nat.prime_iff_prime_int.1 hp.out) hint h H hmin)
    simp only [Set.singleton_subset_iff, SetLike.mem_coe]
    exact Subalgebra.sub_mem _ (self_mem_adjoin_singleton ℤ _) (Subalgebra.one_mem _)
#align is_cyclotomic_extension.rat.is_integral_closure_adjoin_singleton_of_prime_pow IsCyclotomicExtension.Rat.isIntegralClosure_adjoin_singleton_of_prime_pow

theorem isIntegralClosure_adjoin_singleton_of_prime [hcycl : IsCyclotomicExtension {p} ℚ K]
    (hζ : IsPrimitiveRoot ζ ↑p) : IsIntegralClosure (adjoin ℤ ({ζ} : Set K)) ℤ K :=
  by
  rw [← pow_one p] at hζ hcycl
  exact is_integral_closure_adjoin_singleton_of_prime_pow hζ
#align is_cyclotomic_extension.rat.is_integral_closure_adjoin_singleton_of_prime IsCyclotomicExtension.Rat.isIntegralClosure_adjoin_singleton_of_prime

attribute [-instance] CyclotomicField.algebra

/-- The integral closure of `ℤ` inside `cyclotomic_field (p ^ k) ℚ` is
`cyclotomic_ring (p ^ k) ℤ ℚ`. -/
theorem cyclotomicRing_isIntegralClosure_of_prime_pow :
    IsIntegralClosure (CyclotomicRing (p ^ k) ℤ ℚ) ℤ (CyclotomicField (p ^ k) ℚ) :=
  by
  haveI : CharZero ℚ := StrictOrderedSemiring.to_charZero
  have : IsCyclotomicExtension {p ^ k} ℚ (CyclotomicField (p ^ k) ℚ) :=
    by
    convert CyclotomicField.isCyclotomicExtension (p ^ k) _
    · exact Subsingleton.elim _ _
    · exact NeZero.charZero
  have hζ := zeta_spec (p ^ k) ℚ (CyclotomicField (p ^ k) ℚ)
  refine' ⟨IsFractionRing.injective _ _, fun x => ⟨fun h => ⟨⟨x, _⟩, rfl⟩, _⟩⟩
  · have := (is_integral_closure_adjoin_singleton_of_prime_pow hζ).isIntegral_iff
    obtain ⟨y, rfl⟩ := this.1 h
    convert adjoin_mono _ y.2
    · simp only [eq_iff_true_of_subsingleton]
    · simp only [eq_iff_true_of_subsingleton]
    · simp only [PNat.pow_coe, Set.singleton_subset_iff, Set.mem_setOf_eq]
      exact hζ.pow_eq_one
  · have : IsCyclotomicExtension {p ^ k} ℤ (CyclotomicRing (p ^ k) ℤ ℚ) :=
      by
      convert CyclotomicRing.isCyclotomicExtension _ ℤ ℚ
      · exact Subsingleton.elim _ _
      · exact NeZero.charZero
    rintro ⟨y, rfl⟩
    exact IsIntegral.algebraMap ((IsCyclotomicExtension.integral {p ^ k} ℤ _) _)
#align is_cyclotomic_extension.rat.cyclotomic_ring_is_integral_closure_of_prime_pow IsCyclotomicExtension.Rat.cyclotomicRing_isIntegralClosure_of_prime_pow

theorem cyclotomicRing_isIntegralClosure_of_prime :
    IsIntegralClosure (CyclotomicRing p ℤ ℚ) ℤ (CyclotomicField p ℚ) :=
  by
  rw [← pow_one p]
  exact cyclotomic_ring_is_integral_closure_of_prime_pow
#align is_cyclotomic_extension.rat.cyclotomic_ring_is_integral_closure_of_prime IsCyclotomicExtension.Rat.cyclotomicRing_isIntegralClosure_of_prime

end IsCyclotomicExtension.Rat

section PowerBasis

open IsCyclotomicExtension.Rat

namespace IsPrimitiveRoot

/-- The algebra isomorphism `adjoin ℤ {ζ} ≃ₐ[ℤ] (𝓞 K)`, where `ζ` is a primitive `p ^ k`-th root of
unity and `K` is a `p ^ k`-th cyclotomic extension of `ℚ`. -/
@[simps]
noncomputable def IsPrimitiveRoot.adjoinEquivRingOfIntegers
    [hcycl : IsCyclotomicExtension {p ^ k} ℚ K] (hζ : IsPrimitiveRoot ζ ↑(p ^ k)) :
    adjoin ℤ ({ζ} : Set K) ≃ₐ[ℤ] 𝓞 K :=
  let _ := isIntegralClosure_adjoin_singleton_of_prime_pow hζ
  IsIntegralClosure.equiv ℤ (adjoin ℤ ({ζ} : Set K)) K (𝓞 K)
#align is_primitive_root.adjoin_equiv_ring_of_integers IsPrimitiveRoot.adjoinEquivRingOfIntegers

/-- The ring of integers of a `p ^ k`-th cyclotomic extension of `ℚ` is a cyclotomic extension. -/
instance IsCyclotomicExtension.ringOfIntegers [IsCyclotomicExtension {p ^ k} ℚ K] :
    IsCyclotomicExtension {p ^ k} ℤ (𝓞 K) :=
  let _ := (zeta_spec (p ^ k) ℚ K).adjoin_isCyclotomicExtension ℤ
  IsCyclotomicExtension.equiv _ ℤ _ (zeta_spec (p ^ k) ℚ K).adjoinEquivRingOfIntegers
#align is_cyclotomic_extension.ring_of_integers IsCyclotomicExtension.ringOfIntegers

/-- The integral `power_basis` of `𝓞 K` given by a primitive root of unity, where `K` is a `p ^ k`
cyclotomic extension of `ℚ`. -/
noncomputable def integralPowerBasis [hcycl : IsCyclotomicExtension {p ^ k} ℚ K]
    (hζ : IsPrimitiveRoot ζ ↑(p ^ k)) : PowerBasis ℤ (𝓞 K) :=
  (adjoin.powerBasis' (hζ.IsIntegral (p ^ k).Pos)).map hζ.adjoinEquivRingOfIntegers
#align is_primitive_root.integral_power_basis IsPrimitiveRoot.integralPowerBasis

@[simp]
theorem integralPowerBasis_gen [hcycl : IsCyclotomicExtension {p ^ k} ℚ K]
    (hζ : IsPrimitiveRoot ζ ↑(p ^ k)) :
    hζ.integralPowerBasis.gen = ⟨ζ, hζ.IsIntegral (p ^ k).Pos⟩ :=
  Subtype.ext <| show algebraMap _ K hζ.integralPowerBasis.gen = _ by simpa [integral_power_basis]
#align is_primitive_root.integral_power_basis_gen IsPrimitiveRoot.integralPowerBasis_gen

@[simp]
theorem integralPowerBasis_dim [hcycl : IsCyclotomicExtension {p ^ k} ℚ K]
    (hζ : IsPrimitiveRoot ζ ↑(p ^ k)) : hζ.integralPowerBasis.dim = φ (p ^ k) := by
  simp [integral_power_basis, ← cyclotomic_eq_minpoly hζ, nat_degree_cyclotomic]
#align is_primitive_root.integral_power_basis_dim IsPrimitiveRoot.integralPowerBasis_dim

/-- The algebra isomorphism `adjoin ℤ {ζ} ≃ₐ[ℤ] (𝓞 K)`, where `ζ` is a primitive `p`-th root of
unity and `K` is a `p`-th cyclotomic extension of `ℚ`. -/
@[simps]
noncomputable def IsPrimitiveRoot.adjoinEquivRingOfIntegers' [hcycl : IsCyclotomicExtension {p} ℚ K]
    (hζ : IsPrimitiveRoot ζ p) : adjoin ℤ ({ζ} : Set K) ≃ₐ[ℤ] 𝓞 K :=
  @adjoinEquivRingOfIntegers p 1 K _ _ _ _
    (by
      convert hcycl
      rw [pow_one])
    (by rwa [pow_one])
#align is_primitive_root.adjoin_equiv_ring_of_integers' IsPrimitiveRoot.adjoinEquivRingOfIntegers'

/-- The ring of integers of a `p`-th cyclotomic extension of `ℚ` is a cyclotomic extension. -/
instance IsCyclotomicExtension.ring_of_integers' [IsCyclotomicExtension {p} ℚ K] :
    IsCyclotomicExtension {p} ℤ (𝓞 K) :=
  let _ := (zeta_spec p ℚ K).adjoin_isCyclotomicExtension ℤ
  IsCyclotomicExtension.equiv _ ℤ _ (zeta_spec p ℚ K).adjoinEquivRingOfIntegers'
#align is_cyclotomic_extension.ring_of_integers' IsCyclotomicExtension.ring_of_integers'

/-- The integral `power_basis` of `𝓞 K` given by a primitive root of unity, where `K` is a `p`-th
cyclotomic extension of `ℚ`. -/
noncomputable def integralPowerBasis' [hcycl : IsCyclotomicExtension {p} ℚ K]
    (hζ : IsPrimitiveRoot ζ p) : PowerBasis ℤ (𝓞 K) :=
  @integralPowerBasis p 1 K _ _ _ _
    (by
      convert hcycl
      rw [pow_one])
    (by rwa [pow_one])
#align is_primitive_root.integral_power_basis' IsPrimitiveRoot.integralPowerBasis'

@[simp]
theorem integralPowerBasis'_gen [hcycl : IsCyclotomicExtension {p} ℚ K] (hζ : IsPrimitiveRoot ζ p) :
    hζ.integralPowerBasis'.gen = ⟨ζ, hζ.IsIntegral p.Pos⟩ :=
  @integralPowerBasis_gen p 1 K _ _ _ _
    (by
      convert hcycl
      rw [pow_one])
    (by rwa [pow_one])
#align is_primitive_root.integral_power_basis'_gen IsPrimitiveRoot.integralPowerBasis'_gen

@[simp]
theorem power_basis_int'_dim [hcycl : IsCyclotomicExtension {p} ℚ K] (hζ : IsPrimitiveRoot ζ p) :
    hζ.integralPowerBasis'.dim = φ p := by
  erw [@integral_power_basis_dim p 1 K _ _ _ _
      (by
        convert hcycl
        rw [pow_one])
      (by rwa [pow_one]),
    pow_one]
#align is_primitive_root.power_basis_int'_dim IsPrimitiveRoot.power_basis_int'_dim

/-- The integral `power_basis` of `𝓞 K` given by `ζ - 1`, where `K` is a `p ^ k` cyclotomic
extension of `ℚ`. -/
noncomputable def subOneIntegralPowerBasis [IsCyclotomicExtension {p ^ k} ℚ K]
    (hζ : IsPrimitiveRoot ζ ↑(p ^ k)) : PowerBasis ℤ (𝓞 K) :=
  PowerBasis.ofGenMemAdjoin' hζ.integralPowerBasis
    (isIntegral_of_mem_ringOfIntegers <|
      Subalgebra.sub_mem _ (hζ.IsIntegral (p ^ k).Pos) (Subalgebra.one_mem _))
    (by
      simp only [integral_power_basis_gen]
      convert Subalgebra.add_mem _ (self_mem_adjoin_singleton ℤ (⟨ζ - 1, _⟩ : 𝓞 K))
          (Subalgebra.one_mem _)
      simp)
#align is_primitive_root.sub_one_integral_power_basis IsPrimitiveRoot.subOneIntegralPowerBasis

@[simp]
theorem subOneIntegralPowerBasis_gen [IsCyclotomicExtension {p ^ k} ℚ K]
    (hζ : IsPrimitiveRoot ζ ↑(p ^ k)) :
    hζ.subOneIntegralPowerBasis.gen =
      ⟨ζ - 1, Subalgebra.sub_mem _ (hζ.IsIntegral (p ^ k).Pos) (Subalgebra.one_mem _)⟩ :=
  by simp [sub_one_integral_power_basis]
#align is_primitive_root.sub_one_integral_power_basis_gen IsPrimitiveRoot.subOneIntegralPowerBasis_gen

/-- The integral `power_basis` of `𝓞 K` given by `ζ - 1`, where `K` is a `p`-th cyclotomic
extension of `ℚ`. -/
noncomputable def subOneIntegralPowerBasis' [hcycl : IsCyclotomicExtension {p} ℚ K]
    (hζ : IsPrimitiveRoot ζ p) : PowerBasis ℤ (𝓞 K) :=
  @subOneIntegralPowerBasis p 1 K _ _ _ _
    (by
      convert hcycl
      rw [pow_one])
    (by rwa [pow_one])
#align is_primitive_root.sub_one_integral_power_basis' IsPrimitiveRoot.subOneIntegralPowerBasis'

@[simp]
theorem subOneIntegralPowerBasis'_gen [hcycl : IsCyclotomicExtension {p} ℚ K]
    (hζ : IsPrimitiveRoot ζ p) :
    hζ.subOneIntegralPowerBasis'.gen =
      ⟨ζ - 1, Subalgebra.sub_mem _ (hζ.IsIntegral p.Pos) (Subalgebra.one_mem _)⟩ :=
  @subOneIntegralPowerBasis_gen p 1 K _ _ _ _
    (by
      convert hcycl
      rw [pow_one])
    (by rwa [pow_one])
#align is_primitive_root.sub_one_integral_power_basis'_gen IsPrimitiveRoot.subOneIntegralPowerBasis'_gen

end IsPrimitiveRoot

end PowerBasis


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

import data.complex.exponential
import analysis.special_functions.log_deriv

/-!
# Bounds on specific values of the exponential
-/
namespace real

open is_absolute_value finset cau_seq complex

lemma exp_one_near_10 : |exp 1 - 2244083/825552| ≤ 1/10^10 :=
begin
  apply exp_approx_start,
  iterate 13 { refine exp_1_approx_succ_eq (by norm_num1; refl) (by norm_cast; refl) _ },
  norm_num1,
  refine exp_approx_end' _ (by norm_num1; refl) _ (by norm_cast; refl) (by simp) _,
  rw [_root_.abs_one, abs_of_pos]; norm_num1,
end

lemma exp_one_near_20 : |exp 1 - 363916618873/133877442384| ≤ 1/10^20 :=
begin
  apply exp_approx_start,
  iterate 21 { refine exp_1_approx_succ_eq (by norm_num1; refl) (by norm_cast; refl) _ },
  norm_num1,
  refine exp_approx_end' _ (by norm_num1; refl) _ (by norm_cast; refl) (by simp) _,
  rw [_root_.abs_one, abs_of_pos]; norm_num1,
end

lemma exp_one_gt_d9 : 2.7182818283 < exp 1 :=
lt_of_lt_of_le (by norm_num) (sub_le.1 (abs_sub_le_iff.1 exp_one_near_10).2)

lemma exp_one_lt_d9 : exp 1 < 2.7182818286 :=
lt_of_le_of_lt (sub_le_iff_le_add.1 (abs_sub_le_iff.1 exp_one_near_10).1) (by norm_num)

lemma exp_neg_one_gt_d9 : 0.36787944116 < exp (-1) :=
begin
  rw [exp_neg, lt_inv _ (exp_pos _)],
  refine lt_of_le_of_lt (sub_le_iff_le_add.1 (abs_sub_le_iff.1 exp_one_near_10).1) _,
  all_goals {norm_num},
end

lemma exp_neg_one_lt_d9 : exp (-1) < 0.36787944120 :=
begin
  rw [exp_neg, inv_lt (exp_pos _)],
  refine lt_of_lt_of_le _ (sub_le.1 (abs_sub_le_iff.1 exp_one_near_10).2),
  all_goals {norm_num},
end

lemma log_two_near_10 : |log 2 - 287209 / 414355| ≤ 1/10^10 :=
begin
  suffices : |log 2 - 287209 / 414355| ≤ 1/17179869184 + (1/10^10 - 1/2^34),
  { norm_num1 at *,
    assumption },
  have t : |(2⁻¹ : ℝ)| = 2⁻¹,
  { rw abs_of_pos, norm_num },
  have z := real.abs_log_sub_add_sum_range_le (show |(2⁻¹ : ℝ)| < 1, by { rw t, norm_num }) 34,
  rw t at z,
  norm_num1 at z,
  rw [one_div (2:ℝ), log_inv, ←sub_eq_add_neg, _root_.abs_sub_comm] at z,
  apply le_trans (_root_.abs_sub_le _ _ _) (add_le_add z _),
  simp_rw [sum_range_succ],
  norm_num,
  rw abs_of_pos;
  norm_num
end

lemma log_two_gt_d9 : 0.6931471803 < log 2 :=
lt_of_lt_of_le (by norm_num1) (sub_le.1 (abs_sub_le_iff.1 log_two_near_10).2)

lemma log_two_lt_d9 : log 2 < 0.6931471808 :=
lt_of_le_of_lt (sub_le_iff_le_add.1 (abs_sub_le_iff.1 log_two_near_10).1) (by norm_num)

end real


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers, Sébastien Gouëzel, Heather Macbeth

! This file was ported from Lean 3 source module analysis.inner_product_space.pi_L2
! 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.PiLp
import Mathbin.LinearAlgebra.FiniteDimensional
import Mathbin.LinearAlgebra.UnitaryGroup

/-!
# `L²` inner product space structure on finite products of inner product spaces

The `L²` norm on a finite product of inner product spaces is compatible with an inner product
$$
\langle x, y\rangle = \sum \langle x_i, y_i \rangle.
$$
This is recorded in this file as an inner product space instance on `pi_Lp 2`.

This file develops the notion of a finite dimensional Hilbert space over `𝕜 = ℂ, ℝ`, referred to as
`E`. We define an `orthonormal_basis 𝕜 ι E` as a linear isometric equivalence
between `E` and `euclidean_space 𝕜 ι`. Then `std_orthonormal_basis` shows that such an equivalence
always exists if `E` is finite dimensional. We provide language for converting between a basis
that is orthonormal and an orthonormal basis (e.g. `basis.to_orthonormal_basis`). We show that
orthonormal bases for each summand in a direct sum of spaces can be combined into an orthonormal
basis for the the whole sum in `direct_sum.submodule_is_internal.subordinate_orthonormal_basis`. In
the last section, various properties of matrices are explored.

## Main definitions

- `euclidean_space 𝕜 n`: defined to be `pi_Lp 2 (n → 𝕜)` for any `fintype n`, i.e., the space
  from functions to `n` to `𝕜` with the `L²` norm. We register several instances on it (notably
  that it is a finite-dimensional inner product space).

- `orthonormal_basis 𝕜 ι`: defined to be an isometry to Euclidean space from a given
  finite-dimensional innner product space, `E ≃ₗᵢ[𝕜] euclidean_space 𝕜 ι`.

- `basis.to_orthonormal_basis`: constructs an `orthonormal_basis` for a finite-dimensional
  Euclidean space from a `basis` which is `orthonormal`.

- `orthonormal.exists_orthonormal_basis_extension`: provides an existential result of an
  `orthonormal_basis` extending a given orthonormal set

- `exists_orthonormal_basis`: provides an orthonormal basis on a finite dimensional vector space

- `std_orthonormal_basis`: provides an arbitrarily-chosen `orthonormal_basis` of a given finite
  dimensional inner product space

For consequences in infinite dimension (Hilbert bases, etc.), see the file
`analysis.inner_product_space.l2_space`.

-/

open Real Set Filter IsROrC Submodule Function

open BigOperators uniformity Topology NNReal ENNReal ComplexConjugate DirectSum

noncomputable section

variable {ι : Type _} {ι' : Type _}

variable {𝕜 : Type _} [IsROrC 𝕜]

variable {E : Type _} [NormedAddCommGroup E] [InnerProductSpace 𝕜 E]

variable {E' : Type _} [NormedAddCommGroup E'] [InnerProductSpace 𝕜 E']

variable {F : Type _} [NormedAddCommGroup F] [InnerProductSpace ℝ F]

variable {F' : Type _} [NormedAddCommGroup F'] [InnerProductSpace ℝ F']

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

/-
 If `ι` is a finite type and each space `f i`, `i : ι`, is an inner product space,
then `Π i, f i` is an inner product space as well. Since `Π i, f i` is endowed with the sup norm,
we use instead `pi_Lp 2 f` for the product space, which is endowed with the `L^2` norm.
-/
instance PiLp.innerProductSpace {ι : Type _} [Fintype ι] (f : ι → Type _)
    [∀ i, NormedAddCommGroup (f i)] [∀ i, InnerProductSpace 𝕜 (f i)] :
    InnerProductSpace 𝕜 (PiLp 2 f)
    where
  inner x y := ∑ i, inner (x i) (y i)
  norm_sq_eq_inner x := by
    simp only [PiLp.norm_sq_eq_of_L2, AddMonoidHom.map_sum, ← norm_sq_eq_inner, one_div]
  conj_symm := by
    intro x y
    unfold inner
    rw [RingHom.map_sum]
    apply Finset.sum_congr rfl
    rintro z -
    apply inner_conj_symm
  add_left x y z :=
    show (∑ i, inner (x i + y i) (z i)) = (∑ i, inner (x i) (z i)) + ∑ i, inner (y i) (z i) by
      simp only [inner_add_left, Finset.sum_add_distrib]
  smul_left x y r :=
    show (∑ i : ι, inner (r • x i) (y i)) = conj r * ∑ i, inner (x i) (y i) by
      simp only [Finset.mul_sum, inner_smul_left]
#align pi_Lp.inner_product_space PiLp.innerProductSpace

@[simp]
theorem PiLp.inner_apply {ι : Type _} [Fintype ι] {f : ι → Type _} [∀ i, NormedAddCommGroup (f i)]
    [∀ i, InnerProductSpace 𝕜 (f i)] (x y : PiLp 2 f) : ⟪x, y⟫ = ∑ i, ⟪x i, y i⟫ :=
  rfl
#align pi_Lp.inner_apply PiLp.inner_apply

/-- The standard real/complex Euclidean space, functions on a finite type. For an `n`-dimensional
space use `euclidean_space 𝕜 (fin n)`. -/
@[reducible, nolint unused_arguments]
def EuclideanSpace (𝕜 : Type _) [IsROrC 𝕜] (n : Type _) [Fintype n] : Type _ :=
  PiLp 2 fun i : n => 𝕜
#align euclidean_space EuclideanSpace

theorem EuclideanSpace.nnnorm_eq {𝕜 : Type _} [IsROrC 𝕜] {n : Type _} [Fintype n]
    (x : EuclideanSpace 𝕜 n) : ‖x‖₊ = NNReal.sqrt (∑ i, ‖x i‖₊ ^ 2) :=
  PiLp.nnnorm_eq_of_L2 x
#align euclidean_space.nnnorm_eq EuclideanSpace.nnnorm_eq

theorem EuclideanSpace.norm_eq {𝕜 : Type _} [IsROrC 𝕜] {n : Type _} [Fintype n]
    (x : EuclideanSpace 𝕜 n) : ‖x‖ = Real.sqrt (∑ i, ‖x i‖ ^ 2) := by
  simpa only [Real.coe_sqrt, NNReal.coe_sum] using congr_arg (coe : ℝ≥0 → ℝ) x.nnnorm_eq
#align euclidean_space.norm_eq EuclideanSpace.norm_eq

theorem EuclideanSpace.dist_eq {𝕜 : Type _} [IsROrC 𝕜] {n : Type _} [Fintype n]
    (x y : EuclideanSpace 𝕜 n) : dist x y = (∑ i, dist (x i) (y i) ^ 2).sqrt :=
  (PiLp.dist_eq_of_L2 x y : _)
#align euclidean_space.dist_eq EuclideanSpace.dist_eq

theorem EuclideanSpace.nndist_eq {𝕜 : Type _} [IsROrC 𝕜] {n : Type _} [Fintype n]
    (x y : EuclideanSpace 𝕜 n) : nndist x y = (∑ i, nndist (x i) (y i) ^ 2).sqrt :=
  (PiLp.nndist_eq_of_L2 x y : _)
#align euclidean_space.nndist_eq EuclideanSpace.nndist_eq

theorem EuclideanSpace.edist_eq {𝕜 : Type _} [IsROrC 𝕜] {n : Type _} [Fintype n]
    (x y : EuclideanSpace 𝕜 n) : edist x y = (∑ i, edist (x i) (y i) ^ 2) ^ (1 / 2 : ℝ) :=
  (PiLp.edist_eq_of_L2 x y : _)
#align euclidean_space.edist_eq EuclideanSpace.edist_eq

variable [Fintype ι]

section

attribute [local reducible] PiLp

instance : FiniteDimensional 𝕜 (EuclideanSpace 𝕜 ι) := by infer_instance

instance : InnerProductSpace 𝕜 (EuclideanSpace 𝕜 ι) := by infer_instance

@[simp]
theorem finrank_euclideanSpace :
    FiniteDimensional.finrank 𝕜 (EuclideanSpace 𝕜 ι) = Fintype.card ι := by simp
#align finrank_euclidean_space finrank_euclideanSpace

theorem finrank_euclideanSpace_fin {n : ℕ} :
    FiniteDimensional.finrank 𝕜 (EuclideanSpace 𝕜 (Fin n)) = n := by simp
#align finrank_euclidean_space_fin finrank_euclideanSpace_fin

theorem EuclideanSpace.inner_eq_star_dotProduct (x y : EuclideanSpace 𝕜 ι) :
    ⟪x, y⟫ = Matrix.dotProduct (star <| PiLp.equiv _ _ x) (PiLp.equiv _ _ y) :=
  rfl
#align euclidean_space.inner_eq_star_dot_product EuclideanSpace.inner_eq_star_dotProduct

theorem EuclideanSpace.inner_piLp_equiv_symm (x y : ι → 𝕜) :
    ⟪(PiLp.equiv 2 _).symm x, (PiLp.equiv 2 _).symm y⟫ = Matrix.dotProduct (star x) y :=
  rfl
#align euclidean_space.inner_pi_Lp_equiv_symm EuclideanSpace.inner_piLp_equiv_symm

/-- A finite, mutually orthogonal family of subspaces of `E`, which span `E`, induce an isometry
from `E` to `pi_Lp 2` of the subspaces equipped with the `L2` inner product. -/
def DirectSum.IsInternal.isometryL2OfOrthogonalFamily [DecidableEq ι] {V : ι → Submodule 𝕜 E}
    (hV : DirectSum.IsInternal V)
    (hV' : OrthogonalFamily 𝕜 (fun i => V i) fun i => (V i).subtypeₗᵢ) :
    E ≃ₗᵢ[𝕜] PiLp 2 fun i => V i :=
  by
  let e₁ := DirectSum.linearEquivFunOnFintype 𝕜 ι fun i => V i
  let e₂ := LinearEquiv.ofBijective (DirectSum.coeLinearMap V) hV
  refine' LinearEquiv.isometryOfInner (e₂.symm.trans e₁) _
  suffices ∀ v w, ⟪v, w⟫ = ⟪e₂ (e₁.symm v), e₂ (e₁.symm w)⟫
    by
    intro v₀ w₀
    convert this (e₁ (e₂.symm v₀)) (e₁ (e₂.symm w₀)) <;>
      simp only [LinearEquiv.symm_apply_apply, LinearEquiv.apply_symm_apply]
  intro v w
  trans ⟪∑ i, (V i).subtypeₗᵢ (v i), ∑ i, (V i).subtypeₗᵢ (w i)⟫
  · simp only [sum_inner, hV'.inner_right_fintype, PiLp.inner_apply]
  · congr <;> simp
#align direct_sum.is_internal.isometry_L2_of_orthogonal_family DirectSum.IsInternal.isometryL2OfOrthogonalFamily

@[simp]
theorem DirectSum.IsInternal.isometryL2OfOrthogonalFamily_symm_apply [DecidableEq ι]
    {V : ι → Submodule 𝕜 E} (hV : DirectSum.IsInternal V)
    (hV' : OrthogonalFamily 𝕜 (fun i => V i) fun i => (V i).subtypeₗᵢ) (w : PiLp 2 fun i => V i) :
    (hV.isometryL2OfOrthogonalFamily hV').symm w = ∑ i, (w i : E) := by
  classical
    let e₁ := DirectSum.linearEquivFunOnFintype 𝕜 ι fun i => V i
    let e₂ := LinearEquiv.ofBijective (DirectSum.coeLinearMap V) hV
    suffices ∀ v : ⨁ i, V i, e₂ v = ∑ i, e₁ v i by exact this (e₁.symm w)
    intro v
    simp [e₂, DirectSum.coeLinearMap, DirectSum.toModule, Dfinsupp.sumAddHom_apply]
#align direct_sum.is_internal.isometry_L2_of_orthogonal_family_symm_apply DirectSum.IsInternal.isometryL2OfOrthogonalFamily_symm_apply

end

variable (ι 𝕜)

-- TODO : This should be generalized to `pi_Lp` with finite dimensional factors.
/-- `pi_Lp.linear_equiv` upgraded to a continuous linear map between `euclidean_space 𝕜 ι`
and `ι → 𝕜`. -/
@[simps]
def EuclideanSpace.equiv : EuclideanSpace 𝕜 ι ≃L[𝕜] ι → 𝕜 :=
  (PiLp.linearEquiv 2 𝕜 fun i : ι => 𝕜).toContinuousLinearEquiv
#align euclidean_space.equiv EuclideanSpace.equiv

variable {ι 𝕜}

-- TODO : This should be generalized to `pi_Lp`.
/-- The projection on the `i`-th coordinate of `euclidean_space 𝕜 ι`, as a linear map. -/
@[simps]
def EuclideanSpace.projₗ (i : ι) : EuclideanSpace 𝕜 ι →ₗ[𝕜] 𝕜 :=
  (LinearMap.proj i).comp (PiLp.linearEquiv 2 𝕜 fun i : ι => 𝕜 : EuclideanSpace 𝕜 ι →ₗ[𝕜] ι → 𝕜)
#align euclidean_space.projₗ EuclideanSpace.projₗ

-- TODO : This should be generalized to `pi_Lp`.
/-- The projection on the `i`-th coordinate of `euclidean_space 𝕜 ι`,
as a continuous linear map. -/
@[simps]
def EuclideanSpace.proj (i : ι) : EuclideanSpace 𝕜 ι →L[𝕜] 𝕜 :=
  ⟨EuclideanSpace.projₗ i, continuous_apply i⟩
#align euclidean_space.proj EuclideanSpace.proj

-- TODO : This should be generalized to `pi_Lp`.
/-- The vector given in euclidean space by being `1 : 𝕜` at coordinate `i : ι` and `0 : 𝕜` at
all other coordinates. -/
def EuclideanSpace.single [DecidableEq ι] (i : ι) (a : 𝕜) : EuclideanSpace 𝕜 ι :=
  (PiLp.equiv _ _).symm (Pi.single i a)
#align euclidean_space.single EuclideanSpace.single

@[simp]
theorem PiLp.equiv_single [DecidableEq ι] (i : ι) (a : 𝕜) :
    PiLp.equiv _ _ (EuclideanSpace.single i a) = Pi.single i a :=
  rfl
#align pi_Lp.equiv_single PiLp.equiv_single

@[simp]
theorem PiLp.equiv_symm_single [DecidableEq ι] (i : ι) (a : 𝕜) :
    (PiLp.equiv _ _).symm (Pi.single i a) = EuclideanSpace.single i a :=
  rfl
#align pi_Lp.equiv_symm_single PiLp.equiv_symm_single

@[simp]
theorem EuclideanSpace.single_apply [DecidableEq ι] (i : ι) (a : 𝕜) (j : ι) :
    (EuclideanSpace.single i a) j = ite (j = i) a 0 := by
  rw [EuclideanSpace.single, PiLp.equiv_symm_apply, ← Pi.single_apply i a j]
#align euclidean_space.single_apply EuclideanSpace.single_apply

theorem EuclideanSpace.inner_single_left [DecidableEq ι] (i : ι) (a : 𝕜) (v : EuclideanSpace 𝕜 ι) :
    ⟪EuclideanSpace.single i (a : 𝕜), v⟫ = conj a * v i := by simp [apply_ite conj]
#align euclidean_space.inner_single_left EuclideanSpace.inner_single_left

theorem EuclideanSpace.inner_single_right [DecidableEq ι] (i : ι) (a : 𝕜) (v : EuclideanSpace 𝕜 ι) :
    ⟪v, EuclideanSpace.single i (a : 𝕜)⟫ = a * conj (v i) := by simp [apply_ite conj, mul_comm]
#align euclidean_space.inner_single_right EuclideanSpace.inner_single_right

theorem EuclideanSpace.piLpCongrLeft_single [DecidableEq ι] {ι' : Type _} [Fintype ι']
    [DecidableEq ι'] (e : ι' ≃ ι) (i' : ι') :
    LinearIsometryEquiv.piLpCongrLeft 2 𝕜 𝕜 e (EuclideanSpace.single i' (1 : 𝕜)) =
      EuclideanSpace.single (e i') (1 : 𝕜) :=
  by
  ext i
  simpa using if_congr e.symm_apply_eq rfl rfl
#align euclidean_space.pi_Lp_congr_left_single EuclideanSpace.piLpCongrLeft_single

variable (ι 𝕜 E)

/-- An orthonormal basis on E is an identification of `E` with its dimensional-matching
`euclidean_space 𝕜 ι`. -/
structure OrthonormalBasis where ofRepr ::
  repr : E ≃ₗᵢ[𝕜] EuclideanSpace 𝕜 ι
#align orthonormal_basis OrthonormalBasis

variable {ι 𝕜 E}

namespace OrthonormalBasis

instance : Inhabited (OrthonormalBasis ι 𝕜 (EuclideanSpace 𝕜 ι)) :=
  ⟨of_repr (LinearIsometryEquiv.refl 𝕜 (EuclideanSpace 𝕜 ι))⟩

/-- `b i` is the `i`th basis vector. -/
instance : CoeFun (OrthonormalBasis ι 𝕜 E) fun _ => ι → E
    where coe b i := by classical exact b.repr.symm (EuclideanSpace.single i (1 : 𝕜))

@[simp]
theorem coe_of_repr [DecidableEq ι] (e : E ≃ₗᵢ[𝕜] EuclideanSpace 𝕜 ι) :
    ⇑(OrthonormalBasis.of_repr e) = fun i => e.symm (EuclideanSpace.single i (1 : 𝕜)) :=
  by
  rw [coeFn]
  unfold CoeFun.coe
  funext
  congr
  simp only [eq_iff_true_of_subsingleton]
#align orthonormal_basis.coe_of_repr OrthonormalBasis.coe_of_repr

@[simp]
protected theorem repr_symm_single [DecidableEq ι] (b : OrthonormalBasis ι 𝕜 E) (i : ι) :
    b.repr.symm (EuclideanSpace.single i (1 : 𝕜)) = b i := by
  classical
    congr
    simp
#align orthonormal_basis.repr_symm_single OrthonormalBasis.repr_symm_single

@[simp]
protected theorem repr_self [DecidableEq ι] (b : OrthonormalBasis ι 𝕜 E) (i : ι) :
    b.repr (b i) = EuclideanSpace.single i (1 : 𝕜) := by
  rw [← b.repr_symm_single i, LinearIsometryEquiv.apply_symm_apply]
#align orthonormal_basis.repr_self OrthonormalBasis.repr_self

protected theorem repr_apply_apply (b : OrthonormalBasis ι 𝕜 E) (v : E) (i : ι) :
    b.repr v i = ⟪b i, v⟫ := by
  classical
    rw [← b.repr.inner_map_map (b i) v, b.repr_self i, EuclideanSpace.inner_single_left]
    simp only [one_mul, eq_self_iff_true, map_one]
#align orthonormal_basis.repr_apply_apply OrthonormalBasis.repr_apply_apply

@[simp]
protected theorem orthonormal (b : OrthonormalBasis ι 𝕜 E) : Orthonormal 𝕜 b := by
  classical
    rw [orthonormal_iff_ite]
    intro i j
    rw [← b.repr.inner_map_map (b i) (b j), b.repr_self i, b.repr_self j,
      EuclideanSpace.inner_single_left, EuclideanSpace.single_apply, map_one, one_mul]
#align orthonormal_basis.orthonormal OrthonormalBasis.orthonormal

/-- The `basis ι 𝕜 E` underlying the `orthonormal_basis` -/
protected def toBasis (b : OrthonormalBasis ι 𝕜 E) : Basis ι 𝕜 E :=
  Basis.ofEquivFun b.repr.toLinearEquiv
#align orthonormal_basis.to_basis OrthonormalBasis.toBasis

@[simp]
protected theorem coe_toBasis (b : OrthonormalBasis ι 𝕜 E) : (⇑b.toBasis : ι → E) = ⇑b :=
  by
  change ⇑(Basis.ofEquivFun b.repr.to_linear_equiv) = b
  ext j
  classical
    rw [Basis.coe_ofEquivFun]
    congr
#align orthonormal_basis.coe_to_basis OrthonormalBasis.coe_toBasis

@[simp]
protected theorem coe_toBasis_repr (b : OrthonormalBasis ι 𝕜 E) :
    b.toBasis.equivFun = b.repr.toLinearEquiv :=
  by
  change (Basis.ofEquivFun b.repr.to_linear_equiv).equivFun = b.repr.to_linear_equiv
  ext (x j)
  simp only [Basis.ofEquivFun_repr_apply, LinearIsometryEquiv.coe_toLinearEquiv,
    Basis.equivFun_apply]
#align orthonormal_basis.coe_to_basis_repr OrthonormalBasis.coe_toBasis_repr

@[simp]
protected theorem coe_toBasis_repr_apply (b : OrthonormalBasis ι 𝕜 E) (x : E) (i : ι) :
    b.toBasis.repr x i = b.repr x i := by
  rw [← Basis.equivFun_apply, OrthonormalBasis.coe_toBasis_repr,
    LinearIsometryEquiv.coe_toLinearEquiv]
#align orthonormal_basis.coe_to_basis_repr_apply OrthonormalBasis.coe_toBasis_repr_apply

protected theorem sum_repr (b : OrthonormalBasis ι 𝕜 E) (x : E) : (∑ i, b.repr x i • b i) = x :=
  by
  simp_rw [← b.coe_to_basis_repr_apply, ← b.coe_to_basis]
  exact b.to_basis.sum_repr x
#align orthonormal_basis.sum_repr OrthonormalBasis.sum_repr

protected theorem sum_repr_symm (b : OrthonormalBasis ι 𝕜 E) (v : EuclideanSpace 𝕜 ι) :
    (∑ i, v i • b i) = b.repr.symm v := by simpa using (b.to_basis.equiv_fun_symm_apply v).symm
#align orthonormal_basis.sum_repr_symm OrthonormalBasis.sum_repr_symm

protected theorem sum_inner_mul_inner (b : OrthonormalBasis ι 𝕜 E) (x y : E) :
    (∑ i, ⟪x, b i⟫ * ⟪b i, y⟫) = ⟪x, y⟫ :=
  by
  have := congr_arg (innerSL 𝕜 x) (b.sum_repr y)
  rw [map_sum] at this
  convert this
  ext i
  rw [SMulHomClass.map_smul, b.repr_apply_apply, mul_comm]
  rfl
#align orthonormal_basis.sum_inner_mul_inner OrthonormalBasis.sum_inner_mul_inner

protected theorem orthogonalProjection_eq_sum {U : Submodule 𝕜 E} [CompleteSpace U]
    (b : OrthonormalBasis ι 𝕜 U) (x : E) : orthogonalProjection U x = ∑ i, ⟪(b i : E), x⟫ • b i :=
  by
  simpa only [b.repr_apply_apply, inner_orthogonalProjection_eq_of_mem_left] using
    (b.sum_repr (orthogonalProjection U x)).symm
#align orthonormal_basis.orthogonal_projection_eq_sum OrthonormalBasis.orthogonalProjection_eq_sum

/-- Mapping an orthonormal basis along a `linear_isometry_equiv`. -/
protected def map {G : Type _} [NormedAddCommGroup G] [InnerProductSpace 𝕜 G]
    (b : OrthonormalBasis ι 𝕜 E) (L : E ≃ₗᵢ[𝕜] G) : OrthonormalBasis ι 𝕜 G
    where repr := L.symm.trans b.repr
#align orthonormal_basis.map OrthonormalBasis.map

@[simp]
protected theorem map_apply {G : Type _} [NormedAddCommGroup G] [InnerProductSpace 𝕜 G]
    (b : OrthonormalBasis ι 𝕜 E) (L : E ≃ₗᵢ[𝕜] G) (i : ι) : b.map L i = L (b i) :=
  rfl
#align orthonormal_basis.map_apply OrthonormalBasis.map_apply

@[simp]
protected theorem toBasis_map {G : Type _} [NormedAddCommGroup G] [InnerProductSpace 𝕜 G]
    (b : OrthonormalBasis ι 𝕜 E) (L : E ≃ₗᵢ[𝕜] G) :
    (b.map L).toBasis = b.toBasis.map L.toLinearEquiv :=
  rfl
#align orthonormal_basis.to_basis_map OrthonormalBasis.toBasis_map

/-- A basis that is orthonormal is an orthonormal basis. -/
def Basis.toOrthonormalBasis (v : Basis ι 𝕜 E) (hv : Orthonormal 𝕜 v) : OrthonormalBasis ι 𝕜 E :=
  OrthonormalBasis.of_repr <|
    LinearEquiv.isometryOfInner v.equivFun
      (by
        intro x y
        let p : EuclideanSpace 𝕜 ι := v.equiv_fun x
        let q : EuclideanSpace 𝕜 ι := v.equiv_fun y
        have key : ⟪p, q⟫ = ⟪∑ i, p i • v i, ∑ i, q i • v i⟫ := by
          simp [sum_inner, inner_smul_left, hv.inner_right_fintype]
        convert key
        · rw [← v.equiv_fun.symm_apply_apply x, v.equiv_fun_symm_apply]
        · rw [← v.equiv_fun.symm_apply_apply y, v.equiv_fun_symm_apply])
#align basis.to_orthonormal_basis Basis.toOrthonormalBasis

@[simp]
theorem Basis.coe_toOrthonormalBasis_repr (v : Basis ι 𝕜 E) (hv : Orthonormal 𝕜 v) :
    ((v.toOrthonormalBasis hv).repr : E → EuclideanSpace 𝕜 ι) = v.equivFun :=
  rfl
#align basis.coe_to_orthonormal_basis_repr Basis.coe_toOrthonormalBasis_repr

@[simp]
theorem Basis.coe_toOrthonormalBasis_repr_symm (v : Basis ι 𝕜 E) (hv : Orthonormal 𝕜 v) :
    ((v.toOrthonormalBasis hv).repr.symm : EuclideanSpace 𝕜 ι → E) = v.equivFun.symm :=
  rfl
#align basis.coe_to_orthonormal_basis_repr_symm Basis.coe_toOrthonormalBasis_repr_symm

@[simp]
theorem Basis.toBasis_toOrthonormalBasis (v : Basis ι 𝕜 E) (hv : Orthonormal 𝕜 v) :
    (v.toOrthonormalBasis hv).toBasis = v := by
  simp [Basis.toOrthonormalBasis, OrthonormalBasis.toBasis]
#align basis.to_basis_to_orthonormal_basis Basis.toBasis_toOrthonormalBasis

@[simp]
theorem Basis.coe_toOrthonormalBasis (v : Basis ι 𝕜 E) (hv : Orthonormal 𝕜 v) :
    (v.toOrthonormalBasis hv : ι → E) = (v : ι → E) :=
  calc
    (v.toOrthonormalBasis hv : ι → E) = ((v.toOrthonormalBasis hv).toBasis : ι → E) := by
      classical rw [OrthonormalBasis.coe_toBasis]
    _ = (v : ι → E) := by simp

#align basis.coe_to_orthonormal_basis Basis.coe_toOrthonormalBasis

variable {v : ι → E}

/-- A finite orthonormal set that spans is an orthonormal basis -/
protected def mk (hon : Orthonormal 𝕜 v) (hsp : ⊤ ≤ Submodule.span 𝕜 (Set.range v)) :
    OrthonormalBasis ι 𝕜 E :=
  (Basis.mk (Orthonormal.linearIndependent hon) hsp).toOrthonormalBasis (by rwa [Basis.coe_mk])
#align orthonormal_basis.mk OrthonormalBasis.mk

@[simp]
protected theorem coe_mk (hon : Orthonormal 𝕜 v) (hsp : ⊤ ≤ Submodule.span 𝕜 (Set.range v)) :
    ⇑(OrthonormalBasis.mk hon hsp) = v := by
  classical rw [OrthonormalBasis.mk, _root_.basis.coe_to_orthonormal_basis, Basis.coe_mk]
#align orthonormal_basis.coe_mk OrthonormalBasis.coe_mk

/-- Any finite subset of a orthonormal family is an `orthonormal_basis` for its span. -/
protected def span [DecidableEq E] {v' : ι' → E} (h : Orthonormal 𝕜 v') (s : Finset ι') :
    OrthonormalBasis s 𝕜 (span 𝕜 (s.image v' : Set E)) :=
  let e₀' : Basis s 𝕜 _ :=
    Basis.span (h.LinearIndependent.comp (coe : s → ι') Subtype.coe_injective)
  let e₀ : OrthonormalBasis s 𝕜 _ :=
    OrthonormalBasis.mk
      (by
        convert orthonormal_span (h.comp (coe : s → ι') Subtype.coe_injective)
        ext
        simp [e₀', Basis.span_apply])
      e₀'.span_eq.ge
  let φ : span 𝕜 (s.image v' : Set E) ≃ₗᵢ[𝕜] span 𝕜 (range (v' ∘ (coe : s → ι'))) :=
    LinearIsometryEquiv.ofEq _ _
      (by
        rw [Finset.coe_image, image_eq_range]
        rfl)
  e₀.map φ.symm
#align orthonormal_basis.span OrthonormalBasis.span

@[simp]
protected theorem span_apply [DecidableEq E] {v' : ι' → E} (h : Orthonormal 𝕜 v') (s : Finset ι')
    (i : s) : (OrthonormalBasis.span h s i : E) = v' i := by
  simp only [OrthonormalBasis.span, Basis.span_apply, LinearIsometryEquiv.ofEq_symm,
    OrthonormalBasis.map_apply, OrthonormalBasis.coe_mk, LinearIsometryEquiv.coe_ofEq_apply]
#align orthonormal_basis.span_apply OrthonormalBasis.span_apply

open Submodule

/-- A finite orthonormal family of vectors whose span has trivial orthogonal complement is an
orthonormal basis. -/
protected def mkOfOrthogonalEqBot (hon : Orthonormal 𝕜 v) (hsp : (span 𝕜 (Set.range v))ᗮ = ⊥) :
    OrthonormalBasis ι 𝕜 E :=
  OrthonormalBasis.mk hon
    (by
      refine' Eq.ge _
      haveI : FiniteDimensional 𝕜 (span 𝕜 (range v)) :=
        FiniteDimensional.span_of_finite 𝕜 (finite_range v)
      haveI : CompleteSpace (span 𝕜 (range v)) := FiniteDimensional.complete 𝕜 _
      rwa [orthogonal_eq_bot_iff] at hsp)
#align orthonormal_basis.mk_of_orthogonal_eq_bot OrthonormalBasis.mkOfOrthogonalEqBot

@[simp]
protected theorem coe_of_orthogonal_eq_bot_mk (hon : Orthonormal 𝕜 v)
    (hsp : (span 𝕜 (Set.range v))ᗮ = ⊥) : ⇑(OrthonormalBasis.mkOfOrthogonalEqBot hon hsp) = v :=
  OrthonormalBasis.coe_mk hon _
#align orthonormal_basis.coe_of_orthogonal_eq_bot_mk OrthonormalBasis.coe_of_orthogonal_eq_bot_mk

variable [Fintype ι']

/-- `b.reindex (e : ι ≃ ι')` is an `orthonormal_basis` indexed by `ι'` -/
def reindex (b : OrthonormalBasis ι 𝕜 E) (e : ι ≃ ι') : OrthonormalBasis ι' 𝕜 E :=
  OrthonormalBasis.of_repr (b.repr.trans (LinearIsometryEquiv.piLpCongrLeft 2 𝕜 𝕜 e))
#align orthonormal_basis.reindex OrthonormalBasis.reindex

protected theorem reindex_apply (b : OrthonormalBasis ι 𝕜 E) (e : ι ≃ ι') (i' : ι') :
    (b.reindex e) i' = b (e.symm i') := by
  classical
    dsimp [reindex, OrthonormalBasis.hasCoeToFun]
    rw [coe_of_repr]
    dsimp
    rw [← b.repr_symm_single, LinearIsometryEquiv.piLpCongrLeft_symm,
      EuclideanSpace.piLpCongrLeft_single]
#align orthonormal_basis.reindex_apply OrthonormalBasis.reindex_apply

@[simp]
protected theorem coe_reindex (b : OrthonormalBasis ι 𝕜 E) (e : ι ≃ ι') :
    ⇑(b.reindex e) = ⇑b ∘ ⇑e.symm :=
  funext (b.reindex_apply e)
#align orthonormal_basis.coe_reindex OrthonormalBasis.coe_reindex

@[simp]
protected theorem repr_reindex (b : OrthonormalBasis ι 𝕜 E) (e : ι ≃ ι') (x : E) (i' : ι') :
    (b.reindex e).repr x i' = b.repr x (e.symm i') := by
  classical rw [OrthonormalBasis.repr_apply_apply, b.repr_apply_apply, OrthonormalBasis.coe_reindex]
#align orthonormal_basis.repr_reindex OrthonormalBasis.repr_reindex

end OrthonormalBasis

/-- `![1, I]` is an orthonormal basis for `ℂ` considered as a real inner product space. -/
def Complex.orthonormalBasisOneI : OrthonormalBasis (Fin 2) ℝ ℂ :=
  Complex.basisOneI.toOrthonormalBasis
    (by
      rw [orthonormal_iff_ite]
      intro i; fin_cases i <;> intro j <;> fin_cases j <;> simp [real_inner_eq_re_inner])
#align complex.orthonormal_basis_one_I Complex.orthonormalBasisOneI

@[simp]
theorem Complex.orthonormalBasisOneI_repr_apply (z : ℂ) :
    Complex.orthonormalBasisOneI.repr z = ![z.re, z.im] :=
  rfl
#align complex.orthonormal_basis_one_I_repr_apply Complex.orthonormalBasisOneI_repr_apply

@[simp]
theorem Complex.orthonormalBasisOneI_repr_symm_apply (x : EuclideanSpace ℝ (Fin 2)) :
    Complex.orthonormalBasisOneI.repr.symm x = x 0 + x 1 * i :=
  rfl
#align complex.orthonormal_basis_one_I_repr_symm_apply Complex.orthonormalBasisOneI_repr_symm_apply

@[simp]
theorem Complex.toBasis_orthonormalBasisOneI :
    Complex.orthonormalBasisOneI.toBasis = Complex.basisOneI :=
  Basis.toBasis_toOrthonormalBasis _ _
#align complex.to_basis_orthonormal_basis_one_I Complex.toBasis_orthonormalBasisOneI

@[simp]
theorem Complex.coe_orthonormalBasisOneI : (Complex.orthonormalBasisOneI : Fin 2 → ℂ) = ![1, i] :=
  by simp [Complex.orthonormalBasisOneI]
#align complex.coe_orthonormal_basis_one_I Complex.coe_orthonormalBasisOneI

/-- The isometry between `ℂ` and a two-dimensional real inner product space given by a basis. -/
def Complex.isometryOfOrthonormal (v : OrthonormalBasis (Fin 2) ℝ F) : ℂ ≃ₗᵢ[ℝ] F :=
  Complex.orthonormalBasisOneI.repr.trans v.repr.symm
#align complex.isometry_of_orthonormal Complex.isometryOfOrthonormal

@[simp]
theorem Complex.map_isometryOfOrthonormal (v : OrthonormalBasis (Fin 2) ℝ F) (f : F ≃ₗᵢ[ℝ] F') :
    Complex.isometryOfOrthonormal (v.map f) = (Complex.isometryOfOrthonormal v).trans f := by
  simp [Complex.isometryOfOrthonormal, LinearIsometryEquiv.trans_assoc, OrthonormalBasis.map]
#align complex.map_isometry_of_orthonormal Complex.map_isometryOfOrthonormal

theorem Complex.isometryOfOrthonormal_symm_apply (v : OrthonormalBasis (Fin 2) ℝ F) (f : F) :
    (Complex.isometryOfOrthonormal v).symm f =
      (v.toBasis.Coord 0 f : ℂ) + (v.toBasis.Coord 1 f : ℂ) * i :=
  by simp [Complex.isometryOfOrthonormal]
#align complex.isometry_of_orthonormal_symm_apply Complex.isometryOfOrthonormal_symm_apply

theorem Complex.isometryOfOrthonormal_apply (v : OrthonormalBasis (Fin 2) ℝ F) (z : ℂ) :
    Complex.isometryOfOrthonormal v z = z.re • v 0 + z.im • v 1 := by
  simp [Complex.isometryOfOrthonormal, ← v.sum_repr_symm]
#align complex.isometry_of_orthonormal_apply Complex.isometryOfOrthonormal_apply

open FiniteDimensional

/-! ### Matrix representation of an orthonormal basis with respect to another -/

section ToMatrix

variable [DecidableEq ι]

section

variable (a b : OrthonormalBasis ι 𝕜 E)

/-- The change-of-basis matrix between two orthonormal bases `a`, `b` is a unitary matrix. -/
theorem OrthonormalBasis.toMatrix_orthonormalBasis_mem_unitary :
    a.toBasis.toMatrix b ∈ Matrix.unitaryGroup ι 𝕜 :=
  by
  rw [Matrix.mem_unitaryGroup_iff']
  ext (i j)
  convert a.repr.inner_map_map (b i) (b j)
  rw [orthonormal_iff_ite.mp b.orthonormal i j]
  rfl
#align orthonormal_basis.to_matrix_orthonormal_basis_mem_unitary OrthonormalBasis.toMatrix_orthonormalBasis_mem_unitary

/-- The determinant of the change-of-basis matrix between two orthonormal bases `a`, `b` has
unit length. -/
@[simp]
theorem OrthonormalBasis.det_to_matrix_orthonormalBasis : ‖a.toBasis.det b‖ = 1 :=
  by
  have : (norm_sq (a.to_basis.det b) : 𝕜) = 1 := by
    simpa [IsROrC.mul_conj] using
      (Matrix.det_of_mem_unitary (a.to_matrix_orthonormal_basis_mem_unitary b)).2
  norm_cast  at this
  rwa [← sqrt_norm_sq_eq_norm, sqrt_eq_one]
#align orthonormal_basis.det_to_matrix_orthonormal_basis OrthonormalBasis.det_to_matrix_orthonormalBasis

end

section Real

variable (a b : OrthonormalBasis ι ℝ F)

/-- The change-of-basis matrix between two orthonormal bases `a`, `b` is an orthogonal matrix. -/
theorem OrthonormalBasis.toMatrix_orthonormalBasis_mem_orthogonal :
    a.toBasis.toMatrix b ∈ Matrix.orthogonalGroup ι ℝ :=
  a.toMatrix_orthonormalBasis_mem_unitary b
#align orthonormal_basis.to_matrix_orthonormal_basis_mem_orthogonal OrthonormalBasis.toMatrix_orthonormalBasis_mem_orthogonal

/-- The determinant of the change-of-basis matrix between two orthonormal bases `a`, `b` is ±1. -/
theorem OrthonormalBasis.det_to_matrix_orthonormalBasis_real :
    a.toBasis.det b = 1 ∨ a.toBasis.det b = -1 :=
  by
  rw [← sq_eq_one_iff]
  simpa [unitary, sq] using Matrix.det_of_mem_unitary (a.to_matrix_orthonormal_basis_mem_unitary b)
#align orthonormal_basis.det_to_matrix_orthonormal_basis_real OrthonormalBasis.det_to_matrix_orthonormalBasis_real

end Real

end ToMatrix

/-! ### Existence of orthonormal basis, etc. -/

section FiniteDimensional

variable {v : Set E}

variable {A : ι → Submodule 𝕜 E}

/-- Given an internal direct sum decomposition of a module `M`, and an orthonormal basis for each
of the components of the direct sum, the disjoint union of these orthonormal bases is an
orthonormal basis for `M`. -/
noncomputable def DirectSum.IsInternal.collectedOrthonormalBasis
    (hV : OrthogonalFamily 𝕜 (fun i => A i) fun i => (A i).subtypeₗᵢ) [DecidableEq ι]
    (hV_sum : DirectSum.IsInternal fun i => A i) {α : ι → Type _} [∀ i, Fintype (α i)]
    (v_family : ∀ i, OrthonormalBasis (α i) 𝕜 (A i)) : OrthonormalBasis (Σi, α i) 𝕜 E :=
  (hV_sum.collectedBasis fun i => (v_family i).toBasis).toOrthonormalBasis <| by
    simpa using
      hV.orthonormal_sigma_orthonormal (show ∀ i, Orthonormal 𝕜 (v_family i).toBasis by simp)
#align direct_sum.is_internal.collected_orthonormal_basis DirectSum.IsInternal.collectedOrthonormalBasis

theorem DirectSum.IsInternal.collectedOrthonormalBasis_mem [DecidableEq ι]
    (h : DirectSum.IsInternal A) {α : ι → Type _} [∀ i, Fintype (α i)]
    (hV : OrthogonalFamily 𝕜 (fun i => A i) fun i => (A i).subtypeₗᵢ)
    (v : ∀ i, OrthonormalBasis (α i) 𝕜 (A i)) (a : Σi, α i) :
    h.collectedOrthonormalBasis hV v a ∈ A a.1 := by
  simp [DirectSum.IsInternal.collectedOrthonormalBasis]
#align direct_sum.is_internal.collected_orthonormal_basis_mem DirectSum.IsInternal.collectedOrthonormalBasis_mem

variable [FiniteDimensional 𝕜 E]

/-- In a finite-dimensional `inner_product_space`, any orthonormal subset can be extended to an
orthonormal basis. -/
theorem Orthonormal.exists_orthonormalBasis_extension (hv : Orthonormal 𝕜 (coe : v → E)) :
    ∃ (u : Finset E)(b : OrthonormalBasis u 𝕜 E), v ⊆ u ∧ ⇑b = coe :=
  by
  obtain ⟨u₀, hu₀s, hu₀, hu₀_max⟩ := exists_maximal_orthonormal hv
  rw [maximal_orthonormal_iff_orthogonal_complement_eq_bot hu₀] at hu₀_max
  have hu₀_finite : u₀.finite := hu₀.linear_independent.finite
  let u : Finset E := hu₀_finite.to_finset
  let fu : ↥u ≃ ↥u₀ := Equiv.cast (congr_arg coeSort hu₀_finite.coe_to_finset)
  have hfu : (coe : u → E) = (coe : u₀ → E) ∘ fu :=
    by
    ext
    simp
  have hu : Orthonormal 𝕜 (coe : u → E) := by simpa [hfu] using hu₀.comp _ fu.injective
  refine' ⟨u, OrthonormalBasis.mkOfOrthogonalEqBot hu _, _, _⟩
  · simpa using hu₀_max
  · simpa using hu₀s
  · simp
#align orthonormal.exists_orthonormal_basis_extension Orthonormal.exists_orthonormalBasis_extension

theorem Orthonormal.exists_orthonormalBasis_extension_of_card_eq {ι : Type _} [Fintype ι]
    (card_ι : finrank 𝕜 E = Fintype.card ι) {v : ι → E} {s : Set ι}
    (hv : Orthonormal 𝕜 (s.restrict v)) : ∃ b : OrthonormalBasis ι 𝕜 E, ∀ i ∈ s, b i = v i :=
  by
  have hsv : injective (s.restrict v) := hv.linear_independent.injective
  have hX : Orthonormal 𝕜 (coe : Set.range (s.restrict v) → E) := by
    rwa [orthonormal_subtype_range hsv]
  obtain ⟨Y, b₀, hX, hb₀⟩ := hX.exists_orthonormal_basis_extension
  have hιY : Fintype.card ι = Y.card :=
    by
    refine' card_ι.symm.trans _
    exact FiniteDimensional.finrank_eq_card_finset_basis b₀.to_basis
  have hvsY : s.maps_to v Y := (s.maps_to_image v).mono_right (by rwa [← range_restrict])
  have hsv' : Set.InjOn v s := by
    rw [Set.injOn_iff_injective]
    exact hsv
  obtain ⟨g, hg⟩ := hvsY.exists_equiv_extend_of_card_eq hιY hsv'
  use b₀.reindex g.symm
  intro i hi
  · simp [hb₀, hg i hi]
#align orthonormal.exists_orthonormal_basis_extension_of_card_eq Orthonormal.exists_orthonormalBasis_extension_of_card_eq

variable (𝕜 E)

/-- A finite-dimensional inner product space admits an orthonormal basis. -/
theorem exists_orthonormalBasis :
    ∃ (w : Finset E)(b : OrthonormalBasis w 𝕜 E), ⇑b = (coe : w → E) :=
  let ⟨w, hw, hw', hw''⟩ := (orthonormal_empty 𝕜 E).exists_orthonormalBasis_extension
  ⟨w, hw, hw''⟩
#align exists_orthonormal_basis exists_orthonormalBasis

/-- A finite-dimensional `inner_product_space` has an orthonormal basis. -/
irreducible_def stdOrthonormalBasis : OrthonormalBasis (Fin (finrank 𝕜 E)) 𝕜 E :=
  by
  let b := Classical.choose (Classical.choose_spec <| exists_orthonormalBasis 𝕜 E)
  rw [finrank_eq_card_basis b.to_basis]
  exact b.reindex (Fintype.equivFinOfCardEq rfl)
#align std_orthonormal_basis stdOrthonormalBasis

/-- An orthonormal basis of `ℝ` is made either of the vector `1`, or of the vector `-1`. -/
theorem orthonormalBasis_one_dim (b : OrthonormalBasis ι ℝ ℝ) :
    (⇑b = fun _ => (1 : ℝ)) ∨ ⇑b = fun _ => (-1 : ℝ) :=
  by
  have : Unique ι := b.to_basis.unique
  have : b default = 1 ∨ b default = -1 :=
    by
    have : ‖b default‖ = 1 := b.orthonormal.1 _
    rwa [Real.norm_eq_abs, abs_eq (zero_le_one : (0 : ℝ) ≤ 1)] at this
  rw [eq_const_of_unique b]
  refine' this.imp _ _ <;> simp
#align orthonormal_basis_one_dim orthonormalBasis_one_dim

variable {𝕜 E}

section SubordinateOrthonormalBasis

open DirectSum

variable {n : ℕ} (hn : finrank 𝕜 E = n) [DecidableEq ι] {V : ι → Submodule 𝕜 E} (hV : IsInternal V)

/-- Exhibit a bijection between `fin n` and the index set of a certain basis of an `n`-dimensional
inner product space `E`.  This should not be accessed directly, but only via the subsequent API. -/
irreducible_def DirectSum.IsInternal.sigmaOrthonormalBasisIndexEquiv
  (hV' : OrthogonalFamily 𝕜 (fun i => V i) fun i => (V i).subtypeₗᵢ) :
  (Σi, Fin (finrank 𝕜 (V i))) ≃ Fin n :=
  let b := hV.collectedOrthonormalBasis hV' fun i => stdOrthonormalBasis 𝕜 (V i)
  Fintype.equivFinOfCardEq <| (FiniteDimensional.finrank_eq_card_basis b.toBasis).symm.trans hn
#align direct_sum.is_internal.sigma_orthonormal_basis_index_equiv DirectSum.IsInternal.sigmaOrthonormalBasisIndexEquiv

/-- An `n`-dimensional `inner_product_space` equipped with a decomposition as an internal direct
sum has an orthonormal basis indexed by `fin n` and subordinate to that direct sum. -/
irreducible_def DirectSum.IsInternal.subordinateOrthonormalBasis
  (hV' : OrthogonalFamily 𝕜 (fun i => V i) fun i => (V i).subtypeₗᵢ) :
  OrthonormalBasis (Fin n) 𝕜 E :=
  (hV.collectedOrthonormalBasis hV' fun i => stdOrthonormalBasis 𝕜 (V i)).reindex
    (hV.sigmaOrthonormalBasisIndexEquiv hn hV')
#align direct_sum.is_internal.subordinate_orthonormal_basis DirectSum.IsInternal.subordinateOrthonormalBasis

/-- An `n`-dimensional `inner_product_space` equipped with a decomposition as an internal direct
sum has an orthonormal basis indexed by `fin n` and subordinate to that direct sum. This function
provides the mapping by which it is subordinate. -/
irreducible_def DirectSum.IsInternal.subordinateOrthonormalBasisIndex (a : Fin n)
  (hV' : OrthogonalFamily 𝕜 (fun i => V i) fun i => (V i).subtypeₗᵢ) : ι :=
  ((hV.sigmaOrthonormalBasisIndexEquiv hn hV').symm a).1
#align direct_sum.is_internal.subordinate_orthonormal_basis_index DirectSum.IsInternal.subordinateOrthonormalBasisIndex

/-- The basis constructed in `orthogonal_family.subordinate_orthonormal_basis` is subordinate to
the `orthogonal_family` in question. -/
theorem DirectSum.IsInternal.subordinateOrthonormalBasis_subordinate (a : Fin n)
    (hV' : OrthogonalFamily 𝕜 (fun i => V i) fun i => (V i).subtypeₗᵢ) :
    hV.subordinateOrthonormalBasis hn hV' a ∈ V (hV.subordinateOrthonormalBasisIndex hn a hV') := by
  simpa only [DirectSum.IsInternal.subordinateOrthonormalBasis, OrthonormalBasis.coe_reindex,
    DirectSum.IsInternal.subordinateOrthonormalBasisIndex] using
    hV.collected_orthonormal_basis_mem hV' (fun i => stdOrthonormalBasis 𝕜 (V i))
      ((hV.sigma_orthonormal_basis_index_equiv hn hV').symm a)
#align direct_sum.is_internal.subordinate_orthonormal_basis_subordinate DirectSum.IsInternal.subordinateOrthonormalBasis_subordinate

end SubordinateOrthonormalBasis

end FiniteDimensional

attribute [local instance] fact_finite_dimensional_of_finrank_eq_succ

/-- Given a natural number `n` one less than the `finrank` of a finite-dimensional inner product
space, there exists an isometry from the orthogonal complement of a nonzero singleton to
`euclidean_space 𝕜 (fin n)`. -/
def OrthonormalBasis.fromOrthogonalSpanSingleton (n : ℕ) [Fact (finrank 𝕜 E = n + 1)] {v : E}
    (hv : v ≠ 0) : OrthonormalBasis (Fin n) 𝕜 (𝕜 ∙ v)ᗮ :=
  (stdOrthonormalBasis _ _).reindex <| finCongr <| finrank_orthogonal_span_singleton hv
#align orthonormal_basis.from_orthogonal_span_singleton OrthonormalBasis.fromOrthogonalSpanSingleton

section LinearIsometry

variable {V : Type _} [NormedAddCommGroup V] [InnerProductSpace 𝕜 V] [FiniteDimensional 𝕜 V]

variable {S : Submodule 𝕜 V} {L : S →ₗᵢ[𝕜] V}

open FiniteDimensional

/-- Let `S` be a subspace of a finite-dimensional complex inner product space `V`.  A linear
isometry mapping `S` into `V` can be extended to a full isometry of `V`.

TODO:  The case when `S` is a finite-dimensional subspace of an infinite-dimensional `V`.-/
noncomputable def LinearIsometry.extend (L : S →ₗᵢ[𝕜] V) : V →ₗᵢ[𝕜] V :=
  by
  -- Build an isometry from Sᗮ to L(S)ᗮ through euclidean_space
  let d := finrank 𝕜 Sᗮ
  have dim_S_perp : finrank 𝕜 Sᗮ = d := rfl
  let LS := L.to_linear_map.range
  have E : Sᗮ ≃ₗᵢ[𝕜] LSᗮ := by
    have dim_LS_perp : finrank 𝕜 LSᗮ = d
    calc
      finrank 𝕜 LSᗮ = finrank 𝕜 V - finrank 𝕜 LS := by
        simp only [← LS.finrank_add_finrank_orthogonal, add_tsub_cancel_left]
      _ = finrank 𝕜 V - finrank 𝕜 S := by simp only [LinearMap.finrank_range_of_inj L.injective]
      _ = finrank 𝕜 Sᗮ := by simp only [← S.finrank_add_finrank_orthogonal, add_tsub_cancel_left]

    exact
      (stdOrthonormalBasis 𝕜 Sᗮ).repr.trans
        ((stdOrthonormalBasis 𝕜 LSᗮ).reindex <| finCongr dim_LS_perp).repr.symm
  let L3 := LSᗮ.subtypeₗᵢ.comp E.to_linear_isometry
  -- Project onto S and Sᗮ
  haveI : CompleteSpace S := FiniteDimensional.complete 𝕜 S
  haveI : CompleteSpace V := FiniteDimensional.complete 𝕜 V
  let p1 := (orthogonalProjection S).toLinearMap
  let p2 := (orthogonalProjection Sᗮ).toLinearMap
  -- Build a linear map from the isometries on S and Sᗮ
  let M := L.to_linear_map.comp p1 + L3.to_linear_map.comp p2
  -- Prove that M is an isometry
  have M_norm_map : ∀ x : V, ‖M x‖ = ‖x‖ := by
    intro x
    -- Apply M to the orthogonal decomposition of x
    have Mx_decomp : M x = L (p1 x) + L3 (p2 x) := by
      simp only [LinearMap.add_apply, LinearMap.comp_apply, LinearMap.comp_apply,
        LinearIsometry.coe_toLinearMap]
    -- Mx_decomp is the orthogonal decomposition of M x
    have Mx_orth : ⟪L (p1 x), L3 (p2 x)⟫ = 0 :=
      by
      have Lp1x : L (p1 x) ∈ L.to_linear_map.range :=
        LinearMap.mem_range_self L.to_linear_map (p1 x)
      have Lp2x : L3 (p2 x) ∈ L.to_linear_map.rangeᗮ :=
        by
        simp only [L3, LinearIsometry.coe_comp, Function.comp_apply, Submodule.coe_subtypeₗᵢ, ←
          Submodule.range_subtype LSᗮ]
        apply LinearMap.mem_range_self
      apply Submodule.inner_right_of_mem_orthogonal Lp1x Lp2x
    -- Apply the Pythagorean theorem and simplify
    rw [← sq_eq_sq (norm_nonneg _) (norm_nonneg _), norm_sq_eq_add_norm_sq_projection x S]
    simp only [sq, Mx_decomp]
    rw [norm_add_sq_eq_norm_sq_add_norm_sq_of_inner_eq_zero (L (p1 x)) (L3 (p2 x)) Mx_orth]
    simp only [LinearIsometry.norm_map, p1, p2, ContinuousLinearMap.toLinearMap_eq_coe,
      add_left_inj, mul_eq_mul_left_iff, norm_eq_zero, true_or_iff, eq_self_iff_true,
      ContinuousLinearMap.coe_coe, Submodule.coe_norm, Submodule.coe_eq_zero]
  exact
    { toLinearMap := M
      norm_map' := M_norm_map }
#align linear_isometry.extend LinearIsometry.extend

theorem LinearIsometry.extend_apply (L : S →ₗᵢ[𝕜] V) (s : S) : L.extend s = L s :=
  by
  haveI : CompleteSpace S := FiniteDimensional.complete 𝕜 S
  simp only [LinearIsometry.extend, ContinuousLinearMap.toLinearMap_eq_coe, ←
    LinearIsometry.coe_toLinearMap]
  simp only [add_right_eq_self, LinearIsometry.coe_toLinearMap,
    LinearIsometryEquiv.coe_toLinearIsometry, LinearIsometry.coe_comp, Function.comp_apply,
    orthogonalProjection_mem_subspace_eq_self, LinearMap.coe_comp, ContinuousLinearMap.coe_coe,
    Submodule.coeSubtype, LinearMap.add_apply, Submodule.coe_eq_zero,
    LinearIsometryEquiv.map_eq_zero_iff, Submodule.coe_subtypeₗᵢ,
    orthogonalProjection_mem_subspace_orthogonal_complement_eq_zero,
    Submodule.orthogonal_orthogonal, Submodule.coe_mem]
#align linear_isometry.extend_apply LinearIsometry.extend_apply

end LinearIsometry

section Matrix

open Matrix

variable {m n : Type _}

namespace Matrix

variable [Fintype m] [Fintype n] [DecidableEq n]

/-- `matrix.to_lin'` adapted for `euclidean_space 𝕜 _`. -/
def toEuclideanLin : Matrix m n 𝕜 ≃ₗ[𝕜] EuclideanSpace 𝕜 n →ₗ[𝕜] EuclideanSpace 𝕜 m :=
  Matrix.toLin' ≪≫ₗ
    LinearEquiv.arrowCongr (PiLp.linearEquiv _ 𝕜 fun _ : n => 𝕜).symm
      (PiLp.linearEquiv _ 𝕜 fun _ : m => 𝕜).symm
#align matrix.to_euclidean_lin Matrix.toEuclideanLin

@[simp]
theorem toEuclideanLin_piLp_equiv_symm (A : Matrix m n 𝕜) (x : n → 𝕜) :
    A.toEuclideanLin ((PiLp.equiv _ _).symm x) = (PiLp.equiv _ _).symm (A.toLin' x) :=
  rfl
#align matrix.to_euclidean_lin_pi_Lp_equiv_symm Matrix.toEuclideanLin_piLp_equiv_symm

@[simp]
theorem piLp_equiv_toEuclideanLin (A : Matrix m n 𝕜) (x : EuclideanSpace 𝕜 n) :
    PiLp.equiv _ _ (A.toEuclideanLin x) = A.toLin' (PiLp.equiv _ _ x) :=
  rfl
#align matrix.pi_Lp_equiv_to_euclidean_lin Matrix.piLp_equiv_toEuclideanLin

-- `matrix.to_euclidean_lin` is the same as `matrix.to_lin` applied to `pi_Lp.basis_fun`,
theorem toEuclideanLin_eq_toLin :
    (toEuclideanLin : Matrix m n 𝕜 ≃ₗ[𝕜] _) =
      Matrix.toLin (PiLp.basisFun _ _ _) (PiLp.basisFun _ _ _) :=
  rfl
#align matrix.to_euclidean_lin_eq_to_lin Matrix.toEuclideanLin_eq_toLin

end Matrix

-- mathport name: «expr⟪ , ⟫ₑ»
local notation "⟪" x ", " y "⟫ₑ" => @inner 𝕜 _ _ ((PiLp.equiv 2 _).symm x) ((PiLp.equiv 2 _).symm y)

/-- The inner product of a row of `A` and a row of `B` is an entry of `B ⬝ Aᴴ`. -/
theorem inner_matrix_row_row [Fintype n] (A B : Matrix m n 𝕜) (i j : m) :
    ⟪A i, B j⟫ₑ = (B ⬝ Aᴴ) j i := by
  simp_rw [EuclideanSpace.inner_piLp_equiv_symm, Matrix.mul_apply', Matrix.dotProduct_comm,
    Matrix.conjTranspose_apply, Pi.star_def]
#align inner_matrix_row_row inner_matrix_row_row

/-- The inner product of a column of `A` and a column of `B` is an entry of `Aᴴ ⬝ B`. -/
theorem inner_matrix_col_col [Fintype m] (A B : Matrix m n 𝕜) (i j : n) :
    ⟪Aᵀ i, Bᵀ j⟫ₑ = (Aᴴ ⬝ B) i j :=
  rfl
#align inner_matrix_col_col inner_matrix_col_col

end Matrix


import tactic
import data.int.gcd
import data.int.basic
import data.int.modeq -- integer modular arithmetic

lemma gcd_linear_combo_signs {m n : ℤ} (h_m_pos : m > 0) (h_n_pos : n > 0)
                            : (m.gcd_a n ≤ 0 ∧ m.gcd_b n > 0) ∨ (m.gcd_a n > 0 ∧ m.gcd_b n ≤ 0) :=
begin

  have hxy := (int.gcd_eq_gcd_ab m n),
  set x := m.gcd_a n,
  set y := m.gcd_b n,

  by_contra, push_neg at h,
  have m_ne_0 : m ≠ 0 := by linarith,
  have gcd_pos := int.gcd_pos_of_non_zero_left n m_ne_0,

  have hx : (x ≤ 0 ∨ x > 0) := le_or_lt x 0,
  cases hx with hx_nonpos hx_pos,
  { have hy_nonpos := h.1(hx_nonpos),
    have hmx : m * x ≤ 0 := linarith.mul_nonpos hx_nonpos h_m_pos,
    have hny : n * y ≤ 0 := linarith.mul_nonpos hy_nonpos h_n_pos,
    have h_combo : m * x + n * y ≤ 0 := add_nonpos hmx hny,
    rw ← hxy at h_combo,
    linarith,
  },
  {
    -- could simplify argument

    have hy_pos := h.2(hx_pos),
    have hy2 : y ≥ 1 := by linarith,
    have hx2 : x ≥ 1 := by linarith,

    have hcn : n * y ≥ n :=  (le_mul_iff_one_le_right h_n_pos).mpr hy2,
    have hcm : m * x ≥ m :=  (le_mul_iff_one_le_right h_m_pos).mpr hx2,

    have hcmn : m * x + n * y ≥ m + n := add_le_add hcm hcn,
    rw ← hxy at hcmn,
    have h_gcd_dvd := int.gcd_dvd_left m n,
    have g_gcd_le : ↑(m.gcd n) ≤ m := int.le_of_dvd h_m_pos h_gcd_dvd,

    have hm_lt_sum : m < m + n := lt_add_of_pos_right m h_n_pos,
    linarith,
  },
end

lemma fun_coe_lemma_l {m n x y : ℤ } (h_m_nonneg : m ≥ 0) (h_n_nonneg : n ≥ 0) (hl : x ≤ 0 ∧ y > 0) (h_xy_nonneg : m * x + n * y ≥ 0)
  : (m * x + n * y).to_nat + m.to_nat * (-x).to_nat = n.to_nat * y.to_nat :=
begin
  zify,
  have hy_nonneg : y ≥ 0 := by linarith,
  have hx_neg_nonneg : -x ≥ 0 := by linarith,
  have hx := int.to_nat_of_nonneg hx_neg_nonneg,
  have hy := int.to_nat_of_nonneg hy_nonneg,
  have hm := int.to_nat_of_nonneg h_m_nonneg,
  have hn := int.to_nat_of_nonneg h_n_nonneg,
  have h := int.to_nat_of_nonneg h_xy_nonneg,
  rw [hx, hm, hn, hy, h],
  linarith,
end

lemma fun_coe_lemma_r {m n x y : ℤ } (h_m_nonneg : m ≥ 0) (h_n_nonneg : n ≥ 0) (hr : x > 0 ∧ y ≤ 0) (h_xy_nonneg : m * x + n * y ≥ 0)
  : (m * x + n * y).to_nat + n.to_nat * (-y).to_nat = m.to_nat * x.to_nat :=
begin
  zify,
  have hx_nonneg : x ≥ 0 := by linarith,
  have hy_neg_nonneg : -y ≥ 0 := by linarith,
  have hy := int.to_nat_of_nonneg hy_neg_nonneg,
  have hx := int.to_nat_of_nonneg hx_nonneg,
  have hm := int.to_nat_of_nonneg h_m_nonneg,
  have hn := int.to_nat_of_nonneg h_n_nonneg,
  have h := int.to_nat_of_nonneg h_xy_nonneg,
  rw [hx, hm, hn, hy, h],
  linarith,
end

--have hc : (↑(m.gcd n) * e).to_nat = (m.gcd n) * e.to_nat :=  sorry,

lemma fun_coe_lemma2 (n : ℕ) (e : ℤ) (hn : n ≥ 0) (he : e ≥ 0) : ((↑n * e).to_nat) = n * e.to_nat :=
begin
  zify,
  have hc1 : ↑(e.to_nat) = e := int.to_nat_of_nonneg he,
  rw hc1,
  have hc2 : ↑n * e ≥ 0,
  {
    refine mul_nonneg _ _,
    exact int.coe_zero_le n,
    linarith,
  },
  have hc3 := int.to_nat_of_nonneg hc2,
  assumption,
end

lemma a_pow_gcd_modeq_one_signs_left ( a m n : ℤ) (h_a_pos : a > 0) (h_m_pos : m > 0) (h_n_pos : n > 0) (hl : m.gcd_a n ≤ 0 ∧ m.gcd_b n > 0)
      : 1 ≡ a^(m.gcd n) [ZMOD (int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1))] :=
begin
  set d := (int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1)),
  have h_xy_signs := gcd_linear_combo_signs h_m_pos h_n_pos,
  have hxy := (int.gcd_eq_gcd_ab m n),
  set x := m.gcd_a n,
  set y := m.gcd_b n,
  set g := m.gcd n,

  have hx : -x ≥ 0 := by linarith,

  have hd1 : ↑d ∣ a^m.to_nat - 1 := (a ^ m.to_nat - 1).gcd_dvd_left (a ^ n.to_nat - 1),

  have hd1_mod : 1 ≡ a^m.to_nat [ZMOD d] := (int.modeq_iff_dvd).mpr hd1,

  have hd1x : 1^(int.to_nat(-x)) ≡ (a^m.to_nat)^(int.to_nat(-x)) [ZMOD d] := int.modeq.pow (-x).to_nat hd1_mod,
  simp only [one_pow] at hd1x,
  rw ← pow_mul at hd1x,

  have hd2 : ↑d ∣ a^n.to_nat - 1 := (a ^ m.to_nat - 1).gcd_dvd_right (a ^ n.to_nat - 1),
  have hd2_mod : 1 ≡ a^n.to_nat [ZMOD d] := (int.modeq_iff_dvd).mpr hd2,

  have hd2y : 1^(int.to_nat(y)) ≡ (a^n.to_nat)^(int.to_nat(y)) [ZMOD d] := int.modeq.pow (y).to_nat hd2_mod,
  simp only [one_pow] at hd2y,
  rw ← pow_mul at hd2y,

  have hd2y_dvd : ↑d ∣ a ^ (n.to_nat * y.to_nat) - 1 := (int.modeq_iff_dvd).mp hd2y,
  have hd1x_dvd : ↑d ∣ a ^ (m.to_nat * (-x).to_nat) - 1 := (int.modeq_iff_dvd).mp hd1x,

  have hd1x_dvd_mul : ↑d ∣ (a^g) * (a ^ (m.to_nat * (-x).to_nat) - 1) := dvd_mul_of_dvd_right hd1x_dvd (a^g),

  rw mul_sub at hd1x_dvd_mul,
  rw ← pow_add at hd1x_dvd_mul,
  simp only [mul_one] at hd1x_dvd_mul,

  have h_m_nonneg : m ≥ 0 := by linarith,
  have h_n_nonneg : n ≥ 0 := by linarith,
  have h_xy_nonneg : m * x + n * y ≥ 0,
  {
    have hgcd2 : int.of_nat(g) ≥ 0 := int.of_nat_nonneg g,
    rw ← hxy,
    exact hgcd2,
  },

  have hg := fun_coe_lemma_l h_m_nonneg h_n_nonneg hl h_xy_nonneg,
  apply_fun int.to_nat at hxy,
  simp only [int.to_nat_coe_nat] at hxy,
  rw ← hxy at hg,

  have hd1x_dvd_mul_neg : ↑d ∣ -(a ^ (g + m.to_nat * (-x).to_nat) - a ^ g) := (dvd_neg ↑d (a ^ (g + int.to_nat m * (-x).to_nat) - a ^ g)).mpr hd1x_dvd_mul,
  simp only [neg_sub] at hd1x_dvd_mul_neg,
  rw hg at hd1x_dvd_mul_neg,
  have hd3 : ↑d ∣ (a ^ g - a ^ (n.to_nat * y.to_nat)) + (a ^ (n.to_nat * y.to_nat) - 1) := dvd_add hd1x_dvd_mul_neg hd2y_dvd,
  simp only [sub_add_sub_cancel] at hd3,
  exact int.modeq_of_dvd hd3,

end

lemma a_pow_gcd_modeq_one_signs_right ( a m n : ℤ) (h_a_pos : a > 0) (h_m_pos : m > 0) (h_n_pos : n > 0) (hr : m.gcd_a n > 0 ∧ m.gcd_b n ≤ 0)
      : 1 ≡ a^(m.gcd n) [ZMOD (int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1))] :=
begin
  set d := (int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1)),
  have h_xy_signs := gcd_linear_combo_signs h_m_pos h_n_pos,
  have hxy := (int.gcd_eq_gcd_ab m n),
  set x := m.gcd_a n,
  set y := m.gcd_b n,
  set g := m.gcd n,

  have hx : -y ≥ 0 := by linarith,

  have hd1 : ↑d ∣ a^n.to_nat - 1 := (a ^ m.to_nat - 1).gcd_dvd_right (a ^ n.to_nat - 1),
  have hd1_mod : 1 ≡ a^n.to_nat [ZMOD d] := (int.modeq_iff_dvd).mpr hd1,

  have hd1y : 1^(int.to_nat(-y)) ≡ (a^n.to_nat)^(int.to_nat(-y)) [ZMOD d] := int.modeq.pow (-y).to_nat hd1_mod,
  simp only [one_pow] at hd1y,
  rw ← pow_mul at hd1y,

  have hd2 : ↑d ∣ a^m.to_nat - 1 := (a ^ m.to_nat - 1).gcd_dvd_left (a ^ n.to_nat - 1),
  have hd2_mod : 1 ≡ a^m.to_nat [ZMOD d] := (int.modeq_iff_dvd).mpr hd2,

  have hd2x : 1^(int.to_nat(x)) ≡ (a^m.to_nat)^(int.to_nat(x)) [ZMOD d] := int.modeq.pow (x).to_nat hd2_mod,
  simp only [one_pow] at hd2x,
  rw ← pow_mul at hd2x,

  have hd2x_dvd : ↑d ∣ a ^ (m.to_nat * x.to_nat) - 1 := (int.modeq_iff_dvd).mp hd2x,
  have hd1y_dvd : ↑d ∣ a ^ (n.to_nat * (-y).to_nat) - 1 := (int.modeq_iff_dvd).mp hd1y,

  have hd1y_dvd_mul : ↑d ∣ (a^g) * (a ^ (n.to_nat * (-y).to_nat) - 1) := dvd_mul_of_dvd_right hd1y_dvd (a^g),

  rw mul_sub at hd1y_dvd_mul,
  rw ← pow_add at hd1y_dvd_mul,
  simp only [mul_one] at hd1y_dvd_mul,

  have h_m_nonneg : m ≥ 0 := by linarith,
  have h_n_nonneg : n ≥ 0 := by linarith,
  have h_xy_nonneg : m * x + n * y ≥ 0,
  {
    have hgcd2 : int.of_nat(g) ≥ 0 := int.of_nat_nonneg g,
    rw ← hxy,
    exact hgcd2,
  },

  have hg := fun_coe_lemma_r h_m_nonneg h_n_nonneg hr h_xy_nonneg,
  apply_fun int.to_nat at hxy,
  simp only [int.to_nat_coe_nat] at hxy,
  rw ← hxy at hg,

  have hd1y_dvd_mul_neg : ↑d ∣ -(a ^ (g + n.to_nat * (-y).to_nat) - a ^ g) := (dvd_neg ↑d (a ^ (g + int.to_nat n * (-y).to_nat) - a ^ g)).mpr hd1y_dvd_mul,
  simp only [neg_sub] at hd1y_dvd_mul_neg,
  rw hg at hd1y_dvd_mul_neg,
  have hd3 : ↑d ∣ (a ^ g - a ^ (m.to_nat * x.to_nat)) + (a^ (m.to_nat * x.to_nat) - 1) := dvd_add hd1y_dvd_mul_neg hd2x_dvd,
  simp only [sub_add_sub_cancel] at hd3,
  exact int.modeq_of_dvd hd3,

end

lemma h_a_pow {a : ℤ} (h_a_pos : a > 0) (n : ℕ) : 1 ≤ a^n :=
begin
  have ha : a ≥ 1 := by linarith,
  exact one_le_pow_of_one_le ha n,
end

lemma gcd_pow {a m n : ℤ} (h_a_pos : a > 0) (h_m_pos : m > 0) (h_n_pos : n > 0)
              : 1 ≡ a^((int.gcd m n)) [ZMOD (int.gcd (a^(m.to_nat) - 1) (a^(n.to_nat) - 1))] :=
begin
  -- g = gcd(m n); g = mx + ny; wlog y ≤ 0
  -- d = gcd(a^m - 1, a^n -1)
  -- d ∣ a^(mx) - 1 ; d ∣ a^(-ny) - 1 ; d ∣ -a^g (a^-ny - 1)
  -- d ∣ -a^g (a^-ny - 1) + a^(mx) - 1
  -- d ∣ a^g - a^(g-ny) + a^(mx) - 1 = a^g - 1

  set d := (int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1)),
  have h_xy_signs := gcd_linear_combo_signs h_m_pos h_n_pos,
  have hxy := (int.gcd_eq_gcd_ab m n),
  set x := m.gcd_a n,
  set y := m.gcd_b n,
  set g := m.gcd n,

  cases h_xy_signs with hl hr,
  {
    exact a_pow_gcd_modeq_one_signs_left a m n h_a_pos h_m_pos h_n_pos hl,
  },
  {
    exact a_pow_gcd_modeq_one_signs_right a m n h_a_pos h_m_pos h_n_pos hr,
  }

end

lemma left_dvd_right (a m n : ℤ) (ha : a ≠ 1) (h_a_pos : a > 0) (h_m_pos : m > 0) (h_n_pos : n > 0)
                    : ↑(int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1)) ∣  ( a^(int.gcd m n) - 1 ) :=

begin
  set d := ↑(int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1)),
  have hd1 : d ∣ (a^m.to_nat - 1) := (a ^ m.to_nat - 1).gcd_dvd_left (a ^ n.to_nat - 1),
  have hd2 : d ∣ (a^n.to_nat - 1) := (a ^ m.to_nat - 1).gcd_dvd_right (a ^ n.to_nat - 1),
  rw ← int.modeq_iff_dvd at hd1,
  rw ← int.modeq_iff_dvd at hd2,
  {

    have h_gcd_pow := gcd_pow h_a_pos h_m_pos h_n_pos,

    have hk : 1 ≤ a ^ m.gcd n := h_a_pow h_a_pos (m.gcd n),
    exact int.modeq.dvd h_gcd_pow,
  },
end

lemma useful_lemma (a d e : ℤ) (h_a_pos : a > 0) : ((a^d.to_nat)^e.to_nat - 1 ≡ 0 [ZMOD a^d.to_nat - 1]) :=
begin
  have h1 : a^d.to_nat ≡ 1 [ZMOD a^d.to_nat - 1],
  {
    have hr : a^d.to_nat - 1 ∣ a^d.to_nat - 1 := dvd_rfl,
    have hz := int.modeq_zero_iff_dvd.mpr hr,
    have hr : 1 ≡ 1 [ZMOD a^d.to_nat - 1]  := int.modeq.rfl,
    have hzr : (a ^ d.to_nat - 1) + 1 ≡ 0 + 1 [ZMOD a ^ d.to_nat - 1] := int.modeq.add hz hr,
    have hl : a^d.to_nat = a^d.to_nat - 1 + 1,

    { have h_ad_pos : a^d.to_nat > 0 := pow_pos h_a_pos (int.to_nat d),
      linarith,
    },
    rwa [← hl, zero_add] at hzr,
  },
  have h2 : (a^d.to_nat)^e.to_nat ≡ 1 [ZMOD a^d.to_nat - 1],
  {
    have hp := int.modeq.pow e.to_nat h1,
    rwa one_pow e.to_nat at hp,
  },
  have hge1 : (a ^ d.to_nat) ^ e.to_nat ≥ 1,
  {
    rw ← pow_mul,
    exact h_a_pow h_a_pos (int.to_nat d * int.to_nat e),
  },
  suffices h : ((a ^ d.to_nat) ^ e.to_nat) - 1 + 1 ≡ 0 + 1 [ZMOD a ^ d.to_nat - 1],
  exact int.modeq.add_right_cancel' 1 h,
  simp,

  have h_ade_pos : (a^d.to_nat)^e.to_nat > 0 := pow_pos (pow_pos h_a_pos d.to_nat) e.to_nat,
  assumption,

end

lemma dvd_prod {d a k : ℕ} (hd : d ∣ a) : (d ∣ k * a) :=
begin
  exact dvd_mul_of_dvd_right hd k,
end

/-

proof based on:

https://math.stackexchange.com/questions/11567/gcdbx-1-by-1-b-z-1-dots-b-gcdx-y-z-dots-1

-/

theorem gcd_pows_minus_one (a m n : ℤ) (ha : a ≠ 1) (h_a_pos : a > 0) (h_m_pos : m > 0) (h_n_pos : n > 0)
                        : ↑(int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1)) = a^(int.gcd m n) - 1 :=
begin

have left_dvd_right := left_dvd_right a m n ha h_a_pos h_m_pos h_n_pos,
have right_dvd_left : a^(int.gcd m n) - 1 ∣ ↑(int.gcd (a^m.to_nat - 1) (a^n.to_nat - 1)),
{
  have h1 : ↑(int.gcd m n) ∣ n := int.gcd_dvd_right m n,
  have h2 : ↑(int.gcd m n) ∣ m := int.gcd_dvd_left m n,

  have h1_d := dvd_iff_exists_eq_mul_left.mp h1,
  have h2_d := dvd_iff_exists_eq_mul_left.mp h2,

  cases h1_d with e he,
  cases h2_d with f hf,

  have h_gcd_nonneg : m.gcd n ≥ 0 := zero_le (int.gcd m n),
  have h_gcd_nonneg' : ↑(m.gcd n) ≥ 0 := zero_le ↑(int.gcd m n),

  have h_e_nonneg : e ≥ 0,
  {
    by_contra, push_neg at h,
    have he2 : e * ↑(m.gcd n) ≤ 0 * ↑(m.gcd n) := by nlinarith,
    simp only [zero_mul] at he2,
    rw ← he at he2,
    linarith,
  },

  have h_f_nonneg : f ≥ 0,
  {
    by_contra, push_neg at h,
    have hf2 : f * ↑(m.gcd n) ≤ 0 * ↑(m.gcd n),
    {
      nlinarith,
    },
    simp only [zero_mul] at hf2,
    rw ← hf at hf2,
    linarith,
  },

  have h3 : a^n.to_nat - 1 = (a^(m.gcd n))^e.to_nat - 1,
  {
    nth_rewrite 0 he,
    rw mul_comm e (m.gcd n),
    suffices h : a ^ ((↑(m.gcd n) * e).to_nat) = (a ^ m.gcd n) ^ e.to_nat,
    rw h,

    --(n : ℕ) (e : ℤ) (hn : n ≥ 0) (he : e ≥ 0)

    have hc : (↑(m.gcd n) * e).to_nat = (m.gcd n) * e.to_nat := fun_coe_lemma2 (m.gcd n) e h_gcd_nonneg h_e_nonneg,
    rw hc,
    exact pow_mul a (int.gcd m n) e.to_nat,
  },
  have h4 : a^m.to_nat - 1 = (a^(m.gcd n))^f.to_nat - 1,
  {nth_rewrite 0 hf,
    rw mul_comm f (m.gcd n),
    suffices h : a ^ ((m.gcd n) * f.to_nat) = (a ^ m.gcd n) ^ f.to_nat,
    have hc : (↑(m.gcd n) * f).to_nat = (m.gcd n) * f.to_nat := fun_coe_lemma2 (m.gcd n) f h_gcd_nonneg h_f_nonneg,
    rw hc,
    simp only [sub_left_inj],
    exact pow_mul a (int.gcd m n) f.to_nat,
    exact pow_mul a (int.gcd m n) f.to_nat,
    },

  have h5 := int.modeq.symm( useful_lemma a (m.gcd n) e h_a_pos),
  have h6 := int.modeq.symm( useful_lemma a (m.gcd n) f h_a_pos),

  have hgcd: 0 ≤ m.gcd n := zero_le (int.gcd m n),
  simp at h5,
  simp at h6,

  rw ← h3 at h5,
  rw ← h4 at h6,

  rw int.modeq_iff_dvd at h5, simp only [sub_zero] at h5,
  rw int.modeq_iff_dvd at h6, simp only [sub_zero] at h6,
  exact int.dvd_gcd h6 h5,

},

have h_left_nonneg := int.coe_zero_le ((a ^ int.to_nat m - 1).gcd (a ^ int.to_nat n - 1)),
have h_right_nonneg1 := h_a_pow h_a_pos (int.gcd m n),
have h_right_nonneg : 0 ≤ (a^(int.gcd m n) - 1) := by linarith,

exact int.dvd_antisymm h_left_nonneg h_right_nonneg left_dvd_right right_dvd_left,

end


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
-/
import linear_algebra.matrix.to_lin
import linear_algebra.matrix.trace

/-!
# Trace of a linear map

This file defines the trace of a linear map.

See also `linear_algebra/matrix/trace.lean` for the trace of a matrix.

## Tags

linear_map, trace, diagonal

-/

noncomputable theory

universes u v w

namespace linear_map

open_locale big_operators
open_locale matrix
open finite_dimensional

section
variables (R : Type u) [comm_ring R] {M : Type v} [add_comm_group M] [module R M]
variables {ι : Type w} [decidable_eq ι] [fintype ι]
variables {κ : Type*} [decidable_eq κ] [fintype κ]
variables (b : basis ι R M) (c : basis κ R M)

/-- The trace of an endomorphism given a basis. -/
def trace_aux :
  (M →ₗ[R] M) →ₗ[R] R :=
(matrix.trace ι R R) ∘ₗ ↑(linear_map.to_matrix b b)

-- Can't be `simp` because it would cause a loop.
lemma trace_aux_def (b : basis ι R M) (f : M →ₗ[R] M) :
  trace_aux R b f = matrix.trace ι R R (linear_map.to_matrix b b f) :=
rfl

theorem trace_aux_eq : trace_aux R b = trace_aux R c :=
linear_map.ext $ λ f,
calc  matrix.trace ι R R (linear_map.to_matrix b b f)
    = matrix.trace ι R R (linear_map.to_matrix b b ((linear_map.id.comp f).comp linear_map.id)) :
  by rw [linear_map.id_comp, linear_map.comp_id]
... = matrix.trace ι R R (linear_map.to_matrix c b linear_map.id ⬝
        linear_map.to_matrix c c f ⬝
        linear_map.to_matrix b c linear_map.id) :
  by rw [linear_map.to_matrix_comp _ c, linear_map.to_matrix_comp _ c]
... = matrix.trace κ R R (linear_map.to_matrix c c f ⬝
        linear_map.to_matrix b c linear_map.id ⬝
        linear_map.to_matrix c b linear_map.id) :
  by rw [matrix.mul_assoc, matrix.trace_mul_comm]
... = matrix.trace κ R R (linear_map.to_matrix c c ((f.comp linear_map.id).comp linear_map.id)) :
  by rw [linear_map.to_matrix_comp _ b, linear_map.to_matrix_comp _ c]
... = matrix.trace κ R R (linear_map.to_matrix c c f) :
  by rw [linear_map.comp_id, linear_map.comp_id]

open_locale classical

variables (R) (M)

/-- Trace of an endomorphism independent of basis. -/
def trace : (M →ₗ[R] M) →ₗ[R] R :=
if H : ∃ (s : finset M), nonempty (basis s R M)
then trace_aux R H.some_spec.some
else 0

variables (R) {M}

/-- Auxiliary lemma for `trace_eq_matrix_trace`. -/
theorem trace_eq_matrix_trace_of_finset {s : finset M} (b : basis s R M)
  (f : M →ₗ[R] M) :
  trace R M f = matrix.trace s R R (linear_map.to_matrix b b f) :=
have ∃ (s : finset M), nonempty (basis s R M),
from ⟨s, ⟨b⟩⟩,
by { rw [trace, dif_pos this, ← trace_aux_def], congr' 1, apply trace_aux_eq }

theorem trace_eq_matrix_trace (f : M →ₗ[R] M) :
  trace R M f = matrix.trace ι R R (linear_map.to_matrix b b f) :=
by rw [trace_eq_matrix_trace_of_finset R b.reindex_finset_range,
    ← trace_aux_def, ← trace_aux_def, trace_aux_eq R b]

theorem trace_mul_comm (f g : M →ₗ[R] M) :
  trace R M (f * g) = trace R M (g * f) :=
if H : ∃ (s : finset M), nonempty (basis s R M) then let ⟨s, ⟨b⟩⟩ := H in
by { simp_rw [trace_eq_matrix_trace R b, linear_map.to_matrix_mul], apply matrix.trace_mul_comm }
else by rw [trace, dif_neg H, linear_map.zero_apply, linear_map.zero_apply]

/-- The trace of an endomorphism is invariant under conjugation -/
@[simp]
theorem trace_conj (g : M →ₗ[R] M) (f : units (M →ₗ[R] M)) :
  trace R M (↑f * g * ↑f⁻¹) = trace R M g :=
by { rw trace_mul_comm, simp }

/-- The trace of an endomorphism is invariant under conjugation -/
@[simp]
theorem trace_conj' (f g : M →ₗ[R] M) [invertible f] :
  trace R M (f * g * ⅟ f) = trace R M g :=
by { rw trace_mul_comm, simp }

end

section
variables (R : Type u) [field R] {M : Type v} [add_comm_group M] [module R M]

/-- The trace of the identity endomorphism is the dimension of the vector space -/
@[simp] theorem trace_one : trace R M 1 = (finrank R M : R) :=
begin
  classical,
  by_cases H : ∃ (s : finset M), nonempty (basis s R M),
  { obtain ⟨s, ⟨b⟩⟩ := H,
    rw [trace_eq_matrix_trace R b, to_matrix_one, finrank_eq_card_finset_basis b],
    simp, },
  { suffices : (finrank R M : R) = 0, { simp [this, trace, H], },
    simp [finrank_eq_zero_of_not_exists_basis H], },
end

end

end linear_map


/-
Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta

! This file was ported from Lean 3 source module combinatorics.simple_graph.regularity.energy
! leanprover-community/mathlib commit f47581155c818e6361af4e4fda60d27d020c226b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.BigOperators.Order
import Mathbin.Algebra.Module.Basic
import Mathbin.Combinatorics.SimpleGraph.Density

/-!
# Energy of a partition

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

This file defines the energy of a partition.

The energy is the auxiliary quantity that drives the induction process in the proof of Szemerédi's
Regularity Lemma. As long as we do not have a suitable equipartition, we will find a new one that
has an energy greater than the previous one plus some fixed constant.
-/

open Finset

open BigOperators

variable {α : Type _} [DecidableEq α] {s : Finset α} (P : Finpartition s) (G : SimpleGraph α)
  [DecidableRel G.Adj]

namespace Finpartition

/- warning: finpartition.energy -> Finpartition.energy is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {s : Finset.{u1} α}, (Finpartition.{u1} (Finset.{u1} α) (Finset.lattice.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) (Finset.orderBot.{u1} α) s) -> (forall (G : SimpleGraph.{u1} α) [_inst_2 : DecidableRel.{succ u1} α (SimpleGraph.Adj.{u1} α G)], Rat)
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {s : Finset.{u1} α}, (Finpartition.{u1} (Finset.{u1} α) (Finset.instLatticeFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) (Finset.instOrderBotFinsetToLEToPreorderPartialOrder.{u1} α) s) -> (forall (G : SimpleGraph.{u1} α) [_inst_2 : DecidableRel.{succ u1} α (SimpleGraph.Adj.{u1} α G)], Rat)
Case conversion may be inaccurate. Consider using '#align finpartition.energy Finpartition.energyₓ'. -/
/-- The energy of a partition, also known as index. Auxiliary quantity for Szemerédi's regularity
lemma.  -/
def energy : ℚ :=
  (∑ uv in P.parts.offDiag, G.edgeDensity uv.1 uv.2 ^ 2) / P.parts.card ^ 2
#align finpartition.energy Finpartition.energy

/- warning: finpartition.energy_nonneg -> Finpartition.energy_nonneg is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {s : Finset.{u1} α} (P : Finpartition.{u1} (Finset.{u1} α) (Finset.lattice.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) (Finset.orderBot.{u1} α) s) (G : SimpleGraph.{u1} α) [_inst_2 : DecidableRel.{succ u1} α (SimpleGraph.Adj.{u1} α G)], LE.le.{0} Rat Rat.hasLe (OfNat.ofNat.{0} Rat 0 (OfNat.mk.{0} Rat 0 (Zero.zero.{0} Rat Rat.hasZero))) (Finpartition.energy.{u1} α (fun (a : α) (b : α) => _inst_1 a b) s P G (fun (a : α) (b : α) => _inst_2 a b))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {s : Finset.{u1} α} (P : Finpartition.{u1} (Finset.{u1} α) (Finset.instLatticeFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) (Finset.instOrderBotFinsetToLEToPreorderPartialOrder.{u1} α) s) (G : SimpleGraph.{u1} α) [_inst_2 : DecidableRel.{succ u1} α (SimpleGraph.Adj.{u1} α G)], LE.le.{0} Rat Rat.instLERat (OfNat.ofNat.{0} Rat 0 (Rat.instOfNatRat 0)) (Finpartition.energy.{u1} α (fun (a : α) (b : α) => _inst_1 a b) s P G (fun (a : α) (b : α) => _inst_2 a b))
Case conversion may be inaccurate. Consider using '#align finpartition.energy_nonneg Finpartition.energy_nonnegₓ'. -/
theorem energy_nonneg : 0 ≤ P.energy G :=
  div_nonneg (Finset.sum_nonneg fun _ _ => sq_nonneg _) <| sq_nonneg _
#align finpartition.energy_nonneg Finpartition.energy_nonneg

/- warning: finpartition.energy_le_one -> Finpartition.energy_le_one is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {s : Finset.{u1} α} (P : Finpartition.{u1} (Finset.{u1} α) (Finset.lattice.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) (Finset.orderBot.{u1} α) s) (G : SimpleGraph.{u1} α) [_inst_2 : DecidableRel.{succ u1} α (SimpleGraph.Adj.{u1} α G)], LE.le.{0} Rat Rat.hasLe (Finpartition.energy.{u1} α (fun (a : α) (b : α) => _inst_1 a b) s P G (fun (a : α) (b : α) => _inst_2 a b)) (OfNat.ofNat.{0} Rat 1 (OfNat.mk.{0} Rat 1 (One.one.{0} Rat Rat.hasOne)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {s : Finset.{u1} α} (P : Finpartition.{u1} (Finset.{u1} α) (Finset.instLatticeFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) (Finset.instOrderBotFinsetToLEToPreorderPartialOrder.{u1} α) s) (G : SimpleGraph.{u1} α) [_inst_2 : DecidableRel.{succ u1} α (SimpleGraph.Adj.{u1} α G)], LE.le.{0} Rat Rat.instLERat (Finpartition.energy.{u1} α (fun (a : α) (b : α) => _inst_1 a b) s P G (fun (a : α) (b : α) => _inst_2 a b)) (OfNat.ofNat.{0} Rat 1 (Rat.instOfNatRat 1))
Case conversion may be inaccurate. Consider using '#align finpartition.energy_le_one Finpartition.energy_le_oneₓ'. -/
theorem energy_le_one : P.energy G ≤ 1 :=
  div_le_of_nonneg_of_le_mul (sq_nonneg _) zero_le_one <|
    calc
      (∑ uv in P.parts.offDiag, G.edgeDensity uv.1 uv.2 ^ 2) ≤ P.parts.offDiag.card • 1 :=
        sum_le_card_nsmul _ _ 1 fun uv _ =>
          (sq_le_one_iff <| G.edgeDensity_nonneg _ _).2 <| G.edgeDensity_le_one _ _
      _ = P.parts.offDiag.card := (Nat.smul_one_eq_coe _)
      _ ≤ _ := by
        rw [off_diag_card, one_mul, ← Nat.cast_pow, Nat.cast_le, sq]
        exact tsub_le_self

#align finpartition.energy_le_one Finpartition.energy_le_one

end Finpartition


/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/

import field_theory.normal

/-!
# Minpoly

We prove some auxiliary lemmas about minimal polynomials.

## Main Definitions

* `minpoly.alg_equiv` : the canonical `alg_equiv` between `K⟮x⟯`and `K⟮y⟯`, sending `x` to `y`, where
  `x` and `y` have the same minimal polynomial over `K`, sending `x` to `y`.

## Main Results

* `minpoly.eq_of_conj` : For any `σ : L ≃ₐ[K] L` and `x : L`, the minimal polynomials of `x` and
  `σ x` are equal.
* `minpoly.conj_of_root` :If `y : L` is a root of `minpoly K x`, then we can find `σ : L ≃ₐ[K] L)`
   with `σ x = y`. That is, `x` and `y` are Galois conjugates.

## Tags

minpoly, adjoin_root, conj
-/

noncomputable theory

open polynomial intermediate_field alg_equiv

open_locale polynomial

section minpoly

variables {K L : Type*} [field K] [field L] [algebra K L]

namespace adjoin_root

/-- The canonical algebraic equivalence between `adjoin_root p` and `adjoin_root q`, where
  the two polynomial `p q : K[X]` are equal.-/
def id_alg_equiv {p q : K[X]} (hp : p ≠ 0) (hq : q ≠ 0) (h_eq : p = q) :
  adjoin_root p ≃ₐ[K] adjoin_root q :=
of_alg_hom (lift_hom p (root q) (by rw [h_eq, aeval_eq, mk_self]))
  (lift_hom q (root p) (by rw [h_eq, aeval_eq, mk_self]))
  (power_basis.alg_hom_ext (power_basis hq) (by rw [power_basis_gen hq, alg_hom.coe_comp,
    function.comp_app, lift_hom_root, lift_hom_root, alg_hom.coe_id, id.def]))
  (power_basis.alg_hom_ext (power_basis hp) (by rw [power_basis_gen hp, alg_hom.coe_comp,
    function.comp_app, lift_hom_root, lift_hom_root, alg_hom.coe_id, id.def]))

lemma id_alg_equiv_def {p q : K[X]} (hp : p ≠ 0) (hq : q ≠ 0) (h_eq : p = q) :
  (id_alg_equiv hp hq h_eq).to_fun = (lift_hom p (root q) (by rw [h_eq, aeval_eq, mk_self])) :=
rfl

/-- `id_alg_equiv` sends `adjoin_root.root p` to `adjoin_root.root q`. -/
lemma id_alg_equiv_apply_root {p q : K[X]} (hp : p ≠ 0) (hq : q ≠ 0) (h_eq : p = q) :
  id_alg_equiv hp hq h_eq (root p) = root q :=
by rw [← to_fun_eq_coe, id_alg_equiv_def, lift_hom_root]

end adjoin_root

namespace minpoly

/-- Given any `σ : L ≃ₐ[K] L` and any `x : L`, the minimal polynomial of `x` vanishes at `σ x`. -/
@[simp] lemma aeval_conj (σ : L ≃ₐ[K] L) (x : L) : (polynomial.aeval (σ x)) (minpoly K x) = 0 :=
by rw [polynomial.aeval_alg_equiv, alg_hom.coe_comp, function.comp_app, aeval, map_zero]

/-- For any `σ : L ≃ₐ[K] L` and `x : L`, the minimal polynomials of `x` and `σ x` are equal. -/
@[simp] lemma eq_of_conj (h_alg : algebra.is_algebraic K L) (σ : L ≃ₐ[K] L) (x : L) :
  minpoly K (σ x) = minpoly K x :=
begin
  have h_dvd : minpoly K x ∣ minpoly K (σ x),
  { apply dvd,
    have hx : σ.symm (σ x) = x := σ.left_inv x,
    nth_rewrite 0 ← hx,
    rw [polynomial.aeval_alg_equiv, alg_hom.coe_comp, function.comp_app, aeval, map_zero] },
  have h_deg : (minpoly K (σ x)).nat_degree ≤ (minpoly K x).nat_degree,
  { apply polynomial.nat_degree_le_nat_degree (degree_le_of_ne_zero K _ (ne_zero
    (is_algebraic_iff_is_integral.mp (h_alg _))) (aeval_conj σ x)) },
  exact polynomial.eq_of_monic_of_dvd_of_nat_degree_le
    (monic (is_algebraic_iff_is_integral.mp (h_alg _)))
    (monic (is_algebraic_iff_is_integral.mp (h_alg _))) h_dvd h_deg,
end

/-- The canonical `alg_equiv` between `K⟮x⟯`and `K⟮y⟯`, sending `x` to `y`, where `x` and `y` have
  the same minimal polynomial over `K`. -/
def alg_equiv (h_alg : algebra.is_algebraic K L) {x y : L} (h_mp : minpoly K x = minpoly K y) :
  K⟮x⟯ ≃ₐ[K] K⟮y⟯ :=
trans ((adjoin_root_equiv_adjoin K (is_algebraic_iff_is_integral.mp (h_alg _))).symm)
  (trans (adjoin_root.id_alg_equiv (ne_zero (is_algebraic_iff_is_integral.mp (h_alg _)))
    (ne_zero (is_algebraic_iff_is_integral.mp (h_alg _))) h_mp)
    (adjoin_root_equiv_adjoin K(is_algebraic_iff_is_integral.mp (h_alg _))))

/-- `minpoly.alg_equiv` sends the generator of `K⟮x⟯` to the generator of `K⟮y⟯`. -/
lemma alg_equiv_apply (h_alg : algebra.is_algebraic K L) {x y : L}
  (h_mp : minpoly K x = minpoly K y) :
  alg_equiv h_alg h_mp ((adjoin_simple.gen K x)) = (adjoin_simple.gen K y) :=
begin
  simp only [alg_equiv],
  rw [trans_apply, ← adjoin_root_equiv_adjoin_apply_root K
    (is_algebraic_iff_is_integral.mp (h_alg _)), symm_apply_apply,
    trans_apply, adjoin_root.id_alg_equiv_apply_root,
    adjoin_root_equiv_adjoin_apply_root K (is_algebraic_iff_is_integral.mp (h_alg _))],
end

/-- If `y : L` is a root of `minpoly K x`, then `minpoly K y = minpoly K x`. -/
lemma eq_of_root (h_alg : algebra.is_algebraic K L) {x y : L}
 (h_ev : (polynomial.aeval y) (minpoly K x) = 0) : minpoly K y = minpoly K x  :=
polynomial.eq_of_monic_of_associated (monic (is_algebraic_iff_is_integral.mp (h_alg _)))
  (monic (is_algebraic_iff_is_integral.mp (h_alg _)))
  (irreducible.associated_of_dvd (irreducible (is_algebraic_iff_is_integral.mp (h_alg _)))
    (irreducible (is_algebraic_iff_is_integral.mp (h_alg _))) (dvd K y h_ev))

/-- If `y : L` is a root of `minpoly K x`, then we can find `σ : L ≃ₐ[K] L)` with `σ x = y`.
  That is, `x` and `y` are Galois conjugates. -/
lemma conj_of_root (h_alg : algebra.is_algebraic K L) (hn : normal K L) {x y : L}
 (h_ev : (polynomial.aeval x) (minpoly K y) = 0) : ∃ (σ : L ≃ₐ[K] L), σ x = y  :=
begin
  set f : K⟮x⟯ ≃ₐ[K] K⟮y⟯ := alg_equiv h_alg (eq_of_root h_alg h_ev),
  use lift_normal f L,
  simp_rw ← adjoin_simple.algebra_map_gen K x,
  rw [lift_normal_commutes f L, alg_equiv_apply, adjoin_simple.algebra_map_gen K y],
end

/-- If `y : L` is a root of `minpoly K x`, then we can find `σ : L ≃ₐ[K] L)` with `σ y = x`.
  That is, `x` and `y` are Galois conjugates. -/
lemma conj_of_root' (h_alg : algebra.is_algebraic K L) (hn : normal K L) {x y : L}
 (h_ev : (polynomial.aeval x) (minpoly K y) = 0) : ∃ (σ : L ≃ₐ[K] L), σ y = x  :=
begin
  obtain ⟨σ, hσ⟩ := conj_of_root h_alg hn h_ev,
  use σ.symm,
  rw [← hσ, symm_apply_apply],
end

end minpoly

end minpoly


import topology.metric_space.basic
import topology.uniform_space.basic

def converges_to {X : Type*} [metric_space X] (s : ℕ → X) (x : X) :=
∀ (ε : ℝ) (hε : 0 < ε), ∃ N : ℕ, ∀ (n : ℕ) (hn : N ≤ n), dist x (s n) < ε

notation s ` ⟶ ` x := converges_to s x

theorem limit_unique {X : Type*} [metric_space X] {s : ℕ → X}
  (x₀ x₁ : X) (h₀ : s ⟶ x₀) (h₁ : s ⟶ x₁) :
x₀ = x₁ :=
begin
    apply classical.by_contradiction,
    intro h,
    let ε' := (dist x₀ x₁),
    have ε'_pos : 0 < ε',
        exact dist_pos.mpr h,
    let ε := ε'/2,
    have ε_pos : 0 < ε,
        exact half_pos ε'_pos,
    rcases h₀ ε ε_pos with ⟨N₀, hN₀⟩,
    rcases h₁ ε ε_pos with ⟨N₁, hN₁⟩,
    let N := max N₀ N₁,
    specialize hN₀ N (le_max_left N₀ N₁),
    specialize hN₁ N (le_max_right N₀ N₁),
    have key : ε' < ε',
        calc
        ε' = dist x₀ x₁ : rfl
        ... ≤ (dist x₀ (s N)) + (dist x₁ (s N)) : dist_triangle_right x₀ x₁ (s N)
        ... < ε + ε : add_lt_add hN₀ hN₁
        ... = ε' : add_halves ε',
        exact (irrefl ε') key,
end

lemma easy {X : Type*} [metric_space X] (a b : X) (R : ℝ) : R - (dist a b) = R - (dist b a) :=
begin
    rw dist_comm,
end

lemma easy2 {X : Type*} [metric_space X] (a b : X) (R : ℝ) : (dist a b) + R = (dist b a) + R :=
begin
    rw dist_comm,
end

theorem limit_within_closed_bound {X : Type*} [metric_space X] {s : ℕ → X}
    (x : X) (R : ℝ) (h₀ : s ⟶ x) (h₁ : ∀ n m : ℕ, dist (s n) (s m) < R) :
∀ n : ℕ, dist (s n) x ≤ R :=
begin
    intro n,
    apply classical.by_contradiction,
    intro hf,
    rw not_le at hf,
    have help : 0 < (dist (s n) x - R) / 2,
        suffices : 0 < (dist (s n) x - R),
            exact half_pos this,
        exact sub_pos.mpr hf,
    rcases h₀ ((dist (s n) x - R) / 2) help with ⟨N, hN⟩,
    specialize hN N (rfl.ge),
    have key : dist (s n) (s N) > R,
        have help' : (dist (s n) x) ≤ (dist (s n) (s N)) + (dist (s N) x),
            apply dist_triangle,
        calc
        (dist (s n) (s N)) ≥ (dist (s n) x) - (dist (s N) x) : sub_le_iff_le_add.mpr help'
        ... = (dist (s n) x) - (dist x (s N)) : easy (s N) x (dist (s n) x)
        ... > (dist (s n) x) - (dist (s n) x - R) / 2 : sub_lt_sub_left hN (dist (s n) x)
        ... = (dist (s n) x + R) / 2 : by ring
        ... > (R + R) / 2 : by linarith
        ... = R : half_add_self R,
        exact (lt_asymm (h₁ n N)) key,
end

theorem limit_of_bounded_sequence_in_bound
    (s : ℕ → ℝ)
    (x B : ℝ)
    (h_lim : s ⟶ x)
    (zero : s 0 = 0)
    (s_bounded : ∀ n : ℕ, dist 0 (s n) < B)
     : ∃ B', dist 0 x ≤ B' :=
begin
    let B' := 2 * B,
    use B',
    have help : ∀ n m : ℕ, dist (s n) (s m) < B',
        intros n m,
        calc
        dist (s n) (s m) ≤ dist (s n) 0 + dist 0 (s m) : dist_triangle (s n) 0 (s m)
        ... = dist 0 (s n) + dist 0 (s m) : easy2 _ _ _
        ... < B + dist 0 (s m) : add_lt_add_right (s_bounded n) (dist 0 (s m))
        ... < B + B : (add_lt_add_left (s_bounded m) B)
        ... = 2 * B : ((two_mul B).symm)
        ... = B'    : rfl,
    have overkill : dist (s 0) x ≤ B',
        exact limit_within_closed_bound x B' h_lim help 0,
    rwa ← zero,
end


import .fglib
import .basic
import .linear_space

namespace FG

/-
  ## Matrix Representation
-/

/-
  `invertible_matrix` (**genearal linear group**) is a
  **representation** of a **group** `G` in matrix form,
  on a **vector space** `V` over the **field** `ℂ`.
 -/

structure matrix_representation (n : ℕ) (G : Type) [group G] :=
(f          : G → invertible_matrix n)
(id_mapped  : f 1 = 1 )
(mul_mapped : ∀z₁ z₂, f z₁ * f z₂ = f (z₁ * z₂) )

namespace matrix_representation

variables {n : ℕ} {G : Type} [group G]
  (D : matrix_representation n G)

@[ext] theorem ext (D D' : matrix_representation n G) :
  D.f = D'.f → D = D' :=
begin
  intro h,
  cases' D with D,
  cases' D' with D',
  simp at *,
  exact h
end

@[simps] instance : has_coe (matrix_representation n G) (G → invertible_matrix n) :=
{ coe := matrix_representation.f }

@[simps] instance : has_coe_to_fun (matrix_representation n G) (λ_, G → invertible_matrix n) :=
{ coe := λD, D.f }

@[simps] instance : representation G ℂ (vec n) :=
{ map := λ(x : G), (D.f x).to_linear_operator,
  id_mapped := begin
    cases' D,
    apply linear_map.ext,
    intro x,
    simp [id_mapped]
  end,
  mul_mapped := begin
    cases' D,
    intros z₁ z₂,
    apply linear_map.ext,
    intro x,
    simp *,
    have h := mul_mapped z₁ z₂,
    simp [invertible_matrix.mul] at h,
    have h₂ := iff.elim_left subtype.ext_iff_val h,
    simp at h₂,
    rw ←h₂
  end }

/- ## Equivalent Representations -/

@[simp] def is_equivalent (D D' : matrix_representation n G) : Prop :=
  ∃(A : invertible_matrix n), ∀(z : G), D.f z = A⁻¹ * (D'.f z) * A

lemma is_equivalent_symm (D D' : matrix_representation n G) :
  is_equivalent D D' → is_equivalent D' D :=
begin
  intro h,
  cases' h,
  use w⁻¹,
  intro z,
  rw h z,
  rw mul_assoc,
  rw mul_assoc,
  rw mul_right_inv,
  rw ←mul_assoc,
  rw ←mul_assoc,
  rw mul_left_inv,
  rw one_mul,
  rw mul_one
end

lemma is_equivalent_iff (D D' : matrix_representation n G) :
  is_equivalent D D' ↔ is_equivalent D' D :=
iff.intro (is_equivalent_symm D D') (is_equivalent_symm D' D)

@[simp] def is_unitary : Prop :=
  ∀(z : G), (D.f z).is_unitary

/- ## Reducible Representations -/

/- **Similarity Transformation** is noncomputable because it depends on
  the group inv lemmas.-/
@[simp] noncomputable def similarity_transformation
     (S : invertible_matrix n)
  : matrix_representation n G :=
{ f := λ(z : G), S⁻¹ * (D.f z) * S,
  id_mapped := begin
    cases' D,
    simp only [id_mapped],
    rw mul_one,
    rw mul_left_inv
  end,
  mul_mapped := begin
    cases' D,
    intros z₁ z₂,
    simp only,
    rw ←mul_mapped,
    calc S⁻¹ * f z₁ * S * (S⁻¹ * f z₂ * S) = S⁻¹ * f z₁ * (S * S⁻¹) * f z₂ * S
        : begin
          rw ←mul_assoc,
          rw ←mul_assoc,
          rw mul_assoc _ S S⁻¹
        end
      ... = S⁻¹ * f z₁ * 1 * f z₂ * S
        : by rw mul_right_inv
      ... = S⁻¹ * f z₁ * f z₂ * S
        : by rw mul_one
      ... = S⁻¹ * (f z₁ * f z₂) * S
        : by rw mul_assoc S⁻¹ _ _
  end }

@[simp] def is_reducible_by (P : square_matrix n) : Prop :=
  ∀(x : G), P * (D.f x).val * P = (D.f x).val * P

@[simp] def is_reducible : Prop :=
  ∃(P : square_matrix n), is_reducible_by D P

@[simp] def is_irreducible : Prop :=
  ¬is_reducible D

def is_block_diagonal : Prop :=
  ∀z, ∃(A : block_diagonal), A.length - 1 = n → (D.f z).val = A.to_matrix_n n

@[simp] def is_completely_reducible : Prop :=
  ∃(D' : matrix_representation n G), is_equivalent D D' ∧ is_block_diagonal D'

/- TODO -/
@[simp] lemma orthogonal_completely_reducible
    (P : square_matrix n) (h : D.is_completely_reducible) :
  D.is_reducible_by P → D.is_reducible_by (1 - P) :=
sorry

noncomputable def irreducible_representation (h : D.is_completely_reducible)
  : matrix_representation n G :=
classical.some h

end matrix_representation

end FG


import plane_separation_world.level01 --hide
open IncidencePlane --hide

/-
# Plane Separation World

## Level 2: another version of the previous level.

If you managed to solve the previous level, then you know how to prove this lemma with flying colours. Use the same structure as Level 1 to complete this
level by your own. But be careful! Later on, we may need to use them both, so make sure you understand what they mean!
-/

/- Hint : Click here for a hint, in case you get stuck.
Remember to adapt the code from the previous level. Still bewildered? Click on "View source" (located on the top right
corner of the game screen) to see the solution.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide
variables {A B C P Q R : Ω} --hide
variables {ℓ r s t : Line Ω} --hide

/- Lemma :
If the segment P·Q is on the same side of a line ℓ, then Q ∉ ℓ.
-/
lemma not_in_line_of_same_side_right (h : same_side ℓ A B) : B ∉ ℓ :=
begin
  unfold same_side at h,
  simp at h,
  by_contradiction h1,
  have h2 : B ∈ pts(A⬝B) ∩ ℓ,
  {
    split,
    simp [h1],
    simp [h1],
  },
  finish,
end