/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen

! This file was ported from Lean 3 source module ring_theory.trace
! leanprover-community/mathlib commit b68f3403d74afcfd65ab3fe65220572b410a3ed4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.Matrix.BilinearForm
import Mathbin.LinearAlgebra.Matrix.Charpoly.Minpoly
import Mathbin.LinearAlgebra.Determinant
import Mathbin.LinearAlgebra.FiniteDimensional
import Mathbin.LinearAlgebra.Vandermonde
import Mathbin.LinearAlgebra.Trace
import Mathbin.FieldTheory.IsAlgClosed.AlgebraicClosure
import Mathbin.FieldTheory.PrimitiveElement
import Mathbin.FieldTheory.Galois
import Mathbin.RingTheory.PowerBasis

/-!
# Trace for (finite) ring extensions.

Suppose we have an `R`-algebra `S` with a finite basis. For each `s : S`,
the trace of the linear map given by multiplying by `s` gives information about
the roots of the minimal polynomial of `s` over `R`.

## Main definitions

 * `algebra.trace R S x`: the trace of an element `s` of an `R`-algebra `S`
 * `algebra.trace_form R S`: bilinear form sending `x`, `y` to the trace of `x * y`
 * `algebra.trace_matrix R b`: the matrix whose `(i j)`-th element is the trace of `b i * b j`.
 * `algebra.embeddings_matrix A C b : matrix κ (B →ₐ[A] C) C` is the matrix whose
   `(i, σ)` coefficient is `σ (b i)`.
 * `algebra.embeddings_matrix_reindex A C b e : matrix κ κ C` is the matrix whose `(i, j)`
   coefficient is `σⱼ (b i)`, where `σⱼ : B →ₐ[A] C` is the embedding corresponding to `j : κ`
   given by a bijection `e : κ ≃ (B →ₐ[A] C)`.

## Main results

 * `trace_algebra_map_of_basis`, `trace_algebra_map`: if `x : K`, then `Tr_{L/K} x = [L : K] x`
 * `trace_trace_of_basis`, `trace_trace`: `Tr_{L/K} (Tr_{F/L} x) = Tr_{F/K} x`
 * `trace_eq_sum_roots`: the trace of `x : K(x)` is the sum of all conjugate roots of `x`
 * `trace_eq_sum_embeddings`: the trace of `x : K(x)` is the sum of all embeddings of `x` into an
   algebraically closed field
 * `trace_form_nondegenerate`: the trace form over a separable extension is a nondegenerate
   bilinear form

## Implementation notes

Typically, the trace is defined specifically for finite field extensions.
The definition is as general as possible and the assumption that we have
fields or that the extension is finite is added to the lemmas as needed.

We only define the trace for left multiplication (`algebra.left_mul_matrix`,
i.e. `linear_map.mul_left`).
For now, the definitions assume `S` is commutative, so the choice doesn't matter anyway.

## References

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

-/

universe u v w z

variable {R S T : Type _} [CommRing R] [CommRing S] [CommRing T]

variable [Algebra R S] [Algebra R T]

variable {K L : Type _} [Field K] [Field L] [Algebra K L]

variable {ι κ : Type w} [Fintype ι]

open FiniteDimensional

open LinearMap

open Matrix

open BigOperators

open Matrix

namespace Algebra

variable (b : Basis ι R S)

variable (R S)

/-- The trace of an element `s` of an `R`-algebra is the trace of `(*) s`,
as an `R`-linear map. -/
noncomputable def trace : S →ₗ[R] R :=
  (LinearMap.trace R S).comp (LinearMap.Algebra.lmul R S).toLinearMap
#align algebra.trace Algebra.trace

variable {S}

-- Not a `simp` lemma since there are more interesting ways to rewrite `trace R S x`,
-- for example `trace_trace`
theorem trace_apply (x) : trace R S x = LinearMap.trace R S (LinearMap.Algebra.lmul R S x) :=
  rfl
#align algebra.trace_apply Algebra.trace_apply

theorem trace_eq_zero_of_not_exists_basis (h : ¬∃ s : Finset S, Nonempty (Basis s R S)) :
    trace R S = 0 := by
  ext s
  simp [trace_apply, LinearMap.trace, h]
#align algebra.trace_eq_zero_of_not_exists_basis Algebra.trace_eq_zero_of_not_exists_basis

include b

variable {R}

-- Can't be a `simp` lemma because it depends on a choice of basis
theorem trace_eq_matrix_trace [DecidableEq ι] (b : Basis ι R S) (s : S) :
    trace R S s = Matrix.trace (Algebra.leftMulMatrix b s) :=
  by
  rw [trace_apply, LinearMap.trace_eq_matrix_trace _ b, ← to_matrix_lmul_eq]
  rfl
#align algebra.trace_eq_matrix_trace Algebra.trace_eq_matrix_trace

/-- If `x` is in the base field `K`, then the trace is `[L : K] * x`. -/
theorem trace_algebraMap_of_basis (x : R) : trace R S (algebraMap R S x) = Fintype.card ι • x :=
  by
  haveI := Classical.decEq ι
  rw [trace_apply, LinearMap.trace_eq_matrix_trace R b, Matrix.trace]
  convert Finset.sum_const _
  ext i
  simp [-coe_lmul_eq_mul]
#align algebra.trace_algebra_map_of_basis Algebra.trace_algebraMap_of_basis

omit b

/-- If `x` is in the base field `K`, then the trace is `[L : K] * x`.

(If `L` is not finite-dimensional over `K`, then `trace` and `finrank` return `0`.)
-/
@[simp]
theorem trace_algebraMap (x : K) : trace K L (algebraMap K L x) = finrank K L • x :=
  by
  by_cases H : ∃ s : Finset L, Nonempty (Basis s K L)
  · rw [trace_algebra_map_of_basis H.some_spec.some, finrank_eq_card_basis H.some_spec.some]
  · simp [trace_eq_zero_of_not_exists_basis K H, finrank_eq_zero_of_not_exists_basis_finset H]
#align algebra.trace_algebra_map Algebra.trace_algebraMap

theorem trace_trace_of_basis [Algebra S T] [IsScalarTower R S T] {ι κ : Type _} [Finite ι]
    [Finite κ] (b : Basis ι R S) (c : Basis κ S T) (x : T) :
    trace R S (trace S T x) = trace R T x :=
  by
  haveI := Classical.decEq ι
  haveI := Classical.decEq κ
  cases nonempty_fintype ι
  cases nonempty_fintype κ
  rw [trace_eq_matrix_trace (b.smul c), trace_eq_matrix_trace b, trace_eq_matrix_trace c,
    Matrix.trace, Matrix.trace, Matrix.trace, ← Finset.univ_product_univ, Finset.sum_product]
  refine' Finset.sum_congr rfl fun i _ => _
  simp only [AlgHom.map_sum, smul_left_mul_matrix, Finset.sum_apply,
    Matrix.diag,-- The unifier is not smart enough to apply this one by itself:
      Finset.sum_apply
      i _ fun y => left_mul_matrix b (left_mul_matrix c x y y)]
#align algebra.trace_trace_of_basis Algebra.trace_trace_of_basis

theorem trace_comp_trace_of_basis [Algebra S T] [IsScalarTower R S T] {ι κ : Type _} [Finite ι]
    [Fintype κ] (b : Basis ι R S) (c : Basis κ S T) :
    (trace R S).comp ((trace S T).restrictScalars R) = trace R T :=
  by
  ext
  rw [LinearMap.comp_apply, LinearMap.restrictScalars_apply, trace_trace_of_basis b c]
#align algebra.trace_comp_trace_of_basis Algebra.trace_comp_trace_of_basis

@[simp]
theorem trace_trace [Algebra K T] [Algebra L T] [IsScalarTower K L T] [FiniteDimensional K L]
    [FiniteDimensional L T] (x : T) : trace K L (trace L T x) = trace K T x :=
  trace_trace_of_basis (Basis.ofVectorSpace K L) (Basis.ofVectorSpace L T) x
#align algebra.trace_trace Algebra.trace_trace

@[simp]
theorem trace_comp_trace [Algebra K T] [Algebra L T] [IsScalarTower K L T] [FiniteDimensional K L]
    [FiniteDimensional L T] : (trace K L).comp ((trace L T).restrictScalars K) = trace K T :=
  by
  ext
  rw [LinearMap.comp_apply, LinearMap.restrictScalars_apply, trace_trace]
#align algebra.trace_comp_trace Algebra.trace_comp_trace

@[simp]
theorem trace_prod_apply [Module.Free R S] [Module.Free R T] [Module.Finite R S] [Module.Finite R T]
    (x : S × T) : trace R (S × T) x = trace R S x.fst + trace R T x.snd :=
  by
  nontriviality R
  let f := (lmul R S).toLinearMap.Prod_map (lmul R T).toLinearMap
  have : (lmul R (S × T)).toLinearMap = (prod_map_linear R S T S T R).comp f :=
    LinearMap.ext₂ Prod.mul_def
  simp_rw [trace, this]
  exact trace_prod_map' _ _
#align algebra.trace_prod_apply Algebra.trace_prod_apply

theorem trace_prod [Module.Free R S] [Module.Free R T] [Module.Finite R S] [Module.Finite R T] :
    trace R (S × T) = (trace R S).coprod (trace R T) :=
  LinearMap.ext fun p => by rw [coprod_apply, trace_prod_apply]
