Raw port through mathport

pull/1/head
Shad Amethyst 12 months ago
parent 6470249db0
commit 7806ecb35e

4
.gitignore vendored

@ -0,0 +1,4 @@
/build
/lean_packages
/lake-packages/*
.lake

File diff suppressed because it is too large Load Diff

@ -0,0 +1,59 @@
{"version": 7,
"packagesDir": ".lake/packages",
"packages":
[{"url": "https://github.com/leanprover/std4",
"type": "git",
"subDir": null,
"rev": "d3049643f6dded69eb7ce8124796cb1ec8df8840",
"name": "std",
"manifestFile": "lake-manifest.json",
"inputRev": "main",
"inherited": true,
"configFile": "lakefile.lean"},
{"url": "https://github.com/leanprover-community/quote4",
"type": "git",
"subDir": null,
"rev": "d3a1d25f3eba0d93a58d5d3d027ffa78ece07755",
"name": "Qq",
"manifestFile": "lake-manifest.json",
"inputRev": "master",
"inherited": true,
"configFile": "lakefile.lean"},
{"url": "https://github.com/leanprover-community/aesop",
"type": "git",
"subDir": null,
"rev": "bf5ab42a58e71de7ebad399ce3f90d29aae7fca9",
"name": "aesop",
"manifestFile": "lake-manifest.json",
"inputRev": "master",
"inherited": true,
"configFile": "lakefile.lean"},
{"url": "https://github.com/leanprover/lean4-cli",
"type": "git",
"subDir": null,
"rev": "a751d21d4b68c999accb6fc5d960538af26ad5ec",
"name": "Cli",
"manifestFile": "lake-manifest.json",
"inputRev": "main",
"inherited": true,
"configFile": "lakefile.lean"},
{"url": "https://github.com/leanprover-community/ProofWidgets4",
"type": "git",
"subDir": null,
"rev": "c3b9f0d4ebedc43635d3f7e764e277b1010844b7",
"name": "proofwidgets",
"manifestFile": "lake-manifest.json",
"inputRev": "v0.0.22",
"inherited": true,
"configFile": "lakefile.lean"},
{"url": "https://github.com/leanprover-community/mathlib4.git",
"type": "git",
"subDir": null,
"rev": "c6979569edc545f999b82d8a833b190c918aec2e",
"name": "mathlib",
"manifestFile": "lake-manifest.json",
"inputRev": null,
"inherited": false,
"configFile": "lakefile.lean"}],
"name": "rubin",
"lakeDir": ".lake"}

@ -0,0 +1,14 @@
import Lake
open Lake DSL
package «rubin» {
-- add any package configuration options here
}
require mathlib from git
"https://github.com/leanprover-community/mathlib4.git"
@[default_target]
lean_lib «Rubin» {
-- add any library configuration options here
}

@ -0,0 +1 @@
leanprover/lean4:v4.3.0-rc2

@ -0,0 +1,103 @@
-- Insert lean 4 alignment code here.
import Mathlib.Mathport.Rename
set_option align.precheck false
#align smul_smul' Rubin.GroupActionExt.smul_smul'
#align smul_eq_smul Rubin.GroupActionExt.smul_eq_smul_inv
#align smul_succ Rubin.GroupActionExt.smul_succ
#align equiv.congr_ne Rubin.equiv_congr_ne
#align subgroup.mk_smul Rubin.GroupActionExt.subgroup_mk_smul
#align bracket_mul Rubin.bracket_mul
#align is_algebraically_disjoint Rubin.is_algebraically_disjoint
#align orbit_bot Rubin.orbit_bot
#align smul_congr Rubin.GroupActionExt.smul_congr
#align smul_eq_iff_inv_smul_eq Rubin.GroupActionExt.smul_eq_iff_inv_smul_eq
#align smul_pow_eq_of_smul_eq Rubin.GroupActionExt.smul_pow_eq_of_smul_eq
#align smul_zpow_eq_of_smul_eq Rubin.GroupActionExt.smul_zpow_eq_of_smul_eq
#align is_equivariant Rubin.GroupActionExt.is_equivariant
#align subset_img' Rubin.SmulImage.smulImage'
#align subset_preimg' Rubin.SmulImage.smul_preimage'
#align subset_img Rubin.SmulImage.SmulImage
#align subset_img_def Rubin.SmulImage.smulImage_def
#align mem_smul'' Rubin.SmulImage.mem_smulImage
#align mem_inv_smul'' Rubin.SmulImage.mem_inv_smulImage
#align mul_smul'' Rubin.SmulImage.mul_smulImage
#align smul''_smul'' Rubin.SmulImage.smulImage_smulImage
#align one_smul'' Rubin.SmulImage.one_smulImage
#align disjoint_smul'' Rubin.SmulImage.disjoint_smulImage
#align smul''_congr Rubin.SmulImage.smulImage_congr
#align smul''_subset Rubin.SmulImage.smulImage_subset
#align smul''_union Rubin.SmulImage.smulImage_union
#align smul''_inter Rubin.SmulImage.smulImage_inter
#align smul''_eq_inv_preimage Rubin.SmulImage.smulImage_eq_inv_preimage
#align smul''_eq_of_smul_eq Rubin.SmulImage.smulImage_eq_of_smul_eq
#align support Rubin.SmulSupport.Support
#align support_eq_not_fixed_by Rubin.SmulSupport.support_eq_not_fixed_by
#align mem_support Rubin.SmulSupport.mem_support
#align mem_not_support Rubin.SmulSupport.not_mem_support
#align smul_in_support Rubin.SmulSupport.smul_mem_support
#align inv_smul_in_support Rubin.SmulSupport.inv_smul_mem_support
#align fixed_of_disjoint Rubin.SmulSupport.fixed_of_disjoint
#align fixes_subset_within_support Rubin.SmulSupport.fixed_smulImage_in_support
#align moves_subset_within_support Rubin.SmulSupport.smulImage_subset_in_support
#align support_mul Rubin.SmulSupport.support_mul
#align support_conjugate Rubin.SmulSupport.support_conjugate
#align support_inv Rubin.SmulSupport.support_inv
#align support_pow Rubin.SmulSupport.support_pow
#align support_comm Rubin.SmulSupport.support_comm
#align disjoint_support_comm Rubin.SmulSupport.disjoint_support_comm
#align continuous_mul_action Rubin.Topological.ContinuousMulAction
#align equivariant_homeomorph Rubin.Topological.equivariant_homeomorph
#align equivariant_fun Rubin.Topological.equivariant_fun
#align equivariant_inv Rubin.Topological.equivariant_inv
#align img_open_open Rubin.Topological.img_open_open
#align support_open Rubin.Topological.support_open
#align faithful_moves_point Rubin.faithful_moves_point₁
#align faithful_moves_point' Rubin.faithful_moves_point'₁
#align faithful_rist_moves_point Rubin.faithful_rigid_stabilizer_moves_point
#align ne_one_support_nempty Rubin.ne_one_support_nonempty
#align disjoint_commute Rubin.disjoint_commute₁
#align has_no_isolated_points Rubin.has_no_isolated_points
#align is_locally_dense Rubin.is_locally_dense
#align rubin_action Rubin.RubinAction
#align period Rubin.Period.period
#align period_le_fix Rubin.Period.period_le_fix
#align notfix_le_period Rubin.Period.notfix_le_period
#align notfix_le_period' Rubin.Period.notfix_le_period'
#align period_neutral_eq_one Rubin.Period.period_neutral_eq_one
#align periods Rubin.Period.periods
#align period_lemma Rubin.Period.periods_lemmas
#align period_from_exponent Rubin.Period.period_from_exponent
#align zero_lt_period_le_Sup_periods Rubin.Period.zero_lt_period_le_Sup_periods
#align pow_period_fix Rubin.Period.pow_period_fix
#align is_locally_moving Rubin.Disjointness.IsLocallyMoving
#align interior_closure Rubin.RegularSupport.InteriorClosure
#align is_open_interior_closure Rubin.RegularSupport.is_open_interiorClosure
#align interior_closure_mono Rubin.RegularSupport.interiorClosure_mono
#align set.is_regular_open Rubin.RegularSupport.Set.is_regular_open
#align set.is_regular_def Rubin.RegularSupport.Set.is_regular_def
#align is_open.in_closure Rubin.RegularSupport.IsOpen.in_closure
#align is_open.interior_closure_subset Rubin.RegularSupport.IsOpen.interiorClosure_subset
#align regular_interior_closure Rubin.RegularSupport.regular_interior_closure
#align regular_support Rubin.RegularSupport.RegularSupport
#align regular_regular_support Rubin.RegularSupport.regularSupport_regular
#align support_in_regular_support Rubin.RegularSupport.support_subset_regularSupport
#align mem_regular_support Rubin.RegularSupport.mem_regularSupport
#align algebraic_centralizer Rubin.RegularSupport.AlgebraicCentralizer

@ -45,7 +45,6 @@ lemma smul_succ {G α : Type*} (n : ) [group G] [mul_action G α] {g : G} {x
rw [← this, smul_smul] rw [← this, smul_smul]
end end
section group_action_tactic section group_action_tactic
namespace tactic.interactive namespace tactic.interactive
@ -157,6 +156,7 @@ add_tactic_doc
end group_action_tactic end group_action_tactic
namespace Rubin
example (G α : Type*) [group G] (a b c : G) [mul_action G α] (x : α) : ⁅a*b,c⁆ • x = (a*⁅b,c⁆*a⁻¹*⁅a,c⁆) • x := begin example (G α : Type*) [group G] (a b c : G) [mul_action G α] (x : α) : ⁅a*b,c⁆ • x = (a*⁅b,c⁆*a⁻¹*⁅a,c⁆) • x := begin
group_action, group_action,
end end
@ -275,6 +275,7 @@ lemma disjoint_smul'' (g : G) {U V : set α} : disjoint U V → disjoint (g •'
exact (disjoint_U_V (mem_smul''.mp x_in_gU)) (mem_smul''.mp h) exact (disjoint_U_V (mem_smul''.mp x_in_gU)) (mem_smul''.mp h)
end end
-- TODO: check if this is actually needed
lemma smul''_congr (g : G) {U V : set α} : U = V → g •'' U = g •'' V := congr_arg (λ(W : set α), g •'' W) lemma smul''_congr (g : G) {U V : set α} : U = V → g •'' U = g •'' V := congr_arg (λ(W : set α), g •'' W)
lemma smul''_subset (g : G) {U V : set α} : U ⊆ V → g •'' U ⊆ g •'' V := begin lemma smul''_subset (g : G) {U V : set α} : U ⊆ V → g •'' U ⊆ g •'' V := begin
@ -486,6 +487,7 @@ lemma ne_one_support_nempty {g : G} : g ≠ 1 → (support α g).nonempty := beg
use x use x
end end
-- FIXME: somehow clashes with another definition
lemma disjoint_commute {f g : G} : disjoint (support α f) (support α g) → commute f g := begin lemma disjoint_commute {f g : G} : disjoint (support α f) (support α g) → commute f g := begin
intro hdisjoint, intro hdisjoint,
rw ← commutator_element_eq_one_iff_commute, rw ← commutator_element_eq_one_iff_commute,
@ -554,6 +556,7 @@ end
def periods (U : set α) (H : subgroup G) : set := def periods (U : set α) (H : subgroup G) : set :=
{ n : | ∃ (p : U) (g : H), period (p : α) (g : G) = n } { n : | ∃ (p : U) (g : H), period (p : α) (g : G) = n }
-- TODO: split into multiple lemmas
lemma period_lemma lemma period_lemma
{U : set α} (U_nonempty : U.nonempty) {U : set α} (U_nonempty : U.nonempty)
{H : subgroup G} (exp_ne_zero : monoid.exponent H ≠ 0) : {H : subgroup G} (exp_ne_zero : monoid.exponent H ≠ 0) :
@ -611,290 +614,288 @@ variables [topological_space α] [continuous_mul_action G α] [has_faithful_smul
def is_locally_moving (G α : Type*) [group G] [topological_space α] [mul_action G α] := def is_locally_moving (G α : Type*) [group G] [topological_space α] [mul_action G α] :=
∀U : set α, is_open U → set.nonempty U → rigid_stabilizer G U ≠ ⊥ ∀U : set α, is_open U → set.nonempty U → rigid_stabilizer G U ≠ ⊥
lemma dense_locally_moving : t2_space α ∧ has_no_isolated_points α ∧ is_locally_dense G α → is_locally_moving G α := begin -- lemma dense_locally_moving : t2_space α ∧ has_no_isolated_points α ∧ is_locally_dense G α → is_locally_moving G α := begin
rintros ⟨t2α,nipα,ildGα⟩ U ioU neU, -- rintros ⟨t2α,nipα,ildGα⟩ U ioU neU,
by_contra, -- by_contra,
have some_in_U := ildGα U neU.some neU.some_mem, -- have some_in_U := ildGα U neU.some neU.some_mem,
rw [h,orbit_bot G neU.some,@closure_singleton α _ (@t2_space.t1_space α _ t2α) neU.some,@interior_singleton α _ neU.some (nipα neU.some)] at some_in_U, -- rw [h,orbit_bot G neU.some,@closure_singleton α _ (@t2_space.t1_space α _ t2α) neU.some,@interior_singleton α _ neU.some (nipα neU.some)] at some_in_U,
tauto -- tauto
end -- end
lemma disjoint_nbhd {g : G} {x : α} [t2_space α] : g • x ≠ x → ∃U : set α, is_open U ∧ x ∈ U ∧ disjoint U (g •'' U) := begin -- lemma disjoint_nbhd {g : G} {x : α} [t2_space α] : g • x ≠ x → ∃U : set α, is_open U ∧ x ∈ U ∧ disjoint U (g •'' U) := begin
intro xmoved, -- intro xmoved,
rcases t2_space.t2 (g • x) x xmoved with ⟨V,W,open_V,open_W,gx_in_V,x_in_W,disjoint_V_W⟩, -- rcases t2_space.t2 (g • x) x xmoved with ⟨V,W,open_V,open_W,gx_in_V,x_in_W,disjoint_V_W⟩,
let U := (g⁻¹ •'' V) ∩ W, -- let U := (g⁻¹ •'' V) ∩ W,
use U, -- use U,
split, -- split,
exact is_open.inter (img_open_open g⁻¹ V open_V) open_W, -- exact is_open.inter (img_open_open g⁻¹ V open_V) open_W,
split, -- split,
exact ⟨mem_inv_smul''.mpr gx_in_V,x_in_W⟩, -- exact ⟨mem_inv_smul''.mpr gx_in_V,x_in_W⟩,
exact set.disjoint_of_subset -- exact set.disjoint_of_subset
(set.inter_subset_right (g⁻¹•''V) W) -- (set.inter_subset_right (g⁻¹•''V) W)
(λ y hy, smul_inv_smul g y ▸ mem_inv_smul''.mp (set.mem_of_mem_inter_left (mem_smul''.mp hy)) : g•''U ⊆ V) -- (λ y hy, smul_inv_smul g y ▸ mem_inv_smul''.mp (set.mem_of_mem_inter_left (mem_smul''.mp hy)) : g•''U ⊆ V)
disjoint_V_W.symm -- disjoint_V_W.symm
end -- end
lemma disjoint_nbhd_in {g : G} {x : α} [t2_space α] {V : set α} : is_open V → x ∈ V → g • x ≠ x → ∃U : set α, is_open U ∧ x ∈ U ∧ U ⊆ V ∧ disjoint U (g •'' U) := begin -- lemma disjoint_nbhd_in {g : G} {x : α} [t2_space α] {V : set α} : is_open V → x ∈ V → g • x ≠ x → ∃U : set α, is_open U ∧ x ∈ U ∧ U ⊆ V ∧ disjoint U (g •'' U) := begin
intros open_V x_in_V xmoved, -- intros open_V x_in_V xmoved,
rcases disjoint_nbhd xmoved with ⟨W,open_W,x_in_W,disjoint_W⟩, -- rcases disjoint_nbhd xmoved with ⟨W,open_W,x_in_W,disjoint_W⟩,
let U := W ∩ V, -- let U := W ∩ V,
use U, -- use U,
split, -- split,
exact is_open.inter open_W open_V, -- exact is_open.inter open_W open_V,
split, -- split,
exact ⟨x_in_W,x_in_V⟩, -- exact ⟨x_in_W,x_in_V⟩,
split, -- split,
exact set.inter_subset_right W V, -- exact set.inter_subset_right W V,
exact set.disjoint_of_subset -- exact set.disjoint_of_subset
(set.inter_subset_left W V) -- (set.inter_subset_left W V)
((@smul''_inter _ _ _ _ g W V).symm ▸ set.inter_subset_left (g•''W) (g•''V) : g•''U ⊆ g•''W) -- ((@smul''_inter _ _ _ _ g W V).symm ▸ set.inter_subset_left (g•''W) (g•''V) : g•''U ⊆ g•''W)
disjoint_W -- disjoint_W
end -- end
lemma rewrite_Union (f : fin 2 × fin 2 → set α) : ((i : fin 2 × fin 2), f i) = (f (0,0) f (0,1)) (f (1,0) f (1,1)) := begin -- lemma rewrite_Union (f : fin 2 × fin 2 → set α) : ((i : fin 2 × fin 2), f i) = (f (0,0) f (0,1)) (f (1,0) f (1,1)) := begin
ext, -- ext,
simp only [set.mem_Union, set.mem_union], -- simp only [set.mem_Union, set.mem_union],
split, -- split,
{ simp only [forall_exists_index], -- { simp only [forall_exists_index],
intro i, -- intro i,
fin_cases i; simp {contextual := tt}, }, -- fin_cases i; simp {contextual := tt}, },
{ rintro ((h|h)|(h|h)); exact ⟨_, h⟩, }, -- { rintro ((h|h)|(h|h)); exact ⟨_, h⟩, },
end -- end
lemma proposition_1_1_1 (f g : G) (locally_moving : is_locally_moving G α) [t2_space α] : disjoint (support α f) (support α g) → is_algebraically_disjoint f g := begin -- lemma proposition_1_1_1 (f g : G) (locally_moving : is_locally_moving G α) [t2_space α] : disjoint (support α f) (support α g) → is_algebraically_disjoint f g := begin
intros disjoint_f_g h hfh, -- intros disjoint_f_g h hfh,
let support_f := support α f, -- let support_f := support α f,
-- h is not the identity on support α f -- -- h is not the identity on support α f
cases set.not_disjoint_iff.mp (mt (@disjoint_commute G α _ _ _ _ _) hfh) with x hx, -- cases set.not_disjoint_iff.mp (mt (@disjoint_commute G α _ _ _ _ _) hfh) with x hx,
let x_in_support_f := hx.1, -- let x_in_support_f := hx.1,
let hx_ne_x := mem_support.mp hx.2, -- let hx_ne_x := mem_support.mp hx.2,
-- so since α is Hausdoff there is V nonempty ⊆ support α f with h•''V disjoint from V -- -- so since α is Hausdoff there is V nonempty ⊆ support α f with h•''V disjoint from V
rcases disjoint_nbhd_in (support_open f) x_in_support_f hx_ne_x with ⟨V,open_V,x_in_V,V_in_support,disjoint_img_V⟩, -- rcases disjoint_nbhd_in (support_open f) x_in_support_f hx_ne_x with ⟨V,open_V,x_in_V,V_in_support,disjoint_img_V⟩,
let ristV_ne_bot := locally_moving V open_V (set.nonempty_of_mem x_in_V), -- let ristV_ne_bot := locally_moving V open_V (set.nonempty_of_mem x_in_V),
-- let f₂ be a nontrivial element of rigid_stabilizer G V -- -- let f₂ be a nontrivial element of rigid_stabilizer G V
rcases (or_iff_right ristV_ne_bot).mp (subgroup.bot_or_exists_ne_one _) with ⟨f₂,f₂_in_ristV,f₂_ne_one⟩, -- rcases (or_iff_right ristV_ne_bot).mp (subgroup.bot_or_exists_ne_one _) with ⟨f₂,f₂_in_ristV,f₂_ne_one⟩,
-- again since α is Hausdorff there is W nonempty ⊆ V with f₂•''W disjoint from W -- -- again since α is Hausdorff there is W nonempty ⊆ V with f₂•''W disjoint from W
rcases faithful_moves_point' α f₂_ne_one with ⟨y,ymoved⟩, -- rcases faithful_moves_point' α f₂_ne_one with ⟨y,ymoved⟩,
let y_in_V : y ∈ V := (rist_supported_in_set f₂_in_ristV) (mem_support.mpr ymoved), -- let y_in_V : y ∈ V := (rist_supported_in_set f₂_in_ristV) (mem_support.mpr ymoved),
rcases disjoint_nbhd_in open_V y_in_V ymoved with ⟨W,open_W,y_in_W,W_in_V,disjoint_img_W⟩, -- rcases disjoint_nbhd_in open_V y_in_V ymoved with ⟨W,open_W,y_in_W,W_in_V,disjoint_img_W⟩,
-- let f₁ be a nontrivial element of rigid_stabilizer G W -- -- let f₁ be a nontrivial element of rigid_stabilizer G W
let ristW_ne_bot := locally_moving W open_W (set.nonempty_of_mem y_in_W), -- let ristW_ne_bot := locally_moving W open_W (set.nonempty_of_mem y_in_W),
rcases (or_iff_right ristW_ne_bot).mp (subgroup.bot_or_exists_ne_one _) with ⟨f₁,f₁_in_ristW,f₁_ne_one⟩, -- rcases (or_iff_right ristW_ne_bot).mp (subgroup.bot_or_exists_ne_one _) with ⟨f₁,f₁_in_ristW,f₁_ne_one⟩,
use f₁, use f₂, -- use f₁, use f₂,
-- note that f₁,f₂ commute with g since their support is in support α f -- -- note that f₁,f₂ commute with g since their support is in support α f
split, -- split,
exact disjoint_commute (set.disjoint_of_subset_left (set.subset.trans (set.subset.trans (rist_supported_in_set f₁_in_ristW) W_in_V) V_in_support) disjoint_f_g), -- exact disjoint_commute (set.disjoint_of_subset_left (set.subset.trans (set.subset.trans (rist_supported_in_set f₁_in_ristW) W_in_V) V_in_support) disjoint_f_g),
split, -- split,
exact disjoint_commute (set.disjoint_of_subset_left (set.subset.trans (rist_supported_in_set f₂_in_ristV) V_in_support) disjoint_f_g), -- exact disjoint_commute (set.disjoint_of_subset_left (set.subset.trans (rist_supported_in_set f₂_in_ristV) V_in_support) disjoint_f_g),
-- we claim that [f₁,[f₂,h]] is a nontrivial element of centralizer G g -- -- we claim that [f₁,[f₂,h]] is a nontrivial element of centralizer G g
let k := ⁅f₂,h⁆, -- let k := ⁅f₂,h⁆,
-- first, h*f₂⁻¹*h⁻¹ is supported on h V, so k := [f₂,h] agrees with f₂ on V -- -- first, h*f₂⁻¹*h⁻¹ is supported on h V, so k := [f₂,h] agrees with f₂ on V
have h2 : ∀z ∈ W, f₂•z = k•z := λ z z_in_W, -- have h2 : ∀z ∈ W, f₂•z = k•z := λ z z_in_W,
(disjoint_support_comm f₂ h (rist_supported_in_set f₂_in_ristV) disjoint_img_V z (W_in_V z_in_W)).symm, -- (disjoint_support_comm f₂ h (rist_supported_in_set f₂_in_ristV) disjoint_img_V z (W_in_V z_in_W)).symm,
-- then k*f₁⁻¹*k⁻¹ is supported on k W = f₂ W, so [f₁,k] is supported on W f₂ W ⊆ V ⊆ support f, so commutes with g. -- -- then k*f₁⁻¹*k⁻¹ is supported on k W = f₂ W, so [f₁,k] is supported on W f₂ W ⊆ V ⊆ support f, so commutes with g.
have h3 : support α ⁅f₁,k⁆ ⊆ support α f := begin -- have h3 : support α ⁅f₁,k⁆ ⊆ support α f := begin
let := (support_comm α k f₁).trans (set.union_subset_union (rist_supported_in_set f₁_in_ristW) (smul''_subset k $ rist_supported_in_set f₁_in_ristW)), -- let := (support_comm α k f₁).trans (set.union_subset_union (rist_supported_in_set f₁_in_ristW) (smul''_subset k $ rist_supported_in_set f₁_in_ristW)),
rw [← commutator_element_inv,support_inv,(smul''_eq_of_smul_eq h2).symm] at this, -- rw [← commutator_element_inv,support_inv,(smul''_eq_of_smul_eq h2).symm] at this,
exact (this.trans $ (set.union_subset_union W_in_V (moves_subset_within_support f₂ W V W_in_V $ rist_supported_in_set f₂_in_ristV)).trans $ eq.subset V.union_self).trans V_in_support -- exact (this.trans $ (set.union_subset_union W_in_V (moves_subset_within_support f₂ W V W_in_V $ rist_supported_in_set f₂_in_ristV)).trans $ eq.subset V.union_self).trans V_in_support
end, -- end,
split, -- split,
exact disjoint_commute (set.disjoint_of_subset_left h3 disjoint_f_g), -- exact disjoint_commute (set.disjoint_of_subset_left h3 disjoint_f_g),
-- finally, [f₁,k] agrees with f₁ on W, so is not the identity. -- -- finally, [f₁,k] agrees with f₁ on W, so is not the identity.
have h4 : ∀z ∈ W, ⁅f₁,k⁆•z = f₁•z := -- have h4 : ∀z ∈ W, ⁅f₁,k⁆•z = f₁•z :=
disjoint_support_comm f₁ k (rist_supported_in_set f₁_in_ristW) (smul''_eq_of_smul_eq h2 ▸ disjoint_img_W), -- disjoint_support_comm f₁ k (rist_supported_in_set f₁_in_ristW) (smul''_eq_of_smul_eq h2 ▸ disjoint_img_W),
rcases faithful_rist_moves_point f₁_in_ristW f₁_ne_one with ⟨z,z_in_W,z_moved⟩, -- rcases faithful_rist_moves_point f₁_in_ristW f₁_ne_one with ⟨z,z_in_W,z_moved⟩,
by_contra h5, -- by_contra h5,
exact ((h4 z z_in_W).symm ▸ z_moved : ⁅f₁, k⁆ • z ≠ z) ((congr_arg (λg : G, g•z) h5).trans (one_smul G z)), -- exact ((h4 z z_in_W).symm ▸ z_moved : ⁅f₁, k⁆ • z ≠ z) ((congr_arg (λg : G, g•z) h5).trans (one_smul G z)),
end -- end
@[simp] lemma smul''_mul {g h : G} {U : set α} : g •'' (h •'' U) = (g*h) •'' U := -- @[simp] lemma smul''_mul {g h : G} {U : set α} : g •'' (h •'' U) = (g*h) •'' U :=
(mul_smul'' g h U).symm -- (mul_smul'' g h U).symm
lemma disjoint_nbhd_fin {ι : Type*} [fintype ι] {f : ι → G} {x : α} [t2_space α] : (λi : ι, f i • x).injective → ∃U : set α, is_open U ∧ x ∈ U ∧ (∀i j : ι, i ≠ j → disjoint (f i •'' U) (f j •'' U)) := begin -- lemma disjoint_nbhd_fin {ι : Type*} [fintype ι] {f : ι → G} {x : α} [t2_space α] : (λi : ι, f i • x).injective → ∃U : set α, is_open U ∧ x ∈ U ∧ (∀i j : ι, i ≠ j → disjoint (f i •'' U) (f j •'' U)) := begin
intro f_injective, -- intro f_injective,
let disjoint_hyp := λi j (i_ne_j : i≠j), let x_moved : ((f j)⁻¹ * f i) • x ≠ x := begin -- let disjoint_hyp := λi j (i_ne_j : i≠j), let x_moved : ((f j)⁻¹ * f i) • x ≠ x := begin
by_contra, -- by_contra,
let := smul_congr (f j) h, -- let := smul_congr (f j) h,
rw [mul_smul, ← mul_smul,mul_right_inv,one_smul] at this, -- rw [mul_smul, ← mul_smul,mul_right_inv,one_smul] at this,
from i_ne_j (f_injective this), -- from i_ne_j (f_injective this),
end in disjoint_nbhd x_moved, -- end in disjoint_nbhd x_moved,
let ι2 := { p : ι×ι // p.1 ≠ p.2 }, -- let ι2 := { p : ι×ι // p.1 ≠ p.2 },
let U := ⋂(p : ι2), (disjoint_hyp p.1.1 p.1.2 p.2).some, -- let U := ⋂(p : ι2), (disjoint_hyp p.1.1 p.1.2 p.2).some,
use U, -- use U,
split, -- split,
exact is_open_Inter (λp : ι2, (disjoint_hyp p.1.1 p.1.2 p.2).some_spec.1), -- exact is_open_Inter (λp : ι2, (disjoint_hyp p.1.1 p.1.2 p.2).some_spec.1),
split, -- split,
exact set.mem_Inter.mpr (λp : ι2, (disjoint_hyp p.1.1 p.1.2 p.2).some_spec.2.1), -- exact set.mem_Inter.mpr (λp : ι2, (disjoint_hyp p.1.1 p.1.2 p.2).some_spec.2.1),
intros i j i_ne_j, -- intros i j i_ne_j,
let U_inc := set.Inter_subset (λ p : ι2, (disjoint_hyp p.1.1 p.1.2 p.2).some) ⟨⟨i,j⟩,i_ne_j⟩, -- let U_inc := set.Inter_subset (λ p : ι2, (disjoint_hyp p.1.1 p.1.2 p.2).some) ⟨⟨i,j⟩,i_ne_j⟩,
let := (disjoint_smul'' (f j) (set.disjoint_of_subset U_inc (smul''_subset ((f j)⁻¹ * (f i)) U_inc) (disjoint_hyp i j i_ne_j).some_spec.2.2)).symm, -- let := (disjoint_smul'' (f j) (set.disjoint_of_subset U_inc (smul''_subset ((f j)⁻¹ * (f i)) U_inc) (disjoint_hyp i j i_ne_j).some_spec.2.2)).symm,
simp only [subtype.val_eq_coe, smul''_mul, mul_inv_cancel_left] at this, -- simp only [subtype.val_eq_coe, smul''_mul, mul_inv_cancel_left] at this,
from this -- from this
end -- end
lemma moves_inj {g : G} {x : α} {n : } (period_ge_n : ∀ (k : ), 1 ≤ k → k < n → g ^ k • x ≠ x) : function.injective (λ (i : fin n), g ^ (i : ) • x) := begin -- lemma moves_inj {g : G} {x : α} {n : } (period_ge_n : ∀ (k : ), 1 ≤ k → k < n → g ^ k • x ≠ x) : function.injective (λ (i : fin n), g ^ (i : ) • x) := begin
intros i j same_img, -- intros i j same_img,
by_contra i_ne_j, -- by_contra i_ne_j,
let same_img' := congr_arg ((•) (g ^ (-(j : )))) same_img, -- let same_img' := congr_arg ((•) (g ^ (-(j : )))) same_img,
simp only [inv_smul_smul] at same_img', -- simp only [inv_smul_smul] at same_img',
rw [← mul_smul,← mul_smul,← zpow_add,← zpow_add,add_comm] at same_img', -- rw [← mul_smul,← mul_smul,← zpow_add,← zpow_add,add_comm] at same_img',
simp only [add_left_neg, zpow_zero, one_smul] at same_img', -- simp only [add_left_neg, zpow_zero, one_smul] at same_img',
let ij := |(i:) - (j:)|, -- let ij := |(i:) - (j:)|,
rw ← sub_eq_add_neg at same_img', -- rw ← sub_eq_add_neg at same_img',
have xfixed : g^ij • x = x := begin -- have xfixed : g^ij • x = x := begin
cases abs_cases ((i:) - (j:)), -- cases abs_cases ((i:) - (j:)),
{ rw ← h.1 at same_img', exact same_img' }, -- { rw ← h.1 at same_img', exact same_img' },
{ rw [smul_eq_iff_inv_smul_eq,← zpow_neg,← h.1] at same_img', exact same_img' } -- { rw [smul_eq_iff_inv_smul_eq,← zpow_neg,← h.1] at same_img', exact same_img' }
end, -- end,
have ij_ge_1 : 1 ≤ ij := int.add_one_le_iff.mpr (abs_pos.mpr $ sub_ne_zero.mpr $ norm_num.nat_cast_ne i j ↑i ↑j rfl rfl (fin.vne_of_ne i_ne_j)), -- have ij_ge_1 : 1 ≤ ij := int.add_one_le_iff.mpr (abs_pos.mpr $ sub_ne_zero.mpr $ norm_num.nat_cast_ne i j ↑i ↑j rfl rfl (fin.vne_of_ne i_ne_j)),
let neg_le := int.sub_lt_sub_of_le_of_lt (nat.cast_nonneg i) (nat.cast_lt.mpr (fin.prop _)), -- let neg_le := int.sub_lt_sub_of_le_of_lt (nat.cast_nonneg i) (nat.cast_lt.mpr (fin.prop _)),
rw zero_sub at neg_le, -- rw zero_sub at neg_le,
let le_pos := int.sub_lt_sub_of_lt_of_le (nat.cast_lt.mpr (fin.prop _)) (nat.cast_nonneg j), -- let le_pos := int.sub_lt_sub_of_lt_of_le (nat.cast_lt.mpr (fin.prop _)) (nat.cast_nonneg j),
rw sub_zero at le_pos, -- rw sub_zero at le_pos,
have ij_lt_n : ij < n := abs_lt.mpr ⟨ neg_le, le_pos ⟩, -- have ij_lt_n : ij < n := abs_lt.mpr ⟨ neg_le, le_pos ⟩,
exact period_ge_n ij ij_ge_1 ij_lt_n xfixed, -- exact period_ge_n ij ij_ge_1 ij_lt_n xfixed,
end -- end
lemma int_to_nat (k : ) (k_pos : k ≥ 1) : k = k.nat_abs := begin -- lemma int_to_nat (k : ) (k_pos : k ≥ 1) : k = k.nat_abs := begin
cases (int.nat_abs_eq k), -- cases (int.nat_abs_eq k),
{ exact h }, -- { exact h },
{ have : -(k.nat_abs : ) ≤ 0 := neg_nonpos.mpr (int.nat_abs k).cast_nonneg, -- { have : -(k.nat_abs : ) ≤ 0 := neg_nonpos.mpr (int.nat_abs k).cast_nonneg,
rw ← h at this, by_contra, linarith } -- rw ← h at this, by_contra, linarith }
end -- end
lemma moves_inj_N {g : G} {x : α} {n : } (period_ge_n' : ∀ (k : ), 1 ≤ k → k < n → g ^ k • x ≠ x) : function.injective (λ (i : fin n), g ^ (i : ) • x) := begin -- lemma moves_inj_N {g : G} {x : α} {n : } (period_ge_n' : ∀ (k : ), 1 ≤ k → k < n → g ^ k • x ≠ x) : function.injective (λ (i : fin n), g ^ (i : ) • x) := begin
have period_ge_n : ∀ (k : ), 1 ≤ k → k < n → g ^ k • x ≠ x, -- have period_ge_n : ∀ (k : ), 1 ≤ k → k < n → g ^ k • x ≠ x,
{ intros k one_le_k k_lt_n, -- { intros k one_le_k k_lt_n,
have one_le_k_nat : 1 ≤ k.nat_abs := ((int.coe_nat_le_coe_nat_iff 1 k.nat_abs).1 ((int_to_nat k one_le_k) ▸ one_le_k)), -- have one_le_k_nat : 1 ≤ k.nat_abs := ((int.coe_nat_le_coe_nat_iff 1 k.nat_abs).1 ((int_to_nat k one_le_k) ▸ one_le_k)),
have k_nat_lt_n : k.nat_abs < n := ((int.coe_nat_lt_coe_nat_iff k.nat_abs n).1 ((int_to_nat k one_le_k) ▸ k_lt_n)), -- have k_nat_lt_n : k.nat_abs < n := ((int.coe_nat_lt_coe_nat_iff k.nat_abs n).1 ((int_to_nat k one_le_k) ▸ k_lt_n)),
have := period_ge_n' k.nat_abs one_le_k_nat k_nat_lt_n, -- have := period_ge_n' k.nat_abs one_le_k_nat k_nat_lt_n,
rw [(zpow_coe_nat g k.nat_abs).symm, (int_to_nat k one_le_k).symm] at this, -- rw [(zpow_coe_nat g k.nat_abs).symm, (int_to_nat k one_le_k).symm] at this,
exact this }, -- exact this },
have := moves_inj period_ge_n, -- have := moves_inj period_ge_n,
finish -- finish
end -- end
lemma moves_1234_of_moves_12 {g : G} {x : α} (xmoves : g^12 • x ≠ x) : function.injective (λi : fin 5, g^(i:) • x) := begin -- lemma moves_1234_of_moves_12 {g : G} {x : α} (xmoves : g^12 • x ≠ x) : function.injective (λi : fin 5, g^(i:) • x) := begin
apply moves_inj, -- apply moves_inj,
intros k k_ge_1 k_lt_5, -- intros k k_ge_1 k_lt_5,
by_contra xfixed, -- by_contra xfixed,
have k_div_12 : k * (12 / k) = 12 := begin -- have k_div_12 : k * (12 / k) = 12 := begin
interval_cases using k_ge_1 k_lt_5; norm_num -- interval_cases using k_ge_1 k_lt_5; norm_num
end, -- end,
have veryfixed : g^12 • x = x := begin -- have veryfixed : g^12 • x = x := begin
let := smul_zpow_eq_of_smul_eq (12/k) xfixed, -- let := smul_zpow_eq_of_smul_eq (12/k) xfixed,
rw [← zpow_mul,k_div_12] at this, -- rw [← zpow_mul,k_div_12] at this,
norm_cast at this -- norm_cast at this
end, -- end,
exact xmoves veryfixed -- exact xmoves veryfixed
end -- end
lemma proposition_1_1_2 (f g : G) [t2_space α] : is_locally_moving G α → is_algebraically_disjoint f g → disjoint (support α f) (support α (g^12)) := begin -- lemma proposition_1_1_2 (f g : G) [t2_space α] : is_locally_moving G α → is_algebraically_disjoint f g → disjoint (support α f) (support α (g^12)) := begin
intros locally_moving alg_disjoint, -- intros locally_moving alg_disjoint,
-- suppose to the contrary that the set U = supp(f) ∩ supp(g^12) is nonempty -- -- suppose to the contrary that the set U = supp(f) ∩ supp(g^12) is nonempty
by_contra not_disjoint, -- by_contra not_disjoint,
let U := support α f ∩ support α (g^12), -- let U := support α f ∩ support α (g^12),
have U_nonempty : U.nonempty := set.not_disjoint_iff_nonempty_inter.mp not_disjoint, -- have U_nonempty : U.nonempty := set.not_disjoint_iff_nonempty_inter.mp not_disjoint,
-- since X is Hausdorff, we can find a nonempty open set V ⊆ U such that f(V) is disjoint from V and the sets {g^i(V): i=0..4} are pairwise disjoint -- -- since X is Hausdorff, we can find a nonempty open set V ⊆ U such that f(V) is disjoint from V and the sets {g^i(V): i=0..4} are pairwise disjoint
let x := U_nonempty.some, -- let x := U_nonempty.some,
have five_points : function.injective (λi : fin 5, g^(i:) • x) := moves_1234_of_moves_12 (mem_support.mp $ (set.inter_subset_right _ _) U_nonempty.some_mem), -- have five_points : function.injective (λi : fin 5, g^(i:) • x) := moves_1234_of_moves_12 (mem_support.mp $ (set.inter_subset_right _ _) U_nonempty.some_mem),
rcases disjoint_nbhd_in (is_open.inter (support_open f) (support_open $ g^12)) U_nonempty.some_mem ((set.inter_subset_left _ _) U_nonempty.some_mem) with ⟨V₀,open_V₀,x_in_V₀,V₀_in_support,disjoint_img_V₀⟩, -- rcases disjoint_nbhd_in (is_open.inter (support_open f) (support_open $ g^12)) U_nonempty.some_mem ((set.inter_subset_left _ _) U_nonempty.some_mem) with ⟨V₀,open_V₀,x_in_V₀,V₀_in_support,disjoint_img_V₀⟩,
rcases disjoint_nbhd_fin five_points with ⟨V₁,open_V₁,x_in_V₁,disjoint_img_V₁⟩, -- rcases disjoint_nbhd_fin five_points with ⟨V₁,open_V₁,x_in_V₁,disjoint_img_V₁⟩,
simp only at disjoint_img_V₁, -- simp only at disjoint_img_V₁,
let V := V₀ ∩ V₁, -- let V := V₀ ∩ V₁,
-- let h be a nontrivial element of rigid_stabilizer G V, and note that [f,h]≠1 since f(V) is disjoint from V -- -- let h be a nontrivial element of rigid_stabilizer G V, and note that [f,h]≠1 since f(V) is disjoint from V
let ristV_ne_bot := locally_moving V (is_open.inter open_V₀ open_V₁) (set.nonempty_of_mem ⟨x_in_V₀,x_in_V₁⟩), -- let ristV_ne_bot := locally_moving V (is_open.inter open_V₀ open_V₁) (set.nonempty_of_mem ⟨x_in_V₀,x_in_V₁⟩),
rcases (or_iff_right ristV_ne_bot).mp (subgroup.bot_or_exists_ne_one _) with ⟨h,h_in_ristV,h_ne_one⟩, -- rcases (or_iff_right ristV_ne_bot).mp (subgroup.bot_or_exists_ne_one _) with ⟨h,h_in_ristV,h_ne_one⟩,
have comm_non_trivial : ¬commute f h := begin -- have comm_non_trivial : ¬commute f h := begin
by_contra comm_trivial, -- by_contra comm_trivial,
rcases faithful_rist_moves_point h_in_ristV h_ne_one with ⟨z,z_in_V,z_moved⟩, -- rcases faithful_rist_moves_point h_in_ristV h_ne_one with ⟨z,z_in_V,z_moved⟩,
let act_comm := disjoint_support_comm h f (rist_supported_in_set h_in_ristV) (set.disjoint_of_subset (set.inter_subset_left V₀ V₁) (smul''_subset f (set.inter_subset_left V₀ V₁)) disjoint_img_V₀) z z_in_V, -- let act_comm := disjoint_support_comm h f (rist_supported_in_set h_in_ristV) (set.disjoint_of_subset (set.inter_subset_left V₀ V₁) (smul''_subset f (set.inter_subset_left V₀ V₁)) disjoint_img_V₀) z z_in_V,
rw [commutator_element_eq_one_iff_commute.mpr comm_trivial.symm,one_smul] at act_comm, -- rw [commutator_element_eq_one_iff_commute.mpr comm_trivial.symm,one_smul] at act_comm,
exact z_moved act_comm.symm, -- exact z_moved act_comm.symm,
end, -- end,
-- since g is algebraically disjoint from f, there exist f₁,f₂ ∈ C_G(g) so that the commutator h' = [f1,[f2,h]] is a nontrivial element of C_G(g) -- -- since g is algebraically disjoint from f, there exist f₁,f₂ ∈ C_G(g) so that the commutator h' = [f1,[f2,h]] is a nontrivial element of C_G(g)
rcases alg_disjoint h comm_non_trivial with ⟨f₁,f₂,f₁_commutes,f₂_commutes,h'_commutes,h'_non_trivial⟩, -- rcases alg_disjoint h comm_non_trivial with ⟨f₁,f₂,f₁_commutes,f₂_commutes,h'_commutes,h'_non_trivial⟩,
let h' := ⁅f₁,⁅f₂,h⁆⁆, -- let h' := ⁅f₁,⁅f₂,h⁆⁆,
-- now observe that supp([f₂, h]) ⊆ V f₂(V), and by the same reasoning supp(h')⊆Vf₁(V)f₂(V)f₁f₂(V) -- -- now observe that supp([f₂, h]) ⊆ V f₂(V), and by the same reasoning supp(h')⊆Vf₁(V)f₂(V)f₁f₂(V)
have support_f₂h : support α ⁅f₂,h⁆ ⊆ V (f₂ •'' V) := (support_comm α f₂ h).trans (set.union_subset_union (rist_supported_in_set h_in_ristV) $ smul''_subset f₂ $ rist_supported_in_set h_in_ristV), -- have support_f₂h : support α ⁅f₂,h⁆ ⊆ V (f₂ •'' V) := (support_comm α f₂ h).trans (set.union_subset_union (rist_supported_in_set h_in_ristV) $ smul''_subset f₂ $ rist_supported_in_set h_in_ristV),
have support_h' : support α h' ⊆ (i : fin 2 × fin 2), (f₁^i.1.val*f₂^i.2.val) •'' V := begin -- have support_h' : support α h' ⊆ (i : fin 2 × fin 2), (f₁^i.1.val*f₂^i.2.val) •'' V := begin
let this := (support_comm α f₁ ⁅f₂,h⁆).trans (set.union_subset_union support_f₂h (smul''_subset f₁ support_f₂h)), -- let this := (support_comm α f₁ ⁅f₂,h⁆).trans (set.union_subset_union support_f₂h (smul''_subset f₁ support_f₂h)),
rw [smul''_union,← one_smul'' V,← mul_smul'',← mul_smul'',← mul_smul'',mul_one,mul_one] at this, -- rw [smul''_union,← one_smul'' V,← mul_smul'',← mul_smul'',← mul_smul'',mul_one,mul_one] at this,
let rw_u := rewrite_Union (λi : fin 2 × fin 2, (f₁^i.1.val*f₂^i.2.val) •'' V), -- let rw_u := rewrite_Union (λi : fin 2 × fin 2, (f₁^i.1.val*f₂^i.2.val) •'' V),
simp only [fin.val_eq_coe, fin.val_zero', pow_zero, mul_one, fin.val_one, pow_one, one_mul] at rw_u, -- simp only [fin.val_eq_coe, fin.val_zero', pow_zero, mul_one, fin.val_one, pow_one, one_mul] at rw_u,
exact rw_u.symm ▸ this, -- exact rw_u.symm ▸ this,
end, -- end,
-- since h' is nontrivial, it has at least one point p in its support -- -- since h' is nontrivial, it has at least one point p in its support
cases faithful_moves_point' α h'_non_trivial with p p_moves, -- cases faithful_moves_point' α h'_non_trivial with p p_moves,
-- since g commutes with h', all five of the points {gi(p):i=0..4} lie in supp(h') -- -- since g commutes with h', all five of the points {gi(p):i=0..4} lie in supp(h')
have gi_in_support : ∀i : fin 5, g^i.val • p ∈ support α h' := begin -- have gi_in_support : ∀i : fin 5, g^i.val • p ∈ support α h' := begin
intro i, -- intro i,
rw mem_support, -- rw mem_support,
by_contra p_fixed, -- by_contra p_fixed,
rw [← mul_smul,(h'_commutes.pow_right i.val).eq,mul_smul,smul_left_cancel_iff] at p_fixed, -- rw [← mul_smul,(h'_commutes.pow_right i.val).eq,mul_smul,smul_left_cancel_iff] at p_fixed,
exact p_moves p_fixed, -- exact p_moves p_fixed,
end, -- end,
-- by the pigeonhole principle, one of the four sets V, f₁(V), f₂(V), f₁f₂(V) must contain two of these points, say g^i(p),g^j(p) ∈ k(V) for some 0 ≤ i < j ≤ 4 and k ∈ {1,f₁,f₂,f₁f₂} -- -- by the pigeonhole principle, one of the four sets V, f₁(V), f₂(V), f₁f₂(V) must contain two of these points, say g^i(p),g^j(p) ∈ k(V) for some 0 ≤ i < j ≤ 4 and k ∈ {1,f₁,f₂,f₁f₂}
let pigeonhole : fintype.card (fin 5) > fintype.card (fin 2 × fin 2) := dec_trivial, -- let pigeonhole : fintype.card (fin 5) > fintype.card (fin 2 × fin 2) := dec_trivial,
let choice := λi : fin 5, (set.mem_Union.mp $ support_h' $ gi_in_support i).some, -- let choice := λi : fin 5, (set.mem_Union.mp $ support_h' $ gi_in_support i).some,
rcases finset.exists_ne_map_eq_of_card_lt_of_maps_to pigeonhole (λ(i : fin 5) _, finset.mem_univ (choice i)) with ⟨i,_,j,_,i_ne_j,same_choice⟩, -- rcases finset.exists_ne_map_eq_of_card_lt_of_maps_to pigeonhole (λ(i : fin 5) _, finset.mem_univ (choice i)) with ⟨i,_,j,_,i_ne_j,same_choice⟩,
clear h_1_w h_1_h_h_w pigeonhole, -- clear h_1_w h_1_h_h_w pigeonhole,
let k := f₁^(choice i).1.val*f₂^(choice i).2.val, -- let k := f₁^(choice i).1.val*f₂^(choice i).2.val,
have same_k : f₁^(choice j).1.val*f₂^(choice j).2.val = k := by { simp only at same_choice, -- have same_k : f₁^(choice j).1.val*f₂^(choice j).2.val = k := by { simp only at same_choice,
rw ← same_choice }, -- rw ← same_choice },
have g_i : g^i.val • p ∈ k •'' V := (set.mem_Union.mp $ support_h' $ gi_in_support i).some_spec, -- have g_i : g^i.val • p ∈ k •'' V := (set.mem_Union.mp $ support_h' $ gi_in_support i).some_spec,
have g_j : g^j.val • p ∈ k •'' V := same_k ▸ (set.mem_Union.mp $ support_h' $ gi_in_support j).some_spec, -- have g_j : g^j.val • p ∈ k •'' V := same_k ▸ (set.mem_Union.mp $ support_h' $ gi_in_support j).some_spec,
-- but since g^(ji)(V) is disjoint from V and k commutes with g, we know that g^(ji)k(V) is disjoint from k(V), a contradiction since g^i(p) and g^j(p) both lie in k(V). -- -- but since g^(ji)(V) is disjoint from V and k commutes with g, we know that g^(ji)k(V) is disjoint from k(V), a contradiction since g^i(p) and g^j(p) both lie in k(V).
have g_disjoint : disjoint ((g^i.val)⁻¹ •'' V) ((g^j.val)⁻¹ •'' V) := begin -- have g_disjoint : disjoint ((g^i.val)⁻¹ •'' V) ((g^j.val)⁻¹ •'' V) := begin
let := (disjoint_smul'' (g^(-(i.val+j.val : ))) (disjoint_img_V₁ i j i_ne_j)).symm, -- let := (disjoint_smul'' (g^(-(i.val+j.val : ))) (disjoint_img_V₁ i j i_ne_j)).symm,
rw [← mul_smul'',← mul_smul'',← zpow_add,← zpow_add] at this, -- rw [← mul_smul'',← mul_smul'',← zpow_add,← zpow_add] at this,
simp only [fin.val_eq_coe, neg_add_rev, coe_coe, neg_add_cancel_right, zpow_neg, zpow_coe_nat, neg_add_cancel_comm] at this, -- simp only [fin.val_eq_coe, neg_add_rev, coe_coe, neg_add_cancel_right, zpow_neg, zpow_coe_nat, neg_add_cancel_comm] at this,
from set.disjoint_of_subset (smul''_subset _ (set.inter_subset_right V₀ V₁)) (smul''_subset _ (set.inter_subset_right V₀ V₁)) this -- from set.disjoint_of_subset (smul''_subset _ (set.inter_subset_right V₀ V₁)) (smul''_subset _ (set.inter_subset_right V₀ V₁)) this
end, -- end,
have k_commutes : commute k g := commute.mul_left (f₁_commutes.pow_left (choice i).1.val) (f₂_commutes.pow_left (choice i).2.val), -- have k_commutes : commute k g := commute.mul_left (f₁_commutes.pow_left (choice i).1.val) (f₂_commutes.pow_left (choice i).2.val),
have g_k_disjoint : disjoint ((g^i.val)⁻¹ •'' (k •'' V)) ((g^j.val)⁻¹ •'' (k •'' V)) := begin -- have g_k_disjoint : disjoint ((g^i.val)⁻¹ •'' (k •'' V)) ((g^j.val)⁻¹ •'' (k •'' V)) := begin
let this := disjoint_smul'' k g_disjoint, -- let this := disjoint_smul'' k g_disjoint,
rw [← mul_smul'',← mul_smul'',← inv_pow g i.val,← inv_pow g j.val, -- rw [← mul_smul'',← mul_smul'',← inv_pow g i.val,← inv_pow g j.val,
← (k_commutes.symm.inv_left.pow_left i.val).eq, -- ← (k_commutes.symm.inv_left.pow_left i.val).eq,
← (k_commutes.symm.inv_left.pow_left j.val).eq, -- ← (k_commutes.symm.inv_left.pow_left j.val).eq,
mul_smul'',inv_pow g i.val,mul_smul'' (g⁻¹^j.val) k V,inv_pow g j.val] at this, -- mul_smul'',inv_pow g i.val,mul_smul'' (g⁻¹^j.val) k V,inv_pow g j.val] at this,
from this -- from this
end, -- end,
exact set.disjoint_left.mp g_k_disjoint (mem_inv_smul''.mpr g_i) (mem_inv_smul''.mpr g_j) -- exact set.disjoint_left.mp g_k_disjoint (mem_inv_smul''.mpr g_i) (mem_inv_smul''.mpr g_j)
end -- end
lemma remark_1_2 (f g : G) : is_algebraically_disjoint f g → commute f g := begin -- lemma remark_1_2 (f g : G) : is_algebraically_disjoint f g → commute f g := begin
intro alg_disjoint, -- intro alg_disjoint,
by_contra non_commute, -- by_contra non_commute,
rcases alg_disjoint g non_commute with ⟨_,_,_,b,_,d⟩, -- rcases alg_disjoint g non_commute with ⟨_,_,_,b,_,d⟩,
rw [commutator_element_eq_one_iff_commute.mpr b,commutator_element_one_right] at d, -- rw [commutator_element_eq_one_iff_commute.mpr b,commutator_element_one_right] at d,
tauto -- tauto
end -- end
section remark_1_3 -- section remark_1_3
def G := equiv.perm (fin 2) -- def G := equiv.perm (fin 2)
def σ := equiv.swap (0 : fin 2) (1 : fin 2) -- def σ := equiv.swap (0 : fin 2) (1 : fin 2)
-- example : is_algebraically_disjoint σ σ := begin -- example : is_algebraically_disjoint σ σ := begin
-- intro h, -- intro h,
-- fin_cases h, -- fin_cases h,
-- intro hyp1, -- intro hyp1,
-- exfalso, -- exfalso,
-- swap, intro hyp2, exfalso, -- swap, intro hyp2, exfalso,
-- -- is commute decidable? cc, -- -- is commute decidable? cc,
-- sorry -- dec_trivial -- sorry -- dec_trivial
-- sorry -- second sorry needed
-- end -- end
end remark_1_3 -- end remark_1_3
end algebraic_disjointness end algebraic_disjointness
@ -940,114 +941,117 @@ lemma support_in_regular_support [t2_space α] (g : G) : support α g ⊆ regula
lemma mem_regular_support (g : G) (U : set α) : U.is_regular_open → g ∈ rigid_stabilizer G U → regular_support α g ⊆ U := lemma mem_regular_support (g : G) (U : set α) : U.is_regular_open → g ∈ rigid_stabilizer G U → regular_support α g ⊆ U :=
λ U_ro g_moves, (set.is_regular_def _).mp U_ro ▸ (interior_closure_mono (rist_supported_in_set g_moves)) λ U_ro g_moves, (set.is_regular_def _).mp U_ro ▸ (interior_closure_mono (rist_supported_in_set g_moves))
-- FIXME: Weird naming?
def algebraic_centralizer (f : G) : set G := { h | ∃g, h = g^12 ∧ is_algebraically_disjoint f g } def algebraic_centralizer (f : G) : set G := { h | ∃g, h = g^12 ∧ is_algebraically_disjoint f g }
end regular_support end regular_support
---------------------------------------------------------------- -- ----------------------------------------------------------------
section finite_exponent -- section finite_exponent
lemma coe_nat_fin {n i : } (h : i < n) : ∃ (i' : fin n), i = i' := ⟨ ⟨ i, h ⟩, rfl ⟩ -- lemma coe_nat_fin {n i : } (h : i < n) : ∃ (i' : fin n), i = i' := ⟨ ⟨ i, h ⟩, rfl ⟩
variables [topological_space α] [continuous_mul_action G α] [has_faithful_smul G α] -- variables [topological_space α] [continuous_mul_action G α] [has_faithful_smul G α]
lemma distinct_images_from_disjoint {g : G} {V : set α} {n : } -- lemma distinct_images_from_disjoint {g : G} {V : set α} {n : }
(n_pos : 0 < n) -- (n_pos : 0 < n)
(h_disj : ∀ (i j : fin n) (i_ne_j : i ≠ j), disjoint (g ^ (i : ) •'' V) (g ^ (j : ) •'' V)) : -- (h_disj : ∀ (i j : fin n) (i_ne_j : i ≠ j), disjoint (g ^ (i : ) •'' V) (g ^ (j : ) •'' V)) :
∀ (q : α) (hq : q ∈ V) (i : fin n), (i : ) > 0 → g ^ (i : ) • (q : α) ∉ V := -- ∀ (q : α) (hq : q ∈ V) (i : fin n), (i : ) > 0 → g ^ (i : ) • (q : α) ∉ V :=
begin -- begin
intros q hq i i_pos hcontra, -- intros q hq i i_pos hcontra,
have i_ne_zero : i ≠ (⟨ 0, n_pos ⟩ : fin n), { intro, finish }, -- have i_ne_zero : i ≠ (⟨ 0, n_pos ⟩ : fin n), { intro, finish },
have hcontra' : g ^ (i : ) • (q : α) ∈ g ^ (i : ) •'' V, exact ⟨ q, hq, rfl ⟩, -- have hcontra' : g ^ (i : ) • (q : α) ∈ g ^ (i : ) •'' V, exact ⟨ q, hq, rfl ⟩,
have giq_notin_V := set.disjoint_left.mp (h_disj i (⟨ 0, n_pos ⟩ : fin n) i_ne_zero) hcontra', -- have giq_notin_V := set.disjoint_left.mp (h_disj i (⟨ 0, n_pos ⟩ : fin n) i_ne_zero) hcontra',
exact ((by finish : g ^ 0•''V = V) ▸ giq_notin_V) hcontra -- exact ((by finish : g ^ 0•''V = V) ▸ giq_notin_V) hcontra
end -- end
lemma moves_inj_period {g : G} {p : α} {n : } (period_eq_n : period p g = n) : function.injective (λ (i : fin n), g ^ (i : ) • p) := begin -- lemma moves_inj_period {g : G} {p : α} {n : } (period_eq_n : period p g = n) : function.injective (λ (i : fin n), g ^ (i : ) • p) := begin
have period_ge_n : ∀ (k : ), 1 ≤ k → k < n → g ^ k • p ≠ p, -- have period_ge_n : ∀ (k : ), 1 ≤ k → k < n → g ^ k • p ≠ p,
{ intros k one_le_k k_lt_n gkp_eq_p, -- { intros k one_le_k k_lt_n gkp_eq_p,
have := period_le_fix (nat.succ_le_iff.mp one_le_k) gkp_eq_p, -- have := period_le_fix (nat.succ_le_iff.mp one_le_k) gkp_eq_p,
rw period_eq_n at this, -- rw period_eq_n at this,
linarith }, -- linarith },
exact moves_inj_N period_ge_n -- exact moves_inj_N period_ge_n
end -- end
lemma lemma_2_2 {α : Type u_2} [topological_space α] [continuous_mul_action G α] [has_faithful_smul G α] [t2_space α] -- lemma lemma_2_2 {α : Type u_2} [topological_space α] [continuous_mul_action G α] [has_faithful_smul G α] [t2_space α]
(U : set α) (U_open : is_open U) (locally_moving : is_locally_moving G α) : -- (U : set α) (U_open : is_open U) (locally_moving : is_locally_moving G α) :
U.nonempty → monoid.exponent (rigid_stabilizer G U) = 0 := -- U.nonempty → monoid.exponent (rigid_stabilizer G U) = 0 :=
begin -- begin
intro U_nonempty, -- intro U_nonempty,
by_contra exp_ne_zero, -- by_contra exp_ne_zero,
rcases (period_from_exponent U U_nonempty exp_ne_zero) with ⟨ p, g, n, n_pos, hpgn, n_eq_Sup ⟩, -- rcases (period_from_exponent U U_nonempty exp_ne_zero) with ⟨ p, g, n, n_pos, hpgn, n_eq_Sup ⟩,
rcases disjoint_nbhd_fin (moves_inj_period hpgn) with ⟨ V', V'_open, p_in_V', disj' ⟩, -- rcases disjoint_nbhd_fin (moves_inj_period hpgn) with ⟨ V', V'_open, p_in_V', disj' ⟩,
dsimp at disj', -- dsimp at disj',
let V := U ∩ V', -- let V := U ∩ V',
have V_ss_U : V ⊆ U := set.inter_subset_left U V', -- have V_ss_U : V ⊆ U := set.inter_subset_left U V',
have V'_ss_V : V ⊆ V' := set.inter_subset_right U V', -- have V'_ss_V : V ⊆ V' := set.inter_subset_right U V',
have V_open : is_open V := is_open.inter U_open V'_open, -- have V_open : is_open V := is_open.inter U_open V'_open,
have p_in_V : (p : α) ∈ V := ⟨ subtype.mem p, p_in_V' ⟩, -- have p_in_V : (p : α) ∈ V := ⟨ subtype.mem p, p_in_V' ⟩,
have disj : ∀ (i j : fin n), ¬ i = j → disjoint (↑g ^ ↑i•''V) (↑g ^ ↑j•''V), -- have disj : ∀ (i j : fin n), ¬ i = j → disjoint (↑g ^ ↑i•''V) (↑g ^ ↑j•''V),
{ intros i j i_ne_j W W_ss_giV W_ss_gjV, -- { intros i j i_ne_j W W_ss_giV W_ss_gjV,
exact disj' i j i_ne_j -- exact disj' i j i_ne_j
(set.subset.trans W_ss_giV (smul''_subset (↑g ^ ↑i) V'_ss_V)) -- (set.subset.trans W_ss_giV (smul''_subset (↑g ^ ↑i) V'_ss_V))
(set.subset.trans W_ss_gjV (smul''_subset (↑g ^ ↑j) V'_ss_V)) }, -- (set.subset.trans W_ss_gjV (smul''_subset (↑g ^ ↑j) V'_ss_V)) },
have ristV_ne_bot := locally_moving V V_open (set.nonempty_of_mem p_in_V), -- have ristV_ne_bot := locally_moving V V_open (set.nonempty_of_mem p_in_V),
rcases (or_iff_right ristV_ne_bot).mp (subgroup.bot_or_exists_ne_one _) with ⟨h,h_in_ristV,h_ne_one⟩, -- rcases (or_iff_right ristV_ne_bot).mp (subgroup.bot_or_exists_ne_one _) with ⟨h,h_in_ristV,h_ne_one⟩,
rcases faithful_rist_moves_point h_in_ristV h_ne_one with ⟨ q, q_in_V, hq_ne_q ⟩, -- rcases faithful_rist_moves_point h_in_ristV h_ne_one with ⟨ q, q_in_V, hq_ne_q ⟩,
have hg_in_ristU : (h : G) * (g : G) ∈ rigid_stabilizer G U := (rigid_stabilizer G U).mul_mem' (rist_ss_rist V_ss_U h_in_ristV) (subtype.mem g), -- have hg_in_ristU : (h : G) * (g : G) ∈ rigid_stabilizer G U := (rigid_stabilizer G U).mul_mem' (rist_ss_rist V_ss_U h_in_ristV) (subtype.mem g),
have giq_notin_V : ∀ (i : fin n), (i : ) > 0 → g ^ (i : ) • (q : α) ∉ V := distinct_images_from_disjoint n_pos disj q q_in_V, -- have giq_notin_V : ∀ (i : fin n), (i : ) > 0 → g ^ (i : ) • (q : α) ∉ V := distinct_images_from_disjoint n_pos disj q q_in_V,
have giq_ne_q : ∀ (i : fin n), (i : ) > 0 → g ^ (i : ) • (q : α) ≠ (q : α), -- have giq_ne_q : ∀ (i : fin n), (i : ) > 0 → g ^ (i : ) • (q : α) ≠ (q : α),
{ intros i i_pos giq_eq_q, exact (giq_eq_q ▸ (giq_notin_V i i_pos)) q_in_V, }, -- { intros i i_pos giq_eq_q, exact (giq_eq_q ▸ (giq_notin_V i i_pos)) q_in_V, },
have q_in_U : q ∈ U, { have : q ∈ U ∩ V' := q_in_V, exact this.1 }, -- have q_in_U : q ∈ U, { have : q ∈ U ∩ V' := q_in_V, exact this.1 },
-- We have (hg)^i q = g^i q for all 0 < i < n -- -- We have (hg)^i q = g^i q for all 0 < i < n
have pow_hgq_eq_pow_gq : ∀ (i : fin n), (i : ) < n → (h * g) ^ (i : ) • q = (g : G) ^ (i : ) • q, -- have pow_hgq_eq_pow_gq : ∀ (i : fin n), (i : ) < n → (h * g) ^ (i : ) • q = (g : G) ^ (i : ) • q,
{ intros i, induction (i : ) with i', -- { intros i, induction (i : ) with i',
{ intro, repeat {rw pow_zero} }, -- { intro, repeat {rw pow_zero} },
{ intro succ_i'_lt_n, -- { intro succ_i'_lt_n,
rw [smul_succ, ih (nat.lt_of_succ_lt succ_i'_lt_n), smul_smul, mul_assoc, ← smul_smul, ← smul_smul, ← smul_succ], -- rw [smul_succ, ih (nat.lt_of_succ_lt succ_i'_lt_n), smul_smul, mul_assoc, ← smul_smul, ← smul_smul, ← smul_succ],
have image_q_notin_V : g ^ i'.succ • q ∉ V, -- have image_q_notin_V : g ^ i'.succ • q ∉ V,
{ have i'succ_ne_zero := ne_zero.pos i'.succ, -- { have i'succ_ne_zero := ne_zero.pos i'.succ,
exact giq_notin_V (⟨ i'.succ, succ_i'_lt_n ⟩ : fin n) i'succ_ne_zero }, -- exact giq_notin_V (⟨ i'.succ, succ_i'_lt_n ⟩ : fin n) i'succ_ne_zero },
exact by_contradiction (λ c, c (by_contradiction (λ c', image_q_notin_V ((rist_supported_in_set h_in_ristV) c')))) } }, -- exact by_contradiction (λ c, c (by_contradiction (λ c', image_q_notin_V ((rist_supported_in_set h_in_ristV) c')))) } },
-- Combined with g^i q ≠ q, this yields (hg)^i q ≠ q for all 0 < i < n -- -- Combined with g^i q ≠ q, this yields (hg)^i q ≠ q for all 0 < i < n
have hgiq_ne_q : ∀ (i : fin n), (i : ) > 0 → (h * g) ^ (i : ) • q ≠ q, -- have hgiq_ne_q : ∀ (i : fin n), (i : ) > 0 → (h * g) ^ (i : ) • q ≠ q,
{ intros i i_pos, rw pow_hgq_eq_pow_gq i (fin.is_lt i), by_contra c, exact (giq_notin_V i i_pos) (c.symm ▸ q_in_V) }, -- { intros i i_pos, rw pow_hgq_eq_pow_gq i (fin.is_lt i), by_contra c, exact (giq_notin_V i i_pos) (c.symm ▸ q_in_V) },
-- This even holds for i = n -- -- This even holds for i = n
have hgnq_ne_q : (h * g) ^ n • q ≠ q, -- have hgnq_ne_q : (h * g) ^ n • q ≠ q,
{ -- Rewrite (hg)^n q = hg^n q -- { -- Rewrite (hg)^n q = hg^n q
have npred_lt_n : n.pred < n, exact (nat.succ_pred_eq_of_pos n_pos) ▸ (lt_add_one n.pred), -- have npred_lt_n : n.pred < n, exact (nat.succ_pred_eq_of_pos n_pos) ▸ (lt_add_one n.pred),
rcases coe_nat_fin npred_lt_n with ⟨ i', i'_eq_pred_n ⟩, -- rcases coe_nat_fin npred_lt_n with ⟨ i', i'_eq_pred_n ⟩,
have hgi'q_eq_gi'q := pow_hgq_eq_pow_gq i' (i'_eq_pred_n ▸ npred_lt_n), -- have hgi'q_eq_gi'q := pow_hgq_eq_pow_gq i' (i'_eq_pred_n ▸ npred_lt_n),
have : n = (i' : ).succ := i'_eq_pred_n ▸ (nat.succ_pred_eq_of_pos n_pos).symm, -- have : n = (i' : ).succ := i'_eq_pred_n ▸ (nat.succ_pred_eq_of_pos n_pos).symm,
rw [this, smul_succ, hgi'q_eq_gi'q, ← smul_smul, ← smul_succ, ← this], -- rw [this, smul_succ, hgi'q_eq_gi'q, ← smul_smul, ← smul_succ, ← this],
-- Now it follows from g^n q = q and h q ≠ q -- -- Now it follows from g^n q = q and h q ≠ q
have n_le_period_qg := notfix_le_period' n_pos ((zero_lt_period_le_Sup_periods U_nonempty exp_ne_zero (⟨ q, q_in_U ⟩ : U) g)).1 giq_ne_q, -- have n_le_period_qg := notfix_le_period' n_pos ((zero_lt_period_le_Sup_periods U_nonempty exp_ne_zero (⟨ q, q_in_U ⟩ : U) g)).1 giq_ne_q,
have period_qg_le_n := (zero_lt_period_le_Sup_periods U_nonempty exp_ne_zero (⟨ q, q_in_U ⟩ : U) g).2, rw ← n_eq_Sup at period_qg_le_n, -- have period_qg_le_n := (zero_lt_period_le_Sup_periods U_nonempty exp_ne_zero (⟨ q, q_in_U ⟩ : U) g).2, rw ← n_eq_Sup at period_qg_le_n,
exact (ge_antisymm period_qg_le_n n_le_period_qg).symm ▸ ((pow_period_fix q (g : G)).symm ▸ hq_ne_q) }, -- exact (ge_antisymm period_qg_le_n n_le_period_qg).symm ▸ ((pow_period_fix q (g : G)).symm ▸ hq_ne_q) },
-- Finally, we derive a contradiction -- -- Finally, we derive a contradiction
have period_pos_le_n := zero_lt_period_le_Sup_periods U_nonempty exp_ne_zero (⟨ q, q_in_U ⟩ : U) (⟨ h * g, hg_in_ristU ⟩ : rigid_stabilizer G U), -- have period_pos_le_n := zero_lt_period_le_Sup_periods U_nonempty exp_ne_zero (⟨ q, q_in_U ⟩ : U) (⟨ h * g, hg_in_ristU ⟩ : rigid_stabilizer G U),
rw ← n_eq_Sup at period_pos_le_n, -- rw ← n_eq_Sup at period_pos_le_n,
cases (lt_or_eq_of_le period_pos_le_n.2), -- cases (lt_or_eq_of_le period_pos_le_n.2),
{ exact (hgiq_ne_q (⟨ (period (q : α) ((h : G) * (g : G))), h_1 ⟩ : fin n) period_pos_le_n.1) (pow_period_fix (q : α) ((h : G) * (g : G))) }, -- { exact (hgiq_ne_q (⟨ (period (q : α) ((h : G) * (g : G))), h_1 ⟩ : fin n) period_pos_le_n.1) (pow_period_fix (q : α) ((h : G) * (g : G))) },
{ exact hgnq_ne_q (h_1 ▸ (pow_period_fix (q : α) ((h : G) * (g : G)))) } -- { exact hgnq_ne_q (h_1 ▸ (pow_period_fix (q : α) ((h : G) * (g : G)))) }
end -- end
lemma proposition_2_1 [t2_space α] (f : G) : is_locally_moving G α → (algebraic_centralizer f).centralizer = rigid_stabilizer G (regular_support α f) := sorry -- lemma proposition_2_1 [t2_space α] (f : G) : is_locally_moving G α → (algebraic_centralizer f).centralizer = rigid_stabilizer G (regular_support α f) := sorry
end finite_exponent -- end finite_exponent
variables [topological_space α] [topological_space β] [continuous_mul_action G α] [continuous_mul_action G β] -- variables [topological_space α] [topological_space β] [continuous_mul_action G α] [continuous_mul_action G β]
noncomputable theorem rubin (hα : rubin_action G α) (hβ : rubin_action G β) : equivariant_homeomorph G α β := sorry -- noncomputable theorem rubin (hα : rubin_action G α) (hβ : rubin_action G β) : equivariant_homeomorph G α β := sorry
end rubin end rubin
end Rubin

Loading…
Cancel
Save