FenchelNielsenZomorrodian/Discrete/CompactFuchsian/PeriodOne/RelatorProofs.lean
1import FenchelNielsenZomorrodian.Discrete.CompactFuchsian.PeriodOne.SourceMaps
3/-
4PUBLIC_PAGE_SNAPSHOT
5generated_at: 2026-05-27T09:47:29+09:00
6lean_source: lean4/FenchelNielsenZomorrodian/Discrete/CompactFuchsian/PeriodOne/RelatorProofs.lean
7translation_root: data/translation
8purpose: identifies the local data snapshot used to build pages/
9placement: after imports, never before imports
10-/
11/-!
14Handles the cleanup of period-one target entries using quotient maps, kernel equivalences, low-cardinality dihedral cases, source subgroups, and relator proofs.
15-/
17open scoped BigOperators
19namespace FenchelNielsen
22 {tailLen p : ℕ}
23 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
24 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
25 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
26 (e :
27 OriginalFirstReductionIndex tailLen ≃
28 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
29 hTailLen).numPeriods)
30 (hperiods :
31 let source :=
32 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
33 ∀ x : OriginalFirstReductionIndex tailLen,
34 source.periods (e x) =
35 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
36 (hm₁'one : m₁' = 1) :
37 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
38 let source :=
39 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
40 let φ :=
42 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
44 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e : φ.ker) :
45 FreeGroup (FuchsianGenerator source)) ∈
47 classical
48 dsimp
49 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
50 let source :=
51 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
52 let φ :=
54 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
55 let x : FuchsianGenerator source :=
57 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
58 have hrel :
61 have hN :
64 Subgroup.subset_normalClosure hrel
65 have hPeriod : source.periods (e (.inl (0 : Fin 2))) = p := by
66 rw [hperiods (.inl (0 : Fin 2))]
67 simp only [originalFirstReductionPeriods, twoPeriods, Nat.reduceAdd, hm₁'one, mul_one, Fin.isValue,
68 Fin.cases_zero]
72private theorem originalFirstReductionPeriodOneSecondPowerKernel_pow_mem_sourceRelators_normalClosure
73 {tailLen p : ℕ}
74 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
75 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
76 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
77 (e :
78 OriginalFirstReductionIndex tailLen ≃
79 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
80 hTailLen).numPeriods)
81 (hperiods :
82 let source :=
83 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
84 ∀ x : OriginalFirstReductionIndex tailLen,
85 source.periods (e x) =
86 originalFirstReductionPeriods (p := p) m₁' m₂' tail x) :
87 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
88 let source :=
89 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
90 let φ :=
92 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
94 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e : φ.ker) ^ m₂' : φ.ker) :
95 FreeGroup (FuchsianGenerator source)) ∈
97 classical
98 dsimp
99 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
100 let source :=
101 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
102 let φ :=
104 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
105 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
106 have hrel :
109 have hN :
112 Subgroup.subset_normalClosure hrel
113 have hPeriod : source.periods (e (.inl (1 : Fin 2))) = p * m₂' := by
114 rw [hperiods (.inl (1 : Fin 2))]
115 simp only [originalFirstReductionPeriods, twoPeriods, Nat.reduceAdd, Fin.isValue, fin_cases_const_one]
116 change
118 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e : φ.ker) :
119 FreeGroup (FuchsianGenerator source)) ^ m₂') ∈
124private theorem originalFirstReductionPeriodOneTailKernelElement_pow_mem_sourceRelators_normalClosure
125 {tailLen p : ℕ}
126 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
127 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
128 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
129 (e :
130 OriginalFirstReductionIndex tailLen ≃
131 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
132 hTailLen).numPeriods)
133 (hperiods :
134 let source :=
135 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
136 ∀ x : OriginalFirstReductionIndex tailLen,
137 source.periods (e x) =
138 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
139 (j : Fin tailLen) (k : Fin p) :
140 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
141 let source :=
142 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
143 let φ :=
145 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
147 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k : φ.ker) ^ tail j : φ.ker) :
148 FreeGroup (FuchsianGenerator source)) ∈
150 classical
151 dsimp
152 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
153 let source :=
154 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
155 let φ :=
157 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
158 let x : FuchsianGenerator source :=
160 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
161 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inr j))
163 let t : FreeGroup (FuchsianGenerator source) := (FreeGroup.of x) ^ k.val
166 Subgroup.subset_normalClosure hrel
167 have hconj :
169 Subgroup.normalClosure_normal.conj_mem r hN t
170 have hPeriod : source.periods (e (.inr j)) = tail j := by
171 rw [hperiods (.inr j)]
172 simp only [originalFirstReductionPeriods]
173 change
175 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k : φ.ker) :
176 FreeGroup (FuchsianGenerator source)) ^ tail j) ∈
182 {tailLen p : ℕ}
183 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
184 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
185 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
186 (e :
187 OriginalFirstReductionIndex tailLen ≃
188 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
189 hTailLen).numPeriods)
190 (hperiods :
191 let source :=
192 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
193 ∀ x : OriginalFirstReductionIndex tailLen,
194 source.periods (e x) =
195 originalFirstReductionPeriods (p := p) m₁' m₂' tail x) :
196 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
197 let source :=
198 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
199 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
200 let ξ :=
202 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
203 let f := ellipticQuotientGeneratorImage source ξ
204 let T :=
206 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
207 let basis :=
209 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
210 (basis.symm
212 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e)) ^ m₂' ∈
213 Subgroup.normalClosure
215 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
216 classical
217 dsimp
218 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
219 let source :=
220 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
221 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
222 let ξ :=
224 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
225 let f := ellipticQuotientGeneratorImage source ξ
226 let φ :=
228 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
229 let T :=
231 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
232 let hT :=
234 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
235 let basis :=
237 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
238 let b :=
240 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
242 simpa [f, ξ, originalFirstReductionPeriodOneFreeQuotientHom] using
244 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
245 have hk :
246 ((b ^ m₂' : φ.ker) : FreeGroup (FuchsianGenerator source)) ∈
248 simpa [b, φ] using
250 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
251 have hmem :
252 basis.symm (b ^ m₂') ∈
253 Subgroup.normalClosure
255 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
256 simpa [basis, φ] using
257 ReidemeisterSchreier.Discrete.Presentations.freeGroupPullback_transversalRelator_mem_normalClosure_of_mem_normalClosure
258 hrels hT.1 basis hk
259 have hpow : (basis.symm b) ^ m₂' = basis.symm (b ^ m₂') :=
260 (map_pow basis.symm b m₂').symm
261 rw [hpow]
262 exact hmem
265 {tailLen p : ℕ}
266 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
267 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
268 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
269 (e :
270 OriginalFirstReductionIndex tailLen ≃
271 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
272 hTailLen).numPeriods)
273 (hperiods :
274 let source :=
275 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
276 ∀ x : OriginalFirstReductionIndex tailLen,
277 source.periods (e x) =
278 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
279 (hm₁'one : m₁' = 1) :
280 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
281 let source :=
282 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
283 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
284 let ξ :=
286 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
287 let f := ellipticQuotientGeneratorImage source ξ
288 let T :=
290 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
291 let basis :=
293 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
294 basis.symm
296 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e) ∈
297 Subgroup.normalClosure
299 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
300 classical
301 dsimp
302 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
303 let source :=
304 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
305 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
306 let ξ :=
308 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
309 let f := ellipticQuotientGeneratorImage source ξ
310 let φ :=
312 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
313 let T :=
315 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
316 let hT :=
318 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
319 let basis :=
321 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
322 let a :=
324 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
326 simpa [f, ξ, originalFirstReductionPeriodOneFreeQuotientHom] using
328 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
329 have hk :
330 ((a : φ.ker) : FreeGroup (FuchsianGenerator source)) ∈
332 simpa [a, φ] using
334 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods hm₁'one
335 simpa [basis, φ] using
336 ReidemeisterSchreier.Discrete.Presentations.freeGroupPullback_transversalRelator_mem_normalClosure_of_mem_normalClosure
337 hrels hT.1 basis hk
340 {tailLen p : ℕ}
341 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
342 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
343 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
344 (e :
345 OriginalFirstReductionIndex tailLen ≃
346 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
347 hTailLen).numPeriods)
348 (hperiods :
349 let source :=
350 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
351 ∀ x : OriginalFirstReductionIndex tailLen,
352 source.periods (e x) =
353 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
354 (j : Fin tailLen) (k : Fin p) :
355 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
356 let source :=
357 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
358 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
359 let ξ :=
361 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
362 let f := ellipticQuotientGeneratorImage source ξ
363 let T :=
365 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
366 let basis :=
368 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
369 (basis.symm
371 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k)) ^ tail j ∈
372 Subgroup.normalClosure
374 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
375 classical
376 dsimp
377 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
378 let source :=
379 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
380 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
381 let ξ :=
383 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
384 let f := ellipticQuotientGeneratorImage source ξ
385 let φ :=
387 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
388 let T :=
390 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
391 let hT :=
393 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
394 let basis :=
396 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
397 let c :=
399 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k
401 simpa [f, ξ, originalFirstReductionPeriodOneFreeQuotientHom] using
403 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
404 have hk :
405 ((c ^ tail j : φ.ker) : FreeGroup (FuchsianGenerator source)) ∈
407 simpa [c, φ] using
409 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods j k
410 have hmem :
411 basis.symm (c ^ tail j) ∈
412 Subgroup.normalClosure
414 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
415 simpa [basis, φ] using
416 ReidemeisterSchreier.Discrete.Presentations.freeGroupPullback_transversalRelator_mem_normalClosure_of_mem_normalClosure
417 hrels hT.1 basis hk
418 have hpow : (basis.symm c) ^ tail j = basis.symm (c ^ tail j) :=
419 (map_pow basis.symm c (tail j)).symm
420 rw [hpow]
421 exact hmem
423private theorem originalFirstReductionPeriodOneCanonicalSchreier_cyclicBlockTotalProduct_mem_normalClosure
424 {tailLen p : ℕ}
425 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
426 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
427 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen) :
428 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
429 let source :=
430 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
431 let e : OriginalFirstReductionIndex tailLen ≃ Fin source.numPeriods := by
432 simpa [source, originalFirstReductionSignature] using
434 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
435 let ξ :=
437 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
438 let f := ellipticQuotientGeneratorImage source ξ
439 let T :=
441 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
442 let basis :=
444 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
445 let a :=
447 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
448 let b :=
450 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
451 let c : Fin tailLen → Fin p →
455 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k
456 basis.symm a * basis.symm b *
457 (List.ofFn (fun k : Fin p =>
458 (List.ofFn (fun j : Fin tailLen => basis.symm (c j k))).prod)).prod ∈
459 Subgroup.normalClosure
461 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
462 classical
463 dsimp
464 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
465 let source :=
466 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
467 let e : OriginalFirstReductionIndex tailLen ≃ Fin source.numPeriods := by
468 simpa [source, originalFirstReductionSignature] using
470 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
471 let ξ :=
473 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
474 let f := ellipticQuotientGeneratorImage source ξ
475 let φ :=
477 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
478 let T :=
480 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
481 let hT :=
483 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
484 let basis :=
486 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
487 let x : FuchsianGenerator source :=
489 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
490 let y : FuchsianGenerator source :=
491 FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
492 let tailGen : Fin tailLen → FuchsianGenerator source := fun j =>
493 FuchsianGenerator.elliptic (e (.inr j))
494 let hperiods :
495 ∀ x : OriginalFirstReductionIndex tailLen,
496 source.periods (e x) =
497 originalFirstReductionPeriods (p := p) m₁' m₂' tail x := by
498 intro z
499 simpa [source, e] using
501 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen z
503 simpa [f, ξ, originalFirstReductionPeriodOneFreeQuotientHom] using
505 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
506 let a :=
508 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
509 let b :=
511 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
512 let c : Fin tailLen → Fin p → φ.ker := fun j k =>
514 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k
515 let kBlock : φ.ker :=
516 a * b *
517 (List.ofFn (fun k : Fin p =>
518 (List.ofFn (fun j : Fin tailLen => c j k)).prod)).prod
519 have hTailRel :
520 FreeGroup.of x * FreeGroup.of y *
521 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j))).prod ∈
523 have hTotal :=
525 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
526 have hTailEq :
527 totalRelation source =
528 FreeGroup.of x * FreeGroup.of y *
529 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j))).prod := by
532 originalFirstReductionOrderedIndexEquiv] using hTotal
533 rw [← hTailEq]
534 exact Subgroup.subset_normalClosure (Or.inr rfl)
535 have hSourceBlock :
536 (FreeGroup.of x) ^ p * (FreeGroup.of y) ^ p *
537 (List.ofFn (fun k : Fin p =>
538 (List.ofFn (fun j : Fin tailLen =>
539 (FreeGroup.of x) ^ (k : ℕ) * FreeGroup.of (tailGen j) *
540 ((FreeGroup.of x) ^ (k : ℕ))⁻¹)).prod)).prod ∈
542 simpa [x, y, tailGen] using
544 (FreeGroup.of x) (FreeGroup.of y)
545 (fun j : Fin tailLen => FreeGroup.of (tailGen j)) p hTailRel
546 have hBlockCoe :
547 (((List.ofFn (fun k : Fin p =>
548 (List.ofFn (fun j : Fin tailLen => c j k)).prod)).prod : φ.ker) :
549 FreeGroup (FuchsianGenerator source)) =
550 (List.ofFn (fun k : Fin p =>
551 (List.ofFn (fun j : Fin tailLen =>
552 ((c j k : φ.ker) : FreeGroup (FuchsianGenerator source)))).prod)).prod := by
553 simpa using
554 (MonoidHom.map_list_prod_ofFn₂ φ.ker.subtype
555 (fun k : Fin p => fun j : Fin tailLen => c j k))
556 have hkSource : (kBlock : FreeGroup (FuchsianGenerator source)) ∈
558 change
559 ((a : φ.ker) : FreeGroup (FuchsianGenerator source)) *
560 ((b : φ.ker) : FreeGroup (FuchsianGenerator source)) *
561 (((List.ofFn (fun k : Fin p =>
562 (List.ofFn (fun j : Fin tailLen => c j k)).prod)).prod : φ.ker) :
563 FreeGroup (FuchsianGenerator source)) ∈
565 rw [hBlockCoe]
568 simp only [c]
569 simpa [a, b, x, y, tailGen, originalFirstReductionPeriodOneDistinguishedGenerator,
571 using hSourceBlock
572 have hmem :
573 basis.symm kBlock ∈
574 Subgroup.normalClosure
576 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
577 exact
578 ReidemeisterSchreier.Discrete.Presentations.freeGroupPullback_transversalRelator_mem_normalClosure_of_mem_normalClosure
579 hrels hT.1 basis hkSource
580 have hBlockMap :
581 basis.symm ((List.ofFn (fun k : Fin p =>
582 (List.ofFn (fun j : Fin tailLen => c j k)).prod)).prod) =
583 (List.ofFn (fun k : Fin p =>
584 (List.ofFn (fun j : Fin tailLen => basis.symm (c j k))).prod)).prod := by
585 simpa using
586 (MonoidHom.map_list_prod_ofFn₂ basis.symm.toMonoidHom
587 (fun k : Fin p => fun j : Fin tailLen => c j k))
588 have hmem' :
589 basis.symm a * basis.symm b *
590 basis.symm
591 ((List.ofFn (fun k : Fin p =>
592 (List.ofFn (fun j : Fin tailLen => c j k)).prod)).prod) ∈
593 Subgroup.normalClosure
595 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
597 rw [hBlockMap] at hmem'
598 simpa [a, b, c, source, e, ξ, f, φ, T, hT, basis] using hmem'
601 {tailLen p : ℕ}
602 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
603 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
604 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
605 (e :
606 OriginalFirstReductionIndex tailLen ≃
607 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
608 hTailLen).numPeriods) :
609 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
610 let source :=
611 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
612 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
613 let x :=
615 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
616 let hT :=
618 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
619 schreierGenerator hT ((FreeGroup.of x) ^ (p - 1)) x =
621 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e := by
622 classical
623 dsimp
624 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
625 let source :=
626 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
627 let φ :=
629 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
630 let x : FuchsianGenerator source :=
632 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
633 have hx : φ (FreeGroup.of x) = Multiplicative.ofAdd (1 : ZMod p) := by
634 simpa [φ, x, originalFirstReductionPeriodOneDistinguishedGenerator] using
636 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
638 originalFirstReductionPeriodOneFirstPowerKernel, source, φ, x] using
641private theorem originalFirstReductionPeriodOne_distinguished_schreierGenerator_eq_one_of_succ_lt
642 {tailLen p : ℕ}
643 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
644 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
645 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
646 (e :
647 OriginalFirstReductionIndex tailLen ≃
648 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
649 hTailLen).numPeriods)
650 {k : ℕ} (hk : k + 1 < p) :
651 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
652 let source :=
653 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
654 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
655 let x :=
657 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
658 let hT :=
660 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
661 schreierGenerator hT ((FreeGroup.of x) ^ k) x = 1 := by
662 classical
663 dsimp
664 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
665 let source :=
666 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
667 let φ :=
669 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
670 let x : FuchsianGenerator source :=
672 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
673 have hx : φ (FreeGroup.of x) = Multiplicative.ofAdd (1 : ZMod p) := by
674 simpa [φ, x, originalFirstReductionPeriodOneDistinguishedGenerator] using
676 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
677 simpa [originalFirstReductionPeriodOneSchreierTransversal, source, φ, x] using
681 {tailLen p : ℕ}
682 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
683 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
684 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
685 (e :
686 OriginalFirstReductionIndex tailLen ≃
687 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
688 hTailLen).numPeriods) :
689 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
690 let source :=
691 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
692 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
693 let φ :=
695 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
696 let hT :=
698 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
700 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e : φ.ker) ∈
701 schreierGeneratorSet hT := by
702 classical
703 dsimp
704 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
705 let source :=
706 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
707 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
708 let φ :=
710 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
711 let x : FuchsianGenerator source :=
713 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
714 let T :=
716 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
717 let hT :=
719 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
720 refine ⟨(FreeGroup.of x) ^ (p - 1), ?_, x, ?_, ?_⟩
721 · have hx : φ (FreeGroup.of x) = Multiplicative.ofAdd (1 : ZMod p) := by
722 simpa [φ, x, originalFirstReductionPeriodOneDistinguishedGenerator] using
724 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
725 simpa [T, originalFirstReductionPeriodOneSchreierTransversal, source, φ, x] using
727 φ x hx (m := p - 1) (by omega)
728 · simpa [hT, source, φ, x] using
730 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e).symm
731 · intro h
732 have hval := congrArg
733 (fun z : φ.ker => (z : FreeGroup (FuchsianGenerator source))) h
734 have hpow : (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ p = 1 := by
735 simpa [source, φ, x, originalFirstReductionPeriodOneFirstPowerKernel,
737 exact freeGroup_of_pow_ne_one x (by omega) hpow
739private theorem originalFirstReductionPeriodOne_second_schreierGenerator_eq
740 {tailLen p : ℕ}
741 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
742 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
743 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
744 (e :
745 OriginalFirstReductionIndex tailLen ≃
746 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
747 hTailLen).numPeriods)
748 (k : Fin p) :
749 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
750 let source :=
751 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
752 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
753 let x :=
755 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
756 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
757 let hT :=
759 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
760 schreierGenerator hT ((FreeGroup.of x) ^ k.val) y =
762 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k := by
763 classical
764 dsimp
765 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
766 let source :=
767 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
768 let φ :=
770 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
771 let x : FuchsianGenerator source :=
773 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
774 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
775 have hx : φ (FreeGroup.of x) = Multiplicative.ofAdd (1 : ZMod p) := by
776 simpa [φ, x, originalFirstReductionPeriodOneDistinguishedGenerator] using
778 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
779 have hy : φ (FreeGroup.of y) = Multiplicative.ofAdd (-1 : ZMod p) := by
780 simpa [φ, y] using
782 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
784 originalFirstReductionPeriodOneSecondEdgeKernelElement, source, φ, x, y] using
785 cyclicQuotient_negOneImage_schreierGenerator_eq φ x y hx hy k
788 {tailLen p : ℕ}
789 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
790 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
791 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
792 (e :
793 OriginalFirstReductionIndex tailLen ≃
794 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
795 hTailLen).numPeriods)
796 (k : Fin p) :
797 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
798 let source :=
799 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
800 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
801 let φ :=
803 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
804 let hT :=
806 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
808 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k : φ.ker) ∈
809 schreierGeneratorSet hT := by
810 classical
811 dsimp
812 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
813 let source :=
814 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
815 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
816 let φ :=
818 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
819 let x : FuchsianGenerator source :=
821 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
822 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
823 let T :=
825 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
826 let hT :=
828 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
829 refine ⟨(FreeGroup.of x) ^ k.val, ?_, y, ?_, ?_⟩
830 · have hx : φ (FreeGroup.of x) = Multiplicative.ofAdd (1 : ZMod p) := by
831 simpa [φ, x, originalFirstReductionPeriodOneDistinguishedGenerator] using
833 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
834 simpa [T, originalFirstReductionPeriodOneSchreierTransversal, source, φ, x] using
836 φ x hx (m := k.val) k.isLt
837 · simpa [hT, source, φ, x, y] using
839 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k).symm
840 · intro h
841 have hval := congrArg
842 (fun z : φ.ker => (z : FreeGroup (FuchsianGenerator source))) h
843 let r : ℕ := ((k.val : ZMod p) - 1).val
844 have hsecondWord :
845 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
846 FreeGroup.of y *
847 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ r)⁻¹ = 1 := by
848 simpa [source, φ, x, y, r,
851 let χ : FuchsianGenerator source → Multiplicative ℤ :=
852 fun u => if u = y then Multiplicative.ofAdd (1 : ℤ) else 1
853 have hxne : x ≠ y := by
854 intro hEq
855 simp only [originalFirstReductionPeriodOneDistinguishedGenerator, Lean.Elab.WF.paramLet, Fin.isValue, id_eq,
856 FuchsianGenerator.elliptic.injEq, EmbeddingLike.apply_eq_iff_eq, Sum.inl.injEq, zero_ne_one, x, y] at hEq
857 have hmap := congrArg (FreeGroup.lift χ) hsecondWord
858 simp only [map_mul, map_pow, FreeGroup.lift_apply_of, hxne, ↓reduceIte, one_pow, one_mul, map_inv, inv_one,
861private theorem originalFirstReductionPeriodOne_tail_schreierGenerator_eq
862 {tailLen p : ℕ}
863 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
864 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
865 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
866 (e :
867 OriginalFirstReductionIndex tailLen ≃
868 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
869 hTailLen).numPeriods)
870 (j : Fin tailLen) (k : Fin p) :
871 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
872 let source :=
873 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
874 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
875 let x :=
877 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
878 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inr j))
879 let hT :=
881 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
882 schreierGenerator hT ((FreeGroup.of x) ^ k.val) y =
884 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k := by
885 classical
886 dsimp
887 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
888 let source :=
889 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
890 let φ :=
892 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
893 let x : FuchsianGenerator source :=
895 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
896 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inr j))
897 have hx : φ (FreeGroup.of x) = Multiplicative.ofAdd (1 : ZMod p) := by
898 simpa [φ, x, originalFirstReductionPeriodOneDistinguishedGenerator] using
900 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
901 have hy : φ (FreeGroup.of y) = 1 := by
902 simpa [φ, y] using
904 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j
906 originalFirstReductionPeriodOneTailKernelElement, source, φ, x, y] using
907 cyclicQuotient_trivialImage_schreierGenerator_eq_conj φ x y hx hy k
910 {tailLen p : ℕ}
911 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
912 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
913 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
914 (e :
915 OriginalFirstReductionIndex tailLen ≃
916 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
917 hTailLen).numPeriods)
918 (j : Fin tailLen) (k : Fin p) :
919 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
920 let source :=
921 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
922 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
923 let φ :=
925 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
926 let hT :=
928 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
930 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k : φ.ker) ∈
931 schreierGeneratorSet hT := by
932 classical
933 dsimp
934 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
935 let source :=
936 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
937 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
938 let φ :=
940 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
941 let x : FuchsianGenerator source :=
943 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
944 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inr j))
945 let T :=
947 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
948 let hT :=
950 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
951 refine ⟨(FreeGroup.of x) ^ k.val, ?_, y, ?_, ?_⟩
952 · have hx : φ (FreeGroup.of x) = Multiplicative.ofAdd (1 : ZMod p) := by
953 simpa [φ, x, originalFirstReductionPeriodOneDistinguishedGenerator] using
955 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
956 simpa [T, originalFirstReductionPeriodOneSchreierTransversal, source, φ, x] using
958 φ x hx (m := k.val) k.isLt
959 · simpa [hT, source, φ, x, y] using
961 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k).symm
962 · intro h
963 have hval := congrArg
964 (fun z : φ.ker => (z : FreeGroup (FuchsianGenerator source))) h
965 have htailWord :
966 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
967 FreeGroup.of y *
968 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ = 1 := by
969 simp only [originalFirstReductionPeriodOneTailKernelElement, Lean.Elab.WF.paramLet,
970 originalFirstReductionPeriodOneDistinguishedGenerator, Fin.isValue, id_eq, OneMemClass.coe_one, conj_eq_one_iff,
971 FreeGroup.of_ne_one, φ] at hval
972 let χ : FuchsianGenerator source → Multiplicative ℤ :=
973 fun u => if u = y then Multiplicative.ofAdd (1 : ℤ) else 1
974 have hxne : x ≠ y := by
975 intro hEq
976 simp only [originalFirstReductionPeriodOneDistinguishedGenerator, Lean.Elab.WF.paramLet, Fin.isValue, id_eq,
977 FuchsianGenerator.elliptic.injEq, EmbeddingLike.apply_eq_iff_eq, reduceCtorEq, x, y] at hEq
978 have hmap := congrArg (FreeGroup.lift χ) htailWord
979 simp only [map_mul, map_pow, FreeGroup.lift_apply_of, hxne, ↓reduceIte, one_pow, one_mul, map_inv, inv_one,
982private theorem originalFirstReductionPeriodOne_schreierGeneratorSet_cases
983 {tailLen p : ℕ}
984 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
985 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
986 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
987 (e :
988 OriginalFirstReductionIndex tailLen ≃
989 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
990 hTailLen).numPeriods) :
991 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
992 let source :=
993 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
994 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
995 let φ :=
997 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
998 let hT :=
1000 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1001 ∀ z : ↥(schreierGeneratorSet hT),
1002 (z : φ.ker) =
1004 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e ∨
1005 (∃ k : Fin p,
1006 (z : φ.ker) =
1008 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k) ∨
1009 (∃ j : Fin tailLen, ∃ k : Fin p,
1010 (z : φ.ker) =
1012 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k) := by
1013 classical
1014 dsimp
1015 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
1016 let source :=
1017 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1018 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
1019 let φ :=
1021 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1022 let x : FuchsianGenerator source :=
1024 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1025 let hT :=
1027 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1028 have hx : φ (FreeGroup.of x) = Multiplicative.ofAdd (1 : ZMod p) := by
1029 simpa [φ, x, originalFirstReductionPeriodOneDistinguishedGenerator] using
1031 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1032 intro z
1033 rcases z.property with ⟨t, ht, g, hz, hne⟩
1034 have htPower : ∃ k : Fin p, t = (FreeGroup.of x) ^ k.val := by
1035 simpa [hT, originalFirstReductionPeriodOneSchreierTransversal, φ, x] using
1036 (mem_range_cyclicQuotientRightRep_iff_generatorPower φ (x := x) hx).1 ht
1037 rcases htPower with ⟨k, rfl⟩
1038 cases g with
1039 | elliptic i =>
1040 cases hidx : e.symm i with
1041 | inl head =>
1042 have hi : i = e (.inl head) := by
1043 have h := congrArg e hidx
1044 simpa using h
1045 fin_cases head
1046 · by_cases hwrap : k.val + 1 < p
1047 · have hgen :
1048 schreierGenerator hT ((FreeGroup.of x) ^ k.val) x = 1 := by
1049 simpa [hT, source, φ, x,
1052 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hwrap
1053 exact False.elim (hne (by simpa [hz, x, hi,
1054 originalFirstReductionPeriodOneDistinguishedGenerator] using hgen))
1055 · have hk : k.val = p - 1 := by
1056 have hklt := k.isLt
1057 omega
1058 left
1059 calc
1060 (z : φ.ker) =
1061 schreierGenerator hT ((FreeGroup.of x) ^ k.val) x := by
1062 simpa [x, hi, originalFirstReductionPeriodOneDistinguishedGenerator] using hz
1063 _ = schreierGenerator hT ((FreeGroup.of x) ^ (p - 1)) x := by
1064 rw [hk]
1065 _ =
1067 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e := by
1068 simpa [hT, source, φ, x,
1071 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1072 · right
1073 left
1074 refine ⟨k, ?_⟩
1075 calc
1076 (z : φ.ker) =
1077 schreierGenerator hT ((FreeGroup.of x) ^ k.val)
1078 (FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))) := by
1079 simpa [hi] using hz
1080 _ =
1082 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k := by
1083 simpa [hT, source, φ, x] using
1085 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k
1086 | inr j =>
1087 have hi : i = e (.inr j) := by
1088 have h := congrArg e hidx
1089 simpa using h
1090 right
1091 right
1092 refine ⟨j, k, ?_⟩
1093 calc
1094 (z : φ.ker) =
1095 schreierGenerator hT ((FreeGroup.of x) ^ k.val)
1096 (FuchsianGenerator.elliptic (e (.inr j))) := by
1097 simpa [hi] using hz
1098 _ =
1100 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k := by
1101 simpa [hT, source, φ, x] using
1103 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k
1104 | surfaceA i =>
1105 exact Fin.elim0 (by
1106 simpa [source, originalFirstReductionSignature] using i)
1107 | surfaceB i =>
1108 exact Fin.elim0 (by
1109 simpa [source, originalFirstReductionSignature] using i)
1112 {tailLen p : ℕ}
1113 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
1114 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
1115 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
1116 (e :
1117 OriginalFirstReductionIndex tailLen ≃
1118 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
1119 hTailLen).numPeriods)
1120 (hperiods :
1121 let source :=
1122 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1123 ∀ x : OriginalFirstReductionIndex tailLen,
1124 source.periods (e x) =
1125 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
1126 (he : e = originalFirstReductionOrderedIndexEquiv tailLen)
1127 (hm₁'one : m₁' = 1)
1128 (k : Fin p) :
1129 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
1130 let source :=
1131 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1132 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
1133 let ξ :=
1135 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1136 let f := ellipticQuotientGeneratorImage source ξ
1137 let T :=
1139 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1140 let basis :=
1142 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1143 let prev : Fin p :=
1144 if k.val = 0 then ⟨p - 1, by omega⟩ else ⟨k.val - 1, by omega⟩
1145 (List.ofFn (fun j : Fin tailLen =>
1146 basis.symm
1148 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j prev))).prod *
1149 basis.symm
1151 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k) ∈
1152 Subgroup.normalClosure
1154 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
1155 classical
1156 dsimp
1157 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
1158 let source :=
1159 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1160 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
1161 let ξ :=
1163 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1164 let f := ellipticQuotientGeneratorImage source ξ
1165 let φ :=
1167 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1168 let T :=
1170 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1171 let hT :=
1173 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1174 let basis :=
1176 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1177 let x : FuchsianGenerator source :=
1179 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1180 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
1181 let tailGen : Fin tailLen → FuchsianGenerator source := fun j =>
1182 FuchsianGenerator.elliptic (e (.inr j))
1183 let P : FreeGroup (FuchsianGenerator source) :=
1184 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j))).prod
1185 let prev : Fin p :=
1186 if k.val = 0 then ⟨p - 1, by omega⟩ else ⟨k.val - 1, by omega⟩
1187 let c : Fin tailLen → Fin p → φ.ker := fun j k =>
1189 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k
1190 let edge : Fin p → φ.ker :=
1192 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1193 let d : φ.ker := (List.ofFn (fun j : Fin tailLen => c j prev)).prod * edge k
1195 simpa [f, ξ, originalFirstReductionPeriodOneFreeQuotientHom] using
1197 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
1198 have hTotalMem :
1199 FreeGroup.of x * FreeGroup.of y * P ∈
1201 subst e
1202 have hTotal :=
1204 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1205 have hTailEq :
1206 totalRelation source =
1207 FreeGroup.of x * FreeGroup.of y * P := by
1210 originalFirstReductionOrderedIndexEquiv] using hTotal
1211 rw [← hTailEq]
1212 exact Subgroup.subset_normalClosure (Or.inr rfl)
1213 have hRotMem :
1214 P * FreeGroup.of x * FreeGroup.of y ∈
1216 have h₁ :
1217 FreeGroup.of y * P * FreeGroup.of x ∈
1219 simpa [mul_assoc] using
1220 ReidemeisterSchreier.Discrete.Presentations.cyclic_rotation_mem_normalClosure
1222 (by simpa [mul_assoc] using hTotalMem)
1223 simpa [mul_assoc] using
1224 ReidemeisterSchreier.Discrete.Presentations.cyclic_rotation_mem_normalClosure
1226 (by simpa [mul_assoc] using h₁)
1227 have hA :
1228 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ p ∈
1230 simpa [source, φ, x] using
1232 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods hm₁'one
1233 have hblockCoe :
1234 (((List.ofFn (fun j : Fin tailLen => c j prev)).prod : φ.ker) :
1235 FreeGroup (FuchsianGenerator source)) =
1236 (FreeGroup.of x) ^ prev.val * P * ((FreeGroup.of x) ^ prev.val)⁻¹ := by
1237 change
1238 φ.ker.subtype ((List.ofFn (fun j : Fin tailLen => c j prev)).prod) =
1239 (FreeGroup.of x) ^ prev.val * P * ((FreeGroup.of x) ^ prev.val)⁻¹
1240 rw [map_list_prod, List.map_ofFn]
1241 calc
1242 (List.ofFn (fun j : Fin tailLen => φ.ker.subtype (c j prev))).prod =
1243 (List.ofFn (fun j : Fin tailLen =>
1244 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ prev.val *
1245 FreeGroup.of (tailGen j) *
1246 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ prev.val)⁻¹)).prod := by
1247 apply congrArg List.prod
1248 apply List.ofFn_inj.2
1249 funext j
1250 simpa [c, source, φ, x, tailGen] using
1252 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j prev
1253 _ = (FreeGroup.of x) ^ prev.val * P *
1254 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ prev.val)⁻¹ := by
1255 simpa [P] using
1256 (ReidemeisterSchreier.Discrete.Presentations.conjugate_list_prod
1257 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ prev.val)
1258 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j)))).symm
1259 have hedgeCoe :
1260 ((edge k : φ.ker) : FreeGroup (FuchsianGenerator source)) =
1261 (FreeGroup.of x) ^ k.val * FreeGroup.of y *
1262 ((FreeGroup.of x) ^ (((k.val : ZMod p) - 1).val))⁻¹ := by
1263 simpa [edge, source, φ, x, y] using
1265 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k
1266 have hdSource :
1267 ((d : φ.ker) : FreeGroup (FuchsianGenerator source)) ∈
1269 let N : Subgroup (FreeGroup (FuchsianGenerator source)) :=
1271 let q : FreeGroup (FuchsianGenerator source) →*
1272 FreeGroup (FuchsianGenerator source) ⧸ N := QuotientGroup.mk' N
1273 have hqRot : q (P * FreeGroup.of x * FreeGroup.of y) = 1 :=
1274 (QuotientGroup.eq_one_iff (N := N) (P * FreeGroup.of x * FreeGroup.of y)).2
1275 (by simpa [N] using hRotMem)
1276 have hqA : q ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ p) = 1 :=
1277 (QuotientGroup.eq_one_iff (N := N)
1278 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ p)).2
1279 (by simpa [N] using hA)
1280 have hqA' : q (FreeGroup.of x) ^ p = 1 := by
1281 simpa [map_pow] using hqA
1282 have hqTarget : q ((d : φ.ker) : FreeGroup (FuchsianGenerator source)) = 1 := by
1283 haveI : Fact (1 < p) := ⟨by omega⟩
1284 change q ((((List.ofFn (fun j : Fin tailLen => c j prev)).prod : φ.ker) :
1285 FreeGroup (FuchsianGenerator source)) * ((edge k : φ.ker) :
1286 FreeGroup (FuchsianGenerator source))) = 1
1287 rw [hblockCoe, hedgeCoe]
1288 by_cases h0 : k.val = 0
1289 · have hprev : prev = ⟨p - 1, by omega⟩ := by
1290 simp only [h0, ↓reduceIte, prev]
1291 have hr0 : ((((0 : ℕ) : ZMod p) - 1).val) = p - 1 := by
1292 have hsucc : (p - 1).succ = p := by omega
1293 simp only [sub_eq_add_neg, Nat.cast_zero, zero_add]
1294 rw [← hsucc]
1295 exact ZMod.val_neg_one (p - 1)
1296 have hr : (((k.val : ZMod p) - 1).val) = p - 1 := by
1297 simpa [h0] using hr0
1298 rw [hprev]
1299 rw [hr, h0]
1300 have hxpred_mul :
1301 q (FreeGroup.of x) ^ (p - 1) * q (FreeGroup.of x) = 1 := by
1302 rw [← pow_succ]
1303 have hpred : p - 1 + 1 = p := by omega
1304 rw [hpred]
1305 exact hqA'
1306 have hxpred :
1307 q (FreeGroup.of x) ^ (p - 1) = (q (FreeGroup.of x))⁻¹ :=
1308 eq_inv_of_mul_eq_one_left hxpred_mul
1310 rw [hxpred]
1311 calc
1312 (q (FreeGroup.of x))⁻¹ * q P * q (FreeGroup.of x) *
1313 (q (FreeGroup.of y) * q (FreeGroup.of x)) =
1314 (q (FreeGroup.of x))⁻¹ *
1315 (q P * q (FreeGroup.of x) * q (FreeGroup.of y)) *
1316 q (FreeGroup.of x) := by group
1317 _ = 1 := by
1318 have hrot' :
1319 q P * q (FreeGroup.of x) * q (FreeGroup.of y) = 1 := by
1321 simp only [hrot', mul_one, inv_mul_cancel]
1322 · have hprev : prev = ⟨k.val - 1, by omega⟩ := by
1323 simp only [h0, ↓reduceIte, prev]
1324 have hk : k.val = (k.val - 1) + 1 := by omega
1325 have hr : (((k.val : ZMod p) - 1).val) = k.val - 1 := by
1326 let kNat := k.val
1327 have hkpos : 0 < kNat := by
1328 dsimp [kNat]
1329 omega
1330 have hklt : kNat < p := by
1331 dsimp [kNat]
1332 exact k.isLt
1333 have hkval : ((kNat : ZMod p)).val = kNat :=
1334 ZMod.val_natCast_of_lt hklt
1335 have hsubval : ((kNat : ZMod p) - 1).val = kNat - 1 := by
1336 have hle : (1 : ZMod p).val ≤ (kNat : ZMod p).val := by
1337 rw [hkval, ZMod.val_one]
1338 exact Nat.succ_le_iff.mpr hkpos
1339 rw [ZMod.val_sub hle, hkval, ZMod.val_one]
1340 simpa [kNat] using hsubval
1341 rw [hprev]
1342 rw [hr]
1343 have hpowk :
1344 q (FreeGroup.of x) ^ k.val =
1345 q (FreeGroup.of x) ^ (k.val - 1 + 1) := by
1346 exact congrArg (fun n => q (FreeGroup.of x) ^ n) hk
1348 rw [hpowk]
1349 calc
1350 q (FreeGroup.of x) ^ (k.val - 1) * q P *
1351 (q (FreeGroup.of x) ^ (k.val - 1))⁻¹ *
1352 (q (FreeGroup.of x) ^ (k.val - 1 + 1) * q (FreeGroup.of y) *
1353 (q (FreeGroup.of x) ^ (k.val - 1))⁻¹) =
1354 q (FreeGroup.of x) ^ (k.val - 1) *
1355 (q P * q (FreeGroup.of x) * q (FreeGroup.of y)) *
1356 (q (FreeGroup.of x) ^ (k.val - 1))⁻¹ := by
1357 rw [pow_succ]
1358 group
1359 _ = 1 := by
1360 have hrot' :
1361 q P * q (FreeGroup.of x) * q (FreeGroup.of y) = 1 := by
1363 simp only [hrot', mul_one, mul_inv_cancel]
1364 exact (QuotientGroup.eq_one_iff (N := N)
1365 ((d : φ.ker) : FreeGroup (FuchsianGenerator source))).1 hqTarget
1366 have hmem :
1367 basis.symm d ∈
1368 Subgroup.normalClosure
1370 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
1371 exact
1372 ReidemeisterSchreier.Discrete.Presentations.freeGroupPullback_transversalRelator_mem_normalClosure_of_mem_normalClosure
1373 hrels hT.1 basis hdSource
1374 have hmap :
1375 basis.symm d =
1376 (List.ofFn (fun j : Fin tailLen =>
1377 basis.symm (c j prev))).prod * basis.symm (edge k) := by
1378 dsimp [d]
1380 simp only [Function.comp_def]
1381 have hgoal :
1382 (List.ofFn (fun j : Fin tailLen =>
1383 basis.symm (c j prev))).prod * basis.symm (edge k) ∈
1384 Subgroup.normalClosure
1386 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
1387 simpa [hmap] using hmem
1388 simpa [source, ξ, f, T, basis, prev, c, edge] using hgoal
1391 {tailLen p : ℕ}
1392 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
1393 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
1394 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
1395 (e :
1396 OriginalFirstReductionIndex tailLen ≃
1397 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
1398 hTailLen).numPeriods)
1399 (hperiods :
1400 let source :=
1401 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1402 ∀ x : OriginalFirstReductionIndex tailLen,
1403 source.periods (e x) =
1404 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
1405 (idx : OneHeadPeriodOneTargetIndex tailLen p) :
1406 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
1407 let source :=
1408 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1409 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
1410 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
1411 let ξ :=
1413 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1414 let f := ellipticQuotientGeneratorImage source ξ
1415 let T :=
1417 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1418 let basis :=
1420 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1421 let θ :=
1423 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
1424 θ
1425 ((xWord target (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p idx)) ^
1426 target.periods (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p idx)) ∈
1427 Subgroup.normalClosure
1429 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
1430 classical
1431 dsimp
1432 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
1433 let source :=
1434 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1435 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
1436 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
1437 let ξ :=
1439 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1440 let f := ellipticQuotientGeneratorImage source ξ
1441 let T :=
1443 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1444 let basis :=
1446 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1447 let θ :=
1449 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
1450 cases idx using Sum.casesOn with
1451 | inl i =>
1452 fin_cases i
1453 have hPeriod :
1454 target.periods
1455 (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p
1456 (.inl (0 : Fin 1))) = m₂' := by
1457 simp only [oneHeadPeriodOneTargetSignature, oneHeadPeriodOneTargetOrderedIndexEquiv, Equiv.symm_trans_apply,
1458 Equiv.sumCongr_symm, Equiv.refl_symm, Equiv.sumCongr_apply, Equiv.coe_refl, oneHeadPeriodOneTargetPeriods,
1459 Fin.isValue, Equiv.trans_apply, Sum.map_inl, id_eq, finSumFinEquiv_apply_left, finSumFinEquiv_symm_apply_castAdd,
1460 target]
1461 have hmem :=
1463 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
1464 simpa [θ, oneHeadPeriodOneTargetToSchreierHom,
1465 oneHeadPeriodOneTargetToSchreierGeneratorImage, target, xWord, hPeriod,
1466 basis, source, ξ, f, T, oneHeadPeriodOneTargetPeriods,
1467 Equiv.symm_apply_apply] using hmem
1468 | inr jk =>
1469 have hPeriod :
1470 target.periods
1471 (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p
1472 (.inr jk)) = tail jk.2 := by
1473 simp only [oneHeadPeriodOneTargetSignature, oneHeadPeriodOneTargetOrderedIndexEquiv, Equiv.symm_trans_apply,
1474 Equiv.sumCongr_symm, Equiv.refl_symm, Equiv.sumCongr_apply, Equiv.coe_refl, oneHeadPeriodOneTargetPeriods,
1475 Equiv.trans_apply, Sum.map_inr, finSumFinEquiv_apply_right, finSumFinEquiv_symm_apply_natAdd,
1476 Equiv.symm_apply_apply, target]
1477 have hmem :=
1479 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods jk.2 jk.1
1480 simpa [θ, oneHeadPeriodOneTargetToSchreierHom,
1481 oneHeadPeriodOneTargetToSchreierGeneratorImage, target, xWord, hPeriod,
1482 basis, source, ξ, f, T, oneHeadPeriodOneTargetPeriods,
1483 Equiv.symm_apply_apply] using hmem
1486 {tailLen p : ℕ}
1487 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
1488 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
1489 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
1490 (hHigh : 3 ≤ p * tailLen)
1491 (e :
1492 OriginalFirstReductionIndex tailLen ≃
1493 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
1494 hTailLen).numPeriods)
1495 (hperiods :
1496 let source :=
1497 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1498 ∀ x : OriginalFirstReductionIndex tailLen,
1499 source.periods (e x) =
1500 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
1501 (jk : Fin p × Fin tailLen) :
1502 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
1503 let source :=
1504 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1505 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
1506 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
1507 let ξ :=
1509 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1510 let f := ellipticQuotientGeneratorImage source ξ
1511 let T :=
1513 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1514 let basis :=
1516 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1517 let θ :=
1519 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
1520 θ
1522 target.periods (finProdFinEquiv jk)) ∈
1523 Subgroup.normalClosure
1525 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
1526 classical
1527 dsimp
1528 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
1529 let source :=
1530 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1531 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
1532 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
1533 let ξ :=
1535 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1536 let f := ellipticQuotientGeneratorImage source ξ
1537 let T :=
1539 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1540 let basis :=
1542 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1543 let θ :=
1545 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
1546 have hIndex : finProdFinEquiv.symm (finProdFinEquiv jk) = jk := by
1547 exact finProdFinEquiv.symm_apply_apply jk
1548 have hIndexPair :
1549 ((finProdFinEquiv jk).divNat, (finProdFinEquiv jk).modNat) = jk := by
1550 have h := finProdFinEquiv.symm_apply_apply jk
1551 rw [finProdFinEquiv_symm_apply] at h
1552 exact h
1553 have hIndexFst : (finProdFinEquiv jk).divNat = jk.1 :=
1554 congrArg Prod.fst hIndexPair
1555 have hIndexSnd : (finProdFinEquiv jk).modNat = jk.2 :=
1556 congrArg Prod.snd hIndexPair
1557 have hPeriod :
1558 target.periods (finProdFinEquiv jk) = tail jk.2 := by
1559 simp only [doublePeriodOneTailReplicatedSignature, finProdFinEquiv_symm_apply, hIndexSnd, target]
1560 have hmem :=
1562 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods jk.2 jk.1
1563 simpa [θ, doublePeriodOneTargetToSchreierHom,
1564 doublePeriodOneTargetToSchreierGeneratorImage, target, xWord, hPeriod,
1565 basis, source, ξ, f, T, hIndexFst, hIndexSnd] using hmem
1567private theorem oneHeadPeriodOneTarget_totalRelation_eq_blocks
1568 {tailLen p : ℕ}
1569 (m₂' : ℕ) (tail : Fin tailLen → ℕ)
1570 (hp : 2 ≤ p) (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j)
1571 (hTailLen : 0 < tailLen) :
1572 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
1573 totalRelation target =
1575 (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inl (0 : Fin 1))) *
1576 (List.ofFn (fun k : Fin p =>
1577 (List.ofFn (fun j : Fin tailLen =>
1579 (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k, j))))).prod)).prod := by
1580 classical
1581 dsimp
1582 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
1583 let flat : List (FreeGroup (FuchsianGenerator target)) :=
1584 List.ofFn (fun r : Fin (p * tailLen) =>
1586 dsimp [target, oneHeadPeriodOneTargetSignature]
1587 omega⟩)
1588 let blocks : FreeGroup (FuchsianGenerator target) :=
1589 (List.ofFn (fun k : Fin p =>
1590 (List.ofFn (fun j : Fin tailLen =>
1592 (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k, j))))).prod)).prod
1593 have hFlatBlocks : flat.prod = blocks := by
1594 dsimp [flat, blocks]
1596 congr
1597 funext k
1598 congr
1599 funext j
1601 ext
1602 simp only [oneHeadPeriodOneTargetOrderedIndexEquiv, finProdFinEquiv, Equiv.trans_apply, Equiv.sumCongr_apply,
1603 Equiv.coe_refl, Equiv.coe_fn_mk, Sum.map_inr, finSumFinEquiv_apply_right, Fin.natAdd_mk, Nat.add_left_cancel_iff]
1604 rw [Nat.mul_comm tailLen k.val]
1605 omega
1606 have hHead :
1607 (⟨0, by omega⟩ : Fin (1 + p * tailLen)) =
1608 oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inl (0 : Fin 1)) := by
1609 ext
1610 simp only [oneHeadPeriodOneTargetOrderedIndexEquiv, Fin.isValue, Equiv.trans_apply, Equiv.sumCongr_apply,
1611 Equiv.coe_refl, Sum.map_inl, id_eq, finSumFinEquiv_apply_left, Fin.val_castAdd, Fin.val_eq_zero]
1612 have hFlat :
1613 totalRelation target =
1615 rw [totalRelation]
1616 simpa [target, oneHeadPeriodOneTargetSignature, flat, List.ofFn_eq_map,
1617 List.prod_cons, mul_assoc] using
1618 congrArg List.prod
1621 simpa [hHead, hFlatBlocks, blocks] using hFlat
1623private theorem doublePeriodOneTarget_totalRelation_eq_blocks
1624 {tailLen p : ℕ}
1625 (tail : Fin tailLen → ℕ)
1626 (htail : ∀ j, 2 ≤ tail j) (hHigh : 3 ≤ p * tailLen) :
1627 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
1628 totalRelation target =
1629 (List.ofFn (fun k : Fin p =>
1630 (List.ofFn (fun j : Fin tailLen =>
1632 classical
1633 dsimp
1634 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
1635 have hFlat :
1636 totalRelation target =
1638 rw [totalRelation]
1639 simp only [doublePeriodOneTailReplicatedSignature, finProdFinEquiv_symm_apply, List.finRange_zero,
1640 List.map_nil, List.prod_nil, mul_one, List.ofFn_eq_map, target]
1641 rw [hFlat]
1643 congr
1644 funext k
1645 congr
1646 funext j
1648 ext
1649 simp only [finProdFinEquiv, Equiv.coe_fn_mk]
1650 rw [Nat.mul_comm tailLen k.val]
1651 omega
1654 {tailLen p : ℕ}
1655 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
1656 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
1657 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
1658 (e :
1659 OriginalFirstReductionIndex tailLen ≃
1660 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
1661 hTailLen).numPeriods)
1662 (hperiods :
1663 let source :=
1664 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1665 ∀ x : OriginalFirstReductionIndex tailLen,
1666 source.periods (e x) =
1667 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
1668 (he : e = originalFirstReductionOrderedIndexEquiv tailLen)
1669 (hm₁'one : m₁' = 1) :
1670 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
1671 let source :=
1672 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1673 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
1674 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
1675 let ξ :=
1677 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1678 let f := ellipticQuotientGeneratorImage source ξ
1679 let T :=
1681 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1682 let basis :=
1684 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1685 let θ :=
1687 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
1688 θ (totalRelation target) ∈
1689 Subgroup.normalClosure
1691 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
1692 classical
1693 dsimp
1694 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
1695 let source :=
1696 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1697 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
1698 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
1699 let ξ :=
1701 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1702 let f := ellipticQuotientGeneratorImage source ξ
1703 let T :=
1705 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1706 let basis :=
1708 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1709 let θ :=
1711 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
1712 let a :=
1714 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1715 let b :=
1717 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1718 let c :
1719 Fin tailLen → Fin p →
1723 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k
1724 let S :=
1726 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)
1727 let tailBlock : FreeGroup ↥(schreierGeneratorSet
1729 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e)) :=
1730 (List.ofFn (fun k : Fin p =>
1731 (List.ofFn (fun j : Fin tailLen => basis.symm (c j k))).prod)).prod
1732 have hImage :
1733 θ (totalRelation target) = basis.symm b * tailBlock := by
1735 m₂' tail hp hm₂'ge htail hTailLen]
1737 rw [MonoidHom.map_list_prod_ofFn₂ θ
1738 (fun k : Fin p => fun j : Fin tailLen =>
1739 xWord target (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k, j))))]
1740 simp only [Lean.Elab.WF.paramLet, oneHeadPeriodOneTargetToSchreierHom,
1741 oneHeadPeriodOneTargetToSchreierGeneratorImage, oneHeadPeriodOneTargetOrderedIndexEquiv, Equiv.symm_trans_apply,
1742 Equiv.sumCongr_symm, Equiv.refl_symm, Equiv.sumCongr_apply, Equiv.coe_refl, id_eq, xWord, Fin.isValue,
1743 Equiv.trans_apply, Sum.map_inl, finSumFinEquiv_apply_left, FreeGroup.lift_apply_of,
1744 finSumFinEquiv_symm_apply_castAdd, Sum.map_inr, finSumFinEquiv_apply_right, finSumFinEquiv_symm_apply_natAdd,
1745 Equiv.symm_apply_apply, θ, target, basis, b, tailBlock, c]
1746 have hCyclic :
1747 basis.symm a * basis.symm b * tailBlock ∈ Subgroup.normalClosure S := by
1748 subst e
1749 simpa [source, ξ, f, T, basis, a, b, c, S, tailBlock] using
1751 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1752 have hA :
1753 basis.symm a ∈ Subgroup.normalClosure S := by
1754 simpa [source, ξ, f, T, basis, a, S] using
1756 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods hm₁'one
1757 have hTail :
1758 basis.symm b * tailBlock ∈ Subgroup.normalClosure S := by
1759 exact ReidemeisterSchreier.Discrete.Presentations.mem_of_left_mul_mem_normalClosure hA (by simpa [mul_assoc] using hCyclic)
1760 change θ (totalRelation target) ∈ Subgroup.normalClosure S
1761 rw [hImage]
1762 exact hTail
1765 {tailLen p : ℕ}
1766 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
1767 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
1768 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
1769 (hHigh : 3 ≤ p * tailLen)
1770 (e :
1771 OriginalFirstReductionIndex tailLen ≃
1772 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
1773 hTailLen).numPeriods)
1774 (hperiods :
1775 let source :=
1776 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1777 ∀ x : OriginalFirstReductionIndex tailLen,
1778 source.periods (e x) =
1779 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
1780 (he : e = originalFirstReductionOrderedIndexEquiv tailLen)
1781 (hm₁'one : m₁' = 1) (hm₂'one : m₂' = 1) :
1782 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
1783 let source :=
1784 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1785 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
1786 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
1787 let ξ :=
1789 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1790 let f := ellipticQuotientGeneratorImage source ξ
1791 let T :=
1793 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1794 let basis :=
1796 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1797 let θ :=
1799 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
1800 θ (totalRelation target) ∈
1801 Subgroup.normalClosure
1803 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
1804 classical
1805 dsimp
1806 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
1807 let source :=
1808 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1809 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
1810 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
1811 let ξ :=
1813 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1814 let f := ellipticQuotientGeneratorImage source ξ
1815 let T :=
1817 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1818 let basis :=
1820 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1821 let θ :=
1823 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
1824 let a :=
1826 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1827 let b :=
1829 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1830 let c :
1831 Fin tailLen → Fin p →
1835 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k
1836 let S :=
1838 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)
1839 let tailBlock : FreeGroup ↥(schreierGeneratorSet
1841 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e)) :=
1842 (List.ofFn (fun k : Fin p =>
1843 (List.ofFn (fun j : Fin tailLen => basis.symm (c j k))).prod)).prod
1844 have hImage :
1845 θ (totalRelation target) = tailBlock := by
1846 have hIndexFst :
1847 ∀ (k : Fin p) (j : Fin tailLen),
1848 (finProdFinEquiv (k, j)).divNat = k := by
1849 intro k j
1850 have h := finProdFinEquiv.symm_apply_apply (k, j)
1851 rw [finProdFinEquiv_symm_apply] at h
1852 exact congrArg Prod.fst h
1853 have hIndexSnd :
1854 ∀ (k : Fin p) (j : Fin tailLen),
1855 (finProdFinEquiv (k, j)).modNat = j := by
1856 intro k j
1857 have h := finProdFinEquiv.symm_apply_apply (k, j)
1858 rw [finProdFinEquiv_symm_apply] at h
1859 exact congrArg Prod.snd h
1861 tail htail hHigh]
1862 rw [MonoidHom.map_list_prod_ofFn₂ θ
1863 (fun k : Fin p => fun j : Fin tailLen =>
1866 Lean.Elab.WF.paramLet, finProdFinEquiv_symm_apply, id_eq, xWord, FreeGroup.lift_apply_of, hIndexSnd, hIndexFst, θ,
1867 target, tailBlock, basis, c]
1868 have hCyclic :
1869 basis.symm a * basis.symm b * tailBlock ∈ Subgroup.normalClosure S := by
1870 subst e
1871 simpa [source, ξ, f, T, basis, a, b, c, S, tailBlock] using
1873 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1874 have hA :
1875 basis.symm a ∈ Subgroup.normalClosure S := by
1876 simpa [source, ξ, f, T, basis, a, S] using
1878 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods hm₁'one
1879 have hB :
1880 basis.symm b ∈ Subgroup.normalClosure S := by
1881 have hPow :=
1883 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
1884 simpa [source, ξ, f, T, basis, b, S, hm₂'one] using hPow
1885 have hAfterA :
1886 basis.symm b * tailBlock ∈ Subgroup.normalClosure S := by
1887 exact ReidemeisterSchreier.Discrete.Presentations.mem_of_left_mul_mem_normalClosure hA (by simpa [mul_assoc] using hCyclic)
1888 have hTail :
1889 tailBlock ∈ Subgroup.normalClosure S := by
1890 exact ReidemeisterSchreier.Discrete.Presentations.mem_of_left_mul_mem_normalClosure hB hAfterA
1891 change θ (totalRelation target) ∈ Subgroup.normalClosure S
1892 rw [hImage]
1893 exact hTail
1895private theorem fuchsianTarget_mapsRelators_of_power_and_total
1896 (τ : FuchsianSignature) {G : Type*} [Group G] {S : Set G}
1897 (η : FreeGroup (FuchsianGenerator τ) →* G)
1898 (hPower :
1899 ∀ i : Fin τ.numPeriods,
1901 (hTotal : η (totalRelation τ) ∈ Subgroup.normalClosure S) :
1903 intro r hr
1904 rcases hr with ⟨i, rfl⟩ | rfl
1905 · exact hPower i
1906 · exact hTotal
1909 {tailLen p : ℕ}
1910 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
1911 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
1912 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
1913 (e :
1914 OriginalFirstReductionIndex tailLen ≃
1915 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
1916 hTailLen).numPeriods)
1917 (hperiods :
1918 let source :=
1919 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1920 ∀ x : OriginalFirstReductionIndex tailLen,
1921 source.periods (e x) =
1922 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
1923 (he : e = originalFirstReductionOrderedIndexEquiv tailLen)
1924 (hm₁'one : m₁' = 1) :
1925 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
1926 let source :=
1927 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1928 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
1929 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
1930 let ξ :=
1932 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1933 let f := ellipticQuotientGeneratorImage source ξ
1934 let T :=
1936 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1937 let basis :=
1939 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1940 let θ :=
1942 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
1944 θ r ∈
1945 Subgroup.normalClosure
1947 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
1948 classical
1949 dsimp
1950 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
1951 let source :=
1952 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1953 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
1954 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
1955 let ξ :=
1957 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1958 let f := ellipticQuotientGeneratorImage source ξ
1959 let T :=
1961 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1962 let basis :=
1964 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
1965 let θ :=
1967 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
1968 refine
1969 fuchsianTarget_mapsRelators_of_power_and_total target θ ?_ ?_
1970 · intro i
1971 let idx := (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p).symm i
1972 have h :=
1974 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e hperiods idx
1975 simpa [source, target, ξ, f, T, basis, θ, idx] using h
1976 · simpa [source, target, ξ, f, T, basis, θ] using
1978 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e hperiods he hm₁'one
1981 {tailLen p : ℕ}
1982 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
1983 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
1984 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
1985 (hHigh : 3 ≤ p * tailLen)
1986 (e :
1987 OriginalFirstReductionIndex tailLen ≃
1988 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
1989 hTailLen).numPeriods)
1990 (hperiods :
1991 let source :=
1992 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
1993 ∀ x : OriginalFirstReductionIndex tailLen,
1994 source.periods (e x) =
1995 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
1996 (he : e = originalFirstReductionOrderedIndexEquiv tailLen)
1997 (hm₁'one : m₁' = 1) (hm₂'one : m₂' = 1) :
1998 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
1999 let source :=
2000 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
2001 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
2002 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
2003 let ξ :=
2005 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2006 let f := ellipticQuotientGeneratorImage source ξ
2007 let T :=
2009 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2010 let basis :=
2012 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2013 let θ :=
2015 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
2017 θ r ∈
2018 Subgroup.normalClosure
2020 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
2021 classical
2022 dsimp
2023 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
2024 let source :=
2025 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
2026 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
2027 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
2028 let ξ :=
2030 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2031 let f := ellipticQuotientGeneratorImage source ξ
2032 let T :=
2034 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2035 let basis :=
2037 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2038 let θ :=
2040 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
2041 refine
2042 fuchsianTarget_mapsRelators_of_power_and_total target θ ?_ ?_
2043 · intro i
2044 let jk := finProdFinEquiv.symm i
2045 have hidx : finProdFinEquiv jk = i := by
2046 simpa [jk] using finProdFinEquiv.apply_symm_apply i
2047 have h :=
2049 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e hperiods jk
2050 simpa [source, target, ξ, f, T, basis, θ, hidx] using h
2051 · simpa [source, target, ξ, f, T, basis, θ] using
2053 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e hperiods he
2054 hm₁'one hm₂'one
2056private theorem oneHeadPeriodOneSchreierToTargetHom_firstPowerWord
2057 {tailLen p : ℕ}
2058 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
2059 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
2060 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
2061 (e :
2062 OriginalFirstReductionIndex tailLen ≃
2063 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
2064 hTailLen).numPeriods) :
2065 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
2066 let source :=
2067 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
2068 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
2069 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
2070 let basis :=
2072 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2073 let η :=
2075 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
2076 η
2077 (basis.symm
2079 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e)) =
2080 (1 : FreeGroup (FuchsianGenerator target)) := by
2081 classical
2082 dsimp
2083 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
2084 let source :=
2085 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
2086 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
2087 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
2088 let φ :=
2090 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2091 let hT :=
2093 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2094 let basis :=
2096 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2097 let η :=
2099 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
2100 let z : ↥(schreierGeneratorSet hT) :=
2102 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e,
2104 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e⟩
2105 have hzWord :
2106 basis.symm
2108 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e) =
2109 (FreeGroup.of z)⁻¹ := by
2110 simpa [source, φ, hT, basis, z] using
2112 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e z
2113 have hzImage : η (FreeGroup.of z) = (1 : FreeGroup (FuchsianGenerator target)) := by
2114 simp only [Lean.Elab.WF.paramLet, oneHeadPeriodOneSchreierToTargetHom,
2115 oneHeadPeriodOneSchreierToTargetGeneratorImage, dite_eq_ite, id_eq, FreeGroup.lift_apply_of, ↓reduceIte, η, z,
2116 target, source]
2117 calc
2118 η
2119 (basis.symm
2121 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e)) =
2122 η ((FreeGroup.of z)⁻¹) := by rw [hzWord]
2123 _ = (η (FreeGroup.of z))⁻¹ := by rw [map_inv]
2124 _ = (1 : FreeGroup (FuchsianGenerator target)) := by rw [hzImage, inv_one]
2126private theorem doublePeriodOneSchreierToTargetHom_firstPowerWord
2127 {tailLen p : ℕ}
2128 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
2129 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
2130 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
2131 (hHigh : 3 ≤ p * tailLen)
2132 (e :
2133 OriginalFirstReductionIndex tailLen ≃
2134 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
2135 hTailLen).numPeriods) :
2136 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
2137 let source :=
2138 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
2139 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
2140 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
2141 let basis :=
2143 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2144 let η :=
2146 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
2147 η
2148 (basis.symm
2150 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e)) =
2151 (1 : FreeGroup (FuchsianGenerator target)) := by
2152 classical
2153 dsimp
2154 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
2155 let source :=
2156 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
2157 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
2158 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
2159 let φ :=
2161 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2162 let hT :=
2164 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2165 let basis :=
2167 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2168 let η :=
2170 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
2171 let z : ↥(schreierGeneratorSet hT) :=
2173 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e,
2175 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e⟩
2176 have hzWord :
2177 basis.symm
2179 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e) =
2180 (FreeGroup.of z)⁻¹ := by
2181 simpa [source, φ, hT, basis, z] using
2183 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e z
2184 have hzImage : η (FreeGroup.of z) = (1 : FreeGroup (FuchsianGenerator target)) := by
2185 simp only [Lean.Elab.WF.paramLet, doublePeriodOneSchreierToTargetHom,
2186 doublePeriodOneSchreierToTargetGeneratorImage, dite_eq_ite, id_eq, FreeGroup.lift_apply_of, ↓reduceIte, η, z,
2187 target, source]
2188 calc
2189 η
2190 (basis.symm
2192 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e)) =
2193 η ((FreeGroup.of z)⁻¹) := by rw [hzWord]
2194 _ = (η (FreeGroup.of z))⁻¹ := by rw [map_inv]
2195 _ = (1 : FreeGroup (FuchsianGenerator target)) := by rw [hzImage, inv_one]
2197private theorem oneHeadPeriodOneSchreierToTargetHom_tailWord
2198 {tailLen p : ℕ}
2199 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
2200 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
2201 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
2202 (e :
2203 OriginalFirstReductionIndex tailLen ≃
2204 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
2205 hTailLen).numPeriods)
2206 (j : Fin tailLen) (k : Fin p) :
2207 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
2208 let source :=
2209 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
2210 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
2211 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
2212 let basis :=
2214 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2215 let η :=
2217 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
2218 η
2219 (basis.symm
2221 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k)) =
2222 xWord target (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k, j))) := by
2223 classical
2224 dsimp
2225 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
2226 let source :=
2227 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
2228 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
2229 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
2230 let φ :=
2232 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2233 let hT :=
2235 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2236 let basis :=
2238 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2239 let η :=
2241 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
2242 let x : FuchsianGenerator source :=
2244 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2245 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
2246 let tailGen : Fin tailLen → FuchsianGenerator source := fun j =>
2247 FuchsianGenerator.elliptic (e (.inr j))
2248 let z : ↥(schreierGeneratorSet hT) :=
2250 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k,
2252 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k⟩
2253 have hzWord :
2254 basis.symm
2256 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k) =
2257 (FreeGroup.of z)⁻¹ := by
2258 simpa [source, φ, hT, basis, z] using
2260 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e z
2261 have hxne : x ≠ tailGen j := by
2262 intro hEq
2263 simp only [originalFirstReductionPeriodOneDistinguishedGenerator, Lean.Elab.WF.paramLet, Fin.isValue, id_eq,
2264 FuchsianGenerator.elliptic.injEq, EmbeddingLike.apply_eq_iff_eq, reduceCtorEq, x, tailGen] at hEq
2265 have hyne : y ≠ tailGen j := by
2266 intro hEq
2267 simp only [Fin.isValue, FuchsianGenerator.elliptic.injEq, y, tailGen] at hEq
2268 have hbad := e.injective hEq
2269 cases hbad
2270 have hFirst :
2271 ¬ (z : φ.ker) =
2273 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e := by
2274 intro hEq
2275 have hval := congrArg
2276 (fun z : φ.ker => (z : FreeGroup (FuchsianGenerator source))) hEq
2277 have hleft :
2278 ((z : φ.ker) : FreeGroup (FuchsianGenerator source)) =
2279 (FreeGroup.of x) ^ k.val * FreeGroup.of (tailGen j) *
2280 ((FreeGroup.of x) ^ k.val)⁻¹ := by
2281 simpa [z, source, φ, x, tailGen] using
2283 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k
2284 have hright :
2286 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e : φ.ker) :
2287 FreeGroup (FuchsianGenerator source)) =
2288 (FreeGroup.of x) ^ p := by
2289 simpa [source, φ, x] using
2291 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2292 have hword :
2293 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
2294 FreeGroup.of (tailGen j) *
2295 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ =
2296 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ p := by
2297 simpa [hleft, hright] using hval
2298 let χ : FuchsianGenerator source → Multiplicative ℤ :=
2299 fun u => if u = tailGen j then Multiplicative.ofAdd (1 : ℤ) else 1
2300 have hmap := congrArg (FreeGroup.lift χ) hword
2301 simp only [map_mul, map_pow, FreeGroup.lift_apply_of, hxne, ↓reduceIte, one_pow, one_mul, map_inv, inv_one,
2302 mul_one, ofAdd_eq_one, one_ne_zero, χ] at hmap
2303 have hSecond :
2304 ¬ ∃ k' : Fin p,
2305 (z : φ.ker) =
2307 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k' := by
2308 intro h
2309 rcases h with ⟨k', hEq⟩
2310 have hval := congrArg
2311 (fun z : φ.ker => (z : FreeGroup (FuchsianGenerator source))) hEq
2312 have hleft :
2313 ((z : φ.ker) : FreeGroup (FuchsianGenerator source)) =
2314 (FreeGroup.of x) ^ k.val * FreeGroup.of (tailGen j) *
2315 ((FreeGroup.of x) ^ k.val)⁻¹ := by
2316 simpa [z, source, φ, x, tailGen] using
2318 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k
2319 let r : ℕ := ((k'.val : ZMod p) - 1).val
2320 have hright :
2322 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k' : φ.ker) :
2323 FreeGroup (FuchsianGenerator source)) =
2324 (FreeGroup.of x) ^ k'.val * FreeGroup.of y *
2325 ((FreeGroup.of x) ^ r)⁻¹ := by
2326 simpa [source, φ, x, y, r] using
2328 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k'
2329 have hword :
2330 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
2331 FreeGroup.of (tailGen j) *
2332 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ =
2333 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k'.val *
2334 FreeGroup.of y *
2335 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ r)⁻¹ := by
2336 simpa [hleft, hright] using hval
2337 let χ : FuchsianGenerator source → Multiplicative ℤ :=
2338 fun u => if u = tailGen j then Multiplicative.ofAdd (1 : ℤ) else 1
2339 have hmap := congrArg (FreeGroup.lift χ) hword
2340 simp only [map_mul, map_pow, FreeGroup.lift_apply_of, hxne, ↓reduceIte, one_pow, one_mul, map_inv, inv_one,
2341 mul_one, hyne, ofAdd_eq_one, one_ne_zero, χ] at hmap
2342 have hTail :
2343 ∃ j' : Fin tailLen, ∃ k' : Fin p,
2344 (z : φ.ker) =
2346 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j' k' := ⟨j, k, rfl⟩
2347 let j' : Fin tailLen := Classical.choose hTail
2348 let hk' : ∃ k' : Fin p,
2349 (z : φ.ker) =
2351 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j' k' :=
2352 Classical.choose_spec hTail
2353 let k' : Fin p := Classical.choose hk'
2354 have hTailChoose :
2355 oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k', j')) =
2356 oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k, j)) := by
2357 have hEqTail :
2359 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k =
2361 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j' k' := by
2362 simpa [z, j', hk', k'] using Classical.choose_spec hk'
2363 rcases
2365 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hEqTail with
2366 ⟨hj, hk⟩
2367 simp only [hk, hj]
2368 have hzImage :
2369 η (FreeGroup.of z) =
2371 (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k, j))))⁻¹ := by
2372 simp only [Lean.Elab.WF.paramLet, oneHeadPeriodOneSchreierToTargetHom,
2373 oneHeadPeriodOneSchreierToTargetGeneratorImage, dite_eq_ite, id_eq, FreeGroup.lift_apply_of, hFirst, ↓reduceIte,
2374 hSecond, ↓reduceDIte, hTail, hTailChoose, η, z, target, source, j', k']
2375 calc
2376 η
2377 (basis.symm
2379 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k)) =
2380 η ((FreeGroup.of z)⁻¹) := by rw [hzWord]
2381 _ = (η (FreeGroup.of z))⁻¹ := by rw [map_inv]
2382 _ =
2384 (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k, j))))⁻¹)⁻¹ := by
2385 rw [hzImage]
2386 _ =
2388 (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k, j))) := by
2391private theorem doublePeriodOneSchreierToTargetHom_tailWord
2392 {tailLen p : ℕ}
2393 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
2394 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
2395 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
2396 (hHigh : 3 ≤ p * tailLen)
2397 (e :
2398 OriginalFirstReductionIndex tailLen ≃
2399 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
2400 hTailLen).numPeriods)
2401 (j : Fin tailLen) (k : Fin p) :
2402 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
2403 let source :=
2404 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
2405 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
2406 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
2407 let basis :=
2409 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2410 let η :=
2412 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
2413 η
2414 (basis.symm
2416 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k)) =
2418 classical
2419 dsimp
2420 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
2421 let source :=
2422 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
2423 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
2424 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
2425 let φ :=
2427 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2428 let hT :=
2430 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2431 let basis :=
2433 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2434 let η :=
2436 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
2437 let x : FuchsianGenerator source :=
2439 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2440 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
2441 let tailGen : Fin tailLen → FuchsianGenerator source := fun j =>
2442 FuchsianGenerator.elliptic (e (.inr j))
2443 let z : ↥(schreierGeneratorSet hT) :=
2445 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k,
2447 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k⟩
2448 have hzWord :
2449 basis.symm
2451 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k) =
2452 (FreeGroup.of z)⁻¹ := by
2453 simpa [source, φ, hT, basis, z] using
2455 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e z
2456 have hxne : x ≠ tailGen j := by
2457 intro hEq
2458 simp only [originalFirstReductionPeriodOneDistinguishedGenerator, Lean.Elab.WF.paramLet, Fin.isValue, id_eq,
2459 FuchsianGenerator.elliptic.injEq, EmbeddingLike.apply_eq_iff_eq, reduceCtorEq, x, tailGen] at hEq
2460 have hyne : y ≠ tailGen j := by
2461 intro hEq
2462 simp only [Fin.isValue, FuchsianGenerator.elliptic.injEq, y, tailGen] at hEq
2463 have hbad := e.injective hEq
2464 cases hbad
2465 have hFirst :
2466 ¬ (z : φ.ker) =
2468 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e := by
2469 intro hEq
2470 have hval := congrArg
2471 (fun z : φ.ker => (z : FreeGroup (FuchsianGenerator source))) hEq
2472 have hleft :
2473 ((z : φ.ker) : FreeGroup (FuchsianGenerator source)) =
2474 (FreeGroup.of x) ^ k.val * FreeGroup.of (tailGen j) *
2475 ((FreeGroup.of x) ^ k.val)⁻¹ := by
2476 simpa [z, source, φ, x, tailGen] using
2478 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k
2479 have hright :
2481 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e : φ.ker) :
2482 FreeGroup (FuchsianGenerator source)) =
2483 (FreeGroup.of x) ^ p := by
2484 simpa [source, φ, x] using
2486 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2487 have hword :
2488 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
2489 FreeGroup.of (tailGen j) *
2490 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ =
2491 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ p := by
2492 simpa [hleft, hright] using hval
2493 let χ : FuchsianGenerator source → Multiplicative ℤ :=
2494 fun u => if u = tailGen j then Multiplicative.ofAdd (1 : ℤ) else 1
2495 have hmap := congrArg (FreeGroup.lift χ) hword
2496 simp only [map_mul, map_pow, FreeGroup.lift_apply_of, hxne, ↓reduceIte, one_pow, one_mul, map_inv, inv_one,
2497 mul_one, ofAdd_eq_one, one_ne_zero, χ] at hmap
2498 have hSecond :
2499 ¬ ∃ k' : Fin p,
2500 (z : φ.ker) =
2502 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k' := by
2503 intro h
2504 rcases h with ⟨k', hEq⟩
2505 have hval := congrArg
2506 (fun z : φ.ker => (z : FreeGroup (FuchsianGenerator source))) hEq
2507 have hleft :
2508 ((z : φ.ker) : FreeGroup (FuchsianGenerator source)) =
2509 (FreeGroup.of x) ^ k.val * FreeGroup.of (tailGen j) *
2510 ((FreeGroup.of x) ^ k.val)⁻¹ := by
2511 simpa [z, source, φ, x, tailGen] using
2513 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k
2514 let r : ℕ := ((k'.val : ZMod p) - 1).val
2515 have hright :
2517 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k' : φ.ker) :
2518 FreeGroup (FuchsianGenerator source)) =
2519 (FreeGroup.of x) ^ k'.val * FreeGroup.of y *
2520 ((FreeGroup.of x) ^ r)⁻¹ := by
2521 simpa [source, φ, x, y, r] using
2523 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k'
2524 have hword :
2525 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
2526 FreeGroup.of (tailGen j) *
2527 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ =
2528 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k'.val *
2529 FreeGroup.of y *
2530 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ r)⁻¹ := by
2531 simpa [hleft, hright] using hval
2532 let χ : FuchsianGenerator source → Multiplicative ℤ :=
2533 fun u => if u = tailGen j then Multiplicative.ofAdd (1 : ℤ) else 1
2534 have hmap := congrArg (FreeGroup.lift χ) hword
2535 simp only [map_mul, map_pow, FreeGroup.lift_apply_of, hxne, ↓reduceIte, one_pow, one_mul, map_inv, inv_one,
2536 mul_one, hyne, ofAdd_eq_one, one_ne_zero, χ] at hmap
2537 have hTail :
2538 ∃ j' : Fin tailLen, ∃ k' : Fin p,
2539 (z : φ.ker) =
2541 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j' k' := ⟨j, k, rfl⟩
2542 let j' : Fin tailLen := Classical.choose hTail
2543 let hk' : ∃ k' : Fin p,
2544 (z : φ.ker) =
2546 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j' k' :=
2547 Classical.choose_spec hTail
2548 let k' : Fin p := Classical.choose hk'
2549 have hTailChoose :
2550 finProdFinEquiv (k', j') = finProdFinEquiv (k, j) := by
2551 have hEqTail :
2553 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k =
2555 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j' k' := by
2556 simpa [z, j', hk', k'] using Classical.choose_spec hk'
2557 rcases
2559 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hEqTail with
2560 ⟨hj, hk⟩
2561 simp only [hk, hj]
2562 have hzImage :
2563 η (FreeGroup.of z) =
2565 simp only [Lean.Elab.WF.paramLet, doublePeriodOneSchreierToTargetHom,
2566 doublePeriodOneSchreierToTargetGeneratorImage, dite_eq_ite, id_eq, FreeGroup.lift_apply_of, hFirst, ↓reduceIte,
2567 hSecond, ↓reduceDIte, hTail, hTailChoose, η, z, target, source, j', k']
2568 calc
2569 η
2570 (basis.symm
2572 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k)) =
2573 η ((FreeGroup.of z)⁻¹) := by rw [hzWord]
2574 _ = (η (FreeGroup.of z))⁻¹ := by rw [map_inv]
2576 rw [hzImage]
2580private theorem oneHeadPeriodOneSchreierToTargetHom_secondEdgeWord
2581 {tailLen p : ℕ}
2582 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
2583 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
2584 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
2585 (e :
2586 OriginalFirstReductionIndex tailLen ≃
2587 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
2588 hTailLen).numPeriods)
2589 (k : Fin p) :
2590 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
2591 let source :=
2592 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
2593 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
2594 let basis :=
2596 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2597 let η :=
2599 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
2600 η
2601 (basis.symm
2603 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k)) =
2605 m₂' tail hp hm₂'ge htail hTailLen k)⁻¹ := by
2606 classical
2607 dsimp
2608 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
2609 let source :=
2610 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
2611 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
2612 let φ :=
2614 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2615 let hT :=
2617 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2618 let basis :=
2620 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2621 let η :=
2623 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
2624 let x : FuchsianGenerator source :=
2626 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2627 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
2628 let tailGen : Fin tailLen → FuchsianGenerator source := fun j =>
2629 FuchsianGenerator.elliptic (e (.inr j))
2630 let z : ↥(schreierGeneratorSet hT) :=
2632 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k,
2634 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k⟩
2635 have hzWord :
2636 basis.symm
2638 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k) =
2639 (FreeGroup.of z)⁻¹ := by
2640 simpa [source, φ, hT, basis, z] using
2642 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e z
2643 have hxne : x ≠ y := by
2644 intro hEq
2645 simp only [originalFirstReductionPeriodOneDistinguishedGenerator, Lean.Elab.WF.paramLet, Fin.isValue, id_eq,
2646 FuchsianGenerator.elliptic.injEq, EmbeddingLike.apply_eq_iff_eq, Sum.inl.injEq, zero_ne_one, x, y] at hEq
2647 have hFirst :
2648 ¬ (z : φ.ker) =
2650 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e := by
2651 intro hEq
2652 have hval := congrArg
2653 (fun z : φ.ker => (z : FreeGroup (FuchsianGenerator source))) hEq
2654 let r : ℕ := ((k.val : ZMod p) - 1).val
2655 have hleft :
2656 ((z : φ.ker) : FreeGroup (FuchsianGenerator source)) =
2657 (FreeGroup.of x) ^ k.val * FreeGroup.of y *
2658 ((FreeGroup.of x) ^ r)⁻¹ := by
2659 simpa [z, source, φ, x, y, r] using
2661 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k
2662 have hright :
2664 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e : φ.ker) :
2665 FreeGroup (FuchsianGenerator source)) =
2666 (FreeGroup.of x) ^ p := by
2667 simpa [source, φ, x] using
2669 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2670 have hword :
2671 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
2672 FreeGroup.of y *
2673 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ r)⁻¹ =
2674 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ p := by
2675 simpa [hleft, hright] using hval
2676 let χ : FuchsianGenerator source → Multiplicative ℤ :=
2677 fun u => if u = y then Multiplicative.ofAdd (1 : ℤ) else 1
2678 have hmap := congrArg (FreeGroup.lift χ) hword
2679 simp only [map_mul, map_pow, FreeGroup.lift_apply_of, hxne, ↓reduceIte, one_pow, one_mul, map_inv, inv_one,
2680 mul_one, ofAdd_eq_one, one_ne_zero, χ] at hmap
2681 have hTail :
2682 ¬ ∃ j' : Fin tailLen, ∃ k' : Fin p,
2683 (z : φ.ker) =
2685 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j' k' := by
2686 intro h
2687 rcases h with ⟨j', k', hEq⟩
2688 have hval := congrArg
2689 (fun z : φ.ker => (z : FreeGroup (FuchsianGenerator source))) hEq
2690 let r : ℕ := ((k.val : ZMod p) - 1).val
2691 have hleft :
2692 ((z : φ.ker) : FreeGroup (FuchsianGenerator source)) =
2693 (FreeGroup.of x) ^ k.val * FreeGroup.of y *
2694 ((FreeGroup.of x) ^ r)⁻¹ := by
2695 simpa [z, source, φ, x, y, r] using
2697 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k
2698 have hright :
2700 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j' k' : φ.ker) :
2701 FreeGroup (FuchsianGenerator source)) =
2702 (FreeGroup.of x) ^ k'.val * FreeGroup.of (tailGen j') *
2703 ((FreeGroup.of x) ^ k'.val)⁻¹ := by
2704 simpa [source, φ, x, tailGen] using
2706 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j' k'
2707 have hword :
2708 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
2709 FreeGroup.of y *
2710 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ r)⁻¹ =
2711 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k'.val *
2712 FreeGroup.of (tailGen j') *
2713 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k'.val)⁻¹ := by
2714 simpa [hleft, hright] using hval
2715 have hyne : y ≠ tailGen j' := by
2716 intro hEq'
2717 simp only [Fin.isValue, FuchsianGenerator.elliptic.injEq, y, tailGen] at hEq'
2718 have hbad := e.injective hEq'
2719 cases hbad
2720 let χ : FuchsianGenerator source → Multiplicative ℤ :=
2721 fun u => if u = y then Multiplicative.ofAdd (1 : ℤ) else 1
2722 have hmap := congrArg (FreeGroup.lift χ) hword
2723 simp only [map_mul, map_pow, FreeGroup.lift_apply_of, hxne, ↓reduceIte, one_pow, one_mul, map_inv, inv_one,
2724 mul_one, mul_ite, left_eq_ite_iff, ofAdd_eq_one, one_ne_zero, imp_false, Decidable.not_not, χ] at hmap
2725 exact hyne hmap.symm
2726 have hSecond :
2727 ∃ k' : Fin p,
2728 (z : φ.ker) =
2730 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k' := ⟨k, rfl⟩
2731 let k' : Fin p := Classical.choose hSecond
2732 have hSecondChoose :
2734 m₂' tail hp hm₂'ge htail hTailLen k' =
2736 m₂' tail hp hm₂'ge htail hTailLen k := by
2737 have hEqSecond :
2739 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k =
2741 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k' := by
2742 simpa [z, k'] using Classical.choose_spec hSecond
2743 have hk :=
2745 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hEqSecond
2746 simp only [hk]
2747 have hzImage :
2748 η (FreeGroup.of z) =
2750 m₂' tail hp hm₂'ge htail hTailLen k := by
2751 simp only [Lean.Elab.WF.paramLet, oneHeadPeriodOneSchreierToTargetHom,
2752 oneHeadPeriodOneSchreierToTargetGeneratorImage, dite_eq_ite, id_eq, FreeGroup.lift_apply_of, hFirst, ↓reduceIte,
2753 hSecond, ↓reduceDIte, hSecondChoose, η, z, k', source]
2754 calc
2755 η
2756 (basis.symm
2758 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k)) =
2759 η ((FreeGroup.of z)⁻¹) := by rw [hzWord]
2760 _ = (η (FreeGroup.of z))⁻¹ := by rw [map_inv]
2761 _ =
2763 m₂' tail hp hm₂'ge htail hTailLen k)⁻¹ := by
2764 rw [hzImage]
2766private theorem doublePeriodOneSchreierToTargetHom_secondEdgeWord
2767 {tailLen p : ℕ}
2768 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
2769 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
2770 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
2771 (hHigh : 3 ≤ p * tailLen)
2772 (e :
2773 OriginalFirstReductionIndex tailLen ≃
2774 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
2775 hTailLen).numPeriods)
2776 (k : Fin p) :
2777 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
2778 let source :=
2779 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
2780 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
2781 let basis :=
2783 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2784 let η :=
2786 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
2787 η
2788 (basis.symm
2790 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k)) =
2792 tail hp htail hHigh k)⁻¹ := by
2793 classical
2794 dsimp
2795 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
2796 let source :=
2797 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
2798 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
2799 let φ :=
2801 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2802 let hT :=
2804 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2805 let basis :=
2807 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2808 let η :=
2810 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
2811 let x : FuchsianGenerator source :=
2813 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2814 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
2815 let tailGen : Fin tailLen → FuchsianGenerator source := fun j =>
2816 FuchsianGenerator.elliptic (e (.inr j))
2817 let z : ↥(schreierGeneratorSet hT) :=
2819 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k,
2821 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k⟩
2822 have hzWord :
2823 basis.symm
2825 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k) =
2826 (FreeGroup.of z)⁻¹ := by
2827 simpa [source, φ, hT, basis, z] using
2829 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e z
2830 have hxne : x ≠ y := by
2831 intro hEq
2832 simp only [originalFirstReductionPeriodOneDistinguishedGenerator, Lean.Elab.WF.paramLet, Fin.isValue, id_eq,
2833 FuchsianGenerator.elliptic.injEq, EmbeddingLike.apply_eq_iff_eq, Sum.inl.injEq, zero_ne_one, x, y] at hEq
2834 have hFirst :
2835 ¬ (z : φ.ker) =
2837 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e := by
2838 intro hEq
2839 have hval := congrArg
2840 (fun z : φ.ker => (z : FreeGroup (FuchsianGenerator source))) hEq
2841 let r : ℕ := ((k.val : ZMod p) - 1).val
2842 have hleft :
2843 ((z : φ.ker) : FreeGroup (FuchsianGenerator source)) =
2844 (FreeGroup.of x) ^ k.val * FreeGroup.of y *
2845 ((FreeGroup.of x) ^ r)⁻¹ := by
2846 simpa [z, source, φ, x, y, r] using
2848 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k
2849 have hright :
2851 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e : φ.ker) :
2852 FreeGroup (FuchsianGenerator source)) =
2853 (FreeGroup.of x) ^ p := by
2854 simpa [source, φ, x] using
2856 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
2857 have hword :
2858 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
2859 FreeGroup.of y *
2860 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ r)⁻¹ =
2861 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ p := by
2862 simpa [hleft, hright] using hval
2863 let χ : FuchsianGenerator source → Multiplicative ℤ :=
2864 fun u => if u = y then Multiplicative.ofAdd (1 : ℤ) else 1
2865 have hmap := congrArg (FreeGroup.lift χ) hword
2866 simp only [map_mul, map_pow, FreeGroup.lift_apply_of, hxne, ↓reduceIte, one_pow, one_mul, map_inv, inv_one,
2867 mul_one, ofAdd_eq_one, one_ne_zero, χ] at hmap
2868 have hTail :
2869 ¬ ∃ j' : Fin tailLen, ∃ k' : Fin p,
2870 (z : φ.ker) =
2872 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j' k' := by
2873 intro h
2874 rcases h with ⟨j', k', hEq⟩
2875 have hval := congrArg
2876 (fun z : φ.ker => (z : FreeGroup (FuchsianGenerator source))) hEq
2877 let r : ℕ := ((k.val : ZMod p) - 1).val
2878 have hleft :
2879 ((z : φ.ker) : FreeGroup (FuchsianGenerator source)) =
2880 (FreeGroup.of x) ^ k.val * FreeGroup.of y *
2881 ((FreeGroup.of x) ^ r)⁻¹ := by
2882 simpa [z, source, φ, x, y, r] using
2884 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k
2885 have hright :
2887 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j' k' : φ.ker) :
2888 FreeGroup (FuchsianGenerator source)) =
2889 (FreeGroup.of x) ^ k'.val * FreeGroup.of (tailGen j') *
2890 ((FreeGroup.of x) ^ k'.val)⁻¹ := by
2891 simpa [source, φ, x, tailGen] using
2893 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j' k'
2894 have hword :
2895 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
2896 FreeGroup.of y *
2897 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ r)⁻¹ =
2898 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k'.val *
2899 FreeGroup.of (tailGen j') *
2900 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k'.val)⁻¹ := by
2901 simpa [hleft, hright] using hval
2902 have hyne : y ≠ tailGen j' := by
2903 intro hEq'
2904 simp only [Fin.isValue, FuchsianGenerator.elliptic.injEq, y, tailGen] at hEq'
2905 have hbad := e.injective hEq'
2906 cases hbad
2907 let χ : FuchsianGenerator source → Multiplicative ℤ :=
2908 fun u => if u = y then Multiplicative.ofAdd (1 : ℤ) else 1
2909 have hmap := congrArg (FreeGroup.lift χ) hword
2910 simp only [map_mul, map_pow, FreeGroup.lift_apply_of, hxne, ↓reduceIte, one_pow, one_mul, map_inv, inv_one,
2911 mul_one, mul_ite, left_eq_ite_iff, ofAdd_eq_one, one_ne_zero, imp_false, Decidable.not_not, χ] at hmap
2912 exact hyne hmap.symm
2913 have hSecond :
2914 ∃ k' : Fin p,
2915 (z : φ.ker) =
2917 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k' := ⟨k, rfl⟩
2918 let k' : Fin p := Classical.choose hSecond
2919 have hSecondChoose :
2921 tail hp htail hHigh k' =
2923 tail hp htail hHigh k := by
2924 have hEqSecond :
2926 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k =
2928 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k' := by
2929 simpa [z, k'] using Classical.choose_spec hSecond
2930 have hk :=
2932 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hEqSecond
2933 simp only [hk]
2934 have hzImage :
2935 η (FreeGroup.of z) =
2937 tail hp htail hHigh k := by
2938 simp only [Lean.Elab.WF.paramLet, doublePeriodOneSchreierToTargetHom,
2939 doublePeriodOneSchreierToTargetGeneratorImage, dite_eq_ite, id_eq, FreeGroup.lift_apply_of, hFirst, ↓reduceIte,
2940 hSecond, ↓reduceDIte, hSecondChoose, η, z, k', source]
2941 calc
2942 η
2943 (basis.symm
2945 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k)) =
2946 η ((FreeGroup.of z)⁻¹) := by rw [hzWord]
2947 _ = (η (FreeGroup.of z))⁻¹ := by rw [map_inv]
2948 _ =
2950 tail hp htail hHigh k)⁻¹ := by
2951 rw [hzImage]
2954 {tailLen p : ℕ}
2955 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
2956 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
2957 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
2958 (hHigh : 3 ≤ p * tailLen)
2959 (e :
2960 OriginalFirstReductionIndex tailLen ≃
2961 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
2962 hTailLen).numPeriods) :
2963 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
2964 let source :=
2965 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
2966 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
2967 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
2968 let θ :=
2970 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
2971 let η :=
2973 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
2974 ∀ y : FuchsianGenerator target,
2975 η (θ (FreeGroup.of y)) * (FreeGroup.of y)⁻¹ ∈
2977 classical
2978 dsimp
2979 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
2980 let source :=
2981 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
2982 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
2983 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
2984 let θ :=
2986 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
2987 let η :=
2989 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
2990 intro y
2991 cases y with
2992 | elliptic i =>
2993 let jk : Fin p × Fin tailLen := finProdFinEquiv.symm i
2994 have hidx : finProdFinEquiv jk = i := by
2995 simpa [jk] using finProdFinEquiv.apply_symm_apply i
2996 have hword :
2997 η
2999 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e).symm
3001 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e jk.2 jk.1)) =
3003 simpa [source, target, η] using
3005 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e jk.2 jk.1
3006 have hidxPair : finProdFinEquiv (jk.1, jk.2) = i := by
3007 simpa [jk] using hidx
3008 have hword' :
3009 η
3011 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e).symm
3013 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e jk.2 jk.1)) =
3014 FreeGroup.of (FuchsianGenerator.elliptic i) := by
3016 have hcomp :
3017 η (θ (FreeGroup.of (FuchsianGenerator.elliptic i))) =
3018 FreeGroup.of (FuchsianGenerator.elliptic i) := by
3019 simpa [θ, η, doublePeriodOneTargetToSchreierHom,
3020 doublePeriodOneTargetToSchreierGeneratorImage, target, jk] using
3021 hword'
3022 have hprod :
3023 η (θ (FreeGroup.of (FuchsianGenerator.elliptic i))) *
3024 (FreeGroup.of (FuchsianGenerator.elliptic i))⁻¹ =
3025 1 := by
3026 simp only [Lean.Elab.WF.paramLet, hcomp, mul_inv_cancel]
3027 rw [hprod]
3029 | surfaceA a =>
3030 fin_cases a
3031 | surfaceB b =>
3032 fin_cases b
3035 {tailLen p : ℕ}
3036 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
3037 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
3038 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
3039 (hHigh : 3 ≤ p * tailLen)
3040 (e :
3041 OriginalFirstReductionIndex tailLen ≃
3042 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
3043 hTailLen).numPeriods)
3044 (hgen :
3045 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3046 let source :=
3047 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3048 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
3049 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3050 let θ :=
3052 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3053 let η :=
3055 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3056 ∀ y : FuchsianGenerator target,
3057 η (θ (FreeGroup.of y)) * (FreeGroup.of y)⁻¹ ∈
3059 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3060 let source :=
3061 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3062 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
3063 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3064 let θ :=
3066 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3067 let η :=
3069 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3070 ∀ y : FreeGroup (FuchsianGenerator target),
3072 classical
3073 dsimp
3074 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3075 let source :=
3076 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3077 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
3078 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3079 let θ :=
3081 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3082 let η :=
3084 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3085 let F : FreeGroup (FuchsianGenerator target) →* FreeGroup (FuchsianGenerator target) :=
3086 η.comp θ
3087 have hgen' :
3088 ∀ y : FuchsianGenerator target,
3089 F (FreeGroup.of y) * (FreeGroup.of y)⁻¹ ∈
3091 intro y
3092 simpa [source, target, θ, η, F] using hgen y
3093 intro y
3094 simpa [F] using
3095 ReidemeisterSchreier.Discrete.Presentations.freeGroup_endomorph_mul_inv_mem_normalClosure_of_generator_mul_inv
3098private theorem oneHeadPeriodOneTargetToSchreierHom_tailBlock
3099 {tailLen p : ℕ}
3100 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
3101 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
3102 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
3103 (e :
3104 OriginalFirstReductionIndex tailLen ≃
3105 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
3106 hTailLen).numPeriods)
3107 (k : Fin p) :
3108 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3109 let source :=
3110 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3111 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3112 let basis :=
3114 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3115 let θ :=
3117 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
3118 θ (oneHeadPeriodOneTargetTailBlockWord m₂' tail hp hm₂'ge htail hTailLen k) =
3119 (List.ofFn (fun j : Fin tailLen =>
3120 basis.symm
3122 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k))).prod := by
3123 classical
3124 dsimp
3125 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3126 let source :=
3127 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3128 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3129 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
3130 let basis :=
3132 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3133 let θ :=
3135 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
3136 change
3137 θ
3138 ((List.ofFn (fun j : Fin tailLen =>
3140 (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k, j))))).prod) =
3141 (List.ofFn (fun j : Fin tailLen =>
3142 basis.symm
3144 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k))).prod
3145 rw [map_list_prod, List.map_ofFn]
3146 apply congrArg List.prod
3147 apply List.ofFn_inj.2
3148 funext j
3149 simp only [Lean.Elab.WF.paramLet, oneHeadPeriodOneTargetToSchreierHom,
3150 oneHeadPeriodOneTargetToSchreierGeneratorImage, oneHeadPeriodOneTargetOrderedIndexEquiv, Equiv.symm_trans_apply,
3151 Equiv.sumCongr_symm, Equiv.refl_symm, Equiv.sumCongr_apply, Equiv.coe_refl, id_eq, xWord, Equiv.trans_apply,
3152 Sum.map_inr, finSumFinEquiv_apply_right, Function.comp_apply, FreeGroup.lift_apply_of,
3153 finSumFinEquiv_symm_apply_natAdd, Equiv.symm_apply_apply, θ, target, basis]
3155private theorem oneHeadPeriodOneSecondEdgeForward_invComp_mem_normalClosure
3156 {tailLen p : ℕ}
3157 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
3158 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
3159 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
3160 (e :
3161 OriginalFirstReductionIndex tailLen ≃
3162 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
3163 hTailLen).numPeriods)
3164 (hperiods :
3165 let source :=
3166 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3167 ∀ x : OriginalFirstReductionIndex tailLen,
3168 source.periods (e x) =
3169 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
3170 (he : e = originalFirstReductionOrderedIndexEquiv tailLen)
3171 (hm₁'one : m₁' = 1)
3172 (k : Fin p) :
3173 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3174 let source :=
3175 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3176 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3177 let ξ :=
3179 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3180 let f := ellipticQuotientGeneratorImage source ξ
3181 let T :=
3183 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3184 let basis :=
3186 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3187 let θ :=
3189 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
3190 θ (oneHeadPeriodOneSecondEdgeForwardWord m₂' tail hp hm₂'ge htail hTailLen k) *
3191 basis.symm
3193 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k) ∈
3194 Subgroup.normalClosure
3196 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
3197 classical
3198 dsimp
3199 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3200 let source :=
3201 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3202 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3203 let ξ :=
3205 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3206 let f := ellipticQuotientGeneratorImage source ξ
3207 let T :=
3209 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3210 let basis :=
3212 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3213 let θ :=
3215 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
3216 let prev : Fin p :=
3217 if k.val = 0 then ⟨p - 1, by omega⟩ else ⟨k.val - 1, by omega⟩
3218 have hbase :
3219 (List.ofFn (fun j : Fin tailLen =>
3220 basis.symm
3222 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j prev))).prod *
3223 basis.symm
3225 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k) ∈
3226 Subgroup.normalClosure
3228 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
3229 simpa [source, ξ, f, T, basis, prev] using
3231 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods he hm₁'one k
3232 by_cases h0 : k.val = 0
3233 · have hword :
3234 oneHeadPeriodOneSecondEdgeForwardWord m₂' tail hp hm₂'ge htail hTailLen k =
3236 m₂' tail hp hm₂'ge htail hTailLen ⟨p - 1, by omega⟩ := by
3238 dsimp
3239 rw [if_pos h0]
3240 rw [hword]
3242 simpa [source, ξ, f, T, basis, θ, prev, h0] using hbase
3243 · have hword :
3244 oneHeadPeriodOneSecondEdgeForwardWord m₂' tail hp hm₂'ge htail hTailLen k =
3246 m₂' tail hp hm₂'ge htail hTailLen ⟨k.val - 1, by omega⟩ := by
3248 dsimp
3249 rw [if_neg h0]
3250 rw [hword]
3252 simpa [source, ξ, f, T, basis, θ, prev, h0] using hbase
3255 {tailLen p : ℕ}
3256 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
3257 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
3258 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
3259 (e :
3260 OriginalFirstReductionIndex tailLen ≃
3261 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
3262 hTailLen).numPeriods)
3263 (hperiods :
3264 let source :=
3265 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3266 ∀ x : OriginalFirstReductionIndex tailLen,
3267 source.periods (e x) =
3268 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
3269 (he : e = originalFirstReductionOrderedIndexEquiv tailLen)
3270 (hm₁'one : m₁' = 1)
3271 (z :
3272 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3273 let source :=
3274 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3275 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3276 let hT :=
3278 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3279 ↥(schreierGeneratorSet hT)) :
3280 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3281 let source :=
3282 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3283 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3284 let ξ :=
3286 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3287 let f := ellipticQuotientGeneratorImage source ξ
3288 let T :=
3290 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3291 let basis :=
3293 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3294 let θ :=
3296 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
3297 let η :=
3299 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
3300 θ (η (FreeGroup.of z)) * (FreeGroup.of z)⁻¹ ∈
3301 Subgroup.normalClosure
3303 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
3304 classical
3305 dsimp
3306 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3307 let source :=
3308 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3309 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3310 let ξ :=
3312 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3313 let f := ellipticQuotientGeneratorImage source ξ
3314 let φ :=
3316 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3317 let T :=
3319 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3320 let hT :=
3322 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3323 let basis :=
3325 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3326 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
3327 let θ :=
3329 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
3330 let η :=
3332 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
3333 let R :=
3335 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)
3336 have hzWord :
3337 (FreeGroup.of z)⁻¹ = basis.symm (z : φ.ker) := by
3338 symm
3339 simp only [Lean.Elab.WF.paramLet, originalFirstReductionPeriodOneSchreierBasisEquiv_symm_apply, basis]
3340 by_cases hFirst :
3341 (z : φ.ker) =
3343 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3344 · have hzFirstWord :
3345 (FreeGroup.of z)⁻¹ =
3346 basis.symm
3348 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e) := by
3349 rw [hzWord, hFirst]
3350 have hη :
3351 η (FreeGroup.of z) = 1 := by
3352 simp only [Lean.Elab.WF.paramLet, oneHeadPeriodOneSchreierToTargetHom,
3353 oneHeadPeriodOneSchreierToTargetGeneratorImage, dite_eq_ite, id_eq, FreeGroup.lift_apply_of, hFirst, ↓reduceIte, η,
3354 source]
3355 have hmem :
3356 basis.symm
3358 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e) ∈
3359 Subgroup.normalClosure R := by
3360 simpa [source, ξ, f, T, basis, R] using
3362 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods hm₁'one
3363 have hprod :
3364 θ (η (FreeGroup.of z)) * (FreeGroup.of z)⁻¹ =
3365 basis.symm
3367 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e) := by
3369 simpa [R] using hprod ▸ hmem
3370 · by_cases hSecond :
3371 ∃ k : Fin p,
3372 (z : φ.ker) =
3374 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k
3375 · let k : Fin p := Classical.choose hSecond
3376 have hzK :
3377 (z : φ.ker) =
3379 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k :=
3380 Classical.choose_spec hSecond
3381 have hzKWord :
3382 (FreeGroup.of z)⁻¹ =
3383 basis.symm
3385 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k) := by
3386 rw [hzWord, hzK]
3387 have hη :
3388 η (FreeGroup.of z) =
3389 oneHeadPeriodOneSecondEdgeForwardWord m₂' tail hp hm₂'ge htail hTailLen k := by
3390 simp only [Lean.Elab.WF.paramLet, oneHeadPeriodOneSchreierToTargetHom,
3391 oneHeadPeriodOneSchreierToTargetGeneratorImage, dite_eq_ite, id_eq, FreeGroup.lift_apply_of, hFirst, ↓reduceIte,
3392 hSecond, ↓reduceDIte, η, k, source]
3393 have hmem :
3394 θ (oneHeadPeriodOneSecondEdgeForwardWord m₂' tail hp hm₂'ge htail hTailLen k) *
3395 basis.symm
3397 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k) ∈
3398 Subgroup.normalClosure R := by
3399 simpa [source, ξ, f, T, basis, θ, R] using
3401 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e hperiods he
3402 hm₁'one k
3403 have hprod :
3404 θ (η (FreeGroup.of z)) * (FreeGroup.of z)⁻¹ =
3406 m₂' tail hp hm₂'ge htail hTailLen k) *
3407 basis.symm
3409 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k) := by
3410 rw [hη, hzKWord]
3411 simpa [R] using hprod ▸ hmem
3412 · rcases
3414 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e z with
3415 hFirstCase | hSecondCase | hTailCase
3416 · exact False.elim (hFirst hFirstCase)
3417 · exact False.elim (hSecond hSecondCase)
3418 · let j : Fin tailLen := Classical.choose hTailCase
3419 let hk : ∃ k : Fin p,
3420 (z : φ.ker) =
3422 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k :=
3423 Classical.choose_spec hTailCase
3424 let k : Fin p := Classical.choose hk
3425 have hzTail :
3426 (z : φ.ker) =
3428 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k :=
3429 Classical.choose_spec hk
3430 have hzTailWord :
3431 (FreeGroup.of z)⁻¹ =
3432 basis.symm
3434 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k) := by
3435 rw [hzWord, hzTail]
3436 have hη :
3437 η (FreeGroup.of z) =
3439 (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k, j))))⁻¹ := by
3440 simp only [Lean.Elab.WF.paramLet, oneHeadPeriodOneSchreierToTargetHom,
3441 oneHeadPeriodOneSchreierToTargetGeneratorImage, dite_eq_ite, id_eq, FreeGroup.lift_apply_of, hFirst, ↓reduceIte,
3442 hSecond, ↓reduceDIte, hTailCase, η, target, k, j, source]
3443 have hθ :
3445 (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k, j)))) =
3446 basis.symm
3448 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k) := by
3449 simp only [Lean.Elab.WF.paramLet, oneHeadPeriodOneTargetToSchreierHom,
3450 oneHeadPeriodOneTargetToSchreierGeneratorImage, oneHeadPeriodOneTargetOrderedIndexEquiv, Equiv.symm_trans_apply,
3451 Equiv.sumCongr_symm, Equiv.refl_symm, Equiv.sumCongr_apply, Equiv.coe_refl, id_eq, xWord, Equiv.trans_apply,
3452 Sum.map_inr, finSumFinEquiv_apply_right, FreeGroup.lift_apply_of, finSumFinEquiv_symm_apply_natAdd,
3453 Equiv.symm_apply_apply, θ, target, basis]
3454 have hprod :
3455 θ (η (FreeGroup.of z)) * (FreeGroup.of z)⁻¹ = 1 := by
3456 rw [hη, map_inv, hθ, hzTailWord]
3457 group
3458 rw [hprod]
3459 exact Subgroup.one_mem (Subgroup.normalClosure R)
3462 {tailLen p : ℕ}
3463 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
3464 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
3465 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
3466 (e :
3467 OriginalFirstReductionIndex tailLen ≃
3468 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
3469 hTailLen).numPeriods)
3470 (hperiods :
3471 let source :=
3472 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3473 ∀ x : OriginalFirstReductionIndex tailLen,
3474 source.periods (e x) =
3475 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
3476 (he : e = originalFirstReductionOrderedIndexEquiv tailLen)
3477 (hm₁'one : m₁' = 1) :
3478 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3479 let source :=
3480 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3481 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3482 let ξ :=
3484 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3485 let f := ellipticQuotientGeneratorImage source ξ
3486 let T :=
3488 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3489 let hT :=
3491 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3492 let basis :=
3494 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3495 let θ :=
3497 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
3498 let η :=
3500 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
3501 ∀ w : FreeGroup ↥(schreierGeneratorSet hT),
3502 θ (η w) * w⁻¹ ∈
3503 Subgroup.normalClosure
3505 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
3506 classical
3507 dsimp
3508 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3509 let source :=
3510 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3511 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3512 let ξ :=
3514 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3515 let f := ellipticQuotientGeneratorImage source ξ
3516 let T :=
3518 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3519 let hT :=
3521 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3522 let basis :=
3524 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3525 let θ :=
3527 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
3528 let η :=
3530 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
3531 let R :=
3533 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)
3534 let F : FreeGroup ↥(schreierGeneratorSet hT) →* FreeGroup ↥(schreierGeneratorSet hT) :=
3535 θ.comp η
3536 have hgen :
3537 ∀ z : ↥(schreierGeneratorSet hT),
3538 F (FreeGroup.of z) * (FreeGroup.of z)⁻¹ ∈ Subgroup.normalClosure R := by
3539 intro z
3540 simpa [source, ξ, f, T, hT, basis, θ, η, R, F] using
3542 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e hperiods he hm₁'one z
3543 intro w
3544 simpa [R, F] using
3545 ReidemeisterSchreier.Discrete.Presentations.freeGroup_endomorph_mul_inv_mem_normalClosure_of_generator_mul_inv R F hgen w
3547private theorem doublePeriodOneTargetToSchreierHom_tailBlock
3548 {tailLen p : ℕ}
3549 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
3550 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
3551 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
3552 (hHigh : 3 ≤ p * tailLen)
3553 (e :
3554 OriginalFirstReductionIndex tailLen ≃
3555 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
3556 hTailLen).numPeriods)
3557 (k : Fin p) :
3558 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3559 let source :=
3560 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3561 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3562 let basis :=
3564 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3565 let θ :=
3567 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3568 θ (doublePeriodOneTargetTailBlockWord tail htail hHigh k) =
3569 (List.ofFn (fun j : Fin tailLen =>
3570 basis.symm
3572 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k))).prod := by
3573 classical
3574 dsimp
3575 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3576 let source :=
3577 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3578 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3579 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
3580 let basis :=
3582 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3583 let θ :=
3585 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3586 have hIndexFst :
3587 ∀ (j : Fin tailLen), (finProdFinEquiv (k, j)).divNat = k := by
3588 intro j
3589 have h := finProdFinEquiv.symm_apply_apply (k, j)
3590 rw [finProdFinEquiv_symm_apply] at h
3591 exact congrArg Prod.fst h
3592 have hIndexSnd :
3593 ∀ (j : Fin tailLen), (finProdFinEquiv (k, j)).modNat = j := by
3594 intro j
3595 have h := finProdFinEquiv.symm_apply_apply (k, j)
3596 rw [finProdFinEquiv_symm_apply] at h
3597 exact congrArg Prod.snd h
3598 change
3599 θ
3600 ((List.ofFn (fun j : Fin tailLen =>
3602 (List.ofFn (fun j : Fin tailLen =>
3603 basis.symm
3605 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k))).prod
3606 rw [map_list_prod, List.map_ofFn]
3607 apply congrArg List.prod
3608 apply List.ofFn_inj.2
3609 funext j
3610 simp only [Lean.Elab.WF.paramLet, doublePeriodOneTargetToSchreierHom,
3611 doublePeriodOneTargetToSchreierGeneratorImage, finProdFinEquiv_symm_apply, id_eq, xWord, Function.comp_apply,
3612 FreeGroup.lift_apply_of, hIndexSnd j, hIndexFst j, θ, target, basis]
3614private theorem doublePeriodOneSecondEdgeForward_invComp_mem_normalClosure
3615 {tailLen p : ℕ}
3616 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
3617 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
3618 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
3619 (hHigh : 3 ≤ p * tailLen)
3620 (e :
3621 OriginalFirstReductionIndex tailLen ≃
3622 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
3623 hTailLen).numPeriods)
3624 (hperiods :
3625 let source :=
3626 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3627 ∀ x : OriginalFirstReductionIndex tailLen,
3628 source.periods (e x) =
3629 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
3630 (he : e = originalFirstReductionOrderedIndexEquiv tailLen)
3631 (hm₁'one : m₁' = 1)
3632 (k : Fin p) :
3633 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3634 let source :=
3635 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3636 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3637 let ξ :=
3639 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3640 let f := ellipticQuotientGeneratorImage source ξ
3641 let T :=
3643 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3644 let basis :=
3646 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3647 let θ :=
3649 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3650 θ (doublePeriodOneSecondEdgeForwardWord tail hp htail hHigh k) *
3651 basis.symm
3653 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k) ∈
3654 Subgroup.normalClosure
3656 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
3657 classical
3658 dsimp
3659 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3660 let source :=
3661 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3662 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3663 let ξ :=
3665 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3666 let f := ellipticQuotientGeneratorImage source ξ
3667 let T :=
3669 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3670 let basis :=
3672 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3673 let θ :=
3675 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3676 let prev : Fin p :=
3677 if k.val = 0 then ⟨p - 1, by omega⟩ else ⟨k.val - 1, by omega⟩
3678 have hbase :
3679 (List.ofFn (fun j : Fin tailLen =>
3680 basis.symm
3682 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j prev))).prod *
3683 basis.symm
3685 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k) ∈
3686 Subgroup.normalClosure
3688 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
3689 simpa [source, ξ, f, T, basis, prev] using
3691 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods he hm₁'one k
3692 by_cases h0 : k.val = 0
3693 · have hword :
3694 doublePeriodOneSecondEdgeForwardWord tail hp htail hHigh k =
3695 doublePeriodOneTargetTailBlockWord tail htail hHigh ⟨p - 1, by omega⟩ := by
3697 dsimp
3698 rw [if_pos h0]
3699 rw [hword]
3701 simpa [source, ξ, f, T, basis, θ, prev, h0] using hbase
3702 · have hword :
3703 doublePeriodOneSecondEdgeForwardWord tail hp htail hHigh k =
3704 doublePeriodOneTargetTailBlockWord tail htail hHigh ⟨k.val - 1, by omega⟩ := by
3706 dsimp
3707 rw [if_neg h0]
3708 rw [hword]
3710 simpa [source, ξ, f, T, basis, θ, prev, h0] using hbase
3713 {tailLen p : ℕ}
3714 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
3715 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
3716 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
3717 (hHigh : 3 ≤ p * tailLen)
3718 (e :
3719 OriginalFirstReductionIndex tailLen ≃
3720 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
3721 hTailLen).numPeriods)
3722 (hperiods :
3723 let source :=
3724 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3725 ∀ x : OriginalFirstReductionIndex tailLen,
3726 source.periods (e x) =
3727 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
3728 (he : e = originalFirstReductionOrderedIndexEquiv tailLen)
3729 (hm₁'one : m₁' = 1)
3730 (z :
3731 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3732 let source :=
3733 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3734 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3735 let hT :=
3737 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3738 ↥(schreierGeneratorSet hT)) :
3739 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3740 let source :=
3741 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3742 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3743 let ξ :=
3745 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3746 let f := ellipticQuotientGeneratorImage source ξ
3747 let T :=
3749 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3750 let basis :=
3752 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3753 let θ :=
3755 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3756 let η :=
3758 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3759 θ (η (FreeGroup.of z)) * (FreeGroup.of z)⁻¹ ∈
3760 Subgroup.normalClosure
3762 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
3763 classical
3764 dsimp
3765 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3766 let source :=
3767 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3768 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3769 let ξ :=
3771 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3772 let f := ellipticQuotientGeneratorImage source ξ
3773 let φ :=
3775 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3776 let T :=
3778 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3779 let hT :=
3781 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3782 let basis :=
3784 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3785 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
3786 let θ :=
3788 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3789 let η :=
3791 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3792 let R :=
3794 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)
3795 have hzWord :
3796 (FreeGroup.of z)⁻¹ = basis.symm (z : φ.ker) := by
3797 symm
3798 simp only [Lean.Elab.WF.paramLet, originalFirstReductionPeriodOneSchreierBasisEquiv_symm_apply, basis]
3799 by_cases hFirst :
3800 (z : φ.ker) =
3802 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3803 · have hzFirstWord :
3804 (FreeGroup.of z)⁻¹ =
3805 basis.symm
3807 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e) := by
3808 rw [hzWord, hFirst]
3809 have hη :
3810 η (FreeGroup.of z) = 1 := by
3811 simp only [Lean.Elab.WF.paramLet, doublePeriodOneSchreierToTargetHom,
3812 doublePeriodOneSchreierToTargetGeneratorImage, dite_eq_ite, id_eq, FreeGroup.lift_apply_of, hFirst, ↓reduceIte, η,
3813 source]
3814 have hmem :
3815 basis.symm
3817 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e) ∈
3818 Subgroup.normalClosure R := by
3819 simpa [source, ξ, f, T, basis, R] using
3821 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods hm₁'one
3822 have hprod :
3823 θ (η (FreeGroup.of z)) * (FreeGroup.of z)⁻¹ =
3824 basis.symm
3826 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e) := by
3828 simpa [R] using hprod ▸ hmem
3829 · by_cases hSecond :
3830 ∃ k : Fin p,
3831 (z : φ.ker) =
3833 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k
3834 · let k : Fin p := Classical.choose hSecond
3835 have hzK :
3836 (z : φ.ker) =
3838 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k :=
3839 Classical.choose_spec hSecond
3840 have hzKWord :
3841 (FreeGroup.of z)⁻¹ =
3842 basis.symm
3844 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k) := by
3845 rw [hzWord, hzK]
3846 have hη :
3847 η (FreeGroup.of z) =
3848 doublePeriodOneSecondEdgeForwardWord tail hp htail hHigh k := by
3849 simp only [Lean.Elab.WF.paramLet, doublePeriodOneSchreierToTargetHom,
3850 doublePeriodOneSchreierToTargetGeneratorImage, dite_eq_ite, id_eq, FreeGroup.lift_apply_of, hFirst, ↓reduceIte,
3851 hSecond, ↓reduceDIte, η, k, source]
3852 have hmem :
3853 θ (doublePeriodOneSecondEdgeForwardWord tail hp htail hHigh k) *
3854 basis.symm
3856 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k) ∈
3857 Subgroup.normalClosure R := by
3858 simpa [source, ξ, f, T, basis, θ, R] using
3860 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e hperiods he
3861 hm₁'one k
3862 have hprod :
3863 θ (η (FreeGroup.of z)) * (FreeGroup.of z)⁻¹ =
3864 θ (doublePeriodOneSecondEdgeForwardWord tail hp htail hHigh k) *
3865 basis.symm
3867 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k) := by
3868 rw [hη, hzKWord]
3869 simpa [R] using hprod ▸ hmem
3870 · rcases
3872 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e z with
3873 hFirstCase | hSecondCase | hTailCase
3874 · exact False.elim (hFirst hFirstCase)
3875 · exact False.elim (hSecond hSecondCase)
3876 · let j : Fin tailLen := Classical.choose hTailCase
3877 let hk : ∃ k : Fin p,
3878 (z : φ.ker) =
3880 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k :=
3881 Classical.choose_spec hTailCase
3882 let k : Fin p := Classical.choose hk
3883 have hzTail :
3884 (z : φ.ker) =
3886 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k :=
3887 Classical.choose_spec hk
3888 have hzTailWord :
3889 (FreeGroup.of z)⁻¹ =
3890 basis.symm
3892 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k) := by
3893 rw [hzWord, hzTail]
3894 have hη :
3895 η (FreeGroup.of z) =
3897 simp only [Lean.Elab.WF.paramLet, doublePeriodOneSchreierToTargetHom,
3898 doublePeriodOneSchreierToTargetGeneratorImage, dite_eq_ite, id_eq, FreeGroup.lift_apply_of, hFirst, ↓reduceIte,
3899 hSecond, ↓reduceDIte, hTailCase, η, target, k, j, source]
3900 have hIndexFst :
3901 (finProdFinEquiv (k, j)).divNat = k := by
3902 have h := finProdFinEquiv.symm_apply_apply (k, j)
3903 rw [finProdFinEquiv_symm_apply] at h
3904 exact congrArg Prod.fst h
3905 have hIndexSnd :
3906 (finProdFinEquiv (k, j)).modNat = j := by
3907 have h := finProdFinEquiv.symm_apply_apply (k, j)
3908 rw [finProdFinEquiv_symm_apply] at h
3909 exact congrArg Prod.snd h
3910 have hθ :
3912 basis.symm
3914 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k) := by
3915 simp only [Lean.Elab.WF.paramLet, doublePeriodOneTargetToSchreierHom,
3916 doublePeriodOneTargetToSchreierGeneratorImage, finProdFinEquiv_symm_apply, id_eq, xWord, FreeGroup.lift_apply_of,
3917 hIndexSnd, hIndexFst, θ, target, basis]
3918 have hprod :
3919 θ (η (FreeGroup.of z)) * (FreeGroup.of z)⁻¹ = 1 := by
3920 rw [hη, map_inv, hθ, hzTailWord]
3921 group
3922 rw [hprod]
3923 exact Subgroup.one_mem (Subgroup.normalClosure R)
3926 {tailLen p : ℕ}
3927 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
3928 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
3929 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
3930 (hHigh : 3 ≤ p * tailLen)
3931 (e :
3932 OriginalFirstReductionIndex tailLen ≃
3933 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
3934 hTailLen).numPeriods)
3935 (hperiods :
3936 let source :=
3937 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3938 ∀ x : OriginalFirstReductionIndex tailLen,
3939 source.periods (e x) =
3940 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
3941 (he : e = originalFirstReductionOrderedIndexEquiv tailLen)
3942 (hm₁'one : m₁' = 1) :
3943 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3944 let source :=
3945 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3946 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3947 let ξ :=
3949 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3950 let f := ellipticQuotientGeneratorImage source ξ
3951 let T :=
3953 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3954 let hT :=
3956 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3957 let basis :=
3959 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3960 let θ :=
3962 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3963 let η :=
3965 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3966 ∀ w : FreeGroup ↥(schreierGeneratorSet hT),
3967 θ (η w) * w⁻¹ ∈
3968 Subgroup.normalClosure
3970 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)) := by
3971 classical
3972 dsimp
3973 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
3974 let source :=
3975 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
3976 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
3977 let ξ :=
3979 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3980 let f := ellipticQuotientGeneratorImage source ξ
3981 let T :=
3983 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3984 let hT :=
3986 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3987 let basis :=
3989 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
3990 let θ :=
3992 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3993 let η :=
3995 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
3996 let R :=
3998 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T)
3999 let F : FreeGroup ↥(schreierGeneratorSet hT) →* FreeGroup ↥(schreierGeneratorSet hT) :=
4000 θ.comp η
4001 have hgen :
4002 ∀ z : ↥(schreierGeneratorSet hT),
4003 F (FreeGroup.of z) * (FreeGroup.of z)⁻¹ ∈ Subgroup.normalClosure R := by
4004 intro z
4005 simpa [source, ξ, f, T, hT, basis, θ, η, R, F] using
4007 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e hperiods he hm₁'one z
4008 intro w
4009 simpa [R, F] using
4010 ReidemeisterSchreier.Discrete.Presentations.freeGroup_endomorph_mul_inv_mem_normalClosure_of_generator_mul_inv R F hgen w
4012private theorem periodOne_negOneCycleSegmentProduct_eq {G : Type*} [Group G]
4013 (x y : G) : ∀ (n l : ℕ), l ≤ n →
4014 (List.ofFn (fun i : Fin l =>
4015 x ^ (n - i.val) * y * (x ^ (n - 1 - i.val))⁻¹)).prod =
4016 x ^ n * y ^ l * (x ^ (n - l))⁻¹
4017 | n, 0, _ => by
4018 simp only [List.ofFn_zero, List.prod_nil, pow_zero, mul_one, tsub_zero, mul_inv_cancel]
4019 | n, l + 1, h => by
4020 have hl : l ≤ n - 1 := by omega
4021 rw [List.ofFn_succ, List.prod_cons]
4022 simp only [Fin.val_zero, tsub_zero]
4023 change
4024 x ^ n * y * (x ^ (n - 1))⁻¹ *
4025 (List.ofFn (fun i : Fin l =>
4026 x ^ (n - (i.val + 1)) * y * (x ^ (n - 1 - (i.val + 1)))⁻¹)).prod =
4027 x ^ n * y ^ (l + 1) * (x ^ (n - (l + 1)))⁻¹
4028 have htail :
4029 (List.ofFn (fun i : Fin l =>
4030 x ^ (n - (i.val + 1)) * y * (x ^ (n - 1 - (i.val + 1)))⁻¹)).prod =
4031 (List.ofFn (fun i : Fin l =>
4032 x ^ (n - 1 - i.val) * y * (x ^ (n - 1 - 1 - i.val))⁻¹)).prod := by
4033 congr
4034 funext i
4035 have h1 : n - (i.val + 1) = n - 1 - i.val := by omega
4036 have h2 : n - 1 - (i.val + 1) = n - 1 - 1 - i.val := by omega
4037 simp only [h1, h2]
4038 rw [htail]
4039 rw [periodOne_negOneCycleSegmentProduct_eq x y (n - 1) l hl]
4040 have hnl : n - 1 - l = n - (l + 1) := by omega
4041 rw [hnl]
4042 rw [pow_succ']
4043 group
4045private theorem periodOne_list_ofFn_desc_inv_prod_eq
4046 {G : Type*} [Group G] {n : ℕ} (B : Fin n → G) :
4047 (List.ofFn (fun i : Fin n => (B ⟨n - 1 - i.val, by omega⟩)⁻¹)).prod =
4048 (List.ofFn B).prod⁻¹ := by
4049 by_cases hn : n = 0
4050 · subst n
4051 simp only [zero_tsub, List.ofFn_zero, List.prod_nil, inv_one]
4052 · have hpos : 0 < n := Nat.pos_of_ne_zero hn
4053 have hrev := list_ofFn_reverse_last_desc hpos B
4054 rw [List.prod_inv_reverse]
4055 rw [← List.map_reverse, hrev, List.map_cons, List.prod_cons, List.map_ofFn]
4056 have hlen : n = (n - 1) + 1 := by omega
4057 rw [List.ofFn_congr hlen]
4058 rw [List.ofFn_succ, List.prod_cons]
4059 congr 1
4060 apply congrArg List.prod
4061 apply List.ofFn_inj.2
4062 funext i
4063 apply congrArg Inv.inv
4064 apply congrArg B
4065 ext
4066 simp only [Fin.val_cast, Fin.val_succ]
4067 omega
4069private theorem periodOne_list_ofFn_split_at
4070 {α : Type*} {p k : ℕ} (hk : k ≤ p) (f : Fin p → α) :
4071 List.ofFn f =
4072 List.ofFn (fun i : Fin k => f ⟨i.val, by omega⟩) ++
4073 List.ofFn (fun i : Fin (p - k) => f ⟨k + i.val, by omega⟩) := by
4074 let pref : Fin k → α := fun i => f ⟨i.val, by omega⟩
4075 let suff : Fin (p - k) → α := fun i => f ⟨k + i.val, by omega⟩
4076 have hlen : p = k + (p - k) := by omega
4077 rw [List.ofFn_congr hlen]
4078 rw [← List.ofFn_fin_append pref suff]
4079 congr
4080 funext i
4081 cases i using Fin.addCases with
4082 | left r =>
4083 dsimp [pref, suff]
4084 rw [Fin.append_left]
4085 apply congrArg f
4086 ext
4087 simp only [Fin.val_cast, Fin.val_castAdd]
4088 | right j =>
4089 dsimp [pref, suff]
4090 rw [Fin.append_right]
4091 apply congrArg f
4092 ext
4093 simp only [Fin.val_cast, Fin.val_natAdd]
4095private theorem periodOne_cyclic_rotated_inv_mem_normalClosure_of_list_prod
4096 {G : Type*} [Group G] {R : Set G} {p : ℕ}
4097 (block : Fin p → G) (k : Fin p)
4098 (hTotal : (List.ofFn block).prod ∈ Subgroup.normalClosure R) :
4099 ((List.ofFn (fun i : Fin (p - k.val) => block ⟨k.val + i.val, by omega⟩)).prod *
4100 (List.ofFn (fun i : Fin k.val => block ⟨i.val, by omega⟩)).prod)⁻¹ ∈
4101 Subgroup.normalClosure R := by
4102 let N : Subgroup G := Subgroup.normalClosure R
4103 let pref : G := (List.ofFn (fun i : Fin k.val => block ⟨i.val, by omega⟩)).prod
4104 let suff : G :=
4105 (List.ofFn (fun i : Fin (p - k.val) => block ⟨k.val + i.val, by omega⟩)).prod
4106 have hsplit : (List.ofFn block).prod = pref * suff := by
4107 rw [periodOne_list_ofFn_split_at (Nat.le_of_lt k.isLt) block]
4108 rw [List.prod_append]
4109 have hprefSuff : pref * suff ∈ N := by
4110 simpa [N, hsplit] using hTotal
4111 have hrot : suff * pref ∈ N := by
4112 simpa [N] using
4113 (ReidemeisterSchreier.Discrete.Presentations.cyclic_rotation_mem_normalClosure
4114 (R := R) (a := pref) (b := suff) hprefSuff)
4115 exact N.inv_mem hrot
4118 {G : Type*} [Group G] {R : Set G} {p : ℕ}
4119 (head : G) (block : Fin p → G) (k : Fin p) (m : ℕ)
4120 (hTotal : head * (List.ofFn block).prod ∈ Subgroup.normalClosure R)
4121 (hHeadPow : head ^ m ∈ Subgroup.normalClosure R) :
4122 (((List.ofFn (fun i : Fin (p - k.val) =>
4123 block ⟨k.val + i.val, by omega⟩)).prod *
4124 (List.ofFn (fun i : Fin k.val =>
4125 block ⟨i.val, by omega⟩)).prod)⁻¹) ^ m ∈
4126 Subgroup.normalClosure R := by
4127 let N : Subgroup G := Subgroup.normalClosure R
4128 let pref : G :=
4129 (List.ofFn (fun i : Fin k.val => block ⟨i.val, by omega⟩)).prod
4130 let suff : G :=
4131 (List.ofFn (fun i : Fin (p - k.val) => block ⟨k.val + i.val, by omega⟩)).prod
4132 let full : G := (List.ofFn block).prod
4133 have hsplit : full = pref * suff := by
4134 dsimp [full, pref, suff]
4135 rw [periodOne_list_ofFn_split_at (Nat.le_of_lt k.isLt) block]
4136 rw [List.prod_append]
4137 have hfullInvHead :
4138 full⁻¹ * head⁻¹ ∈ N := by
4139 have hinv : (head * full)⁻¹ ∈ N := N.inv_mem hTotal
4140 simpa [N, mul_assoc] using hinv
4141 have hfullInvPow : full⁻¹ ^ m ∈ N :=
4142 ReidemeisterSchreier.Discrete.Presentations.pow_mem_normalClosure_of_mul_inv_mem
4143 (R := R) (u := full⁻¹) (v := head) (n := m) hfullInvHead hHeadPow
4144 have hrotEq : (suff * pref)⁻¹ = pref⁻¹ * full⁻¹ * pref := by
4145 rw [hsplit]
4146 group
4147 have hpowEq :
4148 (suff * pref)⁻¹ ^ m = pref⁻¹ * (full⁻¹ ^ m) * pref := by
4149 rw [hrotEq]
4150 have h :
4151 (pref⁻¹ * full⁻¹ * (pref⁻¹)⁻¹) ^ m =
4152 pref⁻¹ * (full⁻¹ ^ m) * (pref⁻¹)⁻¹ := by
4153 rw [conj_pow]
4154 simpa using h
4155 have hconj :
4156 pref⁻¹ * (full⁻¹ ^ m) * (pref⁻¹)⁻¹ ∈ N :=
4157 Subgroup.normalClosure_normal.conj_mem (full⁻¹ ^ m) hfullInvPow pref⁻¹
4158 have hrotPow : (suff * pref)⁻¹ ^ m ∈ N := by
4159 rw [hpowEq]
4160 simpa using hconj
4161 simpa [pref, suff] using hrotPow
4163private theorem periodOne_cyclic_desc_prevBlock_inv_product_eq_rotated_inv
4164 {G : Type*} [Group G] {p : ℕ} (hp : 2 ≤ p) (block : Fin p → G) (k : Fin p) :
4165 (List.ofFn (fun i : Fin k.val =>
4166 (block ⟨k.val - 1 - i.val, by omega⟩)⁻¹)).prod *
4167 (block ⟨p - 1, by omega⟩)⁻¹ *
4168 (List.ofFn (fun i : Fin (p - 1 - k.val) =>
4169 (block ⟨p - 2 - i.val, by omega⟩)⁻¹)).prod =
4170 ((List.ofFn (fun i : Fin (p - k.val) =>
4171 block ⟨k.val + i.val, by omega⟩)).prod *
4172 (List.ofFn (fun i : Fin k.val => block ⟨i.val, by omega⟩)).prod)⁻¹ := by
4173 let prefB : Fin k.val → G := fun i => block ⟨i.val, by omega⟩
4174 let suffB : Fin (p - k.val) → G := fun i => block ⟨k.val + i.val, by omega⟩
4175 have hLower :
4176 (List.ofFn (fun i : Fin k.val =>
4177 (block ⟨k.val - 1 - i.val, by omega⟩)⁻¹)).prod =
4178 (List.ofFn prefB).prod⁻¹ := by
4179 simpa [prefB] using periodOne_list_ofFn_desc_inv_prod_eq prefB
4180 have hSuffDesc :
4181 (List.ofFn (fun i : Fin (p - k.val) =>
4182 (suffB ⟨p - k.val - 1 - i.val, by omega⟩)⁻¹)).prod =
4183 (List.ofFn suffB).prod⁻¹ :=
4185 have hSuffSplit :
4186 (List.ofFn (fun i : Fin (p - k.val) =>
4187 (suffB ⟨p - k.val - 1 - i.val, by omega⟩)⁻¹)).prod =
4188 (block ⟨p - 1, by omega⟩)⁻¹ *
4189 (List.ofFn (fun i : Fin (p - 1 - k.val) =>
4190 (block ⟨p - 2 - i.val, by omega⟩)⁻¹)).prod := by
4191 have hlen : p - k.val = (p - 1 - k.val) + 1 := by omega
4192 rw [List.ofFn_congr hlen]
4193 rw [List.ofFn_succ, List.prod_cons]
4194 congr 1
4195 · simp only [Fin.val_cast, Fin.coe_ofNat_eq_mod, Nat.zero_mod, tsub_zero, inv_inj, suffB]
4196 apply congrArg block
4197 ext
4198 simp only
4199 omega
4200 · apply congrArg List.prod
4201 apply List.ofFn_inj.2
4202 funext i
4203 simp only [Fin.val_cast, Fin.val_succ, inv_inj, suffB]
4204 apply congrArg block
4205 ext
4206 simp only
4207 omega
4208 have hSuff :
4209 (block ⟨p - 1, by omega⟩)⁻¹ *
4210 (List.ofFn (fun i : Fin (p - 1 - k.val) =>
4211 (block ⟨p - 2 - i.val, by omega⟩)⁻¹)).prod =
4212 (List.ofFn suffB).prod⁻¹ := by
4213 rw [← hSuffSplit]
4214 exact hSuffDesc
4215 rw [hLower]
4216 rw [mul_assoc]
4217 rw [hSuff]
4218 simp only [mul_inv_rev, prefB, suffB]
4221 {tailLen p : ℕ}
4222 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
4223 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
4224 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
4225 (e :
4226 OriginalFirstReductionIndex tailLen ≃
4227 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
4228 hTailLen).numPeriods)
4229 (k : Fin p) :
4230 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
4231 let source :=
4232 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
4233 let φ :=
4235 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4236 let x : FuchsianGenerator source :=
4238 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4239 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
4240 let edge : Fin p → φ.ker :=
4242 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4243 let lower :=
4244 (List.ofFn (fun i : Fin k.val => edge ⟨k.val - i.val, by omega⟩)).prod
4245 let wrap := edge ⟨0, lt_of_lt_of_le (by decide : 0 < 2) hp⟩
4246 let upper :=
4247 (List.ofFn (fun i : Fin (p - 1 - k.val) => edge ⟨p - 1 - i.val, by omega⟩)).prod
4248 lower * wrap * upper =
4249 (⟨(FreeGroup.of x) ^ k.val * (FreeGroup.of y) ^ p *
4250 ((FreeGroup.of x) ^ k.val)⁻¹, by
4251 rw [MonoidHom.mem_ker]
4252 have hx : φ (FreeGroup.of x) = Multiplicative.ofAdd (1 : ZMod p) := by
4253 simpa [φ, x, originalFirstReductionPeriodOneDistinguishedGenerator] using
4255 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4256 have hy : φ (FreeGroup.of y) = Multiplicative.ofAdd (-1 : ZMod p) := by
4257 simpa [φ, y] using
4259 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4261 apply (Multiplicative.toAdd : Multiplicative (ZMod p) ≃ ZMod p).injective
4262 simp only [ofAdd_neg, inv_pow, mul_inv_cancel_comm, toAdd_inv, toAdd_pow, toAdd_ofAdd, nsmul_eq_mul,
4263 CharP.cast_eq_zero, mul_one, neg_zero, toAdd_one]⟩ : φ.ker) := by
4264 classical
4265 dsimp
4266 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
4267 let source :=
4268 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
4269 let φ :=
4271 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4272 let x : FuchsianGenerator source :=
4274 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4275 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
4276 let edge : Fin p → φ.ker :=
4278 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4279 let lower :=
4280 (List.ofFn (fun i : Fin k.val => edge ⟨k.val - i.val, by omega⟩)).prod
4281 let wrap := edge ⟨0, lt_of_lt_of_le (by decide : 0 < 2) hp⟩
4282 let upper :=
4283 (List.ofFn (fun i : Fin (p - 1 - k.val) => edge ⟨p - 1 - i.val, by omega⟩)).prod
4284 apply Subtype.ext
4285 change
4286 ((lower * wrap * upper : φ.ker) : FreeGroup (FuchsianGenerator source)) =
4287 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
4288 (FreeGroup.of y) ^ p *
4289 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹
4290 have hlowerCoe :
4291 ((lower : φ.ker) : FreeGroup (FuchsianGenerator source)) =
4292 (List.ofFn (fun i : Fin k.val =>
4293 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (k.val - i.val) *
4294 FreeGroup.of y *
4295 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^
4296 (k.val - 1 - i.val))⁻¹)).prod := by
4297 change
4298 φ.ker.subtype lower =
4299 (List.ofFn (fun i : Fin k.val =>
4300 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (k.val - i.val) *
4301 FreeGroup.of y *
4302 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^
4303 (k.val - 1 - i.val))⁻¹)).prod
4304 simp only [Subgroup.subtype_apply, Subgroup.val_list_prod, List.map_ofFn, lower, edge]
4305 apply congrArg List.prod
4306 apply List.ofFn_inj.2
4307 funext i
4308 haveI : Fact (1 < p) := ⟨by omega⟩
4309 have hrval :
4310 (((k.val - i.val : ℕ) : ZMod p) - 1).val = k.val - 1 - i.val := by
4311 have hrpos : 0 < k.val - i.val := by omega
4312 have hrlt : k.val - i.val < p := by omega
4313 have hval : ((k.val - i.val : ℕ) : ZMod p).val = k.val - i.val :=
4314 ZMod.val_natCast_of_lt hrlt
4315 have hle : (1 : ZMod p).val ≤ ((k.val - i.val : ℕ) : ZMod p).val := by
4316 rw [hval, ZMod.val_one]
4317 exact Nat.succ_le_iff.mpr hrpos
4318 rw [ZMod.val_sub hle, hval, ZMod.val_one]
4319 omega
4320 have hrvalZ :
4321 ((k.val : ZMod p) - (i.val : ZMod p) - 1).val = k.val - 1 - i.val := by
4322 have hkval : ((k.val : ℕ) : ZMod p).val = k.val :=
4323 ZMod.val_natCast_of_lt k.isLt
4324 have hilt : i.val < p := by omega
4325 have hival : ((i.val : ℕ) : ZMod p).val = i.val :=
4326 ZMod.val_natCast_of_lt hilt
4327 have hleki : ((i.val : ℕ) : ZMod p).val ≤ ((k.val : ℕ) : ZMod p).val := by
4328 rw [hkval, hival]
4329 omega
4330 have hsub :
4331 ((k.val : ZMod p) - (i.val : ZMod p)).val = k.val - i.val := by
4332 rw [ZMod.val_sub hleki, hkval, hival]
4333 have hrpos : 0 < k.val - i.val := by omega
4334 have hle :
4335 (1 : ZMod p).val ≤ ((k.val : ZMod p) - (i.val : ZMod p)).val := by
4336 rw [hsub, ZMod.val_one]
4337 exact Nat.succ_le_iff.mpr hrpos
4338 rw [ZMod.val_sub hle, hsub, ZMod.val_one]
4339 omega
4340 simpa [source, φ, x, y, edge, hrval, hrvalZ] using
4342 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4343 (⟨k.val - i.val, by omega⟩ : Fin p)
4344 have hwrapCoe :
4345 ((wrap : φ.ker) : FreeGroup (FuchsianGenerator source)) =
4346 FreeGroup.of y *
4347 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1))⁻¹ := by
4348 haveI : Fact (1 < p) := ⟨by omega⟩
4349 have hr0 : ((-1 : ZMod p).val) = p - 1 := by
4350 have hsucc : (p - 1).succ = p := by omega
4351 rw [← hsucc]
4352 exact ZMod.val_neg_one (p - 1)
4353 simpa [source, φ, x, y, edge, wrap, hr0] using
4355 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4356 (⟨0, lt_of_lt_of_le (by decide : 0 < 2) hp⟩ : Fin p)
4357 have hupperCoe :
4358 ((upper : φ.ker) : FreeGroup (FuchsianGenerator source)) =
4359 (List.ofFn (fun i : Fin (p - 1 - k.val) =>
4360 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1 - i.val) *
4361 FreeGroup.of y *
4362 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^
4363 (p - 1 - 1 - i.val))⁻¹)).prod := by
4364 change
4365 φ.ker.subtype upper =
4366 (List.ofFn (fun i : Fin (p - 1 - k.val) =>
4367 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1 - i.val) *
4368 FreeGroup.of y *
4369 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^
4370 (p - 1 - 1 - i.val))⁻¹)).prod
4371 simp only [Subgroup.subtype_apply, Subgroup.val_list_prod, List.map_ofFn, upper, edge]
4372 apply congrArg List.prod
4373 apply List.ofFn_inj.2
4374 funext i
4375 haveI : Fact (1 < p) := ⟨by omega⟩
4376 have hrval :
4377 (((p - 1 - i.val : ℕ) : ZMod p) - 1).val = p - 1 - 1 - i.val := by
4378 have hrpos : 0 < p - 1 - i.val := by omega
4379 have hrlt : p - 1 - i.val < p := by omega
4380 have hval : ((p - 1 - i.val : ℕ) : ZMod p).val = p - 1 - i.val :=
4381 ZMod.val_natCast_of_lt hrlt
4382 have hle : (1 : ZMod p).val ≤ ((p - 1 - i.val : ℕ) : ZMod p).val := by
4383 rw [hval, ZMod.val_one]
4384 exact Nat.succ_le_iff.mpr hrpos
4385 rw [ZMod.val_sub hle, hval, ZMod.val_one]
4386 omega
4387 simpa [source, φ, x, y, edge, hrval] using
4389 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4390 (⟨p - 1 - i.val, by omega⟩ : Fin p)
4391 change
4392 ((lower : φ.ker) : FreeGroup (FuchsianGenerator source)) *
4393 ((wrap : φ.ker) : FreeGroup (FuchsianGenerator source)) *
4394 ((upper : φ.ker) : FreeGroup (FuchsianGenerator source)) =
4395 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
4396 (FreeGroup.of y) ^ p *
4397 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹
4398 rw [hlowerCoe, hwrapCoe, hupperCoe]
4399 rw [periodOne_negOneCycleSegmentProduct_eq (FreeGroup.of x) (FreeGroup.of y)
4400 k.val k.val (by omega)]
4401 rw [periodOne_negOneCycleSegmentProduct_eq (FreeGroup.of x) (FreeGroup.of y)
4402 (p - 1) (p - 1 - k.val) (by omega)]
4403 have hkk : k.val - k.val = 0 := by omega
4404 have hlast : p - 1 - (p - 1 - k.val) = k.val := by omega
4405 rw [hkk, hlast]
4406 simp only [pow_zero, inv_one, mul_one]
4407 have hkadd : k.val + 1 + (p - 1 - k.val) = p := by omega
4408 calc
4409 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
4410 (FreeGroup.of y) ^ k.val *
4411 (FreeGroup.of y * ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1))⁻¹) *
4412 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1) *
4413 (FreeGroup.of y) ^ (p - 1 - k.val) *
4414 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹)
4415 =
4416 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
4417 ((FreeGroup.of y) ^ k.val * FreeGroup.of y *
4418 (FreeGroup.of y) ^ (p - 1 - k.val)) *
4419 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ := by
4420 group
4421 _ =
4422 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
4423 (FreeGroup.of y) ^ p *
4424 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ := by
4425 rw [← pow_succ (FreeGroup.of y) k.val]
4426 rw [← pow_add (FreeGroup.of y) (k.val + 1) (p - 1 - k.val)]
4427 rw [hkadd]
4429private theorem oneHeadPeriodOneSchreierToTargetHom_secondPowerWord
4430 {tailLen p : ℕ}
4431 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
4432 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
4433 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
4434 (e :
4435 OriginalFirstReductionIndex tailLen ≃
4436 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
4437 hTailLen).numPeriods) :
4438 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
4439 let source :=
4440 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
4441 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
4442 let basis :=
4444 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4445 let η :=
4447 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
4448 let block := oneHeadPeriodOneTargetTailBlockWord m₂' tail hp hm₂'ge htail hTailLen
4449 η
4450 (basis.symm
4452 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e)) =
4453 (List.ofFn block).prod⁻¹ := by
4454 classical
4455 dsimp
4456 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
4457 let source :=
4458 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
4459 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
4460 let φ :=
4462 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4463 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
4464 let basis :=
4466 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4467 let η :=
4469 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
4470 let x : FuchsianGenerator source :=
4472 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4473 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
4474 let b :=
4476 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4477 let edge : Fin p → φ.ker :=
4479 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4480 let kZero : Fin p := ⟨0, lt_of_lt_of_le (by decide : 0 < 2) hp⟩
4481 let lower :=
4482 (List.ofFn (fun i : Fin kZero.val => edge ⟨kZero.val - i.val, by omega⟩)).prod
4483 let wrap := edge ⟨0, lt_of_lt_of_le (by decide : 0 < 2) hp⟩
4484 let upper :=
4485 (List.ofFn (fun i : Fin (p - 1 - kZero.val) =>
4486 edge ⟨p - 1 - i.val, by omega⟩)).prod
4487 let cycle : φ.ker := lower * wrap * upper
4488 let block := oneHeadPeriodOneTargetTailBlockWord m₂' tail hp hm₂'ge htail hTailLen
4489 have hcycleSource :
4490 cycle =
4491 (⟨(FreeGroup.of x) ^ kZero.val * (FreeGroup.of y) ^ p *
4492 ((FreeGroup.of x) ^ kZero.val)⁻¹, by
4493 rw [MonoidHom.mem_ker]
4494 have hx : φ (FreeGroup.of x) = Multiplicative.ofAdd (1 : ZMod p) := by
4495 simpa [φ, x, originalFirstReductionPeriodOneDistinguishedGenerator] using
4497 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4498 have hy : φ (FreeGroup.of y) = Multiplicative.ofAdd (-1 : ZMod p) := by
4499 simpa [φ, y] using
4501 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4503 apply (Multiplicative.toAdd : Multiplicative (ZMod p) ≃ ZMod p).injective
4504 simp only [ofAdd_neg, inv_pow, mul_inv_cancel_comm, toAdd_inv, toAdd_pow, toAdd_ofAdd, nsmul_eq_mul,
4505 CharP.cast_eq_zero, mul_one, neg_zero, toAdd_one]⟩ : φ.ker) := by
4506 simpa [source, φ, x, y, edge, lower, wrap, upper, cycle] using
4508 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e kZero
4509 have hbCycle : b = cycle := by
4510 apply Subtype.ext
4511 change
4512 ((b : φ.ker) : FreeGroup (FuchsianGenerator source)) =
4513 ((cycle : φ.ker) : FreeGroup (FuchsianGenerator source))
4514 have hcycleCoe := congrArg
4515 (fun u : φ.ker => (u : FreeGroup (FuchsianGenerator source))) hcycleSource
4516 have hcycleCoe' :
4517 ((cycle : φ.ker) : FreeGroup (FuchsianGenerator source)) =
4518 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ kZero.val *
4519 (FreeGroup.of y) ^ p *
4520 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ kZero.val)⁻¹ := by
4521 simpa using hcycleCoe
4522 rw [hcycleCoe']
4524 simp only [Fin.isValue, pow_zero, one_mul, inv_one, mul_one, x, y, kZero]
4525 have hLowerImage :
4526 η (basis.symm lower) =
4527 (List.ofFn (fun i : Fin kZero.val =>
4528 (block ⟨kZero.val - 1 - i.val, by omega⟩)⁻¹)).prod := by
4529 rw [map_list_prod, List.map_ofFn]
4530 rw [map_list_prod, List.map_ofFn]
4531 apply congrArg List.prod
4532 apply List.ofFn_inj.2
4533 funext i
4534 let r : Fin p := ⟨kZero.val - i.val, by omega⟩
4535 have hrne : ¬ r.val = 0 := by
4536 dsimp [r]
4537 omega
4538 have hword :=
4540 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e r
4541 have hprev : kZero.val - i.val - 1 = kZero.val - 1 - i.val := by omega
4542 simpa [source, basis, η, edge, block, r, oneHeadPeriodOneSecondEdgeForwardWord,
4543 hrne, hprev] using hword
4544 have hWrapImage :
4545 η (basis.symm wrap) = (block ⟨p - 1, by omega⟩)⁻¹ := by
4546 have hword :=
4548 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
4549 (⟨0, lt_of_lt_of_le (by decide : 0 < 2) hp⟩ : Fin p)
4550 simpa [source, basis, η, edge, wrap, block,
4551 oneHeadPeriodOneSecondEdgeForwardWord] using hword
4552 have hUpperImage :
4553 η (basis.symm upper) =
4554 (List.ofFn (fun i : Fin (p - 1 - kZero.val) =>
4555 (block ⟨p - 2 - i.val, by omega⟩)⁻¹)).prod := by
4556 rw [map_list_prod, List.map_ofFn]
4557 rw [map_list_prod, List.map_ofFn]
4558 apply congrArg List.prod
4559 apply List.ofFn_inj.2
4560 funext i
4561 let r : Fin p := ⟨p - 1 - i.val, by omega⟩
4562 have hrne : ¬ r.val = 0 := by
4563 dsimp [r]
4564 omega
4565 have hword :=
4567 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e r
4568 have hprev : p - 1 - i.val - 1 = p - 2 - i.val := by omega
4569 simpa [source, basis, η, edge, block, r, oneHeadPeriodOneSecondEdgeForwardWord,
4570 hrne, hprev] using hword
4571 have hImageDesc :
4572 η (basis.symm cycle) =
4573 (List.ofFn (fun i : Fin kZero.val =>
4574 (block ⟨kZero.val - 1 - i.val, by omega⟩)⁻¹)).prod *
4575 (block ⟨p - 1, by omega⟩)⁻¹ *
4576 (List.ofFn (fun i : Fin (p - 1 - kZero.val) =>
4577 (block ⟨p - 2 - i.val, by omega⟩)⁻¹)).prod := by
4578 have hmap :
4579 basis.symm cycle =
4580 basis.symm lower * basis.symm wrap * basis.symm upper := by
4583 have hDescEq :=
4585 (G := FreeGroup (FuchsianGenerator target)) hp block kZero
4586 change η (basis.symm b) = (List.ofFn block).prod⁻¹
4587 rw [hbCycle, hImageDesc]
4588 have hrot :
4589 ((List.ofFn (fun i : Fin (p - kZero.val) =>
4590 block ⟨kZero.val + i.val, by omega⟩)).prod *
4591 (List.ofFn (fun i : Fin kZero.val => block ⟨i.val, by omega⟩)).prod)⁻¹ =
4592 (List.ofFn block).prod⁻¹ := by
4593 dsimp [kZero]
4594 simp only [zero_add, Fin.eta, List.ofFn_zero, List.prod_nil, mul_one]
4595 rw [hDescEq]
4596 exact hrot
4599 {tailLen p : ℕ}
4600 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
4601 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
4602 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
4603 (e :
4604 OriginalFirstReductionIndex tailLen ≃
4605 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
4606 hTailLen).numPeriods) :
4607 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
4608 let source :=
4609 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
4610 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
4611 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
4612 let θ :=
4614 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
4615 let η :=
4617 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
4618 ∀ y : FuchsianGenerator target,
4619 η (θ (FreeGroup.of y)) * (FreeGroup.of y)⁻¹ ∈
4621 classical
4622 dsimp
4623 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
4624 let source :=
4625 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
4626 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
4627 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
4628 let basis :=
4630 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4631 let θ :=
4633 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
4634 let η :=
4636 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
4637 let block := oneHeadPeriodOneTargetTailBlockWord m₂' tail hp hm₂'ge htail hTailLen
4638 intro y
4639 cases y with
4640 | elliptic i =>
4641 let idx := (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p).symm i
4642 have hidx : oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p idx = i := by
4643 simp only [Equiv.apply_symm_apply, idx]
4644 cases hidxCases : idx with
4645 | inl a =>
4646 fin_cases a
4647 let headIdx :=
4648 oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inl (0 : Fin 1))
4649 have hidxHead : headIdx = i := by
4650 simpa [headIdx, idx, hidxCases] using hidx
4651 have hcomp :
4652 η (θ (FreeGroup.of (FuchsianGenerator.elliptic i))) =
4653 (List.ofFn block).prod⁻¹ := by
4654 simpa [θ, η, oneHeadPeriodOneTargetToSchreierHom,
4655 oneHeadPeriodOneTargetToSchreierGeneratorImage, target, basis,
4656 idx, hidxCases, block] using
4658 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
4659 have hHeadWord :
4661 FreeGroup.of (FuchsianGenerator.elliptic i) := by
4663 let N : Subgroup (FreeGroup (FuchsianGenerator target)) :=
4665 have hTotalRel :
4666 totalRelation target ∈ N :=
4667 Subgroup.subset_normalClosure (Or.inr rfl)
4668 have hTotalBlocks :
4670 simpa [N, target, headIdx, block,
4671 oneHeadPeriodOneTarget_totalRelation_eq_blocks] using hTotalRel
4672 have hmem :
4673 (List.ofFn block).prod⁻¹ *
4676 N.inv_mem hTotalBlocks
4677 simpa [N, mul_assoc] using hinv
4678 have hprod :
4679 η (θ (FreeGroup.of (FuchsianGenerator.elliptic i))) *
4680 (FreeGroup.of (FuchsianGenerator.elliptic i))⁻¹ =
4682 rw [hcomp, hHeadWord]
4683 simpa [N] using hprod ▸ hmem
4684 | inr jk =>
4685 have hword :
4686 η
4688 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e).symm
4690 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e jk.2 jk.1)) =
4692 (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (jk.1, jk.2))) := by
4693 simpa [source, target, η] using
4695 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e jk.2 jk.1
4696 have hidxPair :
4697 oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (jk.1, jk.2)) = i := by
4698 simpa [idx, hidxCases] using hidx
4699 have hword' :
4700 η
4702 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e).symm
4704 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e jk.2 jk.1)) =
4705 FreeGroup.of (FuchsianGenerator.elliptic i) := by
4707 have hcomp :
4708 η (θ (FreeGroup.of (FuchsianGenerator.elliptic i))) =
4709 FreeGroup.of (FuchsianGenerator.elliptic i) := by
4710 simpa [θ, η, oneHeadPeriodOneTargetToSchreierHom,
4711 oneHeadPeriodOneTargetToSchreierGeneratorImage, target, basis,
4712 idx, hidxCases] using hword'
4713 have hprod :
4714 η (θ (FreeGroup.of (FuchsianGenerator.elliptic i))) *
4715 (FreeGroup.of (FuchsianGenerator.elliptic i))⁻¹ =
4716 1 := by
4717 simp only [Lean.Elab.WF.paramLet, hcomp, mul_inv_cancel]
4718 rw [hprod]
4720 | surfaceA a =>
4721 fin_cases a
4722 | surfaceB b =>
4723 fin_cases b
4726 {tailLen p : ℕ}
4727 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
4728 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
4729 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
4730 (e :
4731 OriginalFirstReductionIndex tailLen ≃
4732 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
4733 hTailLen).numPeriods)
4734 (hgen :
4735 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
4736 let source :=
4737 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
4738 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
4739 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
4740 let θ :=
4742 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
4743 let η :=
4745 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
4746 ∀ y : FuchsianGenerator target,
4747 η (θ (FreeGroup.of y)) * (FreeGroup.of y)⁻¹ ∈
4749 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
4750 let source :=
4751 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
4752 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
4753 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
4754 let θ :=
4756 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
4757 let η :=
4759 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
4760 ∀ y : FreeGroup (FuchsianGenerator target),
4762 classical
4763 dsimp
4764 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
4765 let source :=
4766 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
4767 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
4768 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
4769 let θ :=
4771 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
4772 let η :=
4774 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
4775 let F : FreeGroup (FuchsianGenerator target) →* FreeGroup (FuchsianGenerator target) :=
4776 η.comp θ
4777 have hgen' :
4778 ∀ y : FuchsianGenerator target,
4779 F (FreeGroup.of y) * (FreeGroup.of y)⁻¹ ∈
4781 intro y
4782 simpa [source, target, θ, η, F] using hgen y
4783 intro y
4784 simpa [F] using
4785 ReidemeisterSchreier.Discrete.Presentations.freeGroup_endomorph_mul_inv_mem_normalClosure_of_generator_mul_inv
4789 {tailLen p : ℕ}
4790 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
4791 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
4792 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
4793 (e :
4794 OriginalFirstReductionIndex tailLen ≃
4795 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
4796 hTailLen).numPeriods) :
4797 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
4798 let source :=
4799 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
4800 let φ :=
4802 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4803 let x : FuchsianGenerator source :=
4805 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4806 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
4808 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4809 (⟨0, lt_of_lt_of_le (by decide : 0 < 2) hp⟩ : Fin p) : φ.ker) :
4810 FreeGroup (FuchsianGenerator source)) =
4811 FreeGroup.of y *
4812 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1))⁻¹ := by
4813 classical
4814 dsimp
4815 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
4816 let source :=
4817 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
4818 let φ :=
4820 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4821 let x : FuchsianGenerator source :=
4823 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4824 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
4825 haveI : Fact (1 < p) := ⟨by omega⟩
4826 have hr0 : ((-1 : ZMod p).val) = p - 1 := by
4827 have hsucc : (p - 1).succ = p := by omega
4828 rw [← hsucc]
4829 exact ZMod.val_neg_one (p - 1)
4830 simpa [source, φ, x, y, hr0] using
4832 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4833 (⟨0, lt_of_lt_of_le (by decide : 0 < 2) hp⟩ : Fin p)
4836 {tailLen p : ℕ}
4837 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
4838 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
4839 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
4840 (e :
4841 OriginalFirstReductionIndex tailLen ≃
4842 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
4843 hTailLen).numPeriods)
4844 (i : Fin (p - 1)) :
4845 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
4846 let source :=
4847 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
4848 let φ :=
4850 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4851 let x : FuchsianGenerator source :=
4853 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4854 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
4856 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4857 (⟨i.val + 1, by omega⟩ : Fin p) : φ.ker) :
4858 FreeGroup (FuchsianGenerator source)) =
4859 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (i.val + 1) *
4860 FreeGroup.of y *
4861 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ i.val)⁻¹ := by
4862 classical
4863 dsimp
4864 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
4865 let source :=
4866 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
4867 let φ :=
4869 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4870 let x : FuchsianGenerator source :=
4872 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4873 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
4874 haveI : Fact (1 < p) := ⟨by omega⟩
4875 have hrval : ((((i.val + 1 : ℕ) : ZMod p) - 1).val) = i.val := by
4876 have hrlt : i.val + 1 < p := by omega
4877 have hval : ((i.val + 1 : ℕ) : ZMod p).val = i.val + 1 :=
4878 ZMod.val_natCast_of_lt hrlt
4879 have hle : (1 : ZMod p).val ≤ ((i.val + 1 : ℕ) : ZMod p).val := by
4880 rw [hval, ZMod.val_one]
4881 omega
4882 rw [ZMod.val_sub hle, hval, ZMod.val_one]
4883 omega
4884 have hmod : i.val % p = i.val := Nat.mod_eq_of_lt (by omega)
4885 simpa [source, φ, x, y, hrval, hmod] using
4887 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4888 (⟨i.val + 1, by omega⟩ : Fin p)
4890private theorem oneHeadPeriodOneSchreierToTargetHom_tailBlockWord
4891 {tailLen p : ℕ}
4892 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
4893 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
4894 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
4895 (e :
4896 OriginalFirstReductionIndex tailLen ≃
4897 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
4898 hTailLen).numPeriods)
4899 (k : Fin p) :
4900 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
4901 let source :=
4902 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
4903 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
4904 let basis :=
4906 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4907 let η :=
4909 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
4910 η
4911 ((List.ofFn (fun j : Fin tailLen =>
4912 basis.symm
4914 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k))).prod) =
4915 oneHeadPeriodOneTargetTailBlockWord m₂' tail hp hm₂'ge htail hTailLen k := by
4916 classical
4917 dsimp
4918 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
4919 let source :=
4920 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
4921 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
4922 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
4923 let basis :=
4925 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4926 let η :=
4928 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
4929 rw [map_list_prod, List.map_ofFn]
4930 change
4931 (List.ofFn (fun j : Fin tailLen =>
4932 η
4933 (basis.symm
4935 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k)))).prod =
4936 (List.ofFn (fun j : Fin tailLen =>
4938 (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k, j))))).prod
4939 apply congrArg List.prod
4940 apply List.ofFn_inj.2
4941 funext j
4942 simpa [source, target, basis, η] using
4944 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e j k
4947 {tailLen p : ℕ}
4948 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
4949 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
4950 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
4951 (e :
4952 OriginalFirstReductionIndex tailLen ≃
4953 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
4954 hTailLen).numPeriods)
4955 (hperiods :
4956 let source :=
4957 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
4958 ∀ x : OriginalFirstReductionIndex tailLen,
4959 source.periods (e x) =
4960 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
4961 (hm₁'one : m₁' = 1)
4962 (k : Fin p) :
4963 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
4964 let source :=
4965 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
4966 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
4967 let φ :=
4969 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4970 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
4971 let basis :=
4973 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4974 let η :=
4976 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
4977 let x :=
4979 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
4980 let i₀ := e (.inl (0 : Fin 2))
4981 η
4982 (basis.symm
4984 ((FreeGroup.of x) ^ k.val)⁻¹, by
4985 change φ
4987 ((FreeGroup.of x) ^ k.val)⁻¹) = 1
4988 have hrφ :
4990 simpa [source, φ, i₀, originalFirstReductionPeriodOneFreeQuotientHom] using
4992 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
4994 simp only [Lean.Elab.WF.paramLet, map_mul, map_pow, hrφ, mul_one, map_inv, mul_inv_cancel]⟩ : φ.ker)) ∈
4996 classical
4997 dsimp
4998 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
4999 let source :=
5000 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
5001 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
5002 let φ :=
5004 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5005 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
5006 let basis :=
5008 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5009 let η :=
5011 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
5012 let x :=
5014 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5015 let i₀ := e (.inl (0 : Fin 2))
5016 let a :=
5018 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5019 let z : φ.ker :=
5021 ((FreeGroup.of x) ^ k.val)⁻¹, by
5022 change φ
5024 ((FreeGroup.of x) ^ k.val)⁻¹) = 1
5025 have hrφ :
5027 simpa [source, φ, i₀, originalFirstReductionPeriodOneFreeQuotientHom] using
5029 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
5032 have hPeriod : source.periods i₀ = p := by
5033 rw [show i₀ = e (.inl (0 : Fin 2)) by rfl]
5034 rw [hperiods (.inl (0 : Fin 2))]
5035 simp only [originalFirstReductionPeriods, twoPeriods, Nat.reduceAdd, hm₁'one, mul_one, Fin.isValue,
5036 Fin.cases_zero]
5037 have hz : z = a := by
5038 apply Subtype.ext
5039 have hxEq : x = FuchsianGenerator.elliptic i₀ := by
5040 simp only [Lean.Elab.WF.paramLet, originalFirstReductionPeriodOneDistinguishedGenerator, Fin.isValue, id_eq,
5041 x, i₀]
5042 change
5043 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
5045 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ =
5046 ((a : φ.ker) : FreeGroup (FuchsianGenerator source))
5048 rw [hxEq]
5050 let g : FreeGroup (FuchsianGenerator source) :=
5051 FreeGroup.of (FuchsianGenerator.elliptic i₀)
5052 change g ^ k.val * g ^ p * (g ^ k.val)⁻¹ = g ^ p
5053 have hcomm : Commute (g ^ k.val) (g ^ p) :=
5054 (Commute.refl g).pow_pow k.val p
5055 calc
5056 g ^ k.val * g ^ p * (g ^ k.val)⁻¹ =
5057 (g ^ p * g ^ k.val) * (g ^ k.val)⁻¹ := by
5058 rw [hcomm.eq]
5059 _ = g ^ p := by simp only [mul_assoc, mul_inv_cancel, mul_one]
5061 rw [hz]
5066 {tailLen p : ℕ}
5067 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
5068 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
5069 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
5070 (e :
5071 OriginalFirstReductionIndex tailLen ≃
5072 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
5073 hTailLen).numPeriods)
5074 (hperiods :
5075 let source :=
5076 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
5077 ∀ x : OriginalFirstReductionIndex tailLen,
5078 source.periods (e x) =
5079 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
5080 (j : Fin tailLen) (k : Fin p) :
5081 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
5082 let source :=
5083 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
5084 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
5085 let φ :=
5087 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5088 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
5089 let basis :=
5091 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5092 let η :=
5094 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
5095 let x :=
5097 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5098 let iTail := e (.inr j)
5099 η
5100 (basis.symm
5102 ((FreeGroup.of x) ^ k.val)⁻¹, by
5103 change φ
5105 ((FreeGroup.of x) ^ k.val)⁻¹) = 1
5106 have hrφ :
5108 simpa [source, φ, iTail, originalFirstReductionPeriodOneFreeQuotientHom] using
5110 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
5112 simp only [Lean.Elab.WF.paramLet, map_mul, map_pow, hrφ, mul_one, map_inv, mul_inv_cancel]⟩ : φ.ker)) ∈
5114 classical
5115 dsimp
5116 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
5117 let source :=
5118 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
5119 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
5120 let φ :=
5122 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5123 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
5124 let basis :=
5126 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5127 let η :=
5129 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
5130 let x :=
5132 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5133 let iTail := e (.inr j)
5134 let c :=
5136 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k
5137 let z : φ.ker :=
5139 ((FreeGroup.of x) ^ k.val)⁻¹, by
5140 change φ
5142 ((FreeGroup.of x) ^ k.val)⁻¹) = 1
5143 have hrφ :
5145 simpa [source, φ, iTail, originalFirstReductionPeriodOneFreeQuotientHom] using
5147 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
5150 have hPeriod : source.periods iTail = tail j := by
5151 rw [show iTail = e (.inr j) by rfl]
5152 rw [hperiods (.inr j)]
5153 simp only [originalFirstReductionPeriods]
5154 have hz : z = c ^ tail j := by
5155 apply Subtype.ext
5156 change
5157 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
5159 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ =
5160 ((c ^ tail j : φ.ker) : FreeGroup (FuchsianGenerator source))
5161 rw [show ((c ^ tail j : φ.ker) : FreeGroup (FuchsianGenerator source)) =
5162 ((c : φ.ker) : FreeGroup (FuchsianGenerator source)) ^ tail j by
5163 exact (map_pow (φ.ker.subtype) c (tail j))]
5166 have hTargetPeriod :
5167 target.periods (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k, j))) =
5168 tail j := by
5169 simp only [oneHeadPeriodOneTargetSignature, oneHeadPeriodOneTargetOrderedIndexEquiv, Equiv.symm_trans_apply,
5170 Equiv.sumCongr_symm, Equiv.refl_symm, Equiv.sumCongr_apply, Equiv.coe_refl, oneHeadPeriodOneTargetPeriods,
5171 Equiv.trans_apply, Sum.map_inr, finSumFinEquiv_apply_right, finSumFinEquiv_symm_apply_natAdd,
5172 Equiv.symm_apply_apply, target]
5173 have hTargetRel :
5174 xWord target (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k, j))) ^
5175 tail j ∈
5177 have hrel :
5178 xWord target (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k, j))) ^
5179 target.periods (oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k, j))) ∈
5181 Or.inl ⟨oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inr (k, j)), rfl⟩
5182 simpa [hTargetPeriod] using Subgroup.subset_normalClosure hrel
5184 rw [hz]
5185 rw [map_pow (basis.symm) c (tail j), map_pow]
5187 exact hTargetRel
5190 {tailLen p : ℕ}
5191 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
5192 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
5193 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
5194 (e :
5195 OriginalFirstReductionIndex tailLen ≃
5196 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
5197 hTailLen).numPeriods)
5198 (hperiods :
5199 let source :=
5200 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
5201 ∀ x : OriginalFirstReductionIndex tailLen,
5202 source.periods (e x) =
5203 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
5204 (k : Fin p) :
5205 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
5206 let source :=
5207 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
5208 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
5209 let φ :=
5211 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5212 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
5213 let basis :=
5215 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5216 let η :=
5218 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
5219 let x :=
5221 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5222 let i₁ := e (.inl (1 : Fin 2))
5223 η
5224 (basis.symm
5226 ((FreeGroup.of x) ^ k.val)⁻¹, by
5227 change φ
5229 ((FreeGroup.of x) ^ k.val)⁻¹) = 1
5230 have hrφ :
5232 simpa [source, φ, i₁, originalFirstReductionPeriodOneFreeQuotientHom] using
5234 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
5236 simp only [Lean.Elab.WF.paramLet, map_mul, map_pow, hrφ, mul_one, map_inv, mul_inv_cancel]⟩ : φ.ker)) ∈
5238 classical
5239 dsimp
5240 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
5241 let source :=
5242 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
5243 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
5244 let φ :=
5246 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5247 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
5248 let basis :=
5250 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5251 let η :=
5253 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
5254 let x :=
5256 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5257 let i₁ := e (.inl (1 : Fin 2))
5258 let y : FuchsianGenerator source := FuchsianGenerator.elliptic i₁
5259 let edge : Fin p → φ.ker :=
5261 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5262 let lower :=
5263 (List.ofFn (fun i : Fin k.val => edge ⟨k.val - i.val, by omega⟩)).prod
5264 let wrap := edge ⟨0, lt_of_lt_of_le (by decide : 0 < 2) hp⟩
5265 let upper :=
5266 (List.ofFn (fun i : Fin (p - 1 - k.val) => edge ⟨p - 1 - i.val, by omega⟩)).prod
5267 let cycle : φ.ker := lower * wrap * upper
5268 let block := oneHeadPeriodOneTargetTailBlockWord m₂' tail hp hm₂'ge htail hTailLen
5269 let z : φ.ker :=
5271 ((FreeGroup.of x) ^ k.val)⁻¹, by
5272 change φ
5274 ((FreeGroup.of x) ^ k.val)⁻¹) = 1
5275 have hrφ :
5277 simpa [source, φ, i₁, originalFirstReductionPeriodOneFreeQuotientHom] using
5279 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
5282 have hPeriod : source.periods i₁ = p * m₂' := by
5283 rw [show i₁ = e (.inl (1 : Fin 2)) by rfl]
5284 rw [hperiods (.inl (1 : Fin 2))]
5285 simp only [originalFirstReductionPeriods, twoPeriods, Nat.reduceAdd, Fin.isValue, fin_cases_const_one]
5286 have hcycleSource :
5287 cycle =
5288 (⟨(FreeGroup.of x) ^ k.val * (FreeGroup.of y) ^ p *
5289 ((FreeGroup.of x) ^ k.val)⁻¹, by
5290 rw [MonoidHom.mem_ker]
5291 have hx : φ (FreeGroup.of x) = Multiplicative.ofAdd (1 : ZMod p) := by
5292 simpa [φ, x, originalFirstReductionPeriodOneDistinguishedGenerator] using
5294 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5295 have hy : φ (FreeGroup.of y) = Multiplicative.ofAdd (-1 : ZMod p) := by
5296 simpa [φ, y, i₁] using
5298 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5300 apply (Multiplicative.toAdd : Multiplicative (ZMod p) ≃ ZMod p).injective
5301 simp only [ofAdd_neg, inv_pow, mul_inv_cancel_comm, toAdd_inv, toAdd_pow, toAdd_ofAdd, nsmul_eq_mul,
5302 CharP.cast_eq_zero, mul_one, neg_zero, toAdd_one]⟩ : φ.ker) := by
5303 simpa [source, φ, x, y, edge, lower, wrap, upper, cycle] using
5305 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k
5306 have hz : z = cycle ^ m₂' := by
5307 apply Subtype.ext
5308 change
5309 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
5311 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ =
5312 ((cycle ^ m₂' : φ.ker) : FreeGroup (FuchsianGenerator source))
5313 rw [show ((cycle ^ m₂' : φ.ker) : FreeGroup (FuchsianGenerator source)) =
5314 ((cycle : φ.ker) : FreeGroup (FuchsianGenerator source)) ^ m₂' by
5315 exact (map_pow (φ.ker.subtype) cycle m₂')]
5316 have hcycleCoe := congrArg
5317 (fun u : φ.ker => (u : FreeGroup (FuchsianGenerator source))) hcycleSource
5318 have hcycleCoe' :
5319 ((cycle : φ.ker) : FreeGroup (FuchsianGenerator source)) =
5320 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
5321 (FreeGroup.of y) ^ p *
5322 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ := by
5323 simpa using hcycleCoe
5324 rw [hcycleCoe']
5326 rw [pow_mul]
5327 have hLowerImage :
5328 η (basis.symm lower) =
5329 (List.ofFn (fun i : Fin k.val =>
5330 (block ⟨k.val - 1 - i.val, by omega⟩)⁻¹)).prod := by
5331 rw [map_list_prod, List.map_ofFn]
5332 rw [map_list_prod, List.map_ofFn]
5333 apply congrArg List.prod
5334 apply List.ofFn_inj.2
5335 funext i
5336 let r : Fin p := ⟨k.val - i.val, by omega⟩
5337 have hrne : ¬ r.val = 0 := by
5338 dsimp [r]
5339 omega
5340 have hword :=
5342 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e r
5343 have hprev : k.val - i.val - 1 = k.val - 1 - i.val := by omega
5344 simpa [source, basis, η, edge, block, r, oneHeadPeriodOneSecondEdgeForwardWord,
5345 hrne, hprev] using hword
5346 have hWrapImage :
5347 η (basis.symm wrap) = (block ⟨p - 1, by omega⟩)⁻¹ := by
5348 have hword :=
5350 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
5351 (⟨0, lt_of_lt_of_le (by decide : 0 < 2) hp⟩ : Fin p)
5352 simpa [source, basis, η, edge, wrap, block, oneHeadPeriodOneSecondEdgeForwardWord] using
5353 hword
5354 have hUpperImage :
5355 η (basis.symm upper) =
5356 (List.ofFn (fun i : Fin (p - 1 - k.val) =>
5357 (block ⟨p - 2 - i.val, by omega⟩)⁻¹)).prod := by
5358 rw [map_list_prod, List.map_ofFn]
5359 rw [map_list_prod, List.map_ofFn]
5360 apply congrArg List.prod
5361 apply List.ofFn_inj.2
5362 funext i
5363 let r : Fin p := ⟨p - 1 - i.val, by omega⟩
5364 have hrne : ¬ r.val = 0 := by
5365 dsimp [r]
5366 omega
5367 have hword :=
5369 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e r
5370 have hprev : p - 1 - i.val - 1 = p - 2 - i.val := by omega
5371 simpa [source, basis, η, edge, block, r, oneHeadPeriodOneSecondEdgeForwardWord,
5372 hrne, hprev] using hword
5373 have hImageDesc :
5374 η (basis.symm cycle) =
5375 (List.ofFn (fun i : Fin k.val =>
5376 (block ⟨k.val - 1 - i.val, by omega⟩)⁻¹)).prod *
5377 (block ⟨p - 1, by omega⟩)⁻¹ *
5378 (List.ofFn (fun i : Fin (p - 1 - k.val) =>
5379 (block ⟨p - 2 - i.val, by omega⟩)⁻¹)).prod := by
5380 have hmap :
5381 basis.symm cycle =
5382 basis.symm lower * basis.symm wrap * basis.symm upper := by
5385 have hDescEq :=
5387 (G := FreeGroup (FuchsianGenerator target)) hp block k
5388 let headIdx :=
5389 oneHeadPeriodOneTargetOrderedIndexEquiv tailLen p (.inl (0 : Fin 1))
5390 let headWord : FreeGroup (FuchsianGenerator target) := xWord target headIdx
5391 let N : Subgroup (FreeGroup (FuchsianGenerator target)) :=
5393 have hHeadPeriod : target.periods headIdx = m₂' := by
5394 simp only [oneHeadPeriodOneTargetSignature, oneHeadPeriodOneTargetOrderedIndexEquiv, Equiv.symm_trans_apply,
5395 Equiv.sumCongr_symm, Equiv.refl_symm, Equiv.sumCongr_apply, Equiv.coe_refl, oneHeadPeriodOneTargetPeriods,
5396 Fin.isValue, Equiv.trans_apply, Sum.map_inl, id_eq, finSumFinEquiv_apply_left, finSumFinEquiv_symm_apply_castAdd,
5397 headIdx, target]
5398 have hHeadPow : headWord ^ m₂' ∈ N := by
5400 Or.inl ⟨headIdx, rfl⟩
5401 simpa [N, headWord, hHeadPeriod] using Subgroup.subset_normalClosure hrel
5402 have hTotalBlocks : headWord * (List.ofFn block).prod ∈ N := by
5403 have hTotalRel : totalRelation target ∈ N :=
5404 Subgroup.subset_normalClosure (Or.inr rfl)
5405 simpa [N, target, headWord, headIdx, block,
5406 oneHeadPeriodOneTarget_totalRelation_eq_blocks] using hTotalRel
5407 have hRotInvPow :
5408 (((List.ofFn (fun i : Fin (p - k.val) =>
5409 block ⟨k.val + i.val, by omega⟩)).prod *
5410 (List.ofFn (fun i : Fin k.val => block ⟨i.val, by omega⟩)).prod)⁻¹) ^ m₂' ∈ N :=
5413 have hCycleImage :
5414 η (basis.symm cycle) =
5415 ((List.ofFn (fun i : Fin (p - k.val) =>
5416 block ⟨k.val + i.val, by omega⟩)).prod *
5417 (List.ofFn (fun i : Fin k.val => block ⟨i.val, by omega⟩)).prod)⁻¹ := by
5418 rw [hImageDesc, hDescEq]
5419 have hCyclePowMem : η (basis.symm cycle) ^ m₂' ∈ N := by
5420 rw [hCycleImage]
5421 exact hRotInvPow
5422 change η (basis.symm z) ∈ N
5423 rw [hz]
5424 rw [map_pow (basis.symm) cycle m₂', map_pow]
5425 exact hCyclePowMem
5428 {tailLen p : ℕ}
5429 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
5430 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
5431 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
5432 (e :
5433 OriginalFirstReductionIndex tailLen ≃
5434 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
5435 hTailLen).numPeriods)
5436 (hperiods :
5437 let source :=
5438 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
5439 ∀ x : OriginalFirstReductionIndex tailLen,
5440 source.periods (e x) =
5441 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
5442 (he : e = originalFirstReductionOrderedIndexEquiv tailLen)
5443 (k : Fin p) :
5444 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
5445 let source :=
5446 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
5447 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
5448 let φ :=
5450 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5451 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
5452 let basis :=
5454 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5455 let η :=
5457 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
5458 let x :=
5460 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5461 η
5462 (basis.symm
5463 (⟨(FreeGroup.of x) ^ k.val * totalRelation source *
5464 ((FreeGroup.of x) ^ k.val)⁻¹, by
5465 change φ
5466 ((FreeGroup.of x) ^ k.val * totalRelation source *
5467 ((FreeGroup.of x) ^ k.val)⁻¹) = 1
5468 have hrφ : φ (totalRelation source) = 1 := by
5469 simpa [source, φ, originalFirstReductionPeriodOneFreeQuotientHom] using
5471 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
5472 (totalRelation source) (Or.inr rfl)
5473 simp only [Lean.Elab.WF.paramLet, map_mul, map_pow, hrφ, mul_one, map_inv, mul_inv_cancel]⟩ : φ.ker)) ∈
5475 classical
5476 dsimp
5477 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
5478 let source :=
5479 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
5480 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
5481 let φ :=
5483 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5484 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
5485 let basis :=
5487 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5488 let η :=
5490 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
5491 let x :=
5493 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5494 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
5495 let tailGen : Fin tailLen → FuchsianGenerator source := fun j =>
5496 FuchsianGenerator.elliptic (e (.inr j))
5497 let block := oneHeadPeriodOneTargetTailBlockWord m₂' tail hp hm₂'ge htail hTailLen
5498 let a :=
5500 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5501 let edge : Fin p → φ.ker :=
5503 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5504 let c : Fin tailLen → Fin p → φ.ker := fun j k =>
5506 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k
5507 let z : φ.ker :=
5508 ⟨(FreeGroup.of x) ^ k.val * totalRelation source *
5509 ((FreeGroup.of x) ^ k.val)⁻¹, by
5510 change φ
5511 ((FreeGroup.of x) ^ k.val * totalRelation source *
5512 ((FreeGroup.of x) ^ k.val)⁻¹) = 1
5513 have hrφ : φ (totalRelation source) = 1 := by
5514 simpa [source, φ, originalFirstReductionPeriodOneFreeQuotientHom] using
5516 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
5517 (totalRelation source) (Or.inr rfl)
5519 have hTailEq :
5520 totalRelation source =
5521 FreeGroup.of x * FreeGroup.of y *
5522 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j))).prod := by
5523 subst e
5524 have hTotal :=
5526 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
5529 originalFirstReductionOrderedIndexEquiv] using hTotal
5531 by_cases hlast : k.val = p - 1
5532 · let kLast : Fin p := ⟨p - 1, by omega⟩
5533 let kZero : Fin p := ⟨0, lt_of_lt_of_le (by decide : 0 < 2) hp⟩
5534 have hprodCoe :
5535 (((List.ofFn (fun j : Fin tailLen => c j kLast)).prod : φ.ker) :
5536 FreeGroup (FuchsianGenerator source)) =
5537 (List.ofFn (fun j : Fin tailLen =>
5538 ((c j kLast : φ.ker) : FreeGroup (FuchsianGenerator source)))).prod := by
5539 change
5540 φ.ker.subtype ((List.ofFn (fun j : Fin tailLen => c j kLast)).prod) =
5541 (List.ofFn (fun j : Fin tailLen => φ.ker.subtype (c j kLast))).prod
5542 rw [map_list_prod, List.map_ofFn]
5543 rfl
5544 have htailList :
5545 (List.ofFn (fun j : Fin tailLen =>
5546 ((c j kLast : φ.ker) : FreeGroup (FuchsianGenerator source)))) =
5547 List.ofFn (fun j : Fin tailLen =>
5548 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1) *
5549 FreeGroup.of (tailGen j) *
5550 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1))⁻¹) := by
5551 apply List.ofFn_inj.2
5552 funext j
5553 simpa [source, φ, x, tailGen, c, kLast] using
5555 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j kLast
5556 have htailConj :
5557 (List.ofFn (fun j : Fin tailLen =>
5558 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1) *
5559 FreeGroup.of (tailGen j) *
5560 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1))⁻¹)).prod =
5561 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1) *
5562 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j))).prod *
5563 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1))⁻¹ := by
5564 calc
5565 (List.ofFn (fun j : Fin tailLen =>
5566 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1) *
5567 FreeGroup.of (tailGen j) *
5568 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1))⁻¹)).prod =
5569 (List.map
5570 (fun u =>
5571 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1) *
5572 u *
5573 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1))⁻¹)
5574 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j)))).prod := by
5575 rw [List.map_ofFn]
5576 rfl
5577 _ =
5578 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1) *
5579 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j))).prod *
5580 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1))⁻¹ := by
5581 rw [← ReidemeisterSchreier.Discrete.Presentations.conjugate_list_prod
5582 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1))
5583 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j)))]
5584 have hkerEq :
5585 z = a * edge kZero * (List.ofFn (fun j : Fin tailLen => c j kLast)).prod := by
5586 apply Subtype.ext
5587 change
5588 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
5589 totalRelation source *
5590 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ =
5591 ((a : φ.ker) : FreeGroup (FuchsianGenerator source)) *
5592 ((edge kZero : φ.ker) : FreeGroup (FuchsianGenerator source)) *
5593 (((List.ofFn (fun j : Fin tailLen => c j kLast)).prod : φ.ker) :
5594 FreeGroup (FuchsianGenerator source))
5595 rw [hprodCoe, htailList, htailConj]
5598 rw [hTailEq]
5599 rw [hlast]
5600 simp only [x, y, tailGen, mul_assoc]
5601 rw [← mul_assoc]
5602 rw [← pow_succ]
5603 have hsuccNat : p - 1 + 1 = p := by omega
5604 rw [hsuccNat]
5605 group
5606 have htailMap :
5607 basis.symm ((List.ofFn (fun j : Fin tailLen => c j kLast)).prod) =
5608 (List.ofFn (fun j : Fin tailLen => basis.symm (c j kLast))).prod := by
5609 rw [map_list_prod, List.map_ofFn]
5610 rfl
5611 have hmap :
5612 basis.symm (a * edge kZero * (List.ofFn (fun j : Fin tailLen => c j kLast)).prod) =
5613 basis.symm a * basis.symm (edge kZero) *
5614 (List.ofFn (fun j : Fin tailLen => basis.symm (c j kLast))).prod := by
5616 let tailWord :=
5617 (List.ofFn (fun j : Fin tailLen => basis.symm (c j kLast))).prod
5618 let firstWord := basis.symm a
5619 let secondWord := basis.symm (edge kZero)
5620 have hFirstImg : η firstWord = 1 := by
5621 simpa [source, target, basis, η, a, firstWord] using
5623 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
5624 have hSecondImg : η secondWord = (block kLast)⁻¹ := by
5625 have hword :=
5627 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e kZero
5628 simpa [source, target, basis, η, edge, secondWord, block, kZero, kLast,
5629 oneHeadPeriodOneSecondEdgeForwardWord] using hword
5630 have hTailImg : η tailWord = block kLast := by
5631 simpa [source, target, basis, η, c, tailWord, block] using
5633 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e kLast
5634 rw [hkerEq, hmap]
5636 change η firstWord * η secondWord * η tailWord ∈
5638 rw [hFirstImg, hSecondImg, hTailImg]
5639 simp only [one_mul, inv_mul_cancel, one_mem]
5640 · let knw : Fin (p - 1) := ⟨k.val, by omega⟩
5641 let k0 : Fin p := ⟨knw.val, by omega⟩
5642 let k1 : Fin p := ⟨knw.val + 1, by omega⟩
5643 have hprodCoe :
5644 (((List.ofFn (fun j : Fin tailLen => c j k0)).prod : φ.ker) :
5645 FreeGroup (FuchsianGenerator source)) =
5646 (List.ofFn (fun j : Fin tailLen =>
5647 ((c j k0 : φ.ker) : FreeGroup (FuchsianGenerator source)))).prod := by
5648 change
5649 φ.ker.subtype ((List.ofFn (fun j : Fin tailLen => c j k0)).prod) =
5650 (List.ofFn (fun j : Fin tailLen => φ.ker.subtype (c j k0))).prod
5651 rw [map_list_prod, List.map_ofFn]
5652 rfl
5653 have htailList :
5654 (List.ofFn (fun j : Fin tailLen =>
5655 ((c j k0 : φ.ker) : FreeGroup (FuchsianGenerator source)))) =
5656 List.ofFn (fun j : Fin tailLen =>
5657 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
5658 FreeGroup.of (tailGen j) *
5659 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹) := by
5660 apply List.ofFn_inj.2
5661 funext j
5662 simpa [source, φ, x, tailGen, c, k0, knw] using
5664 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k0
5665 have htailConj :
5666 (List.ofFn (fun j : Fin tailLen =>
5667 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
5668 FreeGroup.of (tailGen j) *
5669 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹)).prod =
5670 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
5671 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j))).prod *
5672 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ := by
5673 calc
5674 (List.ofFn (fun j : Fin tailLen =>
5675 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
5676 FreeGroup.of (tailGen j) *
5677 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹)).prod =
5678 (List.map
5679 (fun u =>
5680 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
5681 u * ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹)
5682 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j)))).prod := by
5683 rw [List.map_ofFn]
5684 rfl
5685 _ =
5686 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
5687 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j))).prod *
5688 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ := by
5689 rw [← ReidemeisterSchreier.Discrete.Presentations.conjugate_list_prod
5690 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)
5691 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j)))]
5692 have hkerEq :
5693 z = edge k1 * (List.ofFn (fun j : Fin tailLen => c j k0)).prod := by
5694 apply Subtype.ext
5695 change
5696 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
5697 totalRelation source *
5698 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ =
5699 ((edge k1 : φ.ker) : FreeGroup (FuchsianGenerator source)) *
5700 (((List.ofFn (fun j : Fin tailLen => c j k0)).prod : φ.ker) :
5701 FreeGroup (FuchsianGenerator source))
5702 rw [hprodCoe, htailList, htailConj]
5704 rw [hTailEq]
5705 simp only [x, y, tailGen, mul_assoc]
5706 simp only [Fin.isValue, inv_mul_cancel_left, knw]
5707 rw [← mul_assoc, ← pow_succ]
5708 have hmap :
5709 basis.symm (edge k1 * (List.ofFn (fun j : Fin tailLen => c j k0)).prod) =
5710 basis.symm (edge k1) *
5711 (List.ofFn (fun j : Fin tailLen => basis.symm (c j k0))).prod := by
5713 rfl
5714 let tailWord :=
5715 (List.ofFn (fun j : Fin tailLen => basis.symm (c j k0))).prod
5716 let secondWord := basis.symm (edge k1)
5717 have hSecondImg : η secondWord = (block k0)⁻¹ := by
5718 have hword :=
5720 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e k1
5721 have hne : ¬ k1.val = 0 := by
5722 dsimp [k1, knw]
5723 omega
5724 have hprev : k1.val - 1 = k0.val := by
5725 dsimp [k1, k0, knw]
5726 simpa [source, target, basis, η, edge, secondWord, block, k0, k1,
5727 oneHeadPeriodOneSecondEdgeForwardWord, hne, hprev] using hword
5728 have hTailImg : η tailWord = block k0 := by
5729 simpa [source, target, basis, η, c, tailWord, block] using
5731 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e k0
5732 rw [hkerEq, hmap]
5735 rw [hSecondImg, hTailImg]
5736 simp only [inv_mul_cancel, one_mem]
5739 {tailLen p : ℕ}
5740 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
5741 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
5742 (hm₂'ge : 2 ≤ m₂') (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
5743 (e :
5744 OriginalFirstReductionIndex tailLen ≃
5745 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
5746 hTailLen).numPeriods)
5747 (hperiods :
5748 let source :=
5749 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
5750 ∀ x : OriginalFirstReductionIndex tailLen,
5751 source.periods (e x) =
5752 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
5753 (he : e = originalFirstReductionOrderedIndexEquiv tailLen)
5754 (hm₁'one : m₁' = 1) :
5755 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
5756 let source :=
5757 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
5758 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
5759 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
5760 let ξ :=
5762 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5763 let f := ellipticQuotientGeneratorImage source ξ
5764 let T :=
5766 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5767 let basis :=
5769 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5770 let η :=
5772 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
5773 ∀ r ∈
5775 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T),
5777 classical
5778 dsimp
5779 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
5780 let source :=
5781 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
5782 let target := oneHeadPeriodOneTargetSignature m₂' tail hp hm₂'ge htail hTailLen
5783 let φ :=
5785 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5786 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
5787 let ξ :=
5789 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5790 let f := ellipticQuotientGeneratorImage source ξ
5791 let T :=
5793 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5794 let basis :=
5796 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5797 let η :=
5799 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e
5800 let x :=
5802 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5803 have hx : φ (FreeGroup.of x) = Multiplicative.ofAdd (1 : ZMod p) := by
5804 simpa [source, φ, x, originalFirstReductionPeriodOneFreeQuotientHom] using
5806 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5807 let hrels :=
5809 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
5810 intro r hr
5811 have hrImage :
5814 simpa [basis] using
5818 (y := r)).1 hr
5819 rcases hrImage with ⟨t, ht, r₀, hr₀, hval⟩
5820 have htPower : ∃ k : Fin p, t = (FreeGroup.of x) ^ k.val := by
5821 simpa [T] using
5822 (mem_range_cyclicQuotientRightRep_iff_generatorPower φ (x := x) hx).1 ht
5823 rcases htPower with ⟨k, rfl⟩
5824 let tPow : FreeGroup (FuchsianGenerator source) := (FreeGroup.of x) ^ k.val
5825 have relator_eq :
5826 r =
5827 basis.symm
5828 (⟨tPow * r₀ * tPow⁻¹, by
5829 change φ (tPow * r₀ * tPow⁻¹) = 1
5830 have hrφ : φ r₀ = 1 := hrels r₀ hr₀
5831 simp only [Lean.Elab.WF.paramLet, map_mul, hrφ, mul_one, map_inv, mul_inv_cancel]⟩ : φ.ker) := by
5832 let zRel : φ.ker :=
5833 ⟨tPow * r₀ * tPow⁻¹, by
5834 change φ (tPow * r₀ * tPow⁻¹) = 1
5835 have hrφ : φ r₀ = 1 := hrels r₀ hr₀
5837 have hz : basis r = zRel := by
5838 apply Subtype.ext
5839 simpa [tPow, zRel] using hval
5840 calc
5841 r = basis.symm (basis r) := by simp only [MulEquiv.symm_apply_apply]
5842 _ = basis.symm zRel := by rw [hz]
5843 rcases hr₀ with ⟨i, rfl⟩ | rfl
5844 · let idx : OriginalFirstReductionIndex tailLen := e.symm i
5845 have hi : i = e idx := by
5846 symm
5847 simp only [Equiv.apply_symm_apply, idx]
5848 cases hidx : idx with
5849 | inl a =>
5850 fin_cases a
5851 · rw [relator_eq]
5852 simpa [source, target, φ, basis, η, x, tPow, hi, hidx] using
5854 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e hperiods
5855 hm₁'one k
5856 · rw [relator_eq]
5857 simpa [source, target, φ, basis, η, x, tPow, hi, hidx] using
5859 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e hperiods k
5860 | inr j =>
5861 rw [relator_eq]
5862 simpa [source, target, φ, basis, η, x, tPow, hi, hidx] using
5864 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e hperiods j k
5865 · rw [relator_eq]
5866 simpa [source, target, φ, basis, η, x, tPow] using
5868 m₁' m₂' tail hp hm₁' hm₂' hm₂'ge htail hTailLen e hperiods he k
5871 {tailLen p : ℕ}
5872 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
5873 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
5874 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
5875 (hHigh : 3 ≤ p * tailLen)
5876 (e :
5877 OriginalFirstReductionIndex tailLen ≃
5878 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
5879 hTailLen).numPeriods)
5880 (hperiods :
5881 let source :=
5882 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
5883 ∀ x : OriginalFirstReductionIndex tailLen,
5884 source.periods (e x) =
5885 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
5886 (hm₁'one : m₁' = 1)
5887 (k : Fin p) :
5888 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
5889 let source :=
5890 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
5891 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
5892 let φ :=
5894 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5895 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
5896 let basis :=
5898 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5899 let η :=
5901 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
5902 let x :=
5904 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5905 let i₀ := e (.inl (0 : Fin 2))
5906 η
5907 (basis.symm
5909 ((FreeGroup.of x) ^ k.val)⁻¹, by
5910 change φ
5912 ((FreeGroup.of x) ^ k.val)⁻¹) = 1
5913 have hrφ :
5915 simpa [source, φ, i₀, originalFirstReductionPeriodOneFreeQuotientHom] using
5917 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
5919 simp only [Lean.Elab.WF.paramLet, map_mul, map_pow, hrφ, mul_one, map_inv, mul_inv_cancel]⟩ : φ.ker)) ∈
5921 classical
5922 dsimp
5923 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
5924 let source :=
5925 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
5926 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
5927 let φ :=
5929 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5930 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
5931 let basis :=
5933 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5934 let η :=
5936 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
5937 let x :=
5939 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5940 let i₀ := e (.inl (0 : Fin 2))
5941 let a :=
5943 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
5944 let z : φ.ker :=
5946 ((FreeGroup.of x) ^ k.val)⁻¹, by
5947 change φ
5949 ((FreeGroup.of x) ^ k.val)⁻¹) = 1
5950 have hrφ :
5952 simpa [source, φ, i₀, originalFirstReductionPeriodOneFreeQuotientHom] using
5954 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
5957 have hPeriod : source.periods i₀ = p := by
5958 rw [show i₀ = e (.inl (0 : Fin 2)) by rfl]
5959 rw [hperiods (.inl (0 : Fin 2))]
5960 simp only [originalFirstReductionPeriods, twoPeriods, Nat.reduceAdd, hm₁'one, mul_one, Fin.isValue,
5961 Fin.cases_zero]
5962 have hz : z = a := by
5963 apply Subtype.ext
5964 have hxEq : x = FuchsianGenerator.elliptic i₀ := by
5965 simp only [Lean.Elab.WF.paramLet, originalFirstReductionPeriodOneDistinguishedGenerator, Fin.isValue, id_eq,
5966 x, i₀]
5967 change
5968 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
5970 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ =
5971 ((a : φ.ker) : FreeGroup (FuchsianGenerator source))
5973 rw [hxEq]
5975 let g : FreeGroup (FuchsianGenerator source) :=
5976 FreeGroup.of (FuchsianGenerator.elliptic i₀)
5977 change g ^ k.val * g ^ p * (g ^ k.val)⁻¹ = g ^ p
5978 have hcomm : Commute (g ^ k.val) (g ^ p) :=
5979 (Commute.refl g).pow_pow k.val p
5980 calc
5981 g ^ k.val * g ^ p * (g ^ k.val)⁻¹ =
5982 (g ^ p * g ^ k.val) * (g ^ k.val)⁻¹ := by
5983 rw [hcomm.eq]
5984 _ = g ^ p := by simp only [mul_assoc, mul_inv_cancel, mul_one]
5986 rw [hz]
5991 {tailLen p : ℕ}
5992 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
5993 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
5994 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
5995 (hHigh : 3 ≤ p * tailLen)
5996 (e :
5997 OriginalFirstReductionIndex tailLen ≃
5998 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
5999 hTailLen).numPeriods)
6000 (hperiods :
6001 let source :=
6002 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
6003 ∀ x : OriginalFirstReductionIndex tailLen,
6004 source.periods (e x) =
6005 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
6006 (hm₂'one : m₂' = 1)
6007 (k : Fin p) :
6008 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
6009 let source :=
6010 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
6011 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
6012 let φ :=
6014 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6015 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
6016 let basis :=
6018 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6019 let η :=
6021 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
6022 let x :=
6024 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6025 let i₁ := e (.inl (1 : Fin 2))
6026 η
6027 (basis.symm
6029 ((FreeGroup.of x) ^ k.val)⁻¹, by
6030 change φ
6032 ((FreeGroup.of x) ^ k.val)⁻¹) = 1
6033 have hrφ :
6035 simpa [source, φ, i₁, originalFirstReductionPeriodOneFreeQuotientHom] using
6037 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
6039 simp only [Lean.Elab.WF.paramLet, map_mul, map_pow, hrφ, mul_one, map_inv, mul_inv_cancel]⟩ : φ.ker)) ∈
6041 classical
6042 dsimp
6043 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
6044 let source :=
6045 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
6046 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
6047 let φ :=
6049 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6050 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
6051 let basis :=
6053 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6054 let η :=
6056 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
6057 let x :=
6059 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6060 let i₁ := e (.inl (1 : Fin 2))
6061 let y : FuchsianGenerator source := FuchsianGenerator.elliptic i₁
6062 let edge : Fin p → φ.ker :=
6064 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6065 let lower :=
6066 (List.ofFn (fun i : Fin k.val => edge ⟨k.val - i.val, by omega⟩)).prod
6067 let wrap := edge ⟨0, lt_of_lt_of_le (by decide : 0 < 2) hp⟩
6068 let upper :=
6069 (List.ofFn (fun i : Fin (p - 1 - k.val) => edge ⟨p - 1 - i.val, by omega⟩)).prod
6070 let cycle : φ.ker := lower * wrap * upper
6071 let block := doublePeriodOneTargetTailBlockWord tail htail hHigh
6072 let z : φ.ker :=
6074 ((FreeGroup.of x) ^ k.val)⁻¹, by
6075 change φ
6077 ((FreeGroup.of x) ^ k.val)⁻¹) = 1
6078 have hrφ :
6080 simpa [source, φ, i₁, originalFirstReductionPeriodOneFreeQuotientHom] using
6082 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
6085 have hPeriod : source.periods i₁ = p := by
6086 rw [show i₁ = e (.inl (1 : Fin 2)) by rfl]
6087 rw [hperiods (.inl (1 : Fin 2))]
6088 simp only [originalFirstReductionPeriods, twoPeriods, Nat.reduceAdd, hm₂'one, mul_one, Fin.isValue,
6090 have hcycleSource :
6091 cycle =
6092 (⟨(FreeGroup.of x) ^ k.val * (FreeGroup.of y) ^ p *
6093 ((FreeGroup.of x) ^ k.val)⁻¹, by
6094 rw [MonoidHom.mem_ker]
6095 have hx : φ (FreeGroup.of x) = Multiplicative.ofAdd (1 : ZMod p) := by
6096 simpa [φ, x, originalFirstReductionPeriodOneDistinguishedGenerator] using
6098 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6099 have hy : φ (FreeGroup.of y) = Multiplicative.ofAdd (-1 : ZMod p) := by
6100 simpa [φ, y, i₁] using
6102 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6104 apply (Multiplicative.toAdd : Multiplicative (ZMod p) ≃ ZMod p).injective
6105 simp only [ofAdd_neg, inv_pow, mul_inv_cancel_comm, toAdd_inv, toAdd_pow, toAdd_ofAdd, nsmul_eq_mul,
6106 CharP.cast_eq_zero, mul_one, neg_zero, toAdd_one]⟩ : φ.ker) := by
6107 simpa [source, φ, x, y, edge, lower, wrap, upper, cycle] using
6109 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e k
6110 have hz : z = cycle := by
6111 apply Subtype.ext
6112 change
6113 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
6115 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ =
6116 ((cycle : φ.ker) : FreeGroup (FuchsianGenerator source))
6117 have hcycleCoe := congrArg
6118 (fun u : φ.ker => (u : FreeGroup (FuchsianGenerator source))) hcycleSource
6119 have hcycleCoe' :
6120 ((cycle : φ.ker) : FreeGroup (FuchsianGenerator source)) =
6121 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
6122 (FreeGroup.of y) ^ p *
6123 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ := by
6124 simpa using hcycleCoe
6125 rw [hcycleCoe']
6127 have hLowerImage :
6128 η (basis.symm lower) =
6129 (List.ofFn (fun i : Fin k.val =>
6130 (block ⟨k.val - 1 - i.val, by omega⟩)⁻¹)).prod := by
6131 rw [map_list_prod, List.map_ofFn]
6132 rw [map_list_prod, List.map_ofFn]
6133 apply congrArg List.prod
6134 apply List.ofFn_inj.2
6135 funext i
6136 let r : Fin p := ⟨k.val - i.val, by omega⟩
6137 have hrne : ¬ r.val = 0 := by
6138 dsimp [r]
6139 omega
6140 have hword :=
6142 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e r
6143 have hprev : k.val - i.val - 1 = k.val - 1 - i.val := by omega
6144 simpa [source, basis, η, edge, block, r, doublePeriodOneSecondEdgeForwardWord,
6145 hrne, hprev] using hword
6146 have hWrapImage :
6147 η (basis.symm wrap) = (block ⟨p - 1, by omega⟩)⁻¹ := by
6148 have hword :=
6150 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
6151 (⟨0, lt_of_lt_of_le (by decide : 0 < 2) hp⟩ : Fin p)
6152 simpa [source, basis, η, edge, wrap, block, doublePeriodOneSecondEdgeForwardWord] using
6153 hword
6154 have hUpperImage :
6155 η (basis.symm upper) =
6156 (List.ofFn (fun i : Fin (p - 1 - k.val) =>
6157 (block ⟨p - 2 - i.val, by omega⟩)⁻¹)).prod := by
6158 rw [map_list_prod, List.map_ofFn]
6159 rw [map_list_prod, List.map_ofFn]
6160 apply congrArg List.prod
6161 apply List.ofFn_inj.2
6162 funext i
6163 let r : Fin p := ⟨p - 1 - i.val, by omega⟩
6164 have hrne : ¬ r.val = 0 := by
6165 dsimp [r]
6166 omega
6167 have hword :=
6169 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e r
6170 have hprev : p - 1 - i.val - 1 = p - 2 - i.val := by omega
6171 simpa [source, basis, η, edge, block, r, doublePeriodOneSecondEdgeForwardWord,
6172 hrne, hprev] using hword
6173 have hImageDesc :
6174 η (basis.symm cycle) =
6175 (List.ofFn (fun i : Fin k.val =>
6176 (block ⟨k.val - 1 - i.val, by omega⟩)⁻¹)).prod *
6177 (block ⟨p - 1, by omega⟩)⁻¹ *
6178 (List.ofFn (fun i : Fin (p - 1 - k.val) =>
6179 (block ⟨p - 2 - i.val, by omega⟩)⁻¹)).prod := by
6180 have hmap :
6181 basis.symm cycle =
6182 basis.symm lower * basis.symm wrap * basis.symm upper := by
6185 have hTotalBlocks :
6186 (List.ofFn (fun k : Fin p => block k)).prod ∈
6188 have hTotalRel :
6189 totalRelation target ∈ Subgroup.normalClosure (relators target) :=
6190 Subgroup.subset_normalClosure (Or.inr rfl)
6191 simpa [target, block, doublePeriodOneTargetTailBlockWord,
6192 doublePeriodOneTarget_totalRelation_eq_blocks] using hTotalRel
6193 have hRotInv :
6194 ((List.ofFn (fun i : Fin (p - k.val) =>
6195 block ⟨k.val + i.val, by omega⟩)).prod *
6196 (List.ofFn (fun i : Fin k.val => block ⟨i.val, by omega⟩)).prod)⁻¹ ∈
6200 have hDescEq :=
6202 (G := FreeGroup (FuchsianGenerator target)) hp block k
6203 have hCycleMem :
6205 rw [hImageDesc, hDescEq]
6206 exact hRotInv
6208 rw [hz]
6209 exact hCycleMem
6212 {tailLen p : ℕ}
6213 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
6214 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
6215 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
6216 (hHigh : 3 ≤ p * tailLen)
6217 (e :
6218 OriginalFirstReductionIndex tailLen ≃
6219 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
6220 hTailLen).numPeriods)
6221 (hperiods :
6222 let source :=
6223 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
6224 ∀ x : OriginalFirstReductionIndex tailLen,
6225 source.periods (e x) =
6226 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
6227 (j : Fin tailLen) (k : Fin p) :
6228 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
6229 let source :=
6230 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
6231 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
6232 let φ :=
6234 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6235 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
6236 let basis :=
6238 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6239 let η :=
6241 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
6242 let x :=
6244 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6245 let iTail := e (.inr j)
6246 η
6247 (basis.symm
6249 ((FreeGroup.of x) ^ k.val)⁻¹, by
6250 change φ
6252 ((FreeGroup.of x) ^ k.val)⁻¹) = 1
6253 have hrφ :
6255 simpa [source, φ, iTail, originalFirstReductionPeriodOneFreeQuotientHom] using
6257 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
6259 simp only [Lean.Elab.WF.paramLet, map_mul, map_pow, hrφ, mul_one, map_inv, mul_inv_cancel]⟩ : φ.ker)) ∈
6261 classical
6262 dsimp
6263 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
6264 let source :=
6265 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
6266 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
6267 let φ :=
6269 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6270 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
6271 let basis :=
6273 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6274 let η :=
6276 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
6277 let x :=
6279 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6280 let iTail := e (.inr j)
6281 let c :=
6283 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k
6284 let z : φ.ker :=
6286 ((FreeGroup.of x) ^ k.val)⁻¹, by
6287 change φ
6289 ((FreeGroup.of x) ^ k.val)⁻¹) = 1
6290 have hrφ :
6292 simpa [source, φ, iTail, originalFirstReductionPeriodOneFreeQuotientHom] using
6294 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
6297 have hPeriod : source.periods iTail = tail j := by
6298 rw [show iTail = e (.inr j) by rfl]
6299 rw [hperiods (.inr j)]
6300 simp only [originalFirstReductionPeriods]
6301 have hz : z = c ^ tail j := by
6302 apply Subtype.ext
6303 change
6304 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
6306 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ =
6307 ((c ^ tail j : φ.ker) : FreeGroup (FuchsianGenerator source))
6308 rw [show ((c ^ tail j : φ.ker) : FreeGroup (FuchsianGenerator source)) =
6309 ((c : φ.ker) : FreeGroup (FuchsianGenerator source)) ^ tail j by
6310 exact (map_pow (φ.ker.subtype) c (tail j))]
6313 have hIndexPair :
6314 ((finProdFinEquiv (k, j)).divNat, (finProdFinEquiv (k, j)).modNat) = (k, j) := by
6315 have h := finProdFinEquiv.symm_apply_apply (k, j)
6316 rw [finProdFinEquiv_symm_apply] at h
6317 exact h
6318 have hIndexSnd : (finProdFinEquiv (k, j)).modNat = j :=
6319 congrArg Prod.snd hIndexPair
6320 have hTargetPeriod :
6321 target.periods (finProdFinEquiv (k, j)) = tail j := by
6322 simp only [doublePeriodOneTailReplicatedSignature, finProdFinEquiv_symm_apply, hIndexSnd, target]
6323 have hTargetRel :
6326 have hrel :
6329 Or.inl ⟨finProdFinEquiv (k, j), rfl⟩
6330 simpa [hTargetPeriod] using Subgroup.subset_normalClosure hrel
6332 rw [hz]
6333 rw [map_pow (basis.symm) c (tail j), map_pow]
6335 exact hTargetRel
6337private theorem doublePeriodOneSchreierToTargetHom_tailBlockWord
6338 {tailLen p : ℕ}
6339 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
6340 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
6341 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
6342 (hHigh : 3 ≤ p * tailLen)
6343 (e :
6344 OriginalFirstReductionIndex tailLen ≃
6345 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
6346 hTailLen).numPeriods)
6347 (k : Fin p) :
6348 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
6349 let source :=
6350 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
6351 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
6352 let basis :=
6354 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6355 let η :=
6357 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
6358 η
6359 ((List.ofFn (fun j : Fin tailLen =>
6360 basis.symm
6362 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k))).prod) =
6363 doublePeriodOneTargetTailBlockWord tail htail hHigh k := by
6364 classical
6365 dsimp
6366 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
6367 let source :=
6368 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
6369 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
6370 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
6371 let basis :=
6373 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6374 let η :=
6376 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
6377 rw [map_list_prod, List.map_ofFn]
6378 change
6379 (List.ofFn (fun j : Fin tailLen =>
6380 η
6381 (basis.symm
6383 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k)))).prod =
6384 (List.ofFn (fun j : Fin tailLen =>
6386 apply congrArg List.prod
6387 apply List.ofFn_inj.2
6388 funext j
6389 simpa [source, target, basis, η] using
6391 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e j k
6394 {tailLen p : ℕ}
6395 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
6396 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
6397 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
6398 (hHigh : 3 ≤ p * tailLen)
6399 (e :
6400 OriginalFirstReductionIndex tailLen ≃
6401 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
6402 hTailLen).numPeriods)
6403 (hperiods :
6404 let source :=
6405 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
6406 ∀ x : OriginalFirstReductionIndex tailLen,
6407 source.periods (e x) =
6408 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
6409 (he : e = originalFirstReductionOrderedIndexEquiv tailLen)
6410 (k : Fin p) :
6411 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
6412 let source :=
6413 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
6414 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
6415 let φ :=
6417 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6418 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
6419 let basis :=
6421 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6422 let η :=
6424 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
6425 let x :=
6427 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6428 η
6429 (basis.symm
6430 (⟨(FreeGroup.of x) ^ k.val * totalRelation source *
6431 ((FreeGroup.of x) ^ k.val)⁻¹, by
6432 change φ
6433 ((FreeGroup.of x) ^ k.val * totalRelation source *
6434 ((FreeGroup.of x) ^ k.val)⁻¹) = 1
6435 have hrφ : φ (totalRelation source) = 1 := by
6436 simpa [source, φ, originalFirstReductionPeriodOneFreeQuotientHom] using
6438 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
6439 (totalRelation source) (Or.inr rfl)
6440 simp only [Lean.Elab.WF.paramLet, map_mul, map_pow, hrφ, mul_one, map_inv, mul_inv_cancel]⟩ : φ.ker)) ∈
6442 classical
6443 dsimp
6444 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
6445 let source :=
6446 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
6447 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
6448 let φ :=
6450 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6451 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
6452 let basis :=
6454 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6455 let η :=
6457 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
6458 let x :=
6460 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6461 let y : FuchsianGenerator source := FuchsianGenerator.elliptic (e (.inl (1 : Fin 2)))
6462 let tailGen : Fin tailLen → FuchsianGenerator source := fun j =>
6463 FuchsianGenerator.elliptic (e (.inr j))
6464 let block := doublePeriodOneTargetTailBlockWord tail htail hHigh
6465 let a :=
6467 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6468 let edge : Fin p → φ.ker :=
6470 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6471 let c : Fin tailLen → Fin p → φ.ker := fun j k =>
6473 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k
6474 let z : φ.ker :=
6475 ⟨(FreeGroup.of x) ^ k.val * totalRelation source *
6476 ((FreeGroup.of x) ^ k.val)⁻¹, by
6477 change φ
6478 ((FreeGroup.of x) ^ k.val * totalRelation source *
6479 ((FreeGroup.of x) ^ k.val)⁻¹) = 1
6480 have hrφ : φ (totalRelation source) = 1 := by
6481 simpa [source, φ, originalFirstReductionPeriodOneFreeQuotientHom] using
6483 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
6484 (totalRelation source) (Or.inr rfl)
6486 have hTailEq :
6487 totalRelation source =
6488 FreeGroup.of x * FreeGroup.of y *
6489 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j))).prod := by
6490 subst e
6491 have hTotal :=
6493 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
6496 originalFirstReductionOrderedIndexEquiv] using hTotal
6498 by_cases hlast : k.val = p - 1
6499 · let kLast : Fin p := ⟨p - 1, by omega⟩
6500 let kZero : Fin p := ⟨0, lt_of_lt_of_le (by decide : 0 < 2) hp⟩
6501 have hprodCoe :
6502 (((List.ofFn (fun j : Fin tailLen => c j kLast)).prod : φ.ker) :
6503 FreeGroup (FuchsianGenerator source)) =
6504 (List.ofFn (fun j : Fin tailLen =>
6505 ((c j kLast : φ.ker) : FreeGroup (FuchsianGenerator source)))).prod := by
6506 change
6507 φ.ker.subtype ((List.ofFn (fun j : Fin tailLen => c j kLast)).prod) =
6508 (List.ofFn (fun j : Fin tailLen => φ.ker.subtype (c j kLast))).prod
6509 rw [map_list_prod, List.map_ofFn]
6510 rfl
6511 have htailList :
6512 (List.ofFn (fun j : Fin tailLen =>
6513 ((c j kLast : φ.ker) : FreeGroup (FuchsianGenerator source)))) =
6514 List.ofFn (fun j : Fin tailLen =>
6515 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1) *
6516 FreeGroup.of (tailGen j) *
6517 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1))⁻¹) := by
6518 apply List.ofFn_inj.2
6519 funext j
6520 simpa [source, φ, x, tailGen, c, kLast] using
6522 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j kLast
6523 have htailConj :
6524 (List.ofFn (fun j : Fin tailLen =>
6525 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1) *
6526 FreeGroup.of (tailGen j) *
6527 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1))⁻¹)).prod =
6528 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1) *
6529 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j))).prod *
6530 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1))⁻¹ := by
6531 calc
6532 (List.ofFn (fun j : Fin tailLen =>
6533 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1) *
6534 FreeGroup.of (tailGen j) *
6535 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1))⁻¹)).prod =
6536 (List.map
6537 (fun u =>
6538 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1) *
6539 u *
6540 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1))⁻¹)
6541 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j)))).prod := by
6542 rw [List.map_ofFn]
6543 rfl
6544 _ =
6545 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1) *
6546 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j))).prod *
6547 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1))⁻¹ := by
6548 rw [← ReidemeisterSchreier.Discrete.Presentations.conjugate_list_prod
6549 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ (p - 1))
6550 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j)))]
6551 have hkerEq :
6552 z = a * edge kZero * (List.ofFn (fun j : Fin tailLen => c j kLast)).prod := by
6553 apply Subtype.ext
6554 change
6555 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
6556 totalRelation source *
6557 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ =
6558 ((a : φ.ker) : FreeGroup (FuchsianGenerator source)) *
6559 ((edge kZero : φ.ker) : FreeGroup (FuchsianGenerator source)) *
6560 (((List.ofFn (fun j : Fin tailLen => c j kLast)).prod : φ.ker) :
6561 FreeGroup (FuchsianGenerator source))
6562 rw [hprodCoe, htailList, htailConj]
6565 rw [hTailEq]
6566 rw [hlast]
6567 simp only [x, y, tailGen, mul_assoc]
6568 rw [← mul_assoc]
6569 rw [← pow_succ]
6570 have hsuccNat : p - 1 + 1 = p := by omega
6571 rw [hsuccNat]
6572 group
6573 have htailMap :
6574 basis.symm ((List.ofFn (fun j : Fin tailLen => c j kLast)).prod) =
6575 (List.ofFn (fun j : Fin tailLen => basis.symm (c j kLast))).prod := by
6576 rw [map_list_prod, List.map_ofFn]
6577 rfl
6578 have hmap :
6579 basis.symm (a * edge kZero * (List.ofFn (fun j : Fin tailLen => c j kLast)).prod) =
6580 basis.symm a * basis.symm (edge kZero) *
6581 (List.ofFn (fun j : Fin tailLen => basis.symm (c j kLast))).prod := by
6583 let tailWord :=
6584 (List.ofFn (fun j : Fin tailLen => basis.symm (c j kLast))).prod
6585 let firstWord := basis.symm a
6586 let secondWord := basis.symm (edge kZero)
6587 have hFirstImg : η firstWord = 1 := by
6588 simpa [source, target, basis, η, a, firstWord] using
6590 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
6591 have hSecondImg : η secondWord = (block kLast)⁻¹ := by
6592 have hword :=
6594 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e kZero
6595 simpa [source, target, basis, η, edge, secondWord, block, kZero, kLast,
6596 doublePeriodOneSecondEdgeForwardWord] using hword
6597 have hTailImg : η tailWord = block kLast := by
6598 simpa [source, target, basis, η, c, tailWord, block] using
6600 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e kLast
6601 rw [hkerEq, hmap]
6603 change η firstWord * η secondWord * η tailWord ∈
6605 rw [hFirstImg, hSecondImg, hTailImg]
6606 simp only [one_mul, inv_mul_cancel, one_mem]
6607 · let knw : Fin (p - 1) := ⟨k.val, by omega⟩
6608 let k0 : Fin p := ⟨knw.val, by omega⟩
6609 let k1 : Fin p := ⟨knw.val + 1, by omega⟩
6610 have hprodCoe :
6611 (((List.ofFn (fun j : Fin tailLen => c j k0)).prod : φ.ker) :
6612 FreeGroup (FuchsianGenerator source)) =
6613 (List.ofFn (fun j : Fin tailLen =>
6614 ((c j k0 : φ.ker) : FreeGroup (FuchsianGenerator source)))).prod := by
6615 change
6616 φ.ker.subtype ((List.ofFn (fun j : Fin tailLen => c j k0)).prod) =
6617 (List.ofFn (fun j : Fin tailLen => φ.ker.subtype (c j k0))).prod
6618 rw [map_list_prod, List.map_ofFn]
6619 rfl
6620 have htailList :
6621 (List.ofFn (fun j : Fin tailLen =>
6622 ((c j k0 : φ.ker) : FreeGroup (FuchsianGenerator source)))) =
6623 List.ofFn (fun j : Fin tailLen =>
6624 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
6625 FreeGroup.of (tailGen j) *
6626 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹) := by
6627 apply List.ofFn_inj.2
6628 funext j
6629 simpa [source, φ, x, tailGen, c, k0, knw] using
6631 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e j k0
6632 have htailConj :
6633 (List.ofFn (fun j : Fin tailLen =>
6634 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
6635 FreeGroup.of (tailGen j) *
6636 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹)).prod =
6637 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
6638 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j))).prod *
6639 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ := by
6640 calc
6641 (List.ofFn (fun j : Fin tailLen =>
6642 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
6643 FreeGroup.of (tailGen j) *
6644 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹)).prod =
6645 (List.map
6646 (fun u =>
6647 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
6648 u * ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹)
6649 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j)))).prod := by
6650 rw [List.map_ofFn]
6651 rfl
6652 _ =
6653 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
6654 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j))).prod *
6655 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ := by
6656 rw [← ReidemeisterSchreier.Discrete.Presentations.conjugate_list_prod
6657 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)
6658 (List.ofFn (fun j : Fin tailLen => FreeGroup.of (tailGen j)))]
6659 have hkerEq :
6660 z = edge k1 * (List.ofFn (fun j : Fin tailLen => c j k0)).prod := by
6661 apply Subtype.ext
6662 change
6663 (FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val *
6664 totalRelation source *
6665 ((FreeGroup.of x : FreeGroup (FuchsianGenerator source)) ^ k.val)⁻¹ =
6666 ((edge k1 : φ.ker) : FreeGroup (FuchsianGenerator source)) *
6667 (((List.ofFn (fun j : Fin tailLen => c j k0)).prod : φ.ker) :
6668 FreeGroup (FuchsianGenerator source))
6669 rw [hprodCoe, htailList, htailConj]
6671 rw [hTailEq]
6672 simp only [x, y, tailGen, mul_assoc]
6673 simp only [Fin.isValue, inv_mul_cancel_left, knw]
6674 rw [← mul_assoc, ← pow_succ]
6675 have hmap :
6676 basis.symm (edge k1 * (List.ofFn (fun j : Fin tailLen => c j k0)).prod) =
6677 basis.symm (edge k1) *
6678 (List.ofFn (fun j : Fin tailLen => basis.symm (c j k0))).prod := by
6680 rfl
6681 let tailWord :=
6682 (List.ofFn (fun j : Fin tailLen => basis.symm (c j k0))).prod
6683 let secondWord := basis.symm (edge k1)
6684 have hSecondImg : η secondWord = (block k0)⁻¹ := by
6685 have hword :=
6687 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e k1
6688 have hne : ¬ k1.val = 0 := by
6689 dsimp [k1, knw]
6690 omega
6691 have hprev : k1.val - 1 = k0.val := by
6692 dsimp [k1, k0, knw]
6693 simpa [source, target, basis, η, edge, secondWord, block, k0, k1,
6694 doublePeriodOneSecondEdgeForwardWord, hne, hprev] using hword
6695 have hTailImg : η tailWord = block k0 := by
6696 simpa [source, target, basis, η, c, tailWord, block] using
6698 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e k0
6699 rw [hkerEq, hmap]
6702 rw [hSecondImg, hTailImg]
6703 simp only [inv_mul_cancel, one_mem]
6706 {tailLen p : ℕ}
6707 (m₁' m₂' : ℕ) (tail : Fin tailLen → ℕ)
6708 (hp : 2 ≤ p) (hm₁' : 0 < m₁') (hm₂' : 0 < m₂')
6709 (htail : ∀ j, 2 ≤ tail j) (hTailLen : 0 < tailLen)
6710 (hHigh : 3 ≤ p * tailLen)
6711 (e :
6712 OriginalFirstReductionIndex tailLen ≃
6713 Fin (originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail
6714 hTailLen).numPeriods)
6715 (hperiods :
6716 let source :=
6717 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
6718 ∀ x : OriginalFirstReductionIndex tailLen,
6719 source.periods (e x) =
6720 originalFirstReductionPeriods (p := p) m₁' m₂' tail x)
6721 (he : e = originalFirstReductionOrderedIndexEquiv tailLen)
6722 (hm₁'one : m₁' = 1) (hm₂'one : m₂' = 1) :
6723 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
6724 let source :=
6725 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
6726 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
6727 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
6728 let ξ :=
6730 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6731 let f := ellipticQuotientGeneratorImage source ξ
6732 let T :=
6734 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6735 let basis :=
6737 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6738 let η :=
6740 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
6741 ∀ r ∈
6743 (ReidemeisterSchreier.Discrete.Presentations.freeKernelTransversalRelatorSet (f := f) (rels := relators source) T),
6745 classical
6746 dsimp
6747 letI : NeZero p := ⟨Nat.ne_of_gt (lt_of_lt_of_le (by decide : 0 < 2) hp)⟩
6748 let source :=
6749 originalFirstReductionSignature m₁' m₂' tail hp hm₁' hm₂' htail hTailLen
6750 let target := doublePeriodOneTailReplicatedSignature tail htail hHigh
6751 let φ :=
6753 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6754 letI : DecidableEq (FuchsianGenerator source) := Classical.decEq _
6755 let ξ :=
6757 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6758 let f := ellipticQuotientGeneratorImage source ξ
6759 let T :=
6761 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6762 let basis :=
6764 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6765 let η :=
6767 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e
6768 let x :=
6770 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6771 have hx : φ (FreeGroup.of x) = Multiplicative.ofAdd (1 : ZMod p) := by
6772 simpa [source, φ, x, originalFirstReductionPeriodOneFreeQuotientHom] using
6774 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e
6775 let hrels :=
6777 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen e hperiods
6778 intro r hr
6779 have hrImage :
6782 simpa [basis] using
6786 (y := r)).1 hr
6787 rcases hrImage with ⟨t, ht, r₀, hr₀, hval⟩
6788 have htPower : ∃ k : Fin p, t = (FreeGroup.of x) ^ k.val := by
6789 simpa [T] using
6790 (mem_range_cyclicQuotientRightRep_iff_generatorPower φ (x := x) hx).1 ht
6791 rcases htPower with ⟨k, rfl⟩
6792 let tPow : FreeGroup (FuchsianGenerator source) := (FreeGroup.of x) ^ k.val
6793 have relator_eq :
6794 r =
6795 basis.symm
6796 (⟨tPow * r₀ * tPow⁻¹, by
6797 change φ (tPow * r₀ * tPow⁻¹) = 1
6798 have hrφ : φ r₀ = 1 := hrels r₀ hr₀
6799 simp only [Lean.Elab.WF.paramLet, map_mul, hrφ, mul_one, map_inv, mul_inv_cancel]⟩ : φ.ker) := by
6800 let zRel : φ.ker :=
6801 ⟨tPow * r₀ * tPow⁻¹, by
6802 change φ (tPow * r₀ * tPow⁻¹) = 1
6803 have hrφ : φ r₀ = 1 := hrels r₀ hr₀
6805 have hz : basis r = zRel := by
6806 apply Subtype.ext
6807 simpa [tPow, zRel] using hval
6808 calc
6809 r = basis.symm (basis r) := by simp only [MulEquiv.symm_apply_apply]
6810 _ = basis.symm zRel := by rw [hz]
6811 rcases hr₀ with ⟨i, rfl⟩ | rfl
6812 · let idx : OriginalFirstReductionIndex tailLen := e.symm i
6813 have hi : i = e idx := by
6814 symm
6815 simp only [Equiv.apply_symm_apply, idx]
6816 cases hidx : idx with
6817 | inl a =>
6818 fin_cases a
6819 · rw [relator_eq]
6820 simpa [source, target, φ, basis, η, x, tPow, hi, hidx] using
6822 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e hperiods
6823 hm₁'one k
6824 · rw [relator_eq]
6825 simpa [source, target, φ, basis, η, x, tPow, hi, hidx] using
6827 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e hperiods
6828 hm₂'one k
6829 | inr j =>
6830 rw [relator_eq]
6831 simpa [source, target, φ, basis, η, x, tPow, hi, hidx] using
6833 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e hperiods j k
6834 · rw [relator_eq]
6835 simpa [source, target, φ, basis, η, x, tPow] using
6837 m₁' m₂' tail hp hm₁' hm₂' htail hTailLen hHigh e hperiods he k
6839end FenchelNielsen