#align algebra.trace_prod Algebra.trace_prod

section TraceForm

variable (R S)

/-- The `trace_form` maps `x y : S` to the trace of `x * y`.
It is a symmetric bilinear form and is nondegenerate if the extension is separable. -/
noncomputable def traceForm : BilinForm R S :=
  (LinearMap.compr₂ (LinearMap.Algebra.lmul R S).toLinearMap (trace R S)).toBilin
#align algebra.trace_form Algebra.traceForm

variable {S}

-- This is a nicer lemma than the one produced by `@[simps] def trace_form`.
@[simp]
theorem traceForm_apply (x y : S) : traceForm R S x y = trace R S (x * y) :=
  rfl
#align algebra.trace_form_apply Algebra.traceForm_apply

theorem traceFormIsSymm : (traceForm R S).IsSymm := fun x y => congr_arg (trace R S) (mul_comm _ _)
#align algebra.trace_form_is_symm Algebra.traceFormIsSymm

theorem traceForm_toMatrix [DecidableEq ι] (i j) :
    BilinForm.toMatrix b (traceForm R S) i j = trace R S (b i * b j) := by
  rw [BilinForm.toMatrix_apply, trace_form_apply]
#align algebra.trace_form_to_matrix Algebra.traceForm_toMatrix

theorem traceForm_toMatrix_powerBasis (h : PowerBasis R S) :
    BilinForm.toMatrix h.Basis (traceForm R S) = of fun i j => trace R S (h.gen ^ (↑i + ↑j : ℕ)) :=
  by
  ext
  rw [trace_form_to_matrix, of_apply, pow_add, h.basis_eq_pow, h.basis_eq_pow]
#align algebra.trace_form_to_matrix_power_basis Algebra.traceForm_toMatrix_powerBasis

end TraceForm

end Algebra

section EqSumRoots

open Algebra Polynomial

variable {F : Type _} [Field F]

variable [Algebra K S] [Algebra K F]

