import Definitions.Def_NumberField_AdelicHaar open IsDedekindDomain IsDedekindDomain.HeightOneSpectrum NumberField RestrictedProduct open scoped Topology noncomputable section namespace NumberField.AdelicLevel variable (R K : Type*) [CommRing R] [IsDedekindDomain R] [Field K] [Algebra R K] [IsFractionRing R K] open scoped Classical in def idealBound (N : Ideal R) (v : HeightOneSpectrum R) : WithZero (Multiplicative ℤ) := if N = ⊥ then 0 else WithZero.exp (-((Associates.mk v.asIdeal).count (Associates.mk N).factors : ℤ)) section IdealBound variable {R} theorem idealBound_bot (v : HeightOneSpectrum R) : idealBound R ⊥ v = 0 := if_pos rfl theorem idealBound_of_ne_bot {N : Ideal R} (hN : N ≠ ⊥) (v : HeightOneSpectrum R) : idealBound R N v = WithZero.exp (-((Associates.mk v.asIdeal).count (Associates.mk N).factors : ℤ)) := by classical exact if_neg hN theorem idealBound_ne_zero {N : Ideal R} (hN : N ≠ ⊥) (v : HeightOneSpectrum R) : idealBound R N v ≠ 0 := by rw [idealBound_of_ne_bot hN]; exact WithZero.exp_ne_zero theorem idealBound_le_one (N : Ideal R) (v : HeightOneSpectrum R) : idealBound R N v ≤ 1 := by by_cases hN : N = ⊥ · rw [hN, idealBound_bot]; exact zero_le' · rw [idealBound_of_ne_bot hN, ← WithZero.exp_zero, WithZero.exp_le_exp] omega theorem idealBound_eq_one_of_not_dvd {N : Ideal R} (hN : N ≠ ⊥) {v : HeightOneSpectrum R} (hv : ¬ v.asIdeal ∣ N) : idealBound R N v = 1 := by classical rw [idealBound_of_ne_bot hN] have h0 : (Associates.mk v.asIdeal).count (Associates.mk N).factors = 0 := by by_contra h exact hv ((Associates.count_ne_zero_iff_dvd (show N ≠ 0 from hN) v.irreducible).mp h) rw [h0]; simp theorem idealBound_top (v : HeightOneSpectrum R) : idealBound R (⊤ : Ideal R) v = 1 := idealBound_eq_one_of_not_dvd top_ne_bot fun h => v.isPrime.ne_top ((Ideal.dvd_iff_le.mp h).antisymm le_top |>.symm ▸ rfl) theorem finite_setOf_idealBound_ne_one {N : Ideal R} (hN : N ≠ ⊥) : {v : HeightOneSpectrum R | idealBound R N v ≠ 1}.Finite := (Ideal.finite_factors hN).subset fun _ hv => by by_contra h exact hv (idealBound_eq_one_of_not_dvd hN h) end IdealBound section Local variable {R K} (v : HeightOneSpectrum R) theorem algebraMap_mem_adicCompletionIntegers (r : R) : algebraMap K (v.adicCompletion K) (algebraMap R K r) ∈ v.adicCompletionIntegers K := by rw [HeightOneSpectrum.mem_adicCompletionIntegers, show algebraMap K (v.adicCompletion K) (algebraMap R K r) = ((algebraMap R K r : K) : v.adicCompletion K) from rfl, HeightOneSpectrum.valuedAdicCompletion_eq_valuation'] exact v.valuation_le_one r theorem valued_algebraMap (r : R) : Valued.v (algebraMap K (v.adicCompletion K) (algebraMap R K r)) = v.intValuation r := by rw [show algebraMap K (v.adicCompletion K) (algebraMap R K r) = ((algebraMap R K r : K) : v.adicCompletion K) from rfl, HeightOneSpectrum.valuedAdicCompletion_eq_valuation', HeightOneSpectrum.valuation_of_algebraMap] theorem setOf_valued_le_eq_preimage (t : v.adicCompletion K) (ht : t ≠ 0) : {y : v.adicCompletion K | Valued.v y ≤ Valued.v t} = (fun y => y * t⁻¹) ⁻¹' (v.adicCompletionIntegers K : Set (v.adicCompletion K)) := by ext y simp only [Set.mem_setOf_eq, Set.mem_preimage, SetLike.mem_coe, HeightOneSpectrum.mem_adicCompletionIntegers, map_mul, map_inv₀] rw [mul_inv_le_iff₀ (zero_lt_iff.mpr ((Valuation.ne_zero_iff _).mpr ht)), one_mul] theorem isOpen_setOf_valued_le (t : v.adicCompletion K) (ht : t ≠ 0) : IsOpen {y : v.adicCompletion K | Valued.v y ≤ Valued.v t} := by rw [setOf_valued_le_eq_preimage v t ht] exact (continuous_id.mul continuous_const).isOpen_preimage _ (Valued.isOpen_valuationSubring _) theorem isClosed_adicCompletionIntegers : IsClosed (v.adicCompletionIntegers K : Set (v.adicCompletion K)) := Valued.isClosed_valuationSubring _ theorem isClosed_setOf_valued_le (t : v.adicCompletion K) (ht : t ≠ 0) : IsClosed {y : v.adicCompletion K | Valued.v y ≤ Valued.v t} := by rw [setOf_valued_le_eq_preimage v t ht] exact (isClosed_adicCompletionIntegers v).preimage (continuous_id.mul continuous_const) theorem exists_valued_eq_exp_neg (n : ℕ) : ∃ t : v.adicCompletion K, t ≠ 0 ∧ Valued.v t = WithZero.exp (-(n : ℤ)) := by obtain ⟨π, hπ⟩ := v.intValuation_exists_uniformizer refine ⟨(algebraMap K (v.adicCompletion K) (algebraMap R K π)) ^ n, ?_, ?_⟩ · refine pow_ne_zero _ fun h => ?_ have := valued_algebraMap (K := K) v π rw [h, map_zero, hπ] at this exact WithZero.exp_ne_zero this.symm · rw [map_pow, valued_algebraMap, hπ] induction n with | zero => simp | succ n ih => rw [pow_succ, ih, ← WithZero.exp_add]; congr 1; push_cast; ring theorem isOpen_setOf_valued_le_idealBound {N : Ideal R} (hN : N ≠ ⊥) : IsOpen {y : v.adicCompletion K | Valued.v y ≤ idealBound R N v} := by obtain ⟨t, ht, hvt⟩ := exists_valued_eq_exp_neg (K := K) v ((Associates.mk v.asIdeal).count (Associates.mk N).factors) rw [idealBound_of_ne_bot hN, ← hvt] exact isOpen_setOf_valued_le v t ht theorem isClosed_setOf_valued_le_idealBound (N : Ideal R) : IsClosed {y : v.adicCompletion K | Valued.v y ≤ idealBound R N v} := by by_cases hN : N = ⊥ · have : {y : v.adicCompletion K | Valued.v y ≤ idealBound R N v} = {0} := by ext y; simp [hN, idealBound_bot] rw [this]; exact isClosed_singleton · obtain ⟨t, ht, hvt⟩ := exists_valued_eq_exp_neg (K := K) v ((Associates.mk v.asIdeal).count (Associates.mk N).factors) rw [idealBound_of_ne_bot hN, ← hvt] exact isClosed_setOf_valued_le v t ht end Local section Projections def archEval (w : InfinitePlace K) : InfiniteAdeleRing K →+* w.Completion where toFun a := a w map_one' := rfl map_mul' _ _ := rfl map_zero' := rfl map_add' _ _ := rfl def finAdeleEval (v : HeightOneSpectrum R) : FiniteAdeleRing R K →+* v.adicCompletion K where toFun a := a v map_one' := rfl map_mul' _ _ := rfl map_zero' := rfl map_add' _ _ := rfl def adeleArch : AdeleRing R K →+* InfiniteAdeleRing K where toFun a := a.1 map_one' := rfl map_mul' _ _ := rfl map_zero' := rfl map_add' _ _ := rfl def adeleFin : AdeleRing R K →+* FiniteAdeleRing R K where toFun a := a.2 map_one' := rfl map_mul' _ _ := rfl map_zero' := rfl map_add' _ _ := rfl theorem archEval_apply (w : InfinitePlace K) (a : InfiniteAdeleRing K) : archEval K w a = a w := rfl theorem finAdeleEval_apply (v : HeightOneSpectrum R) (a : FiniteAdeleRing R K) : finAdeleEval R K v a = a v := rfl theorem adeleArch_apply (a : AdeleRing R K) : adeleArch R K a = a.1 := rfl theorem adeleFin_apply (a : AdeleRing R K) : adeleFin R K a = a.2 := rfl theorem continuous_archEval (w : InfinitePlace K) : Continuous (archEval K w) := (continuous_apply w : Continuous fun a : (∀ w : InfinitePlace K, w.Completion) => a w) theorem continuous_finAdeleEval (v : HeightOneSpectrum R) : Continuous (finAdeleEval R K v) := (RestrictedProduct.continuous_eval v : Continuous fun x : Πʳ w : HeightOneSpectrum R, [w.adicCompletion K, w.adicCompletionIntegers K] => x v) theorem continuous_adeleArch : Continuous (adeleArch R K) := (continuous_fst : Continuous fun x : AdeleRing R K => x.1) theorem continuous_adeleFin : Continuous (adeleFin R K) := (continuous_snd : Continuous fun x : AdeleRing R K => x.2) def archComponent (w : InfinitePlace K) : GL (Fin 2) (InfiniteAdeleRing K) →* GL (Fin 2) w.Completion := Matrix.GeneralLinearGroup.map (archEval K w) def finComponent (v : HeightOneSpectrum R) : GL (Fin 2) (FiniteAdeleRing R K) →* GL (Fin 2) (v.adicCompletion K) := Matrix.GeneralLinearGroup.map (finAdeleEval R K v) def glArch : GL (Fin 2) (AdeleRing R K) →* GL (Fin 2) (InfiniteAdeleRing K) := Matrix.GeneralLinearGroup.map (adeleArch R K) def glFin : GL (Fin 2) (AdeleRing R K) →* GL (Fin 2) (FiniteAdeleRing R K) := Matrix.GeneralLinearGroup.map (adeleFin R K) theorem archComponent_apply (w : InfinitePlace K) (g : GL (Fin 2) (InfiniteAdeleRing K)) (i j : Fin 2) : (archComponent K w g : Matrix (Fin 2) (Fin 2) w.Completion) i j = (g : Matrix (Fin 2) (Fin 2) (InfiniteAdeleRing K)) i j w := rfl theorem finComponent_apply (v : HeightOneSpectrum R) (g : GL (Fin 2) (FiniteAdeleRing R K)) (i j : Fin 2) : (finComponent R K v g : Matrix (Fin 2) (Fin 2) (v.adicCompletion K)) i j = (g : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K)) i j v := rfl theorem glArch_apply (g : GL (Fin 2) (AdeleRing R K)) (i j : Fin 2) : (glArch R K g : Matrix (Fin 2) (Fin 2) (InfiniteAdeleRing K)) i j = ((g : Matrix (Fin 2) (Fin 2) (AdeleRing R K)) i j).1 := rfl theorem glFin_apply (g : GL (Fin 2) (AdeleRing R K)) (i j : Fin 2) : (glFin R K g : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K)) i j = ((g : Matrix (Fin 2) (Fin 2) (AdeleRing R K)) i j).2 := rfl private theorem continuous_glMap {A B : Type*} [CommRing A] [CommRing B] [TopologicalSpace A] [TopologicalSpace B] [IsTopologicalRing A] [IsTopologicalRing B] (f : A →+* B) (hf : Continuous f) : Continuous (Matrix.GeneralLinearGroup.map (n := Fin 2) f) := Continuous.units_map _ ((continuous_id.matrix_map hf) : Continuous fun m : Matrix (Fin 2) (Fin 2) A => m.map f) theorem continuous_archComponent (w : InfinitePlace K) : Continuous (archComponent K w) := continuous_glMap _ (continuous_archEval K w) theorem continuous_finComponent (v : HeightOneSpectrum R) : Continuous (finComponent R K v) := continuous_glMap _ (continuous_finAdeleEval R K v) theorem continuous_glArch : Continuous (glArch R K) := continuous_glMap _ (continuous_adeleArch R K) theorem continuous_glFin : Continuous (glFin R K) := continuous_glMap _ (continuous_adeleFin R K) end Projections section FiniteAdelic def integralFiniteAdeles : Set (FiniteAdeleRing R K) := {x | ∀ v : HeightOneSpectrum R, x v ∈ v.adicCompletionIntegers K} def idealBall (N : Ideal R) : Set (FiniteAdeleRing R K) := {x | ∀ v : HeightOneSpectrum R, Valued.v (x v) ≤ idealBound R N v} variable {R K} section Coe variable (x y : FiniteAdeleRing R K) (v : HeightOneSpectrum R) theorem coe_zero_apply : (0 : FiniteAdeleRing R K) v = 0 := rfl theorem coe_one_apply : (1 : FiniteAdeleRing R K) v = 1 := rfl theorem coe_add_apply : (x + y) v = x v + y v := rfl theorem coe_mul_apply : (x * y) v = x v * y v := rfl theorem coe_sub_apply : (x - y) v = x v - y v := rfl theorem coe_neg_apply : (-x) v = -x v := rfl end Coe theorem idealBall_subset_integralFiniteAdeles (N : Ideal R) : idealBall R K N ⊆ integralFiniteAdeles R K := fun _ hx v => (HeightOneSpectrum.mem_adicCompletionIntegers _ _ _).mpr ((hx v).trans (idealBound_le_one N v)) theorem zero_mem_idealBall (N : Ideal R) : (0 : FiniteAdeleRing R K) ∈ idealBall R K N := fun v => by rw [coe_zero_apply, map_zero]; exact zero_le' variable (R K) theorem isOpen_integralFiniteAdeles : IsOpen (integralFiniteAdeles R K) := RestrictedProduct.isOpen_forall_mem (R := fun v : HeightOneSpectrum R => v.adicCompletion K) (A := fun v : HeightOneSpectrum R => (v.adicCompletionIntegers K : Set (v.adicCompletion K))) Fact.out theorem isClosed_integralFiniteAdeles : IsClosed (integralFiniteAdeles R K) := by have : integralFiniteAdeles R K = ⋂ v : HeightOneSpectrum R, (fun x : FiniteAdeleRing R K => x v) ⁻¹' (v.adicCompletionIntegers K : Set (v.adicCompletion K)) := by ext x; simp [integralFiniteAdeles] rw [this] exact isClosed_iInter fun v => (isClosed_adicCompletionIntegers v).preimage (continuous_finAdeleEval R K v) theorem isClosed_idealBall (N : Ideal R) : IsClosed (idealBall R K N) := by have : idealBall R K N = ⋂ v : HeightOneSpectrum R, (fun x : FiniteAdeleRing R K => x v) ⁻¹' {y | Valued.v y ≤ idealBound R N v} := by ext x; simp [idealBall] rw [this] exact isClosed_iInter fun v => (isClosed_setOf_valued_le_idealBound v N).preimage (continuous_finAdeleEval R K v) theorem isOpen_idealBall {N : Ideal R} (hN : N ≠ ⊥) : IsOpen (idealBall R K N) := by have hfin := finite_setOf_idealBound_ne_one hN have : idealBall R K N = integralFiniteAdeles R K ∩ ⋂ v ∈ {v : HeightOneSpectrum R | idealBound R N v ≠ 1}, (fun x : FiniteAdeleRing R K => x v) ⁻¹' {y | Valued.v y ≤ idealBound R N v} := by ext x simp only [Set.mem_inter_iff, Set.mem_iInter, Set.mem_preimage, Set.mem_setOf_eq] refine ⟨fun hx => ⟨idealBall_subset_integralFiniteAdeles N hx, fun v _ => hx v⟩, fun ⟨hint, hT⟩ v => ?_⟩ by_cases hv : idealBound R N v = 1 · rw [hv]; exact (HeightOneSpectrum.mem_adicCompletionIntegers _ _ _).mp (hint v) · exact hT v hv rw [this] exact (isOpen_integralFiniteAdeles R K).inter (hfin.isOpen_biInter fun v _ => (isOpen_setOf_valued_le_idealBound v hN).preimage (continuous_finAdeleEval R K v)) variable [Module.Free ℤ R] [Module.Finite ℤ R] theorem isCompact_integralFiniteAdeles : IsCompact (integralFiniteAdeles R K) := by haveI : ∀ v : HeightOneSpectrum R, CompactSpace ((v.adicCompletionIntegers K : Set (v.adicCompletion K))) := fun v => inferInstanceAs (CompactSpace (v.adicCompletionIntegers K)) have h := isCompact_range (RestrictedProduct.isOpenEmbedding_structureMap (R := fun v : HeightOneSpectrum R => v.adicCompletion K) (A := fun v : HeightOneSpectrum R => (v.adicCompletionIntegers K : Set (v.adicCompletion K))) Fact.out).continuous rw [RestrictedProduct.range_structureMap] at h exact h end FiniteAdelic section FiniteLevel structure IsLevelZeroMatrix (N : Ideal R) (m : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K)) : Prop where integral : ∀ i j, m i j ∈ integralFiniteAdeles R K lowerLeft : m 1 0 ∈ idealBall R K N structure IsLevelOneMatrix (N : Ideal R) (m : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K)) : Prop extends IsLevelZeroMatrix R K N m where lowerRight : m 1 1 - 1 ∈ idealBall R K N variable {R K} variable {N : Ideal R} theorem one_mem_integralFiniteAdeles : (1 : FiniteAdeleRing R K) ∈ integralFiniteAdeles R K := fun _ => one_mem _ theorem zero_mem_integralFiniteAdeles : (0 : FiniteAdeleRing R K) ∈ integralFiniteAdeles R K := fun _ => zero_mem _ theorem add_mem_integralFiniteAdeles {x y : FiniteAdeleRing R K} (hx : x ∈ integralFiniteAdeles R K) (hy : y ∈ integralFiniteAdeles R K) : x + y ∈ integralFiniteAdeles R K := fun v => add_mem (hx v) (hy v) theorem mul_mem_integralFiniteAdeles {x y : FiniteAdeleRing R K} (hx : x ∈ integralFiniteAdeles R K) (hy : y ∈ integralFiniteAdeles R K) : x * y ∈ integralFiniteAdeles R K := fun v => mul_mem (hx v) (hy v) theorem sub_mem_integralFiniteAdeles {x y : FiniteAdeleRing R K} (hx : x ∈ integralFiniteAdeles R K) (hy : y ∈ integralFiniteAdeles R K) : x - y ∈ integralFiniteAdeles R K := fun v => sub_mem (hx v) (hy v) theorem valued_apply_le_one {x : FiniteAdeleRing R K} (hx : x ∈ integralFiniteAdeles R K) (v : HeightOneSpectrum R) : Valued.v (x v) ≤ 1 := (HeightOneSpectrum.mem_adicCompletionIntegers _ _ _).mp (hx v) theorem add_mem_idealBall {x y : FiniteAdeleRing R K} (hx : x ∈ idealBall R K N) (hy : y ∈ idealBall R K N) : x + y ∈ idealBall R K N := fun v => (Valuation.map_add _ _ _).trans (max_le (hx v) (hy v)) theorem mul_mem_idealBall_left {x y : FiniteAdeleRing R K} (hx : x ∈ integralFiniteAdeles R K) (hy : y ∈ idealBall R K N) : x * y ∈ idealBall R K N := fun v => by rw [coe_mul_apply, map_mul] calc Valued.v (x v) * Valued.v (y v) ≤ 1 * idealBound R N v := mul_le_mul' (valued_apply_le_one hx v) (hy v) _ = idealBound R N v := one_mul _ theorem mul_mem_idealBall_right {x y : FiniteAdeleRing R K} (hx : x ∈ idealBall R K N) (hy : y ∈ integralFiniteAdeles R K) : x * y ∈ idealBall R K N := by rw [mul_comm]; exact mul_mem_idealBall_left hy hx namespace IsLevelZeroMatrix protected theorem one : IsLevelZeroMatrix R K N 1 where integral i j := by rw [Matrix.one_apply] split_ifs · exact one_mem_integralFiniteAdeles · exact zero_mem_integralFiniteAdeles lowerLeft := by rw [Matrix.one_apply_ne (by decide)] exact zero_mem_idealBall N variable {m m' : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K)} protected theorem mul (hm : IsLevelZeroMatrix R K N m) (hm' : IsLevelZeroMatrix R K N m') : IsLevelZeroMatrix R K N (m * m') where integral i j := by rw [Matrix.mul_apply, Fin.sum_univ_two] exact add_mem_integralFiniteAdeles (mul_mem_integralFiniteAdeles (hm.integral i 0) (hm'.integral 0 j)) (mul_mem_integralFiniteAdeles (hm.integral i 1) (hm'.integral 1 j)) lowerLeft := by rw [Matrix.mul_apply, Fin.sum_univ_two] exact add_mem_idealBall (mul_mem_idealBall_right hm.lowerLeft (hm'.integral 0 0)) (mul_mem_idealBall_left (hm.integral 1 1) hm'.lowerLeft) end IsLevelZeroMatrix namespace IsLevelOneMatrix protected theorem one : IsLevelOneMatrix R K N 1 where toIsLevelZeroMatrix := .one lowerRight := by rw [Matrix.one_apply_eq, sub_self] exact zero_mem_idealBall N variable {m m' : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K)} protected theorem mul (hm : IsLevelOneMatrix R K N m) (hm' : IsLevelOneMatrix R K N m') : IsLevelOneMatrix R K N (m * m') where toIsLevelZeroMatrix := hm.toIsLevelZeroMatrix.mul hm'.toIsLevelZeroMatrix lowerRight := by have h : (m * m') 1 1 - 1 = m 1 0 * m' 0 1 + ((m 1 1 - 1) * m' 1 1 + (m' 1 1 - 1)) := by rw [Matrix.mul_apply, Fin.sum_univ_two]; ring rw [h] exact add_mem_idealBall (mul_mem_idealBall_right hm.lowerLeft (hm'.integral 0 1)) (add_mem_idealBall (mul_mem_idealBall_right hm.lowerRight (hm'.integral 1 1)) hm'.lowerRight) end IsLevelOneMatrix variable (R K) (N) def finiteLevelZero : Subgroup (GL (Fin 2) (FiniteAdeleRing R K)) where carrier := {g | IsLevelZeroMatrix R K N (g : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K)) ∧ IsLevelZeroMatrix R K N ((g⁻¹ : GL (Fin 2) (FiniteAdeleRing R K)) : Matrix _ _ _)} one_mem' := ⟨by rw [Units.val_one]; exact .one, by rw [inv_one, Units.val_one]; exact .one⟩ mul_mem' ha hb := ⟨by rw [Units.val_mul]; exact ha.1.mul hb.1, by rw [mul_inv_rev, Units.val_mul]; exact hb.2.mul ha.2⟩ inv_mem' ha := ⟨ha.2, by rw [inv_inv]; exact ha.1⟩ def finiteLevelOne : Subgroup (GL (Fin 2) (FiniteAdeleRing R K)) where carrier := {g | IsLevelOneMatrix R K N (g : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K)) ∧ IsLevelOneMatrix R K N ((g⁻¹ : GL (Fin 2) (FiniteAdeleRing R K)) : Matrix _ _ _)} one_mem' := ⟨by rw [Units.val_one]; exact .one, by rw [inv_one, Units.val_one]; exact .one⟩ mul_mem' ha hb := ⟨by rw [Units.val_mul]; exact ha.1.mul hb.1, by rw [mul_inv_rev, Units.val_mul]; exact hb.2.mul ha.2⟩ inv_mem' ha := ⟨ha.2, by rw [inv_inv]; exact ha.1⟩ variable {R K N} theorem mem_finiteLevelZero_iff {g : GL (Fin 2) (FiniteAdeleRing R K)} : g ∈ finiteLevelZero R K N ↔ IsLevelZeroMatrix R K N (g : Matrix _ _ _) ∧ IsLevelZeroMatrix R K N ((g⁻¹ : GL (Fin 2) (FiniteAdeleRing R K)) : Matrix _ _ _) := Iff.rfl theorem mem_finiteLevelOne_iff {g : GL (Fin 2) (FiniteAdeleRing R K)} : g ∈ finiteLevelOne R K N ↔ IsLevelOneMatrix R K N (g : Matrix _ _ _) ∧ IsLevelOneMatrix R K N ((g⁻¹ : GL (Fin 2) (FiniteAdeleRing R K)) : Matrix _ _ _) := Iff.rfl variable (R K N) theorem finiteLevelOne_le_finiteLevelZero : finiteLevelOne R K N ≤ finiteLevelZero R K N := fun _ hg => ⟨hg.1.toIsLevelZeroMatrix, hg.2.toIsLevelZeroMatrix⟩ abbrev finiteIntegralGL2 : Subgroup (GL (Fin 2) (FiniteAdeleRing R K)) := finiteLevelZero R K ⊤ variable {R K} in theorem mem_finiteIntegralGL2_iff {g : GL (Fin 2) (FiniteAdeleRing R K)} : g ∈ finiteIntegralGL2 R K ↔ (∀ i j, (g : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K)) i j ∈ integralFiniteAdeles R K) ∧ ∀ i j, ((g⁻¹ : GL (Fin 2) (FiniteAdeleRing R K)) : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K)) i j ∈ integralFiniteAdeles R K := ⟨fun h => ⟨h.1.integral, h.2.integral⟩, fun h => ⟨⟨h.1, fun v => (idealBound_top v).symm ▸ valued_apply_le_one (h.1 1 0) v⟩, ⟨h.2, fun v => (idealBound_top v).symm ▸ valued_apply_le_one (h.2 1 0) v⟩⟩⟩ theorem isClosed_setOf_isLevelZeroMatrix : IsClosed {m : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K) | IsLevelZeroMatrix R K N m} := by have : {m : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K) | IsLevelZeroMatrix R K N m} = (⋂ i, ⋂ j, (fun m => m i j) ⁻¹' integralFiniteAdeles R K) ∩ (fun m => m 1 0) ⁻¹' idealBall R K N := by ext m simp only [Set.mem_setOf_eq, Set.mem_inter_iff, Set.mem_iInter, Set.mem_preimage] exact ⟨fun h => ⟨h.integral, h.lowerLeft⟩, fun h => ⟨h.1, h.2⟩⟩ rw [this] exact (isClosed_iInter fun i => isClosed_iInter fun j => (isClosed_integralFiniteAdeles R K).preimage (continuous_id.matrix_elem i j)).inter ((isClosed_idealBall R K N).preimage (continuous_id.matrix_elem 1 0)) theorem isClosed_setOf_isLevelOneMatrix : IsClosed {m : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K) | IsLevelOneMatrix R K N m} := by have : {m : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K) | IsLevelOneMatrix R K N m} = {m | IsLevelZeroMatrix R K N m} ∩ (fun m => m 1 1 - 1) ⁻¹' idealBall R K N := by ext m simp only [Set.mem_setOf_eq, Set.mem_inter_iff, Set.mem_preimage] exact ⟨fun h => ⟨h.toIsLevelZeroMatrix, h.lowerRight⟩, fun h => ⟨h.1, h.2⟩⟩ rw [this] exact (isClosed_setOf_isLevelZeroMatrix R K N).inter ((isClosed_idealBall R K N).preimage ((continuous_id.matrix_elem 1 1).sub continuous_const)) variable {N} in theorem isOpen_setOf_isLevelZeroMatrix (hN : N ≠ ⊥) : IsOpen {m : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K) | IsLevelZeroMatrix R K N m} := by have : {m : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K) | IsLevelZeroMatrix R K N m} = (⋂ i, ⋂ j, (fun m => m i j) ⁻¹' integralFiniteAdeles R K) ∩ (fun m => m 1 0) ⁻¹' idealBall R K N := by ext m simp only [Set.mem_setOf_eq, Set.mem_inter_iff, Set.mem_iInter, Set.mem_preimage] exact ⟨fun h => ⟨h.integral, h.lowerLeft⟩, fun h => ⟨h.1, h.2⟩⟩ rw [this] exact (isOpen_iInter_of_finite fun i => isOpen_iInter_of_finite fun j => (isOpen_integralFiniteAdeles R K).preimage (continuous_id.matrix_elem i j)).inter ((isOpen_idealBall R K hN).preimage (continuous_id.matrix_elem 1 0)) variable {N} in theorem isOpen_setOf_isLevelOneMatrix (hN : N ≠ ⊥) : IsOpen {m : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K) | IsLevelOneMatrix R K N m} := by have : {m : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K) | IsLevelOneMatrix R K N m} = {m | IsLevelZeroMatrix R K N m} ∩ (fun m => m 1 1 - 1) ⁻¹' idealBall R K N := by ext m simp only [Set.mem_setOf_eq, Set.mem_inter_iff, Set.mem_preimage] exact ⟨fun h => ⟨h.toIsLevelZeroMatrix, h.lowerRight⟩, fun h => ⟨h.1, h.2⟩⟩ rw [this] exact (isOpen_setOf_isLevelZeroMatrix R K hN).inter ((isOpen_idealBall R K hN).preimage ((continuous_id.matrix_elem 1 1).sub continuous_const)) variable {N} in theorem isOpen_finiteLevelZero (hN : N ≠ ⊥) : IsOpen (finiteLevelZero R K N : Set (GL (Fin 2) (FiniteAdeleRing R K))) := ((isOpen_setOf_isLevelZeroMatrix R K hN).preimage Units.continuous_val).inter ((isOpen_setOf_isLevelZeroMatrix R K hN).preimage Units.continuous_coe_inv) variable {N} in theorem isOpen_finiteLevelOne (hN : N ≠ ⊥) : IsOpen (finiteLevelOne R K N : Set (GL (Fin 2) (FiniteAdeleRing R K))) := ((isOpen_setOf_isLevelOneMatrix R K hN).preimage Units.continuous_val).inter ((isOpen_setOf_isLevelOneMatrix R K hN).preimage Units.continuous_coe_inv) theorem isClosed_finiteLevelZero : IsClosed (finiteLevelZero R K N : Set (GL (Fin 2) (FiniteAdeleRing R K))) := ((isClosed_setOf_isLevelZeroMatrix R K N).preimage Units.continuous_val).inter ((isClosed_setOf_isLevelZeroMatrix R K N).preimage Units.continuous_coe_inv) theorem isClosed_finiteLevelOne : IsClosed (finiteLevelOne R K N : Set (GL (Fin 2) (FiniteAdeleRing R K))) := ((isClosed_setOf_isLevelOneMatrix R K N).preimage Units.continuous_val).inter ((isClosed_setOf_isLevelOneMatrix R K N).preimage Units.continuous_coe_inv) section Compact variable [Module.Free ℤ R] [Module.Finite ℤ R] theorem isCompact_setOf_integral : IsCompact {g : GL (Fin 2) (FiniteAdeleRing R K) | (∀ i j, (g : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K)) i j ∈ integralFiniteAdeles R K) ∧ ∀ i j, ((g⁻¹ : GL (Fin 2) (FiniteAdeleRing R K)) : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K)) i j ∈ integralFiniteAdeles R K} := by set C : Set (Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K)) := {m | ∀ i j, m i j ∈ integralFiniteAdeles R K} with hC_def have hC : IsCompact C := by have hpi : C = Set.pi Set.univ fun _ : Fin 2 => Set.pi Set.univ fun _ : Fin 2 => integralFiniteAdeles R K := by ext m exact ⟨fun h i _ j _ => h i j, fun h i j => h i (Set.mem_univ _) j (Set.mem_univ _)⟩ rw [hpi] exact isCompact_univ_pi fun _ => isCompact_univ_pi fun _ => isCompact_integralFiniteAdeles R K have hK : IsCompact ((Units.embedProduct (Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K))) ⁻¹' (C ×ˢ (MulOpposite.op '' C))) := Units.isClosedEmbedding_embedProduct.isCompact_preimage (hC.prod (hC.image MulOpposite.continuous_op)) have heq : {g : GL (Fin 2) (FiniteAdeleRing R K) | (∀ i j, (g : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K)) i j ∈ integralFiniteAdeles R K) ∧ ∀ i j, ((g⁻¹ : GL (Fin 2) (FiniteAdeleRing R K)) : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K)) i j ∈ integralFiniteAdeles R K} = (Units.embedProduct (Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K))) ⁻¹' (C ×ˢ (MulOpposite.op '' C)) := by ext g simp only [Set.mem_setOf_eq, Set.mem_preimage, Units.embedProduct_apply, Set.mem_prod, Set.mem_image, hC_def] constructor · rintro ⟨h1, h2⟩; exact ⟨h1, _, h2, rfl⟩ · rintro ⟨h1, m, hm, hm'⟩ refine ⟨h1, ?_⟩ have : m = ((g⁻¹ : GL (Fin 2) (FiniteAdeleRing R K)) : Matrix (Fin 2) (Fin 2) (FiniteAdeleRing R K)) := MulOpposite.op_injective hm' rw [← this]; exact hm rw [heq]; exact hK theorem isCompact_finiteLevelZero : IsCompact (finiteLevelZero R K N : Set (GL (Fin 2) (FiniteAdeleRing R K))) := (isCompact_setOf_integral R K).of_isClosed_subset (isClosed_finiteLevelZero R K N) fun _ hg => ⟨hg.1.integral, hg.2.integral⟩ theorem isCompact_finiteLevelOne : IsCompact (finiteLevelOne R K N : Set (GL (Fin 2) (FiniteAdeleRing R K))) := (isCompact_finiteLevelZero R K N).of_isClosed_subset (isClosed_finiteLevelOne R K N) (finiteLevelOne_le_finiteLevelZero R K N) end Compact end FiniteLevel section Adelic variable (N : Ideal R) def levelZero : Subgroup (GL (Fin 2) (AdeleRing R K)) := (finiteLevelZero R K N).comap (glFin R K) def levelOne : Subgroup (GL (Fin 2) (AdeleRing R K)) := (finiteLevelOne R K N).comap (glFin R K) variable {R K N} theorem mem_levelZero_iff {g : GL (Fin 2) (AdeleRing R K)} : g ∈ levelZero R K N ↔ glFin R K g ∈ finiteLevelZero R K N := Iff.rfl theorem mem_levelOne_iff {g : GL (Fin 2) (AdeleRing R K)} : g ∈ levelOne R K N ↔ glFin R K g ∈ finiteLevelOne R K N := Iff.rfl variable (R K N) theorem levelOne_le_levelZero : levelOne R K N ≤ levelZero R K N := Subgroup.comap_mono (finiteLevelOne_le_finiteLevelZero R K N) variable {N} in theorem isOpen_levelZero (hN : N ≠ ⊥) : IsOpen (levelZero R K N : Set (GL (Fin 2) (AdeleRing R K))) := (isOpen_finiteLevelZero R K hN).preimage (continuous_glFin R K) variable {N} in theorem isOpen_levelOne (hN : N ≠ ⊥) : IsOpen (levelOne R K N : Set (GL (Fin 2) (AdeleRing R K))) := (isOpen_finiteLevelOne R K hN).preimage (continuous_glFin R K) theorem isClosed_levelZero : IsClosed (levelZero R K N : Set (GL (Fin 2) (AdeleRing R K))) := (isClosed_finiteLevelZero R K N).preimage (continuous_glFin R K) theorem isClosed_levelOne : IsClosed (levelOne R K N : Set (GL (Fin 2) (AdeleRing R K))) := (isClosed_finiteLevelOne R K N).preimage (continuous_glFin R K) end Adelic section Gen def diagOne {A : Type*} [CommRing A] : Aˣ →* GL (Fin 2) A where toFun a := { val := Matrix.diagonal ![(a : A), 1] inv := Matrix.diagonal ![((a⁻¹ : Aˣ) : A), 1] val_inv := by ext i j; fin_cases i <;> fin_cases j <;> simp inv_val := by ext i j; fin_cases i <;> fin_cases j <;> simp } map_one' := by ext i j; fin_cases i <;> fin_cases j <;> simp map_mul' a b := by ext i j; fin_cases i <;> fin_cases j <;> simp theorem diagOne_coe_apply {A : Type*} [CommRing A] (a : Aˣ) (i j : Fin 2) : (diagOne a : Matrix (Fin 2) (Fin 2) A) i j = Matrix.diagonal ![(a : A), 1] i j := rfl def finIncl : FiniteAdeleRing R K →* AdeleRing R K where toFun x := ((1 : InfiniteAdeleRing K), x) map_one' := rfl map_mul' _ _ := Prod.ext (one_mul _).symm rfl theorem finIncl_apply_fst (x : FiniteAdeleRing R K) : (finIncl R K x).1 = 1 := rfl theorem finIncl_apply_snd (x : FiniteAdeleRing R K) : (finIncl R K x).2 = x := rfl variable (v : HeightOneSpectrum R) open scoped Classical in def localUnit : (v.adicCompletion K)ˣ →* (FiniteAdeleRing R K)ˣ where toFun t := { val := ⟨Function.update 1 v (t : v.adicCompletion K), Filter.eventually_cofinite.mpr ((Set.finite_singleton v).subset fun w hw => by by_contra hwv exact hw (by rw [Function.update_of_ne hwv]; exact one_mem _))⟩ inv := ⟨Function.update 1 v ((t⁻¹ : (v.adicCompletion K)ˣ) : v.adicCompletion K), Filter.eventually_cofinite.mpr ((Set.finite_singleton v).subset fun w hw => by by_contra hwv exact hw (by rw [Function.update_of_ne hwv]; exact one_mem _))⟩ val_inv := by refine Subtype.ext (funext fun w => ?_) show Function.update (1 : ∀ w : HeightOneSpectrum R, w.adicCompletion K) v (t : v.adicCompletion K) w * Function.update (1 : ∀ w : HeightOneSpectrum R, w.adicCompletion K) v ((t⁻¹ : (v.adicCompletion K)ˣ) : v.adicCompletion K) w = 1 by_cases hw : w = v · subst hw; simp · simp [Function.update_of_ne hw] inv_val := by refine Subtype.ext (funext fun w => ?_) show Function.update (1 : ∀ w : HeightOneSpectrum R, w.adicCompletion K) v ((t⁻¹ : (v.adicCompletion K)ˣ) : v.adicCompletion K) w * Function.update (1 : ∀ w : HeightOneSpectrum R, w.adicCompletion K) v (t : v.adicCompletion K) w = 1 by_cases hw : w = v · subst hw; simp · simp [Function.update_of_ne hw] } map_one' := by refine Units.ext (Subtype.ext (funext fun w => ?_)) show Function.update (1 : ∀ w : HeightOneSpectrum R, w.adicCompletion K) v 1 w = 1 by_cases hw : w = v · subst hw; simp · simp [Function.update_of_ne hw] map_mul' t t' := by refine Units.ext (Subtype.ext (funext fun w => ?_)) show Function.update (1 : ∀ w : HeightOneSpectrum R, w.adicCompletion K) v ((t * t' : (v.adicCompletion K)ˣ) : v.adicCompletion K) w = Function.update (1 : ∀ w : HeightOneSpectrum R, w.adicCompletion K) v (t : v.adicCompletion K) w * Function.update (1 : ∀ w : HeightOneSpectrum R, w.adicCompletion K) v (t' : v.adicCompletion K) w by_cases hw : w = v · subst hw; simp · simp [Function.update_of_ne hw] open scoped Classical in theorem localUnit_apply_self (t : (v.adicCompletion K)ˣ) : ((localUnit R K v t : (FiniteAdeleRing R K)ˣ) : FiniteAdeleRing R K) v = t := by show Function.update (1 : ∀ w : HeightOneSpectrum R, w.adicCompletion K) v (t : v.adicCompletion K) v = t simp open scoped Classical in theorem localUnit_apply_of_ne (t : (v.adicCompletion K)ˣ) {w : HeightOneSpectrum R} (hw : w ≠ v) : ((localUnit R K v t : (FiniteAdeleRing R K)ˣ) : FiniteAdeleRing R K) w = 1 := by show Function.update (1 : ∀ w : HeightOneSpectrum R, w.adicCompletion K) v (t : v.adicCompletion K) w = 1 simp [Function.update_of_ne hw] def heckeGenAt : (v.adicCompletion K)ˣ →* GL (Fin 2) (AdeleRing R K) := diagOne.comp ((Units.map (finIncl R K)).comp (localUnit R K v)) variable {R K v} theorem heckeGenAt_fst (t : (v.adicCompletion K)ˣ) (i j : Fin 2) : ((heckeGenAt R K v t : Matrix (Fin 2) (Fin 2) (AdeleRing R K)) i j).1 = (1 : Matrix (Fin 2) (Fin 2) (InfiniteAdeleRing K)) i j := by fin_cases i <;> fin_cases j <;> rfl theorem heckeGenAt_snd_apply_of_ne (t : (v.adicCompletion K)ˣ) {w : HeightOneSpectrum R} (hw : w ≠ v) (i j : Fin 2) : ((heckeGenAt R K v t : Matrix (Fin 2) (Fin 2) (AdeleRing R K)) i j).2 w = (1 : Matrix (Fin 2) (Fin 2) (w.adicCompletion K)) i j := by fin_cases i <;> fin_cases j · show ((localUnit R K v t : (FiniteAdeleRing R K)ˣ) : FiniteAdeleRing R K) w = 1 exact localUnit_apply_of_ne R K v t hw · rfl · rfl · rfl theorem heckeGenAt_snd_apply_self (t : (v.adicCompletion K)ˣ) (i j : Fin 2) : ((heckeGenAt R K v t : Matrix (Fin 2) (Fin 2) (AdeleRing R K)) i j).2 v = Matrix.diagonal ![(t : v.adicCompletion K), 1] i j := by fin_cases i <;> fin_cases j · show ((localUnit R K v t : (FiniteAdeleRing R K)ˣ) : FiniteAdeleRing R K) v = t exact localUnit_apply_self R K v t · rfl · rfl · rfl theorem heckeGenAt_inv_mul_heckeGenAt_mem_levelOne (t t' : (v.adicCompletion K)ˣ) (h : Valued.v (t : v.adicCompletion K) = Valued.v (t' : v.adicCompletion K)) (N : Ideal R) : (heckeGenAt R K v t)⁻¹ * heckeGenAt R K v t' ∈ levelOne R K N := by rw [← map_inv, ← map_mul] set u : (v.adicCompletion K)ˣ := t⁻¹ * t' with hu have ht0 : Valued.v (t : v.adicCompletion K) ≠ 0 := (Valuation.ne_zero_iff _).mpr t.ne_zero have hu1 : Valued.v (u : v.adicCompletion K) = 1 := by rw [hu, Units.val_mul, Units.val_inv_eq_inv_val, map_mul, map_inv₀, h, ← h, inv_mul_cancel₀ ht0] have hui : Valued.v ((u⁻¹ : (v.adicCompletion K)ˣ) : v.adicCompletion K) = 1 := by rw [Units.val_inv_eq_inv_val, map_inv₀, hu1, inv_one] have hint : ∀ s : (v.adicCompletion K)ˣ, Valued.v (s : v.adicCompletion K) = 1 → ((localUnit R K v s : (FiniteAdeleRing R K)ˣ) : FiniteAdeleRing R K) ∈ integralFiniteAdeles R K := by intro s hs w classical by_cases hw : w = v · subst hw rw [localUnit_apply_self, HeightOneSpectrum.mem_adicCompletionIntegers, hs] · rw [localUnit_apply_of_ne R K v s hw]; exact one_mem _ have key : ∀ s : (v.adicCompletion K)ˣ, Valued.v (s : v.adicCompletion K) = 1 → IsLevelOneMatrix R K N (glFin R K (heckeGenAt R K v s) : Matrix _ _ _) := by intro s hs refine ⟨⟨fun i j => ?_, ?_⟩, ?_⟩ · fin_cases i <;> fin_cases j · exact hint s hs · exact zero_mem_integralFiniteAdeles · exact zero_mem_integralFiniteAdeles · exact one_mem_integralFiniteAdeles · exact zero_mem_idealBall N · show (1 : FiniteAdeleRing R K) - 1 ∈ idealBall R K N rw [sub_self]; exact zero_mem_idealBall N refine ⟨key u hu1, ?_⟩ rw [← map_inv, ← map_inv] exact key u⁻¹ hui variable (K v) def uniformizer : R := Classical.choose v.intValuation_exists_uniformizer theorem intValuation_uniformizer : v.intValuation (uniformizer v) = WithZero.exp (-1 : ℤ) := Classical.choose_spec v.intValuation_exists_uniformizer theorem valued_uniformizer : Valued.v (algebraMap K (v.adicCompletion K) (algebraMap R K (uniformizer v))) = WithZero.exp (-1 : ℤ) := by rw [valued_algebraMap, intValuation_uniformizer] def uniformizerUnit : (v.adicCompletion K)ˣ := Units.mk0 (algebraMap K (v.adicCompletion K) (algebraMap R K (uniformizer v))) fun h => by have := valued_uniformizer K v rw [h, map_zero] at this exact WithZero.exp_ne_zero this.symm theorem valued_uniformizerUnit : Valued.v (uniformizerUnit K v : v.adicCompletion K) = WithZero.exp (-1 : ℤ) := valued_uniformizer K v variable (R) def heckeGen : GL (Fin 2) (AdeleRing R K) := heckeGenAt R K v (uniformizerUnit K v) variable {R K v} theorem heckeGen_inv_mul_heckeGenAt_mem_levelOne (t : (v.adicCompletion K)ˣ) (ht : Valued.v (t : v.adicCompletion K) = WithZero.exp (-1 : ℤ)) (N : Ideal R) : (heckeGen R K v)⁻¹ * heckeGenAt R K v t ∈ levelOne R K N := heckeGenAt_inv_mul_heckeGenAt_mem_levelOne _ _ ((valued_uniformizerUnit K v).trans ht.symm) N end Gen end NumberField.AdelicLevel end