/-- Given `pb : power_basis K S`, the trace of `pb.gen` is `-(minpoly K pb.gen).next_coeff`. -/
theorem PowerBasis.trace_gen_eq_nextCoeff_minpoly [Nontrivial S] (pb : PowerBasis K S) :
    Algebra.trace K S pb.gen = -(minpoly K pb.gen).nextCoeff :=
  by
  have d_pos : 0 < pb.dim := PowerBasis.dim_pos pb
  have d_pos' : 0 < (minpoly K pb.gen).natDegree := by simpa
  haveI : Nonempty (Fin pb.dim) := ⟨⟨0, d_pos⟩⟩
  rw [trace_eq_matrix_trace pb.basis, trace_eq_neg_charpoly_coeff, charpoly_leftMulMatrix, ←
    pb.nat_degree_minpoly, Fintype.card_fin, ← next_coeff_of_pos_nat_degree _ d_pos']
#align power_basis.trace_gen_eq_next_coeff_minpoly PowerBasis.trace_gen_eq_nextCoeff_minpoly

/-- Given `pb : power_basis K S`, then the trace of `pb.gen` is
`((minpoly K pb.gen).map (algebra_map K F)).roots.sum`. -/
theorem PowerBasis.trace_gen_eq_sum_roots [Nontrivial S] (pb : PowerBasis K S)
    (hf : (minpoly K pb.gen).Splits (algebraMap K F)) :
    algebraMap K F (trace K S pb.gen) = ((minpoly K pb.gen).map (algebraMap K F)).roots.Sum := by
  rw [PowerBasis.trace_gen_eq_nextCoeff_minpoly, RingHom.map_neg, ←
    next_coeff_map (algebraMap K F).Injective,
    sum_roots_eq_next_coeff_of_monic_of_split ((minpoly.monic (PowerBasis.isIntegral_gen _)).map _)
      ((splits_id_iff_splits _).2 hf),
    neg_neg]
#align power_basis.trace_gen_eq_sum_roots PowerBasis.trace_gen_eq_sum_roots

namespace IntermediateField.AdjoinSimple

open IntermediateField

/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
theorem trace_gen_eq_zero {x : L} (hx : ¬IsIntegral K x) :
    Algebra.trace K K⟮⟯ (AdjoinSimple.gen K x) = 0 :=
  by
  rw [trace_eq_zero_of_not_exists_basis, LinearMap.zero_apply]
  contrapose! hx
  obtain ⟨s, ⟨b⟩⟩ := hx
  refine' isIntegral_of_mem_of_fg K⟮⟯.toSubalgebra _ x _
  · exact (Submodule.fg_iff_finiteDimensional _).mpr (FiniteDimensional.of_fintype_basis b)
  · exact subset_adjoin K _ (Set.mem_singleton x)
#align intermediate_field.adjoin_simple.trace_gen_eq_zero IntermediateField.AdjoinSimple.trace_gen_eq_zero

/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
theorem trace_gen_eq_sum_roots (x : L) (hf : (minpoly K x).Splits (algebraMap K F)) :
    algebraMap K F (trace K K⟮⟯ (AdjoinSimple.gen K x)) =
      ((minpoly K x).map (algebraMap K F)).roots.Sum :=
  by
  have injKxL := (algebraMap K⟮⟯ L).Injective
  by_cases hx : IsIntegral K x
  swap
  · simp [minpoly.eq_zero hx, trace_gen_eq_zero hx]
  have hx' : IsIntegral K (adjoin_simple.gen K x) :=
    by
    rwa [← isIntegral_algebraMap_iff injKxL, adjoin_simple.algebra_map_gen]
    infer_instance
  rw [← adjoin.power_basis_gen hx, (adjoin.power_basis hx).trace_gen_eq_sum_roots] <;>
      rw [adjoin.power_basis_gen hx, minpoly.eq_of_algebraMap_eq injKxL hx'] <;>
    try simp only [adjoin_simple.algebra_map_gen _ _]
  exact hf
#align intermediate_field.adjoin_simple.trace_gen_eq_sum_roots IntermediateField.AdjoinSimple.trace_gen_eq_sum_roots

end IntermediateField.AdjoinSimple

open IntermediateField

variable (K)

/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
theorem trace_eq_trace_adjoin [FiniteDimensional K L] (x : L) :
    Algebra.trace K L x = finrank K⟮⟯ L • trace K K⟮⟯ (AdjoinSimple.gen K x) :=
  by
  rw [← @trace_trace _ _ K K⟮⟯ _ _ _ _ _ _ _ _ x]
  conv in x => rw [← IntermediateField.AdjoinSimple.algebraMap_gen K x]
  rw [trace_algebra_map, LinearMap.map_smul_of_tower]
#align trace_eq_trace_adjoin trace_eq_trace_adjoin

variable {K}

/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
theorem trace_eq_sum_roots [FiniteDimensional K L] {x : L}
    (hF : (minpoly K x).Splits (algebraMap K F)) :
    algebraMap K F (Algebra.trace K L x) =
      finrank K⟮⟯ L • ((minpoly K x).map (algebraMap K _)).roots.Sum :=
  by
  rw [trace_eq_trace_adjoin K x, Algebra.smul_def, RingHom.map_mul, ← Algebra.smul_def,
    IntermediateField.AdjoinSimple.trace_gen_eq_sum_roots _ hF, IsScalarTower.algebraMap_smul]
#align trace_eq_sum_roots trace_eq_sum_roots

end EqSumRoots

variable {F : Type _} [Field F]

variable [Algebra R L] [Algebra L F] [Algebra R F] [IsScalarTower R L F]

open Polynomial

theorem Algebra.isIntegral_trace [FiniteDimensional L F] {x : F} (hx : IsIntegral R x) :
    IsIntegral R (Algebra.trace L F x) :=
  by
  have hx' : IsIntegral L x := isIntegral_of_isScalarTower hx
  rw [← isIntegral_algebraMap_iff (algebraMap L (AlgebraicClosure F)).Injective, trace_eq_sum_roots]
  · refine' (IsIntegral.multiset_sum _).nsmul _
    intro y hy
    rw [mem_roots_map (minpoly.ne_zero hx')] at hy
    use minpoly R x, minpoly.monic hx
    rw [← aeval_def] at hy⊢
    exact minpoly.aeval_of_isScalarTower R x y hy
  · apply IsAlgClosed.splits_codomain
  · infer_instance
#align algebra.is_integral_trace Algebra.isIntegral_trace

section EqSumEmbeddings

variable [Algebra K F] [IsScalarTower K L F]

open Algebra IntermediateField

variable (F) (E : Type _) [Field E] [Algebra K E]

theorem trace_eq_sum_embeddings_gen (pb : PowerBasis K L)
    (hE : (minpoly K pb.gen).Splits (algebraMap K E)) (hfx : (minpoly K pb.gen).Separable) :
    algebraMap K E (Algebra.trace K L pb.gen) =
      (@Finset.univ (PowerBasis.AlgHom.fintype pb)).Sum fun σ => σ pb.gen :=
  by
  letI := Classical.decEq E
  rw [pb.trace_gen_eq_sum_roots hE, Fintype.sum_equiv pb.lift_equiv', Finset.sum_mem_multiset,
    Finset.sum_eq_multiset_sum, Multiset.toFinset_val, multiset.dedup_eq_self.mpr _,
    Multiset.map_id]
  · exact nodup_roots ((separable_map _).mpr hfx)
  · intro x
    rfl
  · intro σ
    rw [PowerBasis.liftEquiv'_apply_coe, id.def]
#align trace_eq_sum_embeddings_gen trace_eq_sum_embeddings_gen

variable [IsAlgClosed E]

theorem sum_embeddings_eq_finrank_mul [FiniteDimensional K F] [IsSeparable K F]
    (pb : PowerBasis K L) :
    (∑ σ : F →ₐ[K] E, σ (algebraMap L F pb.gen)) =
      finrank L F •
        (@Finset.univ (PowerBasis.AlgHom.fintype pb)).Sum fun σ : L →ₐ[K] E => σ pb.gen :=
  by
  haveI : FiniteDimensional L F := FiniteDimensional.right K L F
  haveI : IsSeparable L F := isSeparable_tower_top_of_isSeparable K L F
  letI : Fintype (L →ₐ[K] E) := PowerBasis.AlgHom.fintype pb
  letI : ∀ f : L →ₐ[K] E, Fintype (@AlgHom L F E _ _ _ _ f.to_ring_hom.to_algebra) := _
  -- will be solved by unification
  rw [Fintype.sum_equiv algHomEquivSigma (fun σ : F →ₐ[K] E => _) fun σ => σ.1 pb.gen, ←
    Finset.univ_sigma_univ, Finset.sum_sigma, ← Finset.sum_nsmul]
  refine' Finset.sum_congr rfl fun σ _ => _
  · letI : Algebra L E := σ.to_ring_hom.to_algebra
    simp only [Finset.sum_const, Finset.card_univ]
    rw [AlgHom.card L F E]
  · intro σ
    simp only [algHomEquivSigma, Equiv.coe_fn_mk, AlgHom.restrictDomain, AlgHom.comp_apply,
      IsScalarTower.coe_to_alg_hom']
#align sum_embeddings_eq_finrank_mul sum_embeddings_eq_finrank_mul

/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
theorem trace_eq_sum_embeddings [FiniteDimensional K L] [IsSeparable K L] {x : L} :
    algebraMap K E (Algebra.trace K L x) = ∑ σ : L →ₐ[K] E, σ x :=
  by
  have hx := IsSeparable.isIntegral K x
  rw [trace_eq_trace_adjoin K x, Algebra.smul_def, RingHom.map_mul, ← adjoin.power_basis_gen hx,
    trace_eq_sum_embeddings_gen E (adjoin.power_basis hx) (IsAlgClosed.splits_codomain _), ←
    Algebra.smul_def, algebraMap_smul]
  · exact (sum_embeddings_eq_finrank_mul L E (adjoin.power_basis hx)).symm
  · haveI := isSeparable_tower_bot_of_isSeparable K K⟮⟯ L
    exact IsSeparable.separable K _
#align trace_eq_sum_embeddings trace_eq_sum_embeddings

theorem trace_eq_sum_automorphisms (x : L) [FiniteDimensional K L] [IsGalois K L] :
    algebraMap K L (Algebra.trace K L x) = ∑ σ : L ≃ₐ[K] L, σ x :=
  by
  apply NoZeroSMulDivisors.algebraMap_injective L (AlgebraicClosure L)
  rw [map_sum (algebraMap L (AlgebraicClosure L))]
  rw [← Fintype.sum_equiv (Normal.algHomEquivAut K (AlgebraicClosure L) L)]
  · rw [← trace_eq_sum_embeddings (AlgebraicClosure L)]
    · simp only [algebra_map_eq_smul_one, smul_one_smul]
    · exact IsGalois.to_isSeparable
  · intro σ
    simp only [Normal.algHomEquivAut, AlgHom.restrictNormal', Equiv.coe_fn_mk,
      AlgEquiv.coe_ofBijective, AlgHom.restrictNormal_commutes, id.map_eq_id, RingHom.id_apply]
#align trace_eq_sum_automorphisms trace_eq_sum_automorphisms

end EqSumEmbeddings

section DetNeZero

namespace Algebra

variable (A : Type u) {B : Type v} (C : Type z)

variable [CommRing A] [CommRing B] [Algebra A B] [CommRing C] [Algebra A C]

open Finset

/-- Given an `A`-algebra `B` and `b`, an `κ`-indexed family of elements of `B`, we define
`trace_matrix A b` as the matrix whose `(i j)`-th element is the trace of `b i * b j`. -/
@[simp]
noncomputable def traceMatrix (b : κ → B) : Matrix κ κ A
  | i, j => traceForm A B (b i) (b j)
#align algebra.trace_matrix Algebra.traceMatrix

theorem traceMatrix_def (b : κ → B) : traceMatrix A b = of fun i j => traceForm A B (b i) (b j) :=
  rfl
#align algebra.trace_matrix_def Algebra.traceMatrix_def

theorem traceMatrix_reindex {κ' : Type _} (b : Basis κ A B) (f : κ ≃ κ') :
    traceMatrix A (b.reindex f) = reindex f f (traceMatrix A b) :=
  by
  ext (x y)
  simp
#align algebra.trace_matrix_reindex Algebra.traceMatrix_reindex

variable {A}

theorem traceMatrix_of_matrix_vecMul [Fintype κ] (b : κ → B) (P : Matrix κ κ A) :
    traceMatrix A ((P.map (algebraMap A B)).vecMul b) = Pᵀ ⬝ traceMatrix A b ⬝ P :=
  by
  ext (α β)
  rw [trace_matrix, vec_mul, dot_product, vec_mul, dot_product, Matrix.mul_apply,
    BilinForm.sum_left,
    Fintype.sum_congr _ _ fun i : κ =>
      @BilinForm.sum_right _ _ _ _ _ _ _ _ (b i * P.map (algebraMap A B) i α) fun y : κ =>
        b y * P.map (algebraMap A B) y β,
    sum_comm]
  congr ; ext x
  rw [Matrix.mul_apply, sum_mul]
  congr ; ext y
  rw [map_apply, trace_form_apply, mul_comm (b y), ← smul_def]
  simp only [id.smul_eq_mul, RingHom.id_apply, map_apply, transpose_apply, LinearMap.map_smulₛₗ,
    trace_form_apply, Algebra.smul_mul_assoc]
  rw [mul_comm (b x), ← smul_def]
  ring_nf
  simp [mul_comm]
#align algebra.trace_matrix_of_matrix_vec_mul Algebra.traceMatrix_of_matrix_vecMul

theorem traceMatrix_of_matrix_mulVec [Fintype κ] (b : κ → B) (P : Matrix κ κ A) :
    traceMatrix A ((P.map (algebraMap A B)).mulVec b) = P ⬝ traceMatrix A b ⬝ Pᵀ :=
  by
  refine' AddEquiv.injective (transpose_add_equiv _ _ _) _
  rw [transpose_add_equiv_apply, transpose_add_equiv_apply, ← vec_mul_transpose, ← transpose_map,
    trace_matrix_of_matrix_vec_mul, transpose_transpose, transpose_mul, transpose_transpose,
    transpose_mul]
#align algebra.trace_matrix_of_matrix_mul_vec Algebra.traceMatrix_of_matrix_mulVec

theorem traceMatrix_of_basis [Fintype κ] [DecidableEq κ] (b : Basis κ A B) :
    traceMatrix A b = BilinForm.toMatrix b (traceForm A B) :=
  by
  ext (i j)
  rw [trace_matrix, trace_form_apply, trace_form_to_matrix]
#align algebra.trace_matrix_of_basis Algebra.traceMatrix_of_basis

theorem traceMatrix_of_basis_mulVec (b : Basis ι A B) (z : B) :
    (traceMatrix A b).mulVec (b.equivFun z) = fun i => trace A B (z * b i) :=
  by
  ext i
  rw [← col_apply ((trace_matrix A b).mulVec (b.equiv_fun z)) i Unit.unit, col_mul_vec,
    Matrix.mul_apply, trace_matrix_def]
  simp only [col_apply, trace_form_apply]
  conv_lhs =>
    congr
    skip
    ext
    rw [mul_comm _ (b.equiv_fun z _), ← smul_eq_mul, of_apply, ← LinearMap.map_smul]
  rw [← LinearMap.map_sum]
  congr
  conv_lhs =>
    congr
    skip
    ext
    rw [← mul_smul_comm]
  rw [← Finset.mul_sum, mul_comm z]
  congr
  rw [b.sum_equiv_fun]
#align algebra.trace_matrix_of_basis_mul_vec Algebra.traceMatrix_of_basis_mulVec

variable (A)

/-- `embeddings_matrix A C b : matrix κ (B →ₐ[A] C) C` is the matrix whose `(i, σ)` coefficient is
  `σ (b i)`. It is mostly useful for fields when `fintype.card κ = finrank A B` and `C` is
  algebraically closed. -/
@[simp]
def embeddingsMatrix (b : κ → B) : Matrix κ (B →ₐ[A] C) C
  | i, σ => σ (b i)
#align algebra.embeddings_matrix Algebra.embeddingsMatrix

/-- `embeddings_matrix_reindex A C b e : matrix κ κ C` is the matrix whose `(i, j)` coefficient
  is `σⱼ (b i)`, where `σⱼ : B →ₐ[A] C` is the embedding corresponding to `j : κ` given by a
  bijection `e : κ ≃ (B →ₐ[A] C)`. It is mostly useful for fields and `C` is algebraically closed.
  In this case, in presence of `h : fintype.card κ = finrank A B`, one can take
  `e := equiv_of_card_eq ((alg_hom.card A B C).trans h.symm)`. -/
def embeddingsMatrixReindex (b : κ → B) (e : κ ≃ (B →ₐ[A] C)) :=
  reindex (Equiv.refl κ) e.symm (embeddingsMatrix A C b)
#align algebra.embeddings_matrix_reindex Algebra.embeddingsMatrixReindex

variable {A}

theorem embeddingsMatrixReindex_eq_vandermonde (pb : PowerBasis A B)
    (e : Fin pb.dim ≃ (B →ₐ[A] C)) :
    embeddingsMatrixReindex A C pb.Basis e = (vandermonde fun i => e i pb.gen)ᵀ :=
  by
  ext (i j)
  simp [embeddings_matrix_reindex, embeddings_matrix]
#align algebra.embeddings_matrix_reindex_eq_vandermonde Algebra.embeddingsMatrixReindex_eq_vandermonde

section Field

variable (K) {L} (E : Type z) [Field E]

variable [Algebra K E]

variable [Module.Finite K L] [IsSeparable K L] [IsAlgClosed E]

variable (b : κ → L) (pb : PowerBasis K L)

theorem traceMatrix_eq_embeddingsMatrix_mul_trans :
    (traceMatrix K b).map (algebraMap K E) = embeddingsMatrix K E b ⬝ (embeddingsMatrix K E b)ᵀ :=
  by
  ext (i j)
  simp [trace_eq_sum_embeddings, embeddings_matrix, Matrix.mul_apply]
#align algebra.trace_matrix_eq_embeddings_matrix_mul_trans Algebra.traceMatrix_eq_embeddingsMatrix_mul_trans

theorem traceMatrix_eq_embeddingsMatrixReindex_mul_trans [Fintype κ] (e : κ ≃ (L →ₐ[K] E)) :
    (traceMatrix K b).map (algebraMap K E) =
      embeddingsMatrixReindex K E b e ⬝ (embeddingsMatrixReindex K E b e)ᵀ :=
  by
  rw [trace_matrix_eq_embeddings_matrix_mul_trans, embeddings_matrix_reindex, reindex_apply,
    transpose_submatrix, ← submatrix_mul_transpose_submatrix, ← Equiv.coe_refl, Equiv.refl_symm]
#align algebra.trace_matrix_eq_embeddings_matrix_reindex_mul_trans Algebra.traceMatrix_eq_embeddingsMatrixReindex_mul_trans

end Field

end Algebra

open Algebra

variable (pb : PowerBasis K L)

theorem det_traceMatrix_ne_zero' [IsSeparable K L] : det (traceMatrix K pb.Basis) ≠ 0 :=
  by
  suffices algebraMap K (AlgebraicClosure L) (det (trace_matrix K pb.basis)) ≠ 0
    by
    refine' mt (fun ht => _) this
    rw [ht, RingHom.map_zero]
  haveI : FiniteDimensional K L := pb.finite_dimensional
  let e : Fin pb.dim ≃ (L →ₐ[K] AlgebraicClosure L) := (Fintype.equivFinOfCardEq _).symm
  rw [RingHom.map_det, RingHom.mapMatrix_apply,
    trace_matrix_eq_embeddings_matrix_reindex_mul_trans K _ _ e,
    embeddings_matrix_reindex_eq_vandermonde, det_mul, det_transpose]
  refine' mt mul_self_eq_zero.mp _
  · simp only [det_vandermonde, Finset.prod_eq_zero_iff, not_exists, sub_eq_zero]
    intro i _ j hij h
    exact (finset.mem_Ioi.mp hij).ne' (e.injective <| pb.alg_hom_ext h)
  · rw [AlgHom.card, pb.finrank]
#align det_trace_matrix_ne_zero' det_traceMatrix_ne_zero'

theorem det_traceForm_ne_zero [IsSeparable K L] [DecidableEq ι] (b : Basis ι K L) :
    det (BilinForm.toMatrix b (traceForm K L)) ≠ 0 :=
  by
  haveI : FiniteDimensional K L := FiniteDimensional.of_fintype_basis b
  let pb : PowerBasis K L := Field.powerBasisOfFiniteOfSeparable _ _
  rw [← BilinForm.toMatrix_mul_basis_toMatrix pb.basis b, ←
    det_comm' (pb.basis.to_matrix_mul_to_matrix_flip b) _, ← Matrix.mul_assoc, det_mul]
  swap; · apply Basis.toMatrix_mul_toMatrix_flip
  refine'
    mul_ne_zero
      (isUnit_of_mul_eq_one _ ((b.to_matrix pb.basis)ᵀ ⬝ b.to_matrix pb.basis).det _).NeZero _
  ·
    calc
      (pb.basis.to_matrix b ⬝ (pb.basis.to_matrix b)ᵀ).det *
            ((b.to_matrix pb.basis)ᵀ ⬝ b.to_matrix pb.basis).det =
          (pb.basis.to_matrix b ⬝ (b.to_matrix pb.basis ⬝ pb.basis.to_matrix b)ᵀ ⬝
              b.to_matrix pb.basis).det :=
        by simp only [← det_mul, Matrix.mul_assoc, Matrix.transpose_mul]
      _ = 1 := by
        simp only [Basis.toMatrix_mul_toMatrix_flip, Matrix.transpose_one, Matrix.mul_one,
          Matrix.det_one]

  simpa only [trace_matrix_of_basis] using det_traceMatrix_ne_zero' pb
#align det_trace_form_ne_zero det_traceForm_ne_zero

variable (K L)

theorem traceFormNondegenerate [FiniteDimensional K L] [IsSeparable K L] :
    (traceForm K L).Nondegenerate :=
  BilinForm.nondegenerateOfDetNeZero (traceForm K L) _
    (det_traceForm_ne_zero (FiniteDimensional.finBasis K L))
#align trace_form_nondegenerate traceFormNondegenerate

end DetNeZero


import data.real.irrational
import topology.basic
import algebra.order.floor

--OUTPUT 1
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- $\alpha$ is an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h1 : ∀ i j : ℤ, (i ≠ j) → (int.fract (α * ↑i) ≠ int.fract (α * ↑j)), from by auto [hα_irrat, int.fract_eq_iff.1],

  -- Hence,
  -- $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$
  -- is an infinite subset of $\left[0,1\right]$.
  have h2 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [int.fract_nonneg],
  have h3 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ≠ ∅, from by auto [int.fract_nonneg],
  have h4 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) = (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by auto [set.image_univ],

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h5 : ∃ x : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by auto [h2, h3, h4, set.closure_image_subset, set.closure_subset, set.subset.refl],

  -- One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h6 : ∀ (x y : ℝ), x ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → y ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → ∃ (x y : ℝ), x ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ y ∈ ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ abs (x - y) < ε, from by auto [h5, set.closure_iff_nhds, set.mem_nhds_iff],

  -- Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.
  have h7 : 0 ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by auto [h6, set.mem_closure_iff],

  -- To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.
  have h8 : ∀ (y : ℝ), y ∈ set.Icc 0 1 → ∃ (x : ℝ), x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ∧ abs (y - x) < ε, from by auto [h6, h7, set.mem_closure_iff],

  show closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1, from by auto [set.closure_eq_of_is_closed, h2, h8, set.mem_Icc_iff, set.is_closed_Icc]
end

--OUTPUT 2
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- $\alpha$ is irrational
  have h1 : irrational α, from hα_irrat,
  -- Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h2 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by auto [h1, int.fract_eq_iff_eq_int_mult],
  -- If this were not true, then
  have h3 : ∀ i j : ℤ, i ≠ j → (α * ↑i - int.nat_abs (α * ↑i)) ≠ (α * ↑j - int.nat_abs (α * ↑j)), from by auto [int.fract_eq_iff_eq_int_mult],
  -- Hence,
  have h4 : ∀ i j : ℤ, i ≠ j → (α * ↑i - int.nat_abs (α * ↑i)) ≠ (α * ↑j - int.nat_abs (α * ↑j)), from by auto [int.fract_eq_iff_eq_int_mult],
  -- $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$ is an infinite subset of $\left[0,1\right]$.
  have h5 : set.univ ℤ ≠ ∅, from by auto [set.univ_ne_empty],
  have h6 : (λ m : ℤ, (α * ↑m - int.nat_abs (α * ↑m))) '' set.univ ℤ ≠ ∅, from by auto [set.univ_ne_empty],
  have h7 : (λ m : ℤ, int.fract (α * ↑m)) '' set.univ ℤ ≠ ∅, from by auto [set.univ_ne_empty],
  have h8 : (λ m : ℤ, int.fract (α * ↑m)) '' set.univ ℤ ⊆ set.Icc 0 1, from by auto [set.mem_Icc],
  have h9 : ∀ i : ℤ, i ∈ set.univ ℤ → int.fract (α * ↑i) ∈ set.Icc 0 1, from by auto [set.mem_Icc],
  have h10 : ∀ i : ℤ, i ∈ set.univ ℤ → (α * ↑i - int.nat_abs (α * ↑i)) ∈ set.Icc 0 1, from by auto [set.mem_Icc],
  have h11 : ∀ i : ℤ, i ∈ set.univ ℤ → (α * ↑i - int.nat_abs (α * ↑i)) ∈ set.Icc 0 1, from by auto [set.mem_Icc],
  have h12 : (λ m : ℤ, int.fract (α * ↑m)) '' set.univ ℤ ⊆ set.Icc 0 1, from by auto [set.mem_Icc],
  have h13 : (λ m : ℤ, int.fract (α * ↑m)) '' set.univ ℤ ⊆ set.Icc 0 1, from by auto [set.mem_Icc],
  have h14 : (λ m : ℤ, int.fract (α * ↑m)) '' set.univ ℤ ⊆ set.Icc 0 1, from by auto [set.mem_Icc],
  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h15 : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ≠ ∅, from by auto [set.univ_ne_empty],
  have h16 : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) ⊆ set.Icc 0 1, from by auto [set.mem_Icc],
  have h17 : ∀ x : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → x ∈ set.Icc 0 1, from by auto [set.mem_Icc],
  have h18 : ∀ x : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → x ∈ set.Icc 0 1, from by auto [set.mem_Icc],
  have h19 : ∀ x : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → x ∈ set.Icc 0 1, from by auto [set.mem_Icc],
  -- One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h20 : ∀ x y : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → y ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → ∃ ε : ℝ, ε > 0 ∧ ∀ z : ℝ, z ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → abs (x - z) < ε ∧ abs (y - z) < ε, from by auto [set.mem_Icc],
  have h21 : ∀ x y : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → y ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → ∃ ε : ℝ, ε > 0 ∧ ∀ z : ℝ, z ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → abs (x - z) < ε ∧ abs (y - z) < ε, from by auto [set.mem_Icc],
  have h22 : ∀ x y : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → y ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → ∃ ε : ℝ, ε > 0 ∧ ∀ z : ℝ, z ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → abs (x - z) < ε ∧ abs (y - z) < ε, from by auto [set.mem_Icc],
  have h23 : ∀ x y : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → y ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → ∃ ε : ℝ, ε > 0 ∧ ∀ z : ℝ, z ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → abs (x - z) < ε ∧ abs (y - z) < ε, from by auto [set.mem_Icc],
  have h24 : ∀ x y : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → y ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) → ∃ ε : ℝ, ε > 0
end --Needs more than 2000 tokens!

--OUTPUT 3
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ (i j : ℤ), i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by auto [hα_irrat, int.fract_eq_iff],

  -- Hence, $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$ is an infinite subset of $\left[0,1\right]$.
  have h2 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [int.fract_nonneg, int.fract_lt_one],
  have h3 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ≠ ∅, from by auto [int.fract_nonneg, int.fract_lt_one],
  have h4 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ≠ ∅, from by auto [int.fract_nonneg, int.fract_lt_one],

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h5 : ∃ (x : ℝ), x ∈ set.Icc 0 1 ∧ x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by auto [h2, h3, h4, set.closure_eq_of_is_closed, set.is_closed_Icc],

  -- One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.
  have h6 : ∀ (x y : ℝ), x ∈ set.Icc 0 1 → y ∈ set.Icc 0 1 → x ≠ y → ∃ (z : ℝ), z ∈ set.Icc 0 1 ∧ z ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by auto [h1, int.fract_add],

  -- To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.
  have h7 : ∀ (y : ℝ), y ∈ set.Icc 0 1 → ∀ (ε : ℝ), ε > 0 → ∃ (z : ℝ), z ∈ set.Icc 0 1 ∧ z ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ), from by auto [h6, h5],

  show closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1, from by auto [h7, set.closure_eq_of_is_closed, set.is_closed_Icc],
end

--OUTPUT 4
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  -- $i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor$,
  -- which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$.
  have h1 : ∀ (i j : ℤ), (i ≠ j) → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by auto [int.fract_eq_iff, hα_irrat, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_iff, int.fract_eq_
end --Needs more than 2000 tokens!

--OUTPUT 5
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
  have h1 : ∀ i j : ℤ, (i ≠ j) → (int.fract (α * ↑i) ≠ int.fract (α * ↑j)), from
    by auto [int.fract_eq_of_fract_eq_fract, hα_irrat, int.fract_eq_iff_fract_eq, int.fract_eq_iff_fract_eq, int.fract_eq_iff_fract_eq, int.fract_eq_iff_fract_eq] using [irrational.irrational_iff_not_rat],

  -- Hence,
  -- $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$
  -- is an infinite subset of $\left[0,1\right]$.
  have h2 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ⊆ set.Icc 0 1, from by auto [int.fract_nonneg, int.fract_lt_one],

  have h3 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ≠ ∅, from by auto [int.fract_zero],

  have h4 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ∈ 𝒫 (set.Icc 0 1), from by auto [h2, set.mem_powerset],

  have h5 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ∩ set.Icc 0 1 ≠ ∅, from by auto [h3, set.inter_nonempty_iff],

  have h6 : (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ∩ set.Icc 0 1 ∈ 𝒫 (set.Icc 0 1), from by auto [h2, set.mem_powerset, set.inter_subset_left],

  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h7 : ∃ x : ℝ, x ∈ closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)), from by auto [h4, set.finite_powerset, h5, set.not_finite_iff_infinite, set.infinite_iff_nonempty_fiber],

  -- One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h8 : ∀ ε : ℝ, ε > 0 → ∃ (x y : ℝ), x ≠ y ∧ x ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ∧ y ∈ (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ) ∧ abs (x - y) < ε, from
    by auto [h7, set.closure_eq_of_is_closed, set.is_closed_Icc, set.is_open_Icc, set.is_open_inter, set.is_closed_inter, set.is_closed_Icc, set.is_open_Icc, h2, set.mem_powerset, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset_right, set.inter_subset_left, set.inter_subset
end --Needs more than 2000 tokens!

--OUTPUT 6
theorem irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
begin
  -- $\alpha$ is an irrational number.
  assume α_irrat : irrational α,
  -- Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$.
  have h1 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by auto [int.fract_ne_fract],
  -- If this were not true, then
  have h2 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) = int.fract (α * ↑j) → false, from by auto [h1],
  -- Hence,
  have h3 : ∀ i j : ℤ, i ≠ j → int.fract (α * ↑i) ≠ int.fract (α * ↑j), from by auto [h2],
  -- $S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}$
  let S : set ℝ := (λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ),
  -- is an infinite subset of $\left[0,1\right]$.
  have h4 : infinite S, from by auto [fintype.card_univ, set.finite.card_pos, set.card_image_lt, set.card_pos_iff, set.card_univ],
  -- By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$.
  have h5 : ∃ x ∈ set.Icc 0 1, x ∈ closure S, from by auto [h4, set.compact_Icc, set.compact_iff_seq_tendsto_nhds],
  -- One can thus find pairs of elements of $S$ that are arbitrarily close.
  have h6 : ∃ x y ∈ S, abs (x - y) < (1 : ℝ), from by auto [h5, set.mem_closure_iff, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self],
  -- Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.
  have h7 : 0 ∈ closure S, from by auto [h6, set.mem_closure_iff],
  -- To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$.
  have h8 : ∀ y : ℝ, y ∈ set.Icc 0 1 → ∀ ε : ℝ, ε > 0 → ∃ x ∈ S, abs (y - x) < ε, from by auto [h7, set.mem_closure_iff, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self],
  -- Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.
  have h9 : ∀ y : ℝ, y ∈ set.Icc 0 1 → ∀ ε : ℝ, ε > 0 → ∃ x ∈ S, abs (y - x) < ε, from by auto [h8, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_Icc_self, set.mem_
end --Needs more than 2000 tokens!

/- FEW SHOT PROMPTS TO CODEX(START)
/--`theorem`
Power Set is Closed under Intersection
Let $S$ be a set.

Let $\powerset S$ be the power set of $S$.

Then:
:$\forall A, B \in \powerset S: A \cap B \in \powerset S$
`proof`
Let $A, B \in \powerset S$.

Then by the definition of power set, $A \subseteq S$ and $B \subseteq S$.

From Intersection is Subset we have that $A \cap B \subseteq A$.

It follows from Subset Relation is Transitive that $A \cap B \subseteq S$.

Thus $A \cap B \in \powerset S$ and closure is proved.
{{qed}}
-/
theorem power_set_intersection_closed {α : Type*} (S : set α) : ∀ A B ∈ 𝒫 S, (A ∩ B) ∈ 𝒫 S :=
begin
  -- $A$ and $B$ are sets. $A$ and $B$ belong to power set of $S$
  assume (A : set α) (hA : A ∈ 𝒫 S) (B : set α) (hB : B ∈ 𝒫 S),
  -- Then $A ⊆ S$ and $B ⊆ S$, by power set definition
  have h1 : (A ⊆ S) ∧ (B ⊆ S), from by auto [set.subset_of_mem_powerset, set.subset_of_mem_powerset],
  -- Then $(A ∩ B) ⊆ A$, by intersection of set is a subset
  have h2 : (A ∩ B) ⊆ A, from by auto [set.inter_subset_left],
  -- Then $(A ∩ B) ⊆ S$, by subset relation is transitive
  have h3 : (A ∩ B) ⊆ S, from by auto [set.subset.trans],
  -- Hence $(A ∩ B) ∈  𝒫 S$, by power set definition
  show (A ∩ B) ∈  𝒫 S, from by auto [set.mem_powerset],
end

/--`theorem`
Square of Sum
 :$\forall x, y \in \R: \paren {x + y}^2 = x^2 + 2 x y + y^2$
`proof`
Follows from the distribution of multiplication over addition:

{{begin-eqn}}
{{eqn | l = \left({x + y}\right)^2
      | r = \left({x + y}\right) \cdot \left({x + y}\right)
}}
{{eqn | r = x \cdot \left({x + y}\right) + y \cdot \left({x + y}\right)
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x \cdot x + x \cdot y + y \cdot x + y \cdot y
      | c = Real Multiplication Distributes over Addition
}}
{{eqn | r = x^2 + 2xy + y^2
      | c =
}}
{{end-eqn}}
{{qed}}
-/
theorem square_of_sum (x y : ℝ) : (x + y)^2 = (x^2 + 2*x*y + y^2) :=
begin
  -- expand the power
  calc (x + y)^2 = (x+y)*(x+y) : by auto [sq]
  -- distributive property of multiplication over addition gives:
  ... = x*(x+y) + y*(x+y) : by auto [add_mul]
  -- applying the above property further gives:
  ... = x*x + x*y + y*x + y*y : by auto [mul_comm, add_mul] using [ring]
  -- rearranging the terms using commutativity and adding gives:
  ... = x^2 + 2*x*y + y^2 : by auto [sq, mul_comm] using [ring]
end

/--`theorem`
Identity of Group is Unique
Let $\struct {G, \circ}$ be a group. Then there is a unique identity element $e \in G$.
`proof`
From Group has Latin Square Property, there exists a unique $x \in G$ such that:
:$a x = b$

and there exists a unique $y \in G$ such that:
:$y a = b$

Setting $b = a$, this becomes:

There exists a unique $x \in G$ such that:
:$a x = a$

and there exists a unique $y \in G$ such that:
:$y a = a$

These $x$ and $y$ are both $e$, by definition of identity element.
{{qed}}
-/
theorem group_identity_unique {G : Type*} [group G] : ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a :=
begin
  -- Group has Latin Square Property
  have h1 : ∀ a b : G, ∃! x : G, a * x = b, from by auto using [use (a⁻¹ * b)],
  have h2 : ∀ a b : G, ∃! y : G, y * a = b, from by auto using [use b * a⁻¹],

  -- Setting $b = a$, this becomes:
  have h3 : ∀ a : G, ∃! x : G, a * x = a, from by auto [h1],
  have h4 : ∀ a : G, ∃! y : G, y * a = a, from by auto [h2],

  -- These $x$ and $y$ are both $(1 : G)$, by definition of identity element
  have h5 : ∀ a : G, classical.some (h3 a).exists = (1 : G), from by auto [exists_unique.unique, h3, classical.some_spec, exists_unique.exists, mul_one],
  have h6 : ∀ a : G, classical.some (h4 a).exists = (1 : G), from by auto [exists_unique.unique, h4, classical.some_spec, exists_unique.exists, one_mul],

  show ∃! e : G, ∀ a : G, e * a = a ∧ a * e = a, from by auto [h3, h4, exists_unique.unique, classical.some_spec, exists_unique.exists] using [use (1 : G)],
end

/--`theorem`
Density of irrational orbit
The fractional parts of the integer multiples of an irrational number form a dense subset of the unit interval
`proof`
Let $\alpha$ be an irrational number. Then for distinct $i, j \in \mathbb{Z}$, we must have $\{i \alpha\} \neq\{j \alpha\}$. If this were not true, then
$$
i \alpha-\lfloor i \alpha\rfloor=\{i \alpha\}=\{j \alpha\}=j \alpha-\lfloor j \alpha\rfloor,
$$
which yields the false statement $\alpha=\frac{\lfloor i \alpha\rfloor-\lfloor j \alpha\rfloor}{i-j} \in \mathbb{Q}$. Hence,
$$
S:=\{\{i \alpha\} \mid i \in \mathbb{Z}\}
$$
is an infinite subset of $\left[0,1\right]$.

By the Bolzano-Weierstrass theorem, $S$ has a limit point in $[0, 1]$. One can thus find pairs of elements of $S$ that are arbitrarily close. Since (the absolute value of) the difference of any two elements of $S$ is also an element of $S$, it follows that $0$ is a limit point of $S$.

To show that $S$ is dense in $[0, 1]$, consider $y \in[0,1]$, and $\epsilon>0$. Then by selecting $x \in S$ such that $\{x\}<\epsilon$ (which exists as $0$ is a limit point), and $N$ such that $N \cdot\{x\} \leq y<(N+1) \cdot\{x\}$, we get: $|y-\{N x\}|<\epsilon$.

QED
-/
theorem  irrational_orbit_dense {α : ℝ} (hα_irrat : irrational α) : closure ((λ m : ℤ, int.fract (α * ↑m)) '' (@set.univ ℤ)) = set.Icc 0 1 :=
FEW SHOT PROMPTS TO CODEX(END)-/


import tactic -- imports all the Lean tactics
import topology.continuous_function.compact -- continuous functions, compact sets
import topology.constructions
import topology.continuous_on
import topology.category.Top.epi_mono
import topology.path_connected
import data.set.lattice
import data.nat.basic
import topology.subset_properties
import topology.bases
import data.set.basic
import topology.constructions
import topology.separation

variables (X Y : Type) [topological_space X] [topological_space Y]

-- let S be a subset of X
variable (S : set X)

-- Let `f : X → Y` be a function
variables (f : X → Y)

-- X, Y are path connected space, then their product is path connected
example (h: path_connected_space X) (h1: path_connected_space Y):
  path_connected_space (X × Y) :=
begin
  rw path_connected_space_iff_univ at h h1 ⊢,
  unfold is_path_connected at h1 h ⊢,
  cases h with x hx,
  cases hx with h hx,
  cases h1 with y hy,
  cases hy with h1 hy,
  use (x, y),
  split,
  exact set.mem_univ (x, y),
  intro xy,
  have h2: xy.fst ∈ (set.univ: set X),
  exact set.mem_univ xy.fst,
  specialize hx h2,
  have h3: xy.snd ∈ (set.univ: set Y),
  exact set.mem_univ xy.snd,
  specialize hy h3,
  intro xyuniv,
  have h4: xy = (xy.fst, xy.snd),
  exact prod.ext rfl rfl,
  rw h4,
  unfold joined_in at hx hy ⊢,
  cases hy with p1 hy,
  cases hx with p2 hx,

  let p := path.prod p2 p1,
  use p,
  intro interval,
  specialize hx interval,
  specialize hy interval,
  exact set.mem_univ (p interval),
end

-- Show that if U is open in X and A is closed in X, then U − A is open in X, and
-- A − U is closed in X.
example (U : set X) (A : set X):
  is_open U ∧ is_closed A → is_open (U ∩ Aᶜ) ∧ is_closed (A ∩ Uᶜ) :=
begin
  intro h,cases h with h1 h2,
  split,
  {
    have claim: is_open Aᶜ,
    exact is_open_compl_iff.mpr h2,
    exact is_open.inter h1 claim,
  },
  {
    have claim: is_closed Uᶜ,
    exact is_closed_compl_iff.mpr h1,
    exact is_closed.inter h2 claim,
  },
end

-- a set u is open iff for all element x in it, there exist a neighborhood
-- of x that is contained in u.
lemma is_open_iff_nhds' (u: set Y):
  (∀ x ∈ u, (∃ v ∈ nhds x, v ⊆ u)) ↔ is_open u:=
begin
  split,
  {
    intro y,
    rw ← is_closed_compl_iff,
    rw is_closed_iff_nhds,
    intro x,
    specialize y x,
    intro h,
    change x ∈ u → false,
    intro xu,
    specialize y xu,
    cases y with v y,
    specialize h v,
    cases y with H y,
    specialize h H,
    exact set.inter_compl_nonempty_iff.mp h y,
  },
  {
    intro h,
    intro x,
    intro xu,
    use u,
    split,
    exact is_open.mem_nhds h xu,
    refl,
  },
end

-- if an element x is not in a subset u, then {x} and u are disjoint
lemma singleton_not_in {X: Type} (x: X) (u: set X):
  x ∉ u ↔ {x} ∩ u = ∅:=
begin
  split,
  intro hx,
  ext y,
  split,
  {
    intro hy,
    simp,
    change x ∈ u → false at hx,
    apply hx,
    cases hy with hyx hyu,
    cases hyx with hyx1 hyx2,
    exact hyu,

  },
  {
    intro h,
    exfalso,
    exact h,
  },

  exact set.singleton_inter_eq_empty.mp,

end

-- if u1 and u2 are disjoint and u3 subset of u2, then u1 and u3 are disjoint
lemma inter_empty_subset {X: Type} (u1: set X) (u2: set X) (u3: set X) :
  u1 ∩ u2 = ∅ ∧ u3 ⊆ u2 → u1 ∩ u3 = ∅ :=
begin
  intro h,
  cases h with h1 h2,
  ext x,
  split,
  {
    intro h3,
    cases h3 with h3 h4,
    have h5: x ∈ u2,
    exact h2 h4,
    have h6: x ∈ u1 ∩ u2,
    split,
    exact h3,
    exact h5,
    rw h1 at h6,
    exact h6,
  },
  {
    intro h,
    exfalso,
    exact h,
  },
end

-- X, Y topological space, if Y is compact, then projection map π1 is closed map
lemma projection_compact_closed (h: is_compact (set.univ: set Y)):
  (is_closed_map (@prod.fst X Y)):=
begin
  unfold is_closed_map,
  intro u,
  intro hu,
  -- want to show complement open
  -- enough to show for each element x in complement,
  -- there exists nhds of x contained in complement
  rw ← is_open_compl_iff,
  rw ← is_open_iff_nhds',
  intro x,
  intro hx,
  -- we can do this by using tube lemma
  -- WTS: there exists open v s.t. {x} x Y ⊆ v x Y ⊆ uᶜ
  -- To use tube lemma: we need
  -- 1. is_compact {x}
  -- 2. is_compact Y (we have it in h)
  -- 3. is_open uᶜ
  -- 4. {x} x Y ⊆ uᶜ
  have h1: is_compact {x}, -- 1
  refine is_compact_singleton,

  rw ← is_open_compl_iff at hu, -- 3

  -- we have x ∈ π1(u)ᶜ, WTS: {x} x Y ⊆ uᶜ
  have h2: set.prod {x} (set.univ: set Y) ⊆ uᶜ, -- 4
  rw set.subset_compl_iff_disjoint,
  rw set.mem_compl_iff at hx,
  have h3: set.prod {x} (set.univ: set Y) = prod.fst⁻¹' {x},
  refine set.prod_univ,
  exact X,
  exact set.has_singleton,
  rw h3,
  have h4: disjoint {x} (prod.fst '' u),
  exact set.disjoint_singleton_left.mpr hx,
  have h5: disjoint (prod.fst⁻¹' {x}) (prod.fst⁻¹' (prod.fst '' u)),
  refine disjoint.preimage prod.fst h4,
  exact Y,
  have h6: u ⊆ prod.fst⁻¹' (prod.fst '' u),
  exact set.subset_preimage_image prod.fst u,
  rw set.disjoint_iff_inter_eq_empty at h5,
  rw inter_empty_subset (prod.fst ⁻¹' {x}) (prod.fst ⁻¹' (prod.fst '' u)) u,
  split,
  exact h5,
  exact h6,

  -- use tube lemma (h3 is the result of tube lemma)
  have h3: ∃ (u1 : set X) (v1 : set Y), is_open u1 ∧ is_open v1 ∧ {x} ⊆ u1 ∧ (set.univ: set Y) ⊆ v1 ∧ set.prod u1 v1 ⊆ uᶜ,
  exact generalized_tube_lemma h1 h hu h2,

  cases h3 with u1 h3,
  use u1,
  cases h3 with v1 h3,
  cases h3 with hu1 h3,
  cases h3 with hv1 h3,
  cases h3 with hx1 h3,
  cases h3 with h3 h4,
  split,
  rw mem_nhds_iff,
  use u1,
  split,
  refl,
  split,
  exact hu1,
  exact set.singleton_subset_iff.mp hx1,
  -- prove u1 ⊆ π1(u)ᶜ
  have h5: v1 = (set.univ: set Y),
  rw ← set.univ_subset_iff,
  exact h3,
  rw h5 at h4,
  rw set.subset_compl_iff_disjoint at h4 ⊢,

  ext x1,
  split,
  {
    intro hx2,
    cases hx2 with hx2 hx3,
    -- WTS: if x1 ∈ u1 ∩ π1(u), ∃ x2 ∈ u1 x Y ∩ u = ∅
    have h6: ∃ x2 ∈ u, prod.fst x2 = x1, -- preimage
    exact set.mem_image_iff_bex.mp hx3,
    cases h6 with x2 h6,
    cases h6 with h6 h7,
    have h8: x2.fst ∈ u1,
    exact set.mem_of_eq_of_mem h7 hx2,
    have h9: x2.snd ∈ (set.univ: set Y),
    exact set.mem_univ x2.snd,
    have h10: (x2.fst, x2.snd) ∈ u1.prod set.univ,
    exact set.mk_mem_prod h8 h9,
    have h11: x2 = (x2.fst, x2.snd),
    exact prod.ext rfl rfl,
    rw ← h11 at h10,
    have h12: x2 ∈ u1.prod set.univ ∩ u,
    exact set.mem_inter h10 h6,
    rw h4 at h12,
    exfalso,
    exact h12,
  },
  {
    intro hx1,
    exfalso,
    exact hx1,
  },
end

def graph {X: Type} {Y: Type} (f: X → Y): set (X × Y) := {(x, f x)| x: X}

-- f: X → Y, Y compact Hausdorff
-- Then f is cts iff the graph of f is closed in X x Y.
lemma cts_map_closed_graph (h1: is_compact (set.univ: set Y)) (h2: t2_space Y):
  continuous f ↔ is_closed (graph f) :=
begin
  split,
  {
    intro h,
    rw ← is_open_compl_iff,
    rw ← is_open_iff_nhds',
    intro xy,
    intro hxy,
    have h3: xy = (xy.fst, xy.snd),
    exact prod.ext rfl rfl,
    rw h3 at hxy,
    have h4: xy.snd ≠ f xy.fst,
    intro h4,
    unfold graph at hxy,
    simp at hxy,
    specialize hxy xy.fst,
    rw h3 at hxy,
    apply hxy,
    rw h4,
    have h5: ∃ (u v : set Y), is_open u ∧ is_open v ∧ xy.snd ∈ u ∧ (f xy.fst) ∈ v ∧ (u ∩ v = ∅),
    exact t2_separation h4,
    cases h5 with u h5,
    cases h5 with v h5,
    cases h5 with hu h5,
    cases h5 with hv h5,
    cases h5 with hxyu h5,
    cases h5 with hxyv h5,
    have h6: is_open (f ⁻¹' u),
    exact continuous_def.mp h u hu,
    have h7: is_open (f ⁻¹' v),
    exact continuous_def.mp h v hv,
    have h8: is_open (set.prod (f ⁻¹' v) u),
    exact is_open.prod h7 hu,
    have claim: xy ∈ set.prod (f ⁻¹' v) u,
    simp,
    exact ⟨hxyv, hxyu⟩,
    use set.prod (f ⁻¹' v) u,
    split,
    exact is_open.mem_nhds h8 claim,
    rw set.subset_compl_iff_disjoint,
    unfold graph,
    ext a,
    split,
    {
      intro ha,
      cases ha with ha1 ha2,
      simp at ha2,
      cases ha2 with afst ha2,
      have ha3: afst = a.fst,
      exact (congr_arg prod.fst ha2).congr_right.mp rfl,
      rw ha3 at ha2,
      rw ← ha2 at ha1,
      simp at ha1,
      cases ha1 with ha ha1,
      have ha4: f a.fst ∈ u ∩ v,
      exact set.mem_inter ha1 ha,
      rw h5 at ha4,
      exact ha4,
    },
    {
      intro ha,
      exfalso,
      exact ha,
    },
  },
  {
    -- for x in X, s nhds of f(x), Gf ∩ X x (Y - v) closed
    -- π1(Gf ∩ X x (Y - v)) is closed and its compl = f ⁻¹ (s)
    intro h,
    rw continuous_def,
    intro s,
    intro hs,
    have h3: is_closed (set.prod (set.univ: set X) (sᶜ)),
    apply is_closed.prod,
    exact is_closed_univ,
    exact is_closed_compl_iff.mpr hs,
    let u: set (X × Y) := ((set.prod (set.univ: set X) (sᶜ)) ∩ graph f),
    have h4: is_closed u,
    exact is_closed.inter h3 h,
    have h5: is_closed_map (@prod.fst X Y),
    exact projection_compact_closed X Y h1,
    have h6: is_closed (prod.fst '' u),
    exact h5 u h4,
    have h7: prod.fst '' u = (f ⁻¹' s)ᶜ,
    ext x,
    split,
    {
      intro hx,
      intro hx1,
      rw set.mem_preimage at hx1,
      have h8: (x, f x) ∈ graph f,
      unfold graph,
      simp,
      have h11: ∃ a ∈ u, prod.fst a = x,
      exact set.mem_image_iff_bex.mp hx,
      cases h11 with a h11,
      cases h11 with ha h11,
      have h12: a = (a.fst, a.snd),
      exact prod.ext rfl rfl,
      have h13: a.snd = f x,

      rw h11 at h12,
      rw h12 at ha,
      have h10: (x, a.snd) ∈ graph f,
      exact set.mem_of_mem_inter_right ha,
      unfold graph at h10,
      simp at h10,
      exact eq.symm h10,
      rw [h11, h13] at h12,
      rw h12 at ha,
      cases ha with ha1 ha2,
      simp at ha1,
      exact ha1 hx1,
    },
    {
      intro hx,
      simp at hx,
      simp,
      use f x,
      split,
      exact hx,
      unfold graph,
      simp,
    },
    rw ← is_closed_compl_iff,
    rw ← h7,
    exact h6,
  },
end

example (h1: is_open_map f) (h2: function.surjective f) (h3: continuous f) :
  quotient_map f :=
begin
  exact is_open_map.to_quotient_map h1 h3 h2,
end

-- if f : X → Y is continuous, where X is compact and Y is Hausdorff,
-- then f is a closed map
example (h1: continuous f) (h2: is_compact (set.univ: set X)) (h3: t2_space Y) :
  is_closed_map f :=
begin
  unfold is_closed_map,
  intro u,
  intro closeu,
  have h4: u ⊆ (set.univ: set X),
  exact set.subset_univ u,
  have h5: is_compact u,
  exact compact_of_is_closed_subset h2 closeu h4,
  have h6: is_compact (f '' u),
  exact is_compact.image h5 h1,
  exact is_compact.is_closed h6,
end


import for_mathlib.Fintype
import pseudo_normed_group.basic
import Lbar.nnnorm_add_class

/-!
#  The standard filtration `c : ℝ≥0 ↦ {z : α | ∥z∥₊ ≤ c}`

Let `α` be a nnnormed type.  We use the naming convention `std_flt` for the function `ℝ≥0 → set α`
taking a non-negative real number `c` to the subset of all the terms of `α` of nnnorm at most `c`:
```
ℝ≥0 → set α
  c ↦ {z : α | ∥z∥₊ ≤ c}.
```
The main construction is `std_flt.to_pseudo_normed_group` asserting that the typeclass
`nnnorm_add_class α` (i.e. `α` is a Type with `∥_∥₊, 0, +, -` and compatibilities among them),
gives rise to a `pseudo_normed_group α` under the standard filtration.

We use `std_flt.to_pseudo_normed_group` to give a `pseudo_normed_group` instance on
`S → (ℕ →₀ ℤ)`.

For a fixed `r : ℝ≥0`, the nnnorm on `S → (ℕ →₀ ℤ)` is
`∥(s ↦ (n ↦ F s n))∥₊ = ∑ s : S, ∑ n in F.support, ∥F s n∥₊ * r⁻¹ ^ n`, where the sum is "really" a
finite sum, extending over all `s : S` and over `n : ℕ` contained in the (finite) support of `F n`.

The reason for this choice of nnnorm is that it arises as the nnnorm on the "non-positive tails" of
Laurent series, the kernel of the projection map from Laurent series to the series of their terms of
strictly positive degree.

##  Warning/Formalization note
We use the `nnnorm_add_class` instance on `S → (ℕ →₀ ℤ)` to prove that the standard filtration
determined a `pseudo_normed_group (S → (ℕ →₀ ℤ))`.  Note that the `semi_normed_group` instance on
the same type is *not* the same: the norm on finitely indexed finsupps for the `semi_normed_group`
is the `sup`norm and not the `sum_nnnorm`.
-/

open finset finsupp
open_locale nnreal big_operators

lemma mem_union_support_of_mem_support_add {α β : Type*} [add_zero_class β] [decidable_eq α] {k : α}
  (F G : α →₀ β) (hk : k ∈ (F + G).support) :
  k ∈ F.support ∪ G.support :=
begin
  simp only [finset.mem_union, finsupp.mem_support_iff, finsupp.coe_add, pi.add_apply] at ⊢ hk,
  contrapose! hk,
  simp only [hk, add_zero],
end

noncomputable theory

section std_flt_lemmas
variables (α : Type*) [has_nnnorm α]

lemma std_flt_mono ⦃c d : ℝ≥0⦄ (cd : c ≤ d) :
  {z : α | ∥z∥₊ ≤ c} ⊆ {z : α | ∥z∥₊ ≤ d} :=
λ x (hx : ∥x∥₊ ≤ c), hx.trans cd

lemma std_flt_zero_mem [has_zero α] (n0 : ∥(0 : α)∥₊ = 0) (c : ℝ≥0) :
  (0 : α) ∈ {z : α | ∥z∥₊ ≤ c} :=
by simp only [n0, set.mem_set_of_eq, zero_le']

lemma std_flt_neg_mem [has_neg α] (nn : ∀ {x : α}, ∥- x∥₊ = ∥x∥₊) ⦃c : ℝ≥0⦄ ⦃x : α⦄
  (xc : x ∈ {z : α | ∥z∥₊ ≤ c}) :
  - x ∈ {z : α | ∥z∥₊ ≤ c} :=
by simpa only [nn, set.mem_set_of_eq] using xc

lemma std_flt_add_mem [has_add α] (n_le : ∀ {x y : α}, ∥x + y∥₊ ≤ ∥x∥₊ + ∥y∥₊) ⦃c d : ℝ≥0⦄ ⦃x y : α⦄
  (xc : x ∈ {z : α | ∥z∥₊ ≤ c}) (yd : y ∈ {z : α | ∥z∥₊ ≤ d}) :
  x + y ∈ {z : α | ∥z∥₊ ≤ c + d} :=
n_le.trans (add_le_add xc yd)

open nnnorm_add_class
variable {α}

/--  Given a type `α` with a `nnnorm_add_class` instance, `std_flt.to_pseudo_normed_group`
shows that the standard filtration `λ c, {z : α | ∥z∥₊ ≤ c}` endows `α` with a
`pseudo_normed_group` class. -/
def std_flt.to_pseudo_normed_group [add_comm_group α] [nnnorm_add_class α] :
  pseudo_normed_group α :=
{ filtration          := λ c, {z : α | ∥z∥₊ ≤ c},
  filtration_mono     := std_flt_mono α,
  zero_mem_filtration := std_flt_zero_mem α nnn_zero,
  neg_mem_filtration  := std_flt_neg_mem α nnn_neg,
  add_mem_filtration  := std_flt_add_mem α nnn_add_le }

end std_flt_lemmas

/--  Let `r : ℝ≥0` be a non-negative real number.  `nnreal.normed r` or `r.normed` is the type of
finsupps `ℕ →₀ ℤ` with an extra parameter `r`.

The non-negative real number `r` is used in defining a norm on `r.normed`: given `F : ℕ →₀ ℤ`,
define `∥F∥₊ = ∑ x in F.support, ∥F x∥₊ * r⁻¹ ^ x`. -/
@[nolint unused_arguments, reducible, derive add_comm_group]
def nnreal.normed (r : ℝ≥0) := ℕ →₀ ℤ

namespace nnreal.normed
variables {r : ℝ≥0} (F G H : r.normed)

instance (r : ℝ≥0) : has_nnnorm r.normed :=
⟨λ F, ∑ x in F.support, ∥F x∥₊ * r⁻¹ ^ x⟩

@[simp]
lemma nnnorm_zero : ∥(0 : r.normed)∥₊ = 0 :=
by simp only [has_nnnorm.nnnorm, support_zero, sum_empty]

@[simp]
lemma nnnorm_neg : ∥-F∥₊ = ∥F∥₊ :=
by simp only [has_nnnorm.nnnorm, pi.neg_apply, finsupp.coe_neg, support_neg, norm_neg]

lemma nnnorm_add_le : ∥F + G∥₊ ≤ ∥F∥₊ + ∥G∥₊ :=
begin
  unfold nnnorm,
  rw [sum_subset (subset_union_left  F.support G.support),
      sum_subset (subset_union_right F.support G.support),
      sum_subset ((λ k, mem_union_support_of_mem_support_add F G) : _ ⊆ F.support ∪ G.support),
      ← finset.sum_add_distrib],
  { refine sum_le_sum (λ j hj, _),
    rw ← add_mul,
    exact mul_le_mul_of_nonneg_right (nnreal.coe_le_coe.mp (norm_add_le _ _)) (zero_le _) },
  repeat
  { simp only [mem_support_iff, not_not, norm_zero, mul_eq_zero, nonneg.mk_eq_zero,
      eq_self_iff_true, true_or, implies_true_iff] {contextual := true} }
end

instance : nnnorm_add_class r.normed :=
{ nnn_zero   := nnnorm_zero,
  nnn_neg    := nnnorm_neg,
  nnn_add_le := nnnorm_add_le,
  ..(infer_instance : add_comm_group _) }

instance : pseudo_normed_group r.normed :=
std_flt.to_pseudo_normed_group

end nnreal.normed

open nnnorm_add_class

variables {r : ℝ≥0} {α : Type*} [has_nnnorm α] {S : Fintype}

instance fintype.sum_nnnorm : has_nnnorm (S → α) :=
{ nnnorm := λ F, ∑ b, ∥F b∥₊ }

@[simp]
lemma fintype.sum_nnnorm_def (F : S → α) : ∥F∥₊ = ∑ b, ∥F b∥₊ := rfl

instance [add_group α] [nnnorm_add_class α] : nnnorm_add_class (S → α) :=
{ nnn_zero   := by simp,
  nnn_neg    := λ x, by simp [fintype.sum_nnnorm_def, pi.neg_apply, nnn_neg],
  nnn_add_le := λ F G, le_trans (sum_le_sum (λ j hj, nnnorm_add_le _ _)) sum_add_distrib.le,
  ..(infer_instance : add_comm_group _) }

/--  Let `r : ℝ≥0` be a non-negative real number and `S : Fintype` a finite type.
`invpoly' r S` is the type of `S`-indexed terms of type `r.normed`, that is, finsupps
`ℕ →₀ ℤ` with norm defined using `r⁻¹`. -/
@[derive add_comm_group]
def invpoly' (r : ℝ≥0) (S : Fintype) := S → r.normed

namespace invpoly'

instance : inhabited (invpoly' r S) := ⟨0⟩

instance : has_nnnorm (invpoly' r S) :=
@fintype.sum_nnnorm r.normed ⟨nnnorm⟩ S

instance : nnnorm_add_class (invpoly' r S) :=
pi.nnnorm_add_class

instance : pseudo_normed_group (invpoly' r S) :=
std_flt.to_pseudo_normed_group

end invpoly'