diff options
| author | Enrico Tassi | 2018-04-17 16:57:13 +0200 |
|---|---|---|
| committer | Enrico Tassi | 2018-04-17 16:57:13 +0200 |
| commit | eaa90cf9520e43d0b05fc6431a479e6b9559ef0e (patch) | |
| tree | 8499953a468a8d8be510dd0d60232cbd8984c1ec /mathcomp | |
| parent | c1ec9cd8e7e50f73159613c492aad4c6c40bc3aa (diff) | |
move odd_order to its own repository
Diffstat (limited to 'mathcomp')
43 files changed, 0 insertions, 40743 deletions
diff --git a/mathcomp/Make b/mathcomp/Make index 1db29ba..cf52650 100644 --- a/mathcomp/Make +++ b/mathcomp/Make @@ -46,40 +46,6 @@ fingroup/morphism.v fingroup/perm.v fingroup/presentation.v fingroup/quotient.v -odd_order/BGappendixAB.v -odd_order/BGappendixC.v -odd_order/BGsection10.v -odd_order/BGsection11.v -odd_order/BGsection12.v -odd_order/BGsection13.v -odd_order/BGsection14.v -odd_order/BGsection15.v -odd_order/BGsection16.v -odd_order/BGsection1.v -odd_order/BGsection2.v -odd_order/BGsection3.v -odd_order/BGsection4.v -odd_order/BGsection5.v -odd_order/BGsection6.v -odd_order/BGsection7.v -odd_order/BGsection8.v -odd_order/BGsection9.v -odd_order/PFsection10.v -odd_order/PFsection11.v -odd_order/PFsection12.v -odd_order/PFsection13.v -odd_order/PFsection14.v -odd_order/PFsection1.v -odd_order/PFsection2.v -odd_order/PFsection3.v -odd_order/PFsection4.v -odd_order/PFsection5.v -odd_order/PFsection6.v -odd_order/PFsection7.v -odd_order/PFsection8.v -odd_order/PFsection9.v -odd_order/stripped_odd_order_theorem.v -odd_order/wielandt_fixpoint.v real_closed/all_real_closed.v real_closed/bigenough.v real_closed/cauchyreals.v diff --git a/mathcomp/odd_order/AUTHORS b/mathcomp/odd_order/AUTHORS deleted file mode 120000 index b55a98d..0000000 --- a/mathcomp/odd_order/AUTHORS +++ /dev/null @@ -1 +0,0 @@ -../../etc/AUTHORS
\ No newline at end of file diff --git a/mathcomp/odd_order/BGappendixAB.v b/mathcomp/odd_order/BGappendixAB.v deleted file mode 100644 index eb708a6..0000000 --- a/mathcomp/odd_order/BGappendixAB.v +++ /dev/null @@ -1,516 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq div. -From mathcomp -Require Import fintype bigop prime finset ssralg fingroup morphism. -From mathcomp -Require Import automorphism quotient gfunctor commutator zmodp center pgroup. -From mathcomp -Require Import sylow gseries nilpotent abelian maximal. -From mathcomp -Require Import matrix mxalgebra mxrepresentation mxabelem. -From mathcomp -Require Import BGsection1 BGsection2. - -(******************************************************************************) -(* This file contains the useful material in B & G, appendices A and B, i.e., *) -(* the proof of the p-stability properties and the ZL-Theorem (the Puig *) -(* replacement for the Glaubermann ZJ-theorem). The relevant definitions are *) -(* given in BGsection1. *) -(* Theorem A.4(a) has not been formalised: it is a result on external *) -(* p-stability, which concerns faithful representations of group with a *) -(* trivial p-core on a field of characteristic p. It's the historical concept *) -(* that was studied by Hall and Higman, but it's not used for FT. Note that *) -(* the finite field case can be recovered from A.4(c) with a semi-direct *) -(* product. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Local Open Scope ring_scope. -Import GroupScope GRing.Theory. - -Section AppendixA. - -Implicit Type gT : finGroupType. -Implicit Type p : nat. - -Import MatrixGenField. - -(* This is B & G, Theorem A.4(c) (in Appendix A, not section 16!). We follow *) -(* both B & G and Gorenstein in using the general form of the p-stable *) -(* property. We could simplify the property because the conditions under *) -(* which we prove p-stability are inherited by sections (morphic image in our *) -(* framework), and restrict to the case where P is normal in G. (Clearly the *) -(* 'O_p^'(G) * P <| G premise plays no part in the proof.) *) -(* Theorems A.1-A.3 are essentially inlined in this proof. *) - -Theorem odd_p_stable gT p (G : {group gT}) : odd #|G| -> p.-stable G. -Proof. -move: gT G. -pose p_xp gT (E : {group gT}) x := p.-elt x && (x \in 'C([~: E, [set x]])). -suffices IH gT (E : {group gT}) x y (G := <<[set x; y]>>) : - [&& odd #|G|, p.-group E & G \subset 'N(E)] -> p_xp gT E x && p_xp gT E y -> - p.-group (G / 'C(E)). -- move=> gT G oddG P A pP /andP[/mulGsubP[_ sPG] _] /andP[sANG pA] cRA. - apply/subsetP=> _ /morphimP[x Nx Ax ->]; have NGx := subsetP sANG x Ax. - apply: Baer_Suzuki => [|_ /morphimP[y Ny NGy ->]]; first exact: mem_quotient. - rewrite -morphJ // -!morphim_set1 -?[<<_>>]morphimY ?sub1set ?groupJ //. - set G1 := _ <*> _; rewrite /pgroup -(card_isog (second_isog _)); last first. - by rewrite join_subG !sub1set Nx groupJ. - have{Nx NGx Ny NGy} [[Gx Nx] [Gy Ny]] := (setIP NGx, setIP NGy). - have sG1G: G1 \subset G by rewrite join_subG !sub1set groupJ ?andbT. - have nPG1: G1 \subset 'N(P) by rewrite join_subG !sub1set groupJ ?andbT. - rewrite -setIA setICA (setIidPr sG1G). - rewrite (card_isog (second_isog _)) ?norms_cent //. - apply: IH => //; first by rewrite pP nPG1 (oddSg sG1G). - rewrite /p_xp -{2}(normP Ny) -conjg_set1 -conjsRg centJ memJ_conjg. - rewrite p_eltJ andbb (mem_p_elt pA) // -sub1set centsC (sameP commG1P trivgP). - by rewrite -cRA !commgSS ?sub1set. -move: {2}_.+1 (ltnSn #|E|) => n; elim: n => // n IHn in gT E x y G *. -rewrite ltnS => leEn /and3P[oddG pE nEG] /and3P[/andP[p_x cRx] p_y cRy]. -have [Gx Gy]: x \in G /\ y \in G by apply/andP; rewrite -!sub1set -join_subG. -apply: wlog_neg => p'Gc; apply/pgroupP=> q q_pr qGc; apply/idPn => p'q. -have [Q sylQ] := Sylow_exists q [group of G]. -have [sQG qQ]: Q \subset G /\ q.-group Q by case/and3P: sylQ. -have{qQ p'q} p'Q: p^'.-group Q by apply: sub_in_pnat qQ => q' _ /eqnP->. -have{q q_pr sylQ qGc} ncEQ: ~~ (Q \subset 'C(E)). - apply: contraL qGc => cEQ; rewrite -p'natE // -partn_eq1 //. - have nCQ: Q \subset 'N('C(E)) by apply: subset_trans (normG _). - have sylQc: q.-Sylow(G / 'C(E)) (Q / 'C(E)) by rewrite morphim_pSylow. - by rewrite -(card_Hall sylQc) -trivg_card1 (sameP eqP trivgP) quotient_sub1. -have solE: solvable E := pgroup_sol pE. -have ntE: E :!=: 1 by apply: contra ncEQ; move/eqP->; rewrite cents1. -have{Q ncEQ p'Q sQG} minE_EG: minnormal E (E <*> G). - apply/mingroupP; split=> [|D]; rewrite join_subG ?ntE ?normG //. - case/and3P=> ntD nDE nDG sDE; have nDGi := subsetP nDG. - apply/eqP; rewrite eqEcard sDE leqNgt; apply: contra ncEQ => ltDE. - have nDQ: Q \subset 'N(D) by rewrite (subset_trans sQG). - have cDQ: Q \subset 'C(D). - rewrite -quotient_sub1 ?norms_cent // ?[_ / _]card1_trivg //. - apply: pnat_1 (morphim_pgroup _ p'Q); apply: pgroupS (quotientS _ sQG) _. - apply: IHn (leq_trans ltDE leEn) _ _; first by rewrite oddG (pgroupS sDE). - rewrite /p_xp p_x p_y /=; apply/andP. - by split; [move: cRx | move: cRy]; apply: subsetP; rewrite centS ?commSg. - apply: (stable_factor_cent cDQ) solE; rewrite ?(pnat_coprime pE) //. - apply/and3P; split; rewrite // -quotient_cents2 // centsC. - rewrite -quotient_sub1 ?norms_cent ?quotient_norms ?(subset_trans sQG) //=. - rewrite [(_ / _) / _]card1_trivg //=. - apply: pnat_1 (morphim_pgroup _ (morphim_pgroup _ p'Q)). - apply: pgroupS (quotientS _ (quotientS _ sQG)) _. - have defGq: G / D = <<[set coset D x; coset D y]>>. - by rewrite quotient_gen -1?gen_subG ?quotientU ?quotient_set1 ?nDGi. - rewrite /= defGq IHn ?(leq_trans _ leEn) ?ltn_quotient // -?defGq. - by rewrite quotient_odd // quotient_pgroup // quotient_norms. - rewrite /p_xp -!sub1set !morph_p_elt -?quotient_set1 ?nDGi //=. - by rewrite -!quotientR ?quotient_cents ?sub1set ?nDGi. -have abelE: p.-abelem E. - by rewrite -is_abelem_pgroup //; case: (minnormal_solvable minE_EG _ solE). -have cEE: abelian E by case/and3P: abelE. -have{minE_EG} minE: minnormal E G. - case/mingroupP: minE_EG => _ minE; apply/mingroupP; rewrite ntE. - split=> // D ntD sDE; apply: minE => //; rewrite join_subG cents_norm //. - by rewrite centsC (subset_trans sDE). -have nCG: G \subset 'N('C_G(E)) by rewrite normsI ?normG ?norms_cent. -suffices{p'Gc} pG'c: p.-group (G / 'C_G(E))^`(1). - have [Pc sylPc sGc'Pc]:= Sylow_superset (der_subS _ _) pG'c. - have nsPc: Pc <| G / 'C_G(E) by rewrite sub_der1_normal ?(pHall_sub sylPc). - case/negP: p'Gc; rewrite /pgroup -(card_isog (second_isog _)) ?norms_cent //. - rewrite setIC; apply: pgroupS (pHall_pgroup sylPc) => /=. - rewrite sub_quotient_pre // join_subG !sub1set !(subsetP nCG, inE) //=. - by rewrite !(mem_normal_Hall sylPc) ?mem_quotient ?morph_p_elt ?(subsetP nCG). -have defC := rker_abelem abelE ntE nEG; rewrite /= -/G in defC. -set rG := abelem_repr _ _ _ in defC. -case ncxy: (rG x *m rG y == rG y *m rG x). - have Cxy: [~ x, y] \in 'C_G(E). - rewrite -defC inE groupR //= !repr_mxM ?groupM ?groupV // mul1mx -/rG. - by rewrite (eqP ncxy) -!repr_mxM ?groupM ?groupV // mulKg mulVg repr_mx1. - rewrite [_^`(1)](commG1P _) ?pgroup1 //= quotient_gen -gen_subG //= -/G. - rewrite !gen_subG centsC gen_subG quotient_cents2r ?gen_subG //= -/G. - rewrite /commg_set imset2Ul !imset2_set1l !imsetU !imset_set1. - by rewrite !subUset andbC !sub1set !commgg group1 /= -invg_comm groupV Cxy. -pose Ax : 'M(E) := rG x - 1; pose Ay : 'M(E) := rG y - 1. -have Ax2: Ax *m Ax = 0. - apply/row_matrixP=> i; apply/eqP; rewrite row_mul mulmxBr mulmx1. - rewrite row0 subr_eq0 -(inj_eq (@rVabelem_inj _ _ _ abelE ntE)). - rewrite rVabelemJ // conjgE -(centP cRx) ?mulKg //. - rewrite linearB /= addrC row1 rowE rVabelemD rVabelemN rVabelemJ //=. - by rewrite mem_commg ?set11 ?mem_rVabelem. -have Ay2: Ay *m Ay = 0. - apply/row_matrixP=> i; apply/eqP; rewrite row_mul mulmxBr mulmx1. - rewrite row0 subr_eq0 -(inj_eq (@rVabelem_inj _ _ _ abelE ntE)). - rewrite rVabelemJ // conjgE -(centP cRy) ?mulKg //. - rewrite linearB /= addrC row1 rowE rVabelemD rVabelemN rVabelemJ //=. - by rewrite mem_commg ?set11 ?mem_rVabelem. -pose A := Ax *m Ay + Ay *m Ax. -have cAG: centgmx rG A. - rewrite /centgmx gen_subG subUset !sub1set !inE Gx Gy /=; apply/andP. - rewrite -[rG x](subrK 1%R) -[rG y](subrK 1%R) -/Ax -/Ay. - rewrite 2!(mulmxDl _ 1 A) 2!(mulmxDr A _ 1) !mulmx1 !mul1mx. - rewrite !(inj_eq (addIr A)) ![_ *m A]mulmxDr ![A *m _]mulmxDl. - by rewrite -!mulmxA Ax2 Ay2 !mulmx0 !mulmxA Ax2 Ay2 !mul0mx !addr0 !add0r. -have irrG: mx_irreducible rG by apply/abelem_mx_irrP. -pose rAG := gen_repr irrG cAG; pose inFA := in_gen irrG cAG. -pose valFA := @val_gen _ _ _ _ _ _ irrG cAG. -set dA := gen_dim A in rAG inFA valFA. -rewrite -(rker_abelem abelE ntE nEG) -/rG -(rker_gen irrG cAG) -/rAG. -have dA_gt0: dA > 0 by rewrite (gen_dim_gt0 irrG cAG). -have irrAG: mx_irreducible rAG by apply: gen_mx_irr. -have: dA <= 2. - case Ax0: (Ax == 0). - by rewrite subr_eq0 in Ax0; case/eqP: ncxy; rewrite (eqP Ax0) mulmx1 mul1mx. - case/rowV0Pn: Ax0 => v; case/submxP => u def_v nzv. - pose U := col_mx v (v *m Ay); pose UA := <<inFA _ U>>%MS. - pose rvalFA := @rowval_gen _ _ _ _ _ _ irrG cAG. - have Umod: mxmodule rAG UA. - rewrite /mxmodule gen_subG subUset !sub1set !inE Gx Gy /= andbC. - apply/andP; split; rewrite (eqmxMr _ (genmxE _)) -in_genJ // genmxE. - rewrite submx_in_gen // -[rG y](subrK 1%R) -/Ay mulmxDr mulmx1. - rewrite addmx_sub // mul_col_mx -mulmxA Ay2 mulmx0. - by rewrite -!addsmxE addsmx0 addsmxSr. - rewrite -[rG x](subrK 1%R) -/Ax mulmxDr mulmx1 in_genD mul_col_mx. - rewrite -mulmxA -[Ay *m Ax](addKr (Ax *m Ay)) (mulmxDr v _ A) -mulmxN. - rewrite mulmxA {1 2}def_v -(mulmxA u) Ax2 mulmx0 mul0mx add0r. - pose B := A; rewrite -(mul0mx _ B) -mul_col_mx -[B](mxval_groot irrG cAG). - rewrite {B} -[_ 0 v](in_genK irrG cAG) -val_genZ val_genK. - rewrite addmx_sub ?scalemx_sub ?submx_in_gen //. - by rewrite -!addsmxE adds0mx addsmxSl. - have nzU: UA != 0. - rewrite -mxrank_eq0 genmxE mxrank_eq0; apply/eqP. - move/(canRL ((in_genK _ _) _)); rewrite val_gen0; apply/eqP. - by rewrite -submx0 -addsmxE addsmx_sub submx0 negb_and nzv. - case/mx_irrP: irrAG => _ /(_ UA Umod nzU)/eqnP <-. - by rewrite genmxE rank_leq_row. -rewrite leq_eqVlt ltnS leq_eqVlt ltnNge dA_gt0 orbF orbC; case/pred2P=> def_dA. - rewrite [_^`(1)](commG1P _) ?pgroup1 // quotient_cents2r // gen_subG. - apply/subsetP=> zt; case/imset2P=> z t Gz Gt ->{zt}. - rewrite !inE groupR //= mul1mx; have Gtz := groupM Gt Gz. - rewrite -(inj_eq (can_inj (mulKmx (repr_mx_unit rAG Gtz)))) mulmx1. - rewrite [eq_op]lock -repr_mxM ?groupR ?groupM // -commgC !repr_mxM // -lock. - apply/eqP; move: (rAG z) (rAG t); rewrite /= -/dA def_dA => Az At. - by rewrite [Az]mx11_scalar scalar_mxC. -move: (kquo_repr _) (kquo_mx_faithful rAG) => /=; set K := rker _. -rewrite def_dA => r2G; move/der1_odd_GL2_charf; move/implyP. -rewrite quotient_odd //= -/G; apply: etrans; apply: eq_pgroup => p'. -have [p_pr _ _] := pgroup_pdiv pE ntE. -by rewrite (fmorph_char (gen_rmorphism _ _)) (charf_eq (char_Fp _)). -Qed. - -Section A5. - -Variables (gT : finGroupType) (p : nat) (G P X : {group gT}). - -Hypotheses (oddG : odd #|G|) (solG : solvable G) (pP : p.-group P). -Hypotheses (nsPG : P <| G) (sXG : X \subset G). -Hypotheses (genX : generated_by (p_norm_abelian p P) X). - -Let C := 'C_G(P). -Let defN : 'N_G(P) = G. Proof. by rewrite (setIidPl _) ?normal_norm. Qed. -Let nsCG : C <| G. Proof. by rewrite -defN subcent_normal. Qed. -Let nCG := normal_norm nsCG. -Let nCX := subset_trans sXG nCG. - -(* This is B & G, Theorem A.5.1; it does not depend on the solG assumption. *) -Theorem odd_abelian_gen_stable : X / C \subset 'O_p(G / C). -Proof. -case/exists_eqP: genX => gX defX. -rewrite -defN sub_quotient_pre // -defX gen_subG. -apply/bigcupsP=> A gX_A; have [_ pA nAP cAA] := and4P gX_A. -have{gX_A} sAX: A \subset X by rewrite -defX sub_gen ?bigcup_sup. -rewrite -sub_quotient_pre ?(subset_trans sAX nCX) //=. -rewrite odd_p_stable ?normalM ?pcore_normal //. - by rewrite /psubgroup pA defN (subset_trans sAX sXG). -by apply/commG1P; rewrite (subset_trans _ cAA) // commg_subr. -Qed. - -(* This is B & G, Theorem A.5.2. *) -Theorem odd_abelian_gen_constrained : - 'O_p^'(G) = 1 -> 'C_('O_p(G))(P) \subset P -> X \subset 'O_p(G). -Proof. -set Q := 'O_p(G) => p'G1 sCQ_P. -have sPQ: P \subset Q by rewrite pcore_max. -have defQ: 'O_{p^', p}(G) = Q by rewrite pseries_pop2. -have pQ: p.-group Q by apply: pcore_pgroup. -have sCQ: 'C_G(Q) \subset Q. - by rewrite -{2}defQ solvable_p_constrained //= defQ /pHall pQ indexgg subxx. -have pC: p.-group C. - apply/pgroupP=> q q_pr; case/Cauchy=> // u Cu q_u; apply/idPn=> p'q. - suff cQu: u \in 'C_G(Q). - case/negP: p'q; have{q_u}: q %| #[u] by rewrite q_u. - by apply: pnatP q q_pr => //; apply: mem_p_elt pQ _; apply: (subsetP sCQ). - have [Gu cPu] := setIP Cu; rewrite inE Gu /= -cycle_subG. - rewrite coprime_nil_faithful_cent_stab ?(pgroup_nil pQ) //= -/C -/Q. - - by rewrite cycle_subG; apply: subsetP Gu; rewrite normal_norm ?pcore_normal. - - by rewrite (pnat_coprime pQ) // [#|_|]q_u pnatE. - have sPcQu: P \subset 'C_Q(<[u]>) by rewrite subsetI sPQ centsC cycle_subG. - by apply: subset_trans (subset_trans sCQ_P sPcQu); rewrite setIS // centS. -rewrite -(quotientSGK nCX) ?pcore_max // -pquotient_pcore //. -exact: odd_abelian_gen_stable. -Qed. - -End A5. - -End AppendixA. - -Section AppendixB. - -Local Notation "X --> Y" := (generated_by (norm_abelian X) Y) - (at level 70, no associativity) : group_scope. - -Variable gT : finGroupType. -Implicit Types G H A : {group gT}. -Implicit Types D E : {set gT}. -Implicit Type p : nat. - -Lemma Puig_char G : 'L(G) \char G. -Proof. exact: gFchar. Qed. - -Lemma center_Puig_char G : 'Z('L(G)) \char G. -Proof. by rewrite !gFchar_trans. Qed. - -(* This is B & G, Lemma B.1(a). *) -Lemma Puig_succS G D E : D \subset E -> 'L_[G](E) \subset 'L_[G](D). -Proof. -move=> sDE; apply: Puig_max (Puig_succ_sub _ _). -exact: norm_abgenS sDE (Puig_gen _ _). -Qed. - -(* This is part of B & G, Lemma B.1(b) (see also BGsection1.Puig1). *) -Lemma Puig_sub_even m n G : m <= n -> 'L_{m.*2}(G) \subset 'L_{n.*2}(G). -Proof. -move/subnKC <-; move: {n}(n - m)%N => n. -by elim: m => [|m IHm] /=; rewrite ?sub1G ?Puig_succS. -Qed. - -(* This is part of B & G, Lemma B.1(b). *) -Lemma Puig_sub_odd m n G : m <= n -> 'L_{n.*2.+1}(G) \subset 'L_{m.*2.+1}(G). -Proof. by move=> le_mn; rewrite Puig_succS ?Puig_sub_even. Qed. - -(* This is part of B & G, Lemma B.1(b). *) -Lemma Puig_sub_even_odd m n G : 'L_{m.*2}(G) \subset 'L_{n.*2.+1}(G). -Proof. -elim: n m => [|n IHn] m; first by rewrite Puig1 Puig_at_sub. -by case: m => [|m]; rewrite ?sub1G ?Puig_succS ?IHn. -Qed. - -(* This is B & G, Lemma B.1(c). *) -Lemma Puig_limit G : - exists m, forall k, m <= k -> - 'L_{k.*2}(G) = 'L_*(G) /\ 'L_{k.*2.+1}(G) = 'L(G). -Proof. -pose L2G m := 'L_{m.*2}(G); pose n := #|G|. -have []: #|L2G n| <= n /\ n <= n by rewrite subset_leq_card ?Puig_at_sub. -elim: {1 2 3}n => [| m IHm leLm1 /ltnW]; first by rewrite leqNgt cardG_gt0. -have [eqLm le_mn|] := eqVneq (L2G m.+1) (L2G m); last first. - rewrite eq_sym eqEcard Puig_sub_even ?leqnSn // -ltnNge => lt_m1_m. - exact: IHm (leq_trans lt_m1_m leLm1). -have{eqLm} eqLm k: m <= k -> 'L_{k.*2}(G) = L2G m. - rewrite leq_eqVlt => /predU1P[-> // |]; elim: k => // k IHk. - by rewrite leq_eqVlt => /predU1P[<- //| ltmk]; rewrite -eqLm !PuigS IHk. -by exists m => k le_mk; rewrite Puig_def PuigS /Puig_inf /= !eqLm. -Qed. - -(* This is B & G, Lemma B.1(d), second part; the first part is covered by *) -(* BGsection1.Puig_inf_sub. *) -Lemma Puig_inf_sub_Puig G : 'L_*(G) \subset 'L(G). -Proof. exact: Puig_sub_even_odd. Qed. - -(* This is B & G, Lemma B.1(e). *) -Lemma abelian_norm_Puig n G A : - n > 0 -> abelian A -> A <| G -> A \subset 'L_{n}(G). -Proof. -case: n => // n _ cAA /andP[sAG nAG]. -rewrite PuigS sub_gen // bigcup_sup // inE sAG /norm_abelian cAA andbT. -exact: subset_trans (Puig_at_sub n G) nAG. -Qed. - -(* This is B & G, Lemma B.1(f), first inclusion. *) -Lemma sub_cent_Puig_at n p G : - n > 0 -> p.-group G -> 'C_G('L_{n}(G)) \subset 'L_{n}(G). -Proof. -move=> n_gt0 pG. -have /ex_maxgroup[M /(max_SCN pG)SCN_M]: exists M, (gval M <| G) && abelian M. - by exists 1%G; rewrite normal1 abelian1. -have{SCN_M} [cMM [nsMG defCM]] := (SCN_abelian SCN_M, SCN_P SCN_M). -have sML: M \subset 'L_{n}(G) by apply: abelian_norm_Puig. -by apply: subset_trans (sML); rewrite -defCM setIS // centS. -Qed. - -(* This is B & G, Lemma B.1(f), second inclusion. *) -Lemma sub_center_cent_Puig_at n G : 'Z(G) \subset 'C_G('L_{n}(G)). -Proof. by rewrite setIS ?centS ?Puig_at_sub. Qed. - -(* This is B & G, Lemma B.1(f), third inclusion (the fourth is trivial). *) -Lemma sub_cent_Puig_inf p G : p.-group G -> 'C_G('L_*(G)) \subset 'L_*(G). -Proof. by apply: sub_cent_Puig_at; rewrite double_gt0. Qed. - -(* This is B & G, Lemma B.1(f), fifth inclusion (the sixth is trivial). *) -Lemma sub_cent_Puig p G : p.-group G -> 'C_G('L(G)) \subset 'L(G). -Proof. exact: sub_cent_Puig_at. Qed. - -(* This is B & G, Lemma B.1(f), final remark (we prove the contrapositive). *) -Lemma trivg_center_Puig_pgroup p G : p.-group G -> 'Z('L(G)) = 1 -> G :=: 1. -Proof. -move=> pG LG1; apply/(trivg_center_pgroup pG)/trivgP. -rewrite -(trivg_center_pgroup (pgroupS (Puig_sub _) pG) LG1). -by apply: subset_trans (sub_cent_Puig pG); apply: sub_center_cent_Puig_at. -Qed. - -(* This is B & G, Lemma B.1(g), second part; the first part is simply the *) -(* definition of 'L(G) in terms of 'L_*(G). *) -Lemma Puig_inf_def G : 'L_*(G) = 'L_[G]('L(G)). -Proof. -have [k defL] := Puig_limit G. -by case: (defL k) => // _ <-; case: (defL k.+1) => [|<- //]; apply: leqnSn. -Qed. - -(* This is B & G, Lemma B.2. *) -Lemma sub_Puig_eq G H : H \subset G -> 'L(G) \subset H -> 'L(H) = 'L(G). -Proof. -move=> sHG sLG_H; apply/setP/subset_eqP/andP. -have sLH_G := subset_trans (Puig_succ_sub _ _) sHG. -have gPuig := norm_abgenS _ (Puig_gen _ _). -have [[kG defLG] [kH defLH]] := (Puig_limit G, Puig_limit H). -have [/defLG[_ {1}<-] /defLH[_ <-]] := (leq_maxl kG kH, leq_maxr kG kH). -split; do [elim: (maxn _ _) => [|k IHk /=]; first by rewrite !Puig1]. - rewrite doubleS !(PuigS _.+1) Puig_max ?gPuig // Puig_max ?gPuig //. - exact: subset_trans (Puig_sub_even_odd _.+1 _ _) sLG_H. -rewrite doubleS Puig_max // -!PuigS Puig_def gPuig //. -by rewrite Puig_inf_def Puig_max ?gPuig ?sLH_G. -Qed. - -Lemma norm_abgen_pgroup p X G : - p.-group G -> X --> G -> generated_by (p_norm_abelian p X) G. -Proof. -move=> pG /exists_eqP[gG defG]. -have:= subxx G; rewrite -{1 3}defG gen_subG /= => /bigcupsP-sGG. -apply/exists_eqP; exists gG; congr <<_>>; apply: eq_bigl => A. -by rewrite andbA andbAC andb_idr // => /sGG/pgroupS->. -Qed. - -Variables (p : nat) (G S : {group gT}). -Hypotheses (oddG : odd #|G|) (solG : solvable G) (sylS : p.-Sylow(G) S). -Hypothesis p'G1 : 'O_p^'(G) = 1. - -Let T := 'O_p(G). -Let nsTG : T <| G := pcore_normal _ _. -Let pT : p.-group T := pcore_pgroup _ _. -Let pS : p.-group S := pHall_pgroup sylS. -Let sSG := pHall_sub sylS. - -(* This is B & G, Lemma B.3. *) -Lemma pcore_Sylow_Puig_sub : 'L_*(S) \subset 'L_*(T) /\ 'L(T) \subset 'L(S). -Proof. -have [[kS defLS] [kT defLT]] := (Puig_limit S, Puig_limit [group of T]). -have [/defLS[<- <-] /defLT[<- <-]] := (leq_maxl kS kT, leq_maxr kS kT). -have sL_ := subset_trans (Puig_succ_sub _ _). -elim: (maxn kS kT) => [|k [_ sL1]]; first by rewrite !Puig1 pcore_sub_Hall. -have{sL1} gL: 'L_{k.*2.+1}(T) --> 'L_{k.*2.+2}(S). - exact: norm_abgenS sL1 (Puig_gen _ _). -have sCT_L: 'C_T('L_{k.*2.+1}(T)) \subset 'L_{k.*2.+1}(T). - exact: sub_cent_Puig_at pT. -have{sCT_L} sLT: 'L_{k.*2.+2}(S) \subset T. - apply: odd_abelian_gen_constrained sCT_L => //. - - exact: pgroupS (Puig_at_sub _ _) pT. - - exact: gFnormal_trans nsTG. - - exact: sL_ sSG. - by rewrite norm_abgen_pgroup // (pgroupS _ pS) ?Puig_at_sub. -have sL2: 'L_{k.*2.+2}(S) \subset 'L_{k.*2.+2}(T) by apply: Puig_max. -split; [exact: sL2 | rewrite doubleS; apply: subset_trans (Puig_succS _ sL2) _]. -by rewrite Puig_max -?PuigS ?Puig_gen // sL_ // pcore_sub_Hall. -Qed. - -Let Y := 'Z('L(T)). -Let L := 'L(S). - -(* This is B & G, Theorem B.4(b). *) -Theorem Puig_center_normal : 'Z(L) <| G. -Proof. -have [sLiST sLTS] := pcore_Sylow_Puig_sub. -have sLiLT: 'L_*(T) \subset 'L(T) by apply: Puig_sub_even_odd. -have sZY: 'Z(L) \subset Y. - rewrite subsetI andbC subIset ?centS ?orbT //=. - suffices: 'C_S('L_*(S)) \subset 'L(T). - by apply: subset_trans; rewrite setISS ?Puig_sub ?centS ?Puig_sub_even_odd. - apply: subset_trans (subset_trans sLiST sLiLT). - by apply: sub_cent_Puig_at pS; rewrite double_gt0. -have chY: Y \char G by rewrite !gFchar_trans. -have nsCY_G: 'C_G(Y) <| G by rewrite char_normal 1?subcent_char ?char_refl. -have [C defC sCY_C nsCG] := inv_quotientN nsCY_G (pcore_normal p _). -have sLG: L \subset G by rewrite gFsub_trans ?(pHall_sub sylS). -have nsL_nCS: L <| 'N_G(C :&: S). - have sYLiS: Y \subset 'L_*(S). - rewrite abelian_norm_Puig ?double_gt0 ?center_abelian //. - apply: normalS (pHall_sub sylS) (char_normal chY). - by rewrite subIset // (subset_trans sLTS) ?Puig_sub. - have gYL: Y --> L := norm_abgenS sYLiS (Puig_gen _ _). - have sLCS: L \subset C :&: S. - rewrite subsetI Puig_sub andbT. - rewrite -(quotientSGK _ sCY_C) ?(subset_trans sLG) ?normal_norm // -defC. - rewrite odd_abelian_gen_stable ?char_normal ?norm_abgen_pgroup //. - by rewrite (pgroupS _ pT) ?subIset // Puig_sub. - by rewrite (pgroupS _ pS) ?Puig_sub. - rewrite -[L](sub_Puig_eq _ sLCS) ?subsetIr // gFnormal_trans ?normalSG //. - by rewrite subIset // sSG orbT. -have sylCS: p.-Sylow(C) (C :&: S) := Sylow_setI_normal nsCG sylS. -have{defC} defC: 'C_G(Y) * (C :&: S) = C. - apply/eqP; rewrite eqEsubset mulG_subG sCY_C subsetIl /=. - have nCY_C: C \subset 'N('C_G(Y)). - exact: subset_trans (normal_sub nsCG) (normal_norm nsCY_G). - rewrite -quotientSK // -defC /= -pseries1. - rewrite -(pseries_catr_id [:: p : nat_pred]) (pseries_rcons_id [::]) /=. - rewrite pseries1 /= pseries1 defC pcore_sub_Hall // morphim_pHall //. - by rewrite subIset ?nCY_C. -have defG: 'C_G(Y) * 'N_G(C :&: S) = G. - have sCS_N: C :&: S \subset 'N_G(C :&: S). - by rewrite subsetI normG subIset // sSG orbT. - by rewrite -(mulSGid sCS_N) mulgA defC (Frattini_arg _ sylCS). -have nsZ_N: 'Z(L) <| 'N_G(C :&: S) := gFnormal_trans _ nsL_nCS. -rewrite /normal subIset ?sLG //= -{1}defG mulG_subG /=. -rewrite cents_norm ?normal_norm // centsC. -by rewrite (subset_trans sZY) // centsC subsetIr. -Qed. - -End AppendixB. - -Section Puig_factorization. - -Variables (gT : finGroupType) (p : nat) (G S : {group gT}). -Hypotheses (oddG : odd #|G|) (solG : solvable G) (sylS : p.-Sylow(G) S). - -(* This is B & G, Theorem B.4(a). *) -Theorem Puig_factorization : 'O_p^'(G) * 'N_G('Z('L(S))) = G. -Proof. -set D := 'O_p^'(G); set Z := 'Z(_); have [sSG pS _] := and3P sylS. -have sSN: S \subset 'N(D) by rewrite (subset_trans sSG) ?gFnorm. -have p'D: p^'.-group D := pcore_pgroup _ _. -have tiSD: S :&: D = 1 := coprime_TIg (pnat_coprime pS p'D). -have def_Zq: Z / D = 'Z('L(S / D)). - rewrite !quotientE -(setIid S) -(morphim_restrm sSN); set f := restrm _ _. - have injf: 'injm f by rewrite ker_restrm ker_coset tiSD. - rewrite -!(injmF _ injf) ?Puig_sub //= morphim_restrm. - by rewrite (setIidPr _) // subIset ?Puig_sub. -have{def_Zq} nZq: Z / D <| G / D. - have sylSq: p.-Sylow(G / D) (S / D) by apply: morphim_pHall. - rewrite def_Zq (Puig_center_normal _ _ sylSq) ?quotient_odd ?quotient_sol //. - exact: trivg_pcore_quotient. -have sZS: Z \subset S by rewrite subIset ?Puig_sub. -have sZN: Z \subset 'N_G(Z) by rewrite subsetI normG (subset_trans sZS). -have nDZ: Z \subset 'N(D) by rewrite (subset_trans sZS). -rewrite -(mulSGid sZN) mulgA -(norm_joinEr nDZ) (@Frattini_arg p) //= -/D -/Z. - rewrite -cosetpre_normal quotientK ?quotientGK ?pcore_normal // in nZq. - by rewrite norm_joinEr. -rewrite /pHall -divgS joing_subr ?(pgroupS sZS) /= ?norm_joinEr //= -/Z. -by rewrite TI_cardMg ?mulnK //; apply/trivgP; rewrite /= setIC -tiSD setSI. -Qed. - -End Puig_factorization. - - - - - diff --git a/mathcomp/odd_order/BGappendixC.v b/mathcomp/odd_order/BGappendixC.v deleted file mode 100644 index 3cfb101..0000000 --- a/mathcomp/odd_order/BGappendixC.v +++ /dev/null @@ -1,760 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype choice ssrnat seq div fintype. -From mathcomp -Require Import tuple finfun bigop ssralg finset prime binomial poly polydiv. -From mathcomp -Require Import fingroup morphism quotient automorphism action finalg zmodp. -From mathcomp -Require Import gfunctor gproduct cyclic commutator pgroup abelian frobenius. -From mathcomp -Require Import BGsection1. -From mathcomp -Require Import matrix mxalgebra mxabelem vector falgebra fieldext galois. -From mathcomp -Require Import finfield ssrnum algC classfun character integral_char inertia. - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope GRing.Theory FinRing.Theory Num.Theory. -Local Open Scope ring_scope. - -Section AppendixC. - -Variables (gT : finGroupType) (p q : nat) (H P P0 U Q : {group gT}). -Let nU := ((p ^ q).-1 %/ p.-1)%N. - -(* External statement of the finite field assumption. *) -CoInductive finFieldImage : Prop := - FinFieldImage (F : finFieldType) (sigma : {morphism P >-> F}) of - isom P [set: F] sigma & sigma @*^-1 <[1 : F]> = P0 - & exists2 sigmaU : {morphism U >-> {unit F}}, - 'injm sigmaU & {in P & U, morph_act 'J 'U sigma sigmaU}. - -(* These correspond to hypothesis (A) of B & G, Appendix C, Theorem C. *) -Hypotheses (pr_p : prime p) (pr_q : prime q) (coUp1 : coprime nU p.-1). -Hypotheses (defH : P ><| U = H) (fieldH : finFieldImage). -Hypotheses (oP : #|P| = (p ^ q)%N) (oU : #|U| = nU). - -(* These correspond to hypothesis (B) of B & G, Appendix C, Theorem C. *) -Hypotheses (abelQ : q.-abelem Q) (nQP0 : P0 \subset 'N(Q)). -Hypothesis nU_P0Q : exists2 y, y \in Q & P0 :^ y \subset 'N(U). - -Section ExpandHypotheses. - -(* Negation of the goal of B & G, Appendix C, Theorem C. *) -Hypothesis ltqp : (q < p)%N. - -(* From the fieldH assumption. *) -Variables (fT : finFieldType) (charFp : p \in [char fT]). -Local Notation F := (PrimeCharType charFp). -Local Notation galF := [splittingFieldType 'F_p of F]. -Let Fpq : {vspace F} := fullv. -Let Fp : {vspace F} := 1%VS. - -Hypothesis oF : #|F| = (p ^ q)%N. -Let oF_p : #|'F_p| = p. Proof. exact: card_Fp. Qed. -Let oFp : #|Fp| = p. Proof. by rewrite card_vspace1. Qed. -Let oFpq : #|Fpq| = (p ^ q)%N. Proof. by rewrite card_vspacef. Qed. -Let dimFpq : \dim Fpq = q. Proof. by rewrite primeChar_dimf oF pfactorK. Qed. - -Variables (sigma : {morphism P >-> F}) (sigmaU : {morphism U >-> {unit F}}). -Hypotheses (inj_sigma : 'injm sigma) (inj_sigmaU : 'injm sigmaU). -Hypothesis im_sigma : sigma @* P = [set: F]. -Variable s : gT. -Hypotheses (sP0P : P0 \subset P) (sigma_s : sigma s = 1) (defP0 : <[s]> = P0). - -Let psi u : F := val (sigmaU u). -Let inj_psi : {in U &, injective psi}. -Proof. by move=> u v Uu Uv /val_inj/(injmP inj_sigmaU)->. Qed. - -Hypothesis sigmaJ : {in P & U, forall x u, sigma (x ^ u) = sigma x * psi u}. - -Let Ps : s \in P. Proof. by rewrite -cycle_subG defP0. Qed. -Let P0s : s \in P0. Proof. by rewrite -defP0 cycle_id. Qed. - -Let nz_psi u : psi u != 0. Proof. by rewrite -unitfE (valP (sigmaU u)). Qed. - -Let sigma1 : sigma 1%g = 0. Proof. exact: morph1. Qed. -Let sigmaM : {in P &, {morph sigma : x1 x2 / (x1 * x2)%g >-> x1 + x2}}. -Proof. exact: morphM. Qed. -Let sigmaV : {in P, {morph sigma : x / x^-1%g >-> - x}}. -Proof. exact: morphV. Qed. -Let sigmaX n : {in P, {morph sigma : x / (x ^+ n)%g >-> x *+ n}}. -Proof. exact: morphX. Qed. - -Let psi1 : psi 1%g = 1. Proof. by rewrite /psi morph1. Qed. -Let psiM : {in U &, {morph psi : u1 u2 / (u1 * u2)%g >-> u1 * u2}}. -Proof. by move=> u1 u2 Uu1 Uu2; rewrite /psi morphM. Qed. -Let psiV : {in U, {morph psi : u / u^-1%g >-> u^-1}}. -Proof. by move=> u Uu; rewrite /psi morphV. Qed. -Let psiX n : {in U, {morph psi : u / (u ^+ n)%g >-> u ^+ n}}. -Proof. by move=> u Uu; rewrite /psi morphX // val_unitX. Qed. - -Let sigmaE := (sigma1, sigma_s, mulr1, mul1r, - (sigmaJ, sigmaX, sigmaM, sigmaV), (psi1, psiX, psiM, psiV)). - -Let psiE u : u \in U -> psi u = sigma (s ^ u). -Proof. by move=> Uu; rewrite !sigmaE. Qed. - -Let nPU : U \subset 'N(P). Proof. by have [] := sdprodP defH. Qed. -Let memJ_P : {in P & U, forall x u, x ^ u \in P}. -Proof. by move=> x u Px Uu; rewrite /= memJ_norm ?(subsetP nPU). Qed. -Let in_PU := (memJ_P, in_group). - -Let sigmaP0 : sigma @* P0 =i Fp. -Proof. -rewrite -defP0 morphim_cycle // sigma_s => x. -apply/cycleP/vlineP=> [] [n ->]; first by exists n%:R; rewrite scaler_nat. -by exists (val n); rewrite -{1}[n]natr_Zp -in_algE rmorph_nat zmodXgE. -Qed. - -Let nt_s : s != 1%g. -Proof. by rewrite -(morph_injm_eq1 inj_sigma) // sigmaE oner_eq0. Qed. - -Let p_gt0 : (0 < p)%N. Proof. exact: prime_gt0. Qed. -Let q_gt0 : (0 < q)%N. Proof. exact: prime_gt0. Qed. -Let p1_gt0 : (0 < p.-1)%N. Proof. by rewrite -subn1 subn_gt0 prime_gt1. Qed. - -(* This is B & G, Appendix C, Remark I. *) -Let not_dvd_q_p1 : ~~ (q %| p.-1)%N. -Proof. -rewrite -prime_coprime // -[q]card_ord -sum1_card -coprime_modl -modn_summ. -have:= coUp1; rewrite /nU predn_exp mulKn //= -coprime_modl -modn_summ. -congr (coprime (_ %% _) _); apply: eq_bigr => i _. -by rewrite -{1}[p](subnK p_gt0) subn1 -modnXm modnDl modnXm exp1n. -Qed. - -(* This is the first assertion of B & G, Appendix C, Remark V. *) -Let odd_p : odd p. -Proof. -by apply: contraLR ltqp => /prime_oddPn-> //; rewrite -leqNgt prime_gt1. -Qed. - -(* This is the second assertion of B & G, Appendix C, Remark V. *) -Let odd_q : odd q. -Proof. -apply: contraR not_dvd_q_p1 => /prime_oddPn-> //. -by rewrite -subn1 dvdn2 odd_sub ?odd_p. -Qed. - -Let qgt2 : (2 < q)%N. Proof. by rewrite odd_prime_gt2. Qed. -Let pgt4 : (4 < p)%N. Proof. by rewrite odd_geq ?(leq_ltn_trans qgt2). Qed. -Let qgt1 : (1 < q)%N. Proof. exact: ltnW. Qed. - -Local Notation Nm := (galNorm Fp Fpq). -Local Notation uval := (@FinRing.uval _). - -Let cycFU (FU : {group {unit F}}) : cyclic FU. -Proof. exact: field_unit_group_cyclic. Qed. -Let cUU : abelian U. -Proof. by rewrite cyclic_abelian // -(injm_cyclic inj_sigmaU) ?cycFU. Qed. - -(* This is B & G, Appendix C, Remark VII. *) -Let im_psi (x : F) : (x \in psi @: U) = (Nm x == 1). -Proof. -have /cyclicP[u0 defFU]: cyclic [set: {unit F}] by apply: cycFU. -have o_u0: #[u0] = (p ^ q).-1 by rewrite orderE -defFU card_finField_unit oF. -have ->: psi @: U = uval @: (sigmaU @* U) by rewrite morphimEdom -imset_comp. -have /set1P[->]: (sigmaU @* U)%G \in [set <[u0 ^+ (#[u0] %/ nU)]>%G]. - rewrite -cycle_sub_group ?inE; last first. - by rewrite o_u0 -(divnK (dvdn_pred_predX p q)) dvdn_mulr. - by rewrite -defFU subsetT card_injm //= oU. -rewrite divnA ?dvdn_pred_predX // -o_u0 mulKn //. -have [/= alpha alpha_gen Dalpha] := finField_galois_generator (subvf Fp). -have{Dalpha} Dalpha x1: x1 != 0 -> x1 / alpha x1 = x1^-1 ^+ p.-1. - move=> nz_x1; rewrite -[_ ^+ _](mulVKf nz_x1) -exprS Dalpha ?memvf // exprVn. - by rewrite dimv1 oF_p prednK ?prime_gt0. -apply/idP/(Hilbert's_theorem_90 alpha_gen (memvf _)) => [|[u [_ nz_u] ->]]. - case/imsetP=> /= _ /cycleP[n ->] ->; rewrite expgAC; set u := (u0 ^+ n)%g. - have nz_u: (val u)^-1 != 0 by rewrite -unitfE unitrV (valP u). - by exists (val u)^-1; rewrite ?memvf ?Dalpha //= invrK val_unitX. -have /cycleP[n Du]: (insubd u0 u)^-1%g \in <[u0]> by rewrite -defFU inE. -have{Du} Du: u^-1 = val (u0 ^+ n)%g by rewrite -Du /= insubdK ?unitfE. -by rewrite Dalpha // Du -val_unitX mem_imset // expgAC mem_cycle. -Qed. - -(* This is B & G, Appendix C, Remark VIII. *) -Let defFU : sigmaU @* U \x [set u | uval u \in Fp] = [set: {unit F}]. -Proof. -have fP v: in_alg F (uval v) \is a GRing.unit by rewrite rmorph_unit ?(valP v). -pose f (v : {unit 'F_p}) := FinRing.unit F (fP v). -have fM: {in setT &, {morph f: v1 v2 / (v1 * v2)%g}}. - by move=> v1 v2 _ _; apply: val_inj; rewrite /= -in_algE rmorphM. -pose galFpU := Morphism fM @* [set: {unit 'F_p}]. -have ->: [set u | uval u \in Fp] = galFpU. - apply/setP=> u; rewrite inE /galFpU morphimEdom. - apply/idP/imsetP=> [|[v _ ->]]; last by rewrite /= rpredZ // memv_line. - case/vlineP=> v Du; have nz_v: v != 0. - by apply: contraTneq (valP u) => v0; rewrite unitfE /= Du v0 scale0r eqxx. - exists (insubd (1%g : {unit 'F_p}) v); rewrite ?inE //. - by apply: val_inj; rewrite /= insubdK ?unitfE. -have oFpU: #|galFpU| = p.-1. - rewrite card_injm ?card_finField_unit ?oF_p //. - by apply/injmP=> v1 v2 _ _ []/(fmorph_inj [rmorphism of in_alg F])/val_inj. -have oUU: #|sigmaU @* U| = nU by rewrite card_injm. -rewrite dprodE ?coprime_TIg ?oUU ?oFpU //; last first. - by rewrite (sub_abelian_cent2 (cyclic_abelian (cycFU [set: _]))) ?subsetT. -apply/eqP; rewrite eqEcard subsetT coprime_cardMg oUU oFpU //=. -by rewrite card_finField_unit oF divnK ?dvdn_pred_predX. -Qed. - -(* This is B & G, Appendix C, Remark IX. *) -Let frobH : [Frobenius H = P ><| U]. -Proof. -apply/Frobenius_semiregularP=> // [||u /setD1P[ntu Uu]]. -- by rewrite -(morphim_injm_eq1 inj_sigma) // im_sigma finRing_nontrivial. -- rewrite -cardG_gt1 oU ltn_divRL ?dvdn_pred_predX // mul1n -!subn1. - by rewrite ltn_sub2r ?(ltn_exp2l 0) ?(ltn_exp2l 1) ?prime_gt1. -apply/trivgP/subsetP=> x /setIP[Px /cent1P/commgP]. -rewrite inE -!(morph_injm_eq1 inj_sigma) ?(sigmaE, in_PU) //. -rewrite -mulrN1 addrC -mulrDr mulf_eq0 subr_eq0 => /orP[] // /idPn[]. -by rewrite (inj_eq val_inj (sigmaU u) 1%g) morph_injm_eq1. -Qed. - -(* From the abelQ assumption of Peterfalvi, Theorem (14.2) to the assumptions *) -(* of part (B) of the assumptions of Theorem C. *) -Let p'q : q != p. Proof. by rewrite ltn_eqF. Qed. -Let cQQ : abelian Q. Proof. exact: abelem_abelian abelQ. Qed. -Let p'Q : p^'.-group Q. Proof. exact: pi_pgroup (abelem_pgroup abelQ) _. Qed. - -Let pP : p.-group P. Proof. by rewrite /pgroup oP pnat_exp ?pnat_id. Qed. -Let coQP : coprime #|Q| #|P|. Proof. exact: p'nat_coprime p'Q pP. Qed. -Let sQP0Q : [~: Q, P0] \subset Q. Proof. by rewrite commg_subl. Qed. - -(* This is B & G, Appendix C, Remark X. *) -Let defQ : 'C_Q(P0) \x [~: Q, P0] = Q. -Proof. by rewrite dprodC coprime_abelian_cent_dprod // (coprimegS sP0P). Qed. - -(* This is B & G, Appendix C, Remark XI. *) -Let nU_P0QP0 : exists2 y, y \in [~: Q, P0] & P0 :^ y \subset 'N(U). -Proof. -have [_ /(mem_dprod defQ)[z [y [/setIP[_ cP0z] QP0y -> _]]]] := nU_P0Q. -by rewrite conjsgM (normsP (cent_sub P0)) //; exists y. -Qed. - -Let E := [set x : galF | Nm x == 1 & Nm (2%:R - x) == 1]. - -Let E_1 : 1 \in E. -Proof. by rewrite !inE -addrA subrr addr0 galNorm1 eqxx. Qed. - -(* This is B & G, Appendix C, Lemma C.1. *) -Let Einv_gt1_le_pq : E = [set x^-1 | x in E] -> (1 < #|E|)%N -> (p <= q)%N. -Proof. -rewrite (cardsD1 1) E_1 ltnS card_gt0 => Einv /set0Pn[/= a /setD1P[not_a1 Ea]]. -pose tau (x : F) := (2%:R - x)^-1. -have Etau x: x \in E -> tau x \in E. - rewrite inE => Ex; rewrite Einv (mem_imset (fun y => y^-1)) //. - by rewrite inE andbC opprD addNKr opprK. -pose Pa := \prod_(beta in 'Gal(Fpq / Fp)) (beta (1 - a) *: 'X + 1). -have galPoly_roots: all (root (Pa - 1)) (enum Fp). - apply/allP=> x; rewrite mem_enum => /vlineP[b ->]. - rewrite rootE !hornerE horner_prod subr_eq0 /=; apply/eqP. - pose h k := (1 - a) *+ k + 1; transitivity (Nm (h b)). - apply: eq_bigr => beta _; rewrite !(rmorphB, rmorphD, rmorphMn) rmorph1 /=. - by rewrite -mulr_natr -scaler_nat natr_Zp hornerD hornerZ hornerX hornerC. - elim: (b : nat) => [|k IHk]; first by rewrite /h add0r galNorm1. - suffices{IHk}: h k / h k.+1 \in E. - rewrite inE -invr_eq1 => /andP[/eqP <- _]. - by rewrite galNormM galNormV /= [galNorm _ _ (h k)]IHk mul1r invrK. - elim: k => [|k IHk]; first by rewrite /h add0r mul1r addrAC Etau. - have nz_hk1: h k.+1 != 0. - apply: contraTneq IHk => ->; rewrite invr0 mulr0. - by rewrite inE galNorm0 eq_sym oner_eq0. - congr (_ \in E): (Etau _ IHk); apply: canLR (@invrK _) _; rewrite invfM invrK. - apply: canRL (mulKf nz_hk1) _; rewrite mulrC mulrBl divfK // mulrDl mul1r. - by rewrite {2}/h mulrS -2!addrA addrK addrAC -mulrSr. -have sizePa: size Pa = q.+1. - have sizePaX (beta : {rmorphism F -> F}) : size (beta (1 - a) *: 'X + 1) = 2. - rewrite -mul_polyC size_MXaddC oner_eq0 andbF size_polyC fmorph_eq0. - by rewrite subr_eq0 eq_sym (negbTE not_a1). - rewrite size_prod => [|i _]; last by rewrite -size_poly_eq0 sizePaX. - rewrite (eq_bigr (fun _ => 2)) => [|beta _]; last by rewrite sizePaX. - rewrite sum_nat_const muln2 -addnn -addSn addnK. - by rewrite -galois_dim ?finField_galois ?subvf // dimv1 divn1 dimFpq. -have sizePa1: size (Pa - 1) = q.+1. - by rewrite size_addl // size_opp size_poly1 sizePa. -have nz_Pa1 : Pa - 1 != 0 by rewrite -size_poly_eq0 sizePa1. -by rewrite -ltnS -oFp -sizePa1 cardE max_poly_roots ?enum_uniq. -Qed. - -(* This is B & G, Appendix C, Lemma C.2. *) -Let E_gt1 : (1 < #|E|)%N. -Proof. -have [q_gt4 | q_le4] := ltnP 4 q. - pose inK x := enum_rank_in (classes1 H) (x ^: H). - have inK_E x: x \in H -> enum_val (inK x) = x ^: H. - by move=> Hx; rewrite enum_rankK_in ?mem_classes. - pose j := inK s; pose k := inK (s ^+ 2)%g; pose e := gring_classM_coef j j k. - have cPP: abelian P by rewrite -(injm_abelian inj_sigma) ?zmod_abelian. - have Hs: s \in H by rewrite -(sdprodW defH) -[s]mulg1 mem_mulg. - have DsH n: (s ^+ n) ^: H = (s ^+ n) ^: U. - rewrite -(sdprodW defH) classM (abelian_classP _ cPP) ?groupX //. - by rewrite class_support_set1l. - have injJU: {in U &, injective (conjg s)}. - by move=> u v Uu Uv eq_s_uv; apply/inj_psi; rewrite ?psiE ?eq_s_uv. - have ->: #|E| = e. - rewrite /e /gring_classM_coef !inK_E ?groupX //. - transitivity #|[set u in U | s^-1 ^ u * s ^+ 2 \in s ^: U]%g|. - rewrite -(card_in_imset (sub_in2 _ inj_psi)) => [|u /setIdP[] //]. - apply: eq_card => x; rewrite inE -!im_psi. - apply/andP/imsetP=> [[/imsetP[u Uu ->] /imsetP[v Uv Dv]]{x} | ]. - exists u; rewrite // inE Uu /=; apply/imsetP; exists v => //. - by apply: (injmP inj_sigma); rewrite ?(sigmaE, in_PU) // mulN1r addrC. - case=> u /setIdP[Uu /imsetP[v Uv /(congr1 sigma)]]. - rewrite ?(sigmaE, in_PU) // mulN1r addrC => Dv ->. - by rewrite Dv !mem_imset. - rewrite DsH (DsH 1%N) expg1; have [w Uw ->] := repr_class U (s ^+ 2). - pose f u := (s ^ (u * w), (s^-1 ^ u * s ^+ 2) ^ w). - rewrite -(@card_in_imset _ _ f) => [|u v]; last first. - by move=> /setIdP[Uu _] /setIdP[Uv _] [/injJU/mulIg-> //]; apply: groupM. - apply: eq_card => [[x1 x2]]; rewrite inE -andbA. - apply/imsetP/and3P=> [[u /setIdP[Uu sUs2u'] [-> ->]{x1 x2}] | []]. - rewrite /= conjgM -(rcoset_id Uw) class_rcoset !memJ_conjg mem_orbit //. - by rewrite sUs2u' -conjMg conjVg mulKVg. - case/imsetP=> u Uu /= -> sUx2 /eqP/(canRL (mulKg _)) Dx2. - exists (u * w^-1)%g; last first. - by rewrite /f /= conjMg -conjgM mulgKV conjVg -Dx2. - rewrite inE !in_PU // Uw -(memJ_conjg _ w) -class_rcoset rcoset_id //. - by rewrite conjMg -conjgM mulgKV conjVg -Dx2. - pose chi_s2 i := 'chi[H]_i s ^+ 2 * ('chi_i (s ^+ 2)%g)^* / 'chi_i 1%g. - have De: e%:R = #|U|%:R / #|P|%:R * (\sum_i chi_s2 i). - have Ks: s \in enum_val j by rewrite inK_E ?class_refl. - have Ks2: (s ^+ 2)%g \in enum_val k by rewrite inK_E ?groupX ?class_refl. - rewrite (gring_classM_coef_sum_eq Ks Ks Ks2) inK_E //; congr (_ * _). - have ->: #|s ^: H| = #|U| by rewrite (DsH 1%N) (card_in_imset injJU). - by rewrite -(sdprod_card defH) mulnC !natrM invfM mulrA mulfK ?neq0CG. - pose linH := [pred i | P \subset cfker 'chi[H]_i]. - have nsPH: P <| H by have [] := sdprod_context defH. - have sum_linH: \sum_(i in linH) chi_s2 i = #|U|%:R. - have isoU: U \isog H / P := sdprod_isog defH. - have abHbar: abelian (H / P) by rewrite -(isog_abelian isoU). - rewrite (card_isog isoU) -(card_Iirr_abelian abHbar) -sumr_const. - rewrite (reindex _ (mod_Iirr_bij nsPH)) /chi_s2 /=. - apply: eq_big => [i | i _]; rewrite ?mod_IirrE ?cfker_mod //. - have lin_i: ('chi_i %% P)%CF \is a linear_char. - exact/cfMod_lin_char/char_abelianP. - rewrite lin_char1 // divr1 -lin_charX // -normCK. - by rewrite normC_lin_char ?groupX ?expr1n. - have degU i: i \notin linH -> 'chi_i 1%g = #|U|%:R. - case/(Frobenius_Ind_irrP (FrobeniusWker frobH)) => {i}i _ ->. - rewrite cfInd1 ?normal_sub // -(index_sdprod defH) lin_char1 ?mulr1 //. - exact/char_abelianP. - have ub_linH' m (s_m := (s ^+ m)%g): - (0 < m < 5)%N -> \sum_(i in predC linH) `|'chi_i s_m| ^+ 2 <= #|P|%:R. - - case/andP=> m_gt0 m_lt5; have{m_gt0 m_lt5} P1sm: s_m \in P^#. - rewrite !inE groupX // -order_dvdn -(order_injm inj_sigma) // sigmaE. - by rewrite andbT order_primeChar ?oner_neq0 ?gtnNdvd ?(leq_trans m_lt5). - have ->: #|P| = (#|P| * (s_m \in s_m ^: H))%N by rewrite class_refl ?muln1. - have{P1sm} /eqP <-: 'C_H[s ^+ m] == P. - rewrite eqEsubset (Frobenius_cent1_ker frobH) // subsetI normal_sub //=. - by rewrite sub_cent1 groupX // (subsetP cPP). - rewrite mulrnA -second_orthogonality_relation ?groupX // big_mkcond. - by apply: ler_sum => i _; rewrite normCK; case: ifP; rewrite ?mul_conjC_ge0. - have sqrtP_gt0: 0 < sqrtC #|P|%:R :> algC by rewrite sqrtC_gt0 ?gt0CG. - have{De ub_linH'}: - `|(#|P| * e)%:R - #|U|%:R ^+ 2| <= #|P|%:R * sqrtC #|P|%:R :> algC. - rewrite natrM De mulrCA mulrA divfK ?neq0CG // (bigID linH) /= sum_linH. - rewrite mulrDr addrC addKr mulrC mulr_suml /chi_s2. - rewrite (ler_trans (ler_norm_sum _ _ _)) // -ler_pdivr_mulr // mulr_suml. - apply: ler_trans (ub_linH' 1%N isT); apply: ler_sum => i linH'i. - rewrite ler_pdivr_mulr // degU ?divfK ?neq0CG //. - rewrite normrM -normrX norm_conjC ler_wpmul2l ?normr_ge0 //. - rewrite -ler_sqr ?qualifE ?normr_ge0 ?(@ltrW _ 0) // sqrtCK. - apply: ler_trans (ub_linH' 2 isT); rewrite (bigD1 i) ?ler_paddr //=. - by apply: sumr_ge0 => i1 _; rewrite exprn_ge0 ?normr_ge0. - rewrite natrM real_ler_distl ?rpredB ?rpredM ?rpred_nat // => /andP[lb_Pe _]. - rewrite -ltC_nat -(ltr_pmul2l (gt0CG P)) {lb_Pe}(ltr_le_trans _ lb_Pe) //. - rewrite ltr_subr_addl (@ler_lt_trans _ ((p ^ q.-1)%:R ^+ 2)) //; last first. - rewrite -!natrX ltC_nat ltn_sqr oU ltn_divRL ?dvdn_pred_predX //. - rewrite -(subnKC qgt1) /= -!subn1 mulnBr muln1 -expnSr. - by rewrite ltn_sub2l ?(ltn_exp2l 0) // prime_gt1. - rewrite -mulrDr -natrX -expnM muln2 -subn1 doubleB -addnn -addnBA // subn2. - rewrite expnD natrM -oP ler_wpmul2l ?ler0n //. - apply: ler_trans (_ : 2%:R * sqrtC #|P|%:R <= _). - rewrite mulrDl mul1r ler_add2l -(@expr_ge1 _ 2) ?(ltrW sqrtP_gt0) // sqrtCK. - by rewrite oP natrX expr_ge1 ?ler0n ?ler1n. - rewrite -ler_sqr ?rpredM ?rpred_nat ?qualifE ?(ltrW sqrtP_gt0) //. - rewrite exprMn sqrtCK -!natrX -natrM leC_nat -expnM muln2 oP. - rewrite -(subnKC q_gt4) doubleS (expnS p _.*2.+1) -(subnKC pgt4) leq_mul //. - by rewrite ?leq_exp2l // !doubleS !ltnS -addnn leq_addl. -have q3: q = 3 by apply/eqP; rewrite eqn_leq qgt2 andbT -ltnS -(odd_ltn 5). -rewrite (cardsD1 1) E_1 ltnS card_gt0; apply/set0Pn => /=. -pose f (c : 'F_p) : {poly 'F_p} := 'X * ('X - 2%:R%:P) * ('X - c%:P) + ('X - 1). -have fc0 c: (f c).[0] = -1 by rewrite !hornerE. -have fc2 c: (f c).[2%:R] = 1 by rewrite !(subrr, hornerE) /= addrK. -have /existsP[c nz_fc]: [exists c, ~~ [exists d, root (f c) d]]. - have nz_f_0 c: ~~ root (f c) 0 by rewrite /root fc0 oppr_eq0. - rewrite -negb_forall; apply/negP=> /'forall_existsP/fin_all_exists[/= rf rfP]. - suffices inj_rf: injective rf. - by have /negP[] := nz_f_0 (invF inj_rf 0); rewrite -{2}[0](f_invF inj_rf). - move=> a b eq_rf_ab; apply/oppr_inj/(addrI (rf a)). - have: (f a).[rf a] = (f b).[rf a] by rewrite {2}eq_rf_ab !(rootP _). - rewrite !(hornerXsubC, hornerD, hornerM) hornerX => /addIr/mulfI-> //. - rewrite mulf_neq0 ?subr_eq0 1?(contraTneq _ (rfP a)) // => -> //. - by rewrite /root fc2. -have{nz_fc} /= nz_fc: ~~ root (f c) _ by apply/forallP; rewrite -negb_exists. -have sz_fc_lhs: size ('X * ('X - 2%:R%:P) * ('X - c%:P)) = 4. - by rewrite !(size_mul, =^~ size_poly_eq0) ?size_polyX ?size_XsubC. -have sz_fc: size (f c) = 4 by rewrite size_addl ?size_XsubC sz_fc_lhs. -have irr_fc: irreducible_poly (f c) by apply: cubic_irreducible; rewrite ?sz_fc. -have fc_monic : f c \is monic. - rewrite monicE lead_coefDl ?size_XsubC ?sz_fc_lhs // -monicE. - by rewrite !monicMl ?monicXsubC ?monicX. -pose inF := [rmorphism of in_alg F]; pose fcF := map_poly inF (f c). -have /existsP[a fcFa_0]: [exists a : F, root fcF a]. - suffices: ~~ coprimep (f c) ('X ^+ #|F| - 'X). - apply: contraR; rewrite -(coprimep_map inF) negb_exists => /forallP-nz_fcF. - rewrite -/fcF rmorphB rmorphX /= map_polyX finField_genPoly. - elim/big_rec: _ => [|x gF _ co_fcFg]; first exact: coprimep1. - by rewrite coprimep_mulr coprimep_XsubC nz_fcF. - have /irredp_FAdjoin[L dimL [z /coprimep_root fcz0 _]] := irr_fc. - pose finL := [vectType 'F_p of FinFieldExtType L]. - set fcL := map_poly _ _ in fcz0; pose inL := [rmorphism of in_alg L]. - rewrite -(coprimep_map inL) -/fcL rmorphB rmorphX /= map_polyX. - apply: contraL (fcz0 _) _; rewrite hornerD hornerN hornerXn hornerX subr_eq0. - have ->: #|F| = #|{: finL}%VS| by rewrite oF card_vspace dimL sz_fc oF_p q3. - by rewrite card_vspacef (expf_card (z : finL)). -have Fp_fcF: fcF \is a polyOver Fp. - by apply/polyOverP => i; rewrite coef_map /= memvZ ?memv_line. -pose G := 'Gal(Fpq / Fp). -have galG: galois Fp Fpq by rewrite finField_galois ?subvf. -have oG: #|G| = 3 by rewrite -galois_dim // dimv1 dimFpq q3. -have Fp'a: a \notin Fp. - by apply: contraL fcFa_0 => /vlineP[d ->]; rewrite fmorph_root. -have DfcF: fcF = \prod_(beta in G) ('X - (beta a)%:P). - pose Pa : {poly F} := minPoly Fp a. - have /eqP szPa: size Pa == 4. - rewrite size_minPoly eqSS. - rewrite (sameP eqP (prime_nt_dvdP _ _)) ?adjoin_deg_eq1 //. - by rewrite adjoin_degreeE dimv1 divn1 -q3 -dimFpq field_dimS ?subvf. - have dvd_Pa_fcF: Pa %| fcF by apply: minPoly_dvdp fcFa_0. - have{dvd_Pa_fcF} /eqP <-: Pa == fcF. - rewrite -eqp_monic ?monic_minPoly ?monic_map // -dvdp_size_eqp //. - by rewrite szPa size_map_poly sz_fc. - have [r [srG /map_uniq Ur defPa]]:= galois_factors (subvf _) galG a (memvf a). - rewrite -/Pa big_map in defPa; rewrite defPa big_uniq //=. - apply/eq_bigl/subset_cardP=> //; apply/eqP. - by rewrite -eqSS (card_uniqP Ur) oG -szPa defPa size_prod_XsubC. -exists a; rewrite !inE; apply/and3P; split. -- by apply: contraNneq Fp'a => ->; apply: mem1v. -- apply/eqP; transitivity ((- 1) ^+ #|G| * fcF.[inF 0]). - rewrite DfcF horner_prod -prodrN; apply: eq_bigr => beta _. - by rewrite rmorph0 hornerXsubC add0r opprK. - by rewrite -signr_odd mulr_sign oG horner_map fc0 rmorphN1 opprK. -apply/eqP; transitivity (fcF.[inF 2%:R]); last by rewrite horner_map fc2 rmorph1. -rewrite DfcF horner_prod; apply: eq_bigr => beta _. -by rewrite hornerXsubC rmorphB !rmorph_nat. -Qed. - -Section AppendixC3. - -Import GroupScope. - -Variables y : gT. -Hypotheses (QP0y : y \in [~: Q, P0]) (nUP0y : P0 :^ y \subset 'N(U)). -Let Qy : y \in Q. Proof. by rewrite (subsetP sQP0Q). Qed. - -Let t := s ^ y. -Let P1 := P0 :^ y. - -(* This is B & G, Appendix C, Lemma C.3, Step 1. *) -Let splitH x : - x \in H -> - exists2 u, u \in U & exists2 v, v \in U & exists2 s1, s1 \in P0 - & x = u * s1 * v. -Proof. -case/(mem_sdprod defH) => z [v [Pz Uv -> _]]. -have [-> | nt_z] := eqVneq z 1. - by exists 1 => //; exists v => //; exists 1; rewrite ?mulg1. -have nz_z: sigma z != 0 by rewrite (morph_injm_eq1 inj_sigma). -have /(mem_dprod defFU)[]: finField_unit nz_z \in setT := in_setT _. -move=> _ [w [/morphimP[u Uu _ ->] Fp_w /(congr1 val)/= Dz _]]. -have{Fp_w Dz} [n Dz]: exists n, sigma z = sigma ((s ^+ n) ^ u). - move: Fp_w; rewrite {}Dz inE => /vlineP[n ->]; exists n. - by rewrite -{1}(natr_Zp n) scaler_nat mulr_natr conjXg !sigmaE ?in_PU. -exists u^-1; last exists (u * v); rewrite ?groupV ?groupM //. -exists (s ^+ n); rewrite ?groupX // mulgA; congr (_ * _). -by apply: (injmP inj_sigma); rewrite -?mulgA ?in_PU. -Qed. - -(* This is B & G, Appendix C, Lemma C.3, Step 2. *) -Let not_splitU s1 s2 u : - s1 \in P0 -> s2 \in P0 -> u \in U -> s1 * u * s2 \in U -> - (s1 == 1) && (s2 == 1) || (u == 1) && (s1 * s2 == 1). -Proof. -move=> P0s1 P0s2 Uu; have [_ _ _ tiPU] := sdprodP defH. -have [Ps1 Ps2]: s1 \in P /\ s2 \in P by rewrite !(subsetP sP0P). -have [-> | nt_s1 /=] := altP (s1 =P 1). - by rewrite mul1g groupMl // -in_set1 -set1gE -tiPU inE Ps2 => ->. -have [-> | nt_u /=] := altP (u =P 1). - by rewrite mulg1 -in_set1 -set1gE -tiPU inE (groupM Ps1). -rewrite (conjgC _ u) -mulgA groupMl // => Us12; case/negP: nt_u. -rewrite -(morph_injm_eq1 inj_sigmaU) // -in_set1 -set1gE. -have [_ _ _ <-] := dprodP defFU; rewrite !inE mem_morphim //= -/(psi u). -have{Us12}: s1 ^ u * s2 == 1. - by rewrite -in_set1 -set1gE -tiPU inE Us12 andbT !in_PU. -rewrite -(morph_injm_eq1 inj_sigma) ?(in_PU, sigmaE) // addr_eq0. -move/eqP/(canRL (mulKf _))->; rewrite ?morph_injm_eq1 //. -by rewrite mulrC rpred_div ?rpredN //= -sigmaP0 mem_morphim. -Qed. - -(* This is B & G, Appendix C, Lemma C.3, Step 3. *) -Let tiH_P1 t1 : t1 \in P1^# -> H :&: H :^ t1 = U. -Proof. -case/setD1P=>[nt_t1 P1t1]; set X := H :&: _. -have [nsPH sUH _ _ tiPU] := sdprod_context defH. -have sUX: U \subset X. - by rewrite subsetI sUH -(normsP nUP0y t1 P1t1) conjSg. -have defX: (P :&: X) * U = X. - by rewrite setIC group_modr // (sdprodW defH) setIAC setIid. -have [tiPX | ntPX] := eqVneq (P :&: X) 1; first by rewrite -defX tiPX mul1g. -have irrPU: acts_irreducibly U P 'J. - apply/mingroupP; (split=> [|V /andP[ntV]]; rewrite astabsJ) => [|nVU sVP]. - by have [_ ->] := Frobenius_context frobH. - apply/eqP; rewrite eqEsubset sVP; apply/subsetP=> x Px. - have [-> // | ntx] := eqVneq x 1. - have [z Vz ntz] := trivgPn _ ntV; have Pz := subsetP sVP z Vz. - have nz_z: sigma z != 0%R by rewrite morph_injm_eq1. - have uP: (sigma x / sigma z)%R \is a GRing.unit. - by rewrite unitfE mulf_neq0 ?invr_eq0 ?morph_injm_eq1. - have: FinRing.unit F uP \in setT := in_setT _. - case/(mem_dprod defFU)=> _ [s1 [/morphimP[u Uu _ ->]]]. - rewrite inE => /vlineP[n Ds1] /(congr1 val)/= Dx _. - suffices ->: x = (z ^ u) ^+ n by rewrite groupX ?memJ_norm ?(subsetP nVU). - apply: (injmP inj_sigma); rewrite ?(in_PU, sigmaE) //. - by rewrite -mulr_natr -scaler_nat natr_Zp -Ds1 -mulrA -Dx mulrC divfK. -have{ntPX defX irrPU} defX: X :=: H. - rewrite -(sdprodW defH) -defX; congr (_ * _). - have [_ -> //] := mingroupP irrPU; rewrite ?subsetIl //= -/X astabsJ ntPX. - by rewrite normsI // normsG. -have nHt1: t1 \in 'N(H) by rewrite -groupV inE sub_conjgV; apply/setIidPl. -have oP0: #|P0| = p by rewrite -(card_injm inj_sigma) // (eq_card sigmaP0) oFp. -have{nHt1} nHP1: P1 \subset 'N(H). - apply: prime_meetG; first by rewrite cardJg oP0. - by apply/trivgPn; exists t1; rewrite // inE P1t1. -have{nHP1} nPP1: P1 \subset 'N(P). - have /Hall_pi hallP: Hall H P by apply: Frobenius_ker_Hall frobH. - by rewrite -(normal_Hall_pcore hallP nsPH) gFnorm_trans. -have sylP0: p.-Sylow(Q <*> P0) P0. - rewrite /pHall -divgS joing_subr ?(pgroupS sP0P) //=. - by rewrite norm_joinEr // coprime_cardMg ?(coprimegS sP0P) ?mulnK. -have sP1QP0: P1 \subset Q <*> P0. - by rewrite conj_subG ?joing_subr ?mem_gen // inE Qy. -have nP10: P1 \subset 'N(P0). - have: P1 \subset 'N(P :&: (Q <*> P0)) by rewrite normsI // normsG. - by rewrite norm_joinEr // -group_modr // setIC coprime_TIg // mul1g. -have eqP10: P1 :=: P0. - apply/eqP; rewrite eqEcard cardJg leqnn andbT. - rewrite (comm_sub_max_pgroup (Hall_max sylP0)) //; last exact: normC. - by rewrite pgroupJ (pHall_pgroup sylP0). -have /idPn[] := prime_gt1 pr_p. -rewrite -oP0 cardG_gt1 negbK -subG1 -(Frobenius_trivg_cent frobH) subsetI sP0P. -apply/commG1P/trivgP; rewrite -tiPU commg_subI // subsetI ?subxx //. -by rewrite sP0P -eqP10. -Qed. - -(* This is B & G, Appendix C, Lemma C.3, Step 4. *) -Fact BGappendixC3_Ediv : E = [set x^-1 | x in E]%R. -Proof. -suffices sEV_E: [set x^-1 | x in E]%R \subset E. - by apply/esym/eqP; rewrite eqEcard sEV_E card_imset //=; apply: invr_inj. -have /mulG_sub[/(subset_trans sP0P)/subsetP-sP0H /subsetP-sUH] := sdprodW defH. -have Hs := sP0H s P0s; have P1t: t \in P1 by rewrite memJ_conjg. -have nUP1 t1: t1 \in P1 -> U :^ t1 = U by move/(subsetP nUP0y)/normP. -have nUtn n u: u \in U -> u ^ (t ^+ n) \in U. - by rewrite -mem_conjgV nUP1 ?groupV ?groupX. -have nUtVn n u: u \in U -> u ^ (t ^- n) \in U. - by rewrite -mem_conjg nUP1 ?groupX. -have Qsti i: s ^- i * t ^+ i \in Q. - by rewrite -conjXg -commgEl (subsetP sQP0Q) // commGC mem_commg ?groupX. -pose is_sUs m a j n u s1 v := - [/\ a \in U, u \in U, v \in U, s1 \in P0 - & s ^+ m * a ^ t ^+ j * s ^- n = u * s1 * v]. -have split_sUs m a j n: - a \in U -> exists u, exists s1, exists v, is_sUs m a j n u s1 v. -- move=> Ua; suffices: s ^+ m * a ^ t ^+ j * s ^- n \in H. - by case/splitH=> u Uu [v Uv [s1 P0s1 Dusv1]]; exists u, s1, v. - by rewrite 2?groupM ?groupV ?groupX // sUH ?nUtn. -have nt_sUs m j n a u s1 v: - (m == n.+1) || (n == m.+1) -> is_sUs m a j n u s1 v -> s1 != 1. -- move/pred2P=> Dmn [Ua Uu Uv _ Dusv]; have{Dmn}: s ^+ m != s ^+ n. - by case: Dmn => ->; last rewrite eq_sym; rewrite expgS eq_mulgV1 ?mulgK. - apply: contraNneq => s1_1; rewrite {s1}s1_1 mulg1 in Dusv. - have:= groupM Uu Uv; rewrite -Dusv => /(not_splitU _ _ (nUtn j a Ua))/orP. - by rewrite !in_group // eq_invg1 -eq_mulgV1 => -[]// /andP[? /eqP->]. -have sUs_modP m a j n u s1 v: is_sUs m a j n u s1 v -> a ^ t ^+ j = u * v. - have [nUP /isom_inj/injmP/=quoUP_inj] := sdprod_isom defH. - case=> Ua Uu Uv P0s1 /(congr1 (coset P)); rewrite (conjgCV u) -(mulgA _ u). - rewrite coset_kerr ?groupV 2?coset_kerl ?groupX //; last first. - by rewrite -mem_conjg (normsP nUP) // (subsetP sP0P). - by move/quoUP_inj->; rewrite ?nUtn ?groupM. -have expUMp u v Uu Uv := expgMn p (centsP cUU u v Uu Uv). -have sUsXp m a j n u s1 v: - is_sUs m a j n u s1 v -> is_sUs m (a ^+ p) j n (u ^+ p) s1 (v ^+ p). -- move=> Dusv; have{Dusv} [/sUs_modP Duv [Ua Uu Vv P0s1 Dusv]] := (Dusv, Dusv). - split; rewrite ?groupX //; move: P0s1 Dusv; rewrite -defP0 => /cycleP[k ->]. - rewrite conjXg -!(mulgA _ (s ^+ k)) ![s ^+ k * _]conjgC 2!mulgA -expUMp //. - rewrite {}Duv ![s ^+ m * _]conjgC !conjXg -![_ * _ * s ^- n]mulgA. - move/mulgI/(congr1 (Frobenius_aut charFp \o sigma))=> /= Duv_p. - congr (_ * _); apply/(injmP inj_sigma); rewrite ?in_PU //. - by rewrite !{1}sigmaE ?in_PU // rmorphB !rmorphMn rmorph1 in Duv_p *. -have odd_P: odd #|P| by rewrite oP odd_exp odd_p orbT. -suffices EpsiV a: a \in U -> psi a \in E -> psi (a^-1 ^ t ^+ 3) \in E. - apply/subsetP => _ /imsetP[x Ex ->]. - have /imsetP[a Ua Dx]: x \in psi @: U by rewrite im_psi; case/setIdP: Ex. - suffices: psi (a^-1 ^ t ^+ (3 * #|P|)) \in E. - rewrite Dx -psiV // -{2}(conjg1 a^-1); congr (psi (_ ^ _) \in E). - by apply/eqP; rewrite -order_dvdn orderJ dvdn_mull ?order_dvdG. - rewrite -(odd_double_half #|P|) odd_P addnC. - elim: _./2 => [|n /EpsiV/EpsiV/=]; first by rewrite EpsiV -?Dx. - by rewrite conjVg invgK -!conjgM -!expgD -!mulnSr !(groupV, nUtn) //; apply. -move=> Ua Ea; have{Ea} [b Ub Dab]: exists2 b, b \in U & psi a + psi b = 2%:R. - case/setIdP: Ea => _; rewrite -im_psi => /imsetP[b Ub Db]; exists b => //. - by rewrite -Db addrC subrK. -(* In the book k is arbitrary in Fp; however only k := 3 is used. *) -have [u2 [s2 [v2 usv2P]]] := split_sUs 3 (a * _) 2 1%N (groupM Ua (groupVr Ub)). -have{Ua} [u1 [s1 [v1 usv1P]]] := split_sUs 1%N a^-1 3 2 (groupVr Ua). -have{Ub} [u3 [s3 [v3 usv3P]]] := split_sUs 2 b 1%N 3 Ub. -pose s2def w1 w2 w3 := t * s2^-1 * t = w1 * s3 * w2 * t ^+ 2 * s1 * w3. -pose w1 := v2 ^ t^-1 * u3; pose w2 := v3 * u1 ^ t ^- 2; pose w3 := v1 * u2 ^ t. -have stXC m n: (m <= n)%N -> s ^- n ^ t ^+ m = s ^- m ^ t ^+ n * s ^- (n - m). - move/subnK=> Dn; apply/(mulgI (s ^- (n - m) * t ^+ n))/(mulIg (t ^+ (n - m))). - rewrite -{1}[in t ^+ n]Dn expgD !mulgA !mulgK -invMg -2!mulgA -!expgD. - by rewrite addnC Dn (centsP (abelem_abelian abelQ)) ?mulgA. -wlog suffices Ds2: a b u1 v1 u2 v2 u3 v3 @w1 @w2 @w3 Dab usv1P usv2P usv3P / - s2def w1 w2 w3; last first. -- apply/esym; rewrite -[_ * t]mulgA [_ * t]conjgC mulgA -(expgS _ 1) conjVg. - rewrite /w2 mulgA; apply: (canRL (mulKVg _)); rewrite 2!mulgA -conjgE. - rewrite conjMg conjgKV /w3 mulgA; apply: (canLR (mulgKV _)). - rewrite /w1 -4!mulgA (mulgA u1) (mulgA u3) conjMg -conjgM mulKg -mulgA. - have [[[Ua _ _ _ <-] [_ _ _ _ Ds2]] [Ub _ _ _ <-]] := (usv1P, usv2P, usv3P). - apply: (canLR (mulKVg _)); rewrite -!invMg -!conjMg -{}Ds2 groupV in Ua *. - rewrite -[t]expg1 2!conjMg -conjgM -expgS 2!conjMg -conjgM -expgSr mulgA. - apply: (canLR (mulgK _)); rewrite 2!invMg -!conjVg invgK invMg invgK -4!mulgA. - rewrite (mulgA _ s) stXC // mulgKV -!conjMg stXC // mulgKV -conjMg conjgM. - apply: (canLR (mulKVg _)); rewrite -2!conjVg 2!mulgA -conjMg (stXC 1%N) //. - rewrite mulgKV -conjgM -expgSr -mulgA -!conjMg; congr (_ ^ t ^+ 3). - apply/(canLR (mulKVg _))/(canLR (mulgK _))/(canLR invgK). - rewrite -!mulgA (mulgA _ b) mulgA invMg -!conjVg !invgK. - by apply/(injmP inj_sigma); rewrite 1?groupM ?sigmaE ?memJ_P. -have [[Ua Uu1 Uv1 P0s1 Dusv1] /sUs_modP-Duv1] := (usv1P, usv1P). -have [[_ Uu2 Uv2 P0s2 _] [Ub Uu3 Uv3 P0s3 _]] := (usv2P, usv3P). -suffices /(congr1 sigma): s ^+ 2 = s ^ v1 * s ^ a^-1 ^ t ^+ 3. - rewrite inE sigmaX // sigma_s sigmaM ?memJ_P -?psiE ?nUtn // => ->. - by rewrite addrK -!im_psi !mem_imset ?nUtn. -rewrite groupV in Ua; have [Hs1 Hs3]: s1 \in H /\ s3 \in H by rewrite !sP0H. -have nt_s1: s1 != 1 by apply: nt_sUs usv1P. -have nt_s3: s3 != 1 by apply: nt_sUs usv3P. -have{sUsXp} Ds2p: s2def (w1 ^+ p) (w2 ^+ p) (w3 ^+ p). - have [/sUsXp-usv1pP /sUsXp-usv2pP /sUsXp-usv3pP] := And3 usv1P usv2P usv3P. - rewrite expUMp ?groupV // !expgVn in usv1pP usv2pP. - rewrite !(=^~ conjXg _ _ p, expUMp) ?groupV -1?[t]expg1 ?nUtn ?nUtVn //. - apply: Ds2 usv1pP usv2pP usv3pP => //. - by rewrite !psiX // -!Frobenius_autE -rmorphD Dab rmorph_nat. -have{Ds2} Ds2: s2def w1 w2 w3 by apply: Ds2 usv1P usv2P usv3P. -wlog [Uw1 Uw2 Uw3]: w1 w2 w3 Ds2p Ds2 / [/\ w1 \in U, w2 \in U & w3 \in U]. - by move/(_ w1 w2 w3)->; rewrite ?(nUtVn, nUtVn 1%N, nUtn 1%N, in_group). -have{Ds2p} Dw3p: (w2 ^- p * w1 ^- p.-1 ^ s3 * w2) ^ t ^+ 2 = w3 ^+ p.-1 ^ s1^-1. - rewrite -[w1 ^+ _](mulKg w1) -[w3 ^+ _](mulgK w3) -expgS -expgSr !prednK //. - rewrite -(canLR (mulKg _) Ds2p) -(canLR (mulKg _) Ds2) 6!invMg !invgK. - by rewrite mulgA mulgK [2]lock /conjg !mulgA mulVg mul1g mulgK. -have w_id w: w \in U -> w ^+ p.-1 == 1 -> w = 1. - by move=> Uw /eqP/(canRL_in (expgK _) Uw)->; rewrite ?expg1n ?oU. -have{Uw3} Dw3: w3 = 1. - apply: w_id => //; have:= @not_splitU s1^-1^-1 s1^-1 (w3 ^+ p.-1). - rewrite !groupV mulVg eqxx andbT {2}invgK (negPf nt_s1) groupX //= => -> //. - have /tiH_P1 <-: t ^+ 2 \in P1^#. - rewrite 2!inE groupX // andbT -order_dvdn gtnNdvd // orderJ. - by rewrite odd_gt2 ?order_gt1 // orderE defP0 (oddSg sP0P). - by rewrite -mulgA -conjgE inE -{2}Dw3p memJ_conjg !in_group ?Hs1 // sUH. -have{Dw3p} Dw2p: w2 ^+ p.-1 = w1 ^- p.-1 ^ s3. - apply/(mulIg w2)/eqP; rewrite -expgSr prednK // eq_mulVg1 mulgA. - by rewrite (canRL (conjgK _) Dw3p) Dw3 expg1n !conj1g. -have{Uw1} Dw1: w1 = 1. - apply: w_id => //; have:= @not_splitU s3^-1 s3 (w1 ^- p.-1). - rewrite mulVg (negPf nt_s3) andbF -mulgA -conjgE -Dw2p !in_group //=. - by rewrite eqxx andbT eq_invg1 /= => ->. -have{w1 w2 w3 Dw1 Dw3 w_id Uw2 Dw2p Ds2} Ds2: t * s2^-1 * t = s3 * t ^+ 2 * s1. - by rewrite Ds2 Dw3 [w2]w_id ?mulg1 ?Dw2p ?Dw1 ?mul1g // expg1n invg1 conj1g. -have /centsP abP0: abelian P0 by rewrite -defP0 cycle_abelian. -have QP0ys := memJ_norm y (subsetP (commg_normr P0 Q) _ _). -have{QP0ys} memQP0 := (QP0ys, groupV, groupM); have nQ_P0 := subsetP nQP0. -have sQP0_Q: [~: Q, P0] \subset Q by rewrite commg_subl. -have /centsP abQP0 := abelianS sQP0_Q (abelem_abelian abelQ). -have{s2def} Ds312: s3 * s1 * s2 = 1. - apply/set1P; rewrite -set1gE -(coprime_TIg coQP) inE. - rewrite coset_idr ?(subsetP sP0P) ?nQ_P0 ?groupM //. - rewrite -mulgA -[s2](mulgK s) [_ * s]abP0 // -[s2](mulKVg s). - rewrite -!mulgA [s * _]mulgA [s1 * _]mulgA [s1 * _]abP0 ?groupM //. - rewrite 2!(mulgA s3) [s^-1 * _]mulgA !(morphM, morphV) ?nQ_P0 ?in_group //=. - have ->: coset Q s = coset Q t by rewrite coset_kerl ?groupV ?coset_kerr. - have nQt: t \in 'N(Q) by rewrite -(conjGid Qy) normJ memJ_conjg nQ_P0. - rewrite -morphV // -!morphM ?(nQt, groupM) ?groupV // ?nQ_P0 //= -Ds2. - by rewrite 2!mulgA mulgK mulgKV mulgV morph1. -pose x := (y ^ s3)^-1 * y ^ s^-1 * (y ^ (s * s1)^-1)^-1 * y. -have{abP0} Dx: x ^ s^-1 = x. - rewrite 3!conjMg !conjVg -!conjgM -!invMg (mulgA s) -(expgS _ 1). - rewrite [x]abQP0 ?memQP0 // [rhs in y * rhs]abQP0 ?memQP0 //. - apply/(canRL (mulKVg _)); rewrite 4!mulgA; congr (_ * _). - rewrite [RHS]abQP0 ?memQP0 //; apply/(canRL (mulgK _))/eqP. - rewrite -3!mulgA [rhs in y^-1 * rhs]abQP0 ?memQP0 // -eq_invg_sym eq_invg_mul. - apply/eqP; transitivity (t ^+ 2 * s1 * (t^-1 * s2 * t^-1) * s3); last first. - by rewrite -[s2]invgK -!invMg mulgA Ds2 -(mulgA s3) invMg mulKVg mulVg. - rewrite (canRL (mulKg _) Ds312) -2![_ * t^-1]mulgA. - have Dt1 si: si \in P0 -> t^-1 = (s^-1 ^ si) ^ y. - by move=> P0si; rewrite {2}/conjg -conjVg -(abP0 si) ?groupV ?mulKg. - by rewrite {1}(Dt1 s1) // (Dt1 s3^-1) ?groupV // -conjXg /conjg !{1}gnorm. -have{Dx memQP0} Dx1: x = 1. - apply/set1P; rewrite -set1gE; have [_ _ _ <-] := dprodP defQ. - rewrite setIAC (setIidPr sQP0_Q) inE -{2}defP0 -cycleV cent_cycle. - by rewrite (sameP cent1P commgP) commgEl Dx mulVg eqxx !memQP0. -pose t1 := s1 ^ y; pose t3 := s3 ^ y. -have{x Dx1} Ds13: s1 * (t * t1)^-1 = (t3 * t)^-1 * s3. - by apply/eqP; rewrite eq_sym eq_mulVg1 invMg invgK -Dx1 /x /conjg !gnorm. -suffices Ds1: s1 = s^-1. - rewrite -(canLR (mulKg _) (canRL (mulgKV _) Dusv1)) Ds1 Duv1. - by rewrite !invMg invgK /conjg !gnorm. -have [_ _ /trivgPn[u Uu nt_u] _ _] := Frobenius_context frobH. -apply: (conjg_inj y); apply: contraNeq nt_u. -rewrite -/t1 conjVg -/t eq_mulVg1 -invMg => nt_tt1. -have Hu := sUH u Uu; have P1tt1: t * t1 \in P1 by rewrite groupM ?memJ_conjg. -have /tiH_P1 defU: (t * t1)^-1 \in P1^# by rewrite 2!inE nt_tt1 groupV. -suffices: (u ^ s1) ^ (t * t1)^-1 \in U. - rewrite -mem_conjg nUP1 // conjgE mulgA => /(not_splitU _ _ Uu). - by rewrite groupV (negPf nt_s1) andbF mulVg eqxx andbT /= => /(_ _ _)/eqP->. -rewrite -defU inE memJ_conjg -conjgM Ds13 conjgM groupJ ?(groupJ _ Hs1) //. -by rewrite sUH // -mem_conjg nUP1 // groupM ?memJ_conjg. -Qed. - -End AppendixC3. - -Fact BGappendixC_inner_subproof : (p <= q)%N. -Proof. -have [y QP0y nUP0y] := nU_P0QP0. -by apply: Einv_gt1_le_pq E_gt1; apply: BGappendixC3_Ediv nUP0y. -Qed. - -End ExpandHypotheses. - -(* This is B & G, Appendix C, Theorem C. *) -Theorem prime_dim_normed_finField : (p <= q)%N. -Proof. -apply: wlog_neg; rewrite -ltnNge => ltqp. -have [F sigma /isomP[inj_sigma im_sigma] defP0] := fieldH. -case=> sigmaU inj_sigmaU sigmaJ. -have oF: #|F| = (p ^ q)%N by rewrite -cardsT -im_sigma card_injm. -have charFp: p \in [char F] := card_finCharP oF pr_p. -have sP0P: P0 \subset P by rewrite -defP0 subsetIl. -pose s := invm inj_sigma 1%R. -have sigma_s: sigma s = 1%R by rewrite invmK ?im_sigma ?inE. -have{defP0} defP0: <[s]> = P0. - by rewrite -morphim_cycle /= ?im_sigma ?inE // morphim_invmE. -exact: BGappendixC_inner_subproof defP0 sigmaJ. -Qed. - -End AppendixC. diff --git a/mathcomp/odd_order/BGsection1.v b/mathcomp/odd_order/BGsection1.v deleted file mode 100644 index 3230da2..0000000 --- a/mathcomp/odd_order/BGsection1.v +++ /dev/null @@ -1,1343 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div fintype. -From mathcomp -Require Import bigop prime binomial finset fingroup morphism perm automorphism. -From mathcomp -Require Import quotient action gproduct gfunctor commutator. -From mathcomp -Require Import ssralg finalg zmodp cyclic center pgroup finmodule gseries. -From mathcomp -Require Import nilpotent sylow abelian maximal hall extremal. -From mathcomp -Require Import matrix mxalgebra mxrepresentation mxabelem. - -(******************************************************************************) -(* This file contains most of the material in B & G, section 1, including the *) -(* definitions: *) -(* p.-length_1 G == the upper p-series of G has length <= 1, i.e., *) -(* 'O_{p^',p,p^'}(G) = G *) -(* p_elt_gen p G == the subgroup of G generated by its p-elements. *) -(* This file currently covers B & G 1.3-4, 1.6, 1.8-1.21, and also *) -(* Gorenstein 8.1.3 and 2.8.1 (maximal order of a p-subgroup of GL(2,p)). *) -(* This file also provides, mostly for future reference, the following *) -(* definitions, drawn from Gorenstein, Chapter 8, and B & G, Appendix B: *) -(* p.-constrained G <-> the p',p core of G contains the centralisers of *) -(* all its Sylow p-subgroups. The Hall-Higman Lemma *) -(* 1.2.3 (B & G, 1.15a) asserts that this holds for *) -(* all solvable groups. *) -(* p.-stable G <-> a rather group theoretic generalization of the *) -(* Hall-Higman type condition that in a faithful *) -(* p-modular linear representation of G no p-element *) -(* has a quadratic minimal polynomial, to groups G *) -(* with a non-trivial p-core. *) -(* p.-abelian_constrained <-> the p',p core of G contains all the normal *) -(* abelian subgroups of the Sylow p-subgroups of G. *) -(* It is via this property and the ZL theorem (the *) -(* substitute for the ZJ theorem) that the *) -(* p-stability of groups of odd order is exploited *) -(* in the proof of the Odd Order Theorem. *) -(* generated_by p G == G is generated by a set of subgroups satisfying *) -(* p : pred {group gT} *) -(* norm_abelian X A == A is abelian and normalised by X. *) -(* p_norm_abelian p X A == A is an abelian p-group normalised by X. *) -(* 'L_[G](X) == the group generated by the abelian subgroups of G *) -(* normalized by X. *) -(* 'L_{n}(G) == the Puig group series, defined by the recurrence *) -(* 'L_{0}(G) = 1, 'L_{n.+1}(G) = 'L_[G]('L_{n}(G)). *) -(* 'L_*(G) == the lower limit of the Puig series. *) -(* 'L(G) == the Puig subgroup: the upper limit of the Puig *) -(* series: 'L(G) = 'L_[G]('L_*(G)) and conversely. *) -(* The following notation is used locally here and in AppendixB, but is NOT *) -(* exported: *) -(* D --> G == G is generated by abelian groups normalised by D *) -(* := generated_by (norm_abelian D) G *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope. - -Section Definitions. - -Variables (n : nat) (gT : finGroupType). -Implicit Type p : nat. - -Definition plength_1 p (G : {set gT}) := 'O_{p^', p, p^'}(G) == G. - -Definition p_elt_gen p (G : {set gT}) := <<[set x in G | p.-elt x]>>. - -Definition p_constrained p (G : {set gT}) := - forall P : {group gT}, - p.-Sylow('O_{p^',p}(G)) P -> - 'C_G(P) \subset 'O_{p^',p}(G). - -Definition p_abelian_constrained p (G : {set gT}) := - forall S A : {group gT}, - p.-Sylow(G) S -> abelian A -> A <| S -> - A \subset 'O_{p^',p}(G). - -Definition p_stable p (G : {set gT}) := - forall P A : {group gT}, - p.-group P -> 'O_p^'(G) * P <| G -> - p.-subgroup('N_G(P)) A -> [~: P, A, A] = 1 -> - A / 'C_G(P) \subset 'O_p('N_G(P) / 'C_G(P)). - -Definition generated_by (gp : pred {group gT}) (E : {set gT}) := - [exists gE : {set {group gT}}, <<\bigcup_(G in gE | gp G) G>> == E]. - -Definition norm_abelian (D : {set gT}) : pred {group gT} := - fun A => (D \subset 'N(A)) && abelian A. - -Definition p_norm_abelian p (D : {set gT}) : pred {group gT} := - fun A => p.-group A && norm_abelian D A. - -Definition Puig_succ (D E : {set gT}) := - <<\bigcup_(A in subgroups D | norm_abelian E A) A>>. - -Definition Puig_rec D := iter n (Puig_succ D) 1. - -End Definitions. - -(* This must be defined outside a Section to avoid spurrious delta-reduction *) -Definition Puig_at := nosimpl Puig_rec. - -Definition Puig_inf (gT : finGroupType) (G : {set gT}) := Puig_at #|G|.*2 G. - -Definition Puig (gT : finGroupType) (G : {set gT}) := Puig_at #|G|.*2.+1 G. - -Notation "p .-length_1" := (plength_1 p) - (at level 2, format "p .-length_1") : group_scope. - -Notation "p .-constrained" := (p_constrained p) - (at level 2, format "p .-constrained") : group_scope. -Notation "p .-abelian_constrained" := (p_abelian_constrained p) - (at level 2, format "p .-abelian_constrained") : group_scope. -Notation "p .-stable" := (p_stable p) - (at level 2, format "p .-stable") : group_scope. - -Notation "''L_[' G ] ( L )" := (Puig_succ G L) - (at level 8, format "''L_[' G ] ( L )") : group_scope. -Notation "''L_{' n } ( G )" := (Puig_at n G) - (at level 8, format "''L_{' n } ( G )") : group_scope. -Notation "''L_*' ( G )" := (Puig_inf G) - (at level 8, format "''L_*' ( G )") : group_scope. -Notation "''L' ( G )" := (Puig G) - (at level 8, format "''L' ( G )") : group_scope. - -Section BGsection1. - -Implicit Types (gT : finGroupType) (p : nat). - -(* This is B & G, Lemma 1.1, first part. *) -Lemma minnormal_solvable_abelem gT (M G : {group gT}) : - minnormal M G -> solvable M -> is_abelem M. -Proof. by move=> minM solM; case: (minnormal_solvable minM (subxx _) solM). Qed. - -(* This is B & G, Lemma 1.2, second part. *) -Lemma minnormal_solvable_Fitting_center gT (M G : {group gT}) : - minnormal M G -> M \subset G -> solvable M -> M \subset 'Z('F(G)). -Proof. -have nZG: 'Z('F(G)) <| G by rewrite !gFnormal_trans. -move=> minM sMG solM; have[/andP[ntM nMG] minM'] := mingroupP minM. -apply/setIidPl/minM'; last exact: subsetIl. -apply/andP; split; last by rewrite normsI // normal_norm. -apply: meet_center_nil => //; first by apply: Fitting_nil. -apply/andP; split; last exact: gFsub_trans. -apply: Fitting_max; rewrite // /normal ?sMG //; apply: abelian_nil. -by move: (minnormal_solvable_abelem minM solM) => /abelem_abelian. -Qed. - -Lemma sol_chief_abelem gT (G V U : {group gT}) : - solvable G -> chief_factor G V U -> is_abelem (U / V). -Proof. -move=> solG chiefUV; have minUV := chief_factor_minnormal chiefUV. -have [|//] := minnormal_solvable minUV (quotientS _ _) (quotient_sol _ solG). -by case/and3P: chiefUV. -Qed. - -Section HallLemma. - -Variables (gT : finGroupType) (G G' : {group gT}). - -Hypothesis solG : solvable G. -Hypothesis nsG'G : G' <| G. - -Let sG'G : G' \subset G. Proof. exact: normal_sub. Qed. -Let nG'G : G \subset 'N(G'). Proof. exact: normal_norm. Qed. -Let nsF'G : 'F(G') <| G. Proof. exact: gFnormal_trans. Qed. - -Let Gchief (UV : {group gT} * {group gT}) := chief_factor G UV.2 UV.1. -Let H := \bigcap_(UV | Gchief UV) 'C(UV.1 / UV.2 | 'Q). -Let H' := - G' :&: \bigcap_(UV | Gchief UV && (UV.1 \subset 'F(G'))) 'C(UV.1 / UV.2 | 'Q). - -(* This is B & G Proposition 1.2, non trivial inclusion of the first equality.*) -Proposition Fitting_stab_chief : 'F(G') \subset H. -Proof. -apply/bigcapsP=> [[U V] /= chiefUV]. -have minUV: minnormal (U / V) (G / V) := chief_factor_minnormal chiefUV. -have{chiefUV} [/=/maxgroupp/andP[_ nVG] sUG nUG] := and3P chiefUV. -have solUV: solvable (U / V) by rewrite quotient_sol // (solvableS sUG). -have{solUV minUV}: U / V \subset 'Z('F(G / V)). - exact: minnormal_solvable_Fitting_center minUV (quotientS V sUG) solUV. -rewrite sub_astabQ gFsub_trans ?(subset_trans sG'G) //=. -case/subsetIP=> _; rewrite centsC; apply: subset_trans. -by rewrite Fitting_max ?quotient_normal ?quotient_nil ?Fitting_nil. -Qed. - -(* This is B & G Proposition 1.2, non trivial inclusion of the second *) -(* equality. *) -Proposition chief_stab_sub_Fitting : H' \subset 'F(G'). -Proof. -without loss: / {K | [min K | K <| G & ~~ (K \subset 'F(G'))] & K \subset H'}. - move=> IH; apply: wlog_neg => s'H'F; apply/IH/mingroup_exists=> {IH}/=. - rewrite /normal subIset ?sG'G ?normsI ?norms_bigcap {s'H'F}//. - apply/bigcapsP=> /= U /andP[/and3P[/maxgroupp/andP/=[_ nU2G] _ nU1G] _]. - exact: subset_trans (actsQ nU2G nU1G) (astab_norm 'Q (U.1 / U.2)). -case=> K /mingroupP[/andP[nsKG s'KF] minK] /subsetIP[sKG' nFK]. -have [[Ks chiefKs defK] sKG]:= (chief_series_exists nsKG, normal_sub nsKG). -suffices{nsKG s'KF} cKsK: (K.-central).-series 1%G Ks. - by rewrite Fitting_max ?(normalS _ sG'G) ?(centrals_nil cKsK) in s'KF. -move: chiefKs; rewrite -!(rev_path _ _ Ks) {}defK. -case: {Ks}(rev _) => //= K1 Kr /andP[chiefK1 chiefKr]. -have [/maxgroupp/andP[/andP[sK1K ltK1K] nK1G] _] := andP chiefK1. -suffices{chiefK1} cKrK: [rel U V | central_factor K V U].-series K1 Kr. - have cKK1: abelian (K / K1) := abelem_abelian (sol_chief_abelem solG chiefK1). - by rewrite /central_factor subxx sK1K der1_min //= (subset_trans sKG). -have{minK ltK1K nK1G} sK1F: K1 \subset 'F(G'). - have nsK1G: K1 <| G by rewrite /normal (subset_trans sK1K). - by apply: contraR ltK1K => s'K1F; rewrite (minK K1) ?nsK1G. -elim: Kr K1 chiefKr => //= K2 Kr IHr K1 /andP[chiefK2 chiefKr] in sK1F sK1K *. -have [/maxgroupp/andP[/andP[sK21 _] /(subset_trans sKG)nK2K] _] := andP chiefK2. -rewrite /central_factor sK1K {}IHr ?(subset_trans sK21) {chiefKr}// !andbT. -rewrite commGC -sub_astabQR ?(subset_trans _ nK2K) //. -exact/(subset_trans nFK)/(bigcap_inf (K1, K2))/andP. -Qed. - -End HallLemma. - -(* This is B & G, Proposition 1.3 (due to P. Hall). *) -Proposition cent_sub_Fitting gT (G : {group gT}) : - solvable G -> 'C_G('F(G)) \subset 'F(G). -Proof. -move=> solG; apply: subset_trans (chief_stab_sub_Fitting solG _) => //. -rewrite subsetI subsetIl; apply/bigcapsP=> [[U V]] /=. -case/andP=> /andP[/maxgroupp/andP[_ nVG] _] sUF. -by rewrite astabQ (subset_trans _ (morphpre_cent _ _)) // setISS ?centS. -Qed. - -(* This is B & G, Proposition 1.4, for internal actions. *) -Proposition coprime_trivg_cent_Fitting gT (A G : {group gT}) : - A \subset 'N(G) -> coprime #|G| #|A| -> solvable G -> - 'C_A(G) = 1 -> 'C_A('F(G)) = 1. -Proof. -move=> nGA coGA solG regAG; without loss cycA: A nGA coGA regAG / cyclic A. - move=> IH; apply/trivgP/subsetP=> a; rewrite -!cycle_subG subsetI. - case/andP=> saA /setIidPl <-. - rewrite {}IH ?cycle_cyclic ?(coprimegS saA) ?(subset_trans saA) //. - by apply/trivgP; rewrite -regAG setSI. -pose X := G <*> A; pose F := 'F(X); pose pi := \pi(A); pose Q := 'O_pi(F). -have pi'G: pi^'.-group G by rewrite /pgroup -coprime_pi' //= coprime_sym. -have piA: pi.-group A by apply: pgroup_pi. -have oX: #|X| = (#|G| * #|A|)%N by rewrite [X]norm_joinEr ?coprime_cardMg. -have hallG: pi^'.-Hall(X) G. - by rewrite /pHall -divgS joing_subl //= pi'G pnatNK oX mulKn. -have nsGX: G <| X by rewrite /normal joing_subl join_subG normG. -have{oX pi'G piA} hallA: pi.-Hall(X) A. - by rewrite /pHall -divgS joing_subr //= piA oX mulnK. -have nsQX: Q <| X by rewrite !gFnormal_trans. -have{solG cycA} solX: solvable X. - rewrite (series_sol nsGX) {}solG /= norm_joinEr // quotientMidl //. - by rewrite morphim_sol // abelian_sol // cyclic_abelian. -have sQA: Q \subset A. - by apply: normal_sub_max_pgroup (Hall_max hallA) (pcore_pgroup _ _) nsQX. -have pi'F: 'O_pi(F) = 1. - suff cQG: G \subset 'C(Q) by apply/trivgP; rewrite -regAG subsetI sQA centsC. - apply/commG1P/trivgP; rewrite -(coprime_TIg coGA) subsetI commg_subl. - rewrite (subset_trans sQA) // (subset_trans _ sQA) // commg_subr. - by rewrite (subset_trans _ (normal_norm nsQX)) ?joing_subl. -have sFG: F \subset G. - have /dprodP[_ defF _ _]: _ = F := nilpotent_pcoreC pi (Fitting_nil _). - by rewrite (sub_normal_Hall hallG) ?gFsub //= -defF pi'F mul1g pcore_pgroup. -have <-: F = 'F(G). - apply/eqP; rewrite eqEsubset -{1}(setIidPr sFG) FittingS ?joing_subl //=. - by rewrite Fitting_max ?Fitting_nil // gFnormal_trans. -apply/trivgP; rewrite /= -(coprime_TIg coGA) subsetI subsetIl andbT. -apply: subset_trans (subset_trans (cent_sub_Fitting solX) sFG). -by rewrite setSI ?joing_subr. -Qed. - -(* A "contrapositive" of Proposition 1.4 above. *) -Proposition coprime_cent_Fitting gT (A G : {group gT}) : - A \subset 'N(G) -> coprime #|G| #|A| -> solvable G -> - 'C_A('F(G)) \subset 'C(G). -Proof. -move=> nGA coGA solG; apply: subset_trans (subsetIr A _); set C := 'C_A(G). -rewrite -quotient_sub1 /= -/C; last first. - by rewrite subIset // normsI ?normG // norms_cent. -apply: subset_trans (quotient_subcent _ _ _) _; rewrite /= -/C. -have nCG: G \subset 'N(C) by rewrite cents_norm // centsC subsetIr. -rewrite /= -(setIidPr (Fitting_sub _)) -[(G :&: _) / _](morphim_restrm nCG). -rewrite injmF //=; last first. - by rewrite ker_restrm ker_coset setIA (coprime_TIg coGA) subIset ?subxx. -rewrite morphim_restrm -quotientE setIid. -rewrite coprime_trivg_cent_Fitting ?quotient_norms ?coprime_morph //=. - exact: morphim_sol. -rewrite -strongest_coprime_quotient_cent ?trivg_quotient ?solG ?orbT //. - by rewrite -setIA subsetIl. -by rewrite coprime_sym -setIA (coprimegS (subsetIl _ _)). -Qed. - -(* B & G Proposition 1.5 is covered by several lemmas in hall.v : *) -(* 1.5a -> coprime_Hall_exists (internal action) *) -(* ext_coprime_Hall_exists (general group action) *) -(* 1.5b -> coprime_Hall_subset (internal action) *) -(* ext_coprime_Hall_subset (general group action) *) -(* 1.5c -> coprime_Hall_trans (internal action) *) -(* ext_coprime_Hall_trans (general group action) *) -(* 1.5d -> coprime_quotient_cent (internal action) *) -(* ext_coprime_quotient_cent (general group action) *) -(* several stronger variants are proved for internal action *) -(* 1.5e -> coprime_comm_pcore (internal action only) *) - -(* A stronger variant of B & G, Proposition 1.6(a). *) -Proposition coprimeR_cent_prod gT (A G : {group gT}) : - A \subset 'N(G) -> coprime #|[~: G, A]| #|A| -> solvable [~: G, A] -> - [~: G, A] * 'C_G(A) = G. -Proof. -move=> nGA coRA solR; apply/eqP; rewrite eqEsubset mulG_subG commg_subl nGA. -rewrite subsetIl -quotientSK ?commg_norml //=. -rewrite coprime_norm_quotient_cent ?commg_normr //=. -by rewrite subsetI subxx quotient_cents2r. -Qed. - -(* This is B & G, Proposition 1.6(a). *) -Proposition coprime_cent_prod gT (A G : {group gT}) : - A \subset 'N(G) -> coprime #|G| #|A| -> solvable G -> - [~: G, A] * 'C_G(A) = G. -Proof. -move=> nGA; have sRG: [~: G, A] \subset G by rewrite commg_subl. -rewrite -(Lagrange sRG) coprime_mull => /andP[coRA _] /(solvableS sRG). -exact: coprimeR_cent_prod. -Qed. - -(* This is B & G, Proposition 1.6(b). *) -Proposition coprime_commGid gT (A G : {group gT}) : - A \subset 'N(G) -> coprime #|G| #|A| -> solvable G -> - [~: G, A, A] = [~: G, A]. -Proof. -move=> nGA coGA solG; apply/eqP; rewrite eqEsubset commSg ?commg_subl //. -have nAC: 'C_G(A) \subset 'N(A) by rewrite subIset ?cent_sub ?orbT. -rewrite -{1}(coprime_cent_prod nGA) // commMG //=; first 1 last. - by rewrite !normsR // subIset ?normG. -by rewrite (commG1P (subsetIr _ _)) mulg1. -Qed. - -(* This is B & G, Proposition 1.6(c). *) -Proposition coprime_commGG1P gT (A G : {group gT}) : - A \subset 'N(G) -> coprime #|G| #|A| -> solvable G -> - [~: G, A, A] = 1 -> A \subset 'C(G). -Proof. -by move=> nGA coGA solG; rewrite centsC coprime_commGid // => /commG1P. -Qed. - -(* This is B & G, Proposition 1.6(d), TI-part, from finmod.v *) -Definition coprime_abel_cent_TI := coprime_abel_cent_TI. - -(* This is B & G, Proposition 1.6(d) (direct product) *) -Proposition coprime_abelian_cent_dprod gT (A G : {group gT}) : - A \subset 'N(G) -> coprime #|G| #|A| -> abelian G -> - [~: G, A] \x 'C_G(A) = G. -Proof. -move=> nGA coGA abelG; rewrite dprodE ?coprime_cent_prod ?abelian_sol //. - by rewrite subIset 1?(subset_trans abelG) // centS // commg_subl. -by apply/trivgP; rewrite /= setICA coprime_abel_cent_TI ?subsetIr. -Qed. - -(* This is B & G, Proposition 1.6(e), which generalises Aschbacher (24.3). *) -Proposition coprime_abelian_faithful_Ohm1 gT (A G : {group gT}) : - A \subset 'N(G) -> coprime #|G| #|A| -> abelian G -> - A \subset 'C('Ohm_1(G)) -> A \subset 'C(G). -Proof. -move=> nGA coGA cGG; rewrite !(centsC A) => cAG1. -have /dprodP[_ defG _ tiRC] := coprime_abelian_cent_dprod nGA coGA cGG. -have sRG: [~: G, A] \subset G by rewrite commg_subl. -rewrite -{}defG -(setIidPl sRG) TI_Ohm1 ?mul1g ?subsetIr //. -by apply/trivgP; rewrite -{}tiRC setIS // subsetI Ohm_sub. -Qed. - -(* B & G, Lemma 1.7 is covered by several lemmas in maximal.v : *) -(* 1.7a -> Phi_nongen *) -(* 1.7b -> Phi_quotient_abelem *) -(* 1.7c -> trivg_Phi *) -(* 1.7d -> Phi_joing *) - -(* This is B & G, Proposition 1.8, or Aschbacher 24.1. Note that the coprime *) -(* assumption is slightly weaker than requiring that A be a p'-group. *) -Proposition coprime_cent_Phi gT p (A G : {group gT}) : - p.-group G -> coprime #|G| #|A| -> [~: G, A] \subset 'Phi(G) -> - A \subset 'C(G). -Proof. -move=> pG coGA sRphi; rewrite centsC; apply/setIidPl. -rewrite -['C_G(A)]genGid; apply/Phi_nongen/eqP. -rewrite eqEsubset join_subG Phi_sub subsetIl -genM_join sub_gen //=. -rewrite -{1}(coprime_cent_prod _ coGA) ?(pgroup_sol pG) ?mulSg //. -by rewrite -commg_subl (subset_trans sRphi) ?Phi_sub. -Qed. - -(* This is B & G, Proposition 1.9, base (and most common) case, for internal *) -(* coprime action. *) -Proposition stable_factor_cent gT (A G H : {group gT}) : - A \subset 'C(H) -> stable_factor A H G -> - coprime #|G| #|A| -> solvable G -> - A \subset 'C(G). -Proof. -move=> cHA /and3P[sRH sHG nHG] coGA solG. -suffices: G \subset 'C_G(A) by rewrite subsetI subxx centsC. -rewrite -(quotientSGK nHG) ?subsetI ?sHG 1?centsC //. -by rewrite coprime_quotient_cent ?cents_norm ?subsetI ?subxx ?quotient_cents2r. -Qed. - -(* This is B & G, Proposition 1.9 (for internal coprime action) *) -Proposition stable_series_cent gT (A G : {group gT}) s : - last 1%G s :=: G -> (A.-stable).-series 1%G s -> - coprime #|G| #|A| -> solvable G -> - A \subset 'C(G). -Proof. -move=> <-{G}; elim/last_ind: s => /= [|s G IHs]; first by rewrite cents1. -rewrite last_rcons rcons_path /= => /andP[/IHs{IHs}]. -move: {s}(last _ _) => H IH_H nHGA coGA solG; have [_ sHG _] := and3P nHGA. -by rewrite (stable_factor_cent _ nHGA) ?IH_H ?(solvableS sHG) ?(coprimeSg sHG). -Qed. - -(* This is B & G, Proposition 1.10. *) -Proposition coprime_nil_faithful_cent_stab gT (A G : {group gT}) : - A \subset 'N(G) -> coprime #|G| #|A| -> nilpotent G -> - let C := 'C_G(A) in 'C_G(C) \subset C -> A \subset 'C(G). -Proof. -move=> nGA coGA nilG C; rewrite subsetI subsetIl centsC /= -/C => cCA. -pose N := 'N_G(C); have sNG: N \subset G by rewrite subsetIl. -have sCG: C \subset G by rewrite subsetIl. -suffices cNA : A \subset 'C(N). - rewrite centsC (sameP setIidPl eqP) -(nilpotent_sub_norm nilG sCG) //= -/C. - by rewrite subsetI subsetIl centsC. -have{nilG} solN: solvable N by rewrite (solvableS sNG) ?nilpotent_sol. -rewrite (stable_factor_cent cCA) ?(coprimeSg sNG) /stable_factor //= -/N -/C. -rewrite subcent_normal subsetI (subset_trans (commSg A sNG)) ?commg_subl //=. -rewrite comm_norm_cent_cent 1?centsC ?subsetIr // normsI // !norms_norm //. -by rewrite cents_norm 1?centsC ?subsetIr. -Qed. - -(* B & G, Theorem 1.11, via Aschbacher 24.7 rather than Gorenstein 5.3.10. *) -Theorem coprime_odd_faithful_Ohm1 gT p (A G : {group gT}) : - p.-group G -> A \subset 'N(G) -> coprime #|G| #|A| -> odd #|G| -> - A \subset 'C('Ohm_1(G)) -> A \subset 'C(G). -Proof. -move=> pG nGA coGA oddG; rewrite !(centsC A) => cAG1. -have [-> | ntG] := eqsVneq G 1; first exact: sub1G. -have{oddG ntG} [p_pr oddp]: prime p /\ odd p. - have [p_pr p_dv_G _] := pgroup_pdiv pG ntG. - by rewrite !odd_2'nat in oddG *; rewrite pnatE ?(pgroupP oddG). -without loss defR: G pG nGA coGA cAG1 / [~: G, A] = G. - move=> IH; have solG := pgroup_sol pG. - rewrite -(coprime_cent_prod nGA) ?mul_subG ?subsetIr //=. - have sRG: [~: G, A] \subset G by rewrite commg_subl. - rewrite IH ?coprime_commGid ?(pgroupS sRG) ?commg_normr ?(coprimeSg sRG) //. - by apply: subset_trans cAG1; apply: OhmS. -have [|[defPhi defG'] defC] := abelian_charsimple_special pG coGA defR. - apply/bigcupsP=> H /andP[chH abH]; have sHG := char_sub chH. - have nHA := char_norm_trans chH nGA. - rewrite centsC coprime_abelian_faithful_Ohm1 ?(coprimeSg sHG) //. - by rewrite centsC (subset_trans (OhmS 1 sHG)). -have abelZ: p.-abelem 'Z(G) by apply: center_special_abelem. -have cAZ: {in 'Z(G), centralised A} by apply/centsP; rewrite -defC subsetIr. -have cGZ: {in 'Z(G), centralised G} by apply/centsP; rewrite subsetIr. -have defG1: 'Ohm_1(G) = 'Z(G). - apply/eqP; rewrite eqEsubset -{1}defC subsetI Ohm_sub cAG1 /=. - by rewrite -(Ohm1_id abelZ) OhmS ?center_sub. -rewrite (subset_trans _ (subsetIr G _)) // defC -defG1 -{1}defR gen_subG /=. -apply/subsetP=> _ /imset2P[x a Gx Aa ->]; rewrite commgEl. -set u := x^-1; set v := x ^ a; pose w := [~ v, u]. -have [Gu Gv]: u \in G /\ v \in G by rewrite groupV memJ_norm ?(subsetP nGA). -have Zw: w \in 'Z(G) by rewrite -defG' mem_commg. -rewrite (OhmE 1 pG) mem_gen // !inE expn1 groupM //=. -rewrite expMg_Rmul /commute ?(cGZ w) // bin2odd // expgM. -case/(abelemP p_pr): abelZ => _ /(_ w)-> //. -rewrite expg1n mulg1 expgVn -conjXg (sameP commgP eqP) cAZ // -defPhi. -by rewrite (Phi_joing pG) joingC mem_gen // inE (Mho_p_elt 1) ?(mem_p_elt pG). -Qed. - -(* This is B & G, Corollary 1.12. *) -Corollary coprime_odd_faithful_cent_abelem gT p (A G E : {group gT}) : - E \in 'E_p(G) -> p.-group G -> - A \subset 'N(G) -> coprime #|G| #|A| -> odd #|G| -> - A \subset 'C('Ldiv_p('C_G(E))) -> A \subset 'C(G). -Proof. -case/pElemP=> sEG abelE pG nGA coGA oddG cCEA. -have [-> | ntG] := eqsVneq G 1; first by rewrite cents1. -have [p_pr _ _] := pgroup_pdiv pG ntG. -have{cCEA} cCEA: A \subset 'C('Ohm_1('C_G(E))). - by rewrite (OhmE 1 (pgroupS _ pG)) ?subsetIl ?cent_gen. -apply: coprime_nil_faithful_cent_stab (pgroup_nil pG) _ => //. -rewrite subsetI subsetIl centsC /=; set CC := 'C_G(_). -have sCCG: CC \subset G := subsetIl _ _; have pCC := pgroupS sCCG pG. -rewrite (coprime_odd_faithful_Ohm1 pCC) ?(coprimeSg sCCG) ?(oddSg sCCG) //. - by rewrite !(normsI, norms_cent, normG). -rewrite (subset_trans cCEA) // centS // OhmS // setIS // centS //. -rewrite subsetI sEG /= centsC (subset_trans cCEA) // centS //. -have cEE: abelian E := abelem_abelian abelE. -by rewrite -{1}(Ohm1_id abelE) OhmS // subsetI sEG. -Qed. - -(* This is B & G, Theorem 1.13. *) -Theorem critical_odd gT p (G : {group gT}) : - p.-group G -> odd #|G| -> G :!=: 1 -> - {H : {group gT} | - [/\ H \char G, [~: H, G] \subset 'Z(H), nil_class H <= 2, exponent H = p - & p.-group 'C(H | [Aut G])]}. -Proof. -move=> pG oddG ntG; have [H krH]:= Thompson_critical pG. -have [chH sPhiZ sGH_Z scH] := krH; have clH := critical_class2 krH. -have sHG := char_sub chH; set D := 'Ohm_1(H)%G; exists D. -have chD: D \char G := char_trans (Ohm_char 1 H) chH. -have sDH: D \subset H := Ohm_sub 1 H. -have sDG_Z: [~: D, G] \subset 'Z(D). - rewrite subsetI commg_subl char_norm // commGC. - apply: subset_trans (subset_trans sGH_Z _); first by rewrite commgS. - by rewrite subIset // orbC centS. -rewrite nil_class2 !(subset_trans (commgS D _) sDG_Z) ?(char_sub chD) {sDH}//. -have [p_pr p_dv_G _] := pgroup_pdiv pG ntG; have odd_p := dvdn_odd p_dv_G oddG. -split=> {chD sDG_Z}//. - apply/prime_nt_dvdP=> //; last by rewrite exponent_Ohm1_class2 ?(pgroupS sHG). - rewrite -dvdn1 -trivg_exponent /= Ohm1_eq1; apply: contraNneq ntG => H1. - by rewrite -(setIidPl (cents1 G)) -{1}H1 scH H1 center1. -apply/pgroupP=> q q_pr /Cauchy[] //= f. -rewrite astab_ract => /setIdP[Af cDf] ofq; apply: wlog_neg => p'q. -suffices: f \in 'C(H | [Aut G]). - move/(mem_p_elt (critical_p_stab_Aut krH pG))/pnatP=> -> //. - by rewrite ofq. -rewrite astab_ract inE Af; apply/astabP=> x Hx; rewrite /= /aperm /=. -rewrite nil_class2 in clH; have pH := pgroupS sHG pG. -have /p_natP[i ox]: p.-elt x by apply: mem_p_elt Hx. -have{ox}: x ^+ (p ^ i) = 1 by rewrite -ox expg_order. -elim: i x Hx => [|[|i] IHi] x Hx xp1. -- by rewrite [x]xp1 -(autmE Af) morph1. -- by apply: (astabP cDf); rewrite (OhmE 1 pH) mem_gen // !inE Hx xp1 eqxx. -have expH': {in H &, forall y z, [~ y, z] ^+ p = 1}. - move=> y z Hy Hz; apply/eqP. - have /setIP[_ cHyz]: [~ y, z] \in 'Z(H) by rewrite (subsetP clH) // mem_commg. - rewrite -commXg; last exact/commute_sym/(centP cHyz). - suffices /setIP[_ cHyp]: y ^+ p \in 'Z(H) by apply/commgP/(centP cHyp). - rewrite (subsetP sPhiZ) // (Phi_joing pH) mem_gen // inE orbC. - by rewrite (Mho_p_elt 1) ?(mem_p_elt pH). -have Hfx: f x \in H. - case/charP: chH => _ /(_ _ (injm_autm Af) (im_autm Af)) <-. - by rewrite -{1}(autmE Af) mem_morphim // (subsetP sHG). -set y := x^-1 * f x; set z := [~ f x, x^-1]. -have Hy: y \in H by rewrite groupM ?groupV. -have /centerP[_ Zz]: z \in 'Z(H) by rewrite (subsetP clH) // mem_commg ?groupV. -have fy: f y = y. - apply: (IHi); first by rewrite groupM ?groupV. - rewrite expMg_Rmul; try by apply: commute_sym; apply: Zz; rewrite ?groupV. - rewrite -/z bin2odd ?odd_exp // {3}expnS -mulnA expgM expH' ?groupV //. - rewrite expg1n mulg1 expgVn -(autmE Af) -morphX ?(subsetP sHG) //= autmE. - rewrite IHi ?mulVg ?groupX // {2}expnS expgM -(expgM x _ p) -expnSr. - by rewrite xp1 expg1n. -have /eqP: (f ^+ q) x = x * y ^+ q. - elim: (q) => [|j IHj]; first by rewrite perm1 mulg1. - rewrite expgSr permM {}IHj -(autmE Af). - rewrite morphM ?morphX ?groupX ?(subsetP sHG) //= autmE. - by rewrite fy expgS mulgA mulKVg. -rewrite -{1}ofq expg_order perm1 eq_mulVg1 mulKg -order_dvdn. -case: (primeP q_pr) => _ dv_q /dv_q; rewrite order_eq1 -eq_mulVg1. -case/pred2P=> // oyq; case/negP: p'q. -by apply: (pgroupP pH); rewrite // -oyq order_dvdG. -Qed. - -Section CoprimeQuotientPgroup. - -(* This is B & G, Lemma 1.14, which we divide in four lemmas, each one giving *) -(* the (sub)centraliser or (sub)normaliser of a quotient by a coprime p-group *) -(* acting on it. Note that we weaken the assumptions of B & G -- M does not *) -(* need to be normal in G, T need not be a subgroup of G, p need not be a *) -(* prime, and M only needs to be coprime with T. Note also that the subcenter *) -(* quotient lemma is special case of a lemma in coprime_act. *) - -Variables (gT : finGroupType) (p : nat) (T M G : {group gT}). -Hypothesis pT : p.-group T. -Hypotheses (nMT : T \subset 'N(M)) (coMT : coprime #|M| #|T|). - -(* This is B & G, Lemma 1.14, for a global normaliser. *) -Lemma coprime_norm_quotient_pgroup : 'N(T / M) = 'N(T) / M. -Proof. -have [-> | ntT] := eqsVneq T 1; first by rewrite quotient1 !norm1 quotientT. -have [p_pr _ [m oMpm]] := pgroup_pdiv pT ntT. -apply/eqP; rewrite eqEsubset morphim_norms // andbT; apply/subsetP=> Mx. -case: (cosetP Mx) => x Nx ->{Mx} nTqMx. -have sylT: p.-Sylow(M <*> T) T. - rewrite /pHall pT -divgS joing_subr //= norm_joinEr ?coprime_cardMg //. - rewrite mulnK // ?p'natE -?prime_coprime // coprime_sym. - by rewrite -(@coprime_pexpr m.+1) -?oMpm. -have sylTx: p.-Sylow(M <*> T) (T :^ x). - have nMTx: x \in 'N(M <*> T). - rewrite norm_joinEr // inE -quotientSK ?conj_subG ?mul_subG ?normG //. - by rewrite quotientJ // quotientMidl (normP nTqMx). - by rewrite pHallE /= -{1}(normP nMTx) conjSg cardJg -pHallE. -have{sylT sylTx} [ay] := Sylow_trans sylT sylTx. -rewrite /= joingC norm_joinEl //; case/imset2P=> a y Ta. -rewrite -groupV => My ->{ay} defTx; rewrite -(coset_kerr x My). -rewrite mem_morphim //; first by rewrite groupM // (subsetP (normG M)). -by rewrite inE !(conjsgM, defTx) conjsgK conjGid. -Qed. - -(* This is B & G, Lemma 1.14, for a global centraliser. *) -Lemma coprime_cent_quotient_pgroup : 'C(T / M) = 'C(T) / M. -Proof. -symmetry; rewrite -quotientInorm -quotientMidl -['C(T / M)]cosetpreK. -congr (_ / M); set Cq := _ @*^-1 _; set C := 'N_('C(T))(M). -suffices <-: 'N_Cq(T) = C. - rewrite setIC group_modl ?sub_cosetpre //= -/Cq; apply/setIidPr. - rewrite -quotientSK ?subsetIl // cosetpreK. - by rewrite -coprime_norm_quotient_pgroup cent_sub. -apply/eqP; rewrite eqEsubset subsetI -sub_quotient_pre ?subsetIr //. -rewrite quotientInorm quotient_cents //= andbC subIset ?cent_sub //=. -have nMC': 'N_Cq(T) \subset 'N(M) by rewrite subIset ?subsetIl. -rewrite subsetI nMC' andbT (sameP commG1P trivgP) /=. -rewrite -(coprime_TIg coMT) subsetI commg_subr subsetIr andbT. -by rewrite -quotient_cents2 ?sub_quotient_pre ?subsetIl. -Qed. - -Hypothesis sMG : M \subset G. - -(* This is B & G, Lemma 1.14, for a local normaliser. *) -Lemma coprime_subnorm_quotient_pgroup : 'N_(G / M)(T / M) = 'N_G(T) / M. -Proof. by rewrite quotientGI -?coprime_norm_quotient_pgroup. Qed. - -(* This is B & G, Lemma 1.14, for a local centraliser. *) -Lemma coprime_subcent_quotient_pgroup : 'C_(G / M)(T / M) = 'C_G(T) / M. -Proof. by rewrite quotientGI -?coprime_cent_quotient_pgroup. Qed. - -End CoprimeQuotientPgroup. - -Section Constrained. - -Variables (gT : finGroupType) (p : nat) (G : {group gT}). - -(* This is B & G, Proposition 1.15a (Lemma 1.2.3 of P. Hall & G. Higman). *) -Proposition solvable_p_constrained : solvable G -> p.-constrained G. -Proof. -move=> solG P sylP; have [sPO pP _] := and3P sylP; pose K := 'O_p^'(G). -have nKG: G \subset 'N(K) by rewrite normal_norm ?pcore_normal. -have nKC: 'C_G(P) \subset 'N(K) by rewrite subIset ?nKG. -rewrite -(quotientSGK nKC) //; last first. - by rewrite /= -pseries1 (pseries_sub_catl [::_]). -apply: subset_trans (quotient_subcent _ _ _) _; rewrite /= -/K. -suffices ->: P / K = 'O_p(G / K). - rewrite quotient_pseries2 -Fitting_eq_pcore ?trivg_pcore_quotient // -/K. - by rewrite cent_sub_Fitting ?morphim_sol. -apply/eqP; rewrite eqEcard -(part_pnat_id (pcore_pgroup _ _)). -have sylPK: p.-Sylow('O_p(G / K)) (P / K). - rewrite -quotient_pseries2 morphim_pHall //. - exact: subset_trans (subset_trans sPO (pseries_sub _ _)) nKG. -by rewrite -(card_Hall sylPK) leqnn -quotient_pseries2 quotientS. -Qed. - -(* This is Gorenstein, Proposition 8.1.3. *) -Proposition p_stable_abelian_constrained : - p.-constrained G -> p.-stable G -> p.-abelian_constrained G. -Proof. -move=> constrG stabG P A sylP cAA /andP[sAP nAP]. -have [sPG pP _] := and3P sylP; have sAG := subset_trans sAP sPG. -set K2 := 'O_{p^', p}(G); pose K1 := 'O_p^'(G); pose Q := P :&: K2. -have sQG: Q \subset G by rewrite subIset ?sPG. -have nK1G: G \subset 'N(K1) by rewrite normal_norm ?pcore_normal. -have nsK2G: K2 <| G := pseries_normal _ _; have [sK2G nK2G] := andP nsK2G. -have sylQ: p.-Sylow(K2) Q by rewrite /Q setIC (Sylow_setI_normal nsK2G). -have defK2: K1 * Q = K2. - have sK12: K1 \subset K2 by rewrite /K1 -pseries1 (pseries_sub_catl [::_]). - apply/eqP; rewrite eqEsubset mulG_subG /= sK12 subsetIr /=. - rewrite -quotientSK ?(subset_trans sK2G) //= quotientIG //= -/K1 -/K2. - rewrite subsetI subxx andbT quotient_pseries2. - by rewrite pcore_sub_Hall // morphim_pHall // ?(subset_trans sPG). -have{cAA} rQAA_1: [~: Q, A, A] = 1. - by apply/commG1P; apply: subset_trans cAA; rewrite commg_subr subIset // nAP. -have nK2A := subset_trans sAG nK2G. -have sAN: A \subset 'N_G(Q) by rewrite subsetI sAG normsI // normsG. -have{stabG rQAA_1 defK2 sQG} stabA: A / 'C_G(Q) \subset 'O_p('N_G(Q) / 'C_G(Q)). - apply: stabG; rewrite //= /psubgroup -/Q ?sAN ?(pgroupS _ pP) ?subsetIl //. - by rewrite defK2 pseries_normal. -rewrite -quotient_sub1 //= -/K2 -(setIidPr sAN). -have nK2N: 'N_G(Q) \subset 'N(K2) by rewrite subIset ?nK2G. -rewrite -[_ / _](morphim_restrm nK2N); set qK2 := restrm _ _. -have{constrG} fqKp: 'ker (coset 'C_G(Q)) \subset 'ker qK2. - by rewrite ker_restrm !ker_coset subsetI subcent_sub constrG. -rewrite -(morphim_factm fqKp (subcent_norm _ _)) -(quotientE A _). -apply: subset_trans {stabA}(morphimS _ stabA) _. -apply: subset_trans (morphim_pcore _ _ _) _. -rewrite morphim_factm morphim_restrm setIid -quotientE. -rewrite /= -quotientMidl /= -/K2 (Frattini_arg _ sylQ) ?pseries_normal //. -by rewrite -quotient_pseries //= (pseries_rcons_id [::_]) trivg_quotient. -Qed. - -End Constrained. - -(* This is B & G, Proposition 1.15b (due to D. Goldschmith). *) -Proposition p'core_cent_pgroup gT p (G R : {group gT}) : - p.-subgroup(G) R -> solvable G -> 'O_p^'('C_G(R)) \subset 'O_p^'(G). -Proof. -case/andP=> sRG pR solG. -without loss p'G1: gT G R sRG pR solG / 'O_p^'(G) = 1. - have nOG_CR: 'C_G(R) \subset 'N('O_p^'(G)) by rewrite subIset ?gFnorm. - move=> IH; rewrite -quotient_sub1 ?gFsub_trans //. - apply: subset_trans (morphimF _ _ nOG_CR) _; rewrite /= -quotientE. - rewrite -(coprime_subcent_quotient_pgroup pR) ?pcore_sub //; first 1 last. - - by rewrite (subset_trans sRG) ?gFnorm. - - by rewrite coprime_sym (pnat_coprime _ (pcore_pgroup _ _)). - have p'Gq1 : 'O_p^'(G / 'O_p^'(G)) = 1 := trivg_pcore_quotient p^' G. - by rewrite -p'Gq1 IH ?morphimS ?morphim_pgroup ?morphim_sol. -set M := 'O_p^'('C_G(R)); pose T := 'O_p(G). -have /subsetIP[sMG cMR]: M \subset 'C_G(R) by apply: pcore_sub. -have [p'M pT]: p^'.-group M /\ p.-group T by rewrite !pcore_pgroup. -have nRT: R \subset 'N(T) by rewrite (subset_trans sRG) ?gFnorm. -have pRT: p.-group (R <*> T). - rewrite -(pquotient_pgroup pT) ?join_subG ?nRT ?normG //=. - by rewrite norm_joinEl // quotientMidr morphim_pgroup. -have nRT_M: M \subset 'N(R <*> T). - by rewrite normsY ?(cents_norm cMR) // (subset_trans sMG) ?gFnorm. -have coRT_M: coprime #|R <*> T| #|M| := pnat_coprime pRT p'M. -have cMcR: 'C_(R <*> T)(R) \subset 'C(M). - apply/commG1P; apply/trivgP; rewrite -(coprime_TIg coRT_M) subsetI commg_subr. - rewrite (subset_trans (commSg _ (subsetIl _ _))) ?commg_subl //= -/M. - by apply: subset_trans (gFnorm _ _); rewrite setSI // join_subG sRG pcore_sub. -have cRT_M: M \subset 'C(R <*> T). - rewrite coprime_nil_faithful_cent_stab ?(pgroup_nil pRT) //= -/M. - rewrite subsetI subsetIl (subset_trans _ cMcR) // ?setIS ?centS //. - by rewrite subsetI joing_subl centsC. -have sMT: M \subset T. - have defT: 'F(G) = T := Fitting_eq_pcore p'G1. - rewrite -defT (subset_trans _ (cent_sub_Fitting solG)) // defT subsetI sMG. - by rewrite (subset_trans cRT_M) // centY subsetIr. -by rewrite -(setIidPr sMT) p'G1 coprime_TIg // (pnat_coprime pT). -Qed. - -(* This is B & G, Proposition 1.16, second assertion. Contrary to the text, *) -(* we derive this directly, rather than by induction on the first, because *) -(* this is actually how the proof is done in Gorenstein. Note that the non *) -(* cyclic assumption for A is not needed here. *) -Proposition coprime_abelian_gen_cent gT (A G : {group gT}) : - abelian A -> A \subset 'N(G) -> coprime #|G| #|A| -> - <<\bigcup_(B : {group gT} | cyclic (A / B) && (B <| A)) 'C_G(B)>> = G. -Proof. -move=> abelA nGA coGA; symmetry; move: {2}_.+1 (ltnSn #|G|) => n. -elim: n gT => // n IHn gT in A G abelA nGA coGA *; rewrite ltnS => leGn. -without loss nilG: G nGA coGA leGn / nilpotent G. - move=> {IHn} IHn; apply/eqP; rewrite eqEsubset gen_subG. - apply/andP; split; last by apply/bigcupsP=> B _; apply: subsetIl. - pose T := [set P : {group gT} | Sylow G P & A \subset 'N(P)]. - rewrite -{1}(@Sylow_transversal_gen _ T G) => [|P | p _]; first 1 last. - - by rewrite inE -!andbA; case/and4P. - - have [//|P sylP nPA] := sol_coprime_Sylow_exists p (abelian_sol abelA) nGA. - by exists P; rewrite ?inE ?(p_Sylow sylP). - rewrite gen_subG; apply/bigcupsP=> P {T}/setIdP[/SylowP[p _ sylP] nPA]. - have [sPG pP _] := and3P sylP. - rewrite (IHn P) ?(pgroup_nil pP) ?(coprimeSg sPG) ?genS //. - by apply/bigcupsP=> B cycBq; rewrite (bigcup_max B) ?setSI. - by rewrite (leq_trans (subset_leq_card sPG)). -apply/eqP; rewrite eqEsubset gen_subG. -apply/andP; split; last by apply/bigcupsP=> B _; apply: subsetIl. -have [Z1 | ntZ] := eqsVneq 'Z(G) 1. - by rewrite (TI_center_nil _ (normal_refl G)) ?Z1 ?(setIidPr _) ?sub1G. -have{ntZ} [M /= minM] := minnormal_exists ntZ (gFnorm_trans _ nGA). -rewrite subsetI centsC => /andP[sMG /cents_norm nMG]. -have coMA := coprimeSg sMG coGA; have{nilG} solG := nilpotent_sol nilG. -have [nMA ntM abelM] := minnormal_solvable minM sMG solG. -set GC := <<_>>; have sMGC: M \subset GC. - rewrite sub_gen ?(bigcup_max 'C_A(M)%G) //=; last first. - by rewrite subsetI sMG centsC subsetIr. - case/is_abelemP: abelM => p _ abelM; rewrite -(rker_abelem abelM ntM nMA). - rewrite rker_normal -(setIidPl (quotient_abelian _ _)) ?center_kquo_cyclic //. - exact/abelem_mx_irrP. -rewrite -(quotientSGK nMG sMGC). -have: A / M \subset 'N(G / M) by rewrite morphim_norms. -move/IHn->; rewrite ?morphim_abelian ?coprime_morph {IHn}//; first 1 last. - by rewrite (leq_trans _ leGn) ?ltn_quotient. -rewrite gen_subG; apply/bigcupsP=> Bq; rewrite andbC => /andP[]. -have: M :&: A = 1 by rewrite coprime_TIg. -move/(quotient_isom nMA); case/isomP=> /=; set qM := restrm _ _ => injqM <-. -move=> nsBqA; have sBqA := normal_sub nsBqA. -rewrite -(morphpreK sBqA) /= -/qM; set B := qM @*^-1 Bq. -move: nsBqA; rewrite -(morphpre_normal sBqA) ?injmK //= -/B => nsBA. -rewrite -(morphim_quotm _ nsBA) /= -/B injm_cyclic ?injm_quotm //= => cycBA. -rewrite morphim_restrm -quotientE morphpreIdom -/B; have sBA := normal_sub nsBA. -rewrite -coprime_quotient_cent ?(coprimegS sBA, subset_trans sBA) //= -/B. -by rewrite quotientS ?sub_gen // (bigcup_max [group of B]) ?cycBA. -Qed. - -(* B & G, Proposition 1.16, first assertion. *) -Proposition coprime_abelian_gen_cent1 gT (A G : {group gT}) : - abelian A -> ~~ cyclic A -> A \subset 'N(G) -> coprime #|G| #|A| -> - <<\bigcup_(a in A^#) 'C_G[a]>> = G. -Proof. -move=> abelA ncycA nGA coGA. -apply/eqP; rewrite eq_sym eqEsubset /= gen_subG. -apply/andP; split; last by apply/bigcupsP=> B _; apply: subsetIl. -rewrite -{1}(coprime_abelian_gen_cent abelA nGA) ?genS //. -apply/bigcupsP=> B; have [-> | /trivgPn[a Ba n1a]] := eqsVneq B 1. - by rewrite injm_cyclic ?coset1_injm ?norms1 ?(negbTE ncycA). -case/and3P=> _ sBA _; rewrite (bigcup_max a) ?inE ?n1a ?(subsetP sBA) //. -by rewrite setIS // -cent_set1 centS // sub1set. -Qed. - -Section Focal_Subgroup. - -Variables (gT : finGroupType) (G S : {group gT}) (p : nat). -Hypothesis sylS : p.-Sylow(G) S. - -Import finalg FiniteModule GRing.Theory. - -(* This is B & G, Theorem 1.17 ("Focal Subgroup Theorem", D. G. Higman), also *) -(* Gorenstein Theorem 7.3.4 and Aschbacher (37.4). *) -Theorem focal_subgroup_gen : - S :&: G^`(1) = <<[set [~ x, u] | x in S, u in G & x ^ u \in S]>>. -Proof. -set K := <<_>>; set G' := G^`(1); have [sSG coSiSG] := andP (pHall_Hall sylS). -apply/eqP; rewrite eqEsubset gen_subG andbC; apply/andP; split. - apply/subsetP=> _ /imset2P[x u Sx /setIdP[Gu Sxu] ->]. - by rewrite inE groupM ?groupV // mem_commg // (subsetP sSG). -apply/subsetP=> g /setIP[Sg G'g]; have Gg := subsetP sSG g Sg. -have nKS: S \subset 'N(K). - rewrite norms_gen //; apply/subsetP=> y Sy; rewrite inE. - apply/subsetP=> _ /imsetP[_ /imset2P[x u Sx /setIdP[Gu Sxu] ->] ->]. - have Gy: y \in G := subsetP sSG y Sy. - by rewrite conjRg mem_imset2 ?groupJ // inE -conjJg /= 2?groupJ. -set alpha := restrm_morphism nKS (coset_morphism K). -have alphim: (alpha @* S) = (S / K) by rewrite morphim_restrm setIid. -have abelSK : abelian (alpha @* S). - rewrite alphim sub_der1_abelian // genS //. - apply/subsetP=> _ /imset2P[x y Sx Sy ->]. - by rewrite mem_imset2 // inE (subsetP sSG) ?groupJ. -set ker_trans := 'ker (transfer G abelSK). -have G'ker : G' \subset ker_trans. - rewrite gen_subG; apply/subsetP=> h; case/imset2P=> h1 h2 Gh1 Gh2 ->{h}. - by rewrite !inE groupR // morphR //; apply/commgP; apply: addrC. -have transg0: transfer G abelSK g = 0%R. - by move/kerP: (subsetP G'ker g G'g); apply. -have partX := rcosets_cycle_partition sSG Gg. -have trX := transversalP partX; set X := transversal _ _ in trX. -have /and3P[_ sXG _] := trX. -have gGSeq0: (fmod abelSK (alpha g) *+ #|G : S| = 0)%R. - rewrite -transg0 (transfer_cycle_expansion sSG abelSK Gg trX). - rewrite -(sum_index_rcosets_cycle sSG Gg trX) -sumrMnr /restrm. - apply: eq_bigr=> x Xx; rewrite -[(_ *+ _)%R]morphX ?mem_morphim //=. - rewrite -morphX //= /restrm; congr fmod. - apply/rcoset_kercosetP; rewrite /= -/K. - - by rewrite (subsetP nKS) ?groupX. - - rewrite (subsetP nKS) // conjgE invgK mulgA -mem_rcoset. - exact: mulg_exp_card_rcosets. - rewrite mem_rcoset -{1}[g ^+ _]invgK -conjVg -commgEl mem_gen ?mem_imset2 //. - by rewrite groupV groupX. - rewrite inE conjVg !groupV (subsetP sXG) //= conjgE invgK mulgA -mem_rcoset. - exact: mulg_exp_card_rcosets. -move: (congr_fmod gGSeq0). -rewrite fmval0 morphX ?inE //= fmodK ?mem_morphim // /restrm /=. -move/((congr1 (expgn^~ (expg_invn (S / K) #|G : S|))) _). -rewrite expg1n expgK ?mem_quotient ?coprime_morphl // => Kg1. -by rewrite coset_idr ?(subsetP nKS). -Qed. - -(* This is B & G, Theorem 1.18 (due to Burnside). *) -Theorem Burnside_normal_complement : - 'N_G(S) \subset 'C(S) -> 'O_p^'(G) ><| S = G. -Proof. -move=> cSN; set K := 'O_p^'(G); have [sSG pS _] := and3P sylS. -have /andP[sKG nKG]: K <| G by apply: pcore_normal. -have{nKG} nKS := subset_trans sSG nKG. -have p'K: p^'.-group K by apply: pcore_pgroup. -have{pS p'K} tiKS: K :&: S = 1 by rewrite setIC coprime_TIg ?(pnat_coprime pS). -suffices{tiKS nKS} hallK: p^'.-Hall(G) K. - rewrite sdprodE //= -/K; apply/eqP; rewrite eqEcard ?mul_subG //=. - by rewrite TI_cardMg //= (card_Hall sylS) (card_Hall hallK) mulnC partnC. -pose G' := G^`(1); have nsG'G : G' <| G by rewrite der_normalS. -suffices{K sKG} p'G': p^'.-group G'. - have nsG'K: G' <| K by rewrite (normalS _ sKG) ?pcore_max. - rewrite -(pquotient_pHall p'G') -?pquotient_pcore //= -/G'. - by rewrite nilpotent_pcore_Hall ?abelian_nil ?der_abelian. -suffices{nsG'G} tiSG': S :&: G' = 1. - have sylG'S : p.-Sylow(G') (G' :&: S) by rewrite (Sylow_setI_normal _ sylS). - rewrite /pgroup -[#|_|](partnC p) ?cardG_gt0 // -{sylG'S}(card_Hall sylG'S). - by rewrite /= setIC tiSG' cards1 mul1n part_pnat. -apply/trivgP; rewrite /= focal_subgroup_gen ?(p_Sylow sylS) // gen_subG. -apply/subsetP=> _ /imset2P[x u Sx /setIdP[Gu Sxu] ->]. -have cSS y: y \in S -> S \subset 'C_G[y]. - rewrite subsetI sSG -cent_set1 centsC sub1set; apply: subsetP. - by apply: subset_trans cSN; rewrite subsetI sSG normG. -have{cSS} [v]: exists2 v, v \in 'C_G[x ^ u | 'J] & S :=: (S :^ u) :^ v. - have sylSu : p.-Sylow(G) (S :^ u) by rewrite pHallJ. - have [sSC sCG] := (cSS _ Sxu, subsetIl G 'C[x ^ u]). - rewrite astab1J; apply: (@Sylow_trans p); apply: pHall_subl sCG _ => //=. - by rewrite -conjg_set1 normJ -(conjGid Gu) -conjIg conjSg cSS. -rewrite in_set1 -conjsgM => /setIP[Gv /astab1P cx_uv] nSuv. -apply/conjg_fixP; rewrite -cx_uv /= -conjgM; apply: astabP Sx. -by rewrite astabJ (subsetP cSN) // !inE -nSuv groupM /=. -Qed. - -(* This is B & G, Corollary 1.19(a). *) -Corollary cyclic_Sylow_tiVsub_der1 : - cyclic S -> S :&: G^`(1) = 1 \/ S \subset G^`(1). -Proof. -move=> cycS; have [sSG pS _] := and3P sylS. -have nsSN: S <| 'N_G(S) by rewrite normalSG. -have hallSN: Hall 'N_G(S) S. - by apply: pHall_Hall (pHall_subl _ _ sylS); rewrite ?subsetIl ?normal_sub. -have /splitsP[K /complP[tiSK /= defN]] := SchurZassenhaus_split hallSN nsSN. -have sKN: K \subset 'N_G(S) by rewrite -defN mulG_subr. -have [sKG nSK] := subsetIP sKN. -have coSK: coprime #|S| #|K|. - by case/andP: hallSN => sSN; rewrite -divgS //= -defN TI_cardMg ?mulKn. -have:= coprime_abelian_cent_dprod nSK coSK (cyclic_abelian cycS). -case/(cyclic_pgroup_dprod_trivg pS cycS) => [[_ cSK]|[_ <-]]; last first. - by right; rewrite commgSS. -have cSN: 'N_G(S) \subset 'C(S). - by rewrite -defN mulG_subG -abelianE cyclic_abelian // centsC -cSK subsetIr. -have /sdprodP[_ /= defG _ _] := Burnside_normal_complement cSN. -set Q := 'O_p^'(G) in defG; have nQG: G \subset 'N(Q) := gFnorm _ _. -left; rewrite coprime_TIg ?(pnat_coprime pS) //. -apply: pgroupS (pcore_pgroup _ G); rewrite /= -/Q. -rewrite -quotient_sub1 ?gFsub_trans ?quotientR //= -/Q. -rewrite -defG quotientMidl (sameP trivgP commG1P) -abelianE. -by rewrite morphim_abelian ?cyclic_abelian. -Qed. - -End Focal_Subgroup. - -(* This is B & G, Corollary 1.19(b). *) -Corollary Zgroup_der1_Hall gT (G : {group gT}) : - Zgroup G -> Hall G G^`(1). -Proof. -move=> ZgG; set G' := G^`(1). -rewrite /Hall der_sub coprime_sym coprime_pi' ?cardG_gt0 //=. -apply/pgroupP=> p p_pr pG'; have [P sylP] := Sylow_exists p G. -have cycP: cyclic P by have:= forallP ZgG P; rewrite (p_Sylow sylP). -case: (cyclic_Sylow_tiVsub_der1 sylP cycP) => [tiPG' | sPG']. - have: p.-Sylow(G') (P :&: G'). - by rewrite setIC (Sylow_setI_normal _ sylP) ?gFnormal. - move/card_Hall/eqP; rewrite /= tiPG' cards1 eq_sym. - by rewrite partn_eq1 ?cardG_gt0 // p'natE ?pG'. -rewrite inE /= mem_primes p_pr indexg_gt0 -?p'natE // -partn_eq1 //. -have sylPq: p.-Sylow(G / G') (P / G') by rewrite morphim_pHall ?normsG. -rewrite -card_quotient ?gFnorm // -(card_Hall sylPq) -trivg_card1. -by rewrite /= -quotientMidr mulSGid ?trivg_quotient. -Qed. - -(* This is Aschbacher (39.2). *) -Lemma cyclic_pdiv_normal_complement gT (S G : {group gT}) : - (pdiv #|G|).-Sylow(G) S -> cyclic S -> exists H : {group gT}, H ><| S = G. -Proof. -set p := pdiv _ => sylS cycS; have cSS := cyclic_abelian cycS. -exists 'O_p^'(G)%G; apply: Burnside_normal_complement => //. -have [-> | ntS] := eqsVneq S 1; first apply: cents1. -have [sSG pS p'iSG] := and3P sylS; have [pr_p _ _] := pgroup_pdiv pS ntS. -rewrite -['C(S)]mulg1 -ker_conj_aut -morphimSK ?subsetIr // setIC morphimIdom. -set A_G := _ @* _; pose A := Aut S. -have [_ [_ [cAA _ oAp' _]] _] := cyclic_pgroup_Aut_structure pS cycS ntS. -have{cAA cSS p'iSG} /setIidPl <-: A_G \subset 'O_p^'(A). - rewrite pcore_max -?sub_abelian_normal ?Aut_conj_aut //=. - apply: pnat_dvd p'iSG; rewrite card_morphim ker_conj_aut /= setIC. - have sSN: S \subset 'N_G(S) by rewrite subsetI sSG normG. - by apply: dvdn_trans (indexSg sSN (subsetIl G 'N(S))); apply: indexgS. -rewrite coprime_TIg ?sub1G // coprime_morphl // coprime_sym coprime_pi' //. -apply/pgroupP=> q pr_q q_dv_G; rewrite !inE mem_primes gtnNdvd ?andbF // oAp'. -by rewrite prednK ?prime_gt0 ?pdiv_min_dvd ?prime_gt1. -Qed. - -(* This is Aschbacher (39.3). *) -Lemma Zgroup_metacyclic gT (G : {group gT}) : Zgroup G -> metacyclic G. -Proof. -elim: {G}_.+1 {-2}G (ltnSn #|G|) => // n IHn G; rewrite ltnS => leGn ZgG. -have{n IHn leGn} solG: solvable G. - have [-> | ntG] := eqsVneq G 1; first apply: solvable1. - have [S sylS] := Sylow_exists (pdiv #|G|) G. - have cycS: cyclic S := forall_inP ZgG S (p_Sylow sylS). - have [H defG] := cyclic_pdiv_normal_complement sylS cycS. - have [nsHG _ _ _ _] := sdprod_context defG; rewrite (series_sol nsHG) andbC. - rewrite -(isog_sol (sdprod_isog defG)) (abelian_sol (cyclic_abelian cycS)). - rewrite metacyclic_sol ?IHn ?(ZgroupS _ ZgG) ?normal_sub //. - rewrite (leq_trans _ leGn) // -(sdprod_card defG) ltn_Pmulr // cardG_gt1. - by rewrite -rank_gt0 (rank_Sylow sylS) p_rank_gt0 pi_pdiv cardG_gt1. -pose K := 'F(G)%G; apply/metacyclicP; exists K. -have nsKG: K <| G := Fitting_normal G; have [sKG nKG] := andP nsKG. -have cycK: cyclic K by rewrite nil_Zgroup_cyclic ?Fitting_nil ?(ZgroupS sKG). -have cKK: abelian K := cyclic_abelian cycK. -have{solG cKK} defK: 'C_G(K) = K. - by apply/setP/subset_eqP; rewrite cent_sub_Fitting // subsetI sKG. -rewrite cycK nil_Zgroup_cyclic ?morphim_Zgroup ?abelian_nil //. -rewrite -defK -ker_conj_aut (isog_abelian (first_isog_loc _ _)) //. -exact: abelianS (Aut_conj_aut K G) (Aut_cyclic_abelian cycK). -Qed. - -(* This is B & G, Theorem 1.20 (Maschke's Theorem) for internal action on *) -(* elementary abelian subgroups; a more general case, for linear *) -(* represenations on matrices, can be found in mxrepresentation.v. *) -Theorem Maschke_abelem gT p (G V U : {group gT}) : - p.-abelem V -> p^'.-group G -> U \subset V -> - G \subset 'N(V) -> G \subset 'N(U) -> - exists2 W : {group gT}, U \x W = V & G \subset 'N(W). -Proof. -move=> pV p'G sUV nVG nUG. -have splitU: [splits V, over U] := abelem_splits pV sUV. -case/and3P: pV => pV abV; have cUV := subset_trans sUV abV. -have sVVG := joing_subl V G. -have{nUG} nUVG: U <| V <*> G. - by rewrite /(U <| _) join_subG (subset_trans sUV) // cents_norm // centsC. -rewrite -{nUVG}(Gaschutz_split nUVG) ?(abelianS sUV) // in splitU; last first. - rewrite -divgS ?joing_subl //= norm_joinEr //. - have coVG: coprime #|V| #|G| := pnat_coprime pV p'G. - by rewrite coprime_cardMg // mulnC mulnK // (coprimeSg sUV). -case/splitsP: splitU => WG /complP[tiUWG /= defVG]. -exists (WG :&: V)%G. - rewrite dprodE; last by rewrite setIA tiUWG (setIidPl _) ?sub1G. - by rewrite group_modl // defVG (setIidPr _). - by rewrite subIset // orbC centsC cUV. -rewrite (subset_trans (joing_subr V _)) // -defVG mul_subG //. - by rewrite cents_norm ?(subset_trans cUV) ?centS ?subsetIr. -rewrite normsI ?normG // (subset_trans (mulG_subr U _)) //. -by rewrite defVG join_subG normG. -Qed. - -Section Plength1. - -Variables (gT : finGroupType) (p : nat). -Implicit Types G H : {group gT}. - -(* Some basic properties of p.-length_1 that are direct consequences of their *) -(* definition using p-series. *) - -Lemma plength1_1 : p.-length_1 (1 : {set gT}). -Proof. by rewrite -[_ 1]subG1 pseries_sub. Qed. - -Lemma plength1_p'group G : p^'.-group G -> p.-length_1 G. -Proof. -move=> p'G; rewrite [p.-length_1 G]eqEsubset pseries_sub /=. -by rewrite -{1}(pcore_pgroup_id p'G) -pseries1 pseries_sub_catl. -Qed. - -Lemma plength1_nonprime G : ~~ prime p -> p.-length_1 G. -Proof. -move=> not_p_pr; rewrite plength1_p'group // p'groupEpi mem_primes. -by rewrite (negPf not_p_pr). -Qed. - -Lemma plength1_pcore_quo_Sylow G (Gb := G / 'O_p^'(G)) : - p.-length_1 G = p.-Sylow(Gb) 'O_p(Gb). -Proof. -rewrite /plength_1 eqEsubset pseries_sub /=. -rewrite (pseries_rcons _ [:: _; _]) -sub_quotient_pre ?gFnorm //=. -rewrite /pHall pcore_sub pcore_pgroup /= -card_quotient ?gFnorm //=. -rewrite -quotient_pseries2 /= {}/Gb -(pseries1 _ G). -rewrite (card_isog (third_isog _ _ _)) ?pseries_normal ?pseries_sub_catl //. -apply/idP/idP=> p'Gbb; last by rewrite (pcore_pgroup_id p'Gbb). -exact: pgroupS p'Gbb (pcore_pgroup _ _). -Qed. - -Lemma plength1_pcore_Sylow G : - 'O_p^'(G) = 1 -> p.-length_1 G = p.-Sylow(G) 'O_p(G). -Proof. -move=> p'G1; rewrite plength1_pcore_quo_Sylow -quotient_pseries2. -by rewrite p'G1 pseries_pop2 // pquotient_pHall ?normal1 ?pgroup1. -Qed. - -(* This is the characterization given in Section 10 of B & G, p. 75, just *) -(* before Theorem 10.6. *) -Lemma plength1_pseries2_quo G : p.-length_1 G = p^'.-group (G / 'O_{p^', p}(G)). -Proof. -rewrite /plength_1 eqEsubset pseries_sub lastI pseries_rcons /=. -rewrite -sub_quotient_pre ?gFnorm //. -by apply/idP/idP=> pl1G; rewrite ?pcore_pgroup_id ?(pgroupS pl1G) ?pcore_pgroup. -Qed. - -(* This is B & G, Lemma 1.21(a). *) -Lemma plength1S G H : H \subset G -> p.-length_1 G -> p.-length_1 H. -Proof. -rewrite /plength_1 => sHG pG1; rewrite eqEsubset pseries_sub. -by apply: subset_trans (pseriesS _ sHG); rewrite (eqP pG1) (setIidPr _). -Qed. - -Lemma plength1_quo G H : p.-length_1 G -> p.-length_1 (G / H). -Proof. -rewrite /plength_1 => pG1; rewrite eqEsubset pseries_sub. -by rewrite -{1}(eqP pG1) morphim_pseries. -Qed. - -(* This is B & G, Lemma 1.21(b). *) -Lemma p'quo_plength1 G H : - H <| G -> p^'.-group H -> p.-length_1 (G / H) = p.-length_1 G. -Proof. -rewrite /plength_1 => nHG p'H; apply/idP/idP; last exact: plength1_quo. -move=> pGH1; rewrite eqEsubset pseries_sub. -have nOG: 'O_{p^'}(G) <| G by apply: pseries_normal. -rewrite -(quotientSGK (normal_norm nOG)) ?(pseries_sub_catl [:: _]) //. -have [|f f_inj im_f] := third_isom _ nHG nOG. - by rewrite /= pseries1 pcore_max. -rewrite (quotient_pseries_cat [:: _]) -{}im_f //= -injmF //. -rewrite {f f_inj}morphimS // pseries1 -pquotient_pcore // -pseries1 /=. -by rewrite -quotient_pseries_cat /= (eqP pGH1). -Qed. - -(* This is B & G, Lemma 1.21(c). *) -Lemma pquo_plength1 G H : - H <| G -> p.-group H -> 'O_p^'(G / H) = 1-> - p.-length_1 (G / H) = p.-length_1 G. -Proof. -rewrite /plength_1 => nHG pH trO; apply/idP/idP; last exact: plength1_quo. -rewrite (pseries_pop _ trO) => pGH1; rewrite eqEsubset pseries_sub /=. -rewrite pseries_pop //; last first. - apply/eqP; rewrite -subG1; have <-: H :&: 'O_p^'(G) = 1. - by apply: coprime_TIg; apply: pnat_coprime (pcore_pgroup _ _). - rewrite setIC subsetI subxx -quotient_sub1. - by rewrite -trO morphim_pcore. - exact/gFsub_trans/normal_norm. -have nOG: 'O_{p}(G) <| G by apply: pseries_normal. -rewrite -(quotientSGK (normal_norm nOG)) ?(pseries_sub_catl [:: _]) //. -have [|f f_inj im_f] := third_isom _ nHG nOG. - by rewrite /= pseries1 pcore_max. -rewrite (quotient_pseries [::_]) -{}im_f //= -injmF //. -rewrite {f f_inj}morphimS // pseries1 -pquotient_pcore // -(pseries1 p) /=. -by rewrite -quotient_pseries /= (eqP pGH1). -Qed. - -Canonical p_elt_gen_group A : {group gT} := - Eval hnf in [group of p_elt_gen p A]. - -(* Note that p_elt_gen could be a functor. *) -Lemma p_elt_gen_normal G : p_elt_gen p G <| G. -Proof. -apply/normalP; split=> [|x Gx]. - by rewrite gen_subG; apply/subsetP=> x; rewrite inE; case/andP. -rewrite -genJ; congr <<_>>; apply/setP=> y; rewrite mem_conjg !inE. -by rewrite p_eltJ -mem_conjg conjGid. -Qed. - -(* This is B & G, Lemma 1.21(d). *) -Lemma p_elt_gen_length1 G : - p.-length_1 G = p^'.-Hall(p_elt_gen p G) 'O_p^'(p_elt_gen p G). -Proof. -rewrite /pHall pcore_sub pcore_pgroup pnatNK /= /plength_1. -have nUG := p_elt_gen_normal G; have [sUG nnUG]:= andP nUG. -apply/idP/idP=> [p1G | pU]. - apply: (@pnat_dvd _ #|p_elt_gen p G : 'O_p^'(G)|). - by rewrite -[#|_ : 'O_p^'(G)|]indexgI indexgS ?pcoreS. - apply: (@pnat_dvd _ #|'O_p(G / 'O_{p^'}(G))|); last exact: pcore_pgroup. - rewrite -card_quotient; last first. - by rewrite (subset_trans sUG) // normal_norm ?pcore_normal. - rewrite -quotient_pseries pseries1 cardSg ?morphimS //=. - rewrite gen_subG; apply/subsetP=> x; rewrite inE; case/andP=> Gx p_x. - have nOx: x \in 'N('O_{p^',p}(G)). - by apply: subsetP Gx; rewrite normal_norm ?pseries_normal. - rewrite coset_idr //; apply/eqP; rewrite -[coset _ x]expg1 -order_dvdn. - rewrite [#[_]](@pnat_1 p) //; first exact: morph_p_elt. - apply: mem_p_elt (pcore_pgroup _ (G / _)) _. - by rewrite /= -quotient_pseries /= (eqP p1G); apply/morphimP; exists x. -have nOG: 'O_{p^', p}(G) <| G by apply: pseries_normal. -rewrite eqEsubset pseries_sub. -rewrite -(quotientSGK (normal_norm nOG)) ?(pseries_sub_catl [:: _; _]) //=. -rewrite (quotient_pseries [::_; _]) pcore_max //. -rewrite /pgroup card_quotient ?normal_norm //. -apply: pnat_dvd (indexgS G (_ : p_elt_gen p G \subset _)) _; last first. - case p_pr: (prime p); last by rewrite p'natEpi // mem_primes p_pr. - rewrite -card_quotient // p'natE //; apply/negP=> /Cauchy[] // Ux. - case/morphimP=> x Nx Gx -> /= oUx_p; have:= prime_gt1 p_pr. - rewrite -(part_pnat_id (pnat_id p_pr)) -{1}oUx_p {oUx_p} -order_constt. - rewrite -morph_constt //= coset_id ?order1 //. - by rewrite mem_gen // inE groupX // p_elt_constt. -have nOU: p_elt_gen p G \subset 'N('O_{p^'}(G)). - by rewrite (subset_trans sUG) // normal_norm ?pseries_normal. -rewrite -(quotientSGK nOU) ?(pseries_sub_catl [:: _]) //=. -rewrite (quotient_pseries [::_]) pcore_max ?morphim_normal //. -rewrite /pgroup card_quotient //= pseries1; apply: pnat_dvd pU. -by apply: indexgS; rewrite pcore_max ?pcore_pgroup // gFnormal_trans. -Qed. - -End Plength1. - -(* This is B & G, Lemma 1.21(e). *) -Lemma quo2_plength1 gT p (G H K : {group gT}) : - H <| G -> K <| G -> H :&: K = 1 -> - p.-length_1 (G / H) && p.-length_1 (G / K) = p.-length_1 G. -Proof. -move=> nHG nKG trHK. -have [p_pr | p_nonpr] := boolP (prime p); last by rewrite !plength1_nonprime. -apply/andP/idP=> [[pH1 pK1] | pG1]; last by rewrite !plength1_quo. -pose U := p_elt_gen p G; have nU : U <| G by apply: p_elt_gen_normal. -have exB (N : {group gT}) : - N <| G -> p.-length_1 (G / N) -> - exists B : {group gT}, - [/\ U \subset 'N(B), - forall x, x \in B -> #[x] = p -> x \in N - & forall Q : {group gT}, p^'.-subgroup(U) Q -> Q \subset B]. -- move=> nsNG; have [sNG nNG] := andP nsNG. - rewrite p_elt_gen_length1 // (_ : p_elt_gen _ _ = U / N); last first. - rewrite /quotient morphim_gen -?quotientE //; last first. - by rewrite setIdE subIset ?nNG. - congr <<_>>; apply/setP=> Nx; rewrite inE setIdE quotientGI // inE. - apply: andb_id2l => /morphimP[x NNx Gx ->{Nx}] /=. - apply/idP/idP=> [pNx | /morphimP[y NNy]]; last first. - by rewrite inE => p_y ->; apply: morph_p_elt. - rewrite -(constt_p_elt pNx) -morph_constt // mem_morphim ?groupX //. - by rewrite inE p_elt_constt. - have nNU: U \subset 'N(N) := subset_trans (normal_sub nU) nNG. - have nN_UN: U <*> N \subset 'N(N) by rewrite gen_subG subUset normG nNU. - case/(inv_quotientN _): (pcore_normal p^' [group of U <*> N / N]) => /= [|B]. - by rewrite /normal sub_gen ?subsetUr. - rewrite /= quotientYidr //= /U => defB sNB; case/andP=> sB nB hallB. - exists B; split=> [| x Ux p_x | Q /andP[sQU p'Q]]. - - by rewrite (subset_trans (sub_gen _) nB) ?subsetUl. - - have nNx: x \in 'N(N) by rewrite (subsetP nN_UN) ?(subsetP sB). - apply: coset_idr => //; rewrite -[coset N x](consttC p). - rewrite !(constt1P _) ?mulg1 // ?p_eltNK. - by rewrite morph_p_elt // /p_elt p_x pnat_id. - have: coset N x \in B / N by apply/morphimP; exists x. - by apply: mem_p_elt; rewrite /= -defB pcore_pgroup. - rewrite -(quotientSGK (subset_trans sQU nNU) sNB). - by rewrite -defB (sub_Hall_pcore hallB) ?quotientS ?quotient_pgroup. -have{pH1} [A [nAU pA p'A]] := exB H nHG pH1. -have{pK1 exB} [B [nBU pB p'B]] := exB K nKG pK1. -rewrite p_elt_gen_length1 //; apply: normal_max_pgroup_Hall (pcore_normal _ _). -apply/maxgroupP; split; first by rewrite /psubgroup pcore_sub pcore_pgroup. -move=> Q p'Q sOQ; apply/eqP; rewrite eqEsubset sOQ andbT. -apply: subset_trans (_ : U :&: (A :&: B) \subset _); last rewrite /U. - by rewrite !subsetI p'A ?p'B //; case/andP: p'Q => ->. -apply: pcore_max; last by rewrite /normal subsetIl !normsI ?normG. -rewrite /pgroup p'natE //. -apply/negP=> /Cauchy[] // x /setIP[_ /setIP[Ax Bx]] oxp. -suff: x \in 1%G by move/set1P=> x1; rewrite -oxp x1 order1 in p_pr. -by rewrite /= -trHK inE pA ?pB. -Qed. - -(* B & G Lemma 1.22 is covered by sylow.normal_pgroup. *) - -(* Encapsulation of the use of the order of GL_2(p), via abelem groups. *) -Lemma logn_quotient_cent_abelem gT p (A E : {group gT}) : - A \subset 'N(E) -> p.-abelem E -> logn p #|E| <= 2 -> - logn p #|A : 'C_A(E)| <= 1. -Proof. -move=> nEA abelE maxdimE; have [-> | ntE] := eqsVneq E 1. - by rewrite (setIidPl (cents1 _)) indexgg logn1. -pose rP := abelem_repr abelE ntE nEA. -have [p_pr _ _] := pgroup_pdiv (abelem_pgroup abelE) ntE. -have ->: 'C_A(E) = 'ker (reprGLm rP) by rewrite ker_reprGLm rker_abelem. -rewrite -card_quotient ?ker_norm // (card_isog (first_isog _)). -apply: leq_trans (dvdn_leq_log _ _ (cardSg (subsetT _))) _ => //. -rewrite logn_card_GL_p ?(dim_abelemE abelE) //. -by case: logn maxdimE; do 2?case. -Qed. - -End BGsection1. - -Section PuigSeriesGroups. - -Implicit Type gT : finGroupType. - -Canonical Puig_succ_group gT (D E : {set gT}) := [group of 'L_[D](E)]. - -Fact Puig_at_group_set n gT D : @group_set gT 'L_{n}(D). -Proof. by case: n => [|n]; apply: groupP. Qed. - -Canonical Puig_at_group n gT D := Group (@Puig_at_group_set n gT D). -Canonical Puig_inf_group gT (D : {set gT}) := [group of 'L_*(D)]. -Canonical Puig_group gT (D : {set gT}) := [group of 'L(D)]. - -End PuigSeriesGroups. - -Notation "''L_[' G ] ( L )" := (Puig_succ_group G L) : Group_scope. -Notation "''L_{' n } ( G )" := (Puig_at_group n G) - (at level 8, format "''L_{' n } ( G )") : Group_scope. -Notation "''L_*' ( G )" := (Puig_inf_group G) : Group_scope. -Notation "''L' ( G )" := (Puig_group G) : Group_scope. - -(* Elementary properties of the Puig series. *) -Section PuigBasics. - -Variable gT : finGroupType. -Implicit Types (D E : {set gT}) (G H : {group gT}). - -Lemma Puig0 D : 'L_{0}(D) = 1. Proof. by []. Qed. -Lemma PuigS n D : 'L_{n.+1}(D) = 'L_[D]('L_{n}(D)). Proof. by []. Qed. -Lemma Puig_recE n D : Puig_rec n D = 'L_{n}(D). Proof. by []. Qed. -Lemma Puig_def D : 'L(D) = 'L_[D]('L_*(D)). Proof. by []. Qed. - -Local Notation "D --> E" := (generated_by (norm_abelian D) E) - (at level 70, no associativity) : group_scope. - -Lemma Puig_gen D E : E --> 'L_[D](E). -Proof. by apply/existsP; exists (subgroups D). Qed. - -Lemma Puig_max G D E : D --> E -> E \subset G -> E \subset 'L_[G](D). -Proof. -case/existsP=> gE /eqP <-{E}; rewrite !gen_subG. -move/bigcupsP=> sEG; apply/bigcupsP=> A gEA; have [_ abnA]:= andP gEA. -by rewrite sub_gen // bigcup_sup // inE sEG. -Qed. - -Lemma norm_abgenS D1 D2 E : D1 \subset D2 -> D2 --> E -> D1 --> E. -Proof. -move=> sD12 /exists_eqP[gE <-{E}]. -apply/exists_eqP; exists [set A in gE | norm_abelian D2 A]. -congr <<_>>; apply: eq_bigl => A; rewrite !inE. -apply: andb_idr => /and3P[_ nAD cAA]. -by apply/andP; rewrite (subset_trans sD12). -Qed. - -Lemma Puig_succ_sub G D : 'L_[G](D) \subset G. -Proof. by rewrite gen_subG; apply/bigcupsP=> A /andP[]; rewrite inE. Qed. - -Lemma Puig_at_sub n G : 'L_{n}(G) \subset G. -Proof. by case: n => [|n]; rewrite ?sub1G ?Puig_succ_sub. Qed. - -(* This is B & G, Lemma B.1(d), first part. *) -Lemma Puig_inf_sub G : 'L_*(G) \subset G. -Proof. exact: Puig_at_sub. Qed. - -Lemma Puig_sub G : 'L(G) \subset G. -Proof. exact: Puig_at_sub. Qed. - -(* This is part of B & G, Lemma B.1(b). *) -Lemma Puig1 G : 'L_{1}(G) = G. -Proof. -apply/eqP; rewrite eqEsubset Puig_at_sub; apply/subsetP=> x Gx. -rewrite -cycle_subG sub_gen // -[<[x]>]/(gval _) bigcup_sup //=. -by rewrite inE cycle_subG Gx /= /norm_abelian cycle_abelian sub1G. -Qed. - -End PuigBasics. - -(* Functoriality of the Puig series. *) - -Fact Puig_at_cont n : GFunctor.iso_continuous (Puig_at n). -Proof. -elim: n => [|n IHn] aT rT G f injf; first by rewrite morphim1. -have IHnS := Puig_at_sub n; pose func_n := [igFun by IHnS & !IHn]. -rewrite !PuigS sub_morphim_pre ?Puig_succ_sub // gen_subG; apply/bigcupsP=> A. -rewrite inE => /and3P[sAG nAL cAA]; rewrite -sub_morphim_pre ?sub_gen //. -rewrite -[f @* A]/(gval _) bigcup_sup // inE morphimS // /norm_abelian. -rewrite morphim_abelian // -['L_{n}(_)](injmF func_n injf) //=. -by rewrite morphim_norms. -Qed. - -Canonical Puig_at_igFun n := [igFun by Puig_at_sub^~ n & !Puig_at_cont n]. - -Fact Puig_inf_cont : GFunctor.iso_continuous Puig_inf. -Proof. -by move=> aT rT G f injf; rewrite /Puig_inf card_injm // Puig_at_cont. -Qed. - -Canonical Puig_inf_igFun := [igFun by Puig_inf_sub & !Puig_inf_cont]. - -Fact Puig_cont : GFunctor.iso_continuous Puig. -Proof. by move=> aT rT G f injf; rewrite /Puig card_injm // Puig_at_cont. Qed. - -Canonical Puig_igFun := [igFun by Puig_sub & !Puig_cont]. diff --git a/mathcomp/odd_order/BGsection10.v b/mathcomp/odd_order/BGsection10.v deleted file mode 100644 index dbe9c6b..0000000 --- a/mathcomp/odd_order/BGsection10.v +++ /dev/null @@ -1,1503 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq div path fintype. -From mathcomp -Require Import bigop finset prime fingroup morphism perm automorphism quotient. -From mathcomp -Require Import action gproduct gfunctor pgroup cyclic center commutator. -From mathcomp -Require Import gseries nilpotent sylow abelian maximal hall. -From mathcomp -Require Import BGsection1 BGsection3 BGsection4 BGsection5 BGsection6. -From mathcomp -Require Import BGsection7 BGsection9. - -(******************************************************************************) -(* This file covers B & G, section 10, including with the definitions: *) -(* \alpha(M) == the primes p such that M has p-rank at least 3. *) -(* \beta(M) == the primes p in \alpha(M) such that Sylow p-subgroups of M *) -(* are not narrow (see BGsection5), i.e., such that M contains *) -(* no maximal elementary abelian subgroups of rank 2. In a *) -(* minimal counter-example G, \beta(M) is the intersection of *) -(* \alpha(M) and \beta(G). Note that B & G refers to primes in *) -(* \beta(G) as ``ideal'' primes, somewhat inconsistently. *) -(* \sigma(M) == the primes p such that there exists a p-Sylow subgroup P *) -(* of M whose normaliser (in the minimal counter-example) is *) -(* contained in M. *) -(* M`_\alpha == the \alpha(M)-core of M. *) -(* M`_\beta == the \beta(M)-core of M. *) -(* M`_\sigma == the \sigma(M)-core of M. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope. - -Reserved Notation "\alpha ( M )" (at level 2, format "\alpha ( M )"). -Reserved Notation "\beta ( M )" (at level 2, format "\beta ( M )"). -Reserved Notation "\sigma ( M )" (at level 2, format "\sigma ( M )"). - -Reserved Notation "M `_ \alpha" (at level 3, format "M `_ \alpha"). -Reserved Notation "M `_ \beta" (at level 3, format "M `_ \beta"). -Reserved Notation "M `_ \sigma" (at level 3, format "M `_ \sigma"). - -Section Def. - -Variable gT : finGroupType. -Implicit Type p : nat. - -Variable M : {set gT}. - -Definition alpha := [pred p | 2 < 'r_p(M)]. -Definition alpha_core := 'O_alpha(M). -Canonical Structure alpha_core_group := Eval hnf in [group of alpha_core]. - -Definition beta := - [pred p | [forall (P : {group gT} | p.-Sylow(M) P), ~~ p.-narrow P]]. -Definition beta_core := 'O_beta(M). -Canonical Structure beta_core_group := Eval hnf in [group of beta_core]. - -Definition sigma := - [pred p | [exists (P : {group gT} | p.-Sylow(M) P), 'N(P) \subset M]]. -Definition sigma_core := 'O_sigma(M). -Canonical Structure sigma_core_group := Eval hnf in [group of sigma_core]. - -End Def. - -Notation "\alpha ( M )" := (alpha M) : group_scope. -Notation "M `_ \alpha" := (alpha_core M) : group_scope. -Notation "M `_ \alpha" := (alpha_core_group M) : Group_scope. - -Notation "\beta ( M )" := (beta M) : group_scope. -Notation "M `_ \beta" := (beta_core M) : group_scope. -Notation "M `_ \beta" := (beta_core_group M) : Group_scope. - -Notation "\sigma ( M )" := (sigma M) : group_scope. -Notation "M `_ \sigma" := (sigma_core M) : group_scope. -Notation "M `_ \sigma" := (sigma_core_group M) : Group_scope. - -Section CoreTheory. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). -Implicit Type x : gT. -Implicit Type P : {group gT}. - -Section GenericCores. - -Variables H K : {group gT}. - -Lemma sigmaJ x : \sigma(H :^ x) =i \sigma(H). -Proof. -move=> p; apply/exists_inP/exists_inP=> [] [P sylP sNH]; last first. - by exists (P :^ x)%G; rewrite ?pHallJ2 // normJ conjSg. -by exists (P :^ x^-1)%G; rewrite ?normJ ?sub_conjgV // -(pHallJ2 _ _ _ x) actKV. -Qed. - -Lemma MsigmaJ x : (H :^ x)`_\sigma = H`_\sigma :^ x. -Proof. by rewrite /sigma_core -(eq_pcore H (sigmaJ x)) pcoreJ. Qed. - -Lemma alphaJ x : \alpha(H :^ x) =i \alpha(H). -Proof. by move=> p; rewrite !inE /= p_rankJ. Qed. - -Lemma MalphaJ x : (H :^ x)`_\alpha = H`_\alpha :^ x. -Proof. by rewrite /alpha_core -(eq_pcore H (alphaJ x)) pcoreJ. Qed. - -Lemma betaJ x : \beta(H :^ x) =i \beta(H). -Proof. -move=> p; apply/forall_inP/forall_inP=> nnSylH P sylP. - by rewrite -(@narrowJ _ _ _ x) nnSylH ?pHallJ2. -by rewrite -(@narrowJ _ _ _ x^-1) nnSylH // -(pHallJ2 _ _ _ x) actKV. -Qed. - -Lemma MbetaJ x : (H :^ x)`_\beta = H`_\beta :^ x. -Proof. by rewrite /beta_core -(eq_pcore H (betaJ x)) pcoreJ. Qed. - -End GenericCores. - -(* This remark appears at the start (p. 70) of B & G, Section 10, just after *) -(* the definition of ideal, which we do not include, since it is redundant *) -(* with the notation p \in \beta(G) that is used later. *) -Remark not_narrow_ideal p P : p.-Sylow(G) P -> ~~ p.-narrow P -> p \in \beta(G). -Proof. -move=> sylP nnP; apply/forall_inP=> Q sylQ. -by have [x _ ->] := Sylow_trans sylP sylQ; rewrite narrowJ. -Qed. - -Section MaxCores. - -Variables M : {group gT}. -Hypothesis maxM : M \in 'M. - -(* This is the first inclusion in the remark following the preliminary *) -(* definitions in B & G, p. 70. *) -Remark beta_sub_alpha : {subset \beta(M) <= \alpha(M)}. -Proof. -move=> p; rewrite !inE /= => /forall_inP nnSylM. -have [P sylP] := Sylow_exists p M; have:= nnSylM P sylP. -by rewrite negb_imply (p_rank_Sylow sylP) => /andP[]. -Qed. - -Remark alpha_sub_sigma : {subset \alpha(M) <= \sigma(M)}. -Proof. -move=> p a_p; have [P sylP] := Sylow_exists p M; have [sPM pP _ ] := and3P sylP. -have{a_p} rP: 2 < 'r(P) by rewrite (rank_Sylow sylP). -apply/exists_inP; exists P; rewrite ?uniq_mmax_norm_sub //. -exact: def_uniq_mmax (rank3_Uniqueness (mFT_pgroup_proper pP) rP) maxM sPM. -Qed. - -Remark beta_sub_sigma : {subset \beta(M) <= \sigma(M)}. -Proof. by move=> p; move/beta_sub_alpha; apply: alpha_sub_sigma. Qed. - -Remark Mbeta_sub_Malpha : M`_\beta \subset M`_\alpha. -Proof. exact: sub_pcore beta_sub_alpha. Qed. - -Remark Malpha_sub_Msigma : M`_\alpha \subset M`_\sigma. -Proof. exact: sub_pcore alpha_sub_sigma. Qed. - -Remark Mbeta_sub_Msigma : M`_\beta \subset M`_\sigma. -Proof. exact: sub_pcore beta_sub_sigma. Qed. - -(* This is the first part of the remark just above B & G, Theorem 10.1. *) -Remark norm_sigma_Sylow p P : - p \in \sigma(M) -> p.-Sylow(M) P -> 'N(P) \subset M. -Proof. -case/exists_inP=> Q sylQ sNPM sylP. -by case: (Sylow_trans sylQ sylP) => m mM ->; rewrite normJ conj_subG. -Qed. - -(* This is the second part of the remark just above B & G, Theorem 10.1. *) -Remark sigma_Sylow_G p P : p \in \sigma(M) -> p.-Sylow(M) P -> p.-Sylow(G) P. -Proof. -move=> sMp sylP; apply: (mmax_sigma_Sylow maxM) => //. -exact: norm_sigma_Sylow sMp sylP. -Qed. - -Lemma sigma_Sylow_neq1 p P : p \in \sigma(M) -> p.-Sylow(M) P -> P :!=: 1. -Proof. -move=> sMp /(norm_sigma_Sylow sMp); apply: contraTneq => ->. -by rewrite norm1 subTset -properT mmax_proper. -Qed. - -Lemma sigma_sub_pi : {subset \sigma(M) <= \pi(M)}. -Proof. -move=> p sMp; have [P sylP]:= Sylow_exists p M. -by rewrite -p_rank_gt0 -(rank_Sylow sylP) rank_gt0 (sigma_Sylow_neq1 sMp sylP). -Qed. - -Lemma predI_sigma_alpha : [predI \sigma(M) & \alpha(G)] =i \alpha(M). -Proof. -move=> p; rewrite inE /= -(andb_idl (@alpha_sub_sigma p)). -apply: andb_id2l => sMp; have [P sylP] := Sylow_exists p M. -by rewrite !inE -(rank_Sylow sylP) -(rank_Sylow (sigma_Sylow_G sMp sylP)). -Qed. - -Lemma predI_sigma_beta : [predI \sigma(M) & \beta(G)] =i \beta(M). -Proof. -move=> p; rewrite inE /= -(andb_idl (@beta_sub_sigma p)). -apply: andb_id2l => sMp; apply/idP/forall_inP=> [bGp P sylP | nnSylM]. - exact: forall_inP bGp P (sigma_Sylow_G sMp sylP). -have [P sylP] := Sylow_exists p M. -exact: not_narrow_ideal (sigma_Sylow_G sMp sylP) (nnSylM P sylP). -Qed. - -End MaxCores. - -End CoreTheory. - -Section Ten. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). - -Implicit Type p : nat. -Implicit Type A E H K M N P Q R S V W X Y : {group gT}. - -(* This is B & G, Theorem 10.1(d); note that we do not assume M is maximal. *) -Theorem sigma_Sylow_trans M p X g : - p \in \sigma(M) -> p.-Sylow(M) X -> X :^ g \subset M -> g \in M. -Proof. -move=> sMp sylX sXgM; have pX := pHall_pgroup sylX. -have [|h hM /= sXghX] := Sylow_Jsub sylX sXgM; first by rewrite pgroupJ. -by rewrite -(groupMr _ hM) (subsetP (norm_sigma_Sylow _ sylX)) ?inE ?conjsgM. -Qed. - -(* This is B & G, Theorem 10.1 (a, b, c). *) -(* Part (e) of Theorem 10.1 is obviously stated incorrectly, and this is *) -(* difficult to correct because it is not used in the rest of the proof. *) -Theorem sigma_group_trans M p X : - M \in 'M -> p \in \sigma(M) -> p.-group X -> - [/\ (*a*) forall g, X \subset M -> X :^ g \subset M -> - exists2 c, c \in 'C(X) & exists2 m, m \in M & g = c * m, - (*b*) [transitive 'C(X), on [set Mg in M :^: G | X \subset Mg] | 'Js ] - & (*c*) X \subset M -> 'C(X) * 'N_M(X) = 'N(X)]. -Proof. -move=> maxM sMp pX; have defNM := norm_mmax maxM. -pose OM (Y : {set gT}) : {set {set gT}} := [set Mg in M :^: G | Y \subset Mg]. -pose trM (Y : {set gT}) := [transitive 'C(Y), on OM Y | 'Js]. -have actsOM Y: [acts 'N(Y), on OM Y | 'Js]. - apply/actsP=> z nYz Q; rewrite !inE -{1}(normP nYz) conjSg. - by rewrite (acts_act (acts_orbit _ _ _)) ?inE. -have OMid Y: (gval M \in OM Y) = (Y \subset M) by rewrite inE orbit_refl. -have ntOM Y: p.-group Y -> exists B, gval B \in OM Y. - have [S sylS] := Sylow_exists p M; have sSM := pHall_sub sylS. - have sylS_G := sigma_Sylow_G maxM sMp sylS. - move=> pY; have [g Gg sXSg] := Sylow_subJ sylS_G (subsetT Y) pY. - by exists (M :^ g)%G; rewrite inE mem_orbit // (subset_trans sXSg) ?conjSg. -have maxOM Y H: gval H \in OM Y -> H \in 'M. - by case/setIdP=> /imsetP[g _ /val_inj->]; rewrite mmaxJ. -have part_c Y H: trM Y -> gval H \in OM Y -> 'C(Y) * 'N_H(Y) = 'N(Y). - move=> trMY O_H; rewrite -(norm_mmax (maxOM Y H O_H)) -(astab1Js H) setIC. - have [sCN nCN] := andP (cent_normal Y); rewrite -normC 1?subIset ?nCN //. - by apply/(subgroup_transitiveP O_H); rewrite ?(atrans_supgroup sCN) ?actsOM. -suffices trMX: trM X. - do [split; rewrite // -OMid] => [g O_M sXgM |]; last exact: part_c. - have O_Mg': M :^ g^-1 \in OM X by rewrite inE mem_orbit -?sub_conjg ?inE. - have [c Cc /= Mc] := atransP2 trMX O_M O_Mg'; exists c^-1; rewrite ?groupV //. - by exists (c * g); rewrite ?mulKg // -defNM inE conjsgM -Mc conjsgKV. -elim: {X}_.+1 {-2}X (ltnSn (#|G| - #|X|)) => // n IHn X geXn in pX *. -have{n IHn geXn} IHX Y: X \proper Y -> p.-group Y -> trM Y. - move=> ltXY; apply: IHn; rewrite -ltnS (leq_trans _ geXn) // ltnS. - by rewrite ltn_sub2l ?(leq_trans (proper_card ltXY)) // cardsT max_card. -have [-> | ntX] := eqsVneq X 1. - rewrite /trM cent1T /OM setIdE (setIidPl _) ?atrans_orbit //. - by apply/subsetP=> Mg; case/imsetP=> g _ ->; rewrite inE sub1G. -pose L := 'N(X)%G; have ltLG := mFT_norm_proper ntX (mFT_pgroup_proper pX). -have IH_L: {in OM X &, forall B B', - B != B' -> exists2 X1, X \proper gval X1 & p.-Sylow(B :&: L) X1}. -- move=> _ _ /setIdP[/imsetP[a Ga ->] sXMa] /setIdP[/imsetP[b Gb ->] sXMb]. - move=> neqMab. - have [S sylS sXS] := Sylow_superset sXMa pX; have [sSMa pS _] := and3P sylS. - have [defS | ltXS] := eqVproper sXS. - case/eqP: neqMab; apply: (canRL (actKV _ _)); apply: (act_inj 'Js a). - rewrite /= -conjsgM [_ :^ _]conjGid ?(sigma_Sylow_trans _ sylS) ?sigmaJ //. - by rewrite -defS conjsgM conjSg sub_conjgV. - have pSL: p.-group (S :&: L) := pgroupS (subsetIl _ _) pS. - have [X1 sylX1 sNX1] := Sylow_superset (setSI L sSMa) pSL; exists X1 => //. - by rewrite (proper_sub_trans (nilpotent_proper_norm (pgroup_nil pS) _)). -have [M1 O_M1] := ntOM X pX; apply/imsetP; exists (gval M1) => //; apply/eqP. -rewrite eqEsubset andbC acts_sub_orbit ?(subset_trans (cent_sub X)) // O_M1 /=. -apply/subsetP=> M2 O_M2. -have [-> | neqM12] := eqsVneq M1 M2; first exact: orbit_refl. -have [|X2 ltXX2 sylX2] := IH_L _ _ O_M2 O_M1; first by rewrite eq_sym. -have{IH_L neqM12} [X1 ltXX1 sylX1] := IH_L _ _ O_M1 O_M2 neqM12. -have [[sX1L1 pX1 _] [sX2L2 pX2 _]] := (and3P sylX1, and3P sylX2). -have [[sX1M1 sX1L] [sX2M2 sX2L]] := (subsetIP sX1L1, subsetIP sX2L2). -have [P sylP sX1P] := Sylow_superset sX1L pX1; have [sPL pP _] := and3P sylP. -have [M0 O_M0] := ntOM P pP; have [MG_M0 sPM0] := setIdP O_M0. -have [t Lt sX2Pt] := Sylow_subJ sylP sX2L pX2. -have [sX1M0 ltXP] := (subset_trans sX1P sPM0, proper_sub_trans ltXX1 sX1P). -have M0C_M1: gval M1 \in orbit 'Js 'C(X) M0. - rewrite (subsetP (imsetS _ (centS (proper_sub ltXX1)))) // -orbitE. - by rewrite (atransP (IHX _ ltXX1 pX1)) inE ?MG_M0 //; case/setIdP: O_M1 => ->. -have M0tC_M2: M2 \in orbit 'Js 'C(X) (M0 :^ t). - rewrite (subsetP (imsetS _ (centS (proper_sub ltXX2)))) // -orbitE. - rewrite (atransP (IHX _ ltXX2 pX2)) inE; first by case/setIdP: O_M2 => ->. - rewrite (acts_act (acts_orbit _ _ _)) ?inE ?MG_M0 //. - by rewrite (subset_trans sX2Pt) ?conjSg. -rewrite (orbit_eqP M0C_M1) (orbit_transl _ M0tC_M2). -have maxM0 := maxOM _ _ O_M0; have ltMG := mmax_proper maxM0. -have [rPgt2 | rPle2] := ltnP 2 'r(P). - have uP: P \in 'U by rewrite rank3_Uniqueness ?(mFT_pgroup_proper pP). - have uP_M0: 'M(P) = [set M0] := def_uniq_mmax uP maxM0 sPM0. - by rewrite conjGid ?orbit_refl ?(subsetP (sub_uniq_mmax uP_M0 sPL ltLG)). -have pl1L: p.-length_1 L. - have [oddL]: odd #|L| /\ 'r_p(L) <= 2 by rewrite mFT_odd -(rank_Sylow sylP). - by case/rank2_der1_complement; rewrite ?mFT_sol ?plength1_pseries2_quo. -have [|u v nLPu Lp'_v ->] := imset2P (_ : t \in 'N_L(P) * 'O_p^'(L)). - by rewrite normC ?plength1_Frattini // subIset ?gFnorm. -rewrite actM (orbit_transl _ (mem_orbit _ _ _)); last first. - have coLp'X: coprime #|'O_p^'(L)| #|X| := p'nat_coprime (pcore_pgroup _ _) pX. - apply: subsetP Lp'_v; have [sLp'L nLp'L] := andP (pcore_normal p^' L). - rewrite -subsetIidl -coprime_norm_cent ?subsetIidl //. - exact: subset_trans (normG X) nLp'L. -have [|w x nM0Pw cPx ->] := imset2P (_ : u \in 'N_M0(P) * 'C(P)). - rewrite normC ?part_c ?IHX //; first by case/setIP: nLPu. - by rewrite setIC subIset ?cent_norm. -rewrite actM /= conjGid ?mem_orbit //; last by case/setIP: nM0Pw. -by rewrite (subsetP (centS (subset_trans (proper_sub ltXX1) sX1P))). -Qed. - -Section OneMaximal. - -Variable M : {group gT}. -Hypothesis maxM : M \in 'M. - -Let ltMG := mmax_proper maxM. -Let solM := mmax_sol maxM. - -Let aMa : \alpha(M).-group (M`_\alpha). Proof. exact: pcore_pgroup. Qed. -Let nsMaM : M`_\alpha <| M. Proof. exact: pcore_normal. Qed. -Let sMaMs : M`_\alpha \subset M`_\sigma. Proof. exact: Malpha_sub_Msigma. Qed. - -Let F := 'F(M / M`_\alpha). -Let nsFMa : F <| M / M`_\alpha. Proof. exact: Fitting_normal. Qed. - -Let alpha'F : \alpha(M)^'.-group F. -Proof. -rewrite -[F](nilpotent_pcoreC \alpha(M) (Fitting_nil _)) -Fitting_pcore /=. -by rewrite trivg_pcore_quotient (trivgP (Fitting_sub 1)) dprod1g pcore_pgroup. -Qed. - -Let Malpha_quo_sub_Fitting : M^`(1) / M`_\alpha \subset F. -Proof. -have [/= K defF sMaK nsKM] := inv_quotientN nsMaM nsFMa; rewrite -/F in defF. -have [sKM _] := andP nsKM; have nsMaK: M`_\alpha <| K := normalS sMaK sKM nsMaM. -have [[_ nMaK] [_ nMaM]] := (andP nsMaK, andP nsMaM). -have hallMa: \alpha(M).-Hall(K) M`_\alpha. - by rewrite /pHall sMaK pcore_pgroup -card_quotient -?defF. -have [H hallH] := Hall_exists \alpha(M)^' (solvableS sKM solM). -have{hallH} defK := sdprod_normal_p'HallP nsMaK hallH hallMa. -have{defK} [_ sHK defK nMaH tiMaH] := sdprod_context defK. -have{defK} isoHF: H \isog F by rewrite [F]defF -defK quotientMidl quotient_isog. -have{sHK nMaH} sHM := subset_trans sHK sKM. -have{tiMaH isoHF sHM H} rF: 'r(F) <= 2. - rewrite -(isog_rank isoHF); have [p p_pr -> /=] := rank_witness H. - have [|a_p] := leqP 'r_p(M) 2; first exact: leq_trans (p_rankS p sHM). - rewrite 2?leqW // leqNgt p_rank_gt0 /= (card_isog isoHF) /= -/F. - exact: contraL (pnatPpi alpha'F) a_p. -by rewrite quotient_der // rank2_der1_sub_Fitting ?mFT_quo_odd ?quotient_sol. -Qed. - -Let sigma_Hall_sub_der1 H : \sigma(M).-Hall(M) H -> H \subset M^`(1). -Proof. -move=> hallH; have [sHM sH _] := and3P hallH. -rewrite -(Sylow_gen H) gen_subG; apply/bigcupsP=> P /SylowP[p p_pr sylP]. -have [-> | ntP] := eqsVneq P 1; first by rewrite sub1G. -have [sPH pP _] := and3P sylP; have{ntP} [_ p_dv_P _] := pgroup_pdiv pP ntP. -have{p_dv_P} s_p: p \in \sigma(M) := pgroupP (pgroupS sPH sH) p p_pr p_dv_P. -have{sylP} sylP: p.-Sylow(M) P := subHall_Sylow hallH s_p sylP. -have [sPM nMP] := (pHall_sub sylP, norm_sigma_Sylow s_p sylP). -have sylP_G := sigma_Sylow_G maxM s_p sylP. -have defG': G^`(1) = G. - have [_ simpG] := simpleP _ (mFT_simple gT). - by have [?|//] := simpG _ (der_normal 1 _); case/derG1P: (mFT_nonAbelian gT). -rewrite -subsetIidl -{1}(setIT P) -defG'. -rewrite (focal_subgroup_gen sylP_G) (focal_subgroup_gen sylP) genS //. -apply/subsetP=> _ /imset2P[x g Px /setIdP[Gg Pxg] ->]. -pose X := <[x]>; have sXM : X \subset M by rewrite cycle_subG (subsetP sPM). -have sXgM: X :^ g \subset M by rewrite -cycleJ cycle_subG (subsetP sPM). -have [trMX _ _] := sigma_group_trans maxM s_p (mem_p_elt pP Px). -have [c cXc [m Mm def_g]] := trMX _ sXM sXgM; rewrite cent_cycle in cXc. -have def_xg: x ^ g = x ^ m by rewrite def_g conjgM /conjg -(cent1P cXc) mulKg. -by rewrite commgEl def_xg -commgEl mem_imset2 // inE Mm -def_xg. -Qed. - -(* This is B & G, Theorem 10.2(a1). *) -Theorem Malpha_Hall : \alpha(M).-Hall(M) M`_\alpha. -Proof. -have [H hallH] := Hall_exists \sigma(M) solM; have [sHM sH _] := and3P hallH. -rewrite (subHall_Hall hallH (alpha_sub_sigma maxM)) // /pHall pcore_pgroup /=. -rewrite -(card_quotient (subset_trans sHM (normal_norm nsMaM))) -pgroupE. -rewrite (subset_trans sMaMs) ?pcore_sub_Hall ?(pgroupS _ alpha'F) //=. -exact: subset_trans (quotientS _ (sigma_Hall_sub_der1 hallH)) _. -Qed. - -(* This is B & G, Theorem 10.2(b1). *) -Theorem Msigma_Hall : \sigma(M).-Hall(M) M`_\sigma. -Proof. -have [H hallH] := Hall_exists \sigma(M) solM; have [sHM sH _] := and3P hallH. -rewrite /M`_\sigma (normal_Hall_pcore hallH) // -(quotientGK nsMaM). -rewrite -(quotientGK (normalS _ sHM nsMaM)) ?cosetpre_normal //; last first. - by rewrite (subset_trans sMaMs) ?pcore_sub_Hall. -have hallHa: \sigma(M).-Hall(F) (H / M`_\alpha). - apply: pHall_subl (subset_trans _ Malpha_quo_sub_Fitting) (Fitting_sub _) _. - by rewrite quotientS ?sigma_Hall_sub_der1. - exact: quotient_pHall (subset_trans sHM (normal_norm nsMaM)) hallH. -rewrite (nilpotent_Hall_pcore (Fitting_nil _) hallHa) /=. -exact: char_normal_trans (pcore_char _ _) nsFMa. -Qed. - -Lemma pi_Msigma : \pi(M`_\sigma) =i \sigma(M). -Proof. -move=> p; apply/idP/idP=> [|s_p /=]; first exact: pnatPpi (pcore_pgroup _ _). -by rewrite (card_Hall Msigma_Hall) pi_of_part // inE /= sigma_sub_pi. -Qed. - -(* This is B & G, Theorem 10.2(b2). *) -Theorem Msigma_Hall_G : \sigma(M).-Hall(G) M`_\sigma. -Proof. -rewrite pHallE subsetT /= eqn_dvd {1}(card_Hall Msigma_Hall). -rewrite partn_dvd ?cardG_gt0 ?cardSg ?subsetT //=. -apply/dvdn_partP; rewrite ?part_gt0 // => p. -rewrite pi_of_part ?cardG_gt0 // => /andP[_ s_p]. -rewrite partn_part => [|q /eqnP-> //]. -have [P sylP] := Sylow_exists p M; have [sPM pP _] := and3P sylP. -rewrite -(card_Hall (sigma_Sylow_G _ _ sylP)) ?cardSg //. -by rewrite (sub_Hall_pcore Msigma_Hall) ?(pi_pgroup pP). -Qed. - -(* This is B & G, Theorem 10.2(a2). *) -Theorem Malpha_Hall_G : \alpha(M).-Hall(G) M`_\alpha. -Proof. -apply: subHall_Hall Msigma_Hall_G (alpha_sub_sigma maxM) _. -exact: pHall_subl sMaMs (pcore_sub _ _) Malpha_Hall. -Qed. - -(* This is B & G, Theorem 10.2(c). *) -Theorem Msigma_der1 : M`_\sigma \subset M^`(1). -Proof. exact: sigma_Hall_sub_der1 Msigma_Hall. Qed. - -(* This is B & G, Theorem 10.2(d1). *) -Theorem Malpha_quo_rank2 : 'r(M / M`_\alpha) <= 2. -Proof. -have [p p_pr ->] := rank_witness (M / M`_\alpha). -have [P sylP] := Sylow_exists p M; have [sPM pP _] := and3P sylP. -have nMaP := subset_trans sPM (normal_norm nsMaM). -rewrite -(rank_Sylow (quotient_pHall nMaP sylP)) /= leqNgt. -have [a_p | a'p] := boolP (p \in \alpha(M)). - by rewrite quotientS1 ?rank1 ?(sub_Hall_pcore Malpha_Hall) ?(pi_pgroup pP). -rewrite -(isog_rank (quotient_isog _ _)) ?coprime_TIg ?(rank_Sylow sylP) //. -exact: pnat_coprime aMa (pi_pnat pP _). -Qed. - -(* This is B & G, Theorem 10.2(d2). *) -Theorem Malpha_quo_nil : nilpotent (M^`(1) / M`_\alpha). -Proof. exact: nilpotentS Malpha_quo_sub_Fitting (Fitting_nil _). Qed. - -(* This is B & G, Theorem 10.2(e). *) -Theorem Msigma_neq1 : M`_\sigma :!=: 1. -Proof. -without loss Ma1: / M`_\alpha = 1. - by case: eqP => // Ms1 -> //; apply/trivgP; rewrite -Ms1 Malpha_sub_Msigma. -have{Ma1} rFM: 'r('F(M)) <= 2. - rewrite (leq_trans _ Malpha_quo_rank2) // Ma1. - by rewrite -(isog_rank (quotient1_isog _)) rankS ?Fitting_sub. -pose q := max_pdiv #|M|; pose Q := 'O_q(M)%G. -have sylQ: q.-Sylow(M) Q := rank2_max_pcore_Sylow (mFT_odd M) solM rFM. -have piMq: q \in \pi(M) by rewrite pi_max_pdiv cardG_gt1 mmax_neq1. -have{piMq} ntQ: Q :!=: 1 by rewrite -rank_gt0 (rank_Sylow sylQ) p_rank_gt0. -rewrite (subG1_contra _ ntQ) ?(sub_Hall_pcore Msigma_Hall) ?pcore_sub //. -rewrite (pi_pgroup (pcore_pgroup _ _)) //; apply/exists_inP; exists Q => //. -by rewrite (mmax_normal maxM) ?pcore_normal. -Qed. - -(* This is B & G, Lemma 10.3. *) -Theorem cent_alpha'_uniq X : - X \subset M -> \alpha(M)^'.-group X -> 'r('C_(M`_\alpha)(X)) >= 2 -> - 'C_M(X)%G \in 'U. -Proof. -have ltM_G := sub_proper_trans (subsetIl M _) ltMG. -move=> sXM a'X; have [p p_pr -> rCX] := rank_witness 'C_(M`_\alpha)(X). -have{rCX} [B EpB] := p_rank_geP rCX; have{EpB} [sBCX abelB dimB] := pnElemP EpB. -have [[sBMa cXB] [pB cBB _]] := (subsetIP sBCX, and3P abelB). -have rMa: 1 < 'r_p(M`_\alpha) by rewrite -dimB -p_rank_abelem ?p_rankS. -have{rMa} a_p: p \in \alpha(M) by rewrite (pnatPpi aMa) // -p_rank_gt0 ltnW. -have nBX: X \subset 'N(B) by rewrite cents_norm // centsC. -have coMaX: coprime #|M`_\alpha| #|X| := pnat_coprime aMa a'X. -have [sMaM nMaM] := andP nsMaM; have solMa := solvableS sMaM solM. -have nMaX := subset_trans sXM nMaM. -have [P [sylP nPX sBP]] := coprime_Hall_subset nMaX coMaX solMa sBMa pB nBX. -have [sPMa pP _] := and3P sylP; have sPM := subset_trans sPMa sMaM. -have EpCB: B \in 'E_p^2('C_P(B)) by rewrite !inE subsetI sBP abelB dimB !andbT. -have: 1 < 'r_p('C_P(B)) by apply/p_rank_geP; exists B. -rewrite leq_eqVlt; case: ltngtP => // rCPB _. - apply: (uniq_mmaxS (subset_trans sBCX (setSI _ sMaM))) => //=. - have pCPB := pgroupS (subsetIl P 'C(B)) pP; rewrite -rank_pgroup // in rCPB. - have: 2 < 'r('C(B)) by rewrite (leq_trans rCPB) ?rankS ?subsetIr. - by apply: cent_rank3_Uniqueness; rewrite -dimB -rank_abelem. -have cPX: P \subset 'C(X). - have EpPB: B \in 'E_p(P) by apply/pElemP. - have coPX: coprime #|P| #|X| := coprimeSg sPMa coMaX. - rewrite centsC (coprime_odd_faithful_cent_abelem EpPB) ?mFT_odd //. - rewrite -(setIid 'C(B)) setIA (pmaxElem_LdivP p_pr _) 1?centsC //. - by rewrite (subsetP (p_rankElem_max _ _)) -?rCPB. -have sylP_M := subHall_Sylow Malpha_Hall a_p sylP. -have{sylP_M} rP: 2 < 'r(P) by rewrite (rank_Sylow sylP_M). -by rewrite rank3_Uniqueness ?(leq_trans rP (rankS _)) //= subsetI sPM. -Qed. - -Variable p : nat. - -(* This is B & G, Lemma 10.4(a). *) -(* We omit the redundant assumption p \in \pi(M). *) -Lemma der1_quo_sigma' : p %| #|M / M^`(1)| -> p \in \sigma(M)^'. -Proof. -apply: contraL => /= s_p; have piMp := sigma_sub_pi maxM s_p. -have p_pr: prime p by move: piMp; rewrite mem_primes; case/andP. -rewrite -p'natE ?(pi'_p'nat _ s_p) // -pgroupE -partG_eq1. -rewrite -(card_Hall (quotient_pHall _ Msigma_Hall)) /=; last first. - exact/gFsub_trans/gFnorm. -by rewrite quotientS1 ?cards1 // Msigma_der1. -Qed. - -Hypothesis s'p : p \in \sigma(M)^'. - -(* This is B & G, Lemma 10.4(b). *) -(* We do not need the assumption M`_\alpha != 1; the assumption p \in \pi(M) *) -(* is restated as P != 1. *) -Lemma cent1_sigma'_Zgroup P : - p.-Sylow(M) P -> P :!=: 1 -> - exists x, - [/\ x \in 'Ohm_1('Z(P))^#, 'M('C[x]) != [set M] & Zgroup 'C_(M`_\alpha)[x]]. -Proof. -move=> sylP ntP; have [sPM pP _] := and3P sylP; have nilP := pgroup_nil pP. -set T := 'Ohm_1('Z(P)); have charT: T \char P by rewrite !gFchar_trans. -suffices [x Tx not_uCx]: exists2 x, x \in T^# & 'M('C[x]) != [set M]. - exists x; split=> //; rewrite odd_rank1_Zgroup ?mFT_odd //= leqNgt. - apply: contra not_uCx; rewrite -cent_cycle; set X := <[x]> => rCMaX. - have{Tx} [ntX Tx] := setD1P Tx; rewrite -cycle_eq1 -/X in ntX. - have sXP: X \subset P by rewrite cycle_subG (subsetP (char_sub charT)). - rewrite (@def_uniq_mmaxS _ M 'C_M(X)) ?subsetIr ?mFT_cent_proper //. - apply: def_uniq_mmax; rewrite ?subsetIl //. - rewrite cent_alpha'_uniq ?(subset_trans sXP) ?(pi_pgroup (pgroupS sXP pP)) //. - by apply: contra s'p; apply: alpha_sub_sigma. -apply/exists_inP; rewrite -negb_forall_in; apply: contra s'p. -move/forall_inP => uCT; apply/exists_inP; exists P => //. -apply/subsetP=> u nPu; have [y Ty]: exists y, y \in T^#. - by apply/set0Pn; rewrite setD_eq0 subG1 Ohm1_eq1 center_nil_eq1. -rewrite -(norm_mmax maxM) (sameP normP eqP) (inj_eq (@group_inj gT)) -in_set1. -have Tyu: y ^ u \in T^#. - by rewrite memJ_norm // normD1 (subsetP (char_norms charT)). -by rewrite -(eqP (uCT _ Tyu)) -conjg_set1 normJ mmax_ofJ (eqP (uCT _ Ty)) set11. -Qed. - -(* This is B & G, Lemma 10.4(c), part 1. *) -(* The redundant assumption p \in \pi(M) is omitted. *) -Lemma sigma'_rank2_max : 'r_p(M) = 2 -> 'E_p^2(M) \subset 'E*_p(G). -Proof. -move=> rpM; apply: contraR s'p => /subsetPn[A Ep2A not_maxA]. -have{Ep2A} [sAM abelA dimA] := pnElemP Ep2A; have [pA _ _] := and3P abelA. -have [P sylP sAP] := Sylow_superset sAM pA; have [_ pP _] := and3P sylP. -apply/exists_inP; exists P; rewrite ?uniq_mmax_norm_sub //. -apply: def_uniq_mmaxS (mFT_pgroup_proper pP) (def_uniq_mmax _ _ sAM) => //. -by rewrite (@nonmaxElem2_Uniqueness _ p) // !(not_maxA, inE) abelA dimA subsetT. -Qed. - -(* This is B & G, Lemma 10.4(c), part 2 *) -(* The redundant assumption p \in \pi(M) is omitted. *) -Lemma sigma'_rank2_beta' : 'r_p(M) = 2 -> p \notin \beta(G). -Proof. -move=> rpM; rewrite -[p \in _]negb_exists_in negbK; apply/exists_inP. -have [A Ep2A]: exists A, A \in 'E_p^2(M) by apply/p_rank_geP; rewrite rpM. -have [_ abelA dimA] := pnElemP Ep2A; have [pA _] := andP abelA. -have [P sylP sAP] := Sylow_superset (subsetT _) pA. -exists P; rewrite ?inE //; apply/implyP=> _; apply/set0Pn. -exists A; rewrite 3!inE abelA dimA sAP (subsetP (pmaxElemS _ (subsetT P))) //. -by rewrite inE (subsetP (sigma'_rank2_max rpM)) // inE. -Qed. - -(* This is B & G, Lemma 10.5, part 1; the condition on X has been weakened, *) -(* because the proof of Lemma 12.2(a) requires the stronger result. *) -Lemma sigma'_norm_mmax_rank2 X : p.-group X -> 'N(X) \subset M -> 'r_p(M) = 2. -Proof. -move=> pX sNX_M; have sXM: X \subset M := subset_trans (normG X) sNX_M. -have [P sylP sXP] := Sylow_superset sXM pX; have [sPM pP _] := and3P sylP. -apply: contraNeq s'p; case: ltngtP => // rM _; last exact: alpha_sub_sigma. -apply/exists_inP; exists P; rewrite ?(subset_trans _ sNX_M) ?char_norms //. -rewrite sub_cyclic_char // (odd_pgroup_rank1_cyclic pP) ?mFT_odd //. -by rewrite (p_rank_Sylow sylP). -Qed. - -(* This is B & G, Lemma 10.5, part 2. We omit the second claim of B & G 10.5 *) -(* as it is an immediate consequence of sigma'_rank2_beta' (i.e., 10.4(c)). *) -Lemma sigma'1Elem_sub_p2Elem X : - X \in 'E_p^1(G) -> 'N(X) \subset M -> - exists2 A, A \in 'E_p^2(G) & X \subset A. -Proof. -move=> EpX sNXM; have sXM := subset_trans (normG X) sNXM. -have [[_ abelX dimX] p_pr] := (pnElemP EpX, pnElem_prime EpX). -have pX := abelem_pgroup abelX; have rpM2 := sigma'_norm_mmax_rank2 pX sNXM. -have [P sylP sXP] := Sylow_superset sXM pX; have [sPM pP _] := and3P sylP. -pose T := 'Ohm_1('Z(P)); pose A := X <*> T; have nilP := pgroup_nil pP. -have charT: T \char P by apply/gFchar_trans/gFchar. -have neqTX: T != X. - apply: contraNneq s'p => defX; apply/exists_inP; exists P => //. - by rewrite (subset_trans _ sNXM) // -defX char_norms. -have rP: 'r(P) = 2 by rewrite (rank_Sylow sylP) rpM2. -have ntT: T != 1 by rewrite Ohm1_eq1 center_nil_eq1 // -rank_gt0 rP. -have sAP: A \subset P by rewrite join_subG sXP char_sub. -have cTX: T \subset 'C(X) := centSS (Ohm_sub 1 _) sXP (subsetIr P _). -have{cTX} defA: X \* T = A by rewrite cprodEY. -have{defA} abelA : p.-abelem A. - have pZ: p.-group 'Z(P) := pgroupS (center_sub P) pP. - by rewrite (cprod_abelem _ defA) abelX Ohm1_abelem ?center_abelian. -exists [group of A]; last exact: joing_subl. -rewrite !inE subsetT abelA eqn_leq -{1}rP -{1}(rank_abelem abelA) rankS //=. -rewrite -dimX (properG_ltn_log (pgroupS sAP pP)) // /proper join_subG subxx. -rewrite joing_subl /=; apply: contra ntT => sTX; rewrite eqEsubset sTX in neqTX. -by rewrite -(setIidPr sTX) prime_TIg ?(card_pnElem EpX). -Qed. - -End OneMaximal. - -(* This is B & G, Theorem 10.6. *) -Theorem mFT_proper_plength1 p H : H \proper G -> p.-length_1 H. -Proof. -case/mmax_exists=> M /setIdP[maxM sHM]. -suffices{H sHM}: p.-length_1 M by apply: plength1S. -have [solM oddM] := (mmax_sol maxM, mFT_odd M). -have [rpMle2 | a_p] := leqP 'r_p(M) 2. - by rewrite plength1_pseries2_quo; case/rank2_der1_complement: rpMle2. -pose Ma := M`_\alpha; have hallMa: \alpha(M).-Hall(M) Ma := Malpha_Hall maxM. -have [[K hallK] [sMaM aMa _]] := (Hall_exists \alpha(M)^' solM, and3P hallMa). -have defM: Ma ><| K = M by apply/sdprod_Hall_pcoreP. -have{aMa} coMaK: coprime #|Ma| #|K| := pnat_coprime aMa (pHall_pgroup hallK). -suffices{a_p hallMa}: p.-length_1 Ma. - rewrite !p_elt_gen_length1 /p_elt_gen setIdE /= -/Ma -(setIidPl sMaM) -setIA. - rewrite -(setIdE M) (setIidPr _) //; apply/subsetP=> x; case/setIdP=> Mx p_x. - by rewrite (mem_Hall_pcore hallMa) /p_elt ?(pi_pnat p_x). -have{sMaM} <-: [~: Ma, K] = Ma. - have sMaMs: Ma \subset M`_\sigma := Malpha_sub_Msigma maxM. - have sMaM': Ma \subset M^`(1) := subset_trans sMaMs (Msigma_der1 maxM). - by have [] := coprime_der1_sdprod defM coMaK (solvableS sMaM solM) sMaM'. -have [q q_pr q_dv_Mq]: {q | prime q & q %| #|M / M^`(1)| }. - apply: pdivP; rewrite card_quotient ?der_norm // indexg_gt1 proper_subn //. - by rewrite (sol_der1_proper solM) ?mmax_neq1. -have s'q: q \in \sigma(M)^' by apply: der1_quo_sigma' q_dv_Mq. -have [Q sylQ] := Sylow_exists q K; have [sQK qQ _] := and3P sylQ. -have a'q: q \in \alpha(M)^' by apply: contra s'q; apply: alpha_sub_sigma. -have{a'q sylQ hallK} sylQ: q.-Sylow(M) Q := subHall_Sylow hallK a'q sylQ. -have{q_dv_Mq} ntQ: Q :!=: 1. - rewrite -rank_gt0 (rank_Sylow sylQ) p_rank_gt0 mem_primes q_pr cardG_gt0. - exact: dvdn_trans q_dv_Mq (dvdn_quotient _ _). -have{s'q sylQ ntQ} [x [Q1x _ ZgCx]] := cent1_sigma'_Zgroup maxM s'q sylQ ntQ. -have{Q1x} [ntx Q1x] := setD1P Q1x. -have sZQ := center_sub Q; have{sQK} sZK := subset_trans sZQ sQK. -have{sZK} Kx: x \in K by rewrite (subsetP sZK) // (subsetP (Ohm_sub 1 _)). -have{sZQ qQ} abelQ1 := Ohm1_abelem (pgroupS sZQ qQ) (center_abelian Q). -have{q q_pr Q abelQ1 Q1x} ox: prime #[x] by rewrite (abelem_order_p abelQ1). -move: Kx ox ZgCx; rewrite -cycle_subG -cent_cycle. -exact: odd_sdprod_Zgroup_cent_prime_plength1 solM oddM defM coMaK. -Qed. - -Section OneSylow. - -Variables (p : nat) (P : {group gT}). -Hypothesis sylP_G: p.-Sylow(G) P. -Let pP : p.-group P := pHall_pgroup sylP_G. - -(* This is an B & G, Corollary 10.7(a), second part (which does not depend on *) -(* a particular complement). *) -Corollary mFT_Sylow_der1 : P \subset 'N(P)^`(1). -Proof. -have [-> | ntP] := eqsVneq P 1; first exact: sub1G. -have ltNG: 'N(P) \proper G := mFT_norm_proper ntP (mFT_pgroup_proper pP). -have [M /setIdP[/= maxM sNM]] := mmax_exists ltNG. -have [ltMG solM] := (mmax_proper maxM, mmax_sol maxM). -have [pl1M sPM] := (mFT_proper_plength1 p ltMG, subset_trans (normG P) sNM). -have sylP := pHall_subl sPM (subsetT M) sylP_G. -have sMp: p \in \sigma(M) by apply/exists_inP; exists P. -apply: subset_trans (dergS 1 (subsetIr M 'N(P))) => /=. -apply: plength1_Sylow_sub_der1 sylP pl1M (subset_trans _ (Msigma_der1 maxM)). -by rewrite (sub_Hall_pcore (Msigma_Hall maxM)) ?(pi_pgroup pP). -Qed. - -(* This is B & G, Corollary 10.7(a), first part. *) -Corollary mFT_Sylow_sdprod_commg V : P ><| V = 'N(P) -> [~: P, V] = P. -Proof. -move=> defV; have sPN' := mFT_Sylow_der1. -have sylP := pHall_subl (normG P) (subsetT 'N(P)) sylP_G. -have [|//] := coprime_der1_sdprod defV _ (pgroup_sol pP) sPN'. -by rewrite (coprime_sdprod_Hall_l defV) // (pHall_Hall sylP). -Qed. - -(* This is B & G, Corollary 10.7(b). *) -Corollary mFT_rank2_Sylow_cprod : - 'r(P) < 3 -> ~~ abelian P -> - exists2 S, [/\ ~~ abelian (gval S), logn p #|S| = 3 & exponent S %| p] - & exists2 C, cyclic (gval C) & S \* C = P /\ 'Ohm_1(C) = 'Z(S). -Proof. -move=> rP not_cPP; have sylP := pHall_subl (normG P) (subsetT 'N(P)) sylP_G. -have ntP: P :!=: 1 by apply: contraNneq not_cPP => ->; apply: abelian1. -have ltNG: 'N(P) \proper G := mFT_norm_proper ntP (mFT_pgroup_proper pP). -have [V hallV] := Hall_exists p^' (mFT_sol ltNG); have [_ p'V _] := and3P hallV. -have defNP: P ><| V = 'N(P) := sdprod_normal_p'HallP (normalG P) hallV sylP. -have defP: [~: P, V] = P := mFT_Sylow_sdprod_commg defNP. -have [_] := rank2_coprime_comm_cprod pP (mFT_odd _) ntP rP defP p'V (mFT_odd _). -case=> [/idPn// | [S esS [C [mulSC cycC defC1]]]]. -exists S => //; exists C => //; split=> //; rewrite defC1. -have sSP: S \subset P by case/cprodP: mulSC => _ /mulG_sub[]. -have [[not_cSS dimS _] pS] := (esS, pgroupS sSP pP). -by have [||[]] := p3group_extraspecial pS; rewrite ?dimS. -Qed. - -(* This is B & G, Corollary 10.7(c). *) -Corollary mFT_sub_Sylow_trans : forall Q x, - Q \subset P -> Q :^ x \subset P -> exists2 y, y \in 'N(P) & Q :^ x = Q :^ y. -Proof. -move=> Q x; have [-> /trivgP-> /trivgP-> | ntP sQP sQxP] := eqsVneq P 1. - by exists 1; rewrite ?group1 ?conjs1g. -have ltNG: 'N(P) \proper G := mFT_norm_proper ntP (mFT_pgroup_proper pP). -have [M /=] := mmax_exists ltNG; case/setIdP=> maxM sNM. -have [ltMG solM] := (mmax_proper maxM, mmax_sol maxM). -have [pl1M sPM] := (mFT_proper_plength1 p ltMG, subset_trans (normG P) sNM). -have sylP := pHall_subl sPM (subsetT M) sylP_G. -have sMp: p \in \sigma(M) by apply/exists_inP; exists P. -have [transCQ _ _] := sigma_group_trans maxM sMp (pgroupS sQP pP). -have [||q cQq [u Mu defx]] := transCQ x; try exact: subset_trans _ sPM. -have nQC := normP (subsetP (cent_sub Q) _ _). -have [|q' cMQq' [y nMPy defu]] := plength1_Sylow_trans sylP pl1M solM sQP Mu. - by rewrite defx conjsgM nQC in sQxP. -have [[_ nPy] [_ cQq']] := (setIP nMPy, setIP cMQq'). -by exists y; rewrite // defx defu !conjsgM 2?nQC. -Qed. - -(* This is B & G, Corollary 10.7(d). *) -Corollary mFT_subnorm_Sylow Q : Q \subset P -> p.-Sylow('N(Q)) 'N_P(Q). -Proof. -move=> sQP; have pQ := pgroupS sQP pP. -have [S /= sylS] := Sylow_exists p 'N(Q); have [sNS pS _] := and3P sylS. -have sQS: Q \subset S := normal_sub_max_pgroup (Hall_max sylS) pQ (normalG Q). -have [x _ sSxP] := Sylow_Jsub sylP_G (subsetT S) pS. -have sQxP: Q :^ x \subset P by rewrite (subset_trans _ sSxP) ?conjSg. -have [y nPy defQy] := mFT_sub_Sylow_trans sQP sQxP. -have nQxy: x * y^-1 \in 'N(Q) by rewrite inE conjsgM defQy actK. -have sSxyP: S :^ (x * y^-1) \subset P by rewrite conjsgM sub_conjgV (normP nPy). -have sylSxy: p.-Sylow('N(Q)) (S :^ (x * y^-1)) by rewrite pHallJ. -have pNPQ: p.-group 'N_P(Q) := pgroupS (subsetIl P 'N(Q)) pP. -by rewrite (sub_pHall sylSxy pNPQ) ?subsetIr // subsetI sSxyP (@pHall_sub _ p). -Qed. - -(* This is B & G, Corollary 10.7(e). *) -Corollary mFT_Sylow_normalS Q R : - p.-group R -> Q \subset P :&: R -> Q <| 'N(P) -> Q <| 'N(R). -Proof. -move=> pR /subsetIP[sQP sQR] /andP[nQP nQ_NP]. -have [x _ sRxP] := Sylow_Jsub sylP_G (subsetT R) pR. -rewrite /normal normsG //; apply/subsetP=> y nRy. -have sQxP: Q :^ x \subset P by rewrite (subset_trans _ sRxP) ?conjSg. -have sQyxP: Q :^ (y * x) \subset P. - by rewrite actM (subset_trans _ sRxP) // -(normP nRy) !conjSg. -have [t tNP defQx] := mFT_sub_Sylow_trans sQP sQxP. -have [z zNP defQxy] := mFT_sub_Sylow_trans sQP sQyxP. -by rewrite inE -(conjSg _ _ x) -actM /= defQx defQxy !(normsP nQ_NP). -Qed. - -End OneSylow. - -Section AnotherMaximal. - -Variable M : {group gT}. -Hypothesis maxM : M \in 'M. - -Let solM : solvable M := mmax_sol maxM. -Let ltMG : M \proper G := mmax_proper maxM. - -Let sMbMs : M`_\beta \subset M`_\sigma := Mbeta_sub_Msigma maxM. -Let nsMbM : M`_\beta <| M := pcore_normal _ _. - -Let hallMs : \sigma(M).-Hall(M) M`_\sigma := Msigma_Hall maxM. -Let nsMsM : M`_\sigma <| M := pcore_normal _ M. -Let sMsM' : M`_\sigma \subset M^`(1) := Msigma_der1 maxM. - -Lemma Mbeta_der1 : M`_\beta \subset M^`(1). -Proof. exact: subset_trans sMbMs sMsM'. Qed. - -Let sM'M : M^`(1) \subset M := der_sub 1 M. -Let nsMsM' : M`_\sigma <| M^`(1) := normalS sMsM' sM'M nsMsM. -Let nsMbM' : M`_\beta <| M^`(1) := normalS Mbeta_der1 sM'M nsMbM. -Let nMbM' := normal_norm nsMbM'. - -(* This is B & G, Lemma 10.8(c). *) -Lemma beta_max_pdiv p : - p \notin \beta(M) -> - [/\ p^'.-Hall(M^`(1)) 'O_p^'(M^`(1)), - p^'.-Hall(M`_\sigma) 'O_p^'(M`_\sigma) - & forall q, q \in \pi(M / 'O_p^'(M)) -> q <= p]. -Proof. -rewrite !inE -negb_exists_in negbK => /exists_inP[P sylP nnP]. -have [|ncM' p_max] := narrow_der1_complement_max_pdiv (mFT_odd M) solM sylP nnP. - by rewrite mFT_proper_plength1 ?implybT. -by rewrite -(pcore_setI_normal _ nsMsM') (Hall_setI_normal nsMsM'). -Qed. - -(* This is B & G, Lemma 10.8(a), first part. *) -Lemma Mbeta_Hall : \beta(M).-Hall(M) M`_\beta. -Proof. -have [H hallH] := Hall_exists \beta(M) solM; have [sHM bH _]:= and3P hallH. -rewrite [M`_\beta](sub_pHall hallH) ?pcore_pgroup ?pcore_sub //=. -rewrite -(setIidPl sMbMs) pcore_setI_normal ?pcore_normal //. -have sH: \sigma(M).-group H := sub_pgroup (beta_sub_sigma maxM) bH. -have sHMs: H \subset M`_\sigma by rewrite (sub_Hall_pcore hallMs). -rewrite -pcoreNK -bigcap_p'core subsetI sHMs. -apply/bigcapsP=> p b'p; have [_ hallKp' _] := beta_max_pdiv b'p. -by rewrite (sub_Hall_pcore hallKp') ?(pi_p'group bH). -Qed. - -(* This is B & G, Lemma 10.8(a), second part. *) -Lemma Mbeta_Hall_G : \beta(M).-Hall(G) M`_\beta. -Proof. -apply: (subHall_Hall (Msigma_Hall_G maxM) (beta_sub_sigma maxM)). -exact: pHall_subl sMbMs (pcore_sub _ _) Mbeta_Hall. -Qed. - -(* This is an equivalent form of B & G, Lemma 10.8(b), which is used directly *) -(* later in the proof (e.g., Corollary 10.9a below, and Lemma 12.11), and is *) -(* proved as an intermediate step of the proof of of 12.8(b). *) -Lemma Mbeta_quo_nil : nilpotent (M^`(1) / M`_\beta). -Proof. -have /and3P[_ bMb b'M'Mb] := pHall_subl Mbeta_der1 sM'M Mbeta_Hall. -apply: nilpotentS (Fitting_nil (M^`(1) / M`_\beta)) => /=. -rewrite -{1}[_ / _]Sylow_gen gen_subG. -apply/bigcupsP=> Q /SylowP[q _ /and3P[sQM' qQ _]]. -apply: subset_trans (pcore_sub q _). -rewrite p_core_Fitting -pcoreNK -bigcap_p'core subsetI sQM' /=. -apply/bigcapsP=> [[p /= _] q'p]; have [b_p | b'p] := boolP (p \in \beta(M)). - by rewrite pcore_pgroup_id ?(pi'_p'group _ b_p) // /pgroup card_quotient. -have p'Mb: p^'.-group M`_\beta := pi_p'group bMb b'p. -rewrite sub_Hall_pcore ?(pi_p'group qQ) {Q qQ sQM'}//. -rewrite pquotient_pcore ?quotient_pHall 1?gFsub_trans //. -by have [-> _ _] := beta_max_pdiv b'p. -Qed. - -(* This is B & G, Lemma 10.8(b), generalized to arbitrary beta'-subgroups of *) -(* M^`(1) (which includes Hall beta'-subgroups of M^`(1) and M`_\beta). *) -Lemma beta'_der1_nil H : \beta(M)^'.-group H -> H \subset M^`(1) -> nilpotent H. -Proof. -move=> b'H sHM'; have [_ bMb _] := and3P Mbeta_Hall. -have{b'H} tiMbH: M`_\beta :&: H = 1 := coprime_TIg (pnat_coprime bMb b'H). -rewrite {tiMbH}(isog_nil (quotient_isog (subset_trans sHM' nMbM') tiMbH)). -exact: nilpotentS (quotientS _ sHM') Mbeta_quo_nil. -Qed. - -(* This is B & G, Corollary 10.9(a). *) -Corollary beta'_cent_Sylow p q X : - p \notin \beta(M) -> q \notin \beta(M) -> q.-group X -> - (p != q) && (X \subset M^`(1)) || (p < q) && (X \subset M) -> - [/\ (*a1*) exists2 P, p.-Sylow(M`_\sigma) (gval P) & X \subset 'C(P), - (*a2*) p \in \alpha(M) -> 'C_M(X)%G \in 'U - & (*a3*) q.-Sylow(M^`(1)) X -> - exists2 P, p.-Sylow(M^`(1)) (gval P) & P \subset 'N_M(X)^`(1)]. -Proof. -move=> b'p b'q qX q'p_sXM'; pose pq : nat_pred := pred2 p q. -have [q'p sXM]: p \in q^' /\ X \subset M. - case/orP: q'p_sXM' => /andP[q'p /subset_trans-> //]. - by rewrite !inE neq_ltn q'p. -have sXM'M: X <*> M^`(1) \subset M by rewrite join_subG sXM. -have solXM': solvable (X <*> M^`(1)) := solvableS sXM'M solM. -have pqX: pq.-group X by rewrite (pi_pgroup qX) ?inE ?eqxx ?orbT. -have{solXM' pqX} [W /= hallW sXW] := Hall_superset solXM' (joing_subl _ _) pqX. -have [sWXM' pqW _] := and3P hallW; have sWM := subset_trans sWXM' sXM'M. -have{b'q} b'W: \beta(M)^'.-group W. (* GG -- Coq diverges on b'p <> b'q *) - by apply: sub_pgroup pqW => r /pred2P[]->; [apply: b'p | apply: b'q]. -have nilM'W: nilpotent (M^`(1) :&: W). - by rewrite beta'_der1_nil ?subsetIl ?(pgroupS (subsetIr _ _)). -have{nilM'W} nilW: nilpotent W. - do [case/orP: q'p_sXM'=> /andP[]] => [_ sXM' | lt_pq _]. - by rewrite -(setIidPr sWXM') (joing_idPr sXM'). - pose Wq := 'O_p^'(M) :&: W; pose Wp := 'O_p(M^`(1) :&: W). - have nMp'M := char_norm (pcore_char p^' M). - have nMp'W := subset_trans sWM nMp'M. - have sylWq: q.-Sylow(W) Wq. - have [sWqMp' sWp'W] := subsetIP (subxx Wq). - have [Q sylQ] := Sylow_exists q W; have [sQW qQ _] := and3P sylQ. - rewrite [Wq](sub_pHall sylQ _ _ (subsetIr _ W)) //= -/Wq. - apply/pgroupP=> r r_pr r_dv_Wp'. - have:= pgroupP (pgroupS sWqMp' (pcore_pgroup _ _)) r r_pr r_dv_Wp'. - by apply/implyP; rewrite implyNb; apply: (pgroupP (pgroupS sWp'W pqW)). - have [[_ _ max_p] sQM] := (beta_max_pdiv b'p, subset_trans sQW sWM). - rewrite subsetI sQW -quotient_sub1 ?(subset_trans sQM nMp'M) //. - apply: contraLR lt_pq; rewrite -leqNgt andbT subG1 -rank_gt0. - rewrite (rank_pgroup (quotient_pgroup _ qQ)) p_rank_gt0 => piQb_q. - exact: max_p (piSg (quotientS _ sQM) piQb_q). - have nM'W: W \subset 'N(M^`(1)) by rewrite (subset_trans sWM) ?der_norm. - have qWWM': q.-group (W / (M^`(1) :&: W)). - rewrite (isog_pgroup _ (second_isog _)) ?(pgroupS (quotientS _ sWXM')) //=. - by rewrite (quotientYidr (subset_trans sXW nM'W)) quotient_pgroup. - have{qWWM'} sylWp: p.-Sylow(W) Wp. - rewrite /pHall pcore_pgroup gFsub_trans ?subsetIr //=. - rewrite -(Lagrange_index (subsetIr _ _) (pcore_sub _ _)) pnat_mul //. - rewrite -(divgS (pcore_sub _ _)) -card_quotient ?normsI ?normG //= -pgroupE. - rewrite (pi_p'group qWWM') //= -(dprod_card (nilpotent_pcoreC p nilM'W)). - by rewrite mulKn ?cardG_gt0 // -pgroupE pcore_pgroup. - have [[sWqW qWq _] [sWpW pWp _]] := (and3P sylWq, and3P sylWp). - have <-: Wp * Wq = W. - apply/eqP; rewrite eqEcard mul_subG //= -(partnC q (cardG_gt0 W)). - rewrite (coprime_cardMg (p'nat_coprime (pi_pnat pWp _) qWq)) //. - rewrite (card_Hall sylWp) (card_Hall sylWq) -{2}(part_pnat_id pqW) -partnI. - rewrite mulnC (@eq_partn _ p) // => r. - by rewrite !inE andb_orl andbN orbF; apply: andb_idr; move/eqP->. - apply: nilpotentS (mul_subG _ _) (Fitting_nil W). - rewrite Fitting_max ?(pgroup_nil pWp) //. - by rewrite gFnormal_trans //= setIC norm_normalI. - by rewrite Fitting_max ?(pgroup_nil qWq) //= setIC norm_normalI. -have part1: exists2 P : {group gT}, p.-Sylow(M`_\sigma) P & X \subset 'C(P). - have sMsXM' := subset_trans sMsM' (joing_subr X _). - have nsMsXM': M`_\sigma <| X <*> M^`(1) := normalS sMsXM' sXM'M nsMsM. - have sylWp: p.-Hall(M`_\sigma) ('O_p(W) :&: M`_\sigma). - rewrite setIC (Sylow_setI_normal nsMsXM') //. - exact: subHall_Sylow hallW (predU1l _ _) (nilpotent_pcore_Hall p nilW). - have [_ _ cWpWp' _] := dprodP (nilpotent_pcoreC p nilW). - exists ('O_p(W) :&: M`_\sigma)%G; rewrite ?(centSS _ _ cWpWp') ?subsetIl //. - by rewrite (sub_Hall_pcore (nilpotent_pcore_Hall _ _)) ?(pi_p'group qX). -split=> // [a_p | {part1}sylX]. - have ltCMX_G := sub_proper_trans (subsetIl M 'C(X)) ltMG. - have [P sylP cPX] := part1; have s_p := alpha_sub_sigma maxM a_p. - have{sylP} sylP := subHall_Sylow hallMs s_p sylP. - apply: rank3_Uniqueness ltCMX_G (leq_trans a_p _). - by rewrite -(rank_Sylow sylP) rankS //= subsetI (pHall_sub sylP) // centsC. -do [move: sWXM'; rewrite (joing_idPr (pHall_sub sylX)) => sWM'] in hallW. -have nMbX: X \subset 'N(M`_\beta) := subset_trans sXM (normal_norm nsMbM). -have nsMbXM : M`_\beta <*> X <| M. - rewrite -{2}(quotientGK nsMbM) -quotientYK ?cosetpre_normal //=. - rewrite (eq_Hall_pcore _ (quotient_pHall nMbX sylX)); last first. - exact: nilpotent_pcore_Hall Mbeta_quo_nil. - by rewrite gFnormal_trans ?quotient_normal ?gFnormal. -pose U := 'N_M(X); have defM: M`_\beta * U = M. - have sXU : X \subset U by rewrite subsetI sXM normG. - rewrite -[U](mulSGid sXU) /= -/U mulgA -norm_joinEr //. - apply: Frattini_arg nsMbXM (pHall_subl (joing_subr _ X) _ sylX). - by rewrite join_subG Mbeta_der1 (pHall_sub sylX). -have sWpU: 'O_p(W) \subset U. - rewrite gFsub_trans // subsetI sWM normal_norm //=. - have sylX_W: q.-Sylow(W) X := pHall_subl sXW sWM' sylX. - by rewrite (eq_Hall_pcore (nilpotent_pcore_Hall q nilW) sylX_W) pcore_normal. -have sylWp: p.-Sylow(M^`(1)) 'O_p(W). - exact: subHall_Sylow hallW (predU1l _ _) (nilpotent_pcore_Hall p nilW). -exists 'O_p(W)%G; rewrite //= -(setIidPl (pHall_sub sylWp)). -rewrite (pprod_focal_coprime defM) ?pcore_normal ?subsetIr //. -exact: pnat_coprime (pcore_pgroup _ _) (pi_pnat (pcore_pgroup _ _) _). -Qed. - -(* This is B & G, Corollary 10.9(b). *) -Corollary nonuniq_norm_Sylow_pprod p H S : - H \in 'M -> H :!=: M -> p.-Sylow(G) S -> 'N(S) \subset H :&: M -> - M`_\beta * (H :&: M) = M /\ \alpha(M) =i \beta(M). -Proof. -move=> maxH neqHM sylS_G sN_HM; have [sNH sNM] := subsetIP sN_HM. -have [sSM sSH] := (subset_trans (normG S) sNM, subset_trans (normG S) sNH). -have [sylS pS] := (pHall_subl sSM (subsetT M) sylS_G, pHall_pgroup sylS_G). -have sMp: p \in \sigma(M) by apply/exists_inP; exists S. -have aM'p: p \in \alpha(M)^'. - apply: contra neqHM; rewrite !inE -(rank_Sylow sylS) => rS. - have uniqS: S \in 'U := rank3_Uniqueness (mFT_pgroup_proper pS) rS. - by rewrite (eq_uniq_mmax (def_uniq_mmax uniqS maxM sSM) maxH sSH). -have sSM': S \subset M^`(1). - by rewrite (subset_trans _ sMsM') ?(sub_Hall_pcore hallMs) ?(pi_pgroup pS). -have nMbS := subset_trans sSM (normal_norm nsMbM). -have nMbSM: M`_\beta <*> S <| M. - rewrite -{2}(quotientGK nsMbM) -quotientYK ?cosetpre_normal //=. - have sylS_M' := pHall_subl sSM' sM'M sylS. - rewrite (eq_Hall_pcore _ (quotient_pHall nMbS sylS_M')); last first. - exact: nilpotent_pcore_Hall Mbeta_quo_nil. - by rewrite gFnormal_trans ?quotient_normal ?gFnormal. -have defM: M`_\beta * 'N_M(S) = M. - have sSNM: S \subset 'N_M(S) by rewrite subsetI sSM normG. - rewrite -(mulSGid sSNM) /= mulgA -norm_joinEr //. - by rewrite (Frattini_arg _ (pHall_subl _ _ sylS_G)) ?joing_subr ?subsetT. -split=> [|q]. - apply/eqP; rewrite setIC eqEsubset mulG_subG subsetIl pcore_sub /=. - by rewrite -{1}defM mulgS ?setIS. -apply/idP/idP=> [aMq|]; last exact: beta_sub_alpha. -apply: contraR neqHM => bM'q; have bM'p := contra (@beta_sub_alpha _ M p) aM'p. -have [|_ uniqNM _] := beta'_cent_Sylow bM'q bM'p pS. - by apply: contraR aM'p; rewrite sSM'; case: eqP => //= <- _. -rewrite (eq_uniq_mmax (def_uniq_mmax (uniqNM aMq) maxM (subsetIl _ _)) maxH) //. -by rewrite subIset ?(subset_trans (cent_sub _)) ?orbT. -Qed. - -(* This is B & G, Proposition 10.10. *) -Proposition max_normed_2Elem_signaliser p q (A Q : {group gT}) : - p != q -> A \in 'E_p^2(G) :&: 'E*_p(G) -> Q \in |/|*(A; q) -> - q %| #|'C(A)| -> - exists2 P : {group gT}, p.-Sylow(G) P /\ A \subset P - & [/\ (*a*) 'O_p^'('C(P)) * ('N(P) :&: 'N(Q)) = 'N(P), - (*b*) P \subset 'N(Q)^`(1) - & (*c*) q.-narrow Q -> P \subset 'C(Q)]. -Proof. -move=> neq_pq /setIP[Ep2A EpmA] maxQ piCAq. -have [_ abelA dimA] := pnElemP Ep2A; have [pA cAA _] := and3P abelA. -have [p_pr oA] := (pnElem_prime Ep2A, card_pnElem Ep2A). -have{dimA} rA2: 'r(A) = 2 by rewrite (rank_abelem abelA). -have{EpmA} ncA: normed_constrained A. - have ntA: A :!=: 1 by rewrite -rank_gt0 rA2. - exact: plength_1_normed_constrained ntA EpmA (mFT_proper_plength1 _). -pose pi := \pi(A); pose K := 'O_pi^'('C(A)). -have def_pi : pi =i (p : nat_pred). - by move=> r; rewrite !inE /= oA primes_exp ?primes_prime ?inE. -have pi'q : q \notin pi by rewrite def_pi !inE eq_sym. -have transKA: [transitive K, on |/|*(A; q) | 'JG]. - by rewrite normed_constrained_rank2_trans // (center_idP cAA) rA2. -have [P0 sylP0 sAP0] := Sylow_superset (subsetT _) pA. -have pP0: p.-group P0 := pHall_pgroup sylP0. -have piP0: pi.-group P0 by rewrite (eq_pgroup _ def_pi). -have{pP0} snAP0: A <|<| P0 := nilpotent_subnormal (pgroup_nil pP0) sAP0. -have{pi'q snAP0 ncA piP0} [//|] := normed_trans_superset ncA pi'q snAP0 piP0. -rewrite /= -/pi -/K => -> transKP submaxPA maxPfactoring. -have{transKP} [Q0 maxQ0 _] := imsetP transKP. -have{transKA} [k Kk defQ] := atransP2 transKA (subsetP submaxPA _ maxQ0) maxQ. -set P := P0 :^ k; have{sylP0} sylP: p.-Sylow(G) P by rewrite pHallJ ?in_setT. -have nAK: K \subset 'N(A) by rewrite cents_norm ?pcore_sub. -have{sAP0 nAK K Kk} sAP: A \subset P by rewrite -(normsP nAK k Kk) conjSg. -exists [group of P] => //. -have{maxPfactoring} [sPNQ' defNP] := maxPfactoring _ maxQ0. -move/(congr1 ('Js%act^~ k)): defNP sPNQ'; rewrite -(conjSg _ _ k) /=. -rewrite conjsMg !conjIg !conjsRg -!derg1 -!normJ -pcoreJ -centJ -/P. -rewrite -(congr_group defQ) (eq_pcore _ (eq_negn def_pi)) => defNP sPNQ'. -have{sPNQ'} sPNQ': P \subset 'N(Q)^`(1). - by rewrite (setIidPl (mFT_Sylow_der1 sylP)) in sPNQ'. -split=> // narrowQ; have [-> | ntQ] := eqsVneq Q 1; first exact: cents1. -pose AutQ := conj_aut Q @* 'N(Q). -have qQ: q.-group Q by case/mem_max_normed: maxQ. -have ltNG: 'N(Q) \proper G by rewrite mFT_norm_proper // (mFT_pgroup_proper qQ). -have{ltNG} qAutQ': q.-group AutQ^`(1). - have qAutQq: q.-group 'O_q(AutQ) := pcore_pgroup _ _. - rewrite (pgroupS _ qAutQq) // der1_min ?gFnorm //. - have solAutQ: solvable AutQ by rewrite morphim_sol -?mFT_sol_proper. - have [oddQ oddAutQ]: odd #|Q| /\ odd #|AutQ| by rewrite morphim_odd mFT_odd. - by have /(Aut_narrow qQ)[] := Aut_conj_aut Q 'N(Q). -have nQP: P \subset 'N(Q) := subset_trans sPNQ' (der_sub 1 _). -rewrite (sameP setIidPl eqP) eqEsubset subsetIl /=. -rewrite -quotient_sub1 ?normsI ?normG ?norms_cent //= -ker_conj_aut subG1. -rewrite trivg_card1 (card_isog (first_isog_loc _ _)) //= -trivg_card1 -subG1. -have q'AutP: q^'.-group (conj_aut Q @* P). - by rewrite morphim_pgroup //; apply: pi_pnat (pHall_pgroup sylP) _. -rewrite -(coprime_TIg (pnat_coprime qAutQ' q'AutP)) subsetI subxx. -by rewrite /= -morphim_der // morphimS. -Qed. - -(* Notation for Proposition 11, which is the last to appear in this segment. *) -Local Notation sigma' := \sigma(gval M)^'. - -(* This is B & G, Proposition 10.11(a). *) -Proposition sigma'_not_uniq K : K \subset M -> sigma'.-group K -> K \notin 'U. -Proof. -move=> sKM sg'K; have [E hallE sKE] := Hall_superset solM sKM sg'K. -have [sEM sg'E _] := and3P hallE. -have rEle2: 'r(E) <= 2. - have [q _ ->] := rank_witness E; rewrite leqNgt; apply/negP=> rEgt2. - have: q \in sigma' by rewrite (pnatPpi sg'E) // -p_rank_gt0 -(subnKC rEgt2). - by rewrite inE /= alpha_sub_sigma //; apply: leq_trans (p_rankS q sEM). -have [E1 | ntE]:= eqsVneq E 1. - by apply: contraL (@uniq_mmax_neq1 _ K) _; rewrite -subG1 -E1. -pose p := max_pdiv #|E|; pose P := 'O_p(E). -have piEp: p \in \pi(E) by rewrite pi_max_pdiv cardG_gt1. -have sg'p: p \in sigma' by rewrite (pnatPpi sg'E). -have sylP: p.-Sylow(E) P. - rewrite rank2_max_pcore_Sylow ?mFT_odd ?(solvableS sEM solM) //. - exact: leq_trans (rankS (Fitting_sub E)) rEle2. -apply: contra (sg'p) => uniqK; apply/existsP; exists [group of P]. -have defMK := def_uniq_mmax uniqK maxM (subset_trans sKE sEM). -rewrite (subHall_Sylow hallE) // (sub_uniq_mmax defMK) //; last first. - rewrite mFT_norm_proper ?(mFT_pgroup_proper (pcore_pgroup _ _)) //. - by rewrite -cardG_gt1 (card_Hall sylP) p_part_gt1. -by rewrite (subset_trans sKE) // gFnorm. -Qed. - -(* This is B & G, Proposition 10.11(b). *) -Proposition sub'cent_sigma_rank1 K : - K \subset M -> sigma'.-group K -> 'r('C_K(M`_\sigma)) <= 1. -Proof. -move=> sKM sg'K; rewrite leqNgt; apply/rank_geP=> [[A /nElemP[p Ep2A]]]. -have p_pr := pnElem_prime Ep2A. -have [sACKMs abelA dimA] := pnElemP Ep2A; rewrite subsetI centsC in sACKMs. -have{sACKMs} [sAK cAMs]: A \subset K /\ M`_\sigma \subset 'C(A) := andP sACKMs. -have sg'p: p \in sigma'. - by rewrite (pgroupP (pgroupS sAK sg'K)) // (card_pnElem Ep2A) dvdn_mull. -have [Ms1 | [q q_pr q_dvd_Ms]] := trivgVpdiv M`_\sigma. - by case/eqP: (Msigma_neq1 maxM). -have sg_q: q \in \sigma(M) := pgroupP (pcore_pgroup _ _) _ q_pr q_dvd_Ms. -have neq_pq: p != q by apply: contraNneq sg'p => ->. -have [Q sylQ] := Sylow_exists q M`_\sigma; have [sQMs qQ _] := and3P sylQ. -have cAQ: Q \subset 'C(A) := subset_trans sQMs cAMs. -have{q_dvd_Ms} q_dv_CA: q %| #|'C(A)|. - rewrite (dvdn_trans _ (cardSg cAQ)) // -(part_pnat_id (pnat_id q_pr)). - by rewrite (card_Hall sylQ) partn_dvd. -have{cAQ} maxQ: Q \in |/|*(A; q). - rewrite inE; apply/maxgroupP; rewrite qQ cents_norm 1?centsC //. - split=> // Y /andP[qY _] sQY; apply: sub_pHall qY sQY (subsetT Y). - by rewrite (subHall_Sylow (Msigma_Hall_G maxM)). -have sNQM: 'N(Q) \subset M. - by rewrite (norm_sigma_Sylow sg_q) // (subHall_Sylow hallMs). -have rCAle2: 'r('C(A)) <= 2. - apply: contraR (sigma'_not_uniq sKM sg'K); rewrite -ltnNge => rCAgt2. - apply: uniq_mmaxS sAK (sub_mmax_proper maxM sKM) _. - by apply: cent_rank3_Uniqueness rCAgt2; rewrite (rank_abelem abelA) dimA. -have max2A: A \in 'E_p^2(G) :&: 'E*_p(G). - rewrite 3!inE subsetT abelA dimA; apply/pmaxElemP; rewrite inE subsetT. - split=> // Y /pElemP[_ abelY /eqVproper[]//ltAY]. - have [pY cYY _] := and3P abelY. - suffices: 'r_p('C(A)) > 2 by rewrite ltnNge (leq_trans (p_rank_le_rank p _)). - rewrite -dimA (leq_trans (properG_ltn_log pY ltAY)) //. - by rewrite logn_le_p_rank // inE centsC (subset_trans (proper_sub ltAY)). -have{rCAle2 cAMs} Ma1: M`_\alpha = 1. - apply: contraTeq rCAle2; rewrite -rank_gt0 -ltnNge. - have [r _ ->] := rank_witness M`_\alpha; rewrite p_rank_gt0. - move/(pnatPpi (pcore_pgroup _ _))=> a_r; apply: (leq_trans a_r). - have [R sylR] := Sylow_exists r M`_\sigma. - have sylR_M: r.-Sylow(M) R. - by rewrite (subHall_Sylow (Msigma_Hall maxM)) ?alpha_sub_sigma. - rewrite -(p_rank_Sylow sylR_M) (p_rank_Sylow sylR). - by rewrite (leq_trans (p_rank_le_rank r _)) // rankS // centsC. -have{Ma1} nilM': nilpotent M^`(1). - by rewrite (isog_nil (quotient1_isog _)) -Ma1 Malpha_quo_nil. -have{max2A maxQ neq_pq q_dv_CA} [P [sylP sAP] sPNQ']: - exists2 P : {group gT}, p.-Sylow(G) P /\ A \subset P & P \subset 'N(Q)^`(1). -- by case/(max_normed_2Elem_signaliser neq_pq): maxQ => // P ? []; exists P. -have{sNQM} defP: 'O_p(M^`(1)) = P. - rewrite (nilpotent_Hall_pcore nilM' (pHall_subl _ _ sylP)) ?subsetT //. - by rewrite (subset_trans sPNQ') ?dergS. -have nsPM: P <| M by rewrite -defP !gFnormal_trans. -have sPM := normal_sub nsPM. -case/exists_inP: sg'p; exists P; first exact: pHall_subl (subsetT M) sylP. -by rewrite (mmax_normal maxM) // -rank_gt0 ltnW // -dimA -rank_abelem ?rankS. -Qed. - -(* This is B & G, Proposition 10.11(c). *) -Proposition sub'cent_sigma_cyclic K (Y := 'C_K(M`_\sigma) :&: M^`(1)) : - K \subset M -> sigma'.-group K -> cyclic Y /\ Y <| M. -Proof. -move=> sKM sg'K; pose Z := 'O_sigma'('F(M)). -have nsZM: Z <| M by rewrite !gFnormal_trans. -have [sZM nZM] := andP nsZM; have Fnil := Fitting_nil M. -have rZle1: 'r(Z) <= 1. - apply: leq_trans (rankS _) (sub'cent_sigma_rank1 sZM (pcore_pgroup _ _)). - rewrite subsetI subxx (sameP commG1P trivgP) /=. - rewrite -(TI_pcoreC \sigma(M) M 'F(M)) subsetI commg_subl commg_subr. - by rewrite (subset_trans sZM) ?gFnorm ?gFsub_trans. -have{rZle1} cycZ: cyclic Z. - have nilZ: nilpotent Z := nilpotentS (gFsub _ _) Fnil. - by rewrite nil_Zgroup_cyclic // odd_rank1_Zgroup // mFT_odd. -have cZM': M^`(1) \subset 'C_M(Z). - rewrite der1_min ?normsI ?normG ?norms_cent //= -ker_conj_aut. - rewrite (isog_abelian (first_isog_loc _ _)) //. - by rewrite (abelianS (Aut_conj_aut _ _)) // Aut_cyclic_abelian. -have sYF: Y \subset 'F(M). - apply: subset_trans (cent_sub_Fitting (mmax_sol maxM)). - have [_ /= <- _ _] := dprodP (nilpotent_pcoreC \sigma(M) Fnil). - by rewrite centM setICA setISS // setIC subIset ?centS // pcore_Fitting. -have{sYF} sYZ: Y \subset Z. - rewrite (sub_Hall_pcore (nilpotent_pcore_Hall _ Fnil)) //=. - by rewrite -setIA (pgroupS (subsetIl K _)). -by rewrite (cyclicS sYZ cycZ) (char_normal_trans _ nsZM) // sub_cyclic_char. -Qed. - -(* This is B & G, Proposition 10.11(d). *) -Proposition commG_sigma'_1Elem_cyclic p K P (K0 := [~: K, P]) : - K \subset M -> sigma'.-group K -> p \in sigma' -> P \in 'E_p^1('N_M(K)) -> - 'C_(M`_\sigma)(P) = 1 -> p^'.-group K -> abelian K -> - [/\ K0 \subset 'C(M`_\sigma), cyclic K0 & K0 <| M]. -Proof. -move=> sKM sg'K sg'p EpP regP p'K cKK. -have nK0P: P \subset 'N(K0) := commg_normr P K. -have p_pr := pnElem_prime EpP; have [sPMN _ oP] := pnElemPcard EpP. -have [sPM nKP]: P \subset M /\ P \subset 'N(K) by apply/subsetIP. -have /andP[sMsM nMsM]: M`_\sigma <| M := pcore_normal _ _. -have sK0K: K0 \subset K by rewrite commg_subl. -have [sK0M sg'K0]:= (subset_trans sK0K sKM, pgroupS sK0K sg'K). -have [nMsK0 nMsP] := (subset_trans sK0M nMsM, subset_trans sPM nMsM). -have coKP: coprime #|K| #|P| by rewrite oP coprime_sym prime_coprime -?p'natE. -have coK0Ms: coprime #|K0| #|M`_\sigma|. - by rewrite coprime_sym (pnat_coprime (pcore_pgroup _ _)). -have nilK0Ms: nilpotent (K0 <*> M`_\sigma). - have mulK0MsP: K0 <*> M`_\sigma ><| P = K0 <*> M`_\sigma <*> P. - rewrite sdprodEY ?normsY // coprime_TIg //= norm_joinEl //. - rewrite coprime_cardMg // coprime_mull (coprimeSg sK0K) //. - by rewrite oP (pnat_coprime (pcore_pgroup _ _)) ?pnatE. - apply: (prime_Frobenius_sol_kernel_nil mulK0MsP); rewrite ?oP //=. - by rewrite (solvableS _ solM) // !join_subG sK0M pcore_sub. - rewrite norm_joinEl // -subcent_TImulg ?subsetI ?nK0P //. - by rewrite coprime_abel_cent_TI ?mul1g. - exact: coprime_TIg. -have cMsK0: K0 \subset 'C(M`_\sigma). - rewrite (sub_nilpotent_cent2 nilK0Ms) ?joing_subl ?joing_subr //. - exact: pnat_coprime (pcore_pgroup _ _) sg'K0. -have [cycY nsYM] := sub'cent_sigma_cyclic sK0M sg'K0. -set Y := _ :&: _ in cycY nsYM. -have sK0Y: K0 \subset Y by rewrite !subsetI subxx cMsK0 commgSS. -split=> //; first exact: cyclicS sK0Y cycY. -by apply: char_normal_trans nsYM; rewrite sub_cyclic_char. -Qed. - -End AnotherMaximal. - -(* This is B & G, Lemma 10.12. *) -Lemma sigma_disjoint M H : - M \in 'M -> H \in 'M -> gval H \notin M :^: G -> - [/\ (*a*) M`_\alpha :&: H`_\sigma = 1, - [predI \alpha(M) & \sigma(H)] =i pred0 - & (*b*) nilpotent M`_\sigma -> - M`_\sigma :&: H`_\sigma = 1 - /\ [predI \sigma(M) & \sigma(H)] =i pred0]. -Proof. -move=> maxM maxH notjMH. -suffices sigmaMHnil p: p \in [predI \sigma(M) & \sigma(H)] -> - p \notin \alpha(M) /\ ~~ nilpotent M`_\sigma. -- have a2: [predI \alpha(M) & \sigma(H)] =i pred0. - move=> p; apply/andP=> [[/= aMp sHp]]. - by case: (sigmaMHnil p); rewrite /= ?aMp // inE /= alpha_sub_sigma. - split=> // [|nilMs]. - rewrite coprime_TIg // (pnat_coprime (pcore_pgroup _ _)) //. - apply: sub_in_pnat (pcore_pgroup _ _) => p _ sHp. - by apply: contraFN (a2 p) => aMp; rewrite inE /= sHp andbT. - have b2: [predI \sigma(M) & \sigma(H)] =i pred0. - by move=> p; apply/negP; case/sigmaMHnil => _; rewrite nilMs. - rewrite coprime_TIg // (pnat_coprime (pcore_pgroup _ _)) //. - apply: sub_in_pnat (pcore_pgroup _ _) => p _ sHp. - by apply: contraFN (b2 p) => bMp; rewrite inE /= sHp andbT. -case/andP=> sMp sHp; have [S sylS]:= Sylow_exists p M. -have [sSM pS _] := and3P sylS. -have sylS_G: p.-Sylow(G) S := sigma_Sylow_G maxM sMp sylS. -have [g sSHg]: exists g, S \subset H :^ g. - have [Sg' sylSg']:= Sylow_exists p H. - have [g _ ->] := Sylow_trans (sigma_Sylow_G maxH sHp sylSg') sylS_G. - by exists g; rewrite conjSg (pHall_sub sylSg'). -have{notjMH} neqHgM: H :^ g != M. - by apply: contraNneq notjMH => <-; rewrite orbit_sym mem_orbit ?in_setT. -do [split; apply: contra neqHgM] => [|nilMs]. - rewrite !inE -(p_rank_Sylow sylS) -rank_pgroup //= => rS_gt3. - have uniqS: S \in 'U := rank3_Uniqueness (mFT_pgroup_proper pS) rS_gt3. - have defUS: 'M(S) = [set M] := def_uniq_mmax uniqS maxM sSM. - by rewrite (eq_uniq_mmax defUS _ sSHg) ?mmaxJ. -have nsSM: S <| M. - have nsMsM: M`_\sigma <| M by apply: pcore_normal. - have{sylS} sylS: p.-Sylow(M`_\sigma) S. - apply: pHall_subl (pcore_sub _ _) sylS => //. - by rewrite (sub_Hall_pcore (Msigma_Hall maxM)) ?(pi_pgroup pS). - by rewrite (nilpotent_Hall_pcore nilMs sylS) gFnormal_trans. -have sNS_Hg: 'N(S) \subset H :^ g. - rewrite -sub_conjgV -normJ (norm_sigma_Sylow sHp) //. - by rewrite (pHall_subl _ (subsetT _)) ?sub_conjgV // pHallJ ?in_setT. -have ltHg: H :^ g \proper G by rewrite mmax_proper ?mmaxJ //. -rewrite (mmax_max maxM ltHg) // -(mmax_normal maxM nsSM) //. -by apply: contraTneq sNS_Hg => ->; rewrite norm1 proper_subn. -Qed. - -(* This is B & G, Lemma 10.13. *) -Lemma basic_p2maxElem_structure p A P : - A \in 'E_p^2(G) :&: 'E*_p(G) -> p.-group P -> A \subset P -> ~~ abelian P -> - let Z0 := ('Ohm_1('Z(P)))%G in - [/\ (*a*) Z0 \in 'E_p^1(A), - (*b*) exists Y : {group gT}, - [/\ cyclic Y, Z0 \subset Y - & forall A0, A0 \in 'E_p^1(A) :\ Z0 -> A0 \x Y = 'C_P(A)] - & (*c*) [transitive 'N_P(A), on 'E_p^1(A) :\ Z0| 'JG]]. -Proof. -case/setIP=> Ep2A maxA pP sAP not_cPP Z0; set E1A := 'E_p^1(A). -have p_pr: prime p := pnElem_prime Ep2A; have [_ abelA dimA] := pnElemP Ep2A. -have [oA [pA cAA _]] := (card_pnElem Ep2A, and3P abelA). -have [p_gt0 p_gt1] := (prime_gt0 p_pr, prime_gt1 p_pr). -have{maxA} maxA S: - p.-group S -> A \subset S -> A \in 'E*_p(S) /\ 'Ohm_1('C_S(A)) = A. -- move=> pS sAS; suff maxAS: A \in 'E*_p(S) by rewrite (Ohm1_cent_max maxAS). - by rewrite (subsetP (pmaxElemS p (subsetT S))) // inE maxA inE. -have [S sylS sPS] := Sylow_superset (subsetT P) pP. -pose Z1 := 'Ohm_1('Z(S))%G; have sZ1Z: Z1 \subset 'Z(S) := Ohm_sub 1 _. -have [pS sAS] := (pHall_pgroup sylS, subset_trans sAP sPS). -have [maxAS defC1] := maxA S pS sAS; set C := 'C_S(A) in defC1. -have sZ0A: Z0 \subset A by rewrite -defC1 OhmS // setISS // centS. -have sZ1A: Z1 \subset A by rewrite -defC1 OhmS // setIS // centS. -have [pZ0 pZ1]: p.-group Z0 /\ p.-group Z1 by split; apply: pgroupS pA. -have sZ10: Z1 \subset Z0. - rewrite -[gval Z1]Ohm_id OhmS // subsetI (subset_trans sZ1A) //=. - by rewrite (subset_trans sZ1Z) // subIset // centS ?orbT. -have ntZ1: Z1 :!=: 1. - have: A :!=: 1 by rewrite -cardG_gt1 oA (ltn_exp2l 0). - apply: contraNneq; rewrite -subG1 -(setIidPr sZ1Z) => /TI_Ohm1. - by rewrite setIid => /(trivg_center_pgroup pS) <-. -have EpZ01: abelian C -> Z1 = Z0 /\ Z0 \in E1A. - move=> cCC; have [eqZ0A | ltZ0A] := eqVproper sZ0A. - rewrite (abelianS _ cCC) // in not_cPP. - by rewrite subsetI sPS centsC -eqZ0A gFsub_trans ?subsetIr. - have leZ0p: #|Z0| <= p ^ 1. - by rewrite (card_pgroup pZ0) leq_exp2l // -ltnS -dimA properG_ltn_log. - have [_ _ [e oZ1]] := pgroup_pdiv pZ1 ntZ1. - have{e oZ1}: #|Z1| >= p by rewrite oZ1 (leq_exp2l 1). - rewrite (geq_leqif (leqif_trans (subset_leqif_card sZ10) (leqif_eq leZ0p))). - rewrite [E1A]p1ElemE // !inE sZ0A; case/andP=> sZ01 ->. - by split=> //; apply/eqP; rewrite -val_eqE eqEsubset sZ10. -have [A1 neqA1Z EpA1]: exists2 A1, A1 != Z1 & #|Z1| = p -> A1 \in E1A. - have [oZ1 |] := #|Z1| =P p; last by exists 1%G; rewrite // eq_sym. - have [A1 defA]:= abelem_split_dprod abelA sZ1A. - have{defA} [_ defA _ tiA1Z1] := dprodP defA. - have EpZ1: Z1 \in E1A by rewrite [E1A]p1ElemE // !inE sZ1A /= oZ1. - suffices: A1 \in E1A by exists A1; rewrite // eq_sym; apply/(TIp1ElemP EpZ1). - rewrite [E1A]p1ElemE // !inE -defA mulG_subr /=. - by rewrite -(mulKn #|A1| p_gt0) -{1}oZ1 -TI_cardMg // defA oA mulKn. -pose cplA1C Y := [/\ cyclic Y, Z0 \subset Y, A1 \x Y = C & abelian C]. -have [Y [{cplA1C} cycY sZ0Y defC cCC]]: exists Y, cplA1C Y. - have [rSgt2 | rSle2] := ltnP 2 'r(S). - rewrite (rank_pgroup pS) in rSgt2; have oddS := mFT_odd S. - have max2AS: A \in 'E_p^2(S) :&: 'E*_p(S) by rewrite 3!inE sAS abelA dimA. - have oZ1: #|Z1| = p by case/Ohm1_ucn_p2maxElem: max2AS => // _ []. - have{EpA1} EpA1 := EpA1 oZ1; have [sA1A abelA1 oA1] := pnElemPcard EpA1. - have EpZ1: Z1 \in E1A by rewrite [E1A]p1ElemE // !inE sZ1A /= oZ1. - have [_ defA cA1Z tiA1Z] := dprodP (p2Elem_dprodP Ep2A EpA1 EpZ1 neqA1Z). - have defC: 'C_S(A1) = C. - rewrite /C -defA centM setICA setIC ['C_S(Z1)](setIidPl _) // centsC. - by rewrite (subset_trans sZ1Z) ?subsetIr. - have rCSA1: 'r_p('C_S(A1)) <= 2. - by rewrite defC -p_rank_Ohm1 defC1 (p_rank_abelem abelA) dimA. - have sA1S := subset_trans sA1A sAS. - have nnS: p.-narrow S by apply/implyP=> _; apply/set0Pn; exists A. - have [] := narrow_cent_dprod pS oddS rSgt2 nnS oA1 sA1S rCSA1. - set Y := _ :&: _; rewrite {}defC => cycY _ _ defC; exists [group of Y]. - have cCC: abelian C; last split=> //. - apply/center_idP; rewrite -(center_dprod defC). - rewrite (center_idP (abelem_abelian abelA1)). - by rewrite (center_idP (cyclic_abelian cycY)). - have{EpZ01} [<- _] := EpZ01 cCC; rewrite subsetI (subset_trans sZ1Z) //. - by rewrite setIS ?centS ?gFsub_trans. - have not_cSS := contra (abelianS sPS) not_cPP. - have:= mFT_rank2_Sylow_cprod sylS rSle2 not_cSS. - case=> E [_ dimE3 eE] [Y cycY [defS defY1]]. - have [[_ mulEY cEY] cYY] := (cprodP defS, cyclic_abelian cycY). - have defY: 'Z(S) = Y. - case/cprodP: (center_cprod defS) => _ <- _. - by rewrite (center_idP cYY) -defY1 mulSGid ?Ohm_sub. - have pY: p.-group Y by rewrite -defY (pgroupS (center_sub S)). - have sES: E \subset S by rewrite -mulEY mulG_subl. - have pE := pgroupS sES pS. - have defS1: 'Ohm_1(S) = E. - apply/eqP; rewrite (OhmE 1 pS) eqEsubset gen_subG andbC. - rewrite sub_gen; last by rewrite subsetI sES sub_LdivT. - apply/subsetP=> ey /LdivP[]; rewrite -mulEY. - case/imset2P=> e y Ee Yy -> eyp; rewrite groupM //. - rewrite (subsetP (center_sub E)) // -defY1 (OhmE 1 pY) mem_gen //. - rewrite expgMn in eyp; last by red; rewrite -(centsP cEY). - by rewrite (exponentP eE) // mul1g in eyp; rewrite !inE Yy eyp eqxx. - have sAE: A \subset E by rewrite -defS1 -(Ohm1_id abelA) OhmS. - have defC: A * Y = C. - rewrite /C -mulEY setIC -group_modr; last first. - by rewrite -defY subIset // orbC centS. - congr (_ * _); apply/eqP; rewrite /= setIC eqEcard subsetI sAE. - have pCEA: p.-group 'C_E(A) := pgroupS (subsetIl E _) pE. - rewrite -abelianE cAA (card_pgroup pCEA) oA leq_exp2l //= leqNgt. - apply: contraL cycY => dimCEA3. - have sAZE: A \subset 'Z(E). - rewrite subsetI sAE // centsC (sameP setIidPl eqP) eqEcard subsetIl /=. - by rewrite (card_pgroup pE) (card_pgroup pCEA) dimE3 leq_exp2l. - rewrite abelian_rank1_cyclic // -ltnNge (rank_pgroup pY). - by rewrite (p_rank_abelian p cYY) defY1 -dimA lognSg. - have cAY: Y \subset 'C(A) by apply: centSS cEY. - have cCC: abelian C by rewrite -defC abelianM cAA cYY. - have{EpZ01} [eqZ10 EpZ1] := EpZ01 cCC; rewrite -eqZ10 in EpZ1. - have sZ0Y: Z0 \subset Y by rewrite -eqZ10 -defY Ohm_sub. - have{EpA1} EpA1 := EpA1 (card_pnElem EpZ1). - have [sA1A _ oA1] := pnElemPcard EpA1. - have [_ defA _ tiA1Z] := dprodP (p2Elem_dprodP Ep2A EpA1 EpZ1 neqA1Z). - exists Y; split; rewrite // dprodE ?(centSS _ sA1A cAY) ?prime_TIg ?oA1 //. - by rewrite -(mulSGid sZ0Y) -eqZ10 mulgA defA. - apply: contraL cycY => sA1Y; rewrite abelian_rank1_cyclic // -ltnNge. - by rewrite -dimA -rank_abelem ?rankS // -defA eqZ10 mul_subG. -have{EpZ01} [eqZ10 EpZ0] := EpZ01 cCC; have oZ0 := card_pnElem EpZ0. -have{EpA1} EpA1: A1 \in E1A by rewrite EpA1 ?eqZ10. -have [sA1A _ oA1] := pnElemPcard EpA1; rewrite {}eqZ10 in neqA1Z. -have [_ defA _ tiA1Z] := dprodP (p2Elem_dprodP Ep2A EpA1 EpZ0 neqA1Z). -split=> //; first exists (P :&: Y)%G. - have sPY_Y := subsetIr P Y; rewrite (cyclicS sPY_Y) //. - rewrite subsetI (subset_trans sZ0A) //= sZ0Y. - split=> // A0 /setD1P[neqA0Z EpA0]; have [sA0A _ _] := pnElemP EpA0. - have [_ mulA0Z _ tiA0Z] := dprodP (p2Elem_dprodP Ep2A EpA0 EpZ0 neqA0Z). - have{defC} [_ defC cA1Y tiA1Y] := dprodP defC. - rewrite setIC -{2}(setIidPr sPS) setIAC. - apply: dprod_modl (subset_trans sA0A sAP); rewrite -defC dprodE /=. - - by rewrite -(mulSGid sZ0Y) !mulgA mulA0Z defA. - - rewrite (centSS (subxx Y) sA0A) // -defA centM subsetI cA1Y /=. - by rewrite sub_abelian_cent ?cyclic_abelian. - rewrite setIC -(setIidPr sA0A) setIA -defA -group_modr //. - by rewrite (setIC Y) tiA1Y mul1g setIC. -apply/imsetP; exists A1; first by rewrite 2!inE neqA1Z. -apply/eqP; rewrite eq_sym eqEcard; apply/andP; split. - apply/subsetP=> _ /imsetP[x /setIP[Px nAx] ->]. - rewrite 2!inE /E1A -(normP nAx) pnElemJ EpA1 andbT -val_eqE /=. - have nZ0P: P \subset 'N(Z0) by rewrite !gFnorm_trans. - by rewrite -(normsP nZ0P x Px) (inj_eq (@conjsg_inj _ x)). -have pN: p.-group 'N_P(_) := pgroupS (subsetIl P _) pP. -have defCPA: 'N_('N_P(A))(A1) = 'C_P(A). - apply/eqP; rewrite eqEsubset andbC subsetI setIS ?cent_sub //. - rewrite subIset /=; last by rewrite orbC cents_norm ?centS. - rewrite setIAC (subset_trans (subsetIl _ _)) //= subsetI subsetIl /=. - rewrite -defA centM subsetI andbC subIset /=; last first. - by rewrite centsC gFsub_trans ?subsetIr. - have nC_NP: 'N_P(A1) \subset 'N('C(A1)) by rewrite norms_cent ?subsetIr. - rewrite -quotient_sub1 // subG1 trivg_card1. - rewrite (pnat_1 (quotient_pgroup _ (pN _))) //. - rewrite -(card_isog (second_isog nC_NP)) /= (setIC 'C(A1)). - by apply: p'group_quotient_cent_prime; rewrite ?subsetIr ?oA1. -have sCN: 'C_P(A) \subset 'N_P(A) by rewrite setIS ?cent_sub. -have nA_NCPA: 'N_P('C_P(A)) \subset 'N_P(A). - have [_ defCPA1] := maxA P pP sAP. - by rewrite -[in 'N(A)]defCPA1 setIS // gFnorm_trans. -rewrite card_orbit astab1JG /= {}defCPA. -rewrite -(leq_add2l (Z0 \in E1A)) -cardsD1 EpZ0 (card_p1Elem_p2Elem Ep2A) ltnS. -rewrite dvdn_leq ?(pfactor_dvdn 1) ?indexg_gt0 // -divgS // logn_div ?cardSg //. -rewrite subn_gt0 properG_ltn_log ?pN //= (proper_sub_trans _ nA_NCPA) //. -rewrite (nilpotent_proper_norm (pgroup_nil pP)) // properEneq subsetIl andbT. -by apply: contraNneq not_cPP => <-; rewrite (abelianS (setSI _ sPS)). -Qed. - -(* This is B & G, Proposition 10.14(a). *) -Proposition beta_not_narrow p : p \in \beta(G) -> - [disjoint 'E_p^2(G) & 'E*_p(G)] - /\ (forall P, p.-Sylow(G) P -> [disjoint 'E_p^2(P) & 'E*_p(P)]). -Proof. -move/forall_inP=> nnG. -have nnSyl P: p.-Sylow(G) P -> [disjoint 'E_p^2(P) & 'E*_p(P)]. - by move/nnG; rewrite negb_imply negbK setI_eq0 => /andP[]. -split=> //; apply/pred0Pn=> [[E /andP[/= Ep2E EpmE]]]. -have [_ abelE dimE]:= pnElemP Ep2E; have pE := abelem_pgroup abelE. -have [P sylP sEP] := Sylow_superset (subsetT E) pE. -case/pred0Pn: (nnSyl P sylP); exists E; rewrite /= 2!inE sEP abelE dimE /=. -by rewrite (subsetP (pmaxElemS p (subsetT P))) // inE EpmE inE. -Qed. - -(* This is B & G, Proposition 10.14(b). *) -Proposition beta_noncyclic_uniq p R : - p \in \beta(G) -> p.-group R -> 'r(R) > 1 -> R \in 'U. -Proof. -move=> b_p pR rRgt1; have [P sylP sRP] := Sylow_superset (subsetT R) pR. -rewrite (rank_pgroup pR) in rRgt1; have [A Ep2A] := p_rank_geP rRgt1. -have [sAR abelA dimA] := pnElemP Ep2A; have p_pr := pnElem_prime Ep2A. -case: (pickP [pred F in 'E_p(P) | A \proper F]) => [F | maxA]; last first. - have [_ nnSyl] := beta_not_narrow b_p; case/pred0Pn: (nnSyl P sylP). - exists A; rewrite /= (subsetP (pnElemS p 2 sRP)) //. - apply/pmaxElemP; split=> [|F EpF]; first by rewrite inE (subset_trans sAR). - by case/eqVproper=> [// | ltAF]; case/andP: (maxA F). -case/andP=> /pElemP[_ abelF] ltAF; have [pF cFF _] := and3P abelF. -apply: uniq_mmaxS sAR (mFT_pgroup_proper pR) _. -have rCAgt2: 'r('C(A)) > 2. - rewrite -dimA (leq_trans (properG_ltn_log pF ltAF)) // -(rank_abelem abelF). - by rewrite rankS // centsC (subset_trans (proper_sub ltAF)). -by apply: cent_rank3_Uniqueness rCAgt2; rewrite (rank_abelem abelA) dimA. -Qed. - -(* This is B & G, Proposition 10.14(c). *) -Proposition beta_subnorm_uniq p P X : - p \in \beta(G) -> p.-Sylow(G) P -> X \subset P -> 'N_P(X)%G \in 'U. -Proof. -move=> b_p sylP sXP; set Q := 'N_P(X)%G. -have pP := pHall_pgroup sylP; have pQ: p.-group Q := pgroupS (subsetIl _ _) pP. -have [| rQle1] := ltnP 1 'r(Q); first exact: beta_noncyclic_uniq pQ. -have cycQ: cyclic Q. - by rewrite (odd_pgroup_rank1_cyclic pQ) ?mFT_odd -?rank_pgroup. -have defQ: P :=: Q. - apply: (nilpotent_sub_norm (pgroup_nil pP) (subsetIl _ _)). - by rewrite setIS // char_norms // sub_cyclic_char // subsetI sXP normG. -have:= forall_inP b_p P; rewrite inE negb_imply ltnNge; move/(_ sylP). -by rewrite defQ -(rank_pgroup pQ) (leq_trans rQle1). -Qed. - -(* This is B & G, Proposition 10.14(d). *) -Proposition beta_norm_sub_mmax M Y : - M \in 'M -> \beta(M).-subgroup(M) Y -> Y :!=: 1 -> 'N(Y) \subset M. -Proof. -move=> maxM /andP[sYM bY] ntY. -have [F1 | [q q_pr q_dv_FY]] := trivgVpdiv 'F(Y). - by rewrite -(trivg_Fitting (solvableS sYM (mmax_sol maxM))) F1 eqxx in ntY. -pose X := 'O_q(Y); have qX: q.-group X := pcore_pgroup q _. -have ntX: X != 1. - apply: contraTneq q_dv_FY => X1; rewrite -p'natE // -partn_eq1 //. - rewrite -(card_Hall (nilpotent_pcore_Hall q (Fitting_nil Y))). - by rewrite /= p_core_Fitting -/X X1 cards1. -have bMq: q \in \beta(M) by apply: (pgroupP (pgroupS (Fitting_sub Y) bY)). -have b_q: q \in \beta(G) by move: bMq; rewrite -predI_sigma_beta //; case/andP. -have sXM: X \subset M := gFsub_trans _ sYM. -have [P sylP sXP] := Sylow_superset sXM qX; have [sPM qP _] := and3P sylP. -have sylPG: q.-Sylow(G) P by rewrite (sigma_Sylow_G maxM) ?beta_sub_sigma. -have uniqNX: 'M('N_P(X)) = [set M]. - apply: def_uniq_mmax => //; last by rewrite subIset ?sPM. - exact: (beta_subnorm_uniq b_q). -rewrite (subset_trans (char_norms (pcore_char q Y))) //. -rewrite (sub_uniq_mmax uniqNX) ?subsetIr // mFT_norm_proper //. -by rewrite (sub_mmax_proper maxM). -Qed. - -End Ten. - - diff --git a/mathcomp/odd_order/BGsection11.v b/mathcomp/odd_order/BGsection11.v deleted file mode 100644 index ae376c3..0000000 --- a/mathcomp/odd_order/BGsection11.v +++ /dev/null @@ -1,443 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq div path fintype. -From mathcomp -Require Import bigop finset prime fingroup morphism perm automorphism quotient. -From mathcomp -Require Import action gproduct gfunctor pgroup cyclic center commutator. -From mathcomp -Require Import gseries nilpotent sylow abelian maximal hall. -From mathcomp -Require Import BGsection1 BGsection3 BGsection4 BGsection5 BGsection6. -From mathcomp -Require Import BGsection7 BGsection10. - -(******************************************************************************) -(* This file covers B & G, section 11; it has only one definition: *) -(* exceptional_FTmaximal p M A0 A <=> *) -(* p, M and A0 satisfy the conditions of Hypothesis 11.1 in B & G, i.e., *) -(* M is an "exceptional" maximal subgroup in the terminology of B & G. *) -(* In addition, A is elementary abelian p-subgroup of M of rank 2, that *) -(* contains A0. The existence of A is guaranteed by Lemma 10.5, but as *) -(* in the only two lemmas that make use of the results in this section *) -(* (Lemma 12.3 and Theorem 12.5) A is known, we elected to make the *) -(* dependency on A explicit. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope. - -Section Section11. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). - -Implicit Types p q r : nat. -Implicit Types A E H K M N P Q R S T U V W X Y : {group gT}. - -Variables (p : nat) (M A0 A P : {group gT}). - -(* This definition corresponsd to Hypothesis 11.1, where the condition on A *) -(* has been made explicit. *) -Definition exceptional_FTmaximal := - [/\ p \in \sigma(M)^', A \in 'E_p^2(M), A0 \in 'E_p^1(A) & 'N(A0) \subset M]. - -Hypotheses (maxM : M \in 'M) (excM : exceptional_FTmaximal). -Hypotheses (sylP : p.-Sylow(M) P) (sAP : A \subset P). - -(* Splitting the excM hypothesis. *) -Let sM'p : p \in \sigma(M)^'. Proof. by case: excM. Qed. -Let Ep2A : A \in 'E_p^2(M). Proof. by case: excM. Qed. -Let Ep1A0 : A0 \in 'E_p^1(A). Proof. by case: excM. Qed. -Let sNA0_M : 'N(A0) \subset M. Proof. by case: excM. Qed. - -(* Arithmetics of p. *) -Let p_pr : prime p := pnElem_prime Ep2A. -Let p_gt1 : p > 1 := prime_gt1 p_pr. -Let p_gt0 : p > 0 := prime_gt0 p_pr. - -(* Group orders. *) -Let oA : #|A| = (p ^ 2)%N := card_pnElem Ep2A. -Let oA0 : #|A0| = p := card_pnElem Ep1A0. - -(* Structure of A. *) -Let abelA : p.-abelem A. Proof. by case/pnElemP: Ep2A. Qed. -Let pA : p.-group A := abelem_pgroup abelA. -Let cAA : abelian A := abelem_abelian abelA. - -(* Various set inclusions. *) -Let sA0A : A0 \subset A. Proof. by case/pnElemP: Ep1A0. Qed. -Let sPM : P \subset M := pHall_sub sylP. -Let sAM : A \subset M := subset_trans sAP sPM. -Let sCA0_M : 'C(A0) \subset M := subset_trans (cent_sub A0) sNA0_M. -Let sCA_M : 'C(A) \subset M := subset_trans (centS sA0A) sCA0_M. - -(* Alternative E_p^1 memberships for A0; the first is the one used to state *) -(* Hypothesis 11.1 in B & G, the second is the form expected by Lemma 10.5. *) -(* Note that #|A0| = p (oA0 above) would wokr just as well. *) -Let Ep1A0_M : A0 \in 'E_p^1(M) := subsetP (pnElemS p 1 sAM) A0 Ep1A0. -Let Ep1A0_G : A0 \in 'E_p^1(G) := subsetP (pnElemS p 1 (subsetT M)) A0 Ep1A0_M. - -(* This does not depend on exceptionalM, and could move to Section 10. *) -Lemma sigma'_Sylow_contra : p \in \sigma(M)^' -> ~~ ('N(P) \subset M). -Proof. by apply: contra => sNM; apply/exists_inP; exists P. Qed. - -(* First preliminary remark of Section 11; only depends on sM'p and sylP. *) -Let not_sNP_M: ~~ ('N(P) \subset M) := sigma'_Sylow_contra sM'p. - -(* Second preliminary remark of Section 11; only depends on sM'p, Ep1A0_M, *) -(* and sNA0_M. *) -Lemma p_rank_exceptional : 'r_p(M) = 2. -Proof. exact: sigma'_norm_mmax_rank2 (pgroupS sA0A pA) _. Qed. -Let rM := p_rank_exceptional. - -(* Third preliminary remark of Section 11. *) -Lemma exceptional_pmaxElem : A \in 'E*_p(G). -Proof. -have [_ _ dimA]:= pnElemP Ep2A. -apply/pmaxElemP; split=> [|E EpE sAE]; first by rewrite !inE subsetT. -have [//|ltAE]: A :=: E \/ A \proper E := eqVproper sAE. -have [_ abelE] := pElemP EpE; have [pE cEE _] := and3P abelE. -suffices: logn p #|E| <= 'r_p(M) by rewrite leqNgt rM -dimA properG_ltn_log. -by rewrite logn_le_p_rank // inE (subset_trans cEE) ?(subset_trans (centS sAE)). -Qed. -Let EpmA := exceptional_pmaxElem. - -(* This is B & G, Lemma 11.1. *) -Lemma exceptional_TIsigmaJ g q Q1 Q2 : - g \notin M -> A \subset M :^ g -> - q.-Sylow(M`_\sigma) Q1 -> A \subset 'N(Q1) -> - q.-Sylow(M`_\sigma :^ g) Q2 -> A \subset 'N(Q2) -> - (*a*) Q1 :&: Q2 = 1 - /\ (*b*) (forall X, X \in 'E_p^1(A) -> 'C_Q1(X) = 1 \/ 'C_Q2(X) = 1). -Proof. -move=> notMg sAMg sylQ1 nQ1A sylQ2 nQ2A. -have [-> | ntQ1] := eqsVneq Q1 1. - by split=> [|? _]; last left; apply: (setIidPl (sub1G _)). -have [sQ1Ms qQ1 _] := and3P sylQ1. -have{qQ1} [q_pr q_dv_Q1 _] := pgroup_pdiv qQ1 ntQ1. -have{sQ1Ms q_dv_Q1} sMq: q \in \sigma(M). - exact: pgroupP (pgroupS sQ1Ms (pcore_pgroup _ _)) q q_pr q_dv_Q1. -have{sylQ1} sylQ1: q.-Sylow(M) Q1. - by rewrite (subHall_Sylow (Msigma_Hall maxM)). -have sQ1M := pHall_sub sylQ1. -have{sylQ2} sylQ2g': q.-Sylow(M) (Q2 :^ g^-1). - by rewrite (subHall_Sylow (Msigma_Hall _)) // -(pHallJ2 _ _ _ g) actKV. -have sylQ2: q.-Sylow(G) Q2. - by rewrite -(pHallJ _ _ (in_setT g^-1)) (sigma_Sylow_G maxM). -suffices not_Q1_CA_Q2: gval Q2 \notin Q1 :^: 'O_\pi(A)^'('C(A)). - have ncA: normed_constrained A. - have ntA: A :!=: 1 by rewrite -cardG_gt1 oA (ltn_exp2l 0). - exact: plength_1_normed_constrained ntA EpmA (mFT_proper_plength1 _). - have q'A: q \notin \pi(A). - by apply: contraL sMq; move/(pnatPpi pA); move/eqnP->. - have maxnAq Q: q.-Sylow(G) Q -> A \subset 'N(Q) -> Q \in |/|*(A; q). - move=> sylQ; case/(max_normed_exists (pHall_pgroup sylQ)) => R maxR sQR. - have [qR _] := mem_max_normed maxR. - by rewrite -(group_inj (sub_pHall sylQ qR sQR (subsetT R))). - have maxQ1 := maxnAq Q1 (sigma_Sylow_G maxM sMq sylQ1) nQ1A. - have maxQ2 := maxnAq Q2 sylQ2 nQ2A. - have transCAQ := normed_constrained_meet_trans ncA q'A _ _ maxQ1 maxQ2. - split=> [|X EpX]. - apply: contraNeq not_Q1_CA_Q2 => ntQ12; apply/imsetP. - apply: transCAQ (sAM) (mmax_proper maxM) _ _. - by rewrite (setIidPl sQ1M). - by apply: contraNneq ntQ12 => tiQ2M; rewrite setIC -subG1 -tiQ2M setIS. - apply/pred2P; apply: contraR not_Q1_CA_Q2; case/norP=> ntCQ1 ntCQ2. - have [sXA _ oX] := pnElemPcard EpX. - apply/imsetP; apply: transCAQ (centSS _ sXA cAA) _ ntCQ1 ntCQ2 => //. - by rewrite mFT_cent_proper // -cardG_gt1 oX prime_gt1. -apply: contra notMg; case/imsetP=> k cAk defQ2. -have{cAk} Mk := subsetP sCA_M k (subsetP (pcore_sub _ _) k cAk). -have{k Mk defQ2} sQ2M: Q2 \subset M by rewrite defQ2 conj_subG. -have [sQ2g'M qQ2g' _] := and3P sylQ2g'. -by rewrite (sigma_Sylow_trans _ sylQ2g') // actKV. -Qed. - -(* This is B & G, Corollary 11.2. *) -Corollary exceptional_TI_MsigmaJ g : - g \notin M -> A \subset M :^ g -> - (*a*) M`_\sigma :&: M :^ g = 1 - /\ (*b*) M`_\sigma :&: 'C(A0 :^ g) = 1. -Proof. -move=> notMg sAMg; set Ms := M`_\sigma; set H := [group of Ms :&: M :^ g]. -have [H1 | ntH] := eqsVneq H 1. - by split=> //; apply/trivgP; rewrite -H1 setIS //= centJ conjSg. -pose q := pdiv #|H|. -suffices: #|H|`_q == 1%N by rewrite p_part_eq1 pi_pdiv cardG_gt1 ntH. -have nsMsM: Ms <| M := pcore_normal _ _; have [_ nMsM] := andP nsMsM. -have sHMs: H \subset Ms := subsetIl _ _. -have sHMsg: H \subset Ms :^ g. - rewrite -sub_conjgV (sub_Hall_pcore (Msigma_Hall _)) //. - by rewrite pgroupJ (pgroupS sHMs) ?pcore_pgroup. - by rewrite sub_conjgV subsetIr. -have nMsA := subset_trans sAM nMsM. -have nHA: A \subset 'N(H) by rewrite normsI // normsG. -have nMsgA: A \subset 'N(Ms :^ g) by rewrite normJ (subset_trans sAMg) ?conjSg. -have coMsA: coprime #|Ms| #|A|. - by rewrite oA coprime_expr ?(pnat_coprime (pcore_pgroup _ _)) ?pnatE. -have coHA: coprime #|H| #|A| := coprimeSg sHMs coMsA. -have coMsgA: coprime #|Ms :^ g| #|A| by rewrite cardJg. -have solA: solvable A := abelian_sol cAA. -have [Q0 sylQ0 nQ0A] := sol_coprime_Sylow_exists q solA nHA coHA. -have [sQ0H qQ0 _] := and3P sylQ0. -have supQ0 := sol_coprime_Sylow_subset _ _ solA (subset_trans sQ0H _) qQ0 nQ0A. -have [Q1 [sylQ1 nQ1A sQ01]] := supQ0 _ nMsA coMsA sHMs. -have [Q2 [sylQ2 nQ2A sQ02]] := supQ0 _ nMsgA coMsgA sHMsg. -have tiQ12: Q1 :&: Q2 = 1. - by have [-> _] := exceptional_TIsigmaJ notMg sAMg sylQ1 nQ1A sylQ2 nQ2A. -by rewrite -(card_Hall sylQ0) -trivg_card1 -subG1 -tiQ12 subsetI sQ01. -Qed. - -(* This is B & G, Theorem 11.3. *) -Theorem exceptional_sigma_nil : nilpotent M`_\sigma. -Proof. -have [g nPg notMg] := subsetPn not_sNP_M. -set Ms := M`_\sigma; set F := Ms <*> A0 :^ g. -have sA0gM: A0 :^ g \subset M. - by rewrite (subset_trans _ sPM) // -(normP nPg) conjSg (subset_trans sA0A). -have defF: Ms ><| A0 :^ g = F. - rewrite sdprodEY ?coprime_TIg //. - by rewrite (subset_trans sA0gM) ?gFnorm. - by rewrite cardJg oA0 (pnat_coprime (pcore_pgroup _ _)) ?pnatE. -have regA0g: 'C_Ms(A0 :^ g) = 1. - case/exceptional_TI_MsigmaJ: notMg => //. - by rewrite -sub_conjgV (subset_trans _ sPM) // sub_conjgV (normP _). -rewrite (prime_Frobenius_sol_kernel_nil defF) ?cardJg ?oA0 //. -by rewrite (solvableS _ (mmax_sol maxM)) // join_subG pcore_sub. -Qed. - -(* This is B & G, Corollary 11.4. *) -Corollary exceptional_sigma_uniq H : - H \in 'M(A) -> H`_\sigma :&: M `_\sigma != 1 -> H :=: M. -Proof. -rewrite setIC => /setIdP[maxH sAH] ntMsHs. -have [g _ defH]: exists2 g, g \in G & H :=: M :^ g. - apply/imsetP; apply: contraR ntMsHs => /sigma_disjoint[] // _ _. - by case/(_ exceptional_sigma_nil)=> ->. -rewrite defH conjGid //; apply: contraR ntMsHs => notMg. -have [|tiMsMg _] := exceptional_TI_MsigmaJ notMg; first by rewrite -defH. -by rewrite -subG1 -tiMsMg -defH setIS ?pcore_sub. -Qed. - -(* This is B & G, Theorem 11.5. *) -Theorem exceptional_Sylow_abelian P1 : p.-Sylow(M) P1 -> abelian P1. -Proof. -have nregA Q: gval Q != 1 -> A \subset 'N(Q) -> coprime #|Q| #|A| -> - exists2 X, X \in 'E_p^1(A) & 'C_Q(X) != 1. -- move=> ntQ nQA coQA; apply/exists_inP; apply: contraR ntQ. - rewrite negb_exists_in -subG1; move/forall_inP=> regA. - have ncycA: ~~ cyclic A by rewrite (abelem_cyclic abelA) oA pfactorK. - rewrite -(coprime_abelian_gen_cent1 _ _ nQA) // gen_subG. - apply/bigcupsP=> x /setD1P[ntx Ax]. - apply/negPn; rewrite /= -cent_cycle subG1 regA // p1ElemE // !inE. - by rewrite cycle_subG Ax /= -orderE (abelem_order_p abelA). -suffices{P1} cPP: abelian P. - by move=> sylP1; have [m _ ->] := Sylow_trans sylP sylP1; rewrite abelianJ. -have [g nPg notMg] := subsetPn not_sNP_M. -pose Ms := M`_\sigma; pose q := pdiv #|Ms|; have pP := pHall_pgroup sylP. -have nMsP: P \subset 'N(Ms) by rewrite (subset_trans sPM) ?gFnorm. -have coMsP: coprime #|Ms| #|P|. - exact: pnat_coprime (pcore_pgroup _ _) (pi_pnat pP sM'p). -have [Q1 sylQ1 nQ1P]:= sol_coprime_Sylow_exists q (pgroup_sol pP) nMsP coMsP. -have ntQ1: Q1 :!=: 1. - rewrite -cardG_gt1 (card_Hall sylQ1) p_part_gt1 pi_pdiv cardG_gt1. - by rewrite Msigma_neq1. -have nQ1A: A \subset 'N(Q1) := subset_trans sAP nQ1P. -have coQ1A: coprime #|Q1| #|A|. - by rewrite (coprimeSg (pHall_sub sylQ1)) // (coprimegS sAP). -have [X1 EpX1 nregX11] := nregA _ ntQ1 nQ1A coQ1A. -pose Q2 := Q1 :^ g; have sylQ2: q.-Sylow(Ms :^ g) Q2 by rewrite pHallJ2. -have{ntQ1} ntQ2: Q2 != 1 by rewrite -!cardG_gt1 cardJg in ntQ1 *. -have nQ2A: A \subset 'N(Q2) by rewrite (subset_trans sAP) ?norm_conj_norm. -have{coQ1A} coQ2A: coprime #|Q2| #|A| by rewrite cardJg. -have{nregA ntQ2 coQ2A} [X2 EpX2 nregX22] := nregA _ ntQ2 nQ2A coQ2A. -have [|_ regA]:= exceptional_TIsigmaJ notMg _ sylQ1 nQ1A sylQ2 nQ2A. - by rewrite (subset_trans sAP) // -(normP nPg) conjSg. -have regX21: 'C_Q1(X2) = 1 by case: (regA X2) nregX22 => // ->; rewrite eqxx. -have regX12: 'C_Q2(X1) = 1 by case: (regA X1) nregX11 => // ->; rewrite eqxx. -pose X := 'Ohm_1('Z(P))%G. -have eqCQ12_X: ('C_Q1(X) == 1) = ('C_Q2(X) == 1). - rewrite -(inj_eq (@conjsg_inj _ g)) conjs1g conjIg -/Q2 -centJ (normP _) //. - by rewrite (subsetP (gFnorm_trans _ _) g nPg) ?gFnorms. -have{EpX1} EpX1: X1 \in 'E_p^1(A) :\ X. - rewrite 2!inE EpX1 andbT; apply: contraNneq nregX11 => defX1. - by rewrite defX1 eqCQ12_X -defX1 regX12. -have{EpX2 eqCQ12_X} EpX2: X2 \in 'E_p^1(A) :\ X. - rewrite 2!inE EpX2 andbT; apply: contraNneq nregX22 => defX2. - by rewrite defX2 -eqCQ12_X -defX2 regX21. -apply: contraR nregX11 => not_cPP. -have{not_cPP} transNPA: [transitive 'N_P(A), on 'E_p^1(A) :\ X | 'JG]. - have [|_ _]:= basic_p2maxElem_structure _ pP sAP not_cPP; last by []. - by rewrite inE (subsetP (pnElemS p 2 (subsetT M))). -have [y PnAy ->] := atransP2 transNPA EpX2 EpX1; have [Py _] := setIP PnAy. -by rewrite centJ -(normsP nQ1P y Py) -conjIg regX21 conjs1g. -Qed. - -(* This is B & G, Corollary 11.6. *) -Corollary exceptional_structure (Ms := M`_\sigma) : - [/\ (*a*) A :=: 'Ohm_1(P), - (*b*) 'C_Ms(A) = 1 - & (*c*) exists2 A1, A1 \in 'E_p^1(A) & exists2 A2, A2 \in 'E_p^1(A) & - [/\ A1 :!=: A2, 'C_Ms(A1) = 1 & 'C_Ms(A2) = 1]]. -Proof. -pose iMNA := #|'N(A) : M|. -have defA: A :=: 'Ohm_1(P). - apply/eqP; rewrite eqEcard -{1}(Ohm1_id abelA) OhmS //= oA -rM. - rewrite -(p_rank_Sylow sylP) p_rank_abelian ?exceptional_Sylow_abelian //. - by rewrite -card_pgroup // (pgroupS _ (pHall_pgroup sylP)) ?Ohm_sub. -have iMNAgt1: iMNA > 1. - rewrite indexg_gt1 defA; apply: contra (subset_trans _) not_sNP_M. - by rewrite char_norms ?Ohm_char. -have iMNAgt2: iMNA > 2. - pose q := pdiv iMNA; have q_iMNA: q %| iMNA := pdiv_dvd iMNA. - rewrite (leq_trans _ (dvdn_leq (ltnW _) q_iMNA)) // ltn_neqAle eq_sym. - rewrite (sameP eqP (prime_oddPn _)) ?prime_gt1 ?pdiv_prime //. - by rewrite (dvdn_odd q_iMNA) // (dvdn_odd (dvdn_indexg _ _)) ?mFT_odd. -rewrite [iMNA](cardD1 (gval M)) orbit_refl !ltnS lt0n in iMNAgt1 iMNAgt2. -have{iMNAgt1} [Mg1 /= NM_Mg1] := pred0Pn iMNAgt1. -rewrite (cardD1 Mg1) inE /= NM_Mg1 ltnS lt0n in iMNAgt2. -have{iMNAgt2} [Mg2 /= NM_Mg2] := pred0Pn iMNAgt2. -case/andP: NM_Mg1 => neM_Mg1 /rcosetsP[g1 nAg1 defMg1]. -have{neM_Mg1} notMg1: g1 \notin M. - by apply: contra neM_Mg1 => M_g1; rewrite defMg1 rcoset_id. -case/and3P: NM_Mg2 => neMg12 neM_Mg2 /rcosetsP[g2 nAg2 defMg2]. -have{neM_Mg2} notMg2: g2 \notin M. - by apply: contra neM_Mg2 => M_g2; rewrite defMg2 rcoset_id. -pose A1 := (A0 :^ g1)%G; pose A2 := (A0 :^ g2)%G. -have EpA1: A1 \in 'E_p^1(A) by rewrite -(normP nAg1) pnElemJ. -have EpA2: A2 \in 'E_p^1(A) by rewrite -(normP nAg2) pnElemJ. -have{neMg12} neqA12: A1 :!=: A2. - rewrite -(canF_eq (conjsgKV g2)) -conjsgM (sameP eqP normP). - rewrite (contra (subsetP sNA0_M _)) // -mem_rcoset. - by apply: contra neMg12 => g1Mg2; rewrite defMg1 defMg2 (rcoset_eqP g1Mg2). -have{notMg1 nAg1} regA1: 'C_Ms(A1) = 1. - by case/exceptional_TI_MsigmaJ: notMg1; rewrite // -(normP nAg1) conjSg. -have{notMg2 nAg2} regA2: 'C_Ms(A2) = 1. - by case/exceptional_TI_MsigmaJ: notMg2; rewrite // -(normP nAg2) conjSg. -split=> //; last by exists A1 => //; exists A2 => //. -by apply/trivgP; rewrite -regA1 setIS ?centS //; case/pnElemP: EpA1. -Qed. - -(* This is B & G, Theorem 11.7 (the main result on exceptional subgroups). *) -Theorem exceptional_mul_sigma_normal : M`_\sigma <*> A <| M. -Proof. -set Ms := M`_\sigma; have pP := pHall_pgroup sylP; have solM := mmax_sol maxM. -have [E hallE sPE] := Hall_superset solM sPM (pi_pnat pP sM'p). -have sAE := subset_trans sAP sPE; have [sEM s'E _] := and3P hallE. -have [_ _ dimA] := pnElemP Ep2A. -have rE: 'r(E) = 2. - apply/eqP; rewrite eqn_leq -{2}dimA -rank_abelem ?rankS // andbT leqNgt. - have [q q_pr ->]:= rank_witness E; apply/negP=> rqEgt2. - have piEq: q \in \pi(E) by rewrite -p_rank_gt0 -(subnKC rqEgt2). - case/negP: (pnatPpi s'E piEq); rewrite /= alpha_sub_sigma // !inE. - by rewrite (leq_trans rqEgt2) ?p_rankS. -have rFEle2: 'r('F(E)) <= 2 by rewrite -rE rankS ?Fitting_sub. -have solE := solvableS sEM solM; have oddE := mFT_odd E. -pose tau : nat_pred := [pred q | q > p]; pose K := 'O_tau(E). -have hallK: tau.-Hall(E) K by rewrite rank2_ge_pcore_Hall. -pose ptau : nat_pred := [pred q | q >= p]; pose KP := K <*> P. -have nKP: P \subset 'N(K) by rewrite (subset_trans sPE) ?gFnorm. -have coKP: coprime #|K| #|P|. - by rewrite (pnat_coprime (pcore_pgroup _ _)) ?(pi_pnat pP) //= !inE ltnn. -have hallKP: ptau.-Hall(E) KP. - rewrite pHallE join_subG pcore_sub sPE /= norm_joinEr ?coprime_cardMg //. - apply/eqP; rewrite -(partnC tau (part_gt0 _ _)) (card_Hall sylP). - rewrite (card_Hall hallK) partn_part => [|q]; last exact: leqW. - rewrite (card_Hall hallE) -!partnI; congr (_ * _)%N; apply: eq_partn => q. - by rewrite 4!inE andbC /= 8!inE -leqNgt -eqn_leq eq_sym; case: eqP => // <-. -have nsKP_E: KP <| E. - by rewrite [KP](eq_Hall_pcore _ hallKP) ?pcore_normal ?rank2_ge_pcore_Hall. -have [cKA | not_cKA]:= boolP (A \subset 'C(K)). - pose KA := K <*> A; have defKA: K \x A = KA. - by rewrite dprodEY // coprime_TIg // (coprimegS sAP). - have defA: 'Ohm_1(P) = A by case exceptional_structure. - have{defA} defA: 'Ohm_1('O_p(KP)) = A. - apply/eqP; rewrite -defA eqEsubset OhmS /=; last first. - rewrite pcore_sub_Hall ?(pHall_subl _ _ sylP) ?joing_subr //. - exact: subset_trans (pHall_sub hallKP) sEM. - rewrite -Ohm_id defA OhmS // pcore_max // /normal join_subG. - rewrite (subset_trans sAP) ?joing_subr // cents_norm 1?centsC //=. - by rewrite -defA gFnorm. - have nMsE: E \subset 'N(Ms) by rewrite (subset_trans sEM) ?gFnorm. - have tiMsE: Ms :&: E = 1. - by rewrite coprime_TIg ?(pnat_coprime (pcore_pgroup _ _)). - have <-: Ms * E = M. - apply/eqP; rewrite eqEcard mulG_subG pcore_sub sEM /= TI_cardMg //. - by rewrite (card_Hall hallE) (card_Hall (Msigma_Hall maxM)) ?partnC. - rewrite norm_joinEr -?quotientK ?(subset_trans sAE) //= cosetpre_normal. - by rewrite quotient_normal // -defA !gFnormal_trans. -pose q := pdiv #|K : 'C_K(A)|. -have q_pr: prime q by rewrite pdiv_prime // indexg_gt1 subsetI subxx centsC. -have [nKA coKA] := (subset_trans sAP nKP, coprimegS sAP coKP). -have [Q sylQ nQA]: exists2 Q : {group gT}, q.-Sylow(K) Q & A \subset 'N(Q). - by apply: sol_coprime_Sylow_exists => //; apply: (pgroup_sol pA). -have [sQK qQ q'iQK] := and3P sylQ; have [sKE tauK _]:= and3P hallK. -have{q'iQK} not_cQA: ~~ (A \subset 'C(Q)). - apply: contraL q'iQK => cQA; rewrite p'natE // negbK. - rewrite -(Lagrange_index (subsetIl K 'C(A))) ?dvdn_mulr ?pdiv_dvd //. - by rewrite subsetI sQK centsC. -have ntQ: Q :!=: 1 by apply: contraNneq not_cQA => ->; apply: cents1. -have q_dv_K: q %| #|K| := dvdn_trans (pdiv_dvd _) (dvdn_indexg _ _). -have sM'q: q \in (\sigma(M))^' := pgroupP (pgroupS sKE s'E) q q_pr q_dv_K. -have{q_dv_K} tau_q: q \in tau := pgroupP tauK q q_pr q_dv_K. -have sylQ_E: q.-Sylow(E) Q := subHall_Sylow hallK tau_q sylQ. -have sylQ_M: q.-Sylow(M) Q := subHall_Sylow hallE sM'q sylQ_E. -have q'p: p != q by rewrite neq_ltn [p < q]tau_q. -suffices nregQ: 'C_Q(A) != 1. - have ncycQ: ~~ cyclic Q. - apply: contra not_cQA => cycQ. - rewrite (coprime_odd_faithful_Ohm1 qQ) ?mFT_odd ?(coprimeSg sQK) //. - rewrite centsC; apply: contraR nregQ => not_sQ1_CA. - rewrite setIC TI_Ohm1 // setIC prime_TIg //. - by rewrite (Ohm1_cyclic_pgroup_prime cycQ qQ ntQ). - have {ncycQ} rQ: 'r_q(Q) = 2. - apply/eqP; rewrite eqn_leq ltnNge -odd_pgroup_rank1_cyclic ?mFT_odd //. - by rewrite -rE -rank_pgroup ?rankS // (pHall_sub sylQ_E). - have [B Eq2B]: exists B, B \in 'E_q^2(Q) by apply/p_rank_geP; rewrite rQ. - have maxB: B \in 'E*_q(G). - apply: subsetP (subsetP (pnElemS q 2 (pHall_sub sylQ_M)) B Eq2B). - by rewrite sigma'_rank2_max // -(p_rank_Sylow sylQ_M). - have CAq: q %| #|'C(A)|. - apply: dvdn_trans (cardSg (subsetIr Q _)). - by have [_ ? _] := pgroup_pdiv (pgroupS (subsetIl Q _) qQ) nregQ. - have [Qstar maxQstar sQ_Qstar] := max_normed_exists qQ nQA. - have [|Qm] := max_normed_2Elem_signaliser q'p _ maxQstar CAq. - by rewrite inE (subsetP (pnElemS p 2 (subsetT M))). - case=> _ sAQm [_ _ cQstarQm]; rewrite (centSS sAQm sQ_Qstar) // in not_cQA. - apply: cQstarQm; apply/implyP=> _; apply/set0Pn; exists B. - have{Eq2B} Eq2B := subsetP (pnElemS q 2 sQ_Qstar) B Eq2B. - rewrite inE Eq2B (subsetP (pmaxElemS q (subsetT _))) // inE maxB inE. - by have [? _ _] := pnElemP Eq2B. -pose Q0 := 'Z(Q); have sQ0Q: Q0 \subset Q by apply: gFsub. -have nQ0A: A \subset 'N(Q0) by apply: gFnorm_trans. -have ntQ0: Q0 != 1 by apply: contraNneq ntQ => /(trivg_center_pgroup qQ)->. -apply: contraNneq (sM'q) => regQ; apply/exists_inP; exists Q => //. -suffices nsQ0M: Q0 <| M by rewrite -(mmax_normal _ nsQ0M) ?gFnorms. -have sQ0M: Q0 \subset M := subset_trans sQ0Q (pHall_sub sylQ_M). -have qQ0: q.-group Q0 := pgroupS sQ0Q qQ. -have p'Q0: p^'.-group Q0 by apply: (pi_pnat qQ0); rewrite eq_sym in q'p. -have sM'Q0: \sigma(M)^'.-group Q0 := pi_pnat qQ0 sM'q. -have cQ0Q0: abelian Q0 := center_abelian Q. -have defQ0: [~: A, Q0] = Q0. - rewrite -{2}[Q0](coprime_abelian_cent_dprod nQ0A) //. - by rewrite setIAC regQ setI1g dprodg1 commGC. - by rewrite (coprimeSg (subset_trans sQ0Q sQK)). -have [_ _ [A1 EpA1 [A2 EpA2 [neqA12 regA1 regA2]]]] := exceptional_structure. -have defA: A1 \x A2 = A by apply/(p2Elem_dprodP Ep2A EpA1 EpA2). -have{defQ0} defQ0: [~: A1, Q0] * [~: A2, Q0] = Q0. - have{defA} [[_ defA cA12 _] [sA2A _ _]] := (dprodP defA, pnElemP EpA2). - by rewrite -commMG ?defA // normsR ?(cents_norm cA12) // (subset_trans sA2A). -have sA_NQ0: A \subset 'N_M(Q0) by rewrite subsetI sAM. -have sEpA_EpN := subsetP (pnElemS p 1 sA_NQ0). -have nsRQ0 := commG_sigma'_1Elem_cyclic maxM sQ0M sM'Q0 sM'p (sEpA_EpN _ _). -rewrite -defQ0 -!(commGC Q0). -by apply: normalM; [case/nsRQ0: EpA1 | case/nsRQ0: EpA2]. -Qed. - -End Section11. diff --git a/mathcomp/odd_order/BGsection12.v b/mathcomp/odd_order/BGsection12.v deleted file mode 100644 index ea39e9d..0000000 --- a/mathcomp/odd_order/BGsection12.v +++ /dev/null @@ -1,2686 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq choice div fintype. -From mathcomp -Require Import path bigop finset prime fingroup morphism perm automorphism. -From mathcomp -Require Import quotient action gproduct gfunctor pgroup cyclic commutator. -From mathcomp -Require Import center gseries nilpotent sylow abelian maximal hall frobenius. -From mathcomp -Require Import BGsection1 BGsection3 BGsection4 BGsection5 BGsection6. -From mathcomp -Require Import BGsection7 BGsection9 BGsection10 BGsection11. - -(******************************************************************************) -(* This file covers B & G, section 12; it defines the prime sets for the *) -(* complements of M`_\sigma in a maximal group M: *) -(* \tau1(M) == the set of p not in \pi(M^`(1)) (thus not in \sigma(M)), *) -(* such that M has p-rank 1. *) -(* \tau2(M) == the set of p not in \sigma(M), such that M has p-rank 2. *) -(* \tau3(M) == the set of p not in \sigma(M), but in \pi(M^`(1)), such *) -(* that M has p-rank 1. *) -(* We also define the following helper predicate, which encapsulates the *) -(* notation conventions defined at the beginning of B & G, Section 12: *) -(* sigma_complement M E E1 E2 E3 <=> *) -(* E is a Hall \sigma(M)^'-subgroup of M, the Ei are Hall *) -(* \tau_i(M)-subgroups of E, and E2 * E1 is a group. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope. -Section Definitions. - -Variables (gT : finGroupType) (M : {set gT}). -Local Notation sigma' := \sigma(M)^'. - -Definition tau1 := [pred p in sigma' | 'r_p(M) == 1%N & ~~ (p %| #|M^`(1)|)]. -Definition tau2 := [pred p in sigma' | 'r_p(M) == 2]. -Definition tau3 := [pred p in sigma' | 'r_p(M) == 1%N & p %| #|M^`(1)|]. - -Definition sigma_complement E E1 E2 E3 := - [/\ sigma'.-Hall(M) E, tau1.-Hall(E) E1, tau2.-Hall(E) E2, tau3.-Hall(E) E3 - & group_set (E2 * E1)]. - -End Definitions. - -Notation "\tau1 ( M )" := (tau1 M) - (at level 2, format "\tau1 ( M )") : group_scope. -Notation "\tau2 ( M )" := (tau2 M) - (at level 2, format "\tau2 ( M )") : group_scope. -Notation "\tau3 ( M )" := (tau3 M) - (at level 2, format "\tau3 ( M )") : group_scope. - -Section Section12. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). -Implicit Types p q r : nat. -Implicit Types A E H K M Mstar N P Q R S T U V W X Y Z : {group gT}. - -Section Introduction. - -Variables M E : {group gT}. -Hypotheses (maxM : M \in 'M) (hallE : \sigma(M)^'.-Hall(M) E). - -Lemma tau1J x : \tau1(M :^ x) =i \tau1(M). -Proof. by move=> p; rewrite 3!inE sigmaJ p_rankJ derg1 -conjsRg cardJg. Qed. - -Lemma tau2J x : \tau2(M :^ x) =i \tau2(M). -Proof. by move=> p; rewrite 3!inE sigmaJ p_rankJ. Qed. - -Lemma tau3J x : \tau3(M :^ x) =i \tau3(M). -Proof. by move=> p; rewrite 3!inE sigmaJ p_rankJ derg1 -conjsRg cardJg. Qed. - -Lemma tau2'1 : {subset \tau1(M) <= \tau2(M)^'}. -Proof. by move=> p; rewrite !inE; case/and3P=> ->; move/eqP->. Qed. - -Lemma tau3'1 : {subset \tau1(M) <= \tau3(M)^'}. -Proof. by move=> p; rewrite !inE; case/and3P=> -> ->. Qed. - -Lemma tau3'2 : {subset \tau2(M) <= \tau3(M)^'}. -Proof. by move=> p; rewrite !inE; case/andP=> ->; move/eqP->. Qed. - -Lemma ex_sigma_compl : exists F : {group gT}, \sigma(M)^'.-Hall(M) F. -Proof. exact: Hall_exists (mmax_sol maxM). Qed. - -Let s'E : \sigma(M)^'.-group E := pHall_pgroup hallE. -Let sEM : E \subset M := pHall_sub hallE. - -(* For added convenience, this lemma does NOT depend on the maxM assumption. *) -Lemma sigma_compl_sol : solvable E. -Proof. -have [-> | [p p_pr pE]] := trivgVpdiv E; first exact: solvable1. -rewrite (solvableS sEM) // mFT_sol // properT. -apply: contraNneq (pgroupP s'E p p_pr pE) => ->. -have [P sylP] := Sylow_exists p [set: gT]. -by apply/exists_inP; exists P; rewrite ?subsetT. -Qed. -Let solE := sigma_compl_sol. - -Let exHallE pi := exists Ei : {group gT}, pi.-Hall(E) Ei. -Lemma ex_tau13_compl : exHallE \tau1(M) /\ exHallE \tau3(M). -Proof. by split; apply: Hall_exists. Qed. - -Lemma ex_tau2_compl E1 E3 : - \tau1(M).-Hall(E) E1 -> \tau3(M).-Hall(E) E3 -> - exists2 E2 : {group gT}, \tau2(M).-Hall(E) E2 & sigma_complement M E E1 E2 E3. -Proof. -move=> hallE1 hallE3; have [sE1E t1E1 _] := and3P hallE1. -pose tau12 := [predU \tau1(M) & \tau2(M)]. -have t12E1: tau12.-group E1 by apply: sub_pgroup t1E1 => p t1p; apply/orP; left. -have [E21 hallE21 sE1E21] := Hall_superset solE sE1E t12E1. -have [sE21E t12E21 _] := and3P hallE21. -have [E2 hallE2] := Hall_exists \tau2(M) (solvableS sE21E solE). -have [sE2E21 t2E2 _] := and3P hallE2. -have hallE2_E: \tau2(M).-Hall(E) E2. - by apply: subHall_Hall hallE21 _ hallE2 => p t2p; apply/orP; right. -exists E2 => //; split=> //. -suffices ->: E2 * E1 = E21 by apply: groupP. -have coE21: coprime #|E2| #|E1| := sub_pnat_coprime tau2'1 t2E2 t1E1. -apply/eqP; rewrite eqEcard mul_subG ?coprime_cardMg //=. -rewrite -(partnC \tau1(M) (cardG_gt0 E21)) (card_Hall hallE2) mulnC. -rewrite (card_Hall (pHall_subl sE1E21 sE21E hallE1)) leq_pmul2r //. -rewrite dvdn_leq // sub_in_partn // => p t12p t1'p. -by apply: contraLR (pnatPpi t12E21 t12p) => t2'p; apply/norP. -Qed. - -Lemma coprime_sigma_compl : coprime #|M`_\sigma| #|E|. -Proof. exact: pnat_coprime (pcore_pgroup _ _) (pHall_pgroup hallE). Qed. -Let coMsE := coprime_sigma_compl. - -Lemma pi_sigma_compl : \pi(E) =i [predD \pi(M) & \sigma(M)]. -Proof. by move=> p; rewrite /= (card_Hall hallE) pi_of_part // !inE andbC. Qed. - -Lemma sdprod_sigma : M`_\sigma ><| E = M. -Proof. -rewrite sdprodE ?coprime_TIg ?(subset_trans sEM) ?gFnorm //. -apply/eqP; rewrite eqEcard mul_subG ?pcore_sub ?coprime_cardMg //=. -by rewrite (card_Hall (Msigma_Hall maxM)) (card_Hall hallE) partnC. -Qed. - -(* The preliminary remarks in the introduction of B & G, section 12. *) - -Remark der1_sigma_compl : M^`(1) :&: E = E^`(1). -Proof. -have [nsMsM _ defM _ _] := sdprod_context sdprod_sigma. -by rewrite setIC (pprod_focal_coprime defM _ (subxx E)) ?(setIidPr _) ?der_sub. -Qed. - -Remark partition_pi_mmax p : - (p \in \pi(M)) = - [|| p \in \tau1(M), p \in \tau2(M), p \in \tau3(M) | p \in \sigma(M)]. -Proof. -symmetry; rewrite 2!orbA -!andb_orr orbAC -andb_orr orNb andbT. -rewrite orb_andl orNb /= -(orb_idl ((alpha_sub_sigma maxM) p)) orbA orbC -orbA. -rewrite !(eq_sym 'r_p(M)) -!leq_eqVlt p_rank_gt0 orb_idl //. -exact: sigma_sub_pi. -Qed. - -Remark partition_pi_sigma_compl p : - (p \in \pi(E)) = [|| p \in \tau1(M), p \in \tau2(M) | p \in \tau3(M)]. -Proof. -rewrite pi_sigma_compl inE /= partition_pi_mmax !andb_orr /=. -by rewrite andNb orbF !(andbb, andbA) -2!andbA. -Qed. - -Remark tau2E p : (p \in \tau2(M)) = (p \in \pi(E)) && ('r_p(E) == 2). -Proof. -have [P sylP] := Sylow_exists p E. -rewrite -(andb_idl (pnatPpi s'E)) -p_rank_gt0 -andbA; apply: andb_id2l => s'p. -have sylP_M := subHall_Sylow hallE s'p sylP. -by rewrite -(p_rank_Sylow sylP_M) (p_rank_Sylow sylP); case: posnP => // ->. -Qed. - -Remark tau3E p : (p \in \tau3(M)) = (p \in \pi(E^`(1))) && ('r_p(E) == 1%N). -Proof. -have [P sylP] := Sylow_exists p E. -have hallE': \sigma(M)^'.-Hall(M^`(1)) E^`(1). - by rewrite -der1_sigma_compl setIC (Hall_setI_normal _ hallE) ?der_normal. -rewrite 4!inE -(andb_idl (pnatPpi (pHall_pgroup hallE'))) -andbA. -apply: andb_id2l => s'p; have sylP_M := subHall_Sylow hallE s'p sylP. -rewrite -(p_rank_Sylow sylP_M) (p_rank_Sylow sylP) andbC; apply: andb_id2r. -rewrite eqn_leq p_rank_gt0 mem_primes => /and3P[_ p_pr _]. -rewrite (card_Hall hallE') pi_of_part 3?inE ?mem_primes ?cardG_gt0 //=. -by rewrite p_pr inE /= s'p andbT. -Qed. - -Remark tau1E p : - (p \in \tau1(M)) = [&& p \in \pi(E), p \notin \pi(E^`(1)) & 'r_p(E) == 1%N]. -Proof. -rewrite partition_pi_sigma_compl; apply/idP/idP=> [t1p|]. - have [s'p rpM _] := and3P t1p; have [P sylP] := Sylow_exists p E. - have:= tau3'1 t1p; rewrite t1p /= inE /= tau3E -(p_rank_Sylow sylP). - by rewrite (p_rank_Sylow (subHall_Sylow hallE s'p sylP)) rpM !andbT. -rewrite orbC andbC -andbA => /and3P[not_piE'p /eqP rpE]. -by rewrite tau3E tau2E rpE (negPf not_piE'p) andbF. -Qed. - -(* Generate a rank 2 elementary abelian tau2 subgroup in a given complement. *) -Lemma ex_tau2Elem p : - p \in \tau2(M) -> exists2 A, A \in 'E_p^2(E) & A \in 'E_p^2(M). -Proof. -move=> t2p; have [A Ep2A] := p_rank_witness p E. -have <-: 'r_p(E) = 2 by apply/eqP; move: t2p; rewrite tau2E; case/andP. -by exists A; rewrite // (subsetP (pnElemS p _ sEM)). -Qed. - -(* A converse to the above Lemma: if E has an elementary abelian subgroup of *) -(* order p^2, then p must be in tau2. *) -Lemma sigma'2Elem_tau2 p A : A \in 'E_p^2(E) -> p \in \tau2(M). -Proof. -move=> Ep2A; have rE: 'r_p(E) > 1 by apply/p_rank_geP; exists A. -have: p \in \pi(E) by rewrite -p_rank_gt0 ltnW. -rewrite partition_pi_sigma_compl orbCA => /orP[] //. -by rewrite -!andb_orr eqn_leq leqNgt (leq_trans rE) ?andbF ?p_rankS. -Qed. - -(* This is B & G, Lemma 12.1(a). *) -Lemma der1_sigma_compl_nil : nilpotent E^`(1). -Proof. -have sE'E := der_sub 1 E. -have nMaE: E \subset 'N(M`_\alpha) by rewrite (subset_trans sEM) ?gFnorm. -have tiMaE': M`_\alpha :&: E^`(1) = 1. - by apply/trivgP; rewrite -(coprime_TIg coMsE) setISS ?Malpha_sub_Msigma. -rewrite (isog_nil (quotient_isog (subset_trans sE'E nMaE) tiMaE')). -by rewrite (nilpotentS (quotientS _ (dergS 1 sEM))) ?Malpha_quo_nil. -Qed. - -(* This is B & G, Lemma 12.1(g). *) -Lemma tau2_not_beta p : - p \in \tau2(M) -> p \notin \beta(G) /\ {subset 'E_p^2(M) <= 'E*_p(G)}. -Proof. -case/andP=> s'p /eqP rpM; split; first exact: sigma'_rank2_beta' rpM. -by apply/subsetP; apply: sigma'_rank2_max. -Qed. - -End Introduction. - -Arguments tau2'1 {M} [x]. -Arguments tau3'1 {M} [x]. -Arguments tau3'2 {M} [x]. - -(* This is the rest of B & G, Lemma 12.1 (parts b, c, d,e, and f). *) -Lemma sigma_compl_context M E E1 E2 E3 : - M \in 'M -> sigma_complement M E E1 E2 E3 -> - [/\ (*b*) E3 \subset E^`(1) /\ E3 <| E, - (*c*) E2 :==: 1 -> E1 :!=: 1, - (*d*) cyclic E1 /\ cyclic E3, - (*e*) E3 ><| (E2 ><| E1) = E /\ E3 ><| E2 ><| E1 = E - & (*f*) 'C_E3(E) = 1]. -Proof. -move=> maxM [hallE hallE1 hallE2 hallE3 groupE21]. -have [sEM solM] := (pHall_sub hallE, mmax_sol maxM). -have [[sE1E t1E1 _] [sE3E t3E3 _]] := (and3P hallE1, and3P hallE3). -have tiE'E1: E^`(1) :&: E1 = 1. - rewrite coprime_TIg // coprime_pi' ?cardG_gt0 //. - by apply: sub_pgroup t1E1 => p; rewrite (tau1E maxM hallE) => /and3P[]. -have cycE1: cyclic E1. - apply: nil_Zgroup_cyclic. - rewrite odd_rank1_Zgroup ?mFT_odd //; apply: wlog_neg; rewrite -ltnNge. - have [p p_pr ->]:= rank_witness E1; move/ltnW; rewrite p_rank_gt0. - move/(pnatPpi t1E1); rewrite (tau1E maxM hallE) => /and3P[_ _ /eqP <-]. - by rewrite p_rankS. - rewrite abelian_nil // /abelian (sameP commG1P trivgP) -tiE'E1. - by rewrite subsetI (der_sub 1) (dergS 1). -have solE: solvable E := solvableS sEM solM. -have nilE': nilpotent E^`(1) := der1_sigma_compl_nil maxM hallE. -have nsE'piE pi: 'O_pi(E^`(1)) <| E by rewrite !gFnormal_trans. -have SylowE3 P: Sylow E3 P -> [/\ cyclic P, P \subset E^`(1) & 'C_P(E) = 1]. -- case/SylowP=> p p_pr sylP; have [sPE3 pP _] := and3P sylP. - have [-> | ntP] := eqsVneq P 1. - by rewrite cyclic1 sub1G (setIidPl (sub1G _)). - have t3p: p \in \tau3(M). - rewrite (pnatPpi t3E3) // -p_rank_gt0 -(p_rank_Sylow sylP) -rank_pgroup //. - by rewrite rank_gt0. - have sPE: P \subset E := subset_trans sPE3 sE3E. - have cycP: cyclic P. - rewrite (odd_pgroup_rank1_cyclic pP) ?mFT_odd //. - rewrite (tau3E maxM hallE) in t3p. - by case/andP: t3p => _ /eqP <-; rewrite p_rankS. - have nEp'E: E \subset 'N('O_p^'(E)) by apply: gFnorm. - have nEp'P := subset_trans sPE nEp'E. - have sylP_E := subHall_Sylow hallE3 t3p sylP. - have nsEp'P_E: 'O_p^'(E) <*> P <| E. - rewrite sub_der1_normal ?join_subG ?pcore_sub //=. - rewrite norm_joinEr // -quotientSK ?gFsub_trans //=. - have [_ /= <- _ _] := dprodP (nilpotent_pcoreC p nilE'). - rewrite -quotientMidr -mulgA (mulSGid (pcore_max _ _)) ?pcore_pgroup //=. - rewrite quotientMidr quotientS //. - apply: subset_trans (pcore_sub_Hall sylP_E). - by rewrite pcore_max ?pcore_pgroup ?nsE'piE. - have nEP_sol: solvable 'N_E(P) by rewrite (solvableS _ solE) ?subsetIl. - have [K hallK] := Hall_exists p^' nEP_sol; have [sKNEP p'K _] := and3P hallK. - have coPK: coprime #|P| #|K| := pnat_coprime pP p'K. - have sP_NEP: P \subset 'N_E(P) by rewrite subsetI sPE normG. - have mulPK: P * K = 'N_E(P). - apply/eqP; rewrite eqEcard mul_subG //= coprime_cardMg // (card_Hall hallK). - by rewrite (card_Hall (pHall_subl sP_NEP (subsetIl E _) sylP_E)) partnC. - have{sKNEP} [sKE nPK] := subsetIP sKNEP; have nEp'K := subset_trans sKE nEp'E. - have defE: 'O_p^'(E) <*> K * P = E. - have sP_Ep'P: P \subset 'O_p^'(E) <*> P := joing_subr _ _. - have sylP_Ep'P := pHall_subl sP_Ep'P (normal_sub nsEp'P_E) sylP_E. - rewrite -{2}(Frattini_arg nsEp'P_E sylP_Ep'P) /= !norm_joinEr //. - by rewrite -mulgA (normC nPK) -mulPK -{1}(mulGid P) !mulgA. - have ntPE': P :&: E^`(1) != 1. - have sylPE' := Hall_setI_normal (der_normal 1 E) sylP_E. - rewrite -rank_gt0 (rank_Sylow sylPE') p_rank_gt0. - by rewrite (tau3E maxM hallE) in t3p; case/andP: t3p. - have defP := coprime_abelian_cent_dprod nPK coPK (cyclic_abelian cycP). - have{defP} [[PK1 _]|[regKP defP]] := cyclic_pgroup_dprod_trivg pP cycP defP. - have coP_Ep'K: coprime #|P| #|'O_p^'(E) <*> K|. - rewrite (pnat_coprime pP) // -pgroupE norm_joinEr //. - by rewrite pgroupM pcore_pgroup. - rewrite -subG1 -(coprime_TIg coP_Ep'K) setIS ?der1_min // in ntPE'. - rewrite -{1}defE mulG_subG normG normsY // cents_norm //. - exact/commG1P. - by rewrite -{2}defE quotientMidl quotient_abelian ?cyclic_abelian. - split=> //; first by rewrite -defP commgSS. - by apply/trivgP; rewrite -regKP setIS ?centS. -have sE3E': E3 \subset E^`(1). - by rewrite -(Sylow_gen E3) gen_subG; apply/bigcupsP=> P; case/SylowE3. -have cycE3: cyclic E3. - rewrite nil_Zgroup_cyclic ?(nilpotentS sE3E') //. - by apply/forall_inP => P; case/SylowE3. -have regEE3: 'C_E3(E) = 1. - have [// | [p p_pr]] := trivgVpdiv 'C_E3(E). - case/Cauchy=> // x /setIP[]; rewrite -!cycle_subG => sXE3 cEX ox. - have pX: p.-elt x by rewrite /p_elt ox pnat_id. - have [P sylP sXP] := Sylow_superset sXE3 pX. - suffices: <[x]> == 1 by case/idPn; rewrite cycle_eq1 -order_gt1 ox prime_gt1. - rewrite -subG1; case/SylowE3: (p_Sylow sylP) => _ _ <-. - by rewrite subsetI sXP. -have nsE3E: E3 <| E. - have hallE3_E' := pHall_subl sE3E' (der_sub 1 E) hallE3. - by rewrite (nilpotent_Hall_pcore nilE' hallE3_E') /=. -have [sE2E t2E2 _] := and3P hallE2; have [_ nE3E] := andP nsE3E. -have coE21: coprime #|E2| #|E1| := sub_pnat_coprime tau2'1 t2E2 t1E1. -have coE31: coprime #|E3| #|E1| := sub_pnat_coprime tau3'1 t3E3 t1E1. -have coE32: coprime #|E3| #|E2| := sub_pnat_coprime tau3'2 t3E3 t2E2. -have{groupE21} defE: E3 ><| (E2 ><| E1) = E. - have defE21: E2 * E1 = E2 <*> E1 by rewrite -genM_join gen_set_id. - have sE21E: E2 <*> E1 \subset E by rewrite join_subG sE2E. - have nE3E21 := subset_trans sE21E nE3E. - have coE312: coprime #|E3| #|E2 <*> E1|. - by rewrite -defE21 coprime_cardMg // coprime_mulr coE32. - have nE21: E1 \subset 'N(E2). - rewrite (subset_trans (joing_subr E2 E1)) ?sub_der1_norm ?joing_subl //. - rewrite /= -{2}(mulg1 E2) -(setIidPr (der_sub 1 _)) /=. - rewrite -(coprime_mulG_setI_norm defE21) ?gFnorm //. - by rewrite mulgSS ?subsetIl // -tiE'E1 setIC setSI ?dergS. - rewrite (sdprodEY nE21) ?sdprodE ?coprime_TIg //=. - apply/eqP; rewrite eqEcard mul_subG // coprime_cardMg //= -defE21. - rewrite -(partnC \tau3(M) (cardG_gt0 E)) (card_Hall hallE3) leq_mul //. - rewrite coprime_cardMg // (card_Hall hallE1) (card_Hall hallE2). - rewrite -[#|E|`__](partnC \tau2(M)) ?leq_mul ?(partn_part _ tau3'2) //. - rewrite -partnI dvdn_leq // sub_in_partn // => p piEp; apply/implyP. - rewrite inE /= -negb_or /= orbC implyNb orbC. - by rewrite -(partition_pi_sigma_compl maxM hallE). -split=> // [/eqP E2_1|]; last split=> //. - apply: contraTneq (sol_der1_proper solM (subxx _) (mmax_neq1 maxM)) => E1_1. - case/sdprodP: (sdprod_sigma maxM hallE) => _ defM _ _. - rewrite properE der_sub /= negbK -{1}defM mulG_subG Msigma_der1 //. - by rewrite -defE E1_1 E2_1 !sdprodg1 (subset_trans sE3E') ?dergS //. -case/sdprodP: defE => [[_ E21 _ defE21]]; rewrite defE21 => defE nE321 tiE321. -have{defE21} [_ defE21 nE21 tiE21] := sdprodP defE21. -have [nE32 nE31] := (subset_trans sE2E nE3E, subset_trans sE1E nE3E). -rewrite [E3 ><| _]sdprodEY ? sdprodE ?coprime_TIg ?normsY //=. - by rewrite norm_joinEr // -mulgA defE21. -by rewrite norm_joinEr // coprime_cardMg // coprime_mull coE31. -Qed. - -(* This is B & G, Lemma 12.2(a). *) -Lemma prime_class_mmax_norm M p X : - M \in 'M -> p.-group X -> 'N(X) \subset M -> - (p \in \sigma(M)) || (p \in \tau2(M)). -Proof. -move=> maxM pX sNM; rewrite -implyNb; apply/implyP=> sM'p. -by rewrite 3!inE /= sM'p (sigma'_norm_mmax_rank2 _ _ pX). -Qed. - -(* This is B & G, Lemma 12.2(b). *) -Lemma mmax_norm_notJ M Mstar p X : - M \in 'M -> Mstar \in 'M -> - p.-group X -> X \subset M -> 'N(X) \subset Mstar -> - [|| [&& p \in \sigma(M) & M :!=: Mstar], p \in \tau1(M) | p \in \tau3(M)] -> - gval Mstar \notin M :^: G. -Proof. -move: Mstar => H maxM maxH pX sXM sNH; apply: contraL => MG_H. -have [x Gx defH] := imsetP MG_H. -have [sMp | sM'p] := boolP (p \in \sigma(M)); last first. - have:= prime_class_mmax_norm maxH pX sNH. - rewrite defH /= sigmaJ tau2J !negb_or (negPf sM'p) /= => t2Mp. - by rewrite (contraL (@tau2'1 _ p)) // [~~ _]tau3'2. -rewrite 3!inE sMp 3!inE sMp orbF negbK. -have [_ transCX _] := sigma_group_trans maxM sMp pX. -set maxMX := finset _ in transCX. -have maxMX_H: gval H \in maxMX by rewrite inE MG_H (subset_trans (normG X)). -have maxMX_M: gval M \in maxMX by rewrite inE orbit_refl. -have [y cXy ->] := atransP2 transCX maxMX_H maxMX_M. -by rewrite /= conjGid // (subsetP sNH) // (subsetP (cent_sub X)). -Qed. - -(* This is B & G, Lemma 12.3. *) -Lemma nonuniq_p2Elem_cent_sigma M Mstar p A A0 : - M \in 'M -> Mstar \in 'M -> Mstar :!=: M -> A \in 'E_p^2(M) -> - A0 \in 'E_p^1(A) -> 'N(A0) \subset Mstar -> - [/\ (*a*) p \notin \sigma(M) -> A \subset 'C(M`_\sigma :&: Mstar) - & (*b*) p \notin \alpha(M) -> A \subset 'C(M`_\alpha :&: Mstar)]. -Proof. -move: Mstar => H maxM maxH neqMH Ep2A EpA0 sNH. -have p_pr := pnElem_prime Ep2A. -have [sAM abelA dimA] := pnElemP Ep2A; have [pA cAA _] := and3P abelA. -have [sA0A _ _] := pnElemP EpA0; have pA0 := pgroupS sA0A pA. -have sAH: A \subset H. - by apply: subset_trans (cents_norm _) sNH; apply: subset_trans (centS sA0A). -have nsHsH: H`_\sigma <| H by apply: pcore_normal. -have [sHsH nHsH] := andP nsHsH; have nHsA := subset_trans sAH nHsH. -have nsHsA_H: H`_\sigma <*> A <| H. - have [sHp | sH'p] := boolP (p \in \sigma(H)). - rewrite (joing_idPl _) ?pcore_normal //. - by rewrite (sub_Hall_pcore (Msigma_Hall _)) // (pi_pgroup pA). - have [P sylP sAP] := Sylow_superset sAH pA. - have excH: exceptional_FTmaximal p H A0 A by split=> //; apply/pnElemP. - exact: exceptional_mul_sigma_normal excH sylP sAP. -have cAp' K: - p^'.-group K -> A \subset 'N(K) -> K \subset H -> - [~: K, A] \subset K :&: H`_\sigma. -- move=> p'K nKA sKH; have nHsK := subset_trans sKH nHsH. - rewrite subsetI commg_subl nKA /= -quotient_sub1 ?comm_subG // quotientR //=. - have <-: K / H`_\sigma :&: A / H`_\sigma = 1. - by rewrite setIC coprime_TIg ?coprime_morph ?(pnat_coprime pA p'K). - rewrite subsetI commg_subl commg_subr /= -{2}(quotientYidr nHsA). - by rewrite !quotient_norms //= joingC (subset_trans sKH) ?normal_norm. -have [sMp | sM'p] := boolP (p \in \sigma(M)). - split=> // aM'p; have notMGH: gval H \notin M :^: G. - apply: mmax_norm_notJ maxM maxH pA0 (subset_trans sA0A sAM) sNH _. - by rewrite sMp eq_sym neqMH. - rewrite centsC (sameP commG1P trivgP). - apply: subset_trans (cAp' _ _ _ (subsetIr _ _)) _. - - exact: pi_p'group (pgroupS (subsetIl _ _) (pcore_pgroup _ _)) aM'p. - - by rewrite (normsI _ (normsG sAH)) // (subset_trans sAM) ?gFnorm. - by rewrite setIAC; case/sigma_disjoint: notMGH => // -> _ _; apply: subsetIl. -suffices cMaA: A \subset 'C(M`_\sigma :&: H). - by rewrite !{1}(subset_trans cMaA) ?centS ?setSI // Malpha_sub_Msigma. -have [sHp | sH'p] := boolP (p \in \sigma(H)); last first. - apply/commG1P; apply: contraNeq neqMH => ntA_MsH. - have [P sylP sAP] := Sylow_superset sAH pA. - have excH: exceptional_FTmaximal p H A0 A by split=> //; apply/pnElemP. - have maxAM: M \in 'M(A) by apply/setIdP. - rewrite (exceptional_sigma_uniq maxH excH sylP sAP maxAM) //. - apply: contraNneq ntA_MsH => tiMsHs; rewrite -subG1. - have [sHsA_H nHsA_H] := andP nsHsA_H. - have <-: H`_\sigma <*> A :&: M`_\sigma = 1. - apply/trivgP; rewrite -tiMsHs subsetI subsetIr /=. - rewrite -quotient_sub1 ?subIset ?(subset_trans sHsA_H) //. - rewrite quotientGI ?joing_subl //= joingC quotientYidr //. - rewrite setIC coprime_TIg ?coprime_morph //. - rewrite (pnat_coprime (pcore_pgroup _ _)) // (card_pnElem Ep2A). - by rewrite pnat_exp ?orbF ?pnatE. - rewrite commg_subI // subsetI ?joing_subr ?subsetIl. - by rewrite (subset_trans sAM) ?gFnorm. - by rewrite setIC subIset ?nHsA_H. -have sAHs: A \subset H`_\sigma. - by rewrite (sub_Hall_pcore (Msigma_Hall maxH)) // (pi_pgroup pA). -have [S sylS sAS] := Sylow_superset sAHs pA; have [sSHs pS _] := and3P sylS. -have nsHaH: H`_\alpha <| H := pcore_normal _ _; have [_ nHaH] := andP nsHaH. -have nHaS := subset_trans (subset_trans sSHs sHsH) nHaH. -have nsHaS_H: H`_\alpha <*> S <| H. - rewrite -{2}(quotientGK nsHaH) (norm_joinEr nHaS) -quotientK //. - rewrite cosetpre_normal; apply: char_normal_trans (quotient_normal _ nsHsH). - rewrite /= (nilpotent_Hall_pcore _ (quotient_pHall _ sylS)) ?pcore_char //. - exact: nilpotentS (quotientS _ (Msigma_der1 maxH)) (Malpha_quo_nil maxH). -rewrite (sameP commG1P trivgP). -have <-: H`_\alpha <*> S :&: M`_\sigma = 1. - have: gval M \notin H :^: G. - by apply: contra sM'p; case/imsetP=> x _ ->; rewrite sigmaJ. - case/sigma_disjoint=> // _ ti_aHsM _. - rewrite setIC coprime_TIg ?(pnat_coprime (pcore_pgroup _ _)) //=. - rewrite norm_joinEr // [pnat _ _]pgroupM (pi_pgroup pS) // andbT. - apply: sub_pgroup (pcore_pgroup _ _) => q aHq. - by apply: contraFN (ti_aHsM q) => sMq; rewrite inE /= aHq. -rewrite commg_subI // subsetI ?subsetIl. - by rewrite (subset_trans sAS) ?joing_subr ?(subset_trans sAM) ?gFnorm. -by rewrite setIC subIset 1?normal_norm. -Qed. - -(* This is B & G, Proposition 12.4. *) -Proposition p2Elem_mmax M p A : - M \in 'M -> A \in 'E_p^2(M) -> - (*a*) 'C(A) \subset M - /\ (*b*) ([forall A0 in 'E_p^1(A), 'M('N(A0)) != [set M]] -> - [/\ p \in \sigma(M), M`_\alpha = 1 & nilpotent M`_\sigma]). -Proof. -move=> maxM Ep2A; have p_pr := pnElem_prime Ep2A. -have [sAM abelA dimA] := pnElemP Ep2A; have [pA cAA _] := and3P abelA. -have [EpAnonuniq |] := altP forall_inP; last first. - rewrite negb_forall_in; case/exists_inP=> A0 EpA0; rewrite negbK. - case/eqP/mem_uniq_mmax=> _ sNA0_M; rewrite (subset_trans _ sNA0_M) //. - by have [sA0A _ _] := pnElemP EpA0; rewrite cents_norm // centS. -have{EpAnonuniq} sCMkApCA y: y \in A^# -> - [/\ 'r('C_M(<[y]>)) <= 2, - p \in \sigma(M)^' -> 'C_(M`_\sigma)[y] \subset 'C_M(A) - & p \in \alpha(M)^' -> 'C_(M`_\alpha)[y] \subset 'C_M(A)]. -- case/setD1P=> nty Ay; pose Y := <[y]>%G. - rewrite -cent_cycle -[<[y]>]/(gval Y). - have EpY: Y \in 'E_p^1(A). - by rewrite p1ElemE // 2!inE cycle_subG Ay -orderE (abelem_order_p abelA) /=. - have [sYA abelY dimY] := pnElemP EpY; have [pY _] := andP abelY. - have [H maxNYH neqHM]: exists2 H, H \in 'M('N(Y)) & H \notin [set M]. - apply/subsetPn; rewrite subset1 negb_or EpAnonuniq //=. - apply/set0Pn; have [|H] := (@mmax_exists _ 'N(Y)); last by exists H. - rewrite mFT_norm_proper ?(mFT_pgroup_proper pY) //. - by rewrite -rank_gt0 (rank_abelem abelY) dimY. - have{maxNYH} [maxH sNYH] := setIdP maxNYH; rewrite inE -val_eqE /= in neqHM. - have ->: 'r('C_M(Y)) <= 2. - apply: contraR neqHM; rewrite -ltnNge => rCMYgt2. - have uniqCMY: 'C_M(Y)%G \in 'U. - by rewrite rank3_Uniqueness ?(sub_mmax_proper maxM) ?subsetIl. - have defU: 'M('C_M(Y)) = [set M] by apply: def_uniq_mmax; rewrite ?subsetIl. - rewrite (eq_uniq_mmax defU maxH) ?subIset //. - by rewrite orbC (subset_trans (cent_sub Y)). - have [cAMs cAMa] := nonuniq_p2Elem_cent_sigma maxM maxH neqHM Ep2A EpY sNYH. - do 2!rewrite {1}subsetI {1}(subset_trans (subsetIl _ _) (pcore_sub _ _)). - have sCYH: 'C(Y) \subset H := subset_trans (cent_sub Y) sNYH. - by split=> // [/cAMs | /cAMa]; rewrite centsC; apply/subset_trans/setIS. -have ntA: A :!=: 1 by rewrite -rank_gt0 (rank_abelem abelA) dimA. -have ncycA: ~~ cyclic A by rewrite (abelem_cyclic abelA) dimA. -have rCMAle2: 'r('C_M(A)) <= 2. - have [y Ay]: exists y, y \in A^# by apply/set0Pn; rewrite setD_eq0 subG1. - have [rCMy _ _] := sCMkApCA y Ay; apply: leq_trans rCMy. - by rewrite rankS // setIS // centS // cycle_subG; case/setIdP: Ay. -have sMp: p \in \sigma(M). - apply: contraFT (ltnn 1) => sM'p; rewrite -dimA -(rank_abelem abelA). - suffices cMsA: A \subset 'C(M`_\sigma). - by rewrite -(setIidPl cMsA) sub'cent_sigma_rank1 // (pi_pgroup pA). - have nMsA: A \subset 'N(M`_\sigma) by rewrite (subset_trans sAM) ?gFnorm. - rewrite centsC /= -(coprime_abelian_gen_cent1 _ _ nMsA) //; last first. - exact: pnat_coprime (pcore_pgroup _ _) (pi_pnat pA _). - rewrite gen_subG; apply/bigcupsP=> y; case/sCMkApCA=> _ sCMsyCA _. - by rewrite (subset_trans (sCMsyCA sM'p)) ?subsetIr. -have [P sylP sAP] := Sylow_superset sAM pA; have [sPM pP _] := and3P sylP. -pose Z := 'Ohm_1('Z(P)). -have sZA: Z \subset A. - have maxA: A \in 'E*_p('C_M(A)). - have sACMA: A \subset 'C_M(A) by rewrite subsetI sAM. - rewrite (subsetP (p_rankElem_max _ _)) // !inE abelA sACMA. - rewrite eqn_leq logn_le_p_rank /=; last by rewrite !inE sACMA abelA. - by rewrite dimA (leq_trans (p_rank_le_rank _ _)). - rewrite [Z](OhmE 1 (pgroupS (center_sub P) pP)) gen_subG. - rewrite -(pmaxElem_LdivP p_pr maxA) -(setIA M) setIid setSI //=. - by rewrite setISS // centS. -have{ntA} ntZ: Z != 1. - by rewrite Ohm1_eq1 (center_nil_eq1 (pgroup_nil pP)) (subG1_contra sAP). -have rPle2: 'r(P) <= 2. - have [z Zz ntz]: exists2 z, z \in Z & z \notin [1]. - by apply/subsetPn; rewrite subG1. - have [|rCMz _ _] := sCMkApCA z; first by rewrite inE ntz (subsetP sZA). - rewrite (leq_trans _ rCMz) ?rankS // subsetI sPM centsC cycle_subG. - by rewrite (subsetP _ z Zz) // gFsub_trans ?subsetIr. -have aM'p: p \in \alpha(M)^'. - by rewrite !inE -leqNgt -(p_rank_Sylow sylP) -rank_pgroup. -have sMaCMA: M`_\alpha \subset 'C_M(A). -have nMaA: A \subset 'N(M`_\alpha) by rewrite (subset_trans sAM) ?gFnorm. - rewrite -(coprime_abelian_gen_cent1 _ _ nMaA) //; last first. - exact: (pnat_coprime (pcore_pgroup _ _) (pi_pnat pA _)). - rewrite gen_subG; apply/bigcupsP=> y; case/sCMkApCA=> _ _ sCMayCA. - by rewrite (subset_trans (sCMayCA aM'p)) ?subsetIr. -have Ma1: M`_\alpha = 1. - have [q q_pr rMa]:= rank_witness M`_\alpha. - apply: contraTeq rCMAle2; rewrite -ltnNge -rank_gt0 rMa p_rank_gt0 => piMa_q. - have aMq: q \in \alpha(M) := pnatPpi (pcore_pgroup _ _) piMa_q. - apply: leq_trans (rankS sMaCMA); rewrite rMa. - have [Q sylQ] := Sylow_exists q M`_\alpha; rewrite -(p_rank_Sylow sylQ). - by rewrite (p_rank_Sylow (subHall_Sylow (Malpha_Hall maxM) aMq sylQ)). -have nilMs: nilpotent M`_\sigma. - rewrite (nilpotentS (Msigma_der1 maxM)) // (isog_nil (quotient1_isog _)). - by rewrite -Ma1 Malpha_quo_nil. -rewrite (subset_trans (cents_norm (centS sZA))) ?(mmax_normal maxM) //=. -have{sylP} sylP: p.-Sylow(M`_\sigma) P. - apply: pHall_subl _ (pcore_sub _ _) sylP. - by rewrite (sub_Hall_pcore (Msigma_Hall maxM)) // (pi_pgroup pP). -by rewrite (nilpotent_Hall_pcore _ sylP) ?gFnormal_trans. -Qed. - -(* This is B & G, Theorem 12.5(a) -- this part does not mention a specific *) -(* rank 2 elementary abelian \tau_2(M) subgroup of M. *) - -Theorem tau2_Msigma_nil M p : M \in 'M -> p \in \tau2(M) -> nilpotent M`_\sigma. -Proof. -move=> maxM t2Mp; have [sM'p /eqP rpM] := andP t2Mp. -have [A Ep2A] := p_rank_witness p M; rewrite rpM in Ep2A. -have [_]:= p2Elem_mmax maxM Ep2A; rewrite -negb_exists_in [p \in _](negPf sM'p). -have [[A0 EpA0 /eqP/mem_uniq_mmax[_ sNA0M _]] | _ [] //] := exists_inP. -have{EpA0 sNA0M} excM: exceptional_FTmaximal p M A0 A by []. -have [sAM abelA _] := pnElemP Ep2A; have [pA _] := andP abelA. -have [P sylP sAP] := Sylow_superset sAM pA. -exact: exceptional_sigma_nil maxM excM sylP sAP. -Qed. - -(* This is B & G, Theorem 12.5 (b-f) -- the bulk of the Theorem. *) -Theorem tau2_context M p A (Ms := M`_\sigma) : - M \in 'M -> p \in \tau2(M) -> A \in 'E_p^2(M) -> - [/\ (*b*) forall P, p.-Sylow(M) P -> - abelian P - /\ (A \subset P -> 'Ohm_1(P) = A /\ ~~ ('N(P) \subset M)), - (*c*) Ms <*> A <| M, - (*d*) 'C_Ms(A) = 1, - (*e*) forall Mstar, Mstar \in 'M(A) :\ M -> Ms :&: Mstar = 1 - & (*f*) exists2 A1, A1 \in 'E_p^1(A) & 'C_Ms(A1) = 1]. -Proof. -move=> maxM t2Mp Ep2A; have [sM'p _] := andP t2Mp. -have [_]:= p2Elem_mmax maxM Ep2A; rewrite -negb_exists_in [p \in _](negPf sM'p). -have [[A0 EpA0 /eqP/mem_uniq_mmax[_ sNA0M _]] | _ [] //] := exists_inP. -have{EpA0 sNA0M} excM: exceptional_FTmaximal p M A0 A by []. -have strM := exceptional_structure maxM excM. -have [sAM abelA dimA] := pnElemP Ep2A; have [pA cAA _] := and3P abelA. -have [P sylP sAP] := Sylow_superset sAM pA. -have nsMsA_M : Ms <*> A <| M := exceptional_mul_sigma_normal maxM excM sylP sAP. -have [_ regA [A1 EpA1 [_ _ [_ regA1 _]]]] := strM P sylP sAP. -split=> // [P1 sylP1 | {P sylP sAP A0 excM}H| ]; last by exists A1. - split=> [|sAP1]; first exact: (exceptional_Sylow_abelian _ excM sylP). - split; first by case/strM: sylP1. - by apply: contra sM'p => sNP1M; apply/exists_inP; exists P1; rewrite // ?inE. -case/setD1P; rewrite -val_eqE /= => neqHM /setIdP[maxH sAH]. -apply/trivgP; rewrite -regA subsetI subsetIl /=. -have Ep2A_H: A \in 'E_p^2(H) by apply/pnElemP. -have [_]:= p2Elem_mmax maxH Ep2A_H; rewrite -negb_exists_in. -have [[A0 EpA0 /eqP/mem_uniq_mmax[_ sNA0H _]]|_ [//|sHp _ nilHs]] := exists_inP. - have [cMSH_A _]:= nonuniq_p2Elem_cent_sigma maxM maxH neqHM Ep2A EpA0 sNA0H. - by rewrite centsC cMSH_A. -have [P sylP sAP] := Sylow_superset sAH pA; have [sPH pP _] := and3P sylP. -have sylP_Hs: p.-Sylow(H`_\sigma) P. - rewrite (pHall_subl _ (pcore_sub _ _) sylP) //. - by rewrite (sub_Hall_pcore (Msigma_Hall maxH)) // (pi_pgroup pP). -have nPH: H \subset 'N(P). - by rewrite (nilpotent_Hall_pcore nilHs sylP_Hs) !gFnorm_trans ?normG. -have coMsP: coprime #|M`_\sigma| #|P|. - exact: pnat_coprime (pcore_pgroup _ _) (pi_pnat pP _). -rewrite (sameP commG1P trivgP) -(coprime_TIg coMsP) commg_subI ?setIS //. -by rewrite subsetI sAP (subset_trans sAM) ?gFnorm. -Qed. - -(* This is B & G, Corollary 12.6 (a, b, c & f) -- i.e., the assertions that *) -(* do not depend on the decomposition of the complement. *) -Corollary tau2_compl_context M E p A (Ms := M`_\sigma) : - M \in 'M -> \sigma(M)^'.-Hall(M) E -> p \in \tau2(M) -> A \in 'E_p^2(E) -> - [/\ (*a*) A <| E /\ 'E_p^1(E) = 'E_p^1(A), - (*b*) [/\ 'C(A) \subset E, 'N_M(A) = E & ~~ ('N(A) \subset M)], - (*c*) forall X, X \in 'E_p^1(E) -> 'C_Ms(X) != 1 -> 'M('C(X)) = [set M] - & (*f*) forall Mstar, - Mstar \in 'M -> gval Mstar \notin M :^: G -> - Ms :&: Mstar`_\sigma = 1 - /\ [predI \sigma(M) & \sigma(Mstar)] =i pred0]. -Proof. -move=> maxM hallE t2Mp Ep2A; have [sEM sM'E _] := and3P hallE. -have [p_pr [sM'p _]] := (pnElem_prime Ep2A, andP t2Mp). -have [sAE abelA dimA] := pnElemP Ep2A; have [pA cAA _] := and3P abelA. -have [_ mulMsE nMsE tiMsE] := sdprodP (sdprod_sigma maxM hallE). -have Ep2A_M: A \in 'E_p^2(M) by rewrite (subsetP (pnElemS _ _ sEM)). -have [syl_p_M nsMsAM regA tiMsMA _] := tau2_context maxM t2Mp Ep2A_M. -have nMsA: A \subset 'N(Ms) := subset_trans sAE nMsE. -have nsAE: A <| E. - rewrite /normal sAE -(mul1g A) -tiMsE setIC group_modr // normsI ?normG //. - by rewrite (subset_trans sEM) // -(norm_joinEr nMsA) normal_norm. -have sAsylE P: p.-Sylow(E) P -> 'Ohm_1(P) = A /\ ~~ ('N(P) \subset M). - move=> sylP; have sylP_M: p.-Sylow(M) P by apply: (subHall_Sylow hallE). - have [_] := syl_p_M P sylP_M; apply. - exact: subset_trans (pcore_max pA nsAE) (pcore_sub_Hall sylP). -have not_sNA_M: ~~ ('N(A) \subset M). - have [P sylP] := Sylow_exists p E; have [<-]:= sAsylE P sylP. - exact/contra/subset_trans/gFnorms. -have{sAsylE syl_p_M} defEpE: 'E_p^1(E) = 'E_p^1(A). - apply/eqP; rewrite eqEsubset andbC pnElemS //. - apply/subsetP=> X /pnElemP[sXE abelX dimX]; apply/pnElemP; split=> //. - have [pX _ eX] := and3P abelX; have [P sylP sXP] := Sylow_superset sXE pX. - have [<- _]:= sAsylE P sylP; have [_ pP _] := and3P sylP. - by rewrite (OhmE 1 pP) sub_gen // subsetI sXP sub_LdivT. -have defNMA: 'N_M(A) = E. - rewrite -mulMsE setIC -group_modr ?normal_norm //= setIC. - rewrite coprime_norm_cent ?regA ?mul1g //. - exact: (pnat_coprime (pcore_pgroup _ _) (pi_pnat pA _)). -have [sCAM _]: 'C(A) \subset M /\ _ := p2Elem_mmax maxM Ep2A_M. -have sCAE: 'C(A) \subset E by rewrite -defNMA subsetI sCAM cent_sub. -split=> // [X EpX | H maxH not_MGH]; last first. - by case/sigma_disjoint: not_MGH => // _ _; apply; apply: tau2_Msigma_nil t2Mp. -rewrite defEpE in EpX; have [sXA abelX dimX] := pnElemP EpX. -have ntX: X :!=: 1 by rewrite -rank_gt0 (rank_abelem abelX) dimX. -apply: contraNeq => neq_maxCX_M. -have{neq_maxCX_M} [H]: exists2 H, H \in 'M('C(X)) & H \notin [set M]. - apply/subsetPn; rewrite subset1 negb_or neq_maxCX_M. - by have [H maxH]:= mmax_exists (mFT_cent_proper ntX); apply/set0Pn; exists H. -case/setIdP=> maxH sCXH neqHM. -rewrite -subG1 -(tiMsMA H) ?setIS // inE neqHM inE maxH. -exact: subset_trans (sub_abelian_cent cAA sXA) sCXH. -Qed. - -(* This is B & G, Corollary 12.6 (d, e) -- the parts that apply to a *) -(* particular decomposition of the complement. We included an easy consequece *) -(* of part (a), that A is a subgroup of E2, as this is used implicitly later *) -(* in sections 12 and 13. *) -Corollary tau2_regular M E E1 E2 E3 p A (Ms := M`_\sigma) : - M \in 'M -> sigma_complement M E E1 E2 E3 -> - p \in \tau2(M) -> A \in 'E_p^2(E) -> - [/\ (*d*) semiregular Ms E3, - (*e*) semiregular Ms 'C_E1(A) - & A \subset E2]. -Proof. -move=> maxM complEi t2Mp Ep2A; have p_pr := pnElem_prime Ep2A. -have [hallE hallE1 hallE2 hallE3 _] := complEi. -have [sEM sM'E _] := and3P hallE; have [sM'p _] := andP t2Mp. -have [sAE abelA dimA] := pnElemP Ep2A; have [pA cAA _] := and3P abelA. -have Ep2A_M: A \in 'E_p^2(M) by rewrite (subsetP (pnElemS _ _ sEM)). -have [_ _ _ tiMsMA _] := tau2_context maxM t2Mp Ep2A_M. -have [[nsAE _] _ _ _] := tau2_compl_context maxM hallE t2Mp Ep2A. -have [sCAM _]: 'C(A) \subset M /\ _ := p2Elem_mmax maxM Ep2A_M. -have sAE2: A \subset E2. - exact: normal_sub_max_pgroup (Hall_max hallE2) (pi_pnat pA _) nsAE. -split=> // x /setD1P[ntx]; last first. - case/setIP; rewrite -cent_cycle -!cycle_subG => sXE1 cAX. - pose q := pdiv #[x]; have piXq: q \in \pi(#[x]) by rewrite pi_pdiv order_gt1. - have [Q sylQ] := Sylow_exists q <[x]>; have [sQX qQ _] := and3P sylQ. - have [sE1E t1E1 _] := and3P hallE1; have sQE1 := subset_trans sQX sXE1. - have sQM := subset_trans sQE1 (subset_trans sE1E sEM). - have [H /setIdP[maxH sNQH]]: {H | H \in 'M('N(Q))}. - apply: mmax_exists; rewrite mFT_norm_proper ?(mFT_pgroup_proper qQ) //. - by rewrite -rank_gt0 (rank_pgroup qQ) (p_rank_Sylow sylQ) p_rank_gt0. - apply/trivgP; rewrite -(tiMsMA H) ?setIS //. - by rewrite (subset_trans _ sNQH) ?cents_norm ?centS. - rewrite 3!inE maxH /=; apply/andP; split. - apply: contra_orbit (mmax_norm_notJ maxM maxH qQ sQM sNQH _). - by rewrite (pnatPpi (pgroupS sXE1 t1E1)) ?orbT. - by rewrite (subset_trans _ sNQH) ?cents_norm // centsC (subset_trans sQX). -rewrite -cent_cycle -cycle_subG => sXE3. -pose q := pdiv #[x]; have piXq: q \in \pi(#[x]) by rewrite pi_pdiv order_gt1. -have [Q sylQ] := Sylow_exists q <[x]>; have [sQX qQ _] := and3P sylQ. -have [sE3E t3E3 _] := and3P hallE3; have sQE3 := subset_trans sQX sXE3. -have sQM := subset_trans sQE3 (subset_trans sE3E sEM). -have [H /setIdP[maxH sNQH]]: {H | H \in 'M('N(Q))}. - apply: mmax_exists; rewrite mFT_norm_proper ?(mFT_pgroup_proper qQ) //. - by rewrite -rank_gt0 (rank_pgroup qQ) (p_rank_Sylow sylQ) p_rank_gt0. -apply/trivgP; rewrite -(tiMsMA H) ?setIS //. - by rewrite (subset_trans _ sNQH) ?cents_norm ?centS. -rewrite 3!inE maxH /=; apply/andP; split. - apply: contra_orbit (mmax_norm_notJ maxM maxH qQ sQM sNQH _). - by rewrite (pnatPpi (pgroupS sXE3 t3E3)) ?orbT. -rewrite (subset_trans _ sNQH) ?cents_norm // (subset_trans _ (centS sQE3)) //. -have coE3A: coprime #|E3| #|A|. - by rewrite (pnat_coprime t3E3 (pi_pnat pA _)) ?tau3'2. -rewrite (sameP commG1P trivgP) -(coprime_TIg coE3A) subsetI commg_subl. -have [[_ nsE3E] _ _ _ _] := sigma_compl_context maxM complEi. -by rewrite commg_subr (subset_trans sE3E) ?(subset_trans sAE) ?normal_norm. -Qed. - -(* This is B & G, Theorem 12.7. *) -Theorem nonabelian_tau2 M E p A P0 (Ms := M`_\sigma) (A0 := 'C_A(Ms)%G) : - M \in 'M -> \sigma(M)^'.-Hall(M) E -> p \in \tau2(M) -> A \in 'E_p^2(E) -> - p.-group P0 -> ~~ abelian P0 -> - [/\ (*a*) \tau2(M) =i (p : nat_pred), - (*b*) #|A0| = p /\ Ms \x A0 = 'F(M), - (*c*) forall X, - X \in 'E_p^1(E) :\ A0 -> 'C_Ms(X) = 1 /\ ~~ ('C(X) \subset M) - & (*d*) exists2 E0 : {group gT}, A0 ><| E0 = E - & (*e*) forall x, x \in Ms^# -> {subset \pi('C_E0[x]) <= \tau1(M)}]. -Proof. -rewrite {}/A0 => maxM hallE t2Mp Ep2A pP0 not_cP0P0 /=. -have p_pr := pnElem_prime Ep2A. -have [sEM sM'E _] := and3P hallE; have [sM'p _] := andP t2Mp. -have [sAE abelA dimA] := pnElemP Ep2A; have [pA cAA _] := and3P abelA. -have Ep2A_M: A \in 'E_p^2(M) by rewrite (subsetP (pnElemS _ _ sEM)). -have [[E1 hallE1] [E3 hallE3]] := ex_tau13_compl hallE. -have [E2 hallE2 complEi] := ex_tau2_compl hallE hallE1 hallE3. -have [regE3 _ sAE2] := tau2_regular maxM complEi t2Mp Ep2A. -have [P sylP sAP] := Sylow_superset sAE2 pA; have [sPE2 pP _] := and3P sylP. -have [S /= sylS sPS] := Sylow_superset (subsetT P) pP. -have pS := pHall_pgroup sylS; have sAS := subset_trans sAP sPS. -have sylP_E: p.-Sylow(E) P := subHall_Sylow hallE2 t2Mp sylP. -have sylP_M: p.-Sylow(M) P := subHall_Sylow hallE sM'p sylP_E. -have [syl_p_M _ regA _ _] := tau2_context maxM t2Mp Ep2A_M. -have{syl_p_M} cPP: abelian P by case: (syl_p_M P). -have{P0 pP0 not_cP0P0} not_cSS: ~~ abelian S. - have [x _ sP0Sx] := Sylow_subJ sylS (subsetT P0) pP0. - by apply: contra not_cP0P0 => cSS; rewrite (abelianS sP0Sx) ?abelianJ. -have [defP | ltPS] := eqVproper sPS; first by rewrite -defP cPP in not_cSS. -have [[nsAE defEp] [sCAE _ _] nregA _] := - tau2_compl_context maxM hallE t2Mp Ep2A. -have defCSA: 'C_S(A) = P. - apply: (sub_pHall sylP_E (pgroupS (subsetIl _ _) pS)). - by rewrite subsetI sPS (sub_abelian_cent2 cPP). - by rewrite subIset // sCAE orbT. -have max2A: A \in 'E_p^2(G) :&: 'E*_p(G). - by rewrite 3!inE subsetT abelA dimA; case: (tau2_not_beta maxM t2Mp) => _ ->. -have def_t2: \tau2(M) =i (p : nat_pred). - move=> q; apply/idP/idP=> [t2Mq |]; last by move/eqnP->. - apply: contraLR (proper_card ltPS); rewrite !inE /= eq_sym -leqNgt => q'p. - apply: wlog_neg => p'q; have [B EqB] := p_rank_witness q E. - have{EqB} Eq2B: B \in 'E_q^2(E). - by move: t2Mq; rewrite (tau2E hallE) => /andP[_ /eqP <-]. - have [sBE abelB dimB]:= pnElemP Eq2B; have [qB _] := andP abelB. - have coBA: coprime #|B| #|A| by apply: pnat_coprime qB (pi_pnat pA _). - have [[nsBE _] [sCBE _ _] _ _] := tau2_compl_context maxM hallE t2Mq Eq2B. - have nBA: A \subset 'N(B) by rewrite (subset_trans sAE) ?normal_norm. - have cAB: B \subset 'C(A). - rewrite (sameP commG1P trivgP) -(coprime_TIg coBA) subsetI commg_subl nBA. - by rewrite commg_subr (subset_trans sBE) ?normal_norm. - have{cAB} qCA: q %| #|'C(A)|. - by apply: dvdn_trans (cardSg cAB); rewrite (card_pnElem Eq2B) dvdn_mull. - have [Q maxQ sBQ] := max_normed_exists qB nBA. - have nnQ: q.-narrow Q. - apply/implyP=> _; apply/set0Pn; exists B. - rewrite 3!inE sBQ abelB dimB (subsetP (pmaxElemS q (subsetT Q))) //=. - rewrite setIC 2!inE sBQ; case: (tau2_not_beta maxM t2Mq) => _ -> //. - by rewrite (subsetP (pnElemS _ _ sEM)). - have [P1 [sylP1 _] [_ _]] := max_normed_2Elem_signaliser q'p max2A maxQ qCA. - move/(_ nnQ)=> cQP1; have sylP1_E: p.-Sylow(E) P1. - apply: pHall_subl (subset_trans _ sCBE) (subsetT E) sylP1. - exact: subset_trans (centS sBQ). - rewrite (card_Hall sylS) -(card_Hall sylP1). - by rewrite (card_Hall sylP_E) -(card_Hall sylP1_E). -have coMsA: coprime #|Ms| #|A|. - by apply: pnat_coprime (pcore_pgroup _ _) (pi_pnat pA _). -have defMs: <<\bigcup_(X in 'E_p^1(A)) 'C_Ms(X)>> = Ms. - have ncycA: ~~ cyclic A by rewrite (abelem_cyclic abelA) dimA. - have [sAM _ _] := pnElemP Ep2A_M. - have{sAM} nMsA: A \subset 'N(Ms) by rewrite (subset_trans sAM) ?gFnorm. - apply/eqP; rewrite eqEsubset andbC gen_subG. - rewrite -{1}[Ms](coprime_abelian_gen_cent1 cAA ncycA nMsA coMsA). - rewrite genS; apply/bigcupsP=> x; rewrite ?subsetIl //; case/setD1P=> ntx Ax. - rewrite /= -cent_cycle (bigcup_max <[x]>%G) // p1ElemE // . - by rewrite 2!inE cycle_subG Ax /= -orderE (abelem_order_p abelA). -have [A0 EpA0 nregA0]: exists2 A0, A0 \in 'E_p^1(A) & 'C_Ms(A0) != 1. - apply/exists_inP; rewrite -negb_forall_in. - apply: contra (Msigma_neq1 maxM); move/forall_inP => regAp. - rewrite -/Ms -defMs -subG1 gen_subG; apply/bigcupsP=> X EpX. - by rewrite subG1 regAp. -have uniqCA0: 'M('C(A0)) = [set M]. - by rewrite nregA // (subsetP (pnElemS _ _ sAE)). -have defSM: S :&: M = P. - apply: sub_pHall (pgroupS (subsetIl S M) pS) _ (subsetIr S M) => //. - by rewrite subsetI sPS (pHall_sub sylP_M). -have{ltPS} not_sSM: ~~ (S \subset M). - by rewrite (sameP setIidPl eqP) defSM proper_neq. -have not_sA0Z: ~~ (A0 \subset 'Z(S)). - apply: contra not_sSM; rewrite subsetI centsC; case/andP=> _ sS_CA0. - by case/mem_uniq_mmax: uniqCA0 => _; apply: subset_trans sS_CA0. -have [EpZ0 dxCSA transNSA] := basic_p2maxElem_structure max2A pS sAS not_cSS. -do [set Z0 := 'Ohm_1('Z(S))%G; set EpA' := _ :\ Z0] in EpZ0 dxCSA transNSA. -have sZ0Z: Z0 \subset 'Z(S) := Ohm_sub 1 _. -have [sA0A _ _] := pnElemP EpA0; have sA0P := subset_trans sA0A sAP. -have EpA'_A0: A0 \in EpA'. - by rewrite 2!inE EpA0 andbT; apply: contraNneq not_sA0Z => ->. -have{transNSA sAP not_sSM defSM} regA0' X: - X \in 'E_p^1(E) :\ A0 -> 'C_Ms(X) = 1 /\ ~~ ('C(X) \subset M). -- case/setD1P=> neqXA0 EpX. - suffices not_sCXM: ~~ ('C(X) \subset M). - split=> //; apply: contraNeq not_sCXM => nregX. - by case/mem_uniq_mmax: (nregA X EpX nregX). - have [sXZ | not_sXZ] := boolP (X \subset 'Z(S)). - apply: contra (subset_trans _) not_sSM. - by rewrite centsC (subset_trans sXZ) ?subsetIr. - have EpA'_X: X \in EpA'. - by rewrite 2!inE -defEp EpX andbT; apply: contraNneq not_sXZ => ->. - have [g NSAg /= defX] := atransP2 transNSA EpA'_A0 EpA'_X. - have{NSAg} [Sg nAg] := setIP NSAg. - have neqMgM: M :^ g != M. - rewrite (sameP eqP normP) (norm_mmax maxM); apply: contra neqXA0 => Mg. - rewrite defX [_ == _](sameP eqP normP) (subsetP (cent_sub A0)) //. - by rewrite (subsetP (centSS (subxx _) sA0P cPP)) // -defSM inE Sg. - apply: contra neqMgM; rewrite defX centJ sub_conjg. - by move/(eq_uniq_mmax uniqCA0) => defM; rewrite -{1}defM ?mmaxJ ?actKV. -have{defMs} defA0: 'C_A(Ms) = A0. - apply/eqP; rewrite eq_sym eqEcard subsetI sA0A (card_pnElem EpA0). - have pCA: p.-group 'C_A(Ms) := pgroupS (subsetIl A _) pA. - rewrite andbC (card_pgroup pCA) leq_exp2l ?prime_gt1 // -ltnS -dimA. - rewrite properG_ltn_log //=; last first. - rewrite properE subsetIl /= subsetI subxx centsC -(subxx Ms) -subsetI. - by rewrite regA subG1 Msigma_neq1. - rewrite centsC -defMs gen_subG (big_setD1 A0) //= subUset subsetIr /=. - by apply/bigcupsP=> X; rewrite -defEp; case/regA0'=> -> _; rewrite sub1G. -rewrite defA0 (group_inj defA0) (card_pnElem EpA0). -have{dxCSA} [Y [cycY sZ0Y]] := dxCSA; move/(_ _ EpA'_A0)=> dxCSA. -have defCP_Ms: 'C_P(Ms) = A0. - move: dxCSA; rewrite defCSA => /dprodP[_ mulA0Y cA0Y tiA0Y]. - rewrite -mulA0Y -group_modl /=; last by rewrite -defA0 subsetIr. - rewrite setIC TI_Ohm1 ?mulg1 // setIC. - have pY: p.-group Y by rewrite (pgroupS _ pP) // -mulA0Y mulG_subr. - have cYY: abelian Y := cyclic_abelian cycY. - have ->: 'Ohm_1(Y) = Z0. - apply/eqP; rewrite eq_sym eqEcard (card_pnElem EpZ0) /= -['Ohm_1(_)]Ohm_id. - rewrite OhmS // (card_pgroup (pgroupS (Ohm_sub 1 Y) pY)). - rewrite leq_exp2l ?prime_gt1 -?p_rank_abelian // -rank_pgroup //. - by rewrite -abelian_rank1_cyclic. - rewrite prime_TIg ?(card_pnElem EpZ0) // centsC (sameP setIidPl eqP) eq_sym. - case: (regA0' Z0) => [|-> _]; last exact: Msigma_neq1. - by rewrite 2!inE defEp EpZ0 andbT; apply: contraNneq not_sA0Z => <-. -have [sPM pA0] := (pHall_sub sylP_M, pgroupS sA0A pA). -have cMsA0: A0 \subset 'C(Ms) by rewrite -defA0 subsetIr. -have nsA0M: A0 <| M. - have [_ defM nMsE _] := sdprodP (sdprod_sigma maxM hallE). - rewrite /normal (subset_trans sA0P) // -defM mulG_subG cents_norm 1?centsC //. - by rewrite -defA0 normsI ?norms_cent // normal_norm. -have defFM: Ms \x A0 = 'F(M). - have nilF := Fitting_nil M. - rewrite dprodE ?(coprime_TIg (coprimegS sA0A coMsA)) //. - have [_ /= defFM cFpp' _] := dprodP (nilpotent_pcoreC p nilF). - have defFp': 'O_p^'('F(M)) = Ms. - apply/eqP; rewrite eqEsubset. - rewrite (sub_Hall_pcore (Msigma_Hall maxM)); last by rewrite !gFsub_trans. - rewrite /pgroup (sub_in_pnat _ (pcore_pgroup _ _)) => [|q piFq]; last first. - have [Q sylQ] := Sylow_exists q 'F(M); have [sQF qQ _] := and3P sylQ. - have ntQ: Q :!=: 1. - rewrite -rank_gt0 (rank_pgroup qQ) (p_rank_Sylow sylQ) p_rank_gt0. - by rewrite (piSg _ piFq) ?pcore_sub. - have sNQM: 'N(Q) \subset M. - rewrite (mmax_normal maxM) // (nilpotent_Hall_pcore nilF sylQ). - by rewrite p_core_Fitting pcore_normal. - apply/implyP; rewrite implyNb /= -def_t2 orbC. - by rewrite (prime_class_mmax_norm maxM qQ). - rewrite pcore_max ?(pi_p'group (pcore_pgroup _ _)) //. - rewrite [_ <| _]andbC gFsub_trans ?gFnorm //. - rewrite Fitting_max ?gFnormal ?(tau2_Msigma_nil _ t2Mp) //. - rewrite p_core_Fitting defFp' centsC in defFM cFpp'. - rewrite -defFM (centC cFpp'); congr (Ms * _). - apply/eqP; rewrite eqEsubset pcore_max //. - by rewrite -defCP_Ms subsetI cFpp' pcore_sub_Hall. -split=> {defFM}//. -have [[sE1E t1E1 _] t2E2] := (and3P hallE1, pHall_pgroup hallE2). -have defE2: E2 :=: P by rewrite (sub_pHall sylP) // -(eq_pgroup _ def_t2) t2E2. -have [[_ nsE3E] _ _ [defEr _] _] := sigma_compl_context maxM complEi. -have [sE3E nE3E] := andP nsE3E; have{nE3E} nE3E := subset_trans _ nE3E. -have [[_ E21 _ defE21]] := sdprodP defEr; rewrite defE21 => defE nE321 tiE321. -rewrite defE2 in defE21; have{defE21} [_ defPE1 nPE1 tiPE1] := sdprodP defE21. -have [P0 defP nP0E1]: exists2 P0 : {group gT}, A0 \x P0 = P & E1 \subset 'N(P0). - have p'E1b: p^'.-group (E1 / 'Phi(P)). - rewrite quotient_pgroup //; apply: sub_pgroup t1E1 => q /tau2'1. - by rewrite inE /= def_t2. - have defPhiP: 'Phi(P) = 'Phi(Y). - have [_ _ cA0Y tiA0Y] := dprodP dxCSA. - rewrite defCSA dprodEcp // in dxCSA. - have [_ abelA0 _] := pnElemP EpA0; rewrite -trivg_Phi // in abelA0. - by rewrite -(Phi_cprod pP dxCSA) (eqP abelA0) cprod1g. - have abelPb := Phi_quotient_abelem pP; have sA0Pb := quotientS 'Phi(P) sA0P. - have [||P0b] := Maschke_abelem abelPb p'E1b sA0Pb; rewrite ?quotient_norms //. - by rewrite (subset_trans (subset_trans sE1E sEM)) ?normal_norm. - case/dprodP=> _ defPb _ tiAP0b nP0E1b. - have sP0Pb: P0b \subset P / 'Phi(P) by rewrite -defPb mulG_subr. - have [P0 defP0b sPhiP0 sP0P] := inv_quotientS (Phi_normal P) sP0Pb. - exists P0; last first. - rewrite -(quotientSGK (char_norm_trans (Phi_char P) nPE1)); last first. - by rewrite cents_norm ?(sub_abelian_cent2 cPP (Phi_sub P) sP0P). - by rewrite quotient_normG -?defP0b ?(normalS _ _ (Phi_normal P)). - rewrite dprodEY ?(sub_abelian_cent2 cPP) //. - apply/eqP; rewrite eqEsubset join_subG sA0P sP0P /=. - rewrite -(quotientSGK (normal_norm (Phi_normal P))) //=; last first. - by rewrite sub_gen // subsetU // sPhiP0 orbT. - rewrite cent_joinEr ?(sub_abelian_cent2 cPP) //. - rewrite quotientMr //; last by rewrite (subset_trans sP0P) ?gFnorm. - by rewrite -defP0b defPb. - apply/trivgP; case/dprodP: dxCSA => _ _ _ <-. - rewrite subsetI subsetIl (subset_trans _ (Phi_sub Y)) // -defPhiP. - rewrite -quotient_sub1 ?subIset ?(subset_trans sA0P) ?gFnorm //. - by rewrite quotientIG // -defP0b tiAP0b. -have nA0E := subset_trans _ (subset_trans sEM (normal_norm nsA0M)). -have{defP} [_ defAP0 _ tiAP0] := dprodP defP. -have sP0P: P0 \subset P by rewrite -defAP0 mulG_subr. -have sP0E := subset_trans sP0P (pHall_sub sylP_E). -pose E0 := (E3 <*> (P0 <*> E1))%G. -have sP0E1_E: P0 <*> E1 \subset E by rewrite join_subG sP0E. -have sE0E: E0 \subset E by rewrite join_subG sE3E. -have mulA0E0: A0 * E0 = E. - rewrite /= (norm_joinEr (nE3E _ sP0E1_E)) mulgA -(normC (nA0E _ sE3E)). - by rewrite /= -mulgA (norm_joinEr nP0E1) (mulgA A0) defAP0 defPE1. -have tiA0E0: A0 :&: E0 = 1. - rewrite cardMg_TI // mulA0E0 -defE /= (norm_joinEr (nE3E _ sP0E1_E)). - rewrite !TI_cardMg //; last first. - by apply/trivgP; rewrite -tiE321 setIS //= ?norm_joinEr // -defPE1 mulSg. - rewrite mulnCA /= leq_mul // norm_joinEr //= -defPE1. - rewrite !TI_cardMg //; last by apply/trivgP; rewrite -tiPE1 setSI. - by rewrite mulnA -(TI_cardMg tiAP0) defAP0. -have defAE0: A0 ><| E0 = E by rewrite sdprodE ?nA0E. -exists E0 => // x /setD1P[ntx Ms_x] q piCE0x_q. -have: q \in \pi(E) by apply: piSg piCE0x_q; rewrite subIset ?sE0E. -rewrite mem_primes in piCE0x_q; case/and3P: piCE0x_q => q_pr _. -case/Cauchy=> // z /setIP[E0z cxz] oz. -have ntz: z != 1 by rewrite -order_gt1 oz prime_gt1. -have ntCMs_z: 'C_Ms[z] != 1. - apply: contraNneq ntx => reg_z; rewrite (sameP eqP set1gP) -reg_z inE Ms_x. - by rewrite cent1C. -rewrite (partition_pi_sigma_compl maxM hallE) def_t2. -case/or3P => [-> // | pq | t3Mq]. - have EpA0'_z: <[z]>%G \in 'E_p^1(E) :\ A0. - rewrite p1ElemE // !inE -orderE oz (eqnP pq) eqxx cycle_subG. - rewrite (subsetP sE0E) // !andbT; apply: contraNneq ntz => eqA0z. - by rewrite (sameP eqP set1gP) -tiA0E0 inE -eqA0z cycle_id E0z. - have [reg_z _] := regA0' _ EpA0'_z. - by rewrite -cent_cycle reg_z eqxx in ntCMs_z. -rewrite regE3 ?eqxx // !inE ntz /= in ntCMs_z. -by rewrite (mem_normal_Hall hallE3 nsE3E) ?(subsetP sE0E) // /p_elt oz pnatE. -Qed. - -(* This is B & G, Theorem 12.8(c). This part does not use the decompotision *) -(* of the complement, and needs to be proved ahead because it is used with *) -(* different primes in \tau_2(M) in the main argument. We also include an *) -(* auxiliary identity, which is needed in another part of the proof of 12.8. *) -Theorem abelian_tau2_sub_Fitting M E p A S : - M \in 'M -> \sigma(M)^'.-Hall(M) E -> - p \in \tau2(M) -> A \in 'E_p^2(E) -> - p.-Sylow(G) S -> A \subset S -> abelian S -> - [/\ S \subset 'N(S)^`(1), - 'N(S)^`(1) \subset 'F(E), - 'F(E) \subset 'C(S), - 'C(S) \subset E - & 'F('N(A)) = 'F(E)]. -Proof. -move=> maxM hallE t2Mp Ep2A sylS sAS cSS. -have [sAE abelA dimA]:= pnElemP Ep2A; have [pA cAA _] := and3P abelA. -have [sEM sM'E _] := and3P hallE. -have Ep2A_M := subsetP (pnElemS p 2 sEM) A Ep2A. -have eqFC H: A <| H -> 'C(A) \subset H -> 'F(H) = 'F('C(A)). - move=> nsAH sCH; have [_ nAH] := andP nsAH. - apply/eqP; rewrite eqEsubset !Fitting_max ?Fitting_nil //. - by rewrite gFnormal_trans // /normal sCH norms_cent. - apply: normalS sCH (Fitting_normal H). - have [_ defF cFpFp' _] := dprodP (nilpotent_pcoreC p (Fitting_nil H)). - have sAFp: A \subset 'O_p('F(H)) by rewrite p_core_Fitting pcore_max. - have [x _ sFpSx] := Sylow_subJ sylS (subsetT _) (pcore_pgroup p 'F(H)). - have cFpFp: abelian 'O_p('F(H)) by rewrite (abelianS sFpSx) ?abelianJ. - by rewrite -defF mulG_subG (centSS _ _ cFpFp) // (centSS _ _ cFpFp'). -have [[nsAE _] [sCAE _] _ _ _] := tau2_compl_context maxM hallE t2Mp Ep2A. -have eqFN_FE: 'F('N(A)) = 'F(E) by rewrite (eqFC E) // eqFC ?cent_sub ?normalG. -have sN'FN: 'N(A)^`(1) \subset 'F('N(A)). - rewrite rank2_der1_sub_Fitting ?mFT_odd //. - rewrite ?mFT_sol // mFT_norm_proper ?(mFT_pgroup_proper pA) //. - by rewrite -rank_gt0 (rank_abelem abelA) dimA. - rewrite eqFN_FE (leq_trans (rankS (Fitting_sub E))) //. - have [q q_pr ->]:= rank_witness E; apply: wlog_neg; rewrite -ltnNge => rEgt2. - rewrite (leq_trans (p_rankS q sEM)) // leqNgt. - apply: contra ((alpha_sub_sigma maxM) q) (pnatPpi sM'E _). - by rewrite -p_rank_gt0 (leq_trans _ rEgt2). -have sSE: S \subset E by rewrite (subset_trans _ sCAE) // (centSS _ _ cSS). -have nA_NS: 'N(S) \subset 'N(A). - have [ ] := tau2_context maxM t2Mp Ep2A_M; have sSM := subset_trans sSE sEM. - have sylS_M: p.-Sylow(M) S := pHall_subl sSM (subsetT M) sylS. - by case/(_ S) => // _ [// |<- _] _ _ _ _; apply: char_norms (Ohm_char 1 _). -have sS_NS': S \subset 'N(S)^`(1) := mFT_Sylow_der1 sylS. -have sNS'_FE: 'N(S)^`(1) \subset 'F(E). - by rewrite -eqFN_FE (subset_trans (dergS 1 nA_NS)). -split=> //; last by rewrite (subset_trans (centS sAS)). -have sSFE := subset_trans sS_NS' sNS'_FE; have nilFE := Fitting_nil E. -have sylS_FE := pHall_subl sSFE (subsetT 'F(E)) sylS. -suff sSZF: S \subset 'Z('F(E)) by rewrite centsC (subset_trans sSZF) ?subsetIr. -have [_ <- _ _] := dprodP (center_dprod (nilpotent_pcoreC p nilFE)). -by rewrite -(nilpotent_Hall_pcore nilFE sylS_FE) (center_idP cSS) mulG_subl. -Qed. - -(* This is B & G, Theorem 12.8(a,b,d,e) -- the bulk of the Theorem. We prove *) -(* part (f) separately below, as it does not depend on a decomposition of the *) -(* complement. *) -Theorem abelian_tau2 M E E1 E2 E3 p A S (Ms := M`_\sigma) : - M \in 'M -> sigma_complement M E E1 E2 E3 -> - p \in \tau2(M) -> A \in 'E_p^2(E) -> - p.-Sylow(G) S -> A \subset S -> abelian S -> - [/\ (*a*) E2 <| E /\ abelian E2, - (*b*) \tau2(M).-Hall(G) E2, - (*d*) [/\ 'N(A) = 'N(S), - 'N(S) = 'N(E2), - 'N(E2) = 'N(E3 <*> E2) - & 'N(E3 <*> E2) = 'N('F(E))] - & (*e*) forall X, X \in 'E^1(E1) -> 'C_Ms(X) = 1 -> X \subset 'Z(E)]. -Proof. -move=> maxM complEi t2Mp Ep2A sylS sAS cSS. -have [hallE hallE1 hallE2 hallE3 _] := complEi. -have [sEM sM'E _] := and3P hallE. -have [sE1E t1E1 _] := and3P hallE1. -have [sE2E t2E2 _] := and3P hallE2. -have [sE3E t3E3 _] := and3P hallE3. -have nilF: nilpotent 'F(E) := Fitting_nil E. -have sylE2_sylG_ZFE q Q: - q.-Sylow(E2) Q -> Q :!=: 1 -> q.-Sylow(G) Q /\ Q \subset 'Z('F(E)). -- move=> sylQ ntQ; have [sQE2 qQ _] := and3P sylQ. - have piQq: q \in \pi(Q) by rewrite -p_rank_gt0 -rank_pgroup // rank_gt0. - have t2Mq: q \in \tau2(M) by rewrite (pnatPpi t2E2) // (piSg sQE2). - have sylQ_E: q.-Sylow(E) Q := subHall_Sylow hallE2 t2Mq sylQ. - have rqQ: 'r_q(Q) = 2. - rewrite (tau2E hallE) !inE -(p_rank_Sylow sylQ_E) in t2Mq. - by case/andP: t2Mq => _ /eqP. - have [B Eq2B sBQ]: exists2 B, B \in 'E_q^2(E) & B \subset Q. - have [B Eq2B] := p_rank_witness q Q; have [sBQ abelB rBQ] := pnElemP Eq2B. - exists B; rewrite // !inE rBQ rqQ abelB !andbT. - exact: subset_trans sBQ (pHall_sub sylQ_E). - have [T /= sylT sQT] := Sylow_superset (subsetT Q) qQ. - have qT: q.-group T := pHall_pgroup sylT. - have cTT: abelian T. - apply: wlog_neg => not_cTT. - have [def_t2 _ _ _] := nonabelian_tau2 maxM hallE t2Mq Eq2B qT not_cTT. - rewrite def_t2 !inE in t2Mp; rewrite (eqP t2Mp) in sylS. - by have [x _ ->] := Sylow_trans sylS sylT; rewrite abelianJ. - have sTF: T \subset 'F(E). - have subF := abelian_tau2_sub_Fitting maxM hallE t2Mq Eq2B sylT. - have [sTN' sN'F _ _ _] := subF (subset_trans sBQ sQT) cTT. - exact: subset_trans sTN' sN'F. - have sTE: T \subset E := subset_trans sTF (Fitting_sub E). - have <-: T :=: Q by apply: (sub_pHall sylQ_E). - have sylT_F: q.-Sylow('F(E)) T := pHall_subl sTF (subsetT _) sylT. - have [_ <- _ _] := dprodP (center_dprod (nilpotent_pcoreC q nilF)). - by rewrite -(nilpotent_Hall_pcore nilF sylT_F) (center_idP cTT) mulG_subl. -have hallE2_G: \tau2(M).-Hall(G) E2. - rewrite pHallE subsetT /= -(part_pnat_id t2E2); apply/eqnP. - rewrite !(widen_partn _ (subset_leq_card (subsetT _))). - apply: eq_bigr => q t2q; rewrite -!p_part. - have [Q sylQ] := Sylow_exists q E2; have qQ := pHall_pgroup sylQ. - have sylQ_E: q.-Sylow(E) Q := subHall_Sylow hallE2 t2q sylQ. - have ntQ: Q :!=: 1. - rewrite -rank_gt0 (rank_pgroup qQ) (p_rank_Sylow sylQ_E) p_rank_gt0. - by rewrite (tau2E hallE) in t2q; case/andP: t2q. - have [sylQ_G _] := sylE2_sylG_ZFE q Q sylQ ntQ. - by rewrite -(card_Hall sylQ) -(card_Hall sylQ_G). -have sE2_ZFE: E2 \subset 'Z('F(E)). - rewrite -Sylow_gen gen_subG; apply/bigcupsP=> Q; case/SylowP=> q q_pr sylQ. - have [-> | ntQ] := eqsVneq Q 1; first exact: sub1G. - by have [_ ->] := sylE2_sylG_ZFE q Q sylQ ntQ. -have cE2E2: abelian E2 := abelianS sE2_ZFE (center_abelian _). -have sE2FE: E2 \subset 'F(E) := subset_trans sE2_ZFE (center_sub _). -have nsE2E: E2 <| E. - have hallE2_F := pHall_subl sE2FE (Fitting_sub E) hallE2. - by rewrite (nilpotent_Hall_pcore nilF hallE2_F) !gFnormal_trans. -have [_ _ [cycE1 cycE3] [_ defEl] _] := sigma_compl_context maxM complEi. -have [[K _ defK _] _ _ _] := sdprodP defEl; rewrite defK in defEl. -have [nsKE _ mulKE1 nKE1 _] := sdprod_context defEl; have [sKE _] := andP nsKE. -have [nsE3K sE2K _ nE32 tiE32] := sdprod_context defK. -rewrite -sdprodEY // defK. -have{defK} defK: E3 \x E2 = K. - rewrite dprodEsd // (sameP commG1P trivgP) -tiE32 subsetI commg_subr nE32. - by rewrite commg_subl (subset_trans sE3E) ?normal_norm. -have cKK: abelian K. - by have [_ <- cE23 _] := dprodP defK; rewrite abelianM cE2E2 cyclic_abelian. -have [_ sNS'F _ sCS_E defFN] := - abelian_tau2_sub_Fitting maxM hallE t2Mp Ep2A sylS sAS cSS. -have{sCS_E} sSE2: S \subset E2. - rewrite (sub_normal_Hall hallE2 nsE2E (subset_trans cSS sCS_E)). - by rewrite (pi_pgroup (pHall_pgroup sylS)). -have charS: S \char E2. - have sylS_E2: p.-Sylow(E2) S := pHall_subl sSE2 (subsetT E2) sylS. - by rewrite (nilpotent_Hall_pcore (abelian_nil cE2E2) sylS_E2) pcore_char. -have nsSE: S <| E := char_normal_trans charS nsE2E; have [sSE nSE] := andP nsSE. -have charA: A \char S. - have Ep2A_M := subsetP (pnElemS p 2 sEM) A Ep2A. - have sylS_M := pHall_subl (subset_trans sSE sEM) (subsetT M) sylS. - have [] := tau2_context maxM t2Mp Ep2A_M; case/(_ S sylS_M)=> _ [//|<- _]. - by rewrite Ohm_char. -have charE2: E2 \char K. - have hallE2_K := pHall_subl sE2K sKE hallE2. - by rewrite (nilpotent_Hall_pcore (abelian_nil cKK) hallE2_K) pcore_char. -have coKE1: coprime #|K| #|E1|. - rewrite -(dprod_card defK) coprime_mull (sub_pnat_coprime tau3'1 t3E3 t1E1). - by rewrite (sub_pnat_coprime tau2'1 t2E2 t1E1). -have hallK: Hall 'F(E) K. - have hallK: Hall E K. - by rewrite /Hall -divgS sKE //= -(sdprod_card defEl) mulKn. - have sKFE: K \subset 'F(E) by rewrite Fitting_max ?abelian_nil. - exact: pHall_Hall (pHall_subl sKFE (Fitting_sub E) (Hall_pi hallK)). -have charK: K \char 'F(E). - by rewrite (nilpotent_Hall_pcore nilF (Hall_pi hallK)) pcore_char. -have{defFN} [eqNAS eqNSE2 eqNE2K eqNKF]: - [/\ 'N(A) = 'N(S), 'N(S) = 'N(E2), 'N(E2) = 'N(K) & 'N(K) = 'N('F(E))]. - have: #|'N(A)| <= #|'N('F(E))|. - by rewrite subset_leq_card // -defFN gFnorm. - have leCN := subset_leqif_cards (@char_norms gT _ _ _). - have trCN := leqif_trans (leCN _ _ _). - have leq_KtoA := trCN _ _ _ _ charE2 (trCN _ _ _ _ charS (leCN _ _ charA)). - rewrite (geq_leqif (trCN _ _ _ _ charK leq_KtoA)). - by case/and4P; do 4!move/eqP->. -split=> // X E1_1_X regX. -have cK_NK': 'N(K)^`(1) \subset 'C(K). - suffices sKZ: K \subset 'Z('F(E)). - by rewrite -eqNE2K -eqNSE2 (centSS sNS'F sKZ) // centsC subsetIr. - have{hallK} [pi hallK] := HallP hallK. - have [_ <- _ _] := dprodP (center_dprod (nilpotent_pcoreC pi nilF)). - by rewrite -(nilpotent_Hall_pcore nilF hallK) (center_idP cKK) mulG_subl. -have [q EqX] := nElemP E1_1_X; have [sXE1 abelX dimX] := pnElemP EqX. -have sXE := subset_trans sXE1 sE1E. -have nKX := subset_trans sXE (normal_norm nsKE). -have nCSX_NS: 'N(K) \subset 'N('C(K) * X). - rewrite -(quotientGK (cent_normal _)) -quotientK ?norms_cent //. - by rewrite morphpre_norms // sub_abelian_norm ?quotientS ?sub_der1_abelian. -have nKX_NS: 'N(S) \subset 'N([~: K, X]). - have CK_K_1: [~: 'C(K), K] = 1 by apply/commG1P. - rewrite eqNSE2 eqNE2K commGC -[[~: X, K]]mul1g -CK_K_1. - by rewrite -commMG ?CK_K_1 ?norms1 ?normsR. -have not_sNKX_M: ~~ ('N([~: K, X]) \subset M). - have [[sM'p _] sSM] := (andP t2Mp, subset_trans sSE sEM). - apply: contra sM'p => sNKX_M; apply/existsP; exists S. - by rewrite (pHall_subl sSM (subsetT _) sylS) // (subset_trans _ sNKX_M). -have cKX: K \subset 'C(X). - apply: contraR not_sNKX_M; rewrite (sameP commG1P eqP) => ntKX. - rewrite (mmax_normal maxM) //. - have [sKM sM'K] := (subset_trans sKE sEM, pgroupS sKE sM'E). - have piE1q: q \in \pi(E1). - by rewrite -p_rank_gt0 -dimX logn_le_p_rank // inE sXE1. - have sM'q: q \in \sigma(M)^' by rewrite (pnatPpi sM'E) // (piSg sE1E). - have EpX_NK: X \in 'E_q^1('N_M(K)). - by apply: subsetP EqX; rewrite pnElemS // subsetI (subset_trans sE1E). - have q'K: q^'.-group K. - by rewrite p'groupEpi ?coprime_pi' // in coKE1 *; apply: (pnatPpi coKE1). - by have []:= commG_sigma'_1Elem_cyclic maxM sKM sM'K sM'q EpX_NK regX. -rewrite subsetI sXE /= -mulKE1 centM subsetI centsC cKX. -exact: subset_trans sXE1 (cyclic_abelian cycE1). -Qed. - -(* This is B & G, Theorem 12.8(f). *) -Theorem abelian_tau2_norm_Sylow M E p A S : - M \in 'M -> \sigma(M)^'.-Hall(M) E -> p \in \tau2(M) -> A \in 'E_p^2(E) -> - p.-Sylow(G) S -> A \subset S -> abelian S -> - forall X, X \subset 'N(S) -> 'C_S(X) <| 'N(S) /\ [~: S, X] <| 'N(S). -Proof. -move=> maxM hallE t2Mp Ep2A sylS sAS cSS X nSX. -have [_ sNS'F sFCS _ _] := - abelian_tau2_sub_Fitting maxM hallE t2Mp Ep2A sylS sAS cSS. -have{sNS'F sFCS} sNS'CS: 'N(S)^`(1) \subset 'C(S) := subset_trans sNS'F sFCS. -have nCSX_NS: 'N(S) \subset 'N('C(S) * X). - rewrite -quotientK ?norms_cent // -{1}(quotientGK (cent_normal S)). - by rewrite morphpre_norms // sub_abelian_norm ?quotientS ?sub_der1_abelian. -rewrite /normal subIset ?comm_subG ?normG //=; split. - have ->: 'C_S(X) = 'C_S('C(S) * X). - by rewrite centM setIA; congr (_ :&: _); rewrite (setIidPl _) // centsC. - by rewrite normsI ?norms_cent. -have CS_S_1: [~: 'C(S), S] = 1 by apply/commG1P. -by rewrite commGC -[[~: X, S]]mul1g -CS_S_1 -commMG ?CS_S_1 ?norms1 ?normsR. -Qed. - -(* This is B & G, Corollary 12.9. *) -Corollary tau1_act_tau2 M E p A q Q (Ms := M`_\sigma) : - M \in 'M -> \sigma(M)^'.-Hall(M) E -> p \in \tau2(M) -> A \in 'E_p^2(E) -> - q \in \tau1(M) -> Q \in 'E_q^1(E) -> 'C_Ms(Q) = 1 -> [~: A, Q] != 1 -> - let A0 := [~: A, Q]%G in let A1 := ('C_A(Q))%G in - [/\ (*a*) [/\ A0 \in 'E_p^1(A), 'C_A(Ms) = A0 & A0 <| M], - (*b*) gval A0 \notin A1 :^: G - & (*c*) A1 \in 'E_p^1(A) /\ ~~ ('C(A1) \subset M)]. -Proof. -move=> maxM hallE t2Mp Ep2A t1Mq EqQ regQ ntA0 A0 A1. -have [sEM sM'E _] := and3P hallE. -have [sAE abelA dimA] := pnElemP Ep2A; have [pA cAA _] := and3P abelA. -have [sQE abelQ dimQ] := pnElemP EqQ; have [qQ _ _] := and3P abelQ. -have [p_pr q_pr] := (pnElem_prime Ep2A, pnElem_prime EqQ). -have p_gt1 := prime_gt1 p_pr. -have Ep2A_M := subsetP (pnElemS p 2 sEM) A Ep2A. -have [_ _ regA _ _] := tau2_context maxM t2Mp Ep2A_M. -have [[nsAE _] _ _ _] := tau2_compl_context maxM hallE t2Mp Ep2A. -have [_ nAE] := andP nsAE; have nAQ := subset_trans sQE nAE. -have coAQ: coprime #|A| #|Q|. - exact: sub_pnat_coprime tau2'1 (pi_pnat pA t2Mp) (pi_pnat qQ t1Mq). -have defA: A0 \x A1 = A := coprime_abelian_cent_dprod nAQ coAQ cAA. -have [_ _ _ tiA01] := dprodP defA. -have [sAM sM'A] := (subset_trans sAE sEM, pgroupS sAE sM'E). -have sM'q: q \in \sigma(M)^' by case/andP: t1Mq. -have EqQ_NA: Q \in 'E_q^1('N_M(A)). - by apply: subsetP EqQ; rewrite pnElemS // subsetI sEM. -have q'A: q^'.-group A. - rewrite p'groupEpi ?coprime_pi' // in coAQ *. - by apply: (pnatPpi coAQ); rewrite -p_rank_gt0 (p_rank_abelem abelQ) dimQ. -have [] := commG_sigma'_1Elem_cyclic maxM sAM sM'A sM'q EqQ_NA regQ q'A cAA. -rewrite -[[~: A, Q]]/(gval A0) -/Ms => cMsA0 cycA0 nsA0M. -have sA0A: A0 \subset A by rewrite commg_subl. -have EpA0: A0 \in 'E_p^1(A). - have abelA0 := abelemS sA0A abelA; have [pA0 _] := andP abelA0. - rewrite p1ElemE // !inE sA0A -(Ohm1_id abelA0) /=. - by rewrite (Ohm1_cyclic_pgroup_prime cycA0 pA0). -have defA0: 'C_A(Ms) = A0. - apply/eqP; rewrite eq_sym eqEcard subsetI sA0A cMsA0 (card_pnElem EpA0). - have pCAMs: p.-group 'C_A(Ms) := pgroupS (subsetIl A _) pA. - rewrite (card_pgroup pCAMs) leq_exp2l //= leqNgt. - apply: contra (Msigma_neq1 maxM) => dimCAMs. - rewrite eq_sym -regA (sameP eqP setIidPl) centsC (sameP setIidPl eqP). - by rewrite eqEcard subsetIl (card_pnElem Ep2A) (card_pgroup pCAMs) leq_exp2l. -have EpA1: A1 \in 'E_p^1(A). - rewrite p1ElemE // !inE subsetIl -(eqn_pmul2l (ltnW p_gt1)). - by rewrite -{1}[p](card_pnElem EpA0) (dprod_card defA) (card_pnElem Ep2A) /=. -have defNA0: 'N(A0) = M by apply: mmax_normal. -have not_cA0Q: ~~ (Q \subset 'C(A0)). - apply: contra ntA0 => cA0Q. - by rewrite -subG1 -tiA01 !subsetI subxx sA0A centsC cA0Q. -have rqM: 'r_q(M) = 1%N by apply/eqP; case/and3P: t1Mq. -have q'CA0: q^'.-group 'C(A0). - have [S sylS sQS] := Sylow_superset (subset_trans sQE sEM) qQ. - have qS := pHall_pgroup sylS; rewrite -(p_rank_Sylow sylS) in rqM. - have cycS: cyclic S by rewrite (odd_pgroup_rank1_cyclic qS) ?mFT_odd ?rqM. - have ntS: S :!=: 1 by rewrite -rank_gt0 (rank_pgroup qS) rqM. - have defS1: 'Ohm_1(S) = Q. - apply/eqP; rewrite eq_sym eqEcard -{1}(Ohm1_id abelQ) OhmS //=. - by rewrite (card_pnElem EqQ) (Ohm1_cyclic_pgroup_prime cycS qS). - have sylSC: q.-Sylow('C(A0)) 'C_S(A0). - by rewrite (Hall_setI_normal _ sylS) // -defNA0 cent_normal. - rewrite -partG_eq1 ?cardG_gt0 // -(card_Hall sylSC) -trivg_card1 /=. - by rewrite setIC TI_Ohm1 // defS1 setIC prime_TIg ?(card_pnElem EqQ). -do 2?split=> //. - have: ~~ q^'.-group Q by rewrite /pgroup (card_pnElem EqQ) pnatE ?inE ?negbK. - apply: contra; case/imsetP=> x _ defA01. - rewrite defA01 centJ pgroupJ in q'CA0. - by apply: pgroupS q'CA0; rewrite centsC subsetIr. -have [S sylS sAS] := Sylow_superset (subsetT A) pA. -have [cSS | not_cSS] := boolP (abelian S). - have solE := sigma_compl_sol hallE. - have [E1 hallE1 sQE1] := Hall_superset solE sQE (pi_pnat qQ t1Mq). - have [E3 hallE3] := Hall_exists \tau3(M) solE. - have [E2 _ complEi] := ex_tau2_compl hallE hallE1 hallE3. - have [_ _ _ reg1Z] := abelian_tau2 maxM complEi t2Mp Ep2A sylS sAS cSS. - have E1Q: Q \in 'E^1(E1). - by apply/nElemP; exists q; rewrite // !inE sQE1 abelQ dimQ. - rewrite (subset_trans (reg1Z Q E1Q regQ)) ?subIset // in not_cA0Q. - by rewrite centS ?orbT // (subset_trans sA0A). -have pS := pHall_pgroup sylS. -have [_ _ not_cent_reg _] := nonabelian_tau2 maxM hallE t2Mp Ep2A pS not_cSS. -case: (not_cent_reg A1); rewrite // 2!inE (subsetP (pnElemS p 1 sAE)) // andbT. -by rewrite -val_eqE /= defA0 eq_sym; apply/(TIp1ElemP EpA0 EpA1). -Qed. - -(* This is B & G, Corollary 12.10(a). *) -Corollary sigma'_nil_abelian M N : - M \in 'M -> N \subset M -> \sigma(M)^'.-group N -> nilpotent N -> abelian N. -Proof. -move=> maxM sNM sM'N /nilpotent_Fitting defN. -apply/center_idP; rewrite -{2}defN -{defN}(center_bigdprod defN). -apply: eq_bigr => p _; apply/center_idP; set P := 'O_p(N). -have [-> | ntP] := eqVneq P 1; first exact: abelian1. -have [pP sPN]: p.-group P /\ P \subset N by rewrite pcore_sub pcore_pgroup. -have{sPN sNM sM'N} [sPM sM'P] := (subset_trans sPN sNM, pgroupS sPN sM'N). -have{sPM sM'P} [E hallE sPE] := Hall_superset (mmax_sol maxM) sPM sM'P. -suffices [S sylS cSS]: exists2 S : {group gT}, p.-Sylow(E) S & abelian S. - by have [x _ sPS] := Sylow_subJ sylS sPE pP; rewrite (abelianS sPS) ?abelianJ. -have{N P sPE pP ntP} piEp: p \in \pi(E). - by rewrite (piSg sPE) // -p_rank_gt0 -rank_pgroup // rank_gt0. -rewrite (partition_pi_sigma_compl maxM hallE) orbCA orbC -orbA in piEp. -have [[E1 hallE1] [E3 hallE3]] := ex_tau13_compl hallE. -have [E2 hallE2 complEi] := ex_tau2_compl hallE hallE1 hallE3. -have{complEi} [_ _ [cycE1 cycE3] _ _] := sigma_compl_context maxM complEi. -have{piEp} [t1p | t3p | t2p] := or3P piEp. -- have [S sylS] := Sylow_exists p E1. - exists S; first exact: subHall_Sylow hallE1 t1p sylS. - exact: abelianS (pHall_sub sylS) (cyclic_abelian cycE1). -- have [S sylS] := Sylow_exists p E3. - exists S; first exact: subHall_Sylow hallE3 t3p sylS. - exact: abelianS (pHall_sub sylS) (cyclic_abelian cycE3). -have [s'p rpM] := andP t2p; have [S sylS] := Sylow_exists p E; exists S => //. -have sylS_M := subHall_Sylow hallE s'p sylS. -have [A _ Ep2A] := ex_tau2Elem hallE t2p. -by have [/(_ S sylS_M)[]] := tau2_context maxM t2p Ep2A. -Qed. - -(* This is B & G, Corollary 12.10(b), first assertion. *) -Corollary der_mmax_compl_abelian M E : - M \in 'M -> \sigma(M)^'.-Hall(M) E -> abelian E^`(1). -Proof. -move=> maxM hallE; have [sEM s'E _] := and3P hallE. -have sE'E := der_sub 1 E; have sE'M := subset_trans sE'E sEM. -exact: sigma'_nil_abelian (pgroupS _ s'E) (der1_sigma_compl_nil maxM hallE). -Qed. - -(* This is B & G, Corollary 12.10(b), second assertion. *) -(* Note that we do not require the full decomposition of the complement. *) -Corollary tau2_compl_abelian M E E2 : - M \in 'M -> \sigma(M)^'.-Hall(M) E -> \tau2(M).-Hall(E) E2 -> abelian E2. -Proof. -move: E2 => F2 maxM hallE hallF2; have [sEM s'E _] := and3P hallE. -have [[E1 hallE1] [E3 hallE3]] := ex_tau13_compl hallE. -have [E2 hallE2 complEi] := ex_tau2_compl hallE hallE1 hallE3. -have solE: solvable E := sigma_compl_sol hallE. -have{solE hallF2} [x _ ->{F2}] := Hall_trans solE hallF2 hallE2. -have [-> | ntE] := eqsVneq E2 1; rewrite {x}abelianJ ?abelian1 //. -have [[p p_pr rpE2] [sE2E t2E2 _]] := (rank_witness E2, and3P hallE2). -have piE2p: p \in \pi(E2) by rewrite -p_rank_gt0 -rpE2 rank_gt0. -have t2p := pnatPpi t2E2 piE2p; have [A Ep2A _] := ex_tau2Elem hallE t2p. -have [_ abelA _] := pnElemP Ep2A; have [pA _] := andP abelA. -have [S /= sylS sAS] := Sylow_superset (subsetT A) pA. -have [cSS | not_cSS] := boolP (abelian S). - by have [[_ cE2E2] _ _ _] := abelian_tau2 maxM complEi t2p Ep2A sylS sAS cSS. -have pS := pHall_pgroup sylS. -have [def_t2 _ _ _] := nonabelian_tau2 maxM hallE t2p Ep2A pS not_cSS. -apply: sigma'_nil_abelian (subset_trans _ sEM) (pgroupS _ s'E) _ => //. -by rewrite (eq_pgroup _ def_t2) in t2E2; apply: pgroup_nil t2E2. -Qed. - -(* This is B & G, Corollary 12.10(c). *) -(* We do not really need a full decomposition of the complement in the first *) -(* part, but this reduces the number of assumptions. *) -Corollary tau1_cent_tau2Elem_factor M E p A : - M \in 'M -> \sigma(M)^'.-Hall(M) E -> p \in \tau2(M) -> A \in 'E_p^2(E) -> - [/\ forall E1 E2 E3, sigma_complement M E E1 E2 E3 -> E3 * E2 \subset 'C_E(A), - 'C_E(A) <| E - & \tau1(M).-group (E / 'C_E(A))]. -Proof. -move=> maxM hallE t2p Ep2A; have sEM: E \subset M := pHall_sub hallE. -have nsAE: A <| E by case/(tau2_compl_context maxM): Ep2A => //; case. -have [sAE nAE]: A \subset E /\ E \subset 'N(A) := andP nsAE. -have nsCAE: 'C_E(A) <| E by rewrite norm_normalI ?norms_cent. -have [[E1 hallE1] [E3 hallE3]] := ex_tau13_compl hallE. -have [E2 hallE2 complEi] := ex_tau2_compl hallE hallE1 hallE3. -have{hallE1} [t1E1 sE3E] := (pHall_pgroup hallE1, pHall_sub hallE3). -have{nsAE} sAE2: A \subset E2. - apply: subset_trans (pcore_max _ nsAE) (pcore_sub_Hall hallE2). - by apply: pi_pnat t2p; case/pnElemP: Ep2A => _; case/andP. -have{complEi} defE: (E3 ><| E2) ><| E1 = E. - by case/sigma_compl_context: complEi => // _ _ _ [_ ->]. -have [[K _ defK _] _ _ _] := sdprodP defE; rewrite defK in defE. -have nsKE: K <| E by case/sdprod_context: defE. -have [[sKE nKE] [_ mulE32 nE32 tiE32]] := (andP nsKE, sdprodP defK). -have{sE3E} sK_CEA: K \subset 'C_E(A). - have cE2E2: abelian E2 := tau2_compl_abelian maxM hallE hallE2. - rewrite subsetI sKE -mulE32 mulG_subG (centsS sAE2 cE2E2) (sameP commG1P eqP). - rewrite -subG1 -tiE32 subsetI commg_subl (subset_trans sAE2) //=. - by rewrite (subset_trans _ sAE2) // commg_subr (subset_trans sE3E). -split=> // [_ F2 F3 [_ _ hallF2 hallF3 _] | ]. - have solE: solvable E := solvableS sEM (mmax_sol maxM). - have [x2 Ex2 ->] := Hall_trans solE hallF2 hallE2. - have [x3 Ex3 ->] := Hall_trans solE hallF3 hallE3. - rewrite mulG_subG !sub_conjg !(normsP (normal_norm nsCAE)) ?groupV //. - by rewrite -mulG_subG mulE32. -have [f <-] := homgP (homg_quotientS nKE (normal_norm nsCAE) sK_CEA). -by rewrite morphim_pgroup // /pgroup -divg_normal // -(sdprod_card defE) mulKn. -Qed. - -(* This is B & G, Corollary 12.10(d). *) -Corollary norm_noncyclic_sigma M p P : - M \in 'M -> p \in \sigma(M) -> p.-group P -> P \subset M -> ~~ cyclic P -> - 'N(P) \subset M. -Proof. -move=> maxM sMp pP sPM ncycP. -have [A Ep2A]: exists A, A \in 'E_p^2(P). - by apply/p_rank_geP; rewrite ltnNge -odd_pgroup_rank1_cyclic ?mFT_odd. -have [[sAP _ _] Ep2A_M] := (pnElemP Ep2A, subsetP (pnElemS p 2 sPM) A Ep2A). -have sCAM: 'C(A) \subset M by case/p2Elem_mmax: Ep2A_M. -have [_ _ <- //] := sigma_group_trans maxM sMp pP. -by rewrite mulG_subG subsetIl (subset_trans (centS sAP)). -Qed. - -(* This is B & G, Corollary 12.10(e). *) -Corollary cent1_nreg_sigma_uniq M (Ms := M`_\sigma) x : - M \in 'M -> x \in M^# -> \tau2(M).-elt x -> 'C_Ms[x] != 1 -> - 'M('C[x]) = [set M]. -Proof. -move=> maxM /setD1P[ntx]; rewrite -cycle_subG => sMX t2x. -apply: contraNeq => MCx_neqM. -have{MCx_neqM} [H maxCxH neqHM]: exists2 H, H \in 'M('C[x]) & H \notin [set M]. - apply/subsetPn; have [H MCxH] := mmax_exists (mFT_cent1_proper ntx). - by rewrite eqEcard cards1 (cardD1 H) MCxH andbT in MCx_neqM. -have sCxH: 'C[x] \subset H by case/setIdP: maxCxH. -have s'x: \sigma(M)^'.-elt x by apply: sub_pgroup t2x => p; case/andP. -have [E hallE sXE] := Hall_superset (mmax_sol maxM) sMX s'x. -have [sEM solE] := (pHall_sub hallE, sigma_compl_sol hallE). -have{sXE} [E2 hallE2 sXE2] := Hall_superset solE sXE t2x. -pose p := pdiv #[x]. -have t2p: p \in \tau2(M) by rewrite (pnatPpi t2x) ?pi_pdiv ?order_gt1. -have [A Ep2A sAE2]: exists2 A, A \in 'E_p^2(M) & A \subset E2. - have [A Ep2A_E EpA] := ex_tau2Elem hallE t2p. - have [sAE abelA _] := pnElemP Ep2A_E; have [pA _] := andP abelA. - have [z Ez sAzE2] := Hall_Jsub solE hallE2 sAE (pi_pnat pA t2p). - by exists (A :^ z)%G; rewrite // -(normsP (normsG sEM) z Ez) pnElemJ. -have cE2E2: abelian E2 := tau2_compl_abelian maxM hallE hallE2. -have cxA: A \subset 'C[x] by rewrite -cent_cycle (sub_abelian_cent2 cE2E2). -have maxAH: H \in 'M(A) :\ M by rewrite inE neqHM (subsetP (mmax_ofS cxA)). -have [_ _ _ tiMsMA _] := tau2_context maxM t2p Ep2A. -by rewrite -subG1 -(tiMsMA H maxAH) setIS. -Qed. - -(* This is B & G, Lemma 12.11. *) -Lemma primes_norm_tau2Elem M E p A Mstar : - M \in 'M -> \sigma(M)^'.-Hall(M) E -> p \in \tau2(M) -> A \in 'E_p^2(E) -> - Mstar \in 'M('N(A)) -> - [/\ (*a*) {subset \tau2(M) <= [predD \sigma(Mstar) & \beta(Mstar)]}, - (*b*) [predU \tau1(Mstar) & \tau2(Mstar)].-group (E / 'C_E(A)) - & (*c*) forall q, q \in \pi(E / 'C_E(A)) -> q \in \pi('C_E(A)) -> - [/\ q \in \tau2(Mstar), - exists2 P, P \in 'Syl_p(G) & P <| Mstar - & exists Q, [/\ Q \in 'Syl_q(G), Q \subset Mstar & abelian Q]]]. -Proof. -move=> maxM hallE t2Mp Ep2A; move: Mstar. -have [sAE abelA dimA] := pnElemP Ep2A; have [pA cAA _] := and3P abelA. -have ntA: A :!=: 1 by apply: (nt_pnElem Ep2A). -have [sEM solE] := (pHall_sub hallE, sigma_compl_sol hallE). -have [_ nsCA_E t1CEAb] := tau1_cent_tau2Elem_factor maxM hallE t2Mp Ep2A. -have [sAM nCA_E] := (subset_trans sAE sEM, normal_norm nsCA_E). -have part_a H: - H \in 'M('N(A)) -> {subset \tau2(M) <= [predD \sigma(H) & \beta(H)]}. -- case/setIdP=> maxH sNA_H q t2Mq. - have sCA_H: 'C(A) \subset H := subset_trans (cent_sub A) sNA_H. - have sAH := subset_trans cAA sCA_H. - have sHp: p \in \sigma(H). - have [// | t2Hp] := orP (prime_class_mmax_norm maxH pA sNA_H). - apply: contraLR sNA_H => sH'p. - have sH'A: \sigma(H)^'.-group A by apply: pi_pnat pA _. - have [F hallF sAF] := Hall_superset (mmax_sol maxH) sAH sH'A. - have Ep2A_F: A \in 'E_p^2(F) by apply/pnElemP. - by have [_ [_ _ ->]]:= tau2_compl_context maxH hallF t2Hp Ep2A_F. - rewrite inE /= -predI_sigma_beta //= negb_and /= orbC. - have [-> /= _] := tau2_not_beta maxM t2Mq. - have [B Eq2B]: exists B, B \in 'E_q^2('C(A)). - have [E2 hallE2 sAE2] := Hall_superset solE sAE (pi_pnat pA t2Mp). - have cE2E2: abelian E2 := tau2_compl_abelian maxM hallE hallE2. - have [Q sylQ] := Sylow_exists q E2; have sQE2 := pHall_sub sylQ. - have sylQ_E := subHall_Sylow hallE2 t2Mq sylQ. - apply/p_rank_geP; apply: leq_trans (p_rankS q (centsS sAE2 cE2E2)). - rewrite -(p_rank_Sylow sylQ) (p_rank_Sylow sylQ_E). - by move: t2Mq; rewrite (tau2E hallE) => /andP[_ /eqP->]. - have [cAB abelB dimB] := pnElemP Eq2B; have sBH := subset_trans cAB sCA_H. - have{Eq2B} Eq2B: B \in 'E_q^2(H) by apply/pnElemP. - have rqHgt1: 'r_q(H) > 1 by apply/p_rank_geP; exists B. - have piHq: q \in \pi(H) by rewrite -p_rank_gt0 ltnW. - rewrite partition_pi_mmax // in piHq. - case/or4P: piHq rqHgt1 => // [|t2Hq _|]; try by case/and3P=> _ /eqP->. - have [_ _ regB _ _] := tau2_context maxH t2Hq Eq2B. - case/negP: ntA; rewrite -subG1 -regB subsetI centsC cAB andbT. - by rewrite (sub_Hall_pcore (Msigma_Hall maxH)) // (pi_pgroup pA). -have part_b H: - H \in 'M('N(A)) -> [predU \tau1(H) & \tau2(H)].-group (E / 'C_E(A)). -- move=> maxNA_H; have [maxH sNA_H] := setIdP maxNA_H. - have [/= bH'p sHp] := andP (part_a H maxNA_H p t2Mp). - have sCA_H: 'C(A) \subset H := subset_trans (cent_sub A) sNA_H. - have sAH := subset_trans cAA sCA_H. - apply/pgroupP=> q q_pr q_dv_CEAb; apply: contraR bH'p => t12H'q. - have [Q sylQ] := Sylow_exists q E; have [sQE qQ _] := and3P sylQ. - have nsAE: A <| E by case/(tau2_compl_context maxM): Ep2A => //; case. - have nAE := normal_norm nsAE; have nAQ := subset_trans sQE nAE. - have sAQ_A: [~: A, Q] \subset A by rewrite commg_subl. - have ntAQ: [~: A, Q] != 1. - apply: contraTneq q_dv_CEAb => /commG1P cAQ. - have nCEA_Q := subset_trans sQE nCA_E. - rewrite -p'natE // -partn_eq1 ?cardg_gt0 //. - rewrite -(card_Hall (quotient_pHall nCEA_Q sylQ)) -trivg_card1 -subG1. - by rewrite quotient_sub1 // subsetI sQE centsC. - have sQH: Q \subset H := subset_trans nAQ sNA_H. - have sHsubH' r X: - r \in \sigma(H) -> X \subset H -> r.-group X -> X \subset H^`(1). - + move=> sHr sXH rX; apply: subset_trans (Msigma_der1 maxH). - by rewrite (sub_Hall_pcore (Msigma_Hall maxH)) // (pi_pgroup rX sHr). - have sAH': A \subset H^`(1) by apply: sHsubH' pA. - have{t12H'q} sQH': Q \subset H^`(1). - have [sHq | sH'q] := boolP (q \in \sigma(H)); first exact: sHsubH' qQ. - have{sH'q} sH'Q: \sigma(H)^'.-group Q by apply: (pi_pnat qQ). - have{sH'Q} [F hallF sQF] := Hall_superset (mmax_sol maxH) sQH sH'Q. - have [-> | ntQ] := eqsVneq Q 1; first exact: sub1G. - have{t12H'q} t3Hq: q \in \tau3(H). - apply: implyP t12H'q; rewrite implyNb -orbA. - rewrite -(partition_pi_sigma_compl maxH hallF) -p_rank_gt0. - by rewrite (leq_trans _ (p_rankS q sQF)) // -rank_pgroup // rank_gt0. - have solF: solvable F := sigma_compl_sol hallF. - have [F3 hallF3 sQF3] := Hall_superset solF sQF (pi_pnat qQ t3Hq). - have [[F1 hallF1] _] := ex_tau13_compl hallF. - have [F2 _ complFi] := ex_tau2_compl hallF hallF1 hallF3. - have [[sF3H' _] _ _ _ _] := sigma_compl_context maxH complFi. - exact: subset_trans sQF3 (subset_trans sF3H' (dergS 1 (pHall_sub hallF))). - have hallHb: \beta(H).-Hall(H) H`_\beta := Mbeta_Hall maxH. - have nilH'b: nilpotent (H^`(1) / H`_\beta) := Mbeta_quo_nil maxH. - have{nilH'b} sAQ_Hb: [~: A, Q] \subset H`_\beta. - rewrite commGC -quotient_cents2 ?gFnorm_trans ?normsG //=. - rewrite (sub_nilpotent_cent2 nilH'b) ?quotientS ?coprime_morph //. - rewrite (pnat_coprime (pi_pnat pA t2Mp) (pi_pnat qQ _)) ?tau2'1 //. - by rewrite (pnatPpi t1CEAb) // mem_primes q_pr cardG_gt0. - rewrite (pnatPpi (pHall_pgroup hallHb)) // (piSg sAQ_Hb) // -p_rank_gt0. - by rewrite -(rank_pgroup (pgroupS sAQ_A pA)) rank_gt0. -move=> H maxNA_H; split; last 1 [move=> q piCEAb_q piCEAq] || by auto. -have [_ sHp]: _ /\ p \in \sigma(H) := andP (part_a H maxNA_H p t2Mp). -have{maxNA_H} [maxH sNA_H] := setIdP maxNA_H. -have{sNA_H} sCA_H: 'C(A) \subset H := subset_trans (cent_sub A) sNA_H. -have{piCEAq} [Q0 EqQ0]: exists Q0, Q0 \in 'E_q^1('C_E(A)). - by apply/p_rank_geP; rewrite p_rank_gt0. -have [sQ0_CEA abelQ0 dimQ0]:= pnElemP EqQ0; have [qQ0 cQ0Q0 _] := and3P abelQ0. -have{sQ0_CEA} [sQ0E cAQ0]: Q0 \subset E /\ Q0 \subset 'C(A). - by apply/andP; rewrite -subsetI. -have ntQ0: Q0 :!=: 1 by apply: (nt_pnElem EqQ0). -have{t1CEAb} t1Mq: q \in \tau1(M) := pnatPpi t1CEAb piCEAb_q. -have [Q sylQ sQ0Q] := Sylow_superset sQ0E qQ0; have [sQE qQ _] := and3P sylQ. -have [E1 hallE1 sQE1] := Hall_superset solE sQE (pi_pnat qQ t1Mq). -have rqE: 'r_q(E) = 1%N. - by move: t1Mq; rewrite (tau1E maxM hallE) andbA andbC; case: eqP. -have cycQ: cyclic Q. - by rewrite (odd_pgroup_rank1_cyclic qQ) ?mFT_odd // (p_rank_Sylow sylQ) rqE. -have sCAE: 'C(A) \subset E by case/(tau2_compl_context maxM): Ep2A => // _ []. -have{sCAE} sylCQA: q.-Sylow('C(A)) 'C_Q(A). - by apply: Hall_setI_normal sylQ; rewrite /= -(setIidPr sCAE). -have{sylCQA} defNA: 'C(A) * 'N_('N(A))(Q0) = 'N(A). - apply/eqP; rewrite eqEsubset mulG_subG cent_sub subsetIl /=. - rewrite -{1}(Frattini_arg (cent_normal A) sylCQA) mulgS ?setIS ?char_norms //. - by rewrite (sub_cyclic_char Q0 (cyclicS (subsetIl Q _) cycQ)) subsetI sQ0Q. -have [L maxNQ0_L]: {L | L \in 'M('N(Q0))}. - by apply: mmax_exists; rewrite mFT_norm_proper ?(mFT_pgroup_proper qQ0). -have{maxNQ0_L} [maxL sNQ0_L] := setIdP maxNQ0_L. -have sCQ0_L: 'C(Q0) \subset L := subset_trans (cent_sub Q0) sNQ0_L. -have sAL: A \subset L by rewrite (subset_trans _ sCQ0_L) // centsC. -have sCA_L: 'C(A) \subset L. - by have /p2Elem_mmax[]: A \in 'E_p^2(L) by apply/pnElemP. -have{sCA_L defNA} maxNA_L: L \in 'M('N(A)). - by rewrite inE maxL -defNA setIC mul_subG // subIset ?sNQ0_L. -have t2Lq: q \in \tau2(L). - have /orP[sLq | //] := prime_class_mmax_norm maxL qQ0 sNQ0_L. - by have /orP[/andP[/negP] | ] := pnatPpi (part_b L maxNA_L) piCEAb_q. -have [cQQ [/= sL'q _]] := (cyclic_abelian cycQ, andP t2Lq). -have sQL: Q \subset L := subset_trans (centsS sQ0Q cQQ) sCQ0_L. -have [F hallF sQF] := Hall_superset (mmax_sol maxL) sQL (pi_pnat qQ sL'q). -have [B Eq2B _] := ex_tau2Elem hallF t2Lq. -have [_ sLp]: _ /\ p \in \sigma(L) := andP (part_a L maxNA_L p t2Mp). -have{H sHp maxH sCA_H} <-: L :=: H. - have sLHp: p \in [predI \sigma(L) & \sigma(H)] by apply/andP. - have [_ transCA _] := sigma_group_trans maxH sHp pA. - set S := finset _ in transCA; have sAH := subset_trans cAA sCA_H. - suffices [SH SL]: gval H \in S /\ gval L \in S. - have [c cAc -> /=]:= atransP2 transCA SH SL. - by rewrite conjGid // (subsetP sCA_H). - have [_ _ _ TIsL] := tau2_compl_context maxL hallF t2Lq Eq2B. - apply/andP; rewrite !inE sAH sAL orbit_refl orbit_sym /= andbT. - by apply: contraLR sLHp => /TIsL[] // _ ->. -split=> //. - exists ('O_p(L`_\sigma))%G; last by rewrite /= -pcoreI pcore_normal. - rewrite inE (subHall_Sylow (Msigma_Hall_G maxL) sLp) //. - by rewrite nilpotent_pcore_Hall // (tau2_Msigma_nil maxL t2Lq). -have [Q1 sylQ1 sQQ1] := Sylow_superset (subsetT Q) qQ. -have [sQ0Q1 qQ1] := (subset_trans sQ0Q sQQ1, pHall_pgroup sylQ1). -have [cQ1Q1 | not_cQ1Q1] := boolP (abelian Q1). - by exists Q1; rewrite inE (subset_trans (centsS sQ0Q1 cQ1Q1)). -have [_ _ regB [F0 /=]] := nonabelian_tau2 maxL hallF t2Lq Eq2B qQ1 not_cQ1Q1. -have{regB} ->: 'C_B(L`_\sigma) = Q0; last move=> defF _. - apply: contraTeq sCQ0_L => neqQ0B; case: (regB Q0) => //. - by rewrite 2!inE eq_sym neqQ0B; apply/pnElemP; rewrite (subset_trans sQ0Q). -have{defF} defQ: Q0 \x (F0 :&: Q) = Q. - rewrite dprodEsd ?(centSS (subsetIr F0 Q) sQ0Q) //. - by rewrite (sdprod_modl defF sQ0Q) (setIidPr sQF). -have [[/eqP/idPn//] | [_ eqQ0Q]] := cyclic_pgroup_dprod_trivg qQ cycQ defQ. -have nCEA_Q := subset_trans sQE nCA_E. -case/idPn: piCEAb_q; rewrite -p'natEpi -?partn_eq1 ?cardG_gt0 //. -rewrite -(card_Hall (quotient_pHall nCEA_Q sylQ)) -trivg_card1 -subG1. -by rewrite quotient_sub1 // subsetI sQE -eqQ0Q. -Qed. - -(* This is a generalization of B & G, Theorem 12.12. *) -(* In the B & G text, Theorem 12.12 only establishes the type F structure *) -(* for groups of type I, whereas it is required for the derived groups of *) -(* groups of type II (in the sense of Peterfalvi). Indeed this is exactly *) -(* what is stated in Lemma 15.15(e) and then Theorem B(3). The proof of *) -(* 15.15(c) cites 12.12 in the type I case (K = 1) and then loosely invokes *) -(* a "short and easy argument" inside the proof of 12.12 for the K != 1 case. *) -(* In fact, this involves copying roughly 25% of the proof, whereas the proof *) -(* remains essentially unchanged when Theorem 12.12 is generalized to a *) -(* normal Hall subgroup of E as below. *) -(* Also, we simplify the argument for central tau2 Sylow subgroup S of U by *) -(* by replacing the considerations on the abelian structure of S by a *) -(* comparison of Mho^n-1(S) and Ohm_1(S) (with exponent S = p ^ n), as the *) -(* former is needed anyway to prove regularity when S is not homocyclic. *) -Theorem FTtypeF_complement M (Ms := M`_\sigma) E U : - M \in 'M -> \sigma(M)^'.-Hall(M) E -> Hall E U -> U <| E -> U :!=: 1 -> - {in U^#, forall e, [predU \tau1(M) & \tau3(M)].-elt e -> 'C_Ms[e] = 1} -> - [/\ (*a*) exists A0 : {group gT}, - [/\ A0 <| U, abelian A0 & {in Ms^#, forall x, 'C_U[x] \subset A0}] - & (*b*) exists E0 : {group gT}, - [/\ E0 \subset U, exponent E0 = exponent U - & [Frobenius Ms <*> E0 = Ms ><| E0]]]. -Proof. -set p13 := predU _ _ => maxM hallE /Hall_pi hallU nsUE ntU regU13. -have [[E1 hallE1] [E3 hallE3]] := ex_tau13_compl hallE. -have [E2 hallE2 complEi] := ex_tau2_compl hallE hallE1 hallE3. -have [[sE1E _] [sE2E t2E2 _]] := (andP hallE1, and3P hallE2). -have [[_ nsE3E] _ [cycE1 _] [defE _] _] := sigma_compl_context maxM complEi. -have [[[sE3E t3E3 _][_ nE3E]] [sUE _]] := (and3P hallE3, andP nsE3E, andP nsUE). -have defM: Ms ><| E = M := sdprod_sigma maxM hallE. -have [nsMsM sEM mulMsE nMsE tiMsE] := sdprod_context defM. -have ntMs: Ms != 1 := Msigma_neq1 maxM. -have{defM} defMsU: Ms ><| U = Ms <*> U := sdprod_subr defM sUE. -pose U2 := (E2 :&: U)%G. -have hallU2: \tau2(M).-Hall(U) U2 := Hall_setI_normal nsUE hallE2. -have [U2_1 | ntU2] := eqsVneq U2 1. - have frobMsU: [Frobenius Ms <*> U = Ms ><| U]. - apply/Frobenius_semiregularP=> // e Ue. - apply: regU13 => //; case/setD1P: Ue => _; apply: mem_p_elt. - have: \tau2(M)^'.-group U. - by rewrite -partG_eq1 -(card_Hall hallU2) U2_1 cards1. - apply: sub_in_pnat => p /(piSg sUE). - by rewrite (partition_pi_sigma_compl maxM hallE) orbCA => /orP[] // /idPn. - split; [exists 1%G; rewrite normal1 abelian1 | by exists U]. - by split=> //= x Ux; rewrite (Frobenius_reg_compl frobMsU). -have [[sU2U t2U2 _] [p p_pr rU2]] := (and3P hallU2, rank_witness U2). -have piU2p: p \in \pi(U2) by rewrite -p_rank_gt0 -rU2 rank_gt0. -have t2p: p \in \tau2(M) := pnatPpi t2U2 piU2p. -have [A Ep2A Ep2A_M] := ex_tau2Elem hallE t2p. -have [sAE abelA _] := pnElemP Ep2A; have{abelA} [pA cAA _] := and3P abelA. -have [S sylS sAS] := Sylow_superset (subsetT A) pA. -have [cSS | not_cSS] := boolP (abelian S); last first. - have [_] := nonabelian_tau2 maxM hallE t2p Ep2A (pHall_pgroup sylS) not_cSS. - set A0 := ('C_A(_))%G => [] [oA0 _] _ {defE} [E0 defE regE0]. - have [nsA0E sE0E mulAE0 nAE0 tiAE0] := sdprod_context defE. - have [P sylP] := Sylow_exists p U; have [sPU _] := andP sylP. - have sylP_E := subHall_Sylow hallU (piSg sU2U piU2p) sylP. - have pA0: p.-group A0 by rewrite /pgroup oA0 pnat_id. - have sA0P: A0 \subset P. - by apply: subset_trans (pcore_sub_Hall sylP_E); apply: pcore_max. - have sA0U: A0 \subset U := subset_trans sA0P sPU. - pose U0 := (E0 :&: U)%G. - have defU: A0 ><| U0 = U by rewrite (sdprod_modl defE) // (setIidPr sUE). - have piU0p: p \in \pi(U0). - have:= lognSg p sAE; rewrite (card_pnElem Ep2A) pfactorK //. - rewrite -logn_part -(card_Hall sylP_E) (card_Hall sylP) logn_part. - rewrite -(sdprod_card defU) oA0 lognM // ?prime_gt0 // logn_prime // eqxx. - by rewrite ltnS logn_gt0. - have defM0: Ms ><| U0 = Ms <*> U0 := sdprod_subr defMsU (subsetIr _ _). - have frobM0: [Frobenius Ms <*> U0 = Ms ><| U0]. - apply/Frobenius_semiregularP=> // [|e /setD1P[nte /setIP[E0e Ue]]]. - by rewrite -rank_gt0 (leq_trans _ (p_rank_le_rank p _)) ?p_rank_gt0. - have [ | ] := boolP (p13.-elt e); first by apply: regU13; rewrite !inE nte. - apply: contraNeq => /trivgPn[x /setIP[Ms_x cex] ntx]. - apply/pgroupP=> q q_pr q_dv_x; rewrite inE /= (regE0 x) ?inE ?ntx //. - rewrite mem_primes q_pr cardG_gt0 (dvdn_trans q_dv_x) ?order_dvdG //. - by rewrite inE E0e cent1C. - have [nsA0U sU0U _ _ _] := sdprod_context defU. - split; [exists A0 | exists U0]. - split=> // [|x Ms_x]; first by rewrite (abelianS (subsetIl A _) cAA). - rewrite -(sdprodW defU) -group_modl ?(Frobenius_reg_compl frobM0) ?mulg1 //. - by rewrite subIset //= orbC -cent_set1 centS // sub1set; case/setD1P: Ms_x. - split=> //; apply/eqP; rewrite eqn_dvd exponentS //=. - rewrite -(partnC p (exponent_gt0 U0)) -(partnC p (exponent_gt0 U)). - apply: dvdn_mul; last first. - rewrite (partn_exponentS sU0U) // -(sdprod_card defU) partnM ?cardG_gt0 //. - by rewrite part_p'nat ?pnatNK // mul1n dvdn_part. - have cPP: abelian P. - have [/(_ P)[] //] := tau2_context maxM t2p Ep2A_M. - by apply: subHall_Sylow hallE _ sylP_E; case/andP: t2p. - have defP: A0 \x (U0 :&: P) = P. - rewrite dprodEsd ?(sub_abelian_cent2 cPP) ?subsetIr //. - by rewrite (sdprod_modl defU) // (setIidPr sPU). - have sylP_U0: p.-Sylow(U0) (U0 :&: P). - rewrite pHallE subsetIl /= -(eqn_pmul2l (cardG_gt0 A0)). - rewrite (dprod_card defP) (card_Hall sylP) -(sdprod_card defU). - by rewrite partnM // part_pnat_id. - rewrite -(exponent_Hall sylP) -(dprod_exponent defP) (exponent_Hall sylP_U0). - rewrite dvdn_lcm (dvdn_trans (exponent_dvdn A0)) //= oA0. - apply: contraLR piU0p; rewrite -p'natE // -partn_eq1 // partn_part //. - by rewrite partn_eq1 ?exponent_gt0 // pnat_exponent -p'groupEpi. -have{t2p Ep2A sylS sAS cSS} [[nsE2E cE2E2] hallE2_G _ _] - := abelian_tau2 maxM complEi t2p Ep2A sylS sAS cSS. -clear p p_pr rU2 piU2p A S Ep2A_M sAE pA cAA. -have nsU2U: U2 <| U by rewrite (normalS sU2U sUE) ?normalI. -have cU2U2: abelian U2 := abelianS (subsetIl _ _) cE2E2. -split. - exists U2; rewrite -set1gE; split=> // x /setDP[Ms_x ntx]. - rewrite (sub_normal_Hall hallU2) ?subsetIl //=. - apply: sub_in_pnat (pgroup_pi _) => q /(piSg (subsetIl U _))/(piSg sUE). - rewrite (partition_pi_sigma_compl maxM) // orbCA => /orP[] // t13q. - rewrite mem_primes => /and3P[q_pr _ /Cauchy[] // y /setIP[Uy cxy] oy]. - case/negP: ntx; rewrite -(regU13 y); first by rewrite inE Ms_x cent1C. - by rewrite !inE -order_gt1 oy prime_gt1. - by rewrite /p_elt oy pnatE. -pose sylU2 S := (S :!=: 1) && Sylow U2 S. -pose cyclicRegular Z S := - [/\ Z <| U, cyclic Z, 'C_Ms('Ohm_1(Z)) = 1 & exponent Z = exponent S]. -suffices /fin_all_exists[Z_ Z_P] S: exists Z, sylU2 S -> cyclicRegular Z S. - pose Z2 := <<\bigcup_(S | sylU2 S) Z_ S>>. - have sZU2: Z2 \subset U2. - rewrite gen_subG; apply/bigcupsP=> S sylS. - have [[/andP[sZE _] _ _ eq_expZS] [_ _ sSU2 _]] := (Z_P S sylS, and4P sylS). - rewrite (sub_normal_Hall hallU2) // -pnat_exponent eq_expZS. - by rewrite pnat_exponent (pgroupS sSU2 t2U2). - have nZ2U: U \subset 'N(Z2). - by rewrite norms_gen ?norms_bigcup //; apply/bigcapsP => S /Z_P[/andP[]]. - have solU: solvable U := solvableS sUE (sigma_compl_sol hallE). - have [U31 hallU31] := Hall_exists \tau2(M)^' solU. - have [[sU31U t2'U31 _] t2Z2] := (and3P hallU31, pgroupS sZU2 t2U2). - pose U0 := (Z2 <*> U31)%G; have /joing_sub[sZ2U0 sU310] := erefl (gval U0). - have sU0U: U0 \subset U by rewrite join_subG (subset_trans sZU2). - have nsZ2U0: Z2 <| U0 by rewrite /normal sZ2U0 (subset_trans sU0U). - have defU0: Z2 * U31 = U0 by rewrite -norm_joinEr // (subset_trans sU31U). - have [hallZ2 hallU31_0] := coprime_mulpG_Hall defU0 t2Z2 t2'U31. - have expU0U: exponent U0 = exponent U. - have exp_t2c U' := partnC \tau2(M) (exponent_gt0 U'). - rewrite -(exp_t2c U) -(exponent_Hall hallU31) -(exponent_Hall hallU2). - rewrite -{}exp_t2c -(exponent_Hall hallU31_0) -(exponent_Hall hallZ2). - congr (_ * _)%N; apply/eqP; rewrite eqn_dvd exponentS //=. - apply/dvdn_partP=> [|p]; first exact: exponent_gt0. - have [S sylS] := Sylow_exists p U2; rewrite -(exponent_Hall sylS). - rewrite pi_of_exponent -p_rank_gt0 -(rank_Sylow sylS) rank_gt0 => ntS. - have{sylS} sylS: sylU2 S by rewrite /sylU2 ntS (p_Sylow sylS). - by have /Z_P[_ _ _ <-] := sylS; rewrite exponentS ?sub_gen ?(bigcup_max S). - exists U0; split=> //. - have ntU0: U0 :!=: 1 by rewrite trivg_exponent expU0U -trivg_exponent. - apply/Frobenius_semiregularP=> //; first by rewrite (sdprod_subr defMsU). - apply: semiregular_sym => x /setD1P[ntx Ms_x]; apply: contraNeq ntx. - rewrite -rank_gt0; have [p p_pr ->] := rank_witness [group of 'C_U0[x]]. - rewrite -in_set1 -set1gE p_rank_gt0 => piCp. - have [e /setIP[U0e cxe] oe]: {e | e \in 'C_U0[x] & #[e] = p}. - by move: piCp; rewrite mem_primes p_pr cardG_gt0; apply: Cauchy. - have nte: e != 1 by rewrite -order_gt1 oe prime_gt1. - have{piCp} piUp: p \in \pi(U). - by rewrite -pi_of_exponent -expU0U pi_of_exponent (piSg _ piCp) ?subsetIl. - have:= piSg sUE piUp; rewrite (partition_pi_sigma_compl maxM) // orbCA orbC. - case/orP=> [t13p | t2p]. - rewrite -(regU13 e) 1?inE ?Ms_x 1?cent1C //. - by rewrite inE nte (subsetP sU0U). - by rewrite /p_elt oe pnatE. - have Z2e: e \in Z2 by rewrite (mem_normal_Hall hallZ2) // /p_elt oe pnatE. - have [S sylS] := Sylow_exists p U2; have [sSU2 pS _] := and3P sylS. - have sylS_U: p.-Sylow(U) S := subHall_Sylow hallU2 t2p sylS. - have ntS: S :!=: 1 by rewrite -rank_gt0 (rank_Sylow sylS_U) p_rank_gt0. - have sylS_U2: sylU2 S by rewrite /sylU2 ntS (p_Sylow sylS). - have [nsZU cycZ regZ1 eqexpZS] := Z_P S sylS_U2. - suffices defZ1: 'Ohm_1(Z_ S) == <[e]>. - by rewrite -regZ1 (eqP defZ1) cent_cycle inE Ms_x cent1C. - have pZ: p.-group (Z_ S) by rewrite -pnat_exponent eqexpZS pnat_exponent. - have sylZ: p.-Sylow(Z2) (Z_ S). - have:= sZU2; rewrite pHallE /Z2 /= -bigprodGE (bigD1 S) //=. - set Z2' := (\prod_(T | _) _)%G => /joing_subP[sZ_U2 sZ2'_U2]. - rewrite joing_subl cent_joinEl ?(sub_abelian_cent2 cU2U2) //=. - suffices p'Z2': p^'.-group Z2'. - rewrite coprime_cardMg ?(pnat_coprime pZ) //. - by rewrite partnM // part_pnat_id // part_p'nat // muln1. - elim/big_ind: Z2' sZ2'_U2 => [_||T /andP[sylT neqTS]]; first exact: pgroup1. - move=> X Y IHX IHY /joing_subP[sXU2 sYU2] /=. - by rewrite cent_joinEl ?(sub_abelian_cent2 cU2U2) // pgroupM IHX ?IHY. - have /Z_P[_ _ _ expYT _] := sylT. - have{sylT} [_ /SylowP[q _ sylT]] := andP sylT. - rewrite -pnat_exponent expYT pnat_exponent. - apply: (pi_pnat (pHall_pgroup sylT)); apply: contraNneq neqTS => eq_qp. - have defOE2 := nilpotent_Hall_pcore (abelian_nil cU2U2). - by rewrite -val_eqE /= (defOE2 _ _ sylS) (defOE2 _ _ sylT) eq_qp. - have nZZ2 := normalS (pHall_sub sylZ) (subset_trans sZU2 sU2U) nsZU. - have Ze: e \in Z_ S by rewrite (mem_normal_Hall sylZ) // /p_elt oe pnat_id. - rewrite (eq_subG_cyclic cycZ) ?Ohm_sub ?cycle_subG // -orderE oe. - by rewrite (Ohm1_cyclic_pgroup_prime _ pZ) //; apply/trivgPn; exists e. -case: (sylU2 S) / andP => [[ntS /SylowP[p p_pr sylS_U2]]|]; last by exists E. -have [sSU2 pS _] := and3P sylS_U2; have [sSE2 sSU] := subsetIP sSU2. -have piSp: p \in \pi(S) by rewrite -p_rank_gt0 -rank_pgroup ?rank_gt0. -have t2p: p \in \tau2(M) := pnatPpi t2U2 (piSg sSU2 piSp). -have sylS_U: p.-Sylow(U) S := subHall_Sylow hallU2 t2p sylS_U2. -have sylS_E: p.-Sylow(E) S := subHall_Sylow hallU (piSg sSU piSp) sylS_U. -have sylS: p.-Sylow(E2) S := pHall_subl sSE2 sE2E sylS_E. -have sylS_G: p.-Sylow(G) S := subHall_Sylow hallE2_G t2p sylS. -have [cSS [/= s'p rpM]] := (abelianS sSU2 cU2U2, andP t2p). -have sylS_M: p.-Sylow(M) S := subHall_Sylow hallE s'p sylS_E. -have rpS: 'r_p(S) = 2 by apply/eqP; rewrite (p_rank_Sylow sylS_M). -have [A] := p_rank_witness p S; rewrite rpS -(setIidPr (pHall_sub sylS_E)). -rewrite pnElemI setIC 2!inE => /andP[sAS Ep2A]. -have [[nsAE defEp] _ nregEp_uniq _] := tau2_compl_context maxM hallE t2p Ep2A. -have [_ sNS'FE _ sCSE _] - := abelian_tau2_sub_Fitting maxM hallE t2p Ep2A sylS_G sAS cSS. -have [_ _ [defNS _ _ _] regE1subZ] - := abelian_tau2 maxM complEi t2p Ep2A sylS_G sAS cSS. -have nSE: E \subset 'N(S) by rewrite -defNS normal_norm. -have [sSE nSU] := (subset_trans sSE2 sE2E, subset_trans sUE nSE). -have n_subNS := abelian_tau2_norm_Sylow maxM hallE t2p Ep2A sylS_G sAS cSS. -have not_sNS_M: ~~ ('N(S) \subset M). - by apply: contra s'p => sNS_M; apply/exists_inP; exists S; rewrite // inE. -have regNNS Z (Z1 := 'Ohm_1(Z)%G): - Z \subset S -> cyclic Z -> Z :!=: 1 -> 'N(S) \subset 'N(Z1) -> 'C_Ms(Z1) = 1. -- move=> sZS cycZ ntZ nZ1_NS; apply: contraNeq not_sNS_M => nregZ1. - have sZ1S: Z1 \subset S by apply: gFsub_trans. - have EpZ1: Z1 \in 'E_p^1(E). - rewrite p1ElemE // !inE (subset_trans sZ1S) //=. - by rewrite (Ohm1_cyclic_pgroup_prime _ (pgroupS sZS pS)). - have /= uCZ1 := nregEp_uniq _ EpZ1 nregZ1. - apply: (subset_trans nZ1_NS); apply: (sub_uniq_mmax uCZ1 (cent_sub _)). - by rewrite mFT_norm_proper ?(mFT_pgroup_proper (pgroupS sZ1S pS)) ?Ohm1_eq1. -have [_ nsCEA t1CEAb] := tau1_cent_tau2Elem_factor maxM hallE t2p Ep2A. -have [cSU | not_cSU] := boolP (U \subset 'C(S)). - pose n := logn p (exponent S); pose Sn := 'Mho^n.-1(S)%G. - have n_gt0: 0 < n by rewrite -pi_of_exponent -logn_gt0 in piSp. - have expS: (exponent S = p ^ n.-1 * p)%N. - rewrite -expnSr prednK -?p_part //. - by rewrite part_pnat_id ?pnat_exponent ?expg_exponent. - have sSnS1: Sn \subset 'Ohm_1(S). - rewrite (OhmE 1 pS) /= (MhoE _ pS); apply/genS/subsetP=> _ /imsetP[x Sx ->]. - by rewrite !inE groupX //= -expgM -expS expg_exponent. - have sSZ: S \subset 'Z(U) by rewrite subsetI sSU centsC. - have{sSZ} nsZU z: z \in S -> <[z]> <| U. - by move=> Sz; rewrite sub_center_normal ?cycle_subG ?(subsetP sSZ). - have [homoS | ltSnS1] := eqVproper sSnS1. - have Ep2A_M := subsetP (pnElemS p 2 sEM) A Ep2A. - have [_ _ _ _ [A1 EpA1 regA1]] := tau2_context maxM t2p Ep2A_M. - have [sA1A _ oA1] := pnElemPcard EpA1. - have /cyclicP[zn defA1]: cyclic A1 by rewrite prime_cyclic ?oA1. - have [z Sz def_zn]: exists2 z, z \in S & zn = z ^+ (p ^ n.-1). - apply/imsetP; rewrite -(MhoEabelian _ pS cSS) homoS (OhmE 1 pS). - rewrite mem_gen // !inE -cycle_subG -defA1 (subset_trans sA1A) //=. - by rewrite -oA1 defA1 expg_order. - have oz: #[z] = exponent S. - by rewrite expS; apply: orderXpfactor; rewrite // -def_zn orderE -defA1. - exists <[z]>%G; split; rewrite ?cycle_cyclic ?exponent_cycle ?nsZU //. - by rewrite (Ohm_p_cycle _ (mem_p_elt pS Sz)) subn1 oz -def_zn -defA1. - have [z Sz /esym oz] := exponent_witness (abelian_nil cSS). - exists <[z]>%G; split; rewrite ?cycle_cyclic ?exponent_cycle ?nsZU //. - have ntz: <[z]> != 1 by rewrite trivg_card1 -orderE oz -dvdn1 -trivg_exponent. - rewrite regNNS ?cycle_cyclic ?cycle_subG //=. - suffices /eqP->: 'Ohm_1(<[z]>) == Sn by apply: char_norms; apply: gFchar. - have [p_z pS1] := (mem_p_elt pS Sz, pgroupS (Ohm_sub 1 S) pS). - rewrite eqEcard (Ohm1_cyclic_pgroup_prime _ p_z) ?cycle_cyclic //. - rewrite (Ohm_p_cycle _ p_z) oz -/n subn1 cycle_subG Mho_p_elt //=. - rewrite (card_pgroup (pgroupS sSnS1 pS1)) (leq_exp2l _ 1) ?prime_gt1 //. - by rewrite -ltnS -rpS p_rank_abelian ?properG_ltn_log. -have{not_cSU} [q q_pr piUq]: {q | prime q & q \in \pi(U / 'C(S))}. - have [q q_pr rCE] := rank_witness (U / 'C(S)); exists q => //. - by rewrite -p_rank_gt0 -rCE rank_gt0 -subG1 quotient_sub1 ?norms_cent. -have{piUq} [piCESbq piUq]: q \in \pi(E / 'C_E(S)) /\ q \in \pi(U). - rewrite /= setIC (card_isog (second_isog (norms_cent nSE))). - by rewrite (piSg _ piUq) ?quotientS // (pi_of_dvd _ _ piUq) ?dvdn_quotient. -have [Q1 sylQ1_U] := Sylow_exists q U; have [sQ1U qQ1 _] := and3P sylQ1_U. -have sylQ1: q.-Sylow(E) Q1 := subHall_Sylow hallU piUq sylQ1_U. -have sQ1E := subset_trans sQ1U sUE; have nSQ1 := subset_trans sQ1E nSE. -have [Q sylQ sQ1Q] := Sylow_superset nSQ1 qQ1; have [nSQ qQ _] := and3P sylQ. -have Ep2A_M := subsetP (pnElemS p 2 sEM) A Ep2A. -have ltCQ1_S: 'C_S(Q1) \proper S. - rewrite properE subsetIl /= subsetI subxx centsC -sQ1E -subsetI. - have nCES_Q1: Q1 \subset 'N('C_E(S)) by rewrite (setIidPr sCSE) norms_cent. - rewrite -quotient_sub1 // subG1 -rank_gt0. - by rewrite (rank_Sylow (quotient_pHall nCES_Q1 sylQ1)) p_rank_gt0. -have coSQ: coprime #|S| #|Q|. - suffices p'q: q != p by rewrite (pnat_coprime pS) // (pi_pnat qQ). - apply: contraNneq (proper_subn ltCQ1_S) => eq_qp; rewrite subsetI subxx. - rewrite (sub_abelian_cent2 cE2E2) // (sub_normal_Hall hallE2) //. - by rewrite (pi_pgroup qQ1) ?eq_qp. -have not_sQ1CEA: ~~ (Q1 \subset 'C_E(A)). - rewrite subsetI sQ1E; apply: contra (proper_subn ltCQ1_S) => /= cAQ1. - rewrite subsetIidl centsC coprime_abelian_faithful_Ohm1 ?(coprimegS sQ1Q) //. - by case: (tau2_context maxM t2p Ep2A_M); case/(_ S sylS_M)=> _ [|->] //. -have t1q: q \in \tau1(M). - rewrite (pnatPpi t1CEAb) // -p_rank_gt0. - have nCEA_Q1: Q1 \subset 'N('C_E(A)) := subset_trans sQ1E (normal_norm nsCEA). - rewrite -(rank_Sylow (quotient_pHall nCEA_Q1 sylQ1)) rank_gt0. - by rewrite -subG1 quotient_sub1. -have cycQ1: cyclic Q1. - have [x _ sQ1E1x] := Hall_psubJ hallE1 t1q sQ1E qQ1. - by rewrite (cyclicS sQ1E1x) ?cyclicJ. -have defQ1: Q :&: E = Q1. - apply: (sub_pHall sylQ1) (subsetIr Q E); last by rewrite subsetI sQ1Q. - by rewrite (pgroupS (subsetIl Q _)). -pose Q0 := 'C_Q(S); have nsQ0Q: Q0 <| Q by rewrite norm_normalI ?norms_cent. -have [sQ0Q nQ0Q] := andP nsQ0Q; have nQ01 := subset_trans sQ1Q nQ0Q. -have coSQ0: coprime #|S| #|Q0| := coprimegS sQ0Q coSQ. -have ltQ01: Q0 \proper Q1. - rewrite /proper -{1}defQ1 setIS //. - apply: contra (proper_subn ltCQ1_S) => sQ10. - by rewrite subsetIidl (centsS sQ10) // centsC subsetIr. -have [X]: exists2 X, X \in subgroups Q & ('C_S(X) != 1) && ([~: S, X] != 1). - apply/exists_inP; apply: contraFT (ltnn 1); rewrite negb_exists_in => irrS. - have [sQ01 not_sQ10] := andP ltQ01. - have qQb: q.-group (Q / Q0) by apply: quotient_pgroup. - have ntQ1b: Q1 / Q0 != 1 by rewrite -subG1 quotient_sub1. - have ntQb: Q / Q0 != 1 := subG1_contra (quotientS _ sQ1Q) ntQ1b. - have{irrS} regQ: semiregular (S / Q0) (Q / Q0). - move=> Q0x; rewrite 2!inE -cycle_subG -cycle_eq1 -cent_cycle andbC. - case/andP; case/(inv_quotientS nsQ0Q)=> X /= -> {Q0x} sQ0X sXQ ntXb. - have [nSX nQ0X] := (subset_trans sXQ nSQ, subset_trans sXQ nQ0Q). - rewrite -quotient_TI_subcent ?(coprime_TIg coSQ0) //. - apply: contraTeq (forallP irrS X) => ntCSXb; rewrite inE sXQ negbK. - apply/andP; split. - by apply: contraNneq ntCSXb => ->; rewrite quotient1. - apply: contraNneq ntXb; move/commG1P => cXS. - by rewrite quotientS1 // subsetI sXQ centsC. - have{regQ} cycQb: cyclic (Q / Q0). - have nSQb: Q / Q0 \subset 'N(S / Q0) by apply: quotient_norms. - apply: odd_regular_pgroup_cyclic qQb (mFT_quo_odd _ _) _ nSQb regQ. - rewrite -(isog_eq1 (quotient_isog _ _)) ?coprime_TIg 1?coprime_sym //. - by rewrite cents_norm // centsC subsetIr. - have rQ1: 'r(Q1) = 1%N. - apply/eqP; rewrite (rank_Sylow sylQ1). - by rewrite (tau1E maxM hallE) in t1q; case/and3P: t1q. - have: 'r(Q) <= 1; last apply: leq_trans. - have nQ0_Ohm1Q: 'Ohm_1(Q) \subset 'N(Q0) by apply: gFsub_trans. - rewrite -rQ1 -rank_Ohm1 rankS // -(quotientSGK _ sQ01) //. - rewrite (subset_trans (morphim_Ohm _ _ nQ0Q)) //= -quotientE -/Q0. - rewrite -(cardSg_cyclic cycQb) ?Ohm_sub ?quotientS //. - have [_ q_dv_Q1b _] := pgroup_pdiv (pgroupS (quotientS _ sQ1Q) qQb) ntQ1b. - by rewrite (Ohm1_cyclic_pgroup_prime cycQb qQb ntQb). - have ltNA_G: 'N(A) \proper G. - by rewrite defNS mFT_norm_proper // (mFT_pgroup_proper pS). - have [H maxNA_H] := mmax_exists ltNA_G. - have nCEA_Q1 := subset_trans sQ1E (normal_norm nsCEA). - have [_ _] := primes_norm_tau2Elem maxM hallE t2p Ep2A maxNA_H. - case/(_ q)=> [||t2Hq [S2 sylS2 nsS2H] _]. - - rewrite -p_rank_gt0 -(rank_Sylow (quotient_pHall _ sylQ1)) //. - by rewrite rank_gt0 -subG1 quotient_sub1. - - rewrite -p_rank_gt0 -rQ1 (rank_pgroup qQ1) -p_rank_Ohm1 p_rankS //. - have: 'Z(E) \subset 'C_E(A); last apply: subset_trans. - by rewrite setIS ?centS // normal_sub. - have [x Ex sQ1xE1] := Hall_pJsub hallE1 t1q sQ1E qQ1. - rewrite -(conjSg _ _ x) ['Z(E) :^ x](normsP _ x Ex) ?gFnorm //. - set Q11x := _ :^ x; have oQ11x: #|Q11x| = q. - by rewrite cardJg (Ohm1_cyclic_pgroup_prime _ qQ1) // -rank_gt0 rQ1. - apply: regE1subZ; rewrite /= -/Q11x. - apply/nElemP; exists q; rewrite p1ElemE // !inE oQ11x. - by rewrite (subset_trans _ sQ1xE1) //= conjSg Ohm_sub. - have /cyclicP[y defQ11x]: cyclic Q11x by rewrite prime_cyclic ?oQ11x. - rewrite defQ11x cent_cycle regU13 //. - rewrite !inE -order_gt1 -cycle_subG /order -defQ11x oQ11x prime_gt1 //. - by rewrite -(normsP (normal_norm nsUE) x Ex) conjSg gFsub_trans. - by rewrite /p_elt /order -defQ11x oQ11x pnatE //; apply/orP; left. - rewrite inE in sylS2; have [sS2H _]:= andP nsS2H. - have sylS2_H := pHall_subl sS2H (subsetT H) sylS2. - have [maxH sNS_H] := setIdP maxNA_H; rewrite /= defNS in sNS_H. - have sylS_H := pHall_subl (subset_trans (normG S) sNS_H) (subsetT H) sylS_G. - have defS2: S :=: S2 := uniq_normal_Hall sylS2_H nsS2H (Hall_max sylS_H). - have sylQ_H: q.-Sylow(H) Q by rewrite -(mmax_normal maxH nsS2H) -defS2. - by rewrite (rank_Sylow sylQ_H); case/andP: t2Hq => _ /eqP->. -rewrite inE => sXQ /=; have nSX := subset_trans sXQ nSQ. -set S1 := [~: S, X]; set S2 := 'C_S(X) => /andP[ntS2 ntS1]. -have defS12: S1 \x S2 = S. - by apply: coprime_abelian_cent_dprod; rewrite ?(coprimegS sXQ). -have /mulG_sub[sS1S sS2S] := dprodW defS12. -have [cycS1 cycS2]: cyclic S1 /\ cyclic S2. - apply/andP; rewrite !(abelian_rank1_cyclic (abelianS _ cSS)) //. - rewrite -(leqif_add (leqif_geq _) (leqif_geq _)) ?rank_gt0 // addn1 -rpS. - rewrite !(rank_pgroup (pgroupS _ pS)) ?(p_rank_abelian p (abelianS _ cSS)) //. - by rewrite -lognM ?cardG_gt0 // (dprod_card (Ohm_dprod 1 defS12)). -have [nsS2NS nsS1NS]: S2 <| 'N(S) /\ S1 <| 'N(S) := n_subNS X nSX. -pose Z := if #|S1| < #|S2| then [group of S2] else [group of S1]. -have [ntZ sZS nsZN cycZ]: [/\ Z :!=: 1, Z \subset S, Z <| 'N(S) & cyclic Z]. - by rewrite /Z; case: ifP. -have nsZU: Z <| U := normalS (subset_trans sZS sSU) nSU nsZN. -exists Z; split=> //=. - by rewrite regNNS // (char_norm_trans (Ohm_char 1 Z)) // normal_norm. -rewrite -(dprod_exponent defS12) /= (fun_if val) fun_if !exponent_cyclic //=. -rewrite (card_pgroup (pgroupS sS1S pS)) (card_pgroup (pgroupS sS2S pS)) //. -by rewrite /= -/S1 -/S2 ltn_exp2l ?prime_gt1 // -fun_if expn_max. -Qed. - -(* This is B & G, Theorem 12.13. *) -Theorem nonabelian_Uniqueness p P : p.-group P -> ~~ abelian P -> P \in 'U. -Proof. -move=> pP not_cPP; have [M maxP_M] := mmax_exists (mFT_pgroup_proper pP). -have sigma_p L: L \in 'M(P) -> p \in \sigma(L). - case/setIdP=> maxL sPL; apply: contraR not_cPP => sL'p. - exact: sigma'_nil_abelian maxL sPL (pi_pnat pP _) (pgroup_nil pP). -have{maxP_M} [[maxM sPM] sMp] := (setIdP maxP_M, sigma_p M maxP_M). -rewrite (uniq_mmax_subset1 maxM sPM); apply/subsetP=> H maxP_H; rewrite inE. -have{sigma_p maxP_H} [[maxH sPH] sHp] := (setIdP maxP_H, sigma_p H maxP_H). -without loss{pP sPH sPM} sylP: P not_cPP / p.-Sylow(M :&: H) P. - move=> IH; have sP_MH: P \subset M :&: H by rewrite subsetI sPM. - have [S sylS sPS] := Sylow_superset sP_MH pP. - exact: IH (contra (abelianS sPS) not_cPP) sylS. -have [sP_MH pP _] := and3P sylP; have [sPM sPH] := subsetIP sP_MH. -have ncycP := contra (@cyclic_abelian _ _) not_cPP. -have{sHp} sNMH: 'N(P) \subset M :&: H. - by rewrite subsetI !(@norm_noncyclic_sigma _ p). -have{sylP} sylP_M: p.-Sylow(M) P. - have [S sylS sPS] := Sylow_superset sPM pP; have pS := pHall_pgroup sylS. - have [-> // | ltPS] := eqVproper sPS. - have /andP[sNP] := nilpotent_proper_norm (pgroup_nil pS) ltPS. - rewrite (sub_pHall sylP _ sNP) ?subxx ?(pgroupS (subsetIl _ _)) //. - by rewrite subIset // orbC sNMH. -have{sMp} sylP_G: p.-Sylow(G) P := sigma_Sylow_G maxM sMp sylP_M. -have sylP_H: p.-Sylow(H) P := pHall_subl sPH (subsetT H) sylP_G. -have [rPgt2 | rPle2] := ltnP 2 'r(P). - have uniqP: P \in 'U by rewrite rank3_Uniqueness ?(mFT_pgroup_proper pP). - have defMP: 'M(P) = [set M] := def_uniq_mmax uniqP maxM sPM. - by rewrite -val_eqE /= (eq_uniq_mmax defMP maxH). -have rpP: 'r_p(P) = 2. - apply/eqP; rewrite eqn_leq -{1}rank_pgroup // rPle2 ltnNge. - by rewrite -odd_pgroup_rank1_cyclic ?mFT_odd. -have:= mFT_rank2_Sylow_cprod sylP_G rPle2 not_cPP. -case=> Q [not_cQQ dimQ eQ] [R cycR [defP defR1]]. -have sQP: Q \subset P by have /mulG_sub[] := cprodW defP. -have pQ: p.-group Q := pgroupS sQP pP. -have oQ: #|Q| = (p ^ 3)%N by rewrite (card_pgroup pQ) dimQ. -have esQ: extraspecial Q by apply: (p3group_extraspecial pQ); rewrite ?dimQ. -have p_pr := extraspecial_prime pQ esQ; have p_gt1 := prime_gt1 p_pr. -pose Z := 'Z(Q)%G; have oZ: #|Z| = p := card_center_extraspecial pQ esQ. -have nsZQ: Z <| Q := center_normal Q; have [sZQ nZQ] := andP nsZQ. -have [[defPhiQ defQ'] _]: ('Phi(Q) = Z /\ Q^`(1) = Z) /\ _ := esQ. -have defZ: 'Ohm_1 ('Z(P)) = Z. - have [_ <- _] := cprodP (center_cprod defP). - by rewrite (center_idP (cyclic_abelian cycR)) -defR1 mulSGid ?Ohm_sub. -have ncycQ: ~~ cyclic Q := contra (@cyclic_abelian _ Q) not_cQQ. -have rQgt1: 'r_p(Q) > 1. - by rewrite ltnNge -(odd_pgroup_rank1_cyclic pQ) ?mFT_odd. -have [A Ep2A]: exists A, A \in 'E_p^2(Q) by apply/p_rank_geP. -wlog uniqNEpA: M H maxM maxH sP_MH sNMH sPM sPH sylP_M sylP_H / - ~~ [exists A0 in 'E_p^1(A) :\ Z, 'M('N(A0)) == [set M]]. -- move=> IH; case: exists_inP (IH M H) => [[A0 EpA0 defMA0] _ | _ -> //]. - case: exists_inP {IH}(IH H M) => [[A1 EpA1 defMA1] _ | _]; last first. - by rewrite setIC eq_sym => ->. - have [sAQ abelA dimA] := pnElemP Ep2A; have sAP := subset_trans sAQ sQP. - have transNP: [transitive 'N_P(A), on 'E_p^1(A) :\ Z | 'JG]. - have [|_ _] := basic_p2maxElem_structure _ pP sAP not_cPP. - have Ep2A_G := subsetP (pnElemS p 2 (subsetT Q)) A Ep2A. - rewrite inE Ep2A_G (subsetP (p_rankElem_max p G)) //. - by rewrite -(p_rank_Sylow sylP_G) rpP. - by rewrite (group_inj defZ). - have [x NPx defA1] := atransP2 transNP EpA0 EpA1. - have Mx: x \in M by rewrite (subsetP sPM) //; case/setIP: NPx. - rewrite eq_sym -in_set1 -(group_inj (conjGid Mx)). - by rewrite -(eqP defMA1) defA1 /= normJ mmax_ofJ (eqP defMA0) set11. -apply: contraR uniqNEpA => neqHM; have sQM := subset_trans sQP sPM. -suffices{A Ep2A} [ntMa nonuniqNZ]: M`_\alpha != 1 /\ 'M('N(Z)) != [set M]. - have [A0 EpA0 defMNA0]: exists2 A0, A0 \in 'E_p^1(A) & 'M('N(A0)) == [set M]. - apply/exists_inP; apply: contraR ntMa; rewrite negb_exists_in => uniqNA1. - have{Ep2A} Ep2A: A \in 'E_p^2(M) := subsetP (pnElemS p 2 sQM) A Ep2A. - by have [_ [//|_ ->]] := p2Elem_mmax maxM Ep2A. - apply/exists_inP; exists A0; rewrite // 2!inE EpA0 andbT. - by apply: contraNneq nonuniqNZ => <-. -have coMaQ: coprime #|M`_\alpha| #|Q|. - apply: pnat_coprime (pcore_pgroup _ _) (pi_pnat pQ _). - by rewrite !inE -(p_rank_Sylow sylP_M) rpP. -have nMaQ: Q \subset 'N(M`_\alpha) by rewrite (subset_trans sQM) ?gFnorm. -have [coMaZ nMaZ] := (coprimegS sZQ coMaQ, subset_trans sZQ nMaQ). -pose K := 'N_(M`_\alpha)(Z). -have defKC: 'C_(M`_\alpha)(Z) = K by rewrite -coprime_norm_cent. -have coKQ: coprime #|K| #|Q| := coprimeSg (subsetIl _ _) coMaQ. -have nKQ: Q \subset 'N(K) by rewrite normsI ?norms_norm. -have [coKZ nKZ] := (coprimegS sZQ coKQ, subset_trans sZQ nKQ). -have sKH: K \subset H. - have sZH := subset_trans sZQ (subset_trans sQP sPH). - rewrite -(quotientSGK (subsetIr _ _) sZH) /= -/Z -/K. - have cQQb: abelian (Q / Z) by rewrite -defQ' sub_der1_abelian. - rewrite -(coprime_abelian_gen_cent cQQb) ?coprime_morph ?quotient_norms //. - rewrite gen_subG /= -/K -/Z; apply/bigcupsP=> Ab; rewrite andbC; case/andP. - case/(inv_quotientN nsZQ)=> A -> sZA nsAQ; have sAQ := normal_sub nsAQ. - rewrite (isog_cyclic (third_isog _ _ _)) // -/Z => cycQA. - have pA: p.-group A := pgroupS sAQ pQ. - have rAgt1: 'r_p(A) > 1. - have [-> // | ltAQ] := eqVproper sAQ. - rewrite ltnNge -(odd_pgroup_rank1_cyclic pA) ?mFT_odd //. - apply: contraL cycQA => cycA /=; have cAA := cyclic_abelian cycA. - suff <-: Z :=: A by rewrite -defPhiQ (contra (@Phi_quotient_cyclic _ Q)). - apply/eqP; rewrite eqEcard sZA /= oZ (card_pgroup pA) (leq_exp2l _ 1) //. - by rewrite -abelem_cyclic // /abelem pA cAA (dvdn_trans (exponentS sAQ)). - have [A1 EpA1] := p_rank_geP rAgt1. - rewrite -(setIidPr (subset_trans sAQ (subset_trans sQP sPH))) pnElemI in EpA1. - have{EpA1} [Ep2A1 sA1A]:= setIdP EpA1; rewrite inE in sA1A. - have [sCA1_H _]: 'C(A1) \subset H /\ _ := p2Elem_mmax maxH Ep2A1. - rewrite -quotient_TI_subcent ?(subset_trans sAQ) ?(coprime_TIg coKZ) //= -/K. - by rewrite quotientS // subIset // orbC (subset_trans (centS sA1A)). -have defM: M`_\alpha * (M :&: H) = M. - rewrite setIC in sNMH *. - have [defM eq_aM_bM] := nonuniq_norm_Sylow_pprod maxM maxH neqHM sylP_G sNMH. - by rewrite [M`_\alpha](eq_pcore M eq_aM_bM). -do [split; apply: contraNneq neqHM] => [Ma1 | uniqNZ]. - by rewrite -val_eqE /= (eq_mmax maxM maxH) // -defM Ma1 mul1g subsetIr. -have [_ sNZM]: _ /\ 'N(Z) \subset M := mem_uniq_mmax uniqNZ. -rewrite -val_eqE /= (eq_uniq_mmax uniqNZ maxH) //= -(setIidPr sNZM). -have sZ_MH: Z \subset M :&: H := subset_trans sZQ (subset_trans sQP sP_MH). -rewrite -(pprod_norm_coprime_prod defM) ?pcore_normal ?mmax_sol //. -by rewrite mulG_subG /= defKC sKH setIAC subsetIr. -Qed. - -(* This is B & G, Corollary 12.14. We have removed the redundant assumption *) -(* p \in \sigma(M), and restricted the quantification over P to the part of *) -(* the conclusion where it is mentioned. *) -(* Usage note: it might be more convenient to state that P is a Sylow *) -(* subgroup of M rather than M`_\sigma; check later use. *) -Corollary cent_der_sigma_uniq M p X (Ms := M`_\sigma) : - M \in 'M -> X \in 'E_p^1(M) -> (p \in \beta(M)) || (X \subset Ms^`(1)) -> - 'M('C(X)) = [set M] /\ (forall P, p.-Sylow(Ms) P -> 'M(P) = [set M]). -Proof. -move=> maxM EpX bMp_sXMs'; have p_pr := pnElem_prime EpX. -have [sXM abelX oX] := pnElemPcard EpX; have [pX _] := andP abelX. -have ntX: X :!=: 1 := nt_pnElem EpX isT; have ltCXG := mFT_cent_proper ntX. -have sMp: p \in \sigma(M). - have [bMp | sXMs'] := orP bMp_sXMs'; first by rewrite beta_sub_sigma. - rewrite -pnatE // -[p]oX; apply: pgroupS (subset_trans sXMs' (der_sub 1 _)) _. - exact: pcore_pgroup. -have hallMs: \sigma(M).-Hall(M) Ms by apply: Msigma_Hall. -have sXMs: X \subset Ms by rewrite (sub_Hall_pcore hallMs) // /pgroup oX pnatE. -have [P sylP sXP]:= Sylow_superset sXMs pX. -have sylP_M: p.-Sylow(M) P := subHall_Sylow hallMs sMp sylP. -have sylP_G := sigma_Sylow_G maxM sMp sylP_M. -have [sPM pP _] := and3P sylP_M; have ltPG := mFT_pgroup_proper pP. -suffices [-> uniqP]: 'M('C(X)) = [set M] /\ 'M(P) = [set M]. - split=> // Py sylPy; have [y Ms_y ->] := Sylow_trans sylP sylPy. - rewrite (def_uniq_mmaxJ _ uniqP) (group_inj (conjGid _)) //. - exact: subsetP (pcore_sub _ _) y Ms_y. -have [rCPXgt2 | rCPXle2] := ltnP 2 'r_p('C_P(X)). - have [sCPX_P sCPX_CX] := subsetIP (subxx 'C_P(X)). - have [ltP ltCX] := (mFT_pgroup_proper pP, mFT_cent_proper ntX). - have sCPX_M := subset_trans sCPX_P sPM. - have ltCPX_G := sub_proper_trans sCPX_P ltPG. - suff uniqCPX: 'M('C_P(X)) = [set M] by rewrite !(def_uniq_mmaxS _ _ uniqCPX). - apply: (def_uniq_mmax (rank3_Uniqueness _ _)) => //. - exact: leq_trans (p_rank_le_rank p _). -have nnP: p.-narrow P. - apply: wlog_neg; rewrite negb_imply; case/andP=> rP _. - by apply/narrow_centP; rewrite ?mFT_odd //; exists X. -have{bMp_sXMs'} [bM'p sXMs']: p \notin \beta(M) /\ X \subset Ms^`(1). - move: bMp_sXMs'; rewrite !inE -negb_exists_in. - by case: exists_inP => // [[]]; exists P. -have defMs: 'O_p^'(Ms) ><| P = Ms. - by have [_ hallMp' _] := beta_max_pdiv maxM bM'p; apply/sdprod_Hall_p'coreP. -have{defMs} sXP': X \subset P^`(1). - have{defMs} [_ defMs nMp'P tiMp'P] := sdprodP defMs. - have [injMp'P imMp'P] := isomP (quotient_isom nMp'P tiMp'P). - rewrite -(injmSK injMp'P) // morphim_der // {injMp'P}imMp'P morphim_restrm. - rewrite (setIidPr sXP) /= -quotientMidl defMs -quotient_der ?quotientS //. - by rewrite -defMs mul_subG ?normG. -have [rPgt2 | rPle2] := ltnP 2 'r_p(P). - case/eqP: ntX; rewrite -(setIidPl sXP'). - by case/(narrow_cent_dprod pP (mFT_odd P)): rCPXle2. -have not_cPP: ~~ abelian P. - by rewrite (sameP derG1P eqP) (subG1_contra sXP') ?ntX. -have sXZ: X \subset 'Z(P). - rewrite -rank_pgroup // in rPle2. - have := mFT_rank2_Sylow_cprod sylP_G rPle2 not_cPP. - case=> Q [not_cQQ dimQ _] [R]; move/cyclic_abelian=> cRR [defP _]. - have [_ mulQR _] := cprodP defP; have [sQP _] := mulG_sub mulQR. - rewrite (subset_trans sXP') // -(der_cprod 1 defP) (derG1P cRR) cprodg1. - have{dimQ} dimQ: logn p #|Q| <= 3 by rewrite dimQ. - have [[_ ->] _] := p3group_extraspecial (pgroupS sQP pP) not_cQQ dimQ. - by case/cprodP: (center_cprod defP) => _ <- _; apply: mulG_subl. -have uniqP: 'M(P) = [set M]. - exact: def_uniq_mmax (nonabelian_Uniqueness pP not_cPP) maxM sPM. -rewrite (def_uniq_mmaxS _ ltCXG uniqP) //. -by rewrite centsC (subset_trans sXZ) // subsetIr. -Qed. - -(* This is B & G, Proposition 12.15. *) -Proposition sigma_subgroup_embedding M q X Mstar : - M \in 'M -> q \in \sigma(M) -> X \subset M -> q.-group X -> X :!=: 1 -> - Mstar \in 'M('N(X)) :\ M -> - [/\ (*a*) gval Mstar \notin M :^: G, - forall S, q.-Sylow(M :&: Mstar) S -> X \subset S -> - (*b*) 'N(S) \subset M - /\ (*c*) q.-Sylow(Mstar) S - & if q \in \sigma(Mstar) - (*d*) then - [/\ (*1*) Mstar`_\beta * (M :&: Mstar) = Mstar, - (*2*) {subset \tau1(Mstar) <= [predU \tau1(M) & \alpha(M)]} - & (*3*) M`_\beta = M`_\alpha /\ M`_\alpha != 1] - (*e*) else - [/\ (*1*) q \in \tau2(Mstar), - (*2*) {subset [predI \pi(M) & \sigma(Mstar)] <= \beta(Mstar)} - & (*3*) \sigma(Mstar)^'.-Hall(Mstar) (M :&: Mstar)]]. -Proof. -move: Mstar => H maxM sMq sXM qX ntX /setD1P[neqHM maxNX_H]. -have [q_pr _ _] := pgroup_pdiv qX ntX; have [maxH sNX_H] := setIdP maxNX_H. -have sXH := subset_trans (normG X) sNX_H. -have sX_MH: X \subset M :&: H by apply/subsetIP. -have parts_bc S: - q.-Sylow(M :&: H) S -> X \subset S -> 'N(S) \subset M /\ q.-Sylow(H) S. -- move=> sylS sXS; have [sS_MH qS _] := and3P sylS. - have [sSM sSH] := subsetIP sS_MH. - have sNS_M: 'N(S) \subset M. - have [cycS|] := boolP (cyclic S); last exact: norm_noncyclic_sigma qS _. - have [T sylT sST] := Sylow_superset sSM qS; have [sTM qT _] := and3P sylT. - rewrite -(nilpotent_sub_norm (pgroup_nil qT) sST). - exact: norm_sigma_Sylow sylT. - rewrite (sub_pHall sylS (pgroupS (subsetIl T _) qT)) //. - by rewrite subsetI sST normG. - by rewrite setISS // (subset_trans (char_norms _) sNX_H) // sub_cyclic_char. - split=> //; have [T sylT sST] := Sylow_superset sSH qS. - have [sTH qT _] := and3P sylT. - rewrite -(nilpotent_sub_norm (pgroup_nil qT) sST) //. - rewrite (sub_pHall sylS (pgroupS (subsetIl T _) qT)) //=. - by rewrite subsetI sST normG. - by rewrite /= setIC setISS. -have [S sylS sXS] := Sylow_superset sX_MH qX; have [sS_MH qS _] := and3P sylS. -have [sSM sSH] := subsetIP sS_MH; have [sNS_M sylS_H] := parts_bc S sylS sXS. -have notMGH: gval H \notin M :^: G. - by apply: mmax_norm_notJ maxM maxH qX sXM sNX_H _; rewrite sMq eq_sym neqHM. -have /orP[sHq | t2Hq] := prime_class_mmax_norm maxH qX sNX_H; last first. - have [/= sH'q rqH] := andP t2Hq; rewrite [q \in _](negPf sH'q); split=> //. - have [A Eq2A] := p_rank_witness q S; have [sAS abelA dimA] := pnElemP Eq2A. - rewrite (p_rank_Sylow sylS_H) (eqP rqH) in dimA; have [qA _] := andP abelA. - have [sAH sAM] := (subset_trans sAS sSH, subset_trans sAS sSM). - have [F hallF sAF] := Hall_superset (mmax_sol maxH) sAH (pi_pnat qA sH'q). - have tiHsM: H`_\sigma :&: M = 1. - have{Eq2A} Eq2A: A \in 'E_q^2(H) by apply/pnElemP. - have [_ _ _ -> //] := tau2_context maxH t2Hq Eq2A. - by rewrite 3!inE eq_sym neqHM maxM. - have{Eq2A} Eq2A_F: A \in 'E_q^2(F) by apply/pnElemP. - have [[nsAF _] [sCA_F _ _] _ TIsH] - := tau2_compl_context maxH hallF t2Hq Eq2A_F. - have sNA_M: 'N(A) \subset M. - apply: norm_noncyclic_sigma maxM sMq qA sAM _. - by rewrite (abelem_cyclic abelA) dimA. - have ->: M :&: H = F. - have [[_ <- _ _] [_ nAF]] := (sdprodP (sdprod_sigma maxH hallF), andP nsAF). - by rewrite -(group_modr _ (subset_trans nAF sNA_M)) setIC tiHsM mul1g. - split=> // p /andP[/= piMp sHp]; apply: wlog_neg => bH'p. - have bM'q: q \notin \beta(M). - by rewrite -predI_sigma_beta // inE /= sMq; case/tau2_not_beta: t2Hq. - have sM'p: p \notin \sigma(M). - rewrite orbit_sym in notMGH; have [_ TIsHM] := TIsH M maxM notMGH. - by have:= TIsHM p; rewrite inE /= sHp /= => ->. - have p'CA: p^'.-group 'C(A). - by rewrite (pgroupS sCA_F) // (pi'_p'group (pHall_pgroup hallF)). - have p_pr: prime p by rewrite mem_primes in piMp; case/andP: piMp. - have [lt_pq | lt_qp | eq_pq] := ltngtP p q; last 1 first. - - by rewrite eq_pq sMq in sM'p. - - have bH'q: q \notin \beta(H) by apply: contra sH'q; apply: beta_sub_sigma. - have [|[P sylP cPA] _ _] := beta'_cent_Sylow maxH bH'p bH'q qA. - by rewrite lt_pq sAH orbT. - have sylP_H := subHall_Sylow (Msigma_Hall maxH) sHp sylP. - have piPp: p \in \pi(P). - by rewrite -p_rank_gt0 (p_rank_Sylow sylP_H) p_rank_gt0 sigma_sub_pi. - by rewrite centsC in cPA; case/eqnP: (pnatPpi (pgroupS cPA p'CA) piPp). - have bM'p: p \notin \beta(M) by apply: contra sM'p; apply: beta_sub_sigma. - have [P sylP] := Sylow_exists p M; have [sMP pP _] := and3P sylP. - have [|[Q1 sylQ1 cQ1P] _ _] := beta'_cent_Sylow maxM bM'q bM'p pP. - by rewrite lt_qp sMP orbT. - have sylQ1_M := subHall_Sylow (Msigma_Hall maxM) sMq sylQ1. - have [x Mx sAQ1x] := Sylow_subJ sylQ1_M sAM qA. - have sPxCA: P :^ x \subset 'C(A) by rewrite (centsS sAQ1x) // centJ conjSg. - have piPx_p: p \in \pi(P :^ x). - by rewrite /= cardJg -p_rank_gt0 (p_rank_Sylow sylP) p_rank_gt0. - by case/eqnP: (pnatPpi (pgroupS sPxCA p'CA) piPx_p). -rewrite sHq; split=> //. -have sNS_HM: 'N(S) \subset H :&: M by rewrite subsetI (norm_sigma_Sylow sHq). -have sylS_G: q.-Sylow(G) S := sigma_Sylow_G maxH sHq sylS_H. -have [defM eq_abM] := nonuniq_norm_Sylow_pprod maxM maxH neqHM sylS_G sNS_HM. -rewrite setIC eq_sym in sNS_HM neqHM defM. -have [defH eq_abH] := nonuniq_norm_Sylow_pprod maxH maxM neqHM sylS_G sNS_HM. -rewrite [M`_\alpha](eq_pcore M eq_abM) -/M`_\beta. -split=> // [r t1Hr|]; last first. - split=> //; apply: contraNneq neqHM => Mb1. - by rewrite -val_eqE /= (eq_mmax maxM maxH) // -defM Mb1 mul1g subsetIr. -have [R sylR] := Sylow_exists r (M :&: H); have [sR_MH rR _] := and3P sylR. -have [sRM sRH] := subsetIP sR_MH; have [sH'r rrH not_rH'] := and3P t1Hr. -have bH'r: r \notin \beta(H). - by apply: contra sH'r; rewrite -eq_abH; apply: alpha_sub_sigma. -have sylR_H: r.-Sylow(H) R. - rewrite pHallE sRH -defH -LagrangeMr partnM ?cardG_gt0 //. - rewrite -(card_Hall sylR) part_p'nat ?mul1n ?(pnat_dvd (dvdn_indexg _ _)) //=. - by rewrite (pi_p'nat (pcore_pgroup _ _)). -rewrite inE /= orbC -implyNb eq_abM; apply/implyP=> bM'r. -have sylR_M: r.-Sylow(M) R. - rewrite pHallE sRM -defM -LagrangeMr partnM ?cardG_gt0 //. - rewrite -(card_Hall sylR) part_p'nat ?mul1n ?(pnat_dvd (dvdn_indexg _ _)) //=. - by rewrite (pi_p'nat (pcore_pgroup _ _)). -have rrR: 'r_r(R) = 1%N by rewrite (p_rank_Sylow sylR_H) (eqP rrH). -have piRr: r \in \pi(R) by rewrite -p_rank_gt0 rrR. -suffices not_piM'r: r \notin \pi(M^`(1)). - rewrite inE /= -(p_rank_Sylow sylR_M) rrR /= -negb_or /=. - apply: contra not_piM'r; case/orP=> [sMr | rM']. - have sRMs: R \subset M`_\sigma. - by rewrite (sub_Hall_pcore (Msigma_Hall maxM)) ?(pi_pgroup rR). - by rewrite (piSg (Msigma_der1 maxM)) // (piSg sRMs). - by move: piRr; rewrite !mem_primes !cardG_gt0; case/andP=> ->. -have coMbR: coprime #|M`_\beta| #|R|. - exact: pnat_coprime (pcore_pgroup _ _) (pi_pnat rR _). -have sylRM': r.-Sylow(M^`(1)) _ := Hall_setI_normal (der_normal 1 M) sylR_M. -rewrite -p'groupEpi -partG_eq1 -(card_Hall sylRM') -trivg_card1 /=. -rewrite (pprod_focal_coprime defM (pcore_normal _ _)) //. -rewrite coprime_TIg ?(pnat_coprime rR (pgroupS (dergS 1 (subsetIr _ _)) _)) //. -by rewrite p'groupEpi mem_primes (negPf not_rH') !andbF. -Qed. - -(* This is B & G, Corollary 12.16. *) -Corollary sigma_Jsub M Y : - M \in 'M -> \sigma(M).-group Y -> Y :!=: 1 -> - [/\ exists x, Y :^ x \subset M`_\sigma - & forall E p H, - \sigma(M)^'.-Hall(M) E -> p \in \pi(E) -> p \notin \beta(G) -> - H \in 'M(Y) -> gval H \notin M :^: G -> - [/\ (*a*) 'r_p('N_H(Y)) <= 1 - & (*b*) p \in \tau1(M) -> p \notin \pi(('N_H(Y))^`(1))]]. -Proof. -move=> maxM sM_Y ntY. -have ltYG: Y \proper G. - have ltMsG: M`_\sigma \proper G. - exact: sub_proper_trans (pcore_sub _ _) (mmax_proper maxM). - rewrite properEcard subsetT (leq_ltn_trans _ (proper_card ltMsG)) //. - rewrite dvdn_leq ?cardG_gt0 // (card_Hall (Msigma_Hall_G maxM)). - by rewrite -(part_pnat_id sM_Y) partn_dvd // cardSg ?subsetT. -have [q q_pr rFY] := rank_witness 'F(Y). -have [X [ntX qX charX]]: exists X, [/\ gval X :!=: 1, q.-group X & X \char Y]. - exists ('O_q(Y))%G; rewrite pcore_pgroup pcore_char //. - rewrite -rank_gt0 /= -p_core_Fitting. - rewrite (rank_Sylow (nilpotent_pcore_Hall q (Fitting_nil Y))) -rFY. - by rewrite rank_gt0 (trivg_Fitting (mFT_sol ltYG)). -have sXY: X \subset Y := char_sub charX. -have sMq: q \in \sigma(M). - apply: (pnatPpi (pgroupS sXY sM_Y)). - by rewrite -p_rank_gt0 -(rank_pgroup qX) rank_gt0. -without loss sXMs: M maxM sM_Y sMq / X \subset M`_\sigma. - move=> IH; have [Q sylQ] := Sylow_exists q M`_\sigma. - have sQMs := pHall_sub sylQ. - have sylQ_G := subHall_Sylow (Msigma_Hall_G maxM) sMq sylQ. - have [x Gx sXQx] := Sylow_subJ sylQ_G (subsetT X) qX. - have: X \subset M`_\sigma :^ x by rewrite (subset_trans sXQx) ?conjSg. - rewrite -MsigmaJ => /IH; rewrite sigmaJ mmaxJ (eq_pgroup _ (sigmaJ _ _)). - case=> // [[y sYyMx] parts_ab]. - split=> [|E p H hallE piEp bG'p maxY_H notMGH]. - by exists (y * x^-1); rewrite conjsgM sub_conjgV -MsigmaJ. - have:= parts_ab (E :^ x)%G p H; rewrite tau1J /= cardJg pHallJ2. - rewrite (eq_pHall _ _ (eq_negn (sigmaJ _ _))). - by rewrite 2!orbit_sym (orbit_eqP (mem_orbit _ _ _)) //; apply. -have pre_part_a E p H: - \sigma(M)^'.-Hall(M) E -> p \in \pi(E) -> - H \in 'M(Y) -> gval H \notin M :^: G -> 'r_p(H :&: M) <= 1. -- move=> hallE piEp /setIdP[maxH sYH] notMGH; rewrite leqNgt. - apply: contra ntX => /p_rank_geP[A /pnElemP[/subsetIP[sAH sAM] abelA dimA]]. - have{abelA dimA} Ep2A: A \in 'E_p^2(M) by apply/pnElemP. - have rpMgt1: 'r_p(M) > 1 by apply/p_rank_geP; exists A. - have t2Mp: p \in \tau2(M). - move: piEp; rewrite (partition_pi_sigma_compl maxM hallE) orbCA orbC. - by rewrite -2!andb_orr orNb eqn_leq leqNgt rpMgt1 !andbF. - have sM'p := pnatPpi (pHall_pgroup hallE) piEp. - have [_ _ _ tiMsH _] := tau2_context maxM t2Mp Ep2A. - rewrite -subG1 -(tiMsH H); first by rewrite subsetI sXMs (subset_trans sXY). - by rewrite 3!inE maxH (contra_orbit _ _ notMGH). -have [sNX_M | not_sNX_M] := boolP ('N(X) \subset M). - have sNY_M: 'N(Y) \subset M := subset_trans (char_norms charX) sNX_M. - split=> [|E p H hallE piEp bG'p maxY_H notMGH]; last split. - - exists 1; rewrite act1 (sub_Hall_pcore (Msigma_Hall maxM)) //. - exact: subset_trans (normG Y) sNY_M. - - rewrite (leq_trans (p_rankS p (setIS H sNY_M))) ?(pre_part_a E) //. - case/and3P=> _ _; apply: contra; rewrite mem_primes => /and3P[_ _ pM']. - by apply: dvdn_trans pM' (cardSg (dergS 1 _)); rewrite subIset ?sNY_M ?orbT. -have [L maxNX_L] := mmax_exists (mFT_norm_proper ntX (mFT_pgroup_proper qX)). -have [maxL sNX_L] := setIdP maxNX_L. -have{maxNX_L} maxNX_L: L \in 'M('N(X)) :\ M. - by rewrite 2!inE maxNX_L andbT; apply: contraNneq not_sNX_M => <-. -have sXM := subset_trans sXMs (pcore_sub _ M). -have [notMGL _ embedL] := sigma_subgroup_embedding maxM sMq sXM qX ntX maxNX_L. -pose K := (if q \in \sigma(L) then L`_\beta else L`_\sigma)%G. -have sM'K: \sigma(M)^'.-group K. - rewrite orbit_sym in notMGL. - rewrite /K; case: (boolP (q \in _)) embedL => [sLq _ | sL'q [t2Lq _ _]]. - have [_ TIaLsM _] := sigma_disjoint maxL maxM notMGL. - apply: sub_pgroup (pcore_pgroup _ _) => p bLp. - by apply: contraFN (TIaLsM p) => /= sMp; rewrite inE /= beta_sub_alpha. - have [F hallF] := ex_sigma_compl maxL. - have [A Ep2A _] := ex_tau2Elem hallF t2Lq. - have [_ _ _ TIsLs] := tau2_compl_context maxL hallF t2Lq Ep2A. - have{TIsLs} [_ TIsLsM] := TIsLs M maxM notMGL. - apply: sub_pgroup (pcore_pgroup _ _) => p sLp. - by apply: contraFN (TIsLsM p) => /= sMp; rewrite inE /= sLp. -have defL: K * (M :&: L) = L. - rewrite /K; case: (q \in _) embedL => [] [] // _ _. - by move/(sdprod_Hall_pcoreP (Msigma_Hall maxL)); case/sdprodP. -have sYL := subset_trans (char_norm charX) sNX_L. -have [x sYxMs]: exists x, Y :^ x \subset M`_\sigma. - have solML := solvableS (subsetIl M L) (mmax_sol maxM). - have [H hallH] := Hall_exists \sigma(M) solML. - have [sHM sHL] := subsetIP (pHall_sub hallH). - have hallH_L: \sigma(M).-Hall(L) H. - rewrite pHallE sHL -defL -LagrangeMr partnM ?cardG_gt0 //. - rewrite -(card_Hall hallH) part_p'nat ?mul1n //=. - exact: pnat_dvd (dvdn_indexg _ _) sM'K. - have [x _ sYxH]:= Hall_Jsub (mmax_sol maxL) hallH_L sYL sM_Y. - exists x; rewrite (sub_Hall_pcore (Msigma_Hall maxM)) ?pgroupJ //. - exact: subset_trans sYxH sHM. -split=> [|E p H hallE piEp bG'p maxY_H notMGH]; first by exists x. -have p'K: p^'.-group K. - have bL'p: p \notin \beta(L). - by rewrite -predI_sigma_beta // negb_and bG'p orbT. - rewrite /K; case: (q \in _) embedL => [_ | [_ bLp _]]. - by rewrite (pi_p'group (pcore_pgroup _ _)). - rewrite (pi_p'group (pcore_pgroup _ _)) //; apply: contra bL'p => /= sLp. - by rewrite bLp // inE /= (piSg (pHall_sub hallE)). -have sNHY_L: 'N_H(Y) \subset L. - by rewrite subIset ?(subset_trans (char_norms charX)) ?orbT. -rewrite (leq_trans (p_rankS p sNHY_L)); last first. - have [P sylP] := Sylow_exists p (M :&: L). - have [_ sPL] := subsetIP (pHall_sub sylP). - have{sPL} sylP_L: p.-Sylow(L) P. - rewrite pHallE sPL -defL -LagrangeMr partnM ?cardG_gt0 //. - rewrite -(card_Hall sylP) part_p'nat ?mul1n //=. - exact: pnat_dvd (dvdn_indexg _ _) p'K. - rewrite -(p_rank_Sylow sylP_L) {P sylP sylP_L}(p_rank_Sylow sylP). - by rewrite /= setIC (pre_part_a E) // inE maxL. -split=> // t1Mp; rewrite (contra ((piSg (dergS 1 sNHY_L)) p)) // -p'groupEpi. -have nsKL: K <| L by rewrite /K; case: ifP => _; apply: pcore_normal. -have [sKL nKL] := andP nsKL; have nKML := subset_trans (subsetIr M L) nKL. -suffices: p^'.-group (K * (M :&: L)^`(1)). - rewrite -norm_joinEr ?gFsub_trans //; apply: pgroupS => /=. - rewrite norm_joinEr -?quotientSK ?gFsub_trans //= !quotient_der //. - by rewrite -[in L / K]defL quotientMidl. -rewrite pgroupM p'K (pgroupS (dergS 1 (subsetIl M L))) // p'groupEpi. -by rewrite mem_primes andbA andbC negb_and; case/and3P: t1Mp => _ _ ->. -Qed. - -(* This is B & G, Lemma 12.17. *) -Lemma sigma_compl_embedding M E (Ms := M`_\sigma) : - M \in 'M -> \sigma(M)^'.-Hall(M) E -> - [/\ 'C_Ms(E) \subset Ms^`(1), [~: Ms, E] = Ms - & forall g (MsMg := Ms :&: M :^ g), g \notin M -> - [/\ cyclic MsMg, \beta(M)^'.-group MsMg & MsMg :&: Ms^`(1) = 1]]. -Proof. -move=> maxM hallE; have [sEM s'E _] := and3P hallE. -have solMs: solvable Ms := solvableS (pcore_sub _ _) (mmax_sol maxM). -have defM := coprime_der1_sdprod (sdprod_sigma maxM hallE). -have{s'E} coMsE: coprime #|Ms| #|E| := pnat_coprime (pcore_pgroup _ _) s'E. -have{defM coMsE} [-> ->] := defM coMsE solMs (Msigma_der1 maxM). -split=> // g MsMg notMg. -have sMsMg: \sigma(M).-group MsMg := pgroupS (subsetIl _ _) (pcore_pgroup _ _). -have EpMsMg p n X: X \in 'E_p^n(MsMg) -> n > 0 -> - n = 1%N /\ ~~ ((p \in \beta(M)) || (X \subset Ms^`(1))). -- move=> EpX n_gt0; have [sXMsMg abelX dimX] := pnElemP EpX. - have [[sXMs sXMg] [pX _]] := (subsetIP sXMsMg, andP abelX). - have sXM := subset_trans sXMs (pcore_sub _ _). - have piXp: p \in \pi(X) by rewrite -p_rank_gt0 p_rank_abelem ?dimX. - have sMp: p \in \sigma(M) := pnatPpi (pgroupS sXMs (pcore_pgroup _ _)) piXp. - have not_sCX_M: ~~ ('C(X) \subset M). - apply: contra notMg => sCX_M; rewrite -groupV. - have [transCX _ _] := sigma_group_trans maxM sMp pX. - have [|c CXc [m Mm ->]] := transCX g^-1 sXM; rewrite ?sub_conjgV //. - by rewrite groupM // (subsetP sCX_M). - have cycX: cyclic X. - apply: contraR not_sCX_M => ncycX; apply: subset_trans (cent_sub _) _. - exact: norm_noncyclic_sigma maxM sMp pX sXM ncycX. - have n1: n = 1%N by apply/eqP; rewrite eqn_leq -{1}dimX -abelem_cyclic ?cycX. - rewrite n1 in dimX *; split=> //; apply: contra not_sCX_M. - by case/cent_der_sigma_uniq=> //; [apply/pnElemP | case/mem_uniq_mmax]. -have tiMsMg_Ms': MsMg :&: Ms^`(1) = 1. - apply/eqP/idPn; rewrite -rank_gt0 => /rank_geP[X /nElemP[p]]. - case/pnElemP=> /subsetIP[sXMsMg sXMs'] abelX dimX. - by case: (EpMsMg p 1%N X) => //; [apply/pnElemP | rewrite sXMs' orbT]. -split=> //; last first. - apply: sub_in_pnat sMsMg => p. - by rewrite -p_rank_gt0 => /p_rank_geP[X /EpMsMg[] // _ /norP[]]. -rewrite abelian_rank1_cyclic. - by rewrite leqNgt; apply/rank_geP=> [[X /nElemP[p /EpMsMg[]]]]. -by rewrite (sameP derG1P trivgP) -tiMsMg_Ms' subsetI der_sub dergS ?subsetIl. -Qed. - -(* This is B & G, Lemma 12.18. *) -(* We corrected an omission in the text, which fails to quote Lemma 10.3 to *) -(* justify the two p-rank inequalities (12.5) and (12.6), and indeed *) -(* erroneously refers to 12.2(a) for (12.5). Note also that the loosely *) -(* justified equalities of Ohm_1 subgroups are in fact unnecessary. *) -Lemma cent_Malpha_reg_tau1 M p q P Q (Ma := M`_\alpha) : - M \in 'M -> p \in \tau1(M) -> q \in p^' -> P \in 'E_p^1(M) -> Q :!=: 1 -> - P \subset 'N(Q) -> 'C_Q(P) = 1 -> 'M('N(Q)) != [set M] -> - [/\ (*a*) Ma != 1 -> q \notin \alpha(M) -> q.-group Q -> Q \subset M -> - 'C_Ma(P) != 1 /\ 'C_Ma(Q <*> P) = 1 - & (*b*) q.-Sylow(M) Q -> - [/\ \alpha(M) =i \beta(M), Ma != 1, q \notin \alpha(M), - 'C_Ma(P) != 1 & 'C_Ma(Q <*> P) = 1]]. -Proof. -move=> maxM t1p p'q EpP ntQ nQP regPQ nonuniqNQ. -set QP := Q <*> P; set CaQP := 'C_Ma(QP); set part_a := _ -> _. -have ssolM := solvableS _ (mmax_sol maxM). -have [sPM abelP oP] := pnElemPcard EpP; have{abelP} [pP _] := andP abelP. -have p_pr := pnElem_prime EpP; have [s'p _] := andP t1p. -have a'p: p \in \alpha(M)^' by apply: contra s'p; apply: alpha_sub_sigma. -have{a'p} [a'P t2'p] := (pi_pgroup pP a'p, tau2'1 t1p). -have uniqCMX: 'M('C_M(_)) = [set M] := def_uniq_mmax _ maxM (subsetIl _ _). -have nQ_CMQ: 'C_M(Q) \subset 'N(Q) by rewrite setIC subIset ?cent_sub. -have part_a_holds: part_a. - move=> ntMa a'q qQ sQM; have{p'q} p'Q := pi_pgroup qQ p'q. - have{p'Q} coQP: coprime #|Q| #|P| by rewrite coprime_sym (pnat_coprime pP). - have{a'q} a'Q: \alpha(M)^'.-group Q by rewrite (pi_pgroup qQ). - have rCMaQle1: 'r('C_Ma(Q)) <= 1. - rewrite leqNgt; apply: contra nonuniqNQ => rCMaQgt1; apply/eqP. - apply: def_uniq_mmaxS (uniqCMX Q _) => //; last exact: cent_alpha'_uniq. - exact: mFT_norm_proper (mFT_pgroup_proper qQ). - have rCMaPle1: 'r('C_Ma(P)) <= 1. - have: ~~ ('N(P) \subset M). - by apply: contra (prime_class_mmax_norm maxM pP) _; apply/norP. - rewrite leqNgt; apply: contra => rCMaPgt1. - apply: (sub_uniq_mmax (uniqCMX P _)); first exact: cent_alpha'_uniq. - by rewrite /= setIC subIset ?cent_sub. - exact: mFT_norm_proper (nt_pnElem EpP _) (mFT_pgroup_proper pP). - have [sMaM nMaM] := andP (pcore_normal _ M : Ma <| M). - have aMa: \alpha(M).-group Ma by rewrite pcore_pgroup. - have nMaQP: QP \subset 'N(Ma) by rewrite join_subG !(subset_trans _ nMaM). - have{nMaM} coMaQP: coprime #|Ma| #|QP|. - by rewrite (pnat_coprime aMa) ?[QP]norm_joinEr // [pnat _ _]pgroupM ?a'Q. - pose r := pdiv #|if CaQP == 1 then Ma else CaQP|. - have{ntMa} piMar: r \in \pi(Ma). - rewrite /r; case: ifPn => [_| ntCaQP]; first by rewrite pi_pdiv cardG_gt1. - by rewrite (piSg (subsetIl Ma 'C(QP))) // pi_pdiv cardG_gt1. - have{aMa} a_r: r \in \alpha(M) := pnatPpi aMa piMar. - have [r'Q r'P] : r^'.-group Q /\ r^'.-group P by rewrite !(pi'_p'group _ a_r). - have [Rc /= sylRc] := Sylow_exists r [group of CaQP]. - have [sRcCaQP rRc _] := and3P sylRc; have [sRcMa cQPRc] := subsetIP sRcCaQP. - have nRcQP: QP \subset 'N(Rc) by rewrite cents_norm // centsC. - have{nMaQP rRc coMaQP sRcCaQP sRcMa nRcQP} [R [sylR nR_QP sRcR]] := - coprime_Hall_subset nMaQP coMaQP (ssolM _ sMaM) sRcMa rRc nRcQP. - have{nR_QP} [[sRMa rR _] [nRQ nRP]] := (and3P sylR, joing_subP nR_QP). - have{piMar} ntR: R :!=: 1 by rewrite -rank_gt0 (rank_Sylow sylR) p_rank_gt0. - have [r_pr _ _] := pgroup_pdiv rR ntR. - have sylR_M := subHall_Sylow (Malpha_Hall maxM) a_r sylR. - have{rCMaQle1 a_r} not_cRQ: ~~ (Q \subset 'C(R)). - apply: contraL rCMaQle1; rewrite centsC => cQR; rewrite -ltnNge ltnW //. - by rewrite (leq_trans a_r) // -(rank_Sylow sylR_M) rankS // subsetI sRMa. - have [R1 [charR1 _ _ expR1 rCR1_AutR]] := critical_odd rR (mFT_odd R) ntR. - have [sR1R nR1R] := andP (char_normal charR1); have rR1 := pgroupS sR1R rR. - have [nR1P nR1Q] := (char_norm_trans charR1 nRP, char_norm_trans charR1 nRQ). - have [coR1Q coR1P] := (pnat_coprime rR1 r'Q, pnat_coprime rR1 r'P). - have {rCR1_AutR not_cRQ} not_cR1Q: ~~ (Q \subset 'C(R1)). - apply: contra not_cRQ => cR1Q; rewrite -subsetIidl. - rewrite -quotient_sub1 ?normsI ?normG ?norms_cent // subG1 trivg_card1. - rewrite (pnat_1 _ (quotient_pgroup _ r'Q)) //= -ker_conj_aut. - rewrite (card_isog (first_isog_loc _ _)) //; apply: pgroupS rCR1_AutR. - apply/subsetP=> za; case/morphimP=> z nRz Qz ->; rewrite inE Aut_aut inE. - apply/subsetP=> x R1x; rewrite inE [_ x _]norm_conj_autE ?(subsetP sR1R) //. - by rewrite /conjg -(centsP cR1Q z) ?mulKg. - pose R0 := 'C_R1(Q); have sR0R1: R0 \subset R1 := subsetIl R1 'C(Q). - have nR0P: P \subset 'N(R0) by rewrite normsI ?norms_cent. - have nR0Q: Q \subset 'N(R0) by rewrite normsI ?norms_cent ?normG. - pose R1Q := R1 <*> Q; have defR1Q: R1 * Q = R1Q by rewrite -norm_joinEr. - have [[sR1_R1Q sQ_R1Q] tiR1Q] := (joing_sub (erefl R1Q), coprime_TIg coR1Q). - have not_nilR1Q: ~~ nilpotent R1Q. - by apply: contra not_cR1Q => /sub_nilpotent_cent2; apply. - have not_nilR1Qb: ~~ nilpotent (R1Q / R0). - apply: contra not_cR1Q => nilR1Qb. - have [nilR1 solR1] := (pgroup_nil rR1, pgroup_sol rR1). - rewrite centsC -subsetIidl -(nilpotent_sub_norm nilR1 sR0R1) //= -/R0. - rewrite -(quotientSGK (subsetIr R1 _)) ?coprime_quotient_cent //= -/R0. - rewrite quotientInorm subsetIidl /= centsC -/R0. - by rewrite (sub_nilpotent_cent2 nilR1Qb) ?quotientS ?coprime_morph. - have coR1QP: coprime #|R1Q| #|P|. - by rewrite -defR1Q TI_cardMg // coprime_mull coR1P. - have defR1QP: R1Q ><| P = R1Q <*> P. - by rewrite sdprodEY ?normsY ?coprime_TIg. - have sR1Ma := subset_trans sR1R sRMa; have sR1M := subset_trans sR1Ma sMaM. - have solR1Q: solvable R1Q by rewrite ssolM // !join_subG sR1M. - have solR1QP: solvable (R1Q <*> P) by rewrite ssolM // !join_subG sR1M sQM. - have defCR1QP: 'C_R1Q(P) = 'C_R1(P). - by rewrite -defR1Q -subcent_TImulg ?regPQ ?mulg1 //; apply/subsetIP. - have ntCR1P: 'C_R1(P) != 1. - apply: contraNneq not_nilR1Q => regPR1. - by rewrite (prime_Frobenius_sol_kernel_nil defR1QP) ?oP ?defCR1QP. - split; first exact: subG1_contra (setSI _ sR1Ma) ntCR1P. - have{rCMaPle1} cycCRP: cyclic 'C_R(P). - have rCRP: r.-group 'C_R(P) := pgroupS (subsetIl R _) rR. - rewrite (odd_pgroup_rank1_cyclic rCRP) ?mFT_odd -?rank_pgroup {rCRP}//. - by rewrite (leq_trans (rankS _) rCMaPle1) ?setSI. - have{ntCR1P} oCR1P: #|'C_R1(P)| = r. - have cycCR1P: cyclic 'C_R1(P) by rewrite (cyclicS _ cycCRP) ?setSI. - apply: cyclic_abelem_prime ntCR1P => //. - by rewrite abelemE ?cyclic_abelian // -expR1 exponentS ?subsetIl. - apply: contraNeq not_nilR1Qb => ntCaQP. - have{Rc sRcR sylRc cQPRc ntCaQP} ntCRQP: 'C_R(QP) != 1. - suffices: Rc :!=: 1 by apply: subG1_contra; apply/subsetIP. - rewrite -rank_gt0 (rank_Sylow sylRc) p_rank_gt0. - by rewrite /r (negPf ntCaQP) pi_pdiv cardG_gt1. - have defR1QPb: (R1Q / R0) ><| (P / R0) = R1Q <*> P / R0. - have [_ <- nR1QP _] := sdprodP defR1QP; rewrite quotientMr //. - by rewrite sdprodE ?quotient_norms // coprime_TIg ?coprime_morph. - have tiPR0: R0 :&: P = 1 by rewrite coprime_TIg // (coprimeSg sR0R1). - have prPb: prime #|P / R0| by rewrite -(card_isog (quotient_isog _ _)) ?oP. - rewrite (prime_Frobenius_sol_kernel_nil defR1QPb) ?quotient_sol //. - rewrite -coprime_quotient_cent ?(subset_trans sR0R1) // quotientS1 //=. - rewrite defCR1QP -{2}(setIidPl sR1R) -setIA subsetI subsetIl. - apply: subset_trans (setIS R (centS (joing_subl Q P))). - rewrite -(cardSg_cyclic cycCRP) ?setIS ?setSI ?centS ?joing_subr // oCR1P. - by have [_ -> _] := pgroup_pdiv (pgroupS (subsetIl R _) rR) ntCRQP. -split=> // sylQ; have [sQM qQ _] := and3P sylQ. -have ltQG := mFT_pgroup_proper qQ; have ltNQG := mFT_norm_proper ntQ ltQG. -have{p'q} p'Q := pi_pgroup qQ p'q. -have{p'Q} coQP: coprime #|Q| #|P| by rewrite coprime_sym (pnat_coprime pP). -have sQM': Q \subset M^`(1). - by rewrite -(coprime_cent_prod nQP) ?ssolM // regPQ mulg1 commgSS. -have ntMa: Ma != 1. - apply: contraNneq nonuniqNQ => Ma1. - rewrite (mmax_normal maxM _ ntQ) ?mmax_sup_id //. - have sylQ_M': q.-Sylow(M^`(1)) Q := pHall_subl sQM' (der_sub 1 M) sylQ. - rewrite (nilpotent_Hall_pcore _ sylQ_M') ?gFnormal_trans //. - by rewrite (isog_nil (quotient1_isog _)) -Ma1 Malpha_quo_nil. -have a'q: q \notin \alpha(M). - apply: contra nonuniqNQ => a_q. - have uniqQ: Q \in 'U by rewrite rank3_Uniqueness ?(rank_Sylow sylQ). - by rewrite (def_uniq_mmaxS _ _ (def_uniq_mmax _ _ sQM)) ?normG. -have b'q := contra (@beta_sub_alpha _ M _) a'q. -case: part_a_holds => // ntCaP regQP; split=> {ntCaP regQP}// r. -apply/idP/idP=> [a_r | ]; last exact: beta_sub_alpha. -apply: contraR nonuniqNQ => b'r; apply/eqP. -apply: def_uniq_mmaxS (uniqCMX Q _) => //. -have q'r: r != q by apply: contraNneq a'q => <-. -by have [|_ -> //] := beta'_cent_Sylow maxM b'r b'q qQ; rewrite q'r sQM'. -Qed. - -(* This is B & G, Lemma 12.19. *) -(* We have used lemmas 10.8(b) and 10.2(c) rather than 10.9(a) as suggested *) -(* in the text; this avoids a quantifier inversion! *) -Lemma der_compl_cent_beta' M E : - M \in 'M -> \sigma(M)^'.-Hall(M) E -> - exists2 H : {group gT}, \beta(M)^'.-Hall(M`_\sigma) H & E^`(1) \subset 'C(H). -Proof. -move=> maxM hallE; have [sEM s'E _] := and3P hallE. -have s'E': \sigma(M)^'.-group E^`(1) := pgroupS (der_sub 1 E) s'E. -have b'E': \beta(M)^'.-group E^`(1). - by apply: sub_pgroup s'E' => p; apply: contra; apply: beta_sub_sigma. -have solM': solvable M^`(1) := solvableS (der_sub 1 M) (mmax_sol maxM). -have [K hallK sE'K] := Hall_superset solM' (dergS 1 sEM) b'E'. -exists (K :&: M`_\sigma)%G. - apply: Hall_setI_normal hallK. - exact: normalS (Msigma_der1 maxM) (der_sub 1 M) (pcore_normal _ M). -have nilK: nilpotent K. - by have [sKM' b'K _] := and3P hallK; apply: beta'_der1_nil sKM'. -rewrite (sub_nilpotent_cent2 nilK) ?subsetIl ?(coprimeSg (subsetIr _ _)) //. -exact: pnat_coprime (pcore_pgroup _ _) s'E'. -Qed. - -End Section12. - -Arguments tau2'1 {gT M} [x]. -Arguments tau3'1 {gT M} [x]. -Arguments tau3'2 {gT M} [x]. - diff --git a/mathcomp/odd_order/BGsection13.v b/mathcomp/odd_order/BGsection13.v deleted file mode 100644 index de9ddaf..0000000 --- a/mathcomp/odd_order/BGsection13.v +++ /dev/null @@ -1,1123 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq div path fintype. -From mathcomp -Require Import bigop finset prime fingroup morphism perm automorphism quotient. -From mathcomp -Require Import action gproduct gfunctor pgroup cyclic center commutator. -From mathcomp -Require Import gseries nilpotent sylow abelian maximal hall frobenius. -From mathcomp -Require Import BGsection1 BGsection3 BGsection4 BGsection5 BGsection6. -From mathcomp -Require Import BGsection7 BGsection9 BGsection10 BGsection12. - -(******************************************************************************) -(* This file covers B & G, section 13; the title subject of the section, *) -(* prime and regular actions, was defined in the frobenius.v file. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope. - -Section Section13. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). -Implicit Types p q q_star r : nat. -Implicit Types A E H K L M Mstar N P Q Qstar R S T U V W X Y Z : {group gT}. - -Section OneComplement. - -Variables M E : {group gT}. -Hypotheses (maxM : M \in 'M) (hallE : \sigma(M)^'.-Hall(M) E). - -Let sEM : E \subset M := pHall_sub hallE. -Let sM'E : \sigma(M)^'.-group E := pHall_pgroup hallE. - -(* This is B & G, Lemma 13.1. *) -Lemma Msigma_setI_mmax_central p H : - H \in 'M -> p \in \pi(E) -> p \in \pi(H) -> p \notin \tau1(H) -> - [~: M`_\sigma :&: H, M :&: H] != 1 -> gval H \notin M :^: G -> - [/\ (*a*) forall P, P \subset M :&: H -> p.-group P -> - P \subset 'C(M`_\sigma :&: H), - (*b*) p \notin \tau2(H) - & (*c*) p \in \tau1(M) -> p \in \beta(G)]. -Proof. -move=> maxH piEp piHp t1H'p; set R := [~: _, _] => ntR notMGH. -have [q sMq piH'q]: exists2 q, q \in \sigma(M) & q \in \pi(H^`(1)). - pose q := pdiv #|R|; have q_pr: prime q by rewrite pdiv_prime ?cardG_gt1. - have q_dv : q %| _ := dvdn_trans (pdiv_dvd _) (cardSg _). - exists q; last by rewrite mem_primes q_pr cardG_gt0 q_dv ?commgSS ?subsetIr. - rewrite (pgroupP (pcore_pgroup _ M)) ?q_dv //. - have sR_MsM: R \subset [~: M`_\sigma, M] by rewrite commgSS ?subsetIl. - by rewrite (subset_trans sR_MsM) // commg_subl gFnorm. -have [Y sylY] := Sylow_exists q H^`(1); have [sYH' qY _] := and3P sylY. -have nsHbH: H`_\beta <| H := pcore_normal _ _; have [_ nHbH] := andP nsHbH. -have sYH := subset_trans sYH' (der_sub 1 H); have nHbY := subset_trans sYH nHbH. -have nsHbY_H: H`_\beta <*> Y <| H. - rewrite -{2}(quotientGK nsHbH) -quotientYK ?cosetpre_normal //. - have ->: Y / H`_\beta = 'O_q(H^`(1) / H`_\beta). - by apply: nilpotent_Hall_pcore; rewrite ?Mbeta_quo_nil ?quotient_pHall. - by rewrite quotient_der ?gFnormal_trans. -have sYNY: Y \subset 'N_H(Y) by rewrite subsetI sYH normG. -have{nsHbY_H} defH: H`_\beta * 'N_H(Y) = H. - rewrite -(mulSGid sYNY) mulgA -(norm_joinEr nHbY). - rewrite (Frattini_arg _ (pHall_subl _ _ sylY)) ?joing_subr //. - by rewrite join_subG Mbeta_der1. -have ntY: Y :!=: 1 by rewrite -cardG_gt1 (card_Hall sylY) p_part_gt1. -have{ntY} [_] := sigma_Jsub maxM (pi_pgroup qY sMq) ntY. -have maxY_H: H \in 'M(Y) by apply/setIdP. -move/(_ E p H hallE piEp _ maxY_H notMGH) => b'p_t3Hp. -case t2Hp: (p \in \tau2(H)). - have b'p: p \notin \beta(G) by case/tau2_not_beta: t2Hp. - have rpH: 'r_p(H) = 2 by apply/eqP; case/andP: t2Hp. - have p'Hb: p^'.-group H`_\beta. - rewrite (pi_p'group (pcore_pgroup _ H)) // inE /=. - by rewrite -predI_sigma_beta // negb_and b'p orbT. - case: b'p_t3Hp; rewrite // -(p_rank_p'quotient p'Hb) ?subIset ?nHbH //=. - by rewrite -quotientMidl defH p_rank_p'quotient ?rpH. -have [S sylS] := Sylow_exists p H; have [sSH pS _] := and3P sylS. -have sSH': S \subset H^`(1). - have [sHp | sH'p] := boolP (p \in \sigma(H)). - apply: subset_trans (Msigma_der1 maxH). - by rewrite (sub_Hall_pcore (Msigma_Hall _)) // (pi_pgroup pS). - have sH'_S: \sigma(H)^'.-group S by rewrite (pi_pgroup pS). - have [F hallF sSF] := Hall_superset (mmax_sol maxH) sSH sH'_S. - have t3Hp: p \in \tau3(H). - have:= partition_pi_sigma_compl maxH hallF p. - by rewrite (pi_sigma_compl hallF) inE /= sH'p piHp (negPf t1H'p) t2Hp. - have [[F1 hallF1] [F3 hallF3]] := ex_tau13_compl hallF. - have [F2 _ complFi] := ex_tau2_compl hallF hallF1 hallF3. - have [[sF3F' nsF3F] _ _ _ _] := sigma_compl_context maxH complFi. - apply: subset_trans (subset_trans sF3F' (dergS 1 (pHall_sub hallF))). - by rewrite (sub_normal_Hall hallF3) ?(pi_pgroup pS). -have sylS_H' := pHall_subl sSH' (der_sub 1 H) sylS. -split=> // [P sPMH pP | t1Mp]; last first. - apply/idPn=> b'p; have [_ /(_ t1Mp)/negP[]] := b'p_t3Hp b'p. - have p'Hb: p^'.-group H`_\beta. - rewrite (pi_p'group (pcore_pgroup _ H)) // inE /=. - by rewrite -predI_sigma_beta // negb_and b'p orbT. - rewrite -p_rank_gt0 -(p_rank_p'quotient p'Hb) ?comm_subG ?subIset ?nHbH //=. - rewrite quotient_der ?subIset ?nHbH // -quotientMidl defH -quotient_der //=. - rewrite p_rank_p'quotient ?comm_subG // -(rank_Sylow sylS_H'). - by rewrite (rank_Sylow sylS) p_rank_gt0. -have nsHaH: H`_\alpha <| H := pcore_normal _ _; have [_ nHaH] := andP nsHaH. -have [sPM sPH] := subsetIP sPMH; have nHaS := subset_trans sSH nHaH. -have nsHaS_H: H`_\alpha <*> S <| H. - rewrite -[H in _ <| H](quotientGK nsHaH) -quotientYK ?cosetpre_normal //. - have ->: S / H`_\alpha = 'O_p(H^`(1) / H`_\alpha). - by apply: nilpotent_Hall_pcore; rewrite ?Malpha_quo_nil ?quotient_pHall. - by rewrite quotient_der ?gFnormal_trans. -have [sHaS_H nHaS_H] := andP nsHaS_H. -have sP_HaS: P \subset H`_\alpha <*> S. - have [x Hx sPSx] := Sylow_subJ sylS sPH pP; apply: subset_trans sPSx _. - by rewrite sub_conjg (normsP nHaS_H) ?groupV ?joing_subr. -have coHaS_Ms: coprime #|H`_\alpha <*> S| #|M`_\sigma|. - rewrite (p'nat_coprime _ (pcore_pgroup _ _)) // -pgroupE norm_joinEr //. - rewrite pgroupM andbC (pi_pgroup pS) ?(pnatPpi (pHall_pgroup hallE)) //=. - apply: sub_pgroup (pcore_pgroup _ _) => r aHr. - have [|_ ti_aH_sM _] := sigma_disjoint maxH maxM; first by rewrite orbit_sym. - by apply: contraFN (ti_aH_sM r) => sMr; apply/andP. -rewrite (sameP commG1P trivgP) -(coprime_TIg coHaS_Ms) commg_subI ?setIS //. -by rewrite subsetI sP_HaS (subset_trans sPM) ?gFnorm. -Qed. - -(* This is B & G, Corollary 13.2. *) -Corollary cent_norm_tau13_mmax p P H : - (p \in \tau1(M)) || (p \in \tau3(M)) -> - P \subset M -> p.-group P -> H \in 'M('N(P)) -> - [/\ (*a*) forall P1, P1 \subset M :&: H -> p.-group P1 -> - P1 \subset 'C(M`_\sigma :&: H), - (*b*) forall X, X \subset E :&: H -> \tau1(H)^'.-group X -> - X \subset 'C(M`_\sigma :&: H) - & (*c*) [~: M`_\sigma :&: H, M :&: H] != 1 -> - p \in \sigma(H) /\ (p \in \tau1(M) -> p \in \beta(H))]. -Proof. -move=> t13Mp sPM pP /setIdP[maxH sNP_H]. -have ntP: P :!=: 1. - by apply: contraTneq sNP_H => ->; rewrite norm1 proper_subn ?mmax_proper. -have st2Hp: (p \in \sigma(H)) || (p \in \tau2(H)). - exact: (prime_class_mmax_norm maxH pP sNP_H). -have not_MGH: gval H \notin M :^: G. - apply: contraL st2Hp => /imsetP[x _ ->]; rewrite sigmaJ tau2J negb_or. - by have:= t13Mp; rewrite -2!andb_orr !inE => /and3P[-> /eqP->]. -set R := [~: _, _]; have [/commG1P | ntR] := altP (R =P 1). - rewrite centsC => cMH; split=> // X sX_EH _; apply: subset_trans cMH => //. - by rewrite (subset_trans sX_EH) ?setSI. -have piEp: p \in \pi(E). - by rewrite (partition_pi_sigma_compl maxM) // orbCA t13Mp orbT. -have piHp: p \in \pi(H). - by rewrite (partition_pi_mmax maxH) orbCA orbC -!orbA st2Hp !orbT. -have t1H'p: p \notin \tau1(H). - by apply: contraL st2Hp; rewrite negb_or !inE => /and3P[-> /eqP->]. -case: (Msigma_setI_mmax_central maxH piEp) => // cMsH t2H'p b_p. -split=> // [X sX_EH t1'X | _]. - have [sXE sXH] := subsetIP sX_EH. - rewrite -(Sylow_gen X) gen_subG; apply/bigcupsP=> Q; case/SylowP=> q _ sylQ. - have [-> | ntQ] := eqsVneq Q 1; first exact: sub1G. - have piXq: q \in \pi(X) by rewrite -p_rank_gt0 -(rank_Sylow sylQ) rank_gt0. - have [[piEq piHq] t1H'q] := (piSg sXE piXq, piSg sXH piXq, pnatPpi t1'X piXq). - have [sQX qQ _] := and3P sylQ; have sXM := subset_trans sXE sEM. - case: (Msigma_setI_mmax_central maxH piEq) => // -> //. - by rewrite subsetI !(subset_trans sQX). -rewrite (negPf t2H'p) orbF in st2Hp. -by rewrite -predI_sigma_beta // {3}/in_mem /= st2Hp. -Qed. - -(* This is B & G, Corollary 13.3(a). *) -Lemma cyclic_primact_Msigma p P : - p.-Sylow(E) P -> cyclic P -> semiprime M`_\sigma P. -Proof. -move=> sylP cycP x /setD1P[]; rewrite -cycle_eq1 -cycle_subG => ntX sXP. -have [sPE pP _] := and3P sylP; rewrite -cent_cycle. -have sPM := subset_trans sPE sEM; have sXM := subset_trans sXP sPM. -have pX := pgroupS sXP pP; have ltXG := mFT_pgroup_proper pX. -have t13p: (p \in \tau1(M)) || (p \in \tau3(M)). - rewrite (tau1E maxM hallE) (tau3E maxM hallE) -p_rank_gt0 -(rank_Sylow sylP). - rewrite eqn_leq rank_gt0 (subG1_contra sXP) //= andbT -andb_orl orNb. - by rewrite -abelian_rank1_cyclic ?cyclic_abelian. -have [H maxNH] := mmax_exists (mFT_norm_proper ntX ltXG). -have [cMsX _ _] := cent_norm_tau13_mmax t13p sXM pX maxNH. -have [_ sNH] := setIdP maxNH. -apply/eqP; rewrite eqEsubset andbC setIS ?centS // subsetI subsetIl /= centsC. -apply: subset_trans (cMsX P _ pP) (centS _). - rewrite subsetI sPM (subset_trans (cents_norm _) sNH) //. - by rewrite sub_abelian_cent // cyclic_abelian. -by rewrite setIS // (subset_trans (cent_sub _) sNH). -Qed. - -(* This is B & G, Corollary 13.3(b). *) -Corollary tau3_primact_Msigma E3 : - \tau3(M).-Hall(E) E3 -> semiprime M`_\sigma E3. -Proof. -move=> hallE3 x /setD1P[]; rewrite -cycle_eq1 -cycle_subG => ntX sXE3. -have [sE3E t3E3 _] := and3P hallE3; rewrite -cent_cycle. -have [[E1 hallE1] _] := ex_tau13_compl hallE. -have [E2 _ complEi] := ex_tau2_compl hallE hallE1 hallE3. -have [[sE3E' nsE3E] _ [_ cycE3] _ _] := sigma_compl_context maxM complEi. -apply/eqP; rewrite eqEsubset andbC setIS ?centS // subsetI subsetIl /= centsC. -pose p := pdiv #[x]; have p_pr: prime p by rewrite pdiv_prime ?cardG_gt1. -have t3p: p \in \tau3(M) by rewrite (pgroupP (pgroupS sXE3 t3E3)) ?pdiv_dvd. -have t13p: [|| p \in \tau1(M) | p \in \tau3(M)] by rewrite t3p orbT. -have [y Xy oy]:= Cauchy p_pr (pdiv_dvd _). -have ntY: <[y]> != 1 by rewrite -cardG_gt1 -orderE oy prime_gt1. -have pY: p.-group <[y]> by rewrite /pgroup -orderE oy pnat_id. -have [H maxNH] := mmax_exists (mFT_norm_proper ntY (mFT_pgroup_proper pY)). -have sYE3: <[y]> \subset E3 by rewrite cycle_subG (subsetP sXE3). -have sYE := subset_trans sYE3 sE3E; have sYM := subset_trans sYE sEM. -have [_ cMsY _] := cent_norm_tau13_mmax t13p sYM pY maxNH. -have [_ sNH] := setIdP maxNH. -have sE3H': E3 \subset H^`(1). - rewrite (subset_trans sE3E') ?dergS // (subset_trans _ sNH) ?normal_norm //. - by rewrite (char_normal_trans _ nsE3E) // sub_cyclic_char. -apply: subset_trans (cMsY E3 _ _) (centS _). -- rewrite subsetI sE3E (subset_trans (cents_norm _) sNH) //. - by rewrite sub_abelian_cent ?cyclic_abelian. -- rewrite (pgroupS sE3H') //; apply/pgroupP=> q _ q_dv_H'. - by rewrite !inE q_dv_H' !andbF. -by rewrite setIS // (subset_trans _ sNH) // cents_norm ?centS ?cycle_subG. -Qed. - -(* This is B & G, Theorem 13.4. *) -(* Note how the non-structural steps in the proof (top of p. 99, where it is *) -(* deduced that C_M_alpha(P) <= C_M_alpha(R) from q \notin \alpha, and then *) -(* C_M_alpha(P) = C_M_alpha(R) from r \in tau_1(M) !!), are handled cleanly *) -(* on lines 5-12 of the proof by a conditional expression for the former, and *) -(* a without loss tactic for the latter. *) -(* Also note that the references to 10.12 and 12.2 are garbled (some are *) -(* missing, and some are exchanged!). *) -Theorem cent_tau1Elem_Msigma p r P R (Ms := M`_\sigma) : - p \in \tau1(M) -> P \in 'E_p^1(E) -> R \in 'E_r^1('C_E(P)) -> - 'C_Ms(P) \subset 'C_Ms(R). -Proof. -have /andP[sMsM nMsM]: Ms <| M := pcore_normal _ M. -have coMsE: coprime #|Ms| #|E| := coprime_sigma_compl hallE. -pose Ma := M`_\alpha; have sMaMs: Ma \subset Ms := Malpha_sub_Msigma maxM. -rewrite pnElemI -setIdE => t1Mp EpP /setIdP[ErR cPR]. -without loss symPR: p r P R EpP ErR cPR t1Mp / - r \in \tau1(M) -> 'C_Ma(P) \subset 'C_Ma(R) -> 'C_Ma(P) = 'C_Ma(R). -- move=> IH; apply: (IH p r) => // t1Mr sCaPR; apply/eqP; rewrite eqEsubset. - rewrite sCaPR -(setIidPl sMaMs) -!setIA setIS ?(IH r p) 1?centsC // => _. - by case/eqVproper; rewrite // /proper sCaPR andbF. -do [rewrite !subsetI !subsetIl /=; set cRCaP := _ \subset _] in symPR *. -pose Mz := 'O_(if cRCaP then \sigma(M) else \alpha(M))(M); pose C := 'C_Mz(P). -suffices: C \subset 'C(R) by rewrite /C /Mz /cRCaP; case: ifP => // ->. -have sMzMs: Mz \subset Ms by rewrite /Mz; case: ifP => // _. -have sCMs: C \subset Ms by rewrite subIset ?sMzMs. -have [[sPE abelP dimP] [sRE abelR dimR]] := (pnElemP EpP, pnElemP ErR). -have [sPM sRM] := (subset_trans sPE sEM, subset_trans sRE sEM). -have [[pP cPP _] [rR _]] := (and3P abelP, andP abelR). -have coCR: coprime #|C| #|R| := coprimeSg sCMs (coprimegS sRE coMsE). -have ntP: P :!=: 1 by apply: nt_pnElem EpP _. -pose ST := [set S | Sylow C (gval S) & R \subset 'N(S)]. -have sST_CP S: S \in ST -> S \subset C by case/setIdP=> /SylowP[q _ /andP[]]. -rewrite -{sST_CP}[C](Sylow_transversal_gen sST_CP) => [|q _]; last first. - have nMzR: R \subset 'N(Mz) by rewrite (subset_trans sRM) // gFnorm. - have{nMzR} nCR: R \subset 'N(C) by rewrite normsI // norms_cent // cents_norm. - have solC := solvableS (subset_trans sCMs sMsM) (mmax_sol maxM). - have [S sylS nSR] := coprime_Hall_exists q nCR coCR solC. - by exists S; rewrite // inE (p_Sylow sylS) nSR. -rewrite gen_subG; apply/bigcupsP=> S /setIdP[/SylowP[q _ sylS] nSR] {ST}. -have [sSC qS _] := and3P sylS. -have [sSMs [sSMz cPS]] := (subset_trans sSC sCMs, subsetIP sSC). -rewrite (sameP commG1P eqP) /=; set Q := [~: S, R]; apply/idPn => ntQ. -have sQS: Q \subset S by [rewrite commg_subl]; have qQ := pgroupS sQS qS. -have piQq: q \in \pi(Q) by rewrite -p_rank_gt0 -(rank_pgroup qQ) rank_gt0. -have{piQq} [nQR piSq] := (commg_normr R S : R \subset 'N(Q), piSg sQS piQq). -have [H maxNH] := mmax_exists (mFT_norm_proper ntP (mFT_pgroup_proper pP)). -have [maxH sNH] := setIdP maxNH; have sCPH := subset_trans (cent_sub _) sNH. -have [sPH sRH] := (subset_trans cPP sCPH, subset_trans cPR sCPH). -have [sSM sSH] := (subset_trans sSMs sMsM, subset_trans cPS sCPH). -have [sQM sQH] := (subset_trans sQS sSM, subset_trans sQS sSH). -have ntMsH_R: [~: Ms :&: H, R] != 1. - by rewrite (subG1_contra _ ntQ) ?commSg // subsetI sSMs. -have sR_EH: R \subset E :&: H by apply/subsetIP. -have ntMsH_MH: [~: Ms :&: H, M :&: H] != 1. - by rewrite (subG1_contra _ ntMsH_R) ?commgS // (subset_trans sR_EH) ?setSI. -have t13Mp: p \in [predU \tau1(M) & \tau3(M)] by apply/orP; left. -have [_ cMsH_t1H' [//|sHp bHp]] := cent_norm_tau13_mmax t13Mp sPM pP maxNH. -have{cMsH_t1H'} t1Hr: r \in \tau1(H). - apply: contraR ntMsH_R => t1H'r; rewrite (sameP eqP commG1P) centsC. - by rewrite cMsH_t1H' // (pi_pgroup rR). -have ntCHaRQ: 'C_(H`_\alpha)(R <*> Q) != 1. - rewrite centY (subG1_contra _ ntP) ?subsetI //= centsC cPR centsC. - rewrite (subset_trans sQS cPS) (subset_trans _ (Mbeta_sub_Malpha H)) //. - by rewrite (sub_Hall_pcore (Mbeta_Hall maxH)) // (pi_pgroup pP) ?bHp. -have not_MGH: gval H \notin M :^: G. - by apply: contraL sHp => /imsetP[x _ ->]; rewrite sigmaJ; case/andP: t1Mp. -have neqHM: H :!=: M := contra_orbit _ _ not_MGH. -have cSS: abelian S. - apply: contraR neqHM => /(nonabelian_Uniqueness qS)uniqS. - by rewrite (eq_uniq_mmax (def_uniq_mmax uniqS maxM sSM) maxH sSH). -have tiQcR: 'C_Q(R) = 1 by rewrite coprime_abel_cent_TI // (coprimeSg sSC). -have sMq: q \in \sigma(M) := pnatPpi (pcore_pgroup _ M) (piSg sSMs piSq). -have aH'q: q \notin \alpha(H). - have [|_ tiHaMs _] := sigma_disjoint maxH maxM; first by rewrite orbit_sym. - by apply: contraFN (tiHaMs q) => aHq; apply/andP. -have piRr: r \in \pi(R) by rewrite -p_rank_gt0 p_rank_abelem ?dimR. -have ErH_R: R \in 'E_r^1(H) by rewrite !inE sRH abelR dimR. -have{piRr} sM'r: r \in \sigma(M)^' := pnatPpi (pgroupS sRE sM'E) piRr. -have r'q: q \in r^' by apply: contraTneq sMq => ->. -have ntHa: H`_\alpha != 1 by rewrite (subG1_contra _ ntCHaRQ) ?subsetIl. -have uniqNQ: 'M('N(Q)) = [set H]. - apply: contraNeq ntCHaRQ; rewrite joingC. - by case/(cent_Malpha_reg_tau1 _ _ r'q ErH_R) => //; case=> //= _ -> _. -have maxNQ_H: H \in 'M('N(Q)) :\ M by rewrite uniqNQ !inE neqHM /=. -have{maxNQ_H} [_ _] := sigma_subgroup_embedding maxM sMq sQM qQ ntQ maxNQ_H. -have [sHq [_ st1HM [_ ntMa]] | _ [_ _ sM'MH]] := ifP; last first. - have piPp: p \in \pi(P) by rewrite -p_rank_gt0 p_rank_abelem ?dimP. - have sPMH: P \subset M :&: H by apply/subsetIP. - by have/negP[] := pnatPpi (pgroupS sPMH (pHall_pgroup sM'MH)) piPp. -have{st1HM} t1Mr: r \in \tau1(M). - by case/orP: (st1HM r t1Hr); rewrite //= (contraNF ((alpha_sub_sigma _) r)). -have aM'q: q \notin \alpha(M). - have [_ tiMaHs _] := sigma_disjoint maxM maxH not_MGH. - by apply: contraFN (tiMaHs q) => aMq; apply/andP. -have ErM_R: R \in 'E_r^1(M) by rewrite !inE sRM abelR dimR. -have: 'M('N(Q)) != [set M] by rewrite uniqNQ (inj_eq (@set1_inj _)). -case/(cent_Malpha_reg_tau1 _ _ r'q ErM_R) => //. -case=> //= ntCMaP tiCMaPQ _; case/negP: ntCMaP. -rewrite -subG1 -{}tiCMaPQ centY setICA subsetIidr /= -/Ma -/Q centsC. -apply/commG1P/three_subgroup; apply/commG1P. - by rewrite commGC (commG1P _) ?sub1G ?subsetIr. -apply: subset_trans (subsetIr Ma _); rewrite /= -symPR //. - rewrite commg_subl normsI //; last by rewrite norms_cent // cents_norm. - by rewrite (subset_trans sSM) ?gFnorm. -apply: contraR aM'q => not_cRCaP; apply: pnatPpi (pgroupS sSMz _) piSq. -by rewrite (negPf not_cRCaP) pcore_pgroup. -Qed. - -(* This is B & G, Theorem 13.5. *) -Theorem tau1_primact_Msigma E1 : \tau1(M).-Hall(E) E1 -> semiprime M`_\sigma E1. -Proof. -move=> hallE1 x /setD1P[]; rewrite -cycle_eq1 -cycle_subG => ntX sXE1. -rewrite -cent_cycle; have [sE1E t1E1 _] := and3P hallE1. -have [_ [E3 hallE3]] := ex_tau13_compl hallE. -have{hallE3} [E2 _ complEi] := ex_tau2_compl hallE hallE1 hallE3. -have [_ _ [cycE1 _] _ _ {E2 E3 complEi}] := sigma_compl_context maxM complEi. -apply/eqP; rewrite eqEsubset andbC setIS ?centS //= subsetI subsetIl /=. -have [p _ rX] := rank_witness <[x]>; rewrite -rank_gt0 {}rX in ntX. -have t1p: p \in \tau1(M) by rewrite (pnatPpi t1E1) // (piSg sXE1) -?p_rank_gt0. -have{ntX} [P EpP] := p_rank_geP ntX; have{EpP} [sPX abelP dimP] := pnElemP EpP. -have{sXE1} sPE1 := subset_trans sPX sXE1. -have{dimP} EpP: P \in 'E_p^1(E) by rewrite !inE abelP dimP (subset_trans sPE1). -apply: {x sPX abelP} subset_trans (setIS _ (centS sPX)) _; rewrite centsC. -rewrite -(Sylow_gen E1) gen_subG; apply/bigcupsP=> S; case/SylowP=> r _ sylS. -have [[sSE1 rS _] [-> | ntS]] := (and3P sylS, eqsVneq S 1); first exact: sub1G. -have [cycS sSE] := (cyclicS sSE1 cycE1, subset_trans sSE1 sE1E). -have /p_rank_geP[R ErR]: 0 < 'r_r(S) by rewrite -rank_pgroup ?rank_gt0. -have{ErR} [sRS abelR dimR] := pnElemP ErR; have sRE1 := subset_trans sRS sSE1. -have{abelR dimR} ErR: R \in 'E_r^1('C_E(P)). - rewrite !inE abelR dimR (subset_trans sRE1) // subsetI sE1E. - by rewrite sub_abelian_cent ?cyclic_abelian. -rewrite centsC (subset_trans (cent_tau1Elem_Msigma t1p EpP ErR)) //. -have [y defR]: exists y, R :=: <[y]> by apply/cyclicP; apply: cyclicS cycS. -have sylS_E: r.-Sylow(E) S. - apply: subHall_Sylow hallE1 (pnatPpi t1E1 _) (sylS). - by rewrite -p_rank_gt0 -(rank_Sylow sylS) rank_gt0. -rewrite defR cent_cycle (cyclic_primact_Msigma sylS_E cycS) ?subsetIr //. -by rewrite !inE -cycle_subG -cycle_eq1 -defR (nt_pnElem ErR). -Qed. - -(* This is B & G, Lemma 13.6. *) -(* The wording at the top of the proof is misleading: it should say: by *) -(* Corollary 12.14, it suffices to show that we can't have both q \in beta(M) *) -(* and X \notsubset M_sigma^(1). Also, the reference to 12.13 should be 12.19 *) -(* or 10.9 (we've used 12.19 here). *) -Lemma cent_cent_Msigma_tau1_uniq E1 P q X (Ms := M`_\sigma) : - \tau1(M).-Hall(E) E1 -> P \subset E1 -> P :!=: 1 -> - X \in 'E_q^1('C_Ms(P)) -> - 'M('C(X)) = [set M] /\ (forall S, q.-Sylow(Ms) S -> 'M(S) = [set M]). -Proof. -move=> hallE1 sPE1 ntP EqX; have [sE1E t1E1 _] := and3P hallE1. -rewrite (cent_semiprime (tau1_primact_Msigma hallE1)) //= -/Ms in EqX. -have{P ntP sPE1} ntE1 := subG1_contra sPE1 ntP. -have /andP[sMsM nMsM]: Ms <| M := pcore_normal _ M. -have coMsE: coprime #|Ms| #|E| := coprime_sigma_compl hallE. -have [solMs nMsE] := (solvableS sMsM (mmax_sol maxM), subset_trans sEM nMsM). -apply: cent_der_sigma_uniq => //. - by move: EqX; rewrite -(setIidPr sMsM) -setIA pnElemI => /setIP[]. -have{EqX} [[sXcMsE1 abelX _] ntX] := (pnElemP EqX, nt_pnElem EqX isT). -apply: contraR ntX => /norP[b'q not_sXMs']; rewrite -subG1. -have [S sylS nSE] := coprime_Hall_exists q nMsE coMsE solMs. -have{abelX} [[sSMs qS _] [qX _]] := (and3P sylS, andP abelX). -have sScMsE': S \subset 'C_Ms(E^`(1)). - have [H hallH cHE'] := der_compl_cent_beta' maxM hallE. - have [Q sylQ] := Sylow_exists q H; have [sQH qQ _] := and3P sylQ. - have{cHE' sQH} cQE' := centsS sQH cHE'; have sE'E := der_sub 1 E. - have [nMsE' coMsE'] := (coprimegS sE'E coMsE, subset_trans sE'E nMsE). - have{H hallH sylQ} sylQ := subHall_Sylow hallH b'q sylQ. - have nSE' := subset_trans sE'E nSE; have nQE' := cents_norm cQE'. - have [x cE'x ->] := coprime_Hall_trans coMsE' nMsE' solMs sylS nSE' sylQ nQE'. - by rewrite conj_subG // subsetI (pHall_sub sylQ) centsC. -without loss{qX} sXS: X sXcMsE1 not_sXMs' / X \subset S. - have [nMsE1 coMsE1 IH] := (subset_trans sE1E nMsE, coprimegS sE1E coMsE). - have [nSE1 [sXMs cE1X]] := (subset_trans sE1E nSE, subsetIP sXcMsE1). - have [|Q [sylQ nQE1 sXQ]] := coprime_Hall_subset nMsE1 coMsE1 solMs sXMs qX. - by rewrite cents_norm // centsC. - have [//|x cE1x defS] := coprime_Hall_trans nMsE1 _ solMs sylS nSE1 sylQ nQE1. - have Ms_x: x \in Ms by case/setIP: cE1x. - rewrite -(conjs1g x^-1) -sub_conjg IH //; last by rewrite defS conjSg. - by rewrite -(conjGid cE1x) conjSg. - by rewrite -(normsP (der_norm 1 _) x) ?conjSg. -have [sXMs cE1X] := subsetIP sXcMsE1. -have [_ [E3 hallE3]] := ex_tau13_compl hallE. -have{hallE3} [E2 hallE2 complEi] := ex_tau2_compl hallE hallE1 hallE3. -have{not_sXMs' E3 complEi} ntE2: E2 :!=: 1. - apply: contraNneq not_sXMs' => E2_1. - have [[sE3E' _] _ _ [defE _] _] := sigma_compl_context maxM complEi. - have [sCMsE_Ms' _ _] := sigma_compl_embedding maxM hallE. - have{defE} [_ defE _ _] := sdprodP defE; rewrite E2_1 sdprod1g in defE. - rewrite (subset_trans _ sCMsE_Ms') // -defE centM setIA subsetI. - by rewrite (subset_trans (subset_trans sXS sScMsE')) ?setIS ?centS. -have{ntE2 E2 hallE2} [p p_pr t2p]: exists2 p, prime p & p \in \tau2(M). - have [[p p_pr rE2] [_ t2E2 _]] := (rank_witness E2, and3P hallE2). - by exists p; rewrite ?(pnatPpi t2E2) // -p_rank_gt0 -rE2 rank_gt0. -have [A Ep2A Ep2A_M] := ex_tau2Elem hallE t2p. -have [_ _ tiCMsA _ _] := tau2_context maxM t2p Ep2A_M. -have [[nsAE _] _ _ _] := tau2_compl_context maxM hallE t2p Ep2A. -have [sAE abelA _] := pnElemP Ep2A; have [pA cAA _] := and3P abelA. -have cCAE1_X: X \subset 'C('C_A(E1)). - rewrite centsC; apply/subsetP=> y; case/setIP=> Ay cE1y. - have [-> | nty] := eqVneq y 1; first exact: group1. - have oY: #[y] = p := abelem_order_p abelA Ay nty. - have [r _ rE1] := rank_witness E1. - have{rE1} rE1: 'r_r(E1) > 0 by rewrite -rE1 rank_gt0. - have [R ErR] := p_rank_geP rE1; have{ErR} [sRE1 abelR dimR] := pnElemP ErR. - have t1r: r \in \tau1(M) by rewrite (pnatPpi t1E1) -?p_rank_gt0. - have ErR: R \in 'E_r^1(E) by rewrite !inE abelR dimR (subset_trans sRE1). - have EpY: <[y]>%G \in 'E_p^1('C_E(R)). - rewrite p1ElemE // !inE -oY eqxx subsetI (centsS sRE1) cycle_subG //=. - by rewrite (subsetP sAE). - rewrite -sub_cent1 -cent_cycle (subset_trans sXcMsE1) //. - apply: subset_trans (setIS _ (centS sRE1)) _. - rewrite -subsetIidl setIAC subsetI subsetIr andbT. - exact: cent_tau1Elem_Msigma t1r ErR EpY. -have nAE1 := subset_trans sE1E (normal_norm nsAE). -have coAE1: coprime #|A| #|E1|. - by apply: pnat_coprime pA (pi_p'group t1E1 (contraL _ t2p)); apply: tau2'1. -rewrite -tiCMsA -(coprime_cent_prod nAE1 coAE1) ?abelian_sol // centM setIA. -rewrite subsetI cCAE1_X (subset_trans (subset_trans sXS sScMsE')) ?setIS //. -by rewrite centS ?commgSS. -Qed. - -End OneComplement. - -(* This is B & G, Lemma 13.7. *) -(* We've had to plug a gap in this proof: on p. 100, l. 6-7 it is asserted *) -(* the conclusion (E1 * E3 acts in a prime manner on M_sigma) follows from *) -(* the fact that E1 and E3 have coprime orders and act in a prime manner with *) -(* the same set of fixed points. This seems to imply the following argument: *) -(* For any x \in M_sigma, *) -(* C_(E1 * E3)[x] = C_E1[x] * C_E3[x] is either E1 * E3 or 1, *) -(* i.e., E1 * E3 acts in a prime manner on M_sigma. *) -(* This is improper because the distributivity of centralisers over coprime *) -(* products only hold under normality conditions that do not hold in this *) -(* instance. The correct argument, which involves using the prime action *) -(* assumption a second time, only relies on the fact that E1 and E3 are Hall *) -(* subgroups of the group E1 * E3. The fact that E3 <| E (Lemma 12.1(a)), *) -(* implicitly needed to justify that E1 * E3 is a group, can also be used to *) -(* simplify the argument, and we do so. *) -Lemma tau13_primact_Msigma M E E1 E2 E3 : - M \in 'M -> sigma_complement M E E1 E2 E3 -> ~ semiregular E3 E1 -> - semiprime M`_\sigma (E3 <*> E1). -Proof. -move=> maxM complEi not_regE13; set Ms := M`_\sigma. -have [hallE hallE1 hallE2 hallE3 _] := complEi. -have [[sE1E t1E1 _] [sE3E t3E3 _]] := (and3P hallE1, and3P hallE3). -have [[sEM _ _] [_ t2E2 _]] := (and3P hallE, and3P hallE2). -have [[_ nsE3E] _ [_ cycE3] [defE _] tiE3cE]:= sigma_compl_context maxM complEi. -have [[_ nE3E] [sMsM nMsM]] := (andP nsE3E, andP (pcore_normal _ M : Ms <| M)). -have [P]: exists2 P, P \in 'E^1(E1) & 'C_E3(P) != 1. - apply/exists_inP; rewrite -negb_forall_in; apply/forall_inP=> regE13. - apply: not_regE13 => x /setD1P[]; rewrite -cycle_subG -cycle_eq1 -rank_gt0. - case/rank_geP=> P E1xP sXE1; apply/trivgP; move: E1xP. - rewrite /= -(setIidPr sXE1) nElemI -setIdE => /setIdP[E1_P sPX]. - by rewrite -(eqP (regE13 P E1_P)) -cent_cycle setIS ?centS. -rewrite -{1}(setIidPr sE1E) nElemI -setIdE => /setIdP[/nElemP[p EpP] sPE1]. -rewrite -{1}(setIidPl sE3E) -setIA setIC -rank_gt0 => /rank_geP[R]. -rewrite nElemI -setIdE => /setIdP[/nElemP[r ErR] sRE3]. -have t1p: p \in \tau1(M). - rewrite (pnatPpi (pgroupS sPE1 t1E1)) //= (card_p1Elem EpP). - by rewrite pi_of_prime ?inE ?(pnElem_prime EpP) //. -have prE1 := tau1_primact_Msigma maxM hallE hallE1. -have prE3 := tau3_primact_Msigma maxM hallE hallE3. -have sCsPR: 'C_Ms(P) \subset 'C_Ms(R) by apply: cent_tau1Elem_Msigma EpP ErR. -have [eqCsPR | ltCsPR] := eqVproper sCsPR. - move=> x; case/setD1P; rewrite -cycle_eq1 -cycle_subG => ntX sXE31. - apply/eqP; rewrite -cent_cycle eqEsubset andbC setIS ?centS //=. - have eqCsE13: 'C_Ms(E1) = 'C_Ms(E3). - rewrite -(cent_semiprime prE1 sPE1) ?(nt_pnElem EpP) //. - by rewrite -(cent_semiprime prE3 sRE3) ?(nt_pnElem ErR). - rewrite centY setICA eqCsE13 -setICA setIid. - have sE31E: E3 <*> E1 \subset E by apply/joing_subP. - have nE3E1 := subset_trans sE1E nE3E. - pose y := x.`_\tau1(M); have sYX: <[y]> \subset <[x]> := cycleX x _. - have sXE := subset_trans sXE31 sE31E; have sYE := subset_trans sYX sXE. - have [t1'x | not_t1'x] := boolP (\tau1(M)^'.-elt x). - rewrite (cent_semiprime prE3 _ ntX) // (sub_normal_Hall hallE3) //. - apply: pnat_dvd t3E3; rewrite -(Gauss_dvdr _ (p'nat_coprime t1'x t1E1)). - by rewrite mulnC (dvdn_trans _ (dvdn_cardMg _ _)) -?norm_joinEr ?cardSg. - have{not_t1'x} ntY: #[y] != 1%N by rewrite order_constt partn_eq1. - apply: subset_trans (setIS _ (centS sYX)) _. - have [solE nMsE] := (sigma_compl_sol hallE, subset_trans sEM nMsM). - have [u Eu sYuE1] := Hall_Jsub solE hallE1 sYE (p_elt_constt _ _). - rewrite -(conjSg _ _ u) !conjIg -!centJ (normsP nMsE) ?(normsP nE3E) //=. - by rewrite -eqCsE13 (cent_semiprime prE1 sYuE1) // trivg_card1 cardJg. -have ntCsR: 'C_Ms(R) != 1. - by rewrite -proper1G (sub_proper_trans _ ltCsPR) ?sub1G. -have ntR: R :!=: 1 by rewrite (nt_pnElem ErR). -have [cEPR abelR dimR] := pnElemP ErR; have [rR _ _] := and3P abelR. -have{cEPR} [sRE cPR] := subsetIP cEPR; have sRM := subset_trans sRE sEM. -have E2_1: E2 :=: 1. - have [x defR] := cyclicP (cyclicS sRE3 cycE3). - apply: contraNeq ntCsR; rewrite -rank_gt0; have [q _ ->] := rank_witness E2. - rewrite p_rank_gt0 defR cent_cycle. move/(pnatPpi t2E2) => t2q. - have [A Eq2A _] := ex_tau2Elem hallE t2q. - have [-> //] := tau2_regular maxM complEi t2q Eq2A. - by rewrite !inE -cycle_subG -cycle_eq1 -defR sRE3 (nt_pnElem ErR). -have nRE: E \subset 'N(R) by rewrite (char_norm_trans _ nE3E) ?sub_cyclic_char. -have [H maxNH] := mmax_exists (mFT_norm_proper ntR (mFT_pgroup_proper rR)). -have [maxH sNH] := setIdP maxNH; have sEH := subset_trans nRE sNH. -have ntCsR_P: [~: 'C_Ms(R), P] != 1. - rewrite (sameP eqP commG1P); apply: contra (proper_subn ltCsPR). - by rewrite subsetI subsetIl. -have sCsR_MsH: 'C_Ms(R) \subset Ms :&: H. - exact: setIS Ms (subset_trans (cent_sub R) sNH). -have ntMsH_P: [~: Ms :&: H, P] != 1 by rewrite (subG1_contra _ ntCsR_P) ?commSg. -have tiE1cMsH: 'C_E1(Ms :&: H) = 1. - apply: contraNeq (proper_subn ltCsPR) => ntCE1MsH. - rewrite (cent_semiprime prE1 sPE1) ?(nt_pnElem EpP) //. - rewrite -(cent_semiprime prE1 (subsetIl _ _) ntCE1MsH) /=. - by rewrite subsetI subsetIl centsC subIset // orbC centS. -have t3r: r \in \tau3(M). - by rewrite (pnatPpi t3E3) ?(piSg sRE3) // -p_rank_gt0 p_rank_abelem ?dimR. -have t13r: (r \in \tau1(M)) || (r \in \tau3(M)) by rewrite t3r orbT. -have [sE1H sRH] := (subset_trans sE1E sEH, subset_trans sRE sEH). -have [_ ct1H'R [|sHr _]] := cent_norm_tau13_mmax maxM hallE t13r sRM rR maxNH. - rewrite (subG1_contra _ ntMsH_P) // commgS // (subset_trans sPE1) //. - by rewrite subsetI (subset_trans sE1E). -have t1H_E1: \tau1(H).-group E1. - apply/pgroupP=> q q_pr /Cauchy[] // x E1x ox. - apply: contraLR (prime_gt1 q_pr) => t1H'q; rewrite -ox cardG_gt1 negbK. - rewrite -subG1 -tiE1cMsH subsetI cycle_subG E1x /= ct1H'R //. - by rewrite (setIidPl sEH) cycle_subG (subsetP sE1E). - by rewrite /pgroup -orderE ox pnatE. -have sH'_E1: \sigma(H)^'.-group E1 by apply: sub_pgroup t1H_E1 => q /andP[]. -have [F hallF sE1F] := Hall_superset (mmax_sol maxH) sE1H sH'_E1. -have [F1 hallF1 sE1F1] := Hall_superset (sigma_compl_sol hallF) sE1F t1H_E1. -have{sHr} sRHs: R \subset H`_\sigma. - by rewrite (sub_Hall_pcore (Msigma_Hall maxH)) ?(pi_pgroup rR). -have cRE1: E1 \subset 'C(R). - rewrite centsC (centsS sE1F1) // -subsetIidl subsetI subxx -sRHs -subsetI. - have prF1 := tau1_primact_Msigma maxH hallF hallF1. - rewrite -(cent_semiprime prF1 (subset_trans sPE1 sE1F1)); last first. - exact: nt_pnElem EpP _. - by rewrite subsetI sRHs. -case/negP: ntR; rewrite -subG1 -tiE3cE subsetI sRE3 centsC -(sdprodW defE). -by rewrite E2_1 sdprod1g mul_subG // sub_abelian_cent ?cyclic_abelian. -Qed. - -(* This is B & G, Lemma 13.8. *) -(* We had to plug a significant hole in the proof text: in the sixth *) -(* paragraph of the proof, it is asserted that because M = N_M(Q)M_alpha and *) -(* r is in pi(C_M(P)), P centralises some non-trivial r-subgroup of N_M(Q). *) -(* This does not seem to follow directly, even taking into account that r is *) -(* not in alpha(M): while it is true that N_M(Q) contains a Sylow r-subgroup *) -(* of M, this subgroup does not need to contain an r-group centralized by P. *) -(* We can only establish the required result by making use of the fact that M *) -(* has a normal p-complement K (because p is in tau_1(M)), as then N_K(Q) *) -(* will contain a p-invariant Sylow r-subgroup S of K and M (coprime action) *) -(* and then any r-subgroup of M centralised by P will be in K, and hence *) -(* conjugate in C_K(P) to a subgroup of S (coprime action again). *) -Lemma tau1_mmaxI_asymmetry M Mstar p P q Q q_star Qstar : - (*1*) [/\ M \in 'M, Mstar \in 'M & gval Mstar \notin M :^: G] -> - (*2*) [/\ p \in \tau1(M), p \in \tau1(Mstar) & P \in 'E_p^1(M :&: Mstar)] -> - (*3*) [/\ q.-Sylow(M :&: Mstar) Q, q_star.-Sylow(M :&: Mstar) Qstar, - P \subset 'N(Q) & P \subset 'N(Qstar)] -> - (*4*) 'C_Q(P) = 1 /\ 'C_Qstar(P) = 1 -> - (*5*) 'N(Q) \subset Mstar /\ 'N(Qstar) \subset M -> - False. -Proof. -move: Mstar q_star Qstar => L u U. (* Abbreviate Mstar by L, Qstar by U. *) -move=> [maxM maxL notMGL] [t1Mp t1Lp EpP] [sylQ sylU nQP nUP]. -move=> [regPQ regPU] [sNQL sNUM]; rewrite setIC in sylU. (* for symmetry *) -have notLGM: gval M \notin L :^: G by rewrite orbit_sym. (* for symmetry *) -have{EpP} [ntP [sPML abelP dimP]] := (nt_pnElem EpP isT, pnElemP EpP). -have{sPML} [[sPM sPL] [pP _ _]] := (subsetIP sPML, and3P abelP). -have solCP: solvable 'C(P) by rewrite mFT_sol ?mFT_cent_proper. -pose Qprops M q Q := [&& q.-Sylow(M) Q, q != p, q \notin \beta(M), - 'C_(M`_\beta)(P) != 1 & 'C_(M`_\beta)(P <*> Q) == 1]. -have{sylQ sylU} [hypQ hypU]: Qprops M q Q /\ Qprops L u U. - apply/andP; apply/nandP=> not_hypQ. - without loss{not_hypQ}: L u U M q Q maxM maxL notMGL notLGM t1Mp t1Lp sPM sPL - sylQ sylU nQP nUP regPQ regPU sNQL sNUM / ~~ Qprops M q Q. - - by move=> IH; case: not_hypQ; [apply: (IH L u U) | apply: (IH M q Q)]. - case/and5P; have [_ qQ _] := and3P sylQ. - have{sylQ} sylQ: q.-Sylow(M) Q. - by rewrite -Sylow_subnorm -(setIidPr sNQL) setIA Sylow_subnorm. - have ntQ: Q :!=: 1. - by apply: contraTneq sNQL => ->; rewrite norm1 proper_subn ?mmax_proper. - have p'q: q != p. - apply: contraNneq ntQ => def_q; rewrite (trivg_center_pgroup qQ) //. - apply/trivgP; rewrite -regPQ setIS // centS //. - by rewrite (norm_sub_max_pgroup (Hall_max sylQ)) ?def_q. - have EpP: P \in 'E_p^1(M) by apply/pnElemP. - have [|_ [// | abM]] := cent_Malpha_reg_tau1 maxM t1Mp p'q EpP ntQ nQP regPQ. - apply: contraNneq notMGL => uniqNQ. - by rewrite (eq_uniq_mmax uniqNQ) ?orbit_refl. - by rewrite joingC /alpha_core abM !(eq_pcore _ abM) => _ -> -> ->. -have bML_CMbP: forall M L, [predU \beta(M) & \beta(L)].-group 'C_(M`_\beta)(P). - move=> ? ?; apply: pgroupS (subsetIl _ _) (sub_pgroup _ (pcore_pgroup _ _)). - by move=> ?; rewrite !inE => ->. -have [H hallH sCMbP_H] := Hall_superset solCP (subsetIr _ _) (bML_CMbP M L). -have [[s _ rFH] [cPH bH _]] := (rank_witness 'F(H), and3P hallH). -have{sCMbP_H rFH cPH} piFHs: s \in \pi('F(H)). - rewrite -p_rank_gt0 -rFH rank_gt0 (trivg_Fitting (solvableS cPH solCP)). - by rewrite (subG1_contra sCMbP_H) //; case/and5P: hypQ. -without loss{bH} bMs: L u U M q Q maxM maxL notMGL notLGM t1Mp t1Lp sPM sPL - nQP nUP regPQ regPU sNQL sNUM hypQ hypU hallH / s \in \beta(M). -- move=> IH; have:= pnatPpi bH (piSg (Fitting_sub H) piFHs). - case/orP; [apply: IH hypQ hypU hallH | apply: IH hypU hypQ _] => //. - by apply: etrans (eq_pHall _ _ _) hallH => ?; apply: orbC. -without loss{bML_CMbP} sCMbP_H: H hallH piFHs / 'C_(M`_\beta)(P) \subset H. - have [x cPx sCMbP_Hx] := Hall_subJ solCP hallH (subsetIr _ _) (bML_CMbP M L). - by move=> IH; apply: IH sCMbP_Hx; rewrite ?pHallJ //= FittingJ cardJg. -pose X := 'O_s(H); have sylX := nilpotent_pcore_Hall s (Fitting_nil H). -have{piFHs sylX} ntX: X != 1. - by rewrite -rank_gt0 /= -p_core_Fitting (rank_Sylow sylX) p_rank_gt0. -have [[cPH bH _] [sXH nXH]] := (and3P hallH, andP (pcore_normal s H : X <| H)). -have [cPX sX] := (subset_trans sXH cPH, pcore_pgroup s H : s.-group X). -have{hypQ} [sylQ p'q bM'q ntCMbP] := and5P hypQ; apply: negP. -apply: subG1_contra (ntX); rewrite /= centY !subsetI (subset_trans _ cPH) //=. -have nsMbM : M`_\beta <| M := pcore_normal _ M; have [sMbM nMbM] := andP nsMbM. -have hallMb := Mbeta_Hall maxM; have [_ bMb _] := and3P hallMb. -have{ntX} sHM: H \subset M. - have [g sXMg]: exists g, X \subset M :^ g. - have [S sylS] := Sylow_exists s M`_\beta; have [sSMb _ _] := and3P sylS. - have sylS_G := subHall_Sylow (Mbeta_Hall_G maxM) bMs sylS. - have [g _ sXSg] := Sylow_subJ sylS_G (subsetT X) sX. - by exists g; rewrite (subset_trans sXSg) // conjSg (subset_trans sSMb). - have [t _ rFC] := rank_witness 'F('C_(M`_\beta)(P)). - pose Y := 'O_t('C_(M`_\beta)(P)). - have [sYC tY] := (pcore_sub t _ : Y \subset _, pcore_pgroup t _ : t.-group Y). - have sYMb := subset_trans sYC (subsetIl _ _); have bMY := pgroupS sYMb bMb. - have{rFC} ntY: Y != 1. - rewrite -rank_gt0 /= -p_core_Fitting. - rewrite (rank_Sylow (nilpotent_pcore_Hall t (Fitting_nil _))) -rFC. - by rewrite rank_gt0 (trivg_Fitting (solvableS (subsetIr _ _) solCP)). - have bMt: t \in \beta(M). - by rewrite (pnatPpi bMY) // -p_rank_gt0 -rank_pgroup ?rank_gt0. - have sHMg: H \subset M :^ g. - rewrite (subset_trans nXH) // beta_norm_sub_mmax ?mmaxJ // /psubgroup sXMg. - by rewrite (pi_pgroup sX) 1?betaJ. - have sYMg: Y \subset M :^ g := subset_trans (subset_trans sYC sCMbP_H) sHMg. - have sNY_M: 'N(Y) \subset M. - by rewrite beta_norm_sub_mmax // /psubgroup (subset_trans sYMb). - have [_ trCY _] := sigma_group_trans maxM (beta_sub_sigma maxM bMt) tY. - have [|| h cYh /= defMg] := (atransP2 trCY) M (M :^ g). - - by rewrite inE orbit_refl (subset_trans (normG _) sNY_M). - - by rewrite inE mem_orbit ?in_setT. - by rewrite defMg conjGid // (subsetP sNY_M) ?(subsetP (cent_sub _)) in sHMg. -have sXMb: X \subset M`_\beta. - by rewrite (sub_Hall_pcore hallMb) ?(subset_trans sXH sHM) ?(pi_pgroup sX). -rewrite sXMb (sameP commG1P eqP) /= -/X -subG1. -have [sQL [sQM qQ _]] := (subset_trans (normG Q) sNQL, and3P sylQ). -have nsLbL : L`_\beta <| L := pcore_normal _ L; have [sLbL nLbL] := andP nsLbL. -have nLbQ := subset_trans sQL nLbL. -have [<- ti_aLsM _] := sigma_disjoint maxL maxM notLGM. -rewrite subsetI (subset_trans _ (Mbeta_sub_Msigma maxM)) ?andbT; last first. - by rewrite (subset_trans (commgSS sXMb sQM)) // commg_subl nMbM. -have defQ: [~: Q, P] = Q. - rewrite -{2}(coprime_cent_prod nQP) ?(pgroup_sol qQ) ?regPQ ?mulg1 //. - by rewrite (p'nat_coprime (pi_pnat qQ _) pP). -suffices sXL: X \subset L. - apply: subset_trans (Mbeta_sub_Malpha L). - rewrite -quotient_sub1 ?comm_subG ?quotientR ?(subset_trans _ nLbL) //. - have <-: (M`_\beta :&: L) / L`_\beta :&: 'O_q(L^`(1) / L`_\beta) = 1. - rewrite coprime_TIg // coprime_morphl // (coprimeSg (subsetIl _ _)) //. - exact: pnat_coprime (pcore_pgroup _ _) (pi_pnat (pcore_pgroup _ _) _). - rewrite commg_subI // subsetI. - rewrite quotientS /=; last by rewrite subsetI sXMb. - by rewrite quotient_der ?gFnorm_trans ?normsG ?quotientS. - rewrite (sub_Hall_pcore (nilpotent_pcore_Hall _ (Mbeta_quo_nil _))) //. - rewrite quotient_pgroup ?quotient_norms //. - by rewrite normsI ?(subset_trans sQM nMbM) ?normsG. - by rewrite quotientS // -defQ commgSS // (subset_trans nQP). -have{hypU} [r bLr piHr]: exists2 r, r \in \beta(L) & r \in \pi(H). - have [_ _ _] := and5P hypU; rewrite -rank_gt0. - have [r _ ->] := rank_witness 'C_(L`_\beta)(P); rewrite p_rank_gt0 => piCr _. - have [piLb_r piCPr] := (piSg (subsetIl _ _) piCr, piSg (subsetIr _ _) piCr). - have bLr: r \in \beta(L) := pnatPpi (pcore_pgroup _ L) piLb_r. - exists r; rewrite //= (card_Hall hallH) pi_of_part // inE /= piCPr. - by rewrite inE /= bLr orbT. -have sM'r: r \notin \sigma(M). - by apply: contraFN (ti_aLsM r) => sMr; rewrite inE /= beta_sub_alpha. -have defM: M`_\beta * 'N_M(Q) = M. - have nMbQ := subset_trans sQM nMbM. - have nsMbQ_M: M`_\beta <*> Q <| M. - rewrite -{2}(quotientGK nsMbM) -quotientYK ?cosetpre_normal //. - suffices ->: Q / M`_\beta = 'O_q(M^`(1) / M`_\beta). - by rewrite quotient_der ?nMbM ?gFnormal_trans. - apply: nilpotent_Hall_pcore; first exact: Mbeta_quo_nil. - rewrite quotient_pHall // (pHall_subl _ _ sylQ) ?gFsub //. - by rewrite -defQ commgSS // (subset_trans nUP). - have sylQ_MbQ := pHall_subl (joing_subr _ Q) (normal_sub nsMbQ_M) sylQ. - rewrite -{3}(Frattini_arg nsMbQ_M sylQ_MbQ) /= norm_joinEr // -mulgA. - by congr (_ * _); rewrite mulSGid // subsetI sQM normG. -have [[sM'p _ not_pM'] [sL'p _]] := (and3P t1Mp, andP t1Lp). -have{not_pM'} [R ErR nQR]: exists2 R, R \in 'E_r^1('C_M(P)) & R \subset 'N(Q). - have p'r: r \in p^' by apply: contraNneq sL'p => <-; apply: beta_sub_sigma. - have p'M': p^'.-group M^`(1). - by rewrite p'groupEpi mem_primes (negPf not_pM') !andbF. - pose K := 'O_p^'(M); have [sKM nKM] := andP (pcore_normal _ M : K <| M). - have hallK: p^'.-Hall(M) K. - rewrite -(pquotient_pHall _ (der_normal 1 M)) ?quotient_pgroup //. - rewrite -pquotient_pcore ?der_normal // nilpotent_pcore_Hall //. - by rewrite abelian_nil ?der_abelian. - by rewrite (normalS _ sKM) ?pcore_max ?der_normal. - have sMbK: M`_\beta \subset K. - by rewrite (subset_trans (Mbeta_der1 maxM)) // pcore_max ?der_normal. - have coKP: coprime #|K| #|P| := p'nat_coprime (pcore_pgroup _ M) pP. - have [solK sNK] := (solvableS sKM (mmax_sol maxM), subsetIl K 'N(Q)). - have [nKP coNP] := (subset_trans sPM nKM, coprimeSg sNK coKP). - have nNP: P \subset 'N('N_K(Q)) by rewrite normsI // norms_norm. - have [S sylS nSP] := coprime_Hall_exists r nNP coNP (solvableS sNK solK). - have /subsetIP[sSK nQS]: S \subset 'N_K(Q) := pHall_sub sylS. - have sylS_K: r.-Sylow(K) S. - rewrite pHallE sSK /= -/K -(setIidPr sKM) -defM -group_modl // setIAC. - rewrite (setIidPr sKM) -LagrangeMr partnM // -(card_Hall sylS). - rewrite part_p'nat ?mul1n 1?(pnat_dvd (dvdn_indexg _ _)) //. - by apply: (pi_p'nat bMb); apply: contra sM'r; apply: beta_sub_sigma. - have rC: 'r_r('C_M(P)) > 0 by rewrite p_rank_gt0 (piSg _ piHr) // subsetI sHM. - have{rC} [R ErR] := p_rank_geP rC; have [sRcMP abelR _] := pnElemP ErR. - have{sRcMP abelR} [[sRM cPR] [rR _]] := (subsetIP sRcMP, andP abelR). - have nRP: P \subset 'N(R) by rewrite cents_norm 1?centsC. - have sRK: R \subset K by rewrite sub_Hall_pcore ?(pi_pgroup rR). - have [T [sylT nTP sRT]] := coprime_Hall_subset nKP coKP solK sRK rR nRP. - have [x cKPx defS] := coprime_Hall_trans nKP coKP solK sylS_K nSP sylT nTP. - rewrite -(conjGid (subsetP (setSI _ sKM) x cKPx)). - by exists (R :^ x)%G; rewrite ?pnElemJ ?(subset_trans _ nQS) // defS conjSg. -have [sRcMP abelR _] := pnElemP ErR; have ntR := nt_pnElem ErR isT. -have{sRcMP abelR} [[sRM cPR] [rR _]] := (subsetIP sRcMP, andP abelR). -have sNR_L: 'N(R) \subset L. - by rewrite beta_norm_sub_mmax /psubgroup ?(subset_trans nQR) ?(pi_pgroup rR). -have sPR_M: P <*> R \subset M by rewrite join_subG (subset_trans nUP). -have sM'_PR: \sigma(M)^'.-group (P <*> R). - by rewrite cent_joinEr // pgroupM (pi_pgroup rR) // (pi_pgroup pP). -have [E hallE sPRE] := Hall_superset (mmax_sol maxM) sPR_M sM'_PR. -have{sPRE} [sPE sRE] := joing_subP sPRE. -have EpP: P \in 'E_p^1(E) by apply/pnElemP. -have{ErR} ErR: R \in 'E_r^1('C_E(P)). - by rewrite -(setIidPr (pHall_sub hallE)) setIAC pnElemI inE ErR inE. -apply: subset_trans (cents_norm (subset_trans _ (subsetIr M`_\sigma _))) sNR_L. -apply: subset_trans (cent_tau1Elem_Msigma maxM hallE t1Mp EpP ErR). -by rewrite subsetI cPX (subset_trans sXMb) ?Mbeta_sub_Msigma. -Qed. - -(* This is B & G, Theorem 13.9. *) -Theorem sigma_partition M Mstar : - M \in 'M -> Mstar \in 'M -> gval Mstar \notin M :^: G -> - [predI \sigma(M) & \sigma(Mstar)] =i pred0. -Proof. -move: Mstar => L maxM maxL notMGL q; apply/andP=> [[/= sMq sLq]]. -have [E hallE] := ex_sigma_compl maxM; have [sEM sM'E _] := and3P hallE. -have [_ _ nMsE _] := sdprodP (sdprod_sigma maxM hallE). -have coMsE: coprime #|M`_\sigma| #|E| := pnat_coprime (pcore_pgroup _ _) sM'E. -have [|S sylS nSE] := coprime_Hall_exists q nMsE coMsE. - exact: solvableS (pcore_sub _ _) (mmax_sol maxM). -have [sSMs qS _] := and3P sylS. -have sylS_M := subHall_Sylow (Msigma_Hall maxM) sMq sylS. -have ntS: S :!=: 1. - by rewrite -rank_gt0 (rank_Sylow sylS_M) p_rank_gt0 sigma_sub_pi. -without loss sylS_L: L maxL sLq notMGL / q.-Sylow(L) S. - have sylS_G := sigma_Sylow_G maxM sMq sylS_M. - have [T sylT] := Sylow_exists q L; have sylT_G := sigma_Sylow_G maxL sLq sylT. - have [x Gx ->] := Sylow_trans sylT_G (sigma_Sylow_G maxM sMq sylS_M). - case/(_ (L :^ x)%G); rewrite ?mmaxJ ?sigmaJ ?pHallJ2 //. - by rewrite (orbit_transl _ (mem_orbit 'Js L Gx)). -have [[sSL _] [[E1 hallE1] [E3 hallE3]]] := (andP sylS_L, ex_tau13_compl hallE). -have [E2 hallE2 complEi] := ex_tau2_compl hallE hallE1 hallE3. -have E2_1: E2 :==: 1. - apply: contraR ntS; rewrite -rank_gt0; have [p _ ->] := rank_witness E2. - rewrite p_rank_gt0 => /(pnatPpi (pHall_pgroup hallE2))t2p. - have [A Ep2A _] := ex_tau2Elem hallE t2p. - have [_ _ _ ti_sM] := tau2_compl_context maxM hallE t2p Ep2A. - rewrite -subG1; have [<- _] := ti_sM L maxL notMGL; rewrite subsetI sSMs /=. - by rewrite (sub_Hall_pcore (Msigma_Hall maxL) sSL) (pi_pgroup qS). -have: E1 :!=: 1 by have [_ -> //] := sigma_compl_context maxM complEi. -rewrite -rank_gt0; have [p _ ->] := rank_witness E1; case/p_rank_geP=> P EpP. -have [[sPE1 abelP dimP] [sE1E t1E1 _]] := (pnElemP EpP, and3P hallE1). -have ntP: P :!=: 1 by rewrite (nt_pnElem EpP). -have piPp: p \in \pi(P) by rewrite -p_rank_gt0 ?p_rank_abelem ?dimP. -have t1Mp: p \in \tau1(M) by rewrite (pnatPpi _ (piSg sPE1 _)). -have sPE := subset_trans sPE1 sE1E; have sPM := subset_trans sPE sEM. -have [sNM sNL] := (norm_sigma_Sylow sMq sylS_M, norm_sigma_Sylow sLq sylS_L). -have nSP := subset_trans sPE nSE; have sPL := subset_trans nSP sNL. -have regPS: 'C_S(P) = 1. - apply: contraNeq (contra_orbit _ _ notMGL); rewrite -rank_gt0. - rewrite (rank_pgroup (pgroupS _ qS)) ?subsetIl //; case/p_rank_geP=> Q /=. - rewrite -(setIidPr sSMs) setIAC pnElemI; case/setIdP=> EqQ _. - have [_ uniqSq] := cent_cent_Msigma_tau1_uniq maxM hallE hallE1 sPE1 ntP EqQ. - by rewrite (eq_uniq_mmax (uniqSq S sylS) maxL sSL). -have t1Lp: p \in \tau1(L). - have not_cMsL_P: ~~ (P \subset 'C(M`_\sigma :&: L)). - apply: contra ntS => cMsL_P; rewrite -subG1 -regPS subsetIidl centsC. - by rewrite (subset_trans cMsL_P) ?centS // subsetI sSMs. - apply: contraR (not_cMsL_P) => t1L'p. - have [piEp piLp] := (piSg sPE piPp, piSg sPL piPp). - have [] := Msigma_setI_mmax_central maxM hallE maxL piEp piLp t1L'p _ notMGL. - apply: contraNneq not_cMsL_P; move/commG1P; rewrite centsC. - by apply: subset_trans; rewrite subsetI sPM. - by move->; rewrite ?(abelem_pgroup abelP) // subsetI sPM. -case: (@tau1_mmaxI_asymmetry M L p P q S q S) => //. - by rewrite !inE subsetI sPM sPL abelP dimP. -by rewrite (pHall_subl _ (subsetIl M L) sylS_M) // subsetI (pHall_sub sylS_M). -Qed. - -(* This is B & G, Theorem 13.10. *) -Theorem tau13_regular M E E1 E2 E3 p P : - M \in 'M -> sigma_complement M E E1 E2 E3 -> - P \in 'E_p^1(E1) -> ~~ (P \subset 'C(E3)) -> - [/\ (*a*) semiregular E3 E1, - (*b*) semiregular M`_\sigma E3 - & (*c*) 'C_(M`_\sigma)(P) != 1]. -Proof. -move=> maxM complEi EpP not_cE3P. -have nsMsM: M`_\sigma <| M := pcore_normal _ M; have [sMsM nMsM] := andP nsMsM. -have [hallMs sMaMs] := (Msigma_Hall maxM, Malpha_sub_Msigma maxM). -have [[sE3E' nsE3E] _ [_ cycE3] _ _] := sigma_compl_context maxM complEi. -have [hallE hallE1 _ hallE3] := complEi. -have [[_ sM_Ms _] [sEM sM'E _]] := (and3P hallMs, and3P hallE). -have [[sE1E t1E1 _] [sE3E t3E3 _] _] := (and3P hallE1, and3P hallE3). -have [sPE1 abelP dimP] := pnElemP EpP; have [pP _ _] := and3P abelP. -have [ntP t1MP] := (nt_pnElem EpP isT, pgroupS sPE1 t1E1). -have sPE := subset_trans sPE1 sE1E; have sPM := subset_trans sPE sEM. -have piPp: p \in \pi(P) by rewrite -p_rank_gt0 p_rank_abelem ?dimP. -have t1Mp: p \in \tau1(M) := pnatPpi t1MP piPp. -have [Q sylQ not_cPQ]: exists2 Q, Sylow E3 (gval Q) & ~~ (P \subset 'C(Q)). - apply/exists_inP; rewrite -negb_forall_in; apply: contra not_cE3P. - move/forall_inP=> cPE3; rewrite centsC -(Sylow_gen E3) gen_subG. - by apply/bigcupsP=> Q sylQ; rewrite centsC cPE3. -have{sylQ} [q q_pr sylQ] := SylowP _ _ sylQ; have [sQE3 qQ _] := and3P sylQ. -have ntQ: Q :!=: 1 by apply: contraNneq not_cPQ => ->; apply: cents1. -have t3Mq: q \in \tau3(M). - by rewrite (pnatPpi t3E3) // -p_rank_gt0 -(rank_Sylow sylQ) rank_gt0. -have nQP: P \subset 'N(Q). - rewrite (subset_trans sPE) ?normal_norm //. - by rewrite (char_normal_trans _ nsE3E) ?sub_cyclic_char. -have regPQ: 'C_Q(P) = 1. - apply: contraNeq not_cPQ; rewrite setIC => /meet_Ohm1. - rewrite setIC => /prime_meetG/=/implyP. - rewrite (Ohm1_cyclic_pgroup_prime (cyclicS sQE3 cycE3) qQ) // q_pr centsC. - apply: (coprime_odd_faithful_Ohm1 qQ) nQP _ (mFT_odd _). - exact: sub_pnat_coprime tau3'1 (pgroupS sQE3 t3E3) t1MP. -have sQE' := subset_trans sQE3 sE3E'. -have sQM := subset_trans (subset_trans sQE3 sE3E) sEM. -have [L maxNL] := mmax_exists (mFT_norm_proper ntQ (mFT_pgroup_proper qQ)). -have [maxL sNQL] := setIdP maxNL; have sQL := subset_trans (normG Q) sNQL. -have notMGL: gval L \notin M :^: G. - by apply: mmax_norm_notJ maxM maxL qQ sQM sNQL _; rewrite t3Mq !orbT. -have [ntCMaP tiCMaQP]: 'C_(M`_\alpha)(P) != 1 /\ 'C_(M`_\alpha)(Q <*> P) = 1. - have EpMP: P \in 'E_p^1(M) by apply/pnElemP. - have p'q: q != p by apply: contraNneq (tau3'1 t1Mp) => <-. - have [|_ [] //] := cent_Malpha_reg_tau1 maxM t1Mp p'q EpMP ntQ nQP regPQ. - by apply: contraTneq maxNL => ->; rewrite inE (contra_orbit _ _ notMGL). - have sM'q: q \in \sigma(M)^' by case/andP: t3Mq. - exact: subHall_Sylow hallE sM'q (subHall_Sylow hallE3 t3Mq sylQ). -split=> [x E1x | x E3x |]; last exact: subG1_contra (setSI _ sMaMs) ntCMaP. - apply: contraNeq ntCMaP => ntCE3X. - have prE31: semiprime M`_\sigma (E3 <*> E1). - apply: tau13_primact_Msigma maxM complEi _ => regE13. - by rewrite regE13 ?eqxx in ntCE3X. - rewrite -subG1 -tiCMaQP /= -(setIidPl sMaMs) -!setIA setIS //. - rewrite (cent_semiprime prE31 _ ntP) ?setIS ?centS //=. - by rewrite -!genM_join genS ?mulgSS. - by rewrite sub_gen // subsetU // sPE1 orbT. -have prE3 := tau3_primact_Msigma maxM hallE hallE3. -apply/eqP; apply/idPn; rewrite prE3 {x E3x}// -rank_gt0. -have [u _ -> ruC] := rank_witness 'C_(M`_\sigma)(E3). -have sCMs := subsetIl M`_\sigma 'C(E3). -have sMu: u \in \sigma(M) by rewrite (pnatPpi (pgroupS sCMs _)) -?p_rank_gt0. -have nCE: E \subset 'N('C_(M`_\sigma)(E3)). - by rewrite normsI ?norms_cent ?(normal_norm nsE3E) // (subset_trans sEM). -have coCE := coprimeSg sCMs (pnat_coprime (pcore_pgroup _ _) sM'E). -have solC := solvableS (subset_trans sCMs sMsM) (mmax_sol maxM). -have{nCE coCE solC} [U sylU nUE] := coprime_Hall_exists u nCE coCE solC. -have ntU: U :!=: 1 by rewrite -rank_gt0 (rank_Sylow sylU). -have cMsL_Q: Q \subset 'C(M`_\sigma :&: L). - have t13q: (q \in \tau1(M)) || (q \in \tau3(M)) by rewrite t3Mq orbT. - have [-> //] := cent_norm_tau13_mmax maxM hallE t13q sQM qQ maxNL. - by rewrite subsetI sQM. -rewrite /= -(cent_semiprime prE3 sQE3 ntQ) in sylU. -have [sUMs cQU] := subsetIP (pHall_sub sylU). -have{cMsL_Q} sylU_MsL: u.-Sylow(M`_\sigma :&: L) U. - apply: pHall_subl sylU; last by rewrite subsetI subsetIl centsC. - by rewrite subsetI sUMs (subset_trans (cents_norm _) sNQL). -have sylU_ML: u.-Sylow(M :&: L) U. - apply: subHall_Sylow sMu sylU_MsL. - by rewrite /= -(setIidPl sMsM) -setIA (setI_normal_Hall nsMsM) ?subsetIl. -have [sUML uU _] := and3P sylU_ML; have{sUML} [sUM sUL] := subsetIP sUML. -have [sNUM regPU]: 'N(U) \subset M /\ 'C_U(P) = 1. - have [bMu | bM'u] := boolP (u \in \beta(M)). - have [bM_U sMbMa] := (pi_pgroup uU bMu, Mbeta_sub_Malpha M). - split; first by rewrite beta_norm_sub_mmax /psubgroup ?sUM. - apply/trivgP; rewrite -tiCMaQP centY setIA setSI // subsetI cQU. - by rewrite (subset_trans _ sMbMa) // (sub_Hall_pcore (Mbeta_Hall maxM)). - have sylU_Ms: u.-Sylow(M`_\sigma) U. - have [H hallH cHE'] := der_compl_cent_beta' maxM hallE. - rewrite pHallE sUMs (card_Hall sylU) eqn_dvd. - rewrite partn_dvd ?cardG_gt0 ?cardSg ?subsetIl //=. - rewrite -(@partn_part u \beta(M)^') => [|v /eqnP-> //]. - rewrite -(card_Hall hallH) partn_dvd ?cardG_gt0 ?cardSg //. - by rewrite subsetI (pHall_sub hallH) centsC (subset_trans sQE'). - split; first exact: norm_sigma_Sylow (subHall_Sylow hallMs sMu sylU_Ms). - apply: contraNeq (contra_orbit _ _ notMGL); rewrite -rank_gt0. - rewrite (rank_pgroup (pgroupS _ uU)) ?subsetIl // => /p_rank_geP[X] /=. - rewrite -(setIidPr sUMs) setIAC pnElemI -setIdE => /setIdP[EuX sXU]. - have [_ uniqU] := cent_cent_Msigma_tau1_uniq maxM hallE hallE1 sPE1 ntP EuX. - by rewrite (eq_uniq_mmax (uniqU U sylU_Ms) maxL). -have sPL := subset_trans nQP sNQL. -have sPML: P \subset M :&: L by apply/subsetIP. -have t1Lp: p \in \tau1(L). - have not_cMsL_P: ~~ (P \subset 'C(M`_\sigma :&: L)). - apply: contra ntU => cMsL_P; rewrite -subG1 -regPU subsetIidl. - by rewrite centsC (centsS (pHall_sub sylU_MsL)). - apply: contraR (not_cMsL_P) => t1L'p. - have [piEp piLp] := (piSg sPE piPp, piSg sPL piPp). - case: (Msigma_setI_mmax_central maxM hallE maxL piEp piLp) => // [|->] //. - apply: contraNneq not_cMsL_P => /commG1P. - by rewrite centsC; apply: subset_trans sPML. -have EpMLP: P \in 'E_p^1(M :&: L) by apply/pnElemP. -case: (@tau1_mmaxI_asymmetry M L p P q Q u U) => //. -have [sylQ_E [sM'q _]] := (subHall_Sylow hallE3 t3Mq sylQ, andP t3Mq). -have sylQ_M := subHall_Sylow hallE sM'q sylQ_E. -have sQML: Q \subset M :&: L by apply/subsetIP. -by rewrite (subset_trans sPE nUE) (pHall_subl sQML _ sylQ_M) ?subsetIl. -Qed. - -(* This is B & G, Corollary 13.11. *) -Corollary tau13_nonregular M E E1 E2 E3 : - M \in 'M -> sigma_complement M E E1 E2 E3 -> ~ semiregular M`_\sigma E3 -> - [/\ (*a*) E1 :!=: 1, - (*b*) E3 ><| E1 = E, - (*c*) semiprime M`_\sigma E - & (*d*) forall X, X \in 'E^1(E) -> X <| E]. -Proof. -move=> maxM complEi not_regE3Ms. -have [hallE hallE1 hallE2 hallE3 _] := complEi. -have [[sE1E t1E1 _] [sE3E t3E3 _]] := (and3P hallE1, and3P hallE3). -have{hallE2} E2_1: E2 :==: 1. - apply/idPn; rewrite -rank_gt0; have [p _ ->] := rank_witness E2. - rewrite p_rank_gt0 => /(pnatPpi (pHall_pgroup hallE2))t2p. - have [A Ep2A _] := ex_tau2Elem hallE t2p. - by apply: not_regE3Ms; case: (tau2_regular maxM complEi t2p Ep2A). -have [_ ntE1 [cycE1 cycE3] [defE _] _] := sigma_compl_context maxM complEi. -rewrite (eqP E2_1) sdprod1g in defE; have{ntE1} ntE1 := ntE1 E2_1. -have [nsE3E _ mulE31 nE31 _] := sdprod_context defE. -have cE3E1 P: P \in 'E^1(E1) -> P \subset 'C(E3). - by case/nElemP=> p EpP; apply/idPn => /(tau13_regular maxM complEi EpP)[]. -split=> // [|X EpX]. - rewrite -mulE31 -norm_joinEr //. - have [-> | ntE3] := eqsVneq E3 1. - by rewrite joing1G; apply: (tau1_primact_Msigma maxM hallE hallE1). - apply: tau13_primact_Msigma maxM complEi _ => regE13. - have:= ntE1; rewrite -rank_gt0; case/rank_geP=> P EpP. - have cPE3: E3 \subset 'C(P) by rewrite centsC cE3E1. - have [p Ep1P] := nElemP EpP; have [sPE1 _ _] := pnElemP Ep1P. - have ntP: P :!=: 1 by apply: (nt_pnElem Ep1P). - by case/negP: ntE3; rewrite -(setIidPl cPE3) (cent_semiregular regE13 _ ntP). -have [p Ep1X] := nElemP EpX; have [sXE abelX oX] := pnElemPcard Ep1X. -have [p_pr ntX] := (pnElem_prime Ep1X, nt_pnElem Ep1X isT). -have tau31p: p \in [predU \tau3(M) & \tau1(M)]. - rewrite (pgroupP (pgroupS sXE _)) ?oX // -mulE31 pgroupM. - rewrite (sub_pgroup _ t3E3) => [|q t3q]; last by rewrite inE /= t3q. - by rewrite (sub_pgroup _ t1E1) // => q t1q; rewrite inE /= t1q orbT. -have [/= t3p | t1p] := orP tau31p. - rewrite (char_normal_trans _ nsE3E) ?sub_cyclic_char //. - by rewrite (sub_normal_Hall hallE3) // (pi_pgroup (abelem_pgroup abelX)). -have t1X := pi_pgroup (abelem_pgroup abelX) t1p. -have [e Ee sXeE1] := Hall_Jsub (sigma_compl_sol hallE) hallE1 sXE t1X. -rewrite /normal sXE -(conjSg _ _ e) conjGid //= -normJ -mulE31 mulG_subG. -rewrite andbC sub_abelian_norm ?cyclic_abelian ?cents_norm // centsC cE3E1 //. -rewrite -(setIidPr sE1E) nElemI !inE sXeE1 andbT. -by rewrite -(pnElemJ e) conjGid // def_pnElem in Ep1X; case/setIP: Ep1X. -Qed. - -(* This is B & G, Lemma 13.12. *) -Lemma tau12_regular M E p q P A : - M \in 'M -> \sigma(M)^'.-Hall(M) E -> - p \in \tau1(M) -> P \in 'E_p^1(E) -> q \in \tau2(M) -> A \in 'E_q^2(E) -> - 'C_A(P) != 1 -> - 'C_(M`_\sigma)(P) = 1. -Proof. -move=> maxM hallE t1p EpP t2q Eq2A ntCAP; apply: contraNeq (ntCAP) => ntCMsP. -have [[nsAE _] _ uniq_cMs _] := tau2_compl_context maxM hallE t2q Eq2A. -have [sPE abelP dimP] := pnElemP EpP; have [pP _] := andP abelP. -have ntP: P :!=: 1 by apply: nt_pnElem EpP _. -have [solE t1P] := (sigma_compl_sol hallE, pi_pgroup pP t1p). -have [E1 hallE1 sPE1] := Hall_superset solE sPE t1P. -have [_ [E3 hallE3]] := ex_tau13_compl hallE. -have [E2 _ complEi] := ex_tau2_compl hallE hallE1 hallE3. -have not_cAP: ~~ (P \subset 'C(A)). - have [_ regCE1A _] := tau2_regular maxM complEi t2q Eq2A. - apply: contra ntCMsP => cAP; rewrite (cent_semiregular regCE1A _ ntP) //. - exact/subsetIP. -have [sAE abelA dimA] := pnElemP Eq2A; have [qA _] := andP abelA. -pose Y := 'C_A(P)%G; have{abelA dimA} EqY: Y \in 'E_q^1('C_E(P)). - have sYA: Y \subset A := subsetIl A _; have abelY := abelemS sYA abelA. - rewrite !inE setSI // abelY eqn_leq -{2}rank_abelem // rank_gt0 -ltnS -dimA. - by rewrite properG_ltn_log //= /proper subsetIl subsetIidl centsC. -have ntCMsY: 'C_(M`_\sigma)(Y) != 1. - by apply: subG1_contra ntCMsP; apply: cent_tau1Elem_Msigma t1p EpP EqY. -have EqEY: Y \in 'E_q^1(E) by rewrite pnElemI in EqY; case/setIP: EqY. -have uniqCY := uniq_cMs _ EqEY ntCMsY. -have [ntA nAE] := (nt_pnElem Eq2A isT, normal_norm nsAE). -have [L maxNL] := mmax_exists (mFT_norm_proper ntA (mFT_pgroup_proper qA)). -have [sLq t12Lp]: q \in \sigma(L) /\ (p \in \tau1(L)) || (p \in \tau2(L)). - have [sLt2 t12cA' _] := primes_norm_tau2Elem maxM hallE t2q Eq2A maxNL. - split; first by have /andP[] := sLt2 q t2q. - apply: pnatPpi (pgroupS (quotientS _ sPE) t12cA') _. - rewrite -p_rank_gt0 -rank_pgroup ?quotient_pgroup // rank_gt0. - rewrite -subG1 quotient_sub1 ?subsetI ?sPE // (subset_trans sPE) //. - by rewrite normsI ?normG ?norms_cent. -have [maxL sNL] := setIdP maxNL; have sEL := subset_trans nAE sNL. -have sL'p: p \in \sigma(L)^' by move: t12Lp; rewrite -andb_orr => /andP[]. -have [sPL sL'P] := (subset_trans sPE sEL, pi_pgroup pP sL'p). -have{sL'P} [F hallF sPF] := Hall_superset (mmax_sol maxL) sPL sL'P. -have solF := sigma_compl_sol hallF. -have [sAL sL_A] := (subset_trans (normG A) sNL, pi_pgroup qA sLq). -have sALs: A \subset L`_\sigma by rewrite (sub_Hall_pcore (Msigma_Hall maxL)). -have neqLM: L != M by apply: contraTneq sLq => ->; case/andP: t2q. -have{t12Lp} [t1Lp | t2Lp] := orP t12Lp. - have [F1 hallF1 sPF1] := Hall_superset solF sPF (pi_pgroup pP t1Lp). - have EqLsY: Y \in 'E_q^1('C_(L`_\sigma)(P)). - by rewrite !inE setSI //; case/pnElemP: EqY => _ -> ->. - have [defL _] := cent_cent_Msigma_tau1_uniq maxL hallF hallF1 sPF1 ntP EqLsY. - by rewrite -in_set1 -uniqCY defL set11 in neqLM. -have sCPL: 'C(P) \subset L. - have [B Ep2B _] := ex_tau2Elem hallF t2Lp. - have EpFP: P \in 'E_p^1(F) by apply/pnElemP. - have [_ _ uniq_cLs _] := tau2_compl_context maxL hallF t2Lp Ep2B. - by case/mem_uniq_mmax: (uniq_cLs _ EpFP (subG1_contra (setSI _ sALs) ntCAP)). -have Eq2MA: A \in 'E_q^2(M). - by move: Eq2A; rewrite -(setIidPr (pHall_sub hallE)) pnElemI => /setIP[]. -have [_ _ _ tiMsL _] := tau2_context maxM t2q Eq2MA. -by case/negP: ntCMsP; rewrite -subG1 -(tiMsL L) ?setIS // 3!inE neqLM maxL. -Qed. - -(* This is B & G, Lemma 13.13. *) -Lemma tau13_nonregular_sigma M E p P : - M \in 'M -> \sigma(M)^'.-Hall(M) E -> - P \in 'E_p^1(E) -> (p \in \tau1(M)) || (p \in \tau3(M)) -> - 'C_(M`_\sigma)(P) != 1 -> - {in 'M('N(P)), forall Mstar, p \in \sigma(Mstar)}. -Proof. -move=> maxM hallE EpP t13Mp ntCMsP L maxNL /=. -have [maxL sNL] := setIdP maxNL. -have [sPE abelP dimP] := pnElemP EpP; have [pP _] := andP abelP. -have [solE ntP] := (sigma_compl_sol hallE, nt_pnElem EpP isT). -have /orP[// | t2Lp] := prime_class_mmax_norm maxL pP sNL. -have:= ntCMsP; rewrite -rank_gt0 => /rank_geP[Q /nElemP[q EqQ]]. -have [sQcMsP abelQ dimQ] := pnElemP EqQ; have [sQMs cPQ] := subsetIP sQcMsP. -have piQq: q \in \pi(Q) by rewrite -p_rank_gt0 p_rank_abelem ?dimQ. -have sMq: q \in \sigma(M) := pnatPpi (pgroupS sQMs (pcore_pgroup _ M)) piQq. -have rpM: 'r_p(M) = 1%N by move: t13Mp; rewrite -2!andb_orr andbCA; case: eqP. -have sL'q: q \notin \sigma(L). - have notMGL: gval L \notin M :^: G. - by apply: contraL t2Lp => /imsetP[x _ ->]; rewrite tau2J 2!inE rpM andbF. - by apply: contraFN (sigma_partition maxM maxL notMGL q) => sLq; apply/andP. -have [[sL'p _] [qQ _]] := (andP t2Lp, andP abelQ). -have sL'PQ: \sigma(L)^'.-group (P <*> Q). - by rewrite cent_joinEr // pgroupM (pi_pgroup pP) // (pi_pgroup qQ). -have sPQ_L: P <*> Q \subset L. - by rewrite (subset_trans _ sNL) // join_subG normG cents_norm. -have{sPQ_L sL'PQ} [F hallF sPQF] := Hall_superset (mmax_sol maxL) sPQ_L sL'PQ. -have{sPQF} [sPF sQF] := joing_subP sPQF. -have [A Ep2A _] := ex_tau2Elem hallF t2Lp. -have [[nsAF defA1] _ _ _] := tau2_compl_context maxL hallF t2Lp Ep2A. -have EpAP: P \in 'E_p^1(A) by rewrite -defA1; apply/pnElemP. -have{EpAP} sPA: P \subset A by case/pnElemP: EpAP. -have sCQM: 'C(Q) \subset M. - suffices: 'M('C(Q)) = [set M] by case/mem_uniq_mmax. - have [t1Mp | t3Mp] := orP t13Mp. - have [E1 hallE1 sPE1] := Hall_superset solE sPE (pi_pgroup pP t1Mp). - by have [] := cent_cent_Msigma_tau1_uniq maxM hallE hallE1 sPE1 ntP EqQ. - have [E3 hallE3 sPE3] := Hall_superset solE sPE (pi_pgroup pP t3Mp). - have [[E1 hallE1] _] := ex_tau13_compl hallE; have [sE1E _] := andP hallE1. - have [E2 _ complEi] := ex_tau2_compl hallE hallE1 hallE3. - have [regE3 | ntE1 _ prE _] := tau13_nonregular maxM complEi. - by rewrite (cent_semiregular regE3 sPE3 ntP) eqxx in ntCMsP. - rewrite /= (cent_semiprime prE) // -(cent_semiprime prE sE1E ntE1) in EqQ. - by have [] := cent_cent_Msigma_tau1_uniq maxM hallE hallE1 _ ntE1 EqQ. -have not_cQA: ~~ (A \subset 'C(Q)). - have [_ abelA dimA] := pnElemP Ep2A; apply: contraFN (ltnn 1) => cQA. - by rewrite -dimA -p_rank_abelem // -rpM p_rankS ?(subset_trans cQA sCQM). -have t1Lq: q \in \tau1(L). - have [_ nsCF t1Fb] := tau1_cent_tau2Elem_factor maxL hallF t2Lp Ep2A. - rewrite (pnatPpi (pgroupS (quotientS _ sQF) t1Fb)) //. - rewrite -p_rank_gt0 -rank_pgroup ?quotient_pgroup // rank_gt0. - rewrite -subG1 quotient_sub1 ?(subset_trans _ (normal_norm nsCF)) //. - by rewrite subsetI sQF centsC. -have defP: 'C_A(Q) = P. - apply/eqP; rewrite eq_sym eqEcard subsetI sPA centsC cPQ /=. - have [_ abelA dimA] := pnElemP Ep2A; have [pA _] := andP abelA. - rewrite (card_pgroup (pgroupS _ pA)) ?subsetIl // (card_pgroup pP) dimP. - rewrite leq_exp2l ?prime_gt1 ?(pnElem_prime EpP) //. - by rewrite -ltnS -dimA properG_ltn_log // /proper subsetIl subsetIidl. -have EqFQ: Q \in 'E_q^1(F) by apply/pnElemP. -have regQLs: 'C_(L`_\sigma)(Q) = 1. - by rewrite (tau12_regular maxL hallF t1Lq EqFQ t2Lp Ep2A) // defP. -have ntAQ: [~: A, Q] != 1 by rewrite (sameP eqP commG1P). -have [_ _ [_]] := tau1_act_tau2 maxL hallF t2Lp Ep2A t1Lq EqFQ regQLs ntAQ. -by case/negP; rewrite /= defP (subset_trans (cent_sub P)). -Qed. - -End Section13. - diff --git a/mathcomp/odd_order/BGsection14.v b/mathcomp/odd_order/BGsection14.v deleted file mode 100644 index bc6f9e2..0000000 --- a/mathcomp/odd_order/BGsection14.v +++ /dev/null @@ -1,2520 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq div path fintype. -From mathcomp -Require Import bigop finset prime fingroup morphism perm automorphism quotient. -From mathcomp -Require Import action gproduct gfunctor pgroup cyclic center commutator. -From mathcomp -Require Import gseries nilpotent sylow abelian maximal hall frobenius. -From mathcomp -Require Import ssralg ssrnum ssrint rat. -From mathcomp -Require Import BGsection1 BGsection3 BGsection4 BGsection5 BGsection6. -From mathcomp -Require Import BGsection7 BGsection9 BGsection10 BGsection12 BGsection13. - -(******************************************************************************) -(* This file covers B & G, section 14, starting with the definition of the *) -(* sigma-decomposition of elements, sigma-supergroups, and basic categories *) -(* of maximal subgroups: *) -(* sigma_decomposition x == the set of nontrivial constituents x.`_\sigma(M), *) -(* with M ranging over maximal sugroups of G. *) -(* (x is the product of these). *) -(* \ell_\sigma[x] == #|sigma_decomposition x|. *) -(* 'M_\sigma(X) == the set of maximal subgroups M such that X is a *) -(* a subset of M`_\sigma. *) -(* 'M_\sigma[x] := 'M_\sigma(<[x]>) *) -(* \kappa(M) == the set of primes p in \tau1(M) or \tau3(M), such *) -(* that 'C_(M`_\sigma)(P) != 1 for some subgroup of *) -(* M of order p, i.e., the primes for which M fails *) -(* to be a Frobenius group. *) -(* kappa_complement M U K <-> U and K are respectively {kappa, sigma}'- and *) -(* kappa-Hall subgroups of M, whose product is a *) -(* sigma-complement of M. This corresponds to the *) -(* notation introduced at the start of section 15 in *) -(* B & G, but is needed here to capture the use of *) -(* bound variables of 14.2(a) in the statement of *) -(* Lemma 14.12. *) -(* 'M_'F == the set of maximal groups M for which \kappa(M) *) -(* is empty, i.e., the maximal groups of Frobenius *) -(* type (in the final classification, this becomes *) -(* Type I). *) -(* 'M_'P == the complement to 'M_'F in 'M, i.e., the set of M *) -(* for which at least E1 has a proper prime action *) -(* on M`_\sigma. *) -(* 'M_'P1 == the set of maximal subgroups M such that \pi(M) *) -(* is the disjoint union of \sigma(M) and \kappa(M), *) -(* i.e., for which the entire complement acts in a *) -(* prime manner (this troublesome subset of 'M_'P is *) -(* ultimately refined into Types III-V in the final *) -(* classification). *) -(* 'M_'P2 == the complement to 'M_'P1 in 'M_'P; this becomes *) -(* Type II in the final classification. *) -(* 'N[x] == if x != 1 and 'M_\sigma[x] > 1, the unique group *) -(* in 'M('C[x]) (see B & G, Theorem 14.4), and the *) -(* trivial group otherwise. *) -(* 'R[x] := 'C_('N[x]`_\sigma)[x]; if \ell_\sigma[x] == 1, *) -(* this is the normal Hall subgroup of 'C[x] that *) -(* acts sharply transitively by conjugagtion on *) -(* 'M`_\sigma[x] (again, by Theorem 14.4). *) -(* M^~~ == the union of all the cosets x *: 'R[x], with x *) -(* ranging over (M`_\sigma)^#. This will become the *) -(* support set for the Dade isometry for M in the *) -(* character theory part of the proof. *) -(* It seems 'R[x] and 'N[x]`_\sigma play a somewhat the role of a signalizer *) -(* functor in the FT proof; in particular 'R[x] will be used to construct the *) -(* Dade isometry in the character theory part of the proof. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Local Open Scope ring_scope. -Local Open Scope nat_scope. -Import GRing.Theory Num.Theory GroupScope. - -Section Definitons. - -Variable gT : minSimpleOddGroupType. -Implicit Type x : gT. -Implicit Type M X : {set gT}. - -Definition sigma_decomposition x := - [set x.`_\sigma(M) | M : {group gT} in 'M]^#. -Definition sigma_length x := #|sigma_decomposition x|. - -Definition sigma_mmax_of X := [set M in 'M | X \subset M`_\sigma]. - -Definition FT_signalizer_base x := - if #|sigma_mmax_of <[x]>| > 1 then odflt 1%G (pick (mem 'M('C[x]))) else 1%G. - -Definition FT_signalizer x := 'C_((FT_signalizer_base x)`_\sigma)[x]. - -Definition sigma_cover M := \bigcup_(x in (M`_\sigma)^#) x *: FT_signalizer x. - -Definition tau13 M := [predU \tau1(M) & \tau3(M)]. - -Fact kappa_key : unit. Proof. by []. Qed. -Definition kappa_def M : nat_pred := - [pred p in tau13 M | [exists P in 'E_p^1(M), 'C_(M`_\sigma)(P) != 1]]. -Definition kappa := locked_with kappa_key kappa_def. -Canonical kappa_unlockable := [unlockable fun kappa]. - -Definition sigma_kappa M := [predU \sigma(M) & kappa M]. - -Definition kappa_complement (M U K : {set gT}) := - [/\ (sigma_kappa M)^'.-Hall(M) U, (kappa M).-Hall(M) K & group_set (U * K)]. - -Definition TypeF_maxgroups := [set M in 'M | (kappa M)^'.-group M]. - -Definition TypeP_maxgroups := 'M :\: TypeF_maxgroups. - -Definition TypeP1_maxgroups := - [set M in TypeP_maxgroups | (sigma_kappa M).-group M]. - -Definition TypeP2_maxgroups := TypeP_maxgroups :\: TypeP1_maxgroups. - -End Definitons. - -Notation "\ell_ \sigma ( x )" := (sigma_length x) - (at level 8, format "\ell_ \sigma ( x )") : group_scope. - -Notation "''M_' \sigma ( X )" := (sigma_mmax_of X) - (at level 8, format "''M_' \sigma ( X )") : group_scope. - -Notation "''M_' \sigma [ x ]" := (sigma_mmax_of <[x]>) - (at level 8, format "''M_' \sigma [ x ]") : group_scope. - -Notation "''N' [ x ]" := (FT_signalizer_base x) - (at level 8, format "''N' [ x ]") : group_scope. - -Notation "''R' [ x ]" := (FT_signalizer x) - (at level 8, format "''R' [ x ]") : group_scope. - -Notation "M ^~~" := (sigma_cover M) - (at level 2, format "M ^~~") : group_scope. - -Notation "\tau13 ( M )" := (tau13 M) - (at level 8, format "\tau13 ( M )") : group_scope. - -Notation "\kappa ( M )" := (kappa M) - (at level 8, format "\kappa ( M )") : group_scope. - -Notation "\sigma_kappa ( M )" := (sigma_kappa M) - (at level 8, format "\sigma_kappa ( M )") : group_scope. - -Notation "''M_' ''F'" := (TypeF_maxgroups _) - (at level 2, format "''M_' ''F'") : group_scope. - -Notation "''M_' ''P'" := (TypeP_maxgroups _) - (at level 2, format "''M_' ''P'") : group_scope. - -Notation "''M_' ''P1'" := (TypeP1_maxgroups _) - (at level 2, format "''M_' ''P1'") : group_scope. - -Notation "''M_' ''P2'" := (TypeP2_maxgroups _) - (at level 2, format "''M_' ''P2'") : group_scope. - -Section Section14. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). -Implicit Types p q q_star r : nat. -Implicit Types x y z : gT. -Implicit Types A E H K L M Mstar N P Q Qstar R S T U V W X Y Z : {group gT}. - -(* Basic properties of the sigma decomposition. *) -Lemma mem_sigma_decomposition x M (xM := x.`_\sigma(M)) : - M \in 'M -> xM != 1 -> xM \in sigma_decomposition x. -Proof. by move=> maxM nt_xM; rewrite !inE nt_xM; apply: mem_imset. Qed. - -Lemma sigma_decompositionJ x z : - sigma_decomposition (x ^ z) = sigma_decomposition x :^ z. -Proof. -rewrite conjD1g -[_ :^ z]imset_comp; congr _^#. -by apply: eq_in_imset => M maxM; rewrite /= consttJ. -Qed. - -Lemma ell_sigmaJ x z : \ell_\sigma(x ^ z) = \ell_\sigma(x). -Proof. by rewrite /sigma_length sigma_decompositionJ cardJg. Qed. - -Lemma sigma_mmaxJ M (X : {set gT}) z : - ((M :^ z)%G \in 'M_\sigma(X :^ z)) = (M \in 'M_\sigma(X)). -Proof. by rewrite inE mmaxJ MsigmaJ conjSg !inE. Qed. - -Lemma card_sigma_mmaxJ (X : {set gT}) z : - #|'M_\sigma(X :^ z)| = #|'M_\sigma(X)|. -Proof. -rewrite -(card_setact 'JG _ z^-1) setactVin ?inE //. -by apply: eq_card => M; rewrite inE sigma_mmaxJ. -Qed. - -Lemma sigma_decomposition_constt' x M (sM := \sigma(M)) : - M \in 'M -> sigma_decomposition x.`_sM^' = sigma_decomposition x :\ x.`_sM. -Proof. -move=> maxM; apply/setP=> y; rewrite !inE andbCA; apply: andb_id2l => nty. -apply/imsetP/andP=> [ | [neq_y_xM /imsetP]] [L maxL def_y]. - have not_sMy: ~~ sM.-elt y. - apply: contra nty => sMy; rewrite -order_eq1 (pnat_1 sMy) // def_y. - by apply: p_eltX; apply: p_elt_constt. - split; first by apply: contraNneq not_sMy => ->; apply: p_elt_constt. - have notMGL: gval L \notin M :^: G. - apply: contra not_sMy; rewrite def_y; case/imsetP=> z _ ->. - by rewrite (eq_constt _ (sigmaJ M z)) p_elt_constt. - apply/imsetP; exists L; rewrite // def_y sub_in_constt // => p _ sLp. - by apply: contraFN (sigma_partition maxM maxL notMGL p) => sMp; apply/andP. -exists L; rewrite ?sub_in_constt // => p _ sLp. -suffices notMGL: gval L \notin M :^: G. - by apply: contraFN (sigma_partition maxM maxL notMGL p) => sMp; apply/andP. -apply: contra neq_y_xM; rewrite def_y => /imsetP[z _ ->]. -by rewrite (eq_constt _ (sigmaJ M z)). -Qed. - -(* General remarks about the sigma-decomposition, p. 105 of B & G. *) -Remark sigma_mmax_exists p : - p \in \pi(G) -> {M : {group gT} | M \in 'M & p \in \sigma(M)}. -Proof. -move=> piGp; have [P sylP] := Sylow_exists p [set: gT]. -have ntP: P :!=: 1 by rewrite -rank_gt0 (rank_Sylow sylP) p_rank_gt0. -have ltPG: P \proper G := mFT_pgroup_proper (pHall_pgroup sylP). -have [M maxNM] := mmax_exists (mFT_norm_proper ntP ltPG). -have{maxNM} [maxM sNM] := setIdP maxNM; have sPM := subset_trans (normG P) sNM. -have{sylP} sylP := pHall_subl sPM (subsetT M) sylP. -by exists M => //; apply/exists_inP; exists P. -Qed. - -Lemma ell_sigma0P x : reflect (x = 1) (\ell_\sigma(x) == 0). -Proof. -rewrite cards_eq0 setD_eq0. -apply: (iffP idP) => [x1 | ->]; last first. - by apply/subsetP=> _ /imsetP[M _ ->]; rewrite constt1 inE. -rewrite -(prod_constt x) big1_seq //= => p _; apply: contraTeq x1 => nt_xp. -have piXp: p \in \pi(#[x]) by rewrite -p_part_gt1 -order_constt order_gt1. -have [M maxM sMp] := sigma_mmax_exists (piSg (subsetT _) piXp). -apply/subsetPn; exists (x.`_(\sigma(M))); first exact: mem_imset. -by rewrite (sameP set1P constt1P); apply: contraL sMp => /pnatPpi; apply. -Qed. - -Remark sigma_decomposition_subG x H : - x \in H -> sigma_decomposition x \subset H. -Proof. -by move=> Hx; apply/subsetP=> _ /setD1P[_ /imsetP[M _ ->]]; apply: groupX. -Qed. - -Remark prod_sigma_decomposition x : - \prod_(x_sM in sigma_decomposition x) x_sM = x. -Proof. -rewrite -big_filter filter_index_enum; set e := enum _. -have: uniq e := enum_uniq _; have: e =i sigma_decomposition x := mem_enum _. -elim: {x}e (x) => [|y e IHe] x def_e /= Ue. - by rewrite big_nil (ell_sigma0P x _) //; apply/pred0P; apply: fsym. -have{Ue} [not_e_y Ue] := andP Ue. -have [nty] := setD1P (etrans (fsym def_e y) (mem_head _ _)). -case/imsetP=> M maxM def_y; rewrite big_cons -(consttC \sigma(M) x) -def_y. -congr (y * _); apply: IHe Ue => z; rewrite sigma_decomposition_constt' //. -rewrite -def_y inE -def_e !inE andb_orr andNb andb_idl //. -by apply: contraTneq => ->. -Qed. - -Lemma ell1_decomposition x : - \ell_\sigma(x) == 1%N -> sigma_decomposition x = [set x]. -Proof. -case/cards1P=> y sdx_y. -by rewrite -{2}[x]prod_sigma_decomposition sdx_y big_set1. -Qed. - -Lemma Msigma_ell1 M x : - M \in 'M -> x \in (M`_\sigma)^# -> \ell_\sigma(x) == 1%N. -Proof. -move=> maxM /setD1P[ntx Ms_x]; apply/cards1P. -have sMx: \sigma(M).-elt x := mem_p_elt (pcore_pgroup _ _) Ms_x. -have def_xM: x.`_(\sigma(M)) = x := constt_p_elt sMx. -exists x; apply/eqP; rewrite eqEsubset sub1set !inE ntx -setD_eq0 /=. -rewrite -{2 3}def_xM -sigma_decomposition_constt' // (constt1P _) ?p_eltNK //. -by rewrite -cards_eq0 (sameP (ell_sigma0P 1) eqP) eqxx; apply: mem_imset. -Qed. - -Remark ell_sigma1P x : - reflect (x != 1 /\ 'M_\sigma[x] != set0) (\ell_\sigma(x) == 1%N). -Proof. -apply: (iffP idP) => [ell1x | [ntx]]; last first. - case/set0Pn=> M /setIdP[maxM]; rewrite cycle_subG => Ms_x. - by rewrite (Msigma_ell1 maxM) // in_setD1 ntx. -have sdx_x: x \in sigma_decomposition x by rewrite ell1_decomposition ?set11. -have{sdx_x} [ntx sdx_x] := setD1P sdx_x; split=> //; apply/set0Pn. -have{sdx_x} [M maxM def_x] := imsetP sdx_x; rewrite // -cycle_eq1 in ntx. -have sMx: \sigma(M).-elt x by rewrite def_x p_elt_constt. -have [[z sXzMs] _] := sigma_Jsub maxM sMx ntx. -by exists (M :^ z^-1)%G; rewrite inE mmaxJ maxM MsigmaJ -sub_conjg. -Qed. - -Remark ell_sigma_le1 x :(\ell_\sigma(x) <= 1) = ('M_\sigma[x] != set0). -Proof. -rewrite -[_ <= 1](mem_iota 0 2) !inE (sameP (ell_sigma0P x) eqP). -rewrite (sameP (ell_sigma1P x) andP); case: eqP => //= ->; symmetry. -have [M max1M] := mmax_exists (mFT_pgroup_proper (@pgroup1 gT 2)). -have [maxM _] := setIdP max1M; apply/set0Pn; exists M. -by rewrite inE maxM cycle1 sub1G. -Qed. - -(* Basic properties of \kappa and the maximal group subclasses. *) -Lemma kappaJ M x : \kappa(M :^ x) =i \kappa(M). -Proof. -move=> p; rewrite unlock 3!{1}inE /= tau1J tau3J; apply: andb_id2l => _. -apply/exists_inP/exists_inP=> [] [P EpP ntCMsP]. - rewrite -(conjsgK x M); exists (P :^ x^-1)%G; first by rewrite pnElemJ. - by rewrite MsigmaJ centJ -conjIg -subG1 sub_conjg conjs1g subG1. -exists (P :^ x)%G; first by rewrite pnElemJ. -by rewrite MsigmaJ centJ -conjIg -subG1 sub_conjg conjs1g subG1. -Qed. - -Lemma kappa_tau13 M p : p \in \kappa(M) -> (p \in \tau1(M)) || (p \in \tau3(M)). -Proof. by rewrite unlock => /andP[]. Qed. - -Lemma kappa_sigma' M : {subset \kappa(M) <= \sigma(M)^'}. -Proof. by move=> p /kappa_tau13/orP[] /andP[]. Qed. - -Remark rank_kappa M p : p \in \kappa(M) -> 'r_p(M) = 1%N. -Proof. by case/kappa_tau13/orP=> /and3P[_ /eqP]. Qed. - -Lemma kappa_pi M : {subset \kappa(M) <= \pi(M)}. -Proof. by move=> p kMp; rewrite -p_rank_gt0 rank_kappa. Qed. - -Remark kappa_nonregular M p P : - p \in \kappa(M) -> P \in 'E_p^1(M) -> 'C_(M`_\sigma)(P) != 1. -Proof. -move=> kMp EpP; have rpM := rank_kappa kMp. -have [sPM abelP oP] := pnElemPcard EpP; have [pP _] := andP abelP. -have [Q EpQ nregQ]: exists2 Q, Q \in 'E_p^1(M) & 'C_(M`_\sigma)(Q) != 1. - by apply/exists_inP; rewrite unlock in kMp; case/andP: kMp. -have [sQM abelQ oQ] := pnElemPcard EpQ; have [pQ _] := andP abelQ. -have [S sylS sQS] := Sylow_superset sQM pQ; have [_ pS _] := and3P sylS. -have [x Mx sPxS] := Sylow_Jsub sylS sPM pP. -rewrite -(inj_eq (@conjsg_inj _ x)) conjs1g conjIg -centJ. -rewrite (normsP (normal_norm (pcore_normal _ _))) // (subG1_contra _ nregQ) //. -rewrite setIS ?centS // -(cardSg_cyclic _ sPxS sQS) ?cardJg ?oP ?oQ //. -by rewrite (odd_pgroup_rank1_cyclic pS) ?mFT_odd // (p_rank_Sylow sylS) rpM. -Qed. - -Lemma ex_kappa_compl M K : - M \in 'M -> \kappa(M).-Hall(M) K -> - exists U : {group gT}, kappa_complement M U K. -Proof. -move=> maxM hallK; have [sKM kK _] := and3P hallK. -have s'K: \sigma(M)^'.-group K := sub_pgroup (@kappa_sigma' M) kK. -have [E hallE sKE] := Hall_superset (mmax_sol maxM) sKM s'K. -pose sk' := \sigma_kappa(M)^'. -have [U hallU] := Hall_exists sk' (sigma_compl_sol hallE). -exists U; split=> //. - by apply: subHall_Hall hallE _ hallU => p; case/norP. -suffices ->: U * K = E by apply: groupP. -have [[sUE sk'U _] [sEM s'E _]] := (and3P hallU, and3P hallE). -apply/eqP; rewrite eqEcard mulG_subG sUE sKE /= coprime_cardMg; last first. - by apply: p'nat_coprime (sub_pgroup _ sk'U) kK => p; case/norP. -rewrite -(partnC \kappa(M) (cardG_gt0 E)) -{2}(part_pnat_id s'E) mulnC. -rewrite -(card_Hall (pHall_subl sKE sEM hallK)) leq_mul // -partnI. -by rewrite -(@eq_partn sk') -?(card_Hall hallU) // => p; apply: negb_or. -Qed. - -Lemma FtypeP M : reflect (M \in 'M /\ \kappa(M) =i pred0) (M \in 'M_'F). -Proof. -do [apply: (iffP setIdP) => [] [maxM k'M]; split] => // [p|]. - by apply/idP=> /= kMp; case/negP: (pnatPpi k'M (kappa_pi kMp)). -by apply/pgroupP=> p _ _; rewrite inE /= k'M. -Qed. - -Lemma PtypeP M : reflect (M \in 'M /\ exists p, p \in \kappa(M)) (M \in 'M_'P). -Proof. -apply: (iffP setDP) => [[maxM kM] | [maxM [p kMp]]]; split => //. - rewrite inE maxM !negb_and cardG_gt0 /= all_predC negbK in kM. - by have [p _ kMp] := hasP kM; exists p. -by apply/FtypeP=> [[_ kM0]]; rewrite kM0 in kMp. -Qed. - -Lemma trivg_kappa M K : - M \in 'M -> \kappa(M).-Hall(M) K -> (K :==: 1) = (M \in 'M_'F). -Proof. -by move=> maxM hallK; rewrite inE maxM trivg_card1 (card_Hall hallK) partG_eq1. -Qed. - -(* Could go in Section 10. *) -Lemma not_sigma_mmax M : M \in 'M -> ~~ \sigma(M).-group M. -Proof. -move=> maxM; apply: contraL (mmax_sol maxM); rewrite negb_forall_in => sM. -apply/existsP; exists M; rewrite mmax_neq1 // subsetIidl andbT. -apply: subset_trans (Msigma_der1 maxM). -by rewrite (sub_Hall_pcore (Msigma_Hall maxM)). -Qed. - -Lemma trivg_kappa_compl M U K : - M \in 'M -> kappa_complement M U K -> (U :==: 1) = (M \in 'M_'P1). -Proof. -move=> maxM [hallU _ _]; symmetry. -rewrite 3!inE maxM /= trivg_card1 (card_Hall hallU) partG_eq1 pgroupNK andbT. -apply: andb_idl => skM; apply: contra (not_sigma_mmax maxM). -by apply: sub_in_pnat => p /(pnatPpi skM)/orP[] // kMp /negP. -Qed. - -Lemma FtypeJ M x : ((M :^ x)%G \in 'M_'F) = (M \in 'M_'F). -Proof. by rewrite inE mmaxJ pgroupJ (eq_p'group _ (kappaJ M x)) !inE. Qed. - -Lemma PtypeJ M x : ((M :^ x)%G \in 'M_'P) = (M \in 'M_'P). -Proof. by rewrite !in_setD mmaxJ FtypeJ. Qed. - -Lemma P1typeJ M x : ((M :^ x)%G \in 'M_'P1) = (M \in 'M_'P1). -Proof. -rewrite inE PtypeJ pgroupJ [M \in 'M_'P1]inE; congr (_ && _). -by apply: eq_pgroup => p; rewrite inE /= kappaJ sigmaJ. -Qed. - -Lemma P2typeJ M x : ((M :^ x)%G \in 'M_'P2) = (M \in 'M_'P2). -Proof. by rewrite in_setD PtypeJ P1typeJ -in_setD. Qed. - -(* This is B & G, Lemma 14.1. *) -Lemma sigma'_kappa'_facts M p S (A := 'Ohm_1(S)) (Ms := M`_\sigma) : - M \in 'M -> p.-Sylow(M) S -> - [&& p \in \pi(M), p \notin \sigma(M) & p \notin \kappa(M)] -> - [/\ M \in 'M_'F :|: 'M_'P2, logn p #|A| <= 2, 'C_Ms(A) = 1 & nilpotent Ms]. -Proof. -move=> maxM sylS /and3P[piMp sM'p kM'p]; have [sSM pS _] := and3P sylS. -rewrite 8!(maxM, inE) /= !andbT negb_and orb_andr orbN andbT negbK. -rewrite (contra (fun skM => pnatPpi skM piMp)) ?orbT; last exact/norP. -rewrite partition_pi_mmax // (negPf sM'p) orbF orbCA in piMp. -have{piMp} [t2p | t13p] := orP piMp. - rewrite (tau2_Msigma_nil maxM t2p); have [_ rpM] := andP t2p. - have{rpM} rS: 2 <= 'r_p(S) by rewrite (p_rank_Sylow sylS) (eqP rpM). - have [B EpB] := p_rank_geP rS; have{EpB} [sBS abelB dimB] := pnElemP EpB. - have EpB: B \in 'E_p^2(M) by rewrite !inE abelB dimB (subset_trans sBS). - have [defB _ regB _ _] := tau2_context maxM t2p EpB. - by rewrite /A -dimB; have [_ [|->]] := defB S sylS. -have [ntS cycS]: S :!=: 1 /\ cyclic S. - rewrite (odd_pgroup_rank1_cyclic pS) ?mFT_odd // (p_rank_Sylow sylS). - apply/andP; rewrite -rank_gt0 (rank_Sylow sylS) -eqn_leq eq_sym. - by rewrite -2!andb_orr orNb andbT inE /= sM'p in t13p. -have [p_pr _ _] := pgroup_pdiv pS ntS. -have oA: #|A| = p by rewrite (Ohm1_cyclic_pgroup_prime cycS pS). -have sAM: A \subset M by apply: gFsub_trans. -have regA: 'C_Ms(A) = 1. - apply: contraNeq kM'p => nregA; rewrite unlock; apply/andP; split=> //. - by apply/exists_inP; exists [group of A]; rewrite ?p1ElemE // !inE sAM oA /=. -have defMsA: Ms ><| A = Ms <*> A. - rewrite sdprodEY ?coprime_TIg ?(subset_trans sAM) ?gFnorm // oA. - by rewrite (pnat_coprime (pcore_pgroup _ _)) ?pnatE. -rewrite (prime_Frobenius_sol_kernel_nil defMsA) ?oA ?(pfactorK 1) //. -by rewrite (solvableS _ (mmax_sol maxM)) // join_subG pcore_sub. -Qed. - -Lemma notP1type_Msigma_nil M : - (M \in 'M_'F) || (M \in 'M_'P2) -> nilpotent M`_\sigma. -Proof. -move=> notP1maxM; suffices [maxM]: M \in 'M /\ ~~ \sigma_kappa(M).-group M. - rewrite negb_and cardG_gt0 => /allPn[p piMp /norP[s'p k'p]]. - by have [S /sigma'_kappa'_facts[] //] := Sylow_exists p M; apply/and3P. -have [/setIdP[maxM k'M] | /setDP[PmaxM]] := orP notP1maxM; last first. - by rewrite inE PmaxM; case/setDP: PmaxM. -split=> //; apply: contra (not_sigma_mmax maxM). -by apply: sub_in_pnat => p piMp /orP[] // /idPn[]; apply: (pnatPpi k'M). -Qed. - -(* This is B & G, Proposition 14.2. *) -Proposition Ptype_structure M K (Ms := M`_\sigma) (Kstar := 'C_Ms(K)) : - M \in 'M_'P -> \kappa(M).-Hall(M) K -> - [/\ (*a*) exists2 U : {group gT}, - kappa_complement M U K /\ Ms ><| (U ><| K) = M - & [/\ abelian U, semiprime Ms K & semiregular U K], - (*b*) (*1.2*) K \x Kstar = 'N_M(K) - /\ {in 'E^1(K), forall X, - (*1.1*) 'N_M(X) = 'N_M(K) - /\ (*2*) {in 'M('N(X)), forall Mstar, X \subset Mstar`_\sigma}}, - (*c*) Kstar != 1 /\ {in 'E^1(Kstar), forall X, 'M('C(X)) = [set M]}, - [/\ (*d*) {in ~: M, forall g, Kstar :&: M :^ g = 1} - /\ {in M :\: 'N_M(K), forall g, K :&: K :^ g = 1}, - (*e*) {in \pi(Kstar), forall p S, - p.-Sylow(M) S -> 'M(S) = [set M] /\ ~~ (S \subset Kstar)} - & (*f*) forall Y, \sigma(M).-group Y -> Y :&: Kstar != 1 -> Y \subset Ms] - & (*g*) M \in 'M_'P2 -> - [/\ \sigma(M) =i \beta(M), prime #|K|, nilpotent Ms - & normedTI Ms^# G M]]. -Proof. -move: @Kstar => Ks PmaxM hallK; have [maxM notFmaxM] := setDP PmaxM. -have sMs: \sigma(M).-group M`_\sigma := pcore_pgroup _ M. -have{notFmaxM} ntK: K :!=: 1 by rewrite (trivg_kappa maxM). -have [sKM kK _] := and3P hallK; have s'K := sub_pgroup (@kappa_sigma' M) kK. -have solM := mmax_sol maxM; have [E hallE sKE] := Hall_superset solM sKM s'K. -have [[sEM s'E _] [_ [E3 hallE3]]] := (and3P hallE, ex_tau13_compl hallE). -have [F1 hallF1] := Hall_exists \tau1(M) (solvableS sKM solM). -have [[sF1K t1F1 _] solE] := (and3P hallF1, sigma_compl_sol hallE). -have [E1 hallE1 sFE1] := Hall_superset solE (subset_trans sF1K sKE) t1F1. -have [E2 hallE2 complEi] := ex_tau2_compl hallE hallE1 hallE3. -have [[_ nsE3E] _ [cycE1 _] [defEl defE] _] := sigma_compl_context maxM complEi. -have [sE1E t1E1 _] := and3P hallE1; have sE1M := subset_trans sE1E sEM. -have [sE3E t3E3 _] := and3P hallE3; have sE3M := subset_trans sE3E sEM. -set part_a := exists2 U, _ & _; pose b1_hyp := {in 'E^1(K), forall X, X <| K}. -have [have_a nK1K ntE1 sE1K]: [/\ part_a, b1_hyp, E1 :!=: 1 & E1 \subset K]. - have [t1K | not_t1K] := boolP (\tau1(M).-group K). - have sKE1: K \subset E1 by rewrite (sub_pHall hallF1 t1K). - have prE1 := tau1_primact_Msigma maxM hallE hallE1. - have st1k: {subset \tau1(M) <= \kappa(M)}. - move=> p t1p; rewrite unlock 3!inE /= t1p /=. - have [X]: exists X, X \in 'E_p^1(E1). - apply/p_rank_geP; rewrite p_rank_gt0 /= (card_Hall hallE1). - by rewrite pi_of_part // inE /= (partition_pi_sigma_compl maxM) ?t1p. - rewrite -(setIidPr sE1M) pnElemI -setIdE => /setIdP[EpX sXE1]. - pose q := pdiv #|K|; have piKq: q \in \pi(K) by rewrite pi_pdiv cardG_gt1. - have /p_rank_geP[Y]: 0 < 'r_q(K) by rewrite p_rank_gt0. - rewrite -(setIidPr sKM) pnElemI -setIdE => /setIdP[EqY sYK]. - have ntCMsY := kappa_nonregular (pnatPpi kK piKq) EqY. - have [ntY sYE1] := (nt_pnElem EqY isT, subset_trans sYK sKE1). - apply/exists_inP; exists X; rewrite ?(subG1_contra _ ntCMsY) //=. - by rewrite (cent_semiprime prE1 sYE1 ntY) ?setIS ?centS. - have defK := sub_pHall hallK (sub_pgroup st1k t1E1) sKE1 sE1M. - split=> [|X||]; rewrite ?defK //; last first. - rewrite -defK; case/nElemP=> p /pnElemP[sXE1 _ _]. - by rewrite char_normal // sub_cyclic_char. - have [[U _ defU _] _ _ _] := sdprodP defE; rewrite defU in defE. - have [nsUE _ mulUE1 nUE1 _] := sdprod_context defE. - have [[_ V _ defV] _] := sdprodP defEl; rewrite defV. - have [_ <- nE21 _] := sdprodP defV => /mulGsubP[nE32 nE31] _. - have regUK: semiregular U K. - move=> y /setD1P[]; rewrite -cycle_subG -cent_cycle -order_gt1. - rewrite -pi_pdiv; move: (pdiv _) => p pi_y_p Ky. - have piKp := piSg Ky pi_y_p; have t1p := pnatPpi t1K piKp. - move: pi_y_p; rewrite -p_rank_gt0 => /p_rank_geP[Y] /=. - rewrite -{1}(setIidPr (subset_trans Ky sKE)) pnElemI -setIdE. - case/setIdP=> EpY sYy; have EpMY := subsetP (pnElemS _ _ sEM) Y EpY. - apply: contraNeq (kappa_nonregular (pnatPpi kK piKp) EpMY). - move/(subG1_contra (setIS U (centS sYy))). - have{y sYy Ky} sYE1 := subset_trans sYy (subset_trans Ky sKE1). - have ntY: Y :!=: 1 by apply: (nt_pnElem EpY). - rewrite -subG1 /=; have [_ <- _ tiE32] := sdprodP defU. - rewrite -subcent_TImulg ?subsetI ?(subset_trans sYE1) // mulG_subG. - rewrite !subG1 /= => /nandP[nregE3Y | nregE2Y]. - have pr13 := cent_semiprime (tau13_primact_Msigma maxM complEi _). - rewrite pr13 ?(subset_trans sYE1) ?joing_subr //; last first. - by move/cent_semiregular=> regE31; rewrite regE31 ?eqxx in nregE3Y. - pose q := pdiv #|'C_E3(Y)|. - have piE3q: q \in \pi(E3). - by rewrite (piSg (subsetIl E3 'C(Y))) // pi_pdiv cardG_gt1. - have /p_rank_geP[X]: 0 < 'r_q(M :&: E3). - by rewrite (setIidPr sE3M) p_rank_gt0. - rewrite pnElemI -setIdE => /setIdP[EqX sXE3]. - rewrite -subG1 -(_ : 'C_Ms(X) = 1) ?setIS ?centS //. - by rewrite (subset_trans sXE3) ?joing_subl. - apply: contraTeq (pnatPpi t3E3 piE3q) => nregMsX; apply: tau3'1. - suffices kq: q \in \kappa(M). - rewrite (pnatPpi t1K) //= (card_Hall hallK) pi_of_part //. - by rewrite inE /= kappa_pi. - rewrite unlock 3!inE /= (pnatPpi t3E3 piE3q) orbT /=. - by apply/exists_inP; exists X. - pose q := pdiv #|'C_E2(Y)|; have [sE2E t2E2 _] := and3P hallE2. - have piCE2Yq: q \in \pi('C_E2(Y)) by rewrite pi_pdiv cardG_gt1. - have [X]: exists X, X \in 'E_q^1(E :&: 'C_E2(Y)). - by apply/p_rank_geP; rewrite /= setIA (setIidPr sE2E) p_rank_gt0. - rewrite pnElemI -setIdE => /setIdP[EqX sXcE2Y]. - have t2q:= pnatPpi t2E2 (piSg (subsetIl _ _) piCE2Yq). - have [A Eq2A _] := ex_tau2Elem hallE t2q. - have [[_ defEq1] _ _ _] := tau2_compl_context maxM hallE t2q Eq2A. - rewrite (tau12_regular maxM hallE t1p EpY t2q Eq2A) //. - rewrite (subG1_contra _ (nt_pnElem EqX _)) // subsetI. - rewrite defEq1 in EqX; case/pnElemP: EqX => -> _ _. - by rewrite (subset_trans sXcE2Y) ?subsetIr. - have [defM [sUE _]] := (sdprod_sigma maxM hallE, andP nsUE). - have hallU: \sigma_kappa(M)^'.-Hall(M) U. - suffices: [predI \sigma(M)^' & \kappa(M)^'].-Hall(M) U. - by apply: etrans; apply: eq_pHall=> p; rewrite inE /= negb_or. - apply: subHall_Hall hallE _ _ => [p|]; first by case/andP. - rewrite pHallE partnI (part_pnat_id s'E) -pHallE. - have hallK_E: \kappa(M).-Hall(E) K := pHall_subl sKE sEM hallK. - by apply/(sdprod_normal_pHallP nsUE hallK_E); rewrite -defK. - exists U; [rewrite -{2}defK defE | rewrite -{1}defK]; split=> //. - by split; rewrite // -defK mulUE1 groupP. - apply: abelianS (der_mmax_compl_abelian maxM hallE). - rewrite -(coprime_cent_prod nUE1) ?(solvableS sUE) //. - by rewrite {2}defK (cent_semiregular regUK) // mulg1 commgSS. - by rewrite (coprime_sdprod_Hall_r defE); apply: pHall_Hall hallE1. - move: not_t1K; rewrite negb_and cardG_gt0 => /allPn[p piKp t1'p]. - have kp := pnatPpi kK piKp; have t3p := kappa_tau13 kp. - rewrite [p \in _](negPf t1'p) /= in t3p. - have [X]: exists X, X \in 'E_p^1(K) by apply/p_rank_geP; rewrite p_rank_gt0. - rewrite -{1}(setIidPr sKM) pnElemI -setIdE => /setIdP[EpX sXK]. - have sXE3: X \subset E3. - rewrite (sub_normal_Hall hallE3) ?(subset_trans sXK) ?(pi_pgroup _ t3p) //. - by case/pnElemP: EpX => _ /andP[]. - have [nregX ntX] := (kappa_nonregular kp EpX, nt_pnElem EpX isT). - have [regE3|ntE1 {defE}defE prE nE1_E] := tau13_nonregular maxM complEi. - by case/eqP: nregX; rewrite (cent_semiregular regE3). - have defK: E :=: K. - apply: (sub_pHall hallK _ sKE sEM); apply/pgroupP=> q q_pr q_dv_E. - have{q_dv_E} piEq: q \in \pi(E) by rewrite mem_primes q_pr cardG_gt0. - rewrite unlock; apply/andP; split=> /=. - apply: pnatPpi piEq; rewrite -pgroupE -(sdprodW defE). - rewrite pgroupM (sub_pgroup _ t3E3) => [|r t3r]; last by apply/orP; right. - by rewrite (sub_pgroup _ t1E1) // => r t1r; apply/orP; left. - have:= piEq; rewrite -p_rank_gt0 => /p_rank_geP[Y]. - rewrite -{1}(setIidPr sEM) pnElemI -setIdE => /setIdP[EqY sYE]. - rewrite (cent_semiprime prE) ?(subset_trans sXK) // in nregX. - apply/exists_inP; exists Y => //; apply: subG1_contra nregX. - by rewrite setIS ?centS. - have defM := sdprod_sigma maxM hallE. - rewrite /b1_hyp -defK; split=> //; exists 1%G; last first. - by split; [apply: abelian1 | rewrite -defK | apply: semiregular1l]. - rewrite sdprod1g; do 2?split=> //; rewrite ?mul1g ?groupP -?defK //. - rewrite pHallE sub1G cards1 eq_sym partG_eq1 pgroupNK /=. - have{defM} [_ defM _ _] := sdprodP defM; rewrite -{2}defM defK pgroupM. - rewrite (sub_pgroup _ sMs) => [|r sr]; last by apply/orP; left. - by rewrite (sub_pgroup _ kK) // => r kr; apply/orP; right. -set part_b := _ /\ _; set part_c := _ /\ _; set part_d := _ /\ _. -have [U [complUK defM] [cUU prMsK regUK]] := have_a. -have [hallU _ _] := complUK; have [sUM sk'U _] := and3P hallU. -have have_b: part_b. - have coMsU: coprime #|Ms| #|U|. - by rewrite (pnat_coprime sMs (sub_pgroup _ sk'U)) // => p; case/norP. - have{defM} [[_ F _ defF]] := sdprodP defM; rewrite defF. - have [_ <- nUK _] := sdprodP defF; rewrite mulgA mulG_subG => defM. - case/andP=> nMsU nMsK _. - have coMsU_K: coprime #|Ms <*> U| #|K|. - rewrite norm_joinEr // (p'nat_coprime _ kK) // -pgroupE. - rewrite pgroupM // (sub_pgroup _ sMs) => [|r]; last first. - by apply: contraL; apply: kappa_sigma'. - by apply: sub_pgroup _ sk'U => r /norP[]. - have defNK X: X <| K -> X :!=: 1 -> 'N_M(X) = Ks * K. - case/andP=> sXK nXK ntX; rewrite -defM -(norm_joinEr nMsU). - rewrite setIC -group_modr // setIC. - rewrite coprime_norm_cent ?(subset_trans sXK) ?normsY //; last first. - by rewrite (coprimegS sXK). - rewrite /= norm_joinEr -?subcent_TImulg ?(coprime_TIg coMsU) //; last first. - by rewrite subsetI !(subset_trans sXK). - by rewrite (cent_semiregular regUK) // mulg1 (cent_semiprime prMsK). - rewrite /part_b dprodE ?subsetIr //; last first. - rewrite setICA setIA (coprime_TIg (coprimeSg _ coMsU_K)) ?setI1g //. - by rewrite joing_subl. - rewrite -centC ?subsetIr // defNK //; split=> // X Eq1X. - have [q EqX] := nElemP Eq1X; have ntX := nt_pnElem EqX isT. - have:= EqX; rewrite -{1}(setIidPr sKE) pnElemI -setIdE. - case/setIdP=> EqEX sXK; split; first by rewrite defNK ?nK1K. - have [_ abelX dimX] := pnElemP EqX; have [qX _] := andP abelX. - have kq: q \in \kappa(M). - by rewrite (pnatPpi kK (piSg sXK _)) // -p_rank_gt0 p_rank_abelem ?dimX. - have nregX := kappa_nonregular kq (subsetP (pnElemS _ _ sEM) _ EqEX). - have sq := tau13_nonregular_sigma maxM hallE EqEX (kappa_tau13 kq) nregX. - move=> H maxNH; have [maxH sNXH] := setIdP maxNH. - rewrite (sub_Hall_pcore (Msigma_Hall maxH)) ?(subset_trans (normG X)) //. - exact: pi_pgroup qX (sq H maxNH). -have have_c: part_c. - pose p := pdiv #|E1|; have piE1p: p \in \pi(E1) by rewrite pi_pdiv cardG_gt1. - have:= piE1p; rewrite -p_rank_gt0 => /p_rank_geP[Y]. - rewrite -(setIidPr sE1M) pnElemI -setIdE => /setIdP[EpY sYE1]. - have [sYK ntY] := (subset_trans sYE1 sE1K, nt_pnElem EpY isT). - split=> [|X /nElemP[q]]. - rewrite /Ks -(cent_semiprime prMsK sYK) //. - exact: kappa_nonregular (pnatPpi kK (piSg sE1K piE1p)) EpY. - rewrite /= -(cent_semiprime prMsK sYK) // => EqX. - by have [] := cent_cent_Msigma_tau1_uniq maxM hallE hallE1 sYE1 ntY EqX. -have [[defNK defK1] [_ uniqKs]] := (have_b, have_c). -have have_d: part_d. - split=> g. - rewrite inE; apply: contraNeq; rewrite -rank_gt0. - case/rank_geP=> X; rewrite nElemI -setIdE -groupV => /setIdP[EpX sXMg]. - have [_ sCXMs] := mem_uniq_mmax (uniqKs _ EpX). - case/nElemP: EpX => p /pnElemP[/subsetIP[sXMs _] abelX dimX]. - have [[pX _] sXM] := (andP abelX, subset_trans sXMs (pcore_sub _ _)). - have piXp: p \in \pi(X) by rewrite -p_rank_gt0 p_rank_abelem ?dimX. - have sp := pnatPpi sMs (piSg sXMs piXp). - have [def_g _ _] := sigma_group_trans maxM sp pX. - have [|c cXc [m Mm ->]] := def_g g^-1 sXM; first by rewrite sub_conjgV. - by rewrite groupM // (subsetP sCXMs). - case/setDP=> Mg; apply: contraNeq; rewrite -rank_gt0 /=. - case/rank_geP=> X; rewrite nElemI -setIdE => /setIdP[EpX sXKg]. - have [<- _] := defK1 X EpX; rewrite 2!inE Mg /=. - have{EpX} [p EpX] := nElemP EpX; have [_ abelX dimX] := pnElemP EpX. - have defKp1: {in 'E_p^1(K), forall Y, 'Ohm_1('O_p(K)) = Y}. - move=> Y EpY; have E1K_Y: Y \in 'E^1(K) by apply/nElemP; exists p. - have piKp: p \in \pi(K) by rewrite -p_rank_gt0; apply/p_rank_geP; exists Y. - have [pKp sKpK] := (pcore_pgroup p K, pcore_sub p K). - have cycKp: cyclic 'O_p(K). - rewrite (odd_pgroup_rank1_cyclic pKp) ?mFT_odd //. - by rewrite -(rank_kappa (pnatPpi kK piKp)) p_rankS ?(subset_trans sKpK). - have [sYK abelY oY] := pnElemPcard EpY; have [pY _] := andP abelY. - have sYKp: Y \subset 'O_p(K) by rewrite pcore_max ?nK1K. - apply/eqP; rewrite eq_sym eqEcard -{1}(Ohm1_id abelY) OhmS //= oY. - rewrite (Ohm1_cyclic_pgroup_prime cycKp pKp) ?(subG1_contra sYKp) //=. - exact: nt_pnElem EpY _. - rewrite sub_conjg -[X :^ _]defKp1 ?(defKp1 X) //. - by rewrite !inE sub_conjgV sXKg abelemJ abelX cardJg dimX. -split=> {part_a part_b part_c have_a have_b have_c}//; first split=> //. -- move=> q; rewrite /Ks -(cent_semiprime prMsK sE1K ntE1) => picMsE1q. - have sq := pnatPpi (pcore_pgroup _ M) (piSg (subsetIl _ _) picMsE1q). - move: picMsE1q; rewrite -p_rank_gt0; case/p_rank_geP=> y EqY S sylS. - have [sSM qS _] := and3P sylS. - have sSMs: S \subset M`_\sigma. - by rewrite (sub_Hall_pcore (Msigma_Hall maxM)) ?(pi_pgroup qS). - have sylS_Ms: q.-Sylow(M`_\sigma) S := pHall_subl sSMs (pcore_sub _ M) sylS. - have [_]:= cent_cent_Msigma_tau1_uniq maxM hallE hallE1 (subxx _) ntE1 EqY. - move/(_ S sylS_Ms) => uniqS; split=> //; rewrite subsetI sSMs /=. - pose p := pdiv #|E1|; have piE1p: p \in \pi(E1) by rewrite pi_pdiv cardG_gt1. - have [s'p _] := andP (pnatPpi t1E1 piE1p). - have [P sylP] := Sylow_exists p E1; have [sPE1 pP _] := and3P sylP. - apply: contra (s'p) => cE1S; apply/exists_inP; exists P. - exact: subHall_Sylow s'p (subHall_Sylow hallE1 (pnatPpi t1E1 piE1p) sylP). - apply: (sub_uniq_mmax uniqS); first by rewrite cents_norm // (centsS sPE1). - apply: mFT_norm_proper (mFT_pgroup_proper pP). - by rewrite -rank_gt0 (rank_Sylow sylP) p_rank_gt0. -- move=> Y sY ntYKs; have ntY: Y :!=:1 := subG1_contra (subsetIl _ _) ntYKs. - have [[x sYxMs] _] := sigma_Jsub maxM sY ntY; rewrite sub_conjg in sYxMs. - suffices Mx': x^-1 \in M by rewrite (normsP _ _ Mx') ?gFnorm in sYxMs. - rewrite -(setCK M) inE; apply: contra ntYKs => M'x'. - rewrite setIC -(setIidPr sYxMs) -/Ms -[Ms](setIidPr (pcore_sub _ _)). - by rewrite conjIg !setIA; have [-> // _] := have_d; rewrite !setI1g. -rewrite inE PmaxM andbT -(trivg_kappa_compl maxM complUK) => ntU. -have [regMsU nilMs]: 'C_Ms(U) = 1 /\ nilpotent Ms. - pose p := pdiv #|U|; have piUp: p \in \pi(U) by rewrite pi_pdiv cardG_gt1. - have sk'p := pnatPpi sk'U piUp. - have [S sylS] := Sylow_exists p U; have [sSU _] := andP sylS. - have sylS_M := subHall_Sylow hallU sk'p sylS. - have [|_ _ regMsS1 nilMs] := sigma'_kappa'_facts maxM sylS_M. - by rewrite -negb_or (piSg sUM). - by split=> //; apply/trivgP; rewrite -regMsS1 setIS ?centS ?gFsub_trans. -have [[_ F _ defF] _ _ _] := sdprodP defM; rewrite defF in defM. -have hallMs: \sigma(M).-Hall(M) Ms by apply: Msigma_Hall. -have hallF: \sigma(M)^'.-Hall(M) F by apply/(sdprod_Hall_pcoreP hallMs). -have frF: [Frobenius F = U ><| K] by apply/Frobenius_semiregularP. -have ntMs: Ms != 1 by apply: Msigma_neq1. -have prK: prime #|K|. - have [solF [_ _ nMsF _]] := (sigma_compl_sol hallF, sdprodP defM). - have solMs: solvable Ms := solvableS (pcore_sub _ _) (mmax_sol maxM). - have coMsF: coprime #|Ms| #|F|. - by rewrite (coprime_sdprod_Hall_r defM) (pHall_Hall hallF). - by have [] := Frobenius_primact frF solF nMsF solMs ntMs coMsF prMsK. -have eq_sb: \sigma(M) =i \beta(M). - suffices bMs: \beta(M).-group Ms. - move=> p; apply/idP/idP=> [sp|]; last exact: beta_sub_sigma. - rewrite (pnatPpi bMs) //= (card_Hall (Msigma_Hall maxM)) pi_of_part //. - by rewrite inE /= sigma_sub_pi. - have [H hallH cHF'] := der_compl_cent_beta' maxM hallF. - rewrite -pgroupNK -partG_eq1 -(card_Hall hallH) -trivg_card1 -subG1. - rewrite -regMsU subsetI (pHall_sub hallH) centsC (subset_trans _ cHF') //. - have [solU [_ mulUK nUK _]] := (abelian_sol cUU, sdprodP defF). - have coUK: coprime #|U| #|K|. - rewrite (p'nat_coprime (sub_pgroup _ (pHall_pgroup hallU)) kK) // => p. - by case/norP. - rewrite -(coprime_cent_prod nUK) // (cent_semiregular regUK) // mulg1. - by rewrite -mulUK commgSS ?mulG_subl ?mulG_subr. -split=> //; apply/normedTI_P; rewrite setD_eq0 subG1 setTI normD1 gFnorm. -split=> // g _; rewrite -setI_eq0 conjD1g -setDIl setD_eq0 subG1 /= -/Ms. -have [_ _ b'MsMg] := sigma_compl_embedding maxM hallE. -apply: contraR => notMg; have{b'MsMg notMg} [_ b'MsMg _] := b'MsMg g notMg. -rewrite -{2}(setIidPr (pHall_sub hallMs)) conjIg setIA coprime_TIg // cardJg. -by apply: p'nat_coprime b'MsMg _; rewrite -(eq_pnat _ eq_sb). -Qed. - -(* This is essentially the skolemized form of 14.2(a). *) -Lemma kappa_compl_context M U K : - M \in 'M -> kappa_complement M U K -> - [/\ \sigma(M)^'.-Hall(M) (U <*> K), - M`_\sigma ><| (U ><| K) = M, - semiprime M`_\sigma K, - semiregular U K - & K :!=: 1 -> abelian U]. -Proof. -move=> maxM [hallU hallK gsetUK]; set E := U <*> K. -have mulUK: U * K = E by rewrite -(gen_set_id gsetUK) genM_join. -have [[sKM kK _] [sUM sk'U _]] := (and3P hallK, and3P hallU). -have tiUK: U :&: K = 1. - by apply: coprime_TIg (p'nat_coprime (sub_pgroup _ sk'U) kK) => p; case/norP. -have hallE: \sigma(M)^'.-Hall(M) E. - rewrite pHallE /= -/E -mulUK mul_subG //= TI_cardMg //. - rewrite -(partnC \kappa(M) (part_gt0 _ _)) (partn_part _ (@kappa_sigma' M)). - apply/eqP; rewrite -partnI -(card_Hall hallK) mulnC; congr (_ * _)%N. - by rewrite (card_Hall hallU); apply: eq_partn => p; apply: negb_or. -have [K1 | ntK] := altP (K :=P: 1). - rewrite K1 sdprodg1 -{1}(mulg1 U) -{1}K1 mulUK sdprod_sigma //. - by split=> //; first apply: semiregular_prime; apply: semiregular1r. -have PmaxM: M \in 'M_'P by rewrite inE maxM -(trivg_kappa maxM hallK) andbT. -have [[V [complV defM] [cVV prK regK]] _ _ _ _] := Ptype_structure PmaxM hallK. -have [[_ F _ defF] _ _ _] := sdprodP defM; rewrite defF in defM. -have hallF: \sigma(M)^'.-Hall(M) F. - exact/(sdprod_Hall_pcoreP (Msigma_Hall maxM)). -have [a Ma /= defFa] := Hall_trans (mmax_sol maxM) hallE hallF. -have [hallV _ _] := complV; set sk' := \sigma_kappa(M)^' in hallU hallV sk'U. -have [nsVF sKF _ _ _] := sdprod_context defF. -have [[[sVF _] [sFM _]] [sEM _]] := (andP nsVF, andP hallF, andP hallE). -have hallV_F: sk'.-Hall(F) V := pHall_subl sVF sFM hallV. -have hallU_E: sk'.-Hall(E) U := pHall_subl (joing_subl _ _) sEM hallU. -have defV: 'O_sk'(F) = V := normal_Hall_pcore hallV_F nsVF. -have hallEsk': sk'.-Hall(E) 'O_sk'(E). - by rewrite [E]defFa pcoreJ pHallJ2 /= defV. -have defU: 'O_sk'(E) = U by rewrite (eq_Hall_pcore hallEsk' hallU_E). -have nUE: E \subset 'N(U) by rewrite -defU gFnorm. -have hallK_E: \kappa(M).-Hall(E) K := pHall_subl (joing_subr _ _) sEM hallK. -have hallK_F: \kappa(M).-Hall(F) K := pHall_subl sKF sFM hallK. -have hallKa_E: \kappa(M).-Hall(E) (K :^ a) by rewrite [E]defFa pHallJ2. -have [b Eb /= defKab] := Hall_trans (sigma_compl_sol hallE) hallK_E hallKa_E. -have defVa: V :^ a = U by rewrite -defV -pcoreJ -defFa defU. -split=> // [| x Kx | _]; last by rewrite -defVa abelianJ. - by rewrite [U ><| K]sdprodEY ?sdprod_sigma //; case/joing_subP: nUE. -rewrite -(conjgKV (a * b) x) -(normsP nUE b Eb) -defVa -conjsgM. -rewrite -cent_cycle cycleJ centJ -conjIg cent_cycle regK ?conjs1g //. -by rewrite -mem_conjg conjD1g conjsgM -defKab. -Qed. - -(* This is B & G, Corollary 14.3. *) -Corollary pi_of_cent_sigma M x x' : - M \in 'M -> x \in (M`_\sigma)^# -> - x' \in ('C_M[x])^# -> \sigma(M)^'.-elt x' -> - (*1*) \kappa(M).-elt x' /\ 'C[x] \subset M - \/ (*2*) [/\ \tau2(M).-elt x', \ell_\sigma(x') == 1%N & 'M('C[x']) = [set M]]. -Proof. -move: x' => y maxM /setD1P[ntx Ms_x] /setD1P[nty cMxy] s'y. -have [My cxy] := setIP cMxy. -have [t2y | not_t2y] := boolP (\tau2(M).-elt y); [right | left]. - have uniqCy: 'M('C[y]) = [set M]; last split=> //. - apply: cent1_nreg_sigma_uniq; rewrite // ?inE ?nty //. - by apply/trivgPn; exists x; rewrite // inE Ms_x cent1C. - pose p := pdiv #[y]; have piYp: p \in \pi(#[y]) by rewrite pi_pdiv order_gt1. - have t2p := pnatPpi t2y piYp; have [E hallE] := ex_sigma_compl maxM. - have [A Ep2A _] := ex_tau2Elem hallE t2p. - have pA: p.-group A by case/pnElemP: Ep2A => _ /andP[]. - have ntA: A :!=: 1 by rewrite (nt_pnElem Ep2A). - have [H maxNH] := mmax_exists (mFT_norm_proper ntA (mFT_pgroup_proper pA)). - have [st2MsH _ _] := primes_norm_tau2Elem maxM hallE t2p Ep2A maxNH. - have [maxH _] := setIdP maxNH. - have sHy: \sigma(H).-elt y by apply: sub_p_elt t2y => q /st2MsH/andP[]. - rewrite /sigma_length (cardsD1 y.`_(\sigma(H))). - rewrite mem_sigma_decomposition //; last by rewrite constt_p_elt. - rewrite eqSS -sigma_decomposition_constt' //. - by apply/ell_sigma0P; rewrite (constt1P _) ?p_eltNK. -have{not_t2y} [p piYp t2'p]: exists2 p, p \in \pi(#[y]) & p \notin \tau2(M). - by apply/allPn; rewrite negb_and cardG_gt0 in not_t2y. -have sYM: <[y]> \subset M by rewrite cycle_subG. -have piMp: p \in \pi(M) := piSg sYM piYp. -have t13p: p \in [predU \tau1(M) & \tau3(M)]. - move: piMp; rewrite partition_pi_mmax // (negPf t2'p) /= orbA. - by case/orP=> // sMy; case/negP: (pnatPpi s'y piYp). -have [X]: exists X, X \in 'E_p^1(<[y]>) by apply/p_rank_geP; rewrite p_rank_gt0. -rewrite -(setIidPr sYM) pnElemI -setIdE => /setIdP[EpX sXy]. -have kp: p \in \kappa(M). - rewrite unlock; apply/andP; split=> //; apply/exists_inP; exists X => //. - apply/trivgPn; exists x; rewrite // inE Ms_x (subsetP (centS sXy)) //. - by rewrite cent_cycle cent1C. -have [sXM abelX dimX] := pnElemP EpX; have [pX _] := andP abelX. -have [K hallK sXK] := Hall_superset (mmax_sol maxM) sXM (pi_pgroup pX kp). -have PmaxM: M \in 'M_'P. - by rewrite 2!inE maxM andbT; apply: contraL kp => k'M; apply: (pnatPpi k'M). -have [_ [defNK defNX] [_ uniqCKs] _ _] := Ptype_structure PmaxM hallK. -have{defNX} sCMy_nMK: 'C_M[y] \subset 'N_M(K). - have [|<- _] := defNX X. - by apply/nElemP; exists p; rewrite !inE sXK abelX dimX. - by rewrite setIS // cents_norm // -cent_cycle centS. -have [[sMK kK _] [_ mulKKs cKKs _]] := (and3P hallK, dprodP defNK). -have s'K: \sigma(M)^'.-group K := sub_pgroup (@kappa_sigma' M) kK. -have sMs: \sigma(M).-group M`_\sigma := pcore_pgroup _ M. -have sKs: \sigma(M).-group 'C_(M`_\sigma)(K) := pgroupS (subsetIl _ _) sMs. -have{s'K sKs} [hallK_N hallKs] := coprime_mulGp_Hall mulKKs s'K sKs. -split. - rewrite (mem_p_elt kK) // (mem_normal_Hall hallK_N) ?normal_subnorm //. - by rewrite (subsetP sCMy_nMK) // inE My cent1id. -have Mx: x \in M := subsetP (pcore_sub _ _) x Ms_x. -have sxKs: <[x]> \subset 'C_(M`_\sigma)(K). - rewrite cycle_subG (mem_normal_Hall hallKs) ?(mem_p_elt sMs) //=. - by rewrite -mulKKs /normal mulG_subr mulG_subG normG cents_norm // centsC. - by rewrite (subsetP sCMy_nMK) // inE Mx cent1C. -have /rank_geP[Z]: 0 < 'r(<[x]>) by rewrite rank_gt0 cycle_eq1. -rewrite /= -(setIidPr sxKs) nElemI -setIdE => /setIdP[E1KsZ sZx]. -have [_ sCZM] := mem_uniq_mmax (uniqCKs Z E1KsZ). -by rewrite (subset_trans _ sCZM) // -cent_cycle centS. -Qed. - -(* This is B & G, Theorem 14.4. *) -(* We are omitting the first half of part (a), since we have taken it as our *) -(* definition of 'R[x]. *) -Theorem FT_signalizer_context x (N := 'N[x]) (R := 'R[x]) : - \ell_\sigma(x) == 1%N -> - [/\ [/\ [transitive R, on 'M_\sigma[x] | 'JG], - #|R| = #|'M_\sigma[x]|, - R <| 'C[x] - & Hall 'C[x] R] - & #|'M_\sigma[x]| > 1 -> - [/\ 'M('C[x]) = [set N], - (*a*) R :!=: 1, - (*c1*) \tau2(N).-elt x, - (*f*) N \in 'M_'F :|: 'M_'P2 - & {in 'M_\sigma[x], forall M, - [/\ (*b*) R ><| 'C_(M :&: N)[x] = 'C[x], - (*c2*) {subset \tau2(N) <= \sigma(M)}, - (*d*) {subset [predI \pi(M) & \sigma(N)] <= \beta(N)} - & (*e*) \sigma(N)^'.-Hall(N) (M :&: N)]}]]. -Proof. -rewrite {}/N {}/R => ell1x; have [ntx ntMSx] := ell_sigma1P x ell1x. -have [M MSxM] := set0Pn _ ntMSx; have [maxM Ms_x] := setIdP MSxM. -rewrite cycle_subG in Ms_x; have sMx := mem_p_elt (pcore_pgroup _ M) Ms_x. -have Mx: x \in M := subsetP (pcore_sub _ _) x Ms_x. -have [MSx_le1 | MSx_gt1] := leqP _ 1. - rewrite /'R[x] /'N[x] ltnNge MSx_le1 (trivgP (pcore_sub _ _)) setI1g normal1. - have <-: [set M] = 'M_\sigma[x]. - by apply/eqP; rewrite eqEcard sub1set MSxM cards1. - by rewrite /Hall atrans_acts_card ?imset_set1 ?cards1 ?sub1G ?coprime1n. -have [q pi_x_q]: exists q, q \in \pi(#[x]). - by exists (pdiv #[x]); rewrite pi_pdiv order_gt1. -have{sMx} sMq: q \in \sigma(M) := pnatPpi sMx pi_x_q. -have [X EqX]: exists X, X \in 'E_q^1(<[x]>). - by apply/p_rank_geP; rewrite p_rank_gt0. -have [sXx abelX dimX] := pnElemP EqX; have [qX cXX _] := and3P abelX. -have ntX: X :!=: 1 := nt_pnElem EqX isT. -have sXM: X \subset M by rewrite (subset_trans sXx) ?cycle_subG. -have [N maxNX_N] := mmax_exists (mFT_norm_proper ntX (mFT_pgroup_proper qX)). -have [maxN sNX_N] := setIdP maxNX_N; pose R := 'C_(N`_\sigma)[x]%G. -have sCX_N: 'C(X) \subset N := subset_trans (cent_sub X) sNX_N. -have sCx_N: 'C[x] \subset N by rewrite -cent_cycle (subset_trans (centS sXx)). -have sMSx_MSX: 'M_\sigma[x] \subset 'M_\sigma(X). - apply/subsetP=> M1 /setIdP[maxM1 sxM1]. - by rewrite inE maxM1 (subset_trans sXx). -have nsRCx: R <| 'C[x] by rewrite /= setIC (normalGI sCx_N) ?pcore_normal. -have hallR: \sigma(N).-Hall('C[x]) R. - exact: setI_normal_Hall (pcore_normal _ _) (Msigma_Hall maxN) sCx_N. -have transCX: [transitive 'C(X), on 'M_\sigma(X) | 'JG]. - have [_ trCX _ ] := sigma_group_trans maxM sMq qX. - case/imsetP: trCX => _ /setIdP[/imsetP[y _ ->] sXMy] trCX. - have maxMy: (M :^ y)%G \in 'M by rewrite mmaxJ. - have sXMys: X \subset (M :^ y)`_\sigma. - by rewrite (sub_Hall_pcore (Msigma_Hall _)) // (pi_pgroup qX) ?sigmaJ. - apply/imsetP; exists (M :^ y)%G; first exact/setIdP. - apply/setP=> Mz; apply/setIdP/imsetP=> [[maxMz sXMzs] | [z cXz -> /=]]. - suffices: gval Mz \in orbit 'Js 'C(X) (M :^ y). - by case/imsetP=> z CXz /group_inj->; exists z. - rewrite -trCX inE andbC (subset_trans sXMzs) ?pcore_sub //=. - apply/idPn => /(sigma_partition maxM maxMz)/=/(_ q)/idP[]. - rewrite inE /= sMq (pnatPpi (pgroupS sXMzs (pcore_pgroup _ _))) //. - by rewrite -p_rank_gt0 p_rank_abelem ?dimX. - by rewrite mmaxJ -(normP (subsetP (cent_sub X) z cXz)) MsigmaJ conjSg. -have MSX_M: M \in 'M_\sigma(X) := subsetP sMSx_MSX M MSxM. -have not_sCX_M: ~~ ('C(X) \subset M). - apply: contraL MSx_gt1 => sCX_M. - rewrite -leqNgt (leq_trans (subset_leq_card sMSx_MSX)) //. - rewrite -(atransP transCX _ MSX_M) card_orbit astab1JG. - by rewrite (setIidPl (normsG sCX_M)) indexgg. -have neqNM: N :!=: M by apply: contraNneq not_sCX_M => <-. -have maxNX'_N: N \in 'M('N(X)) :\ M by rewrite 2!inE neqNM. -have [notMGN _] := sigma_subgroup_embedding maxM sMq sXM qX ntX maxNX'_N. -have sN'q: q \notin \sigma(N). - by apply: contraFN (sigma_partition maxM maxN notMGN q) => sNq; apply/andP. -rewrite (negPf sN'q) => [[t2Nq s_piM_bN hallMN]]. -have defN: N`_\sigma ><| (M :&: N) = N. - exact/(sdprod_Hall_pcoreP (Msigma_Hall maxN)). -have Nx: x \in N by rewrite (subsetP sCx_N) ?cent1id. -have MNx: x \in M :&: N by rewrite inE Mx. -have sN'x: \sigma(N)^'.-elt x by rewrite (mem_p_elt (pHall_pgroup hallMN)). -have /andP[sNsN nNsN]: N`_\sigma <| N := pcore_normal _ _. -have nNs_x: x \in 'N(N`_\sigma) := subsetP nNsN x Nx. -have defCx: R ><| 'C_(M :&: N)[x] = 'C[x]. - rewrite -{2}(setIidPr sCx_N) /= -cent_cycle (subcent_sdprod defN) //. - by rewrite subsetI andbC normsG ?cycle_subG. -have transR: [transitive R, on 'M_\sigma[x] | 'JG]. - apply/imsetP; exists M => //; apply/setP=> L. - apply/idP/imsetP=> [MSxL | [u Ru ->{L}]]; last first. - have [_ cxu] := setIP Ru; rewrite /= -cent_cycle in cxu. - by rewrite -(normsP (cent_sub _) u cxu) sigma_mmaxJ. - have [u cXu defL] := atransP2 transCX MSX_M (subsetP sMSx_MSX _ MSxL). - have [_ mulMN nNsMN tiNsMN] := sdprodP defN. - have:= subsetP sCX_N u cXu; rewrite -mulMN -normC //. - case/imset2P=> v w /setIP[Mv _] Ns_w def_u; exists w => /=; last first. - by apply: group_inj; rewrite defL /= def_u conjsgM (conjGid Mv). - rewrite inE Ns_w -groupV (sameP cent1P commgP) -in_set1 -set1gE -tiNsMN. - rewrite setICA setIC (setIidPl sNsN) inE groupMl ?groupV //. - rewrite memJ_norm // groupV Ns_w /= -(norm_mmax maxM) inE sub_conjg. - rewrite invg_comm -(conjSg _ _ w) -{2}(conjGid Mx) -!conjsgM -conjg_Rmul. - rewrite -conjgC conjsgM -(conjGid Mv) -(conjsgM M) -def_u. - rewrite -[M :^ u](congr_group defL) conjGid // -cycle_subG. - by have [_ Ls_x] := setIdP MSxL; rewrite (subset_trans Ls_x) ?pcore_sub. -have oR: #|R| = #|'M_\sigma[x]|. - rewrite -(atransP transR _ MSxM) card_orbit astab1JG (norm_mmax maxM). - rewrite -setIAC /= -{3}(setIidPl sNsN) -(setIA _ N) -(setIC M). - by have [_ _ _ ->] := sdprodP defN; rewrite setI1g indexg1. -have ntR: R :!=: 1 by rewrite -cardG_gt1 oR. -have [y Ns_y CNy_x]: exists2 y, y \in (N`_\sigma)^# & x \in ('C_N[y])^#. - have [y Ry nty] := trivgPn _ ntR; have [Ns_y cxy] := setIP Ry. - by exists y; rewrite 2!inE ?nty // inE Nx cent1C ntx. -have kN'q: q \notin \kappa(N). - rewrite (contra (@kappa_tau13 N q)) // negb_or (contraL (@tau2'1 _ _ _)) //. - exact: tau3'2. -have [[kNx _] | [t2Nx _ uniqN]] := pi_of_cent_sigma maxN Ns_y CNy_x sN'x. - by case/idPn: (pnatPpi kNx pi_x_q). -have defNx: 'N[x] = N. - apply/set1P; rewrite -uniqN /'N[x] MSx_gt1. - by case: pickP => // /(_ N); rewrite uniqN /= set11. -rewrite /'R[x] {}defNx -(erefl (gval R)) (pHall_Hall hallR). -split=> // _; split=> // [|L MSxL]. - rewrite !(maxN, inE) /=; case: (pgroup _ _) => //=; rewrite andbT. - apply: contra kN'q => skN_N; have:= pnatPpi (mem_p_elt skN_N Nx) pi_x_q. - by case/orP=> //=; rewrite (negPf sN'q). -have [u Ru ->{L MSxL}] := atransP2 transR MSxM MSxL; rewrite /= cardJg. -have [Ns_u cxu] := setIP Ru; have Nu := subsetP sNsN u Ns_u. -rewrite -{1}(conjGid Ru) -(conjGid cxu) -{1 6 7}(conjGid Nu) -!conjIg pHallJ2. -split=> // [|p t2Np]. - rewrite /= -(setTI 'C[x]) -!(setICA setT) -!morphim_conj. - exact: injm_sdprod (subsetT _) (injm_conj _ _) defCx. -have [A Ep2A _] := ex_tau2Elem hallMN t2Np. -have [[nsAMN _] _ _ _] := tau2_compl_context maxN hallMN t2Np Ep2A. -have{Ep2A} Ep2A: A \in 'E_p^2(M) by move: Ep2A; rewrite pnElemI; case/setIP. -have rpM: 'r_p(M) > 1 by apply/p_rank_geP; exists A. -have: p \in \pi(M) by rewrite -p_rank_gt0 ltnW. -rewrite sigmaJ partition_pi_mmax // !orbA; case/orP=> //. -rewrite orbAC -2!andb_orr -(subnKC rpM) andbF /= => t2Mp. -case/negP: ntX; rewrite -subG1 (subset_trans sXx) //. -have [_ _ <- _ _] := tau2_context maxM t2Mp Ep2A. -have [[sAM abelA _] [_ nAMN]] := (pnElemP Ep2A, andP nsAMN). -rewrite -coprime_norm_cent ?(subset_trans sAM) ?gFnorm //. - by rewrite cycle_subG inE Ms_x (subsetP nAMN). -have [[sM'p _] [pA _]] := (andP t2Mp, andP abelA). -exact: pnat_coprime (pcore_pgroup _ _) (pi_pgroup pA sM'p). -Qed. - -(* A useful supplement to Theorem 14.4. *) -Lemma cent1_sub_uniq_sigma_mmax x M : - #|'M_\sigma[x]| == 1%N -> M \in 'M_\sigma[x] -> 'C[x] \subset M. -Proof. -move: M => M0 /cards1P[M defMSx] MS_M0; move: MS_M0 (MS_M0). -rewrite {1}defMSx => /set1P->{M0} MSxM; have [maxM _] := setIdP MSxM. -rewrite -(norm_mmax maxM); apply/normsP=> y cxy; apply: congr_group. -by apply/set1P; rewrite -defMSx -(mulKg y x) (cent1P cxy) cycleJ sigma_mmaxJ. -Qed. - -Remark cent_FT_signalizer x : x \in 'C('R[x]). -Proof. by rewrite -sub_cent1 subsetIr. Qed. - -(* Because the definition of 'N[x] uses choice, we can only prove it commutes *) -(* with conjugation now that we have established that the choice is unique. *) -Lemma FT_signalizer_baseJ x z : 'N[x ^ z] :=: 'N[x] :^ z. -Proof. -case MSx_gt1: (#|'M_\sigma[x]| > 1); last first. - by rewrite /'N[x] /'N[_] cycleJ card_sigma_mmaxJ MSx_gt1 conjs1g. -have [x1 | ntx] := eqVneq x 1. - rewrite x1 conj1g /'N[1] /= norm1. - case: pickP => [M maxTM | _]; last by rewrite if_same conjs1g. - by have [maxM] := setIdP maxTM; case/idPn; rewrite proper_subn ?mmax_proper. -apply: congr_group; apply/eqP; rewrite eq_sym -in_set1. -have ell1xz: \ell_\sigma(x ^ z) == 1%N. - by rewrite ell_sigmaJ; apply/ell_sigma1P; rewrite -cards_eq0 -lt0n ltnW. -have [_ [|<- _ _ _ _]] := FT_signalizer_context ell1xz. - by rewrite cycleJ card_sigma_mmaxJ. -rewrite -conjg_set1 normJ mmax_ofJ; rewrite ell_sigmaJ in ell1xz. -by have [_ [//|-> _ _ _ _]] := FT_signalizer_context ell1xz; apply: set11. -Qed. - -Lemma FT_signalizerJ x z : 'R[x ^ z] :=: 'R[x] :^ z. -Proof. -by rewrite /'R[x] /'R[_] FT_signalizer_baseJ MsigmaJ -conjg_set1 normJ conjIg. -Qed. - -Lemma sigma_coverJ x z : x ^ z *: 'R[x ^ z] = (x *: 'R[x]) :^ z. -Proof. by rewrite FT_signalizerJ conjsMg conjg_set1. Qed. - -Lemma sigma_supportJ M z : (M :^ z)^~~ = M^~~ :^ z. -Proof. -rewrite -bigcupJ /_^~~ MsigmaJ -conjD1g (big_imset _ (in2W (act_inj 'J z))) /=. -by apply: eq_bigr => x _; rewrite sigma_coverJ. -Qed. - -(* This is the remark imediately above B & G, Lemma 14.5; note the adjustment *) -(* allowing for the case x' = 1. *) -Remark sigma_cover_decomposition x x' : - \ell_\sigma(x) == 1%N -> x' \in 'R[x] -> - sigma_decomposition (x * x') = x |: [set x']^#. -Proof. -move=> ell1x Rx'; have [-> | ntx'] := eqVneq x' 1. - by rewrite mulg1 setDv setU0 ell1_decomposition. -rewrite setDE (setIidPl _) ?sub1set ?inE // setUC. -have ntR: #|'R[x]| > 1 by rewrite cardG_gt1; apply/trivgPn; exists x'. -have [Ns_x' cxx'] := setIP Rx'; move/cent1P in cxx'. -have [[_ <- _ _] [//| maxN _ t2Nx _ _]] := FT_signalizer_context ell1x. -have{maxN} [maxN _] := mem_uniq_mmax maxN. -have sNx' := mem_p_elt (pcore_pgroup _ _) Ns_x'. -have sN'x: \sigma('N[x])^'.-elt x by apply: sub_p_elt t2Nx => p /andP[]. -have defx': (x * x').`_\sigma('N[x]) = x'. - by rewrite consttM // (constt1P sN'x) mul1g constt_p_elt. -have sd_xx'_x': x' \in sigma_decomposition (x * x'). - by rewrite 2!inE ntx' -{1}defx'; apply: mem_imset. -rewrite -(setD1K sd_xx'_x') -{3}defx' -sigma_decomposition_constt' ?consttM //. -by rewrite constt_p_elt // (constt1P _) ?p_eltNK ?mulg1 // ell1_decomposition. -Qed. - -(* This is the simplified form of remark imediately above B & G, Lemma 14.5. *) -Remark nt_sigma_cover_decomposition x x' : - \ell_\sigma(x) == 1%N -> x' \in 'R[x]^# -> - sigma_decomposition (x * x') = [set x; x']. -Proof. -move=> ell1x /setD1P[ntx' Rx']; rewrite sigma_cover_decomposition //. -by rewrite setDE (setIidPl _) ?sub1set ?inE // setUC. -Qed. - -Remark mem_sigma_cover_decomposition x g : - \ell_\sigma(x) == 1%N -> g \in x *: 'R[x] -> x \in sigma_decomposition g. -Proof. -by move=> ell1x /lcosetP[x' Rx' ->]; rewrite sigma_cover_decomposition ?setU11. -Qed. - -Remark ell_sigma_cover x g : - \ell_\sigma(x) == 1%N -> g \in x *: 'R[x] -> \ell_\sigma(g) <= 2. -Proof. -move=> ell1x /lcosetP[x' Rx' ->]. -rewrite /(\ell_\sigma(_)) sigma_cover_decomposition // cardsU1. -by rewrite (leq_add (leq_b1 _)) // -(cards1 x') subset_leq_card ?subsetDl. -Qed. - -Remark ell_sigma_support M g : M \in 'M -> g \in M^~~ -> \ell_\sigma(g) <= 2. -Proof. -by move=> maxM /bigcupP[x Msx]; apply: ell_sigma_cover; apply: Msigma_ell1 Msx. -Qed. - -(* This is B & G, Lemma 14.5(a). *) -Lemma sigma_cover_disjoint x y : - \ell_\sigma(x) == 1%N -> \ell_\sigma(y) == 1%N -> x != y -> - [disjoint x *: 'R[x] & y *: 'R[y]]. -Proof. -move=> ell1x ell1y neq_xy; apply/pred0P=> g /=. -have [[ntx _] [nty _]] := (ell_sigma1P x ell1x, ell_sigma1P y ell1y). -apply: contraNF (ntx) => /andP[/lcosetP[x' Rxx' ->{g}] /= yRy_xx']. -have def_y: y = x'. - apply: contraTeq (mem_sigma_cover_decomposition ell1y yRy_xx') => neq_yx'. - by rewrite sigma_cover_decomposition // !inE negb_or nty eq_sym neq_xy. -have [[_ <- _ _] [|uniqCx _ _ _ _]] := FT_signalizer_context ell1x. - by rewrite cardG_gt1; apply/trivgPn; exists x'; rewrite // -def_y. -have{uniqCx} [maxNx sCxNx] := mem_uniq_mmax uniqCx. -have Rx_y: y \in 'R[x] by [rewrite def_y]; have [Nxs_y cxy] := setIP Rx_y. -have Ry_x: x \in 'R[y]. - by rewrite -def_y -(cent1P cxy) mem_lcoset mulKg in yRy_xx'. -have MSyNx: 'N[x] \in 'M_\sigma[y] by rewrite inE maxNx cycle_subG. -have [[_ <- _ _] [|uniqCy _ _ _]] := FT_signalizer_context ell1y. - by rewrite cardG_gt1; apply/trivgPn; exists x. -have{uniqCy} [_ sCyNy] := mem_uniq_mmax uniqCy. -case/(_ 'N[x] MSyNx)=> /sdprodP[_ _ _ tiRyNx] _ _ _. -rewrite -in_set1 -set1gE -tiRyNx -setIA (setIidPr sCyNy) inE Ry_x /=. -by rewrite inE cent1C cxy (subsetP sCxNx) ?cent1id. -Qed. - -(* This is B & G, Lemma 14.5(b). *) -Lemma sigma_support_disjoint M1 M2 : - M1 \in 'M -> M2 \in 'M -> gval M2 \notin M1 :^: G -> [disjoint M1^~~ & M2^~~]. -Proof. -move=> maxM1 maxM2 notM1GM2; rewrite -setI_eq0 -subset0 big_distrl. -apply/bigcupsP=> x M1s_x; rewrite big_distrr; apply/bigcupsP=> y M2s_y /=. -have [ell1x ell1y] := (Msigma_ell1 maxM1 M1s_x, Msigma_ell1 maxM2 M2s_y). -rewrite subset0 setI_eq0 sigma_cover_disjoint //. -have{M1s_x M2s_y}[[ntx M1s_x] [_ M2s_y]] := (setD1P M1s_x, setD1P M2s_y). -pose p := pdiv #[x]; have pixp: p \in \pi(#[x]) by rewrite pi_pdiv order_gt1. -apply: contraFN (sigma_partition maxM1 maxM2 notM1GM2 p) => eq_xy. -rewrite inE /= (pnatPpi (mem_p_elt (pcore_pgroup _ _) M1s_x)) //=. -by rewrite (pnatPpi (mem_p_elt (pcore_pgroup _ _) M2s_y)) -?(eqP eq_xy). -Qed. - -(* This is B & G, Lemma 14.5(c). *) -Lemma card_class_support_sigma M : - M \in 'M -> #|class_support M^~~ G| = (#|M`_\sigma|.-1 * #|G : M|)%N. -Proof. -move=> maxM; rewrite [#|M`_\sigma|](cardsD1 1) group1 /=. -set MsG := class_support (M`_\sigma)^# G; pose P := [set x *: 'R[x] | x in MsG]. -have ellMsG x: x \in MsG -> \ell_\sigma(x) == 1%N. - by case/imset2P=> y z My _ ->; rewrite ell_sigmaJ (Msigma_ell1 maxM). -have tiP: trivIset P. - apply/trivIsetP=> _ _ /imsetP[x MsGx ->] /imsetP[y MsGy ->] neq_xRyR. - by rewrite sigma_cover_disjoint ?ellMsG //; apply: contraNneq neq_xRyR => ->. -have->: class_support M^~~ G = cover P. - apply/setP=> az; apply/imset2P/bigcupP=> [[a z] | [xRz]]. - case/bigcupP=> x Ms_x xRa Gz ->; exists (x ^ z *: 'R[x ^ z]). - by apply: mem_imset; apply: mem_imset2. - by rewrite sigma_coverJ memJ_conjg. - case/imsetP=> _ /imset2P[x z Ms_x Gz ->] ->; rewrite sigma_coverJ. - by case/imsetP=> a xRa ->; exists a z => //; apply/bigcupP; exists x. -rewrite -(eqnP tiP) big_imset /= => [|x y MsGx MsGy eq_xyR]; last first. - have: x *: 'R[x] != set0 by rewrite -cards_eq0 -lt0n card_lcoset cardG_gt0. - rewrite -[x *: _]setIid {2}eq_xyR setI_eq0. - by apply: contraNeq => neq_xy; rewrite sigma_cover_disjoint ?ellMsG. -rewrite -{2}(norm_mmax maxM) -astab1JG -indexgI -card_orbit. -set MG := orbit _ G M; rewrite mulnC -sum_nat_const. -transitivity (\sum_(Mz in MG) \sum_(x in (Mz`_\sigma)^#) 1); last first. - apply: eq_bigr => _ /imsetP[z _ ->]; rewrite sum1_card MsigmaJ. - by rewrite -conjD1g cardJg. -rewrite (exchange_big_dep (mem MsG)) /= => [|Mz xz]; last first. - case/imsetP=> z Gz ->; rewrite MsigmaJ -conjD1g => /imsetP[x Ms_x ->{xz}]. - exact: mem_imset2. -apply: eq_bigr => x MsGx; rewrite card_lcoset sum1dep_card. -have ell1x := ellMsG x MsGx; have [ntx _] := ell_sigma1P x ell1x. -have [[transRx -> _ _] _] := FT_signalizer_context ell1x. -apply: eq_card => Mz; rewrite 2!inE cycle_subG in_setD1 ntx /=. -apply: andb_id2r => Mzs_x. -apply/idP/imsetP=> [maxMz | [z _ ->]]; last by rewrite mmaxJ. -have [y t Ms_y _ def_x] := imset2P MsGx; have{Ms_y} [_ Ms_y] := setD1P Ms_y. -have [MSxMz MSxMt]: Mz \in 'M_\sigma[x] /\ (M :^ t)%G \in 'M_\sigma[x]. - by rewrite {2}def_x cycleJ sigma_mmaxJ inE maxMz inE maxM !cycle_subG. -have [z _ ->] := atransP2 transRx MSxMt MSxMz. -by exists (t * z); rewrite ?inE ?actM. -Qed. - -(* This is B & G, Lemma 14.6. *) -Lemma sigma_decomposition_dichotomy (g : gT) : - g != 1 -> - [exists (x | \ell_\sigma(x) == 1%N), x^-1 * g \in 'R[x]] - (+) [exists (y | \ell_\sigma(y) == 1%N), - let y' := y^-1 * g in - [exists M in 'M_\sigma[y], (y' \in ('C_M[y])^#) && \kappa(M).-elt y']]. -Proof. -move=> ntg; have [[x ell1x Rx'] | ] := altP exists_inP. - rewrite /= negb_exists_in; apply/forall_inP=> y ell1y. - set y' := y^-1 * g; set x' := x^-1 * g in Rx'. - apply/existsP=> -[M /and3P[MSyM CMy_y' kMy']]. - have [maxM Ms_y] := setIdP MSyM; rewrite cycle_subG in Ms_y. - have [nty'] := setD1P CMy_y'; case/setIP=> My'; move/cent1P=> cyy'. - have [[nty _] sMy]:= (ell_sigma1P y ell1y, mem_p_elt (pcore_pgroup _ _) Ms_y). - have sM'y': \sigma(M)^'.-elt y' := sub_p_elt (@kappa_sigma' M) kMy'. - have t2M'y': \tau2(M)^'.-elt y'. - apply: sub_p_elt kMy' => p; move/kappa_tau13. - by case/orP; [apply: tau2'1 | apply: contraL; apply: tau3'2]. - have xx'_y: y \in pred2 x x'. - suffices: y \in x |: [set x']^# by rewrite !inE nty. - rewrite -sigma_cover_decomposition // mulKVg 2!inE nty /=. - apply/imsetP; exists M => //; rewrite -(mulKVg y g) -/y' consttM //. - by rewrite (constt_p_elt sMy) (constt1P sM'y') mulg1. - have nt_x': x' != 1 by case/pred2P: xx'_y; rewrite /x' => <-. - have maxCY_M: M \in 'M('C[y]). - have Ms1_y: y \in (M`_\sigma)^# by apply/setD1P. - rewrite inE maxM; case/pi_of_cent_sigma: CMy_y' => // [[//] | [t2y']]. - by rewrite -order_eq1 (pnat_1 t2y' t2M'y') in nty'. - have [[_ <- _ _] [|uniqNx _ t2Nx _ _]] := FT_signalizer_context ell1x. - by rewrite cardG_gt1; apply/trivgPn; exists x'. - rewrite -order_gt1 (pnat_1 sMy _) // -/(_.-elt _) in nty. - have{xx'_y} [eq_yx | eq_yx']: y = x \/ y = x' := pred2P xx'_y. - rewrite eq_yx uniqNx in maxCY_M *; rewrite (set1P maxCY_M). - by apply: sub_p_elt t2Nx => p; case/andP. - have eq_xy': x = y' by apply: (mulIg y); rewrite cyy' {1}eq_yx' !mulKVg. - have [[z _ defM] | notMGNx] := altP (@orbitP _ _ _ 'Js G 'N[x] M). - rewrite -order_eq1 (pnat_1 _ t2M'y') // in nty'. - by rewrite -defM (eq_pnat _ (tau2J _ _)) -eq_xy'. - have Ns_y: y \in 'N[x]`_\sigma by rewrite eq_yx'; case/setIP: Rx'. - apply: sub_p_elt (mem_p_elt (pcore_pgroup _ _) Ns_y) => p sNp. - have [maxN _] := mem_uniq_mmax uniqNx. - by apply: contraFN (sigma_partition _ _ notMGNx p) => // sMp; apply/andP. -rewrite negb_exists_in => /forall_inP not_sign_g. -apply: wlog_neg; rewrite negb_exists_in => /forall_inP not_kappa_g. -have s'g M: M \in 'M -> g \in M -> g.`_\sigma(M) = 1. - move=> maxM; set x := g.`_\sigma(M); pose x' := g.`_(\sigma(M))^'. - have def_x': x^-1 * g = x' by rewrite -(consttC \sigma(M) g) mulKg. - apply: contraTeq => ntx. - have ell1x: \ell_\sigma(x) == 1%N. - rewrite /sigma_length (cardsD1 x.`_\sigma(M)). - rewrite -sigma_decomposition_constt' // mem_sigma_decomposition //. - by apply/ell_sigma0P; apply/constt1P; rewrite p_eltNK p_elt_constt. - by rewrite sub_in_constt // => ?. - apply: contra (not_sign_g _ ell1x) => Mg; rewrite def_x'. - have [-> | ntx'] := eqVneq x' 1; first exact: group1. - have cxx': x \in 'C[x'] by apply/cent1P; apply: commuteX2. - have cMx_x': x' \in ('C_M[x])^# by rewrite 3!inE ntx' cent1C cxx' groupX. - have Ms_x: x \in M`_\sigma. - by rewrite (mem_Hall_pcore (Msigma_Hall maxM)) ?p_elt_constt ?groupX. - have Ms1x: x \in (M`_\sigma)^# by apply/setD1P. - have sM'x': (\sigma(M))^'.-elt x' := p_elt_constt _ _. - have [[kMx' _] | [_ ell1x' uniqM]] := pi_of_cent_sigma maxM Ms1x cMx_x' sM'x'. - case/existsP: (not_kappa_g _ ell1x); exists M; rewrite def_x' cMx_x' /=. - by rewrite inE maxM cycle_subG Ms_x. - have MSx'_gt1: #|'M_\sigma[x']| > 1. - have [_ ntMSx'] := ell_sigma1P _ ell1x'. - rewrite ltn_neqAle lt0n cards_eq0 ntMSx' andbT eq_sym. - apply: contra ntx' => MSx'_eq1; rewrite -order_eq1 (pnat_1 _ sM'x') //. - have [N MSx'N] := set0Pn _ ntMSx'; have [maxN Ns_x'] := setIdP MSx'N. - rewrite -(eq_uniq_mmax uniqM maxN) ?cent1_sub_uniq_sigma_mmax //. - exact: pgroupS Ns_x' (pcore_pgroup _ _). - have defNx': 'N[x'] = M. - by apply: set1_inj; case/FT_signalizer_context: ell1x' => _ [|<-]. - case/negP: (not_sign_g _ ell1x'). - by rewrite -(consttC \sigma(M)^' g) mulKg consttNK inE defNx' Ms_x. -have [x sg_x]: exists x, x \in sigma_decomposition g. - by apply/set0Pn; rewrite -cards_eq0 (sameP (ell_sigma0P g) eqP). -have{sg_x} [ntx /imsetP[M maxM def_x]] := setD1P sg_x. -wlog MSxM: M maxM def_x / M \in 'M_\sigma[x]. - have sMx: \sigma(M).-elt x by rewrite def_x p_elt_constt. - have [|[z Ms_xz] _] := sigma_Jsub maxM sMx; first by rewrite cycle_eq1. - move/(_ (M :^ z^-1)%G)->; rewrite ?mmaxJ ?(eq_constt _ (sigmaJ M _)) //. - by rewrite inE mmaxJ maxM MsigmaJ -sub_conjg. -have ell1x: \ell_\sigma(x) == 1%N. - by apply/ell_sigma1P; split=> //; apply/set0Pn; exists M. -have notMg: g \notin M by apply: contra ntx; rewrite def_x; move/s'g->. -have cxg: g \in 'C[x] by rewrite cent1C def_x groupX ?cent1id. -have MSx_gt1: #|'M_\sigma[x]| > 1. - rewrite ltnNge; apply: contra notMg => MSx_le1; apply: subsetP cxg. - have [_ ntMSx] := ell_sigma1P _ ell1x. - by rewrite cent1_sub_uniq_sigma_mmax // eqn_leq MSx_le1 lt0n cards_eq0. -have [_ [//|defNx _ _ _]] := FT_signalizer_context ell1x. -case/(_ M)=> // _ _ _ hallMN; have [maxN sCxN] := mem_uniq_mmax defNx. -have Ng: <[g]> \subset 'N[x] by rewrite cycle_subG (subsetP sCxN). -have sN'g: \sigma('N[x])^'.-elt g by apply/constt1P; rewrite s'g // -cycle_subG. -have [z _ MNgz] := Hall_subJ (mmax_sol maxN) hallMN Ng sN'g. -case/eqP: ntx; rewrite def_x -(eq_constt _ (sigmaJ M z)) s'g ?mmaxJ //. -by move: MNgz; rewrite conjIg cycle_subG => /setIP[]. -Qed. - -Section PTypeEmbedding. -Implicit Types Mi Mj : {group gT}. -Implicit Type Ks : {set gT}. - -(* This is B & G, Theorem 14.7. *) -(* This theorem provides the basis for the maximal subgroup classification, *) -(* the main output of the local analysis. Note that we handle differently the *) -(* two separate instances of non-structural proof (by analogy) that occur in *) -(* the textbook, p. 112, l. 7 and p. 113, l. 22. For the latter we simply use *) -(* global induction on the size of the class support of the TI-set \hat{Z} *) -(* (for this reason we have kept the assertion that this is greater than half *) -(* of the size of G, even though this is not used later in the proof; we did *) -(* drop the more precise lower bound). For the former we prove a preliminary *) -(* lemma that summarizes the four results of the beginning of the proof that *) -(* used after p. 112, l. 7 -- note that this also gets rid of a third non *) -(* structural argument (on p. 112, l. 5). *) -(* Also, note that the direct product decomposition of Z and the K_i, and *) -(* its direct relation with the sigma-decomposition of elements of Z (p. 112, *) -(* l. 13-19) is NOT materially used in the rest of the argument, though it *) -(* does obviously help a human reader forge a mental picture of the situation *) -(* at hand. Only the first remark, l. 13, is used to prove the alternative *) -(* definition of T implicit in the remarks l. 22-23. Accordingly, we have *) -(* suppressed most of these intermediate results: we have only kept the proof *) -(* that Z is the direct product of the K_i^*, though we discard this result *) -(* immediately (its 24-line proof just nudges the whole proof size slightyly *) -(* over the 600-line bar). *) -Theorem Ptype_embedding M K : - M \in 'M_'P -> \kappa(M).-Hall(M) K -> - exists2 Mstar, Mstar \in 'M_'P /\ gval Mstar \notin M :^: G - & let Kstar := 'C_(M`_\sigma)(K) in - let Z := K <*> Kstar in let Zhat := Z :\: (K :|: Kstar) in - [/\ (*a*) {in 'E^1(K), forall X, 'M('C(X)) = [set Mstar]}, - (*b*) \kappa(Mstar).-Hall(Mstar) Kstar /\ \sigma(M).-Hall(Mstar) Kstar, - (*c*) 'C_(Mstar`_\sigma)(Kstar) = K /\ \kappa(M) =i \tau1(M), - (*d*) [/\ cyclic Z, M :&: Mstar = Z, - {in K^#, forall x, 'C_M[x] = Z}, - {in Kstar^#, forall y, 'C_Mstar[y] = Z} - & {in K^# & Kstar^#, forall x y, 'C[x * y] = Z}] -& [/\ (*e*) [/\ normedTI Zhat G Z, {in ~: M, forall g, [disjoint Zhat & M :^ g]} - & (#|G|%:R / 2%:R < #|class_support Zhat G|%:R :> rat)%R ], - (*f*) M \in 'M_'P2 /\ prime #|K| \/ Mstar \in 'M_'P2 /\ prime #|Kstar|, - (*g*) {in 'M_'P, forall H, gval H \in M :^: G :|: Mstar :^: G} - & (*h*) M^`(1) ><| K = M]]. -Proof. -pose isKi Ks M K := [&& M \in 'M_'P, \kappa(M).-Hall(M) K & Ks \subset K]. -move: M K; have Pmax_sym M K X (Ks := 'C_(M`_\sigma)(K)) (Z := K <*> Ks) Mi : - M \in 'M_'P -> \kappa(M).-Hall(M) K -> X \in 'E^1(K) -> Mi \in 'M('N(X)) -> - [/\ Z \subset Mi, gval Mi \notin M :^: G, exists Ki, isKi Ks Mi Ki - & {in 'E^1(Ks), forall Xs, Z \subset 'N_Mi(gval Xs)}]. -- move=> PmaxM hallK E1X maxNMi. - have [[_ maxM] [maxMi sNXMi]] := (setIdP PmaxM, setIdP maxNMi). - have [_ [defNK defNX] [ntKs uniqCKs] _ _] := Ptype_structure PmaxM hallK. - rewrite -/Ks in defNK ntKs uniqCKs; have [_ mulKKs cKKs _] := dprodP defNK. - have{mulKKs} defZ: 'N_M(K) = Z by rewrite -mulKKs -cent_joinEr. - have sZMi: Z \subset Mi. - by rewrite -defZ; have [<- _] := defNX X E1X; rewrite setIC subIset ?sNXMi. - have [sKMi sKsMi] := joing_subP sZMi. - have sXMis: X \subset Mi`_\sigma by have [_ ->] := defNX X E1X. - have sMiX: \sigma(Mi).-group X := pgroupS sXMis (pcore_pgroup _ _). - have [q EqX] := nElemP E1X; have [sXK abelX dimX] := pnElemP EqX. - have piXq: q \in \pi(X) by rewrite -p_rank_gt0 p_rank_abelem ?dimX. - have notMGMi: gval Mi \notin M :^: G. - apply: contraL (pnatPpi sMiX piXq); case/imsetP=> a _ ->; rewrite sigmaJ. - exact: kappa_sigma' (pnatPpi (pHall_pgroup hallK) (piSg sXK piXq)). - have kMiKs: \kappa(Mi).-group Ks. - apply/pgroupP=> p p_pr /Cauchy[] // xs Ks_xs oxs. - pose Xs := <[xs]>%G; have sXsKs: Xs \subset Ks by rewrite cycle_subG. - have EpXs: Xs \in 'E_p^1(Ks) by rewrite p1ElemE // !inE sXsKs -oxs /=. - have sMi'Xs: \sigma(Mi)^'.-group Xs. - rewrite /pgroup /= -orderE oxs pnatE //=. - apply: contraFN (sigma_partition maxM maxMi notMGMi p) => /= sMi_p. - rewrite inE /= sMi_p -pnatE // -oxs andbT. - exact: pgroupS sXsKs (pgroupS (subsetIl _ _) (pcore_pgroup _ _)). - have uniqM: 'M('C(Xs)) = [set M] by apply: uniqCKs; apply/nElemP; exists p. - have [x Xx ntx] := trivgPn _ (nt_pnElem EqX isT). - have Mis_x: x \in (Mi`_\sigma)^# by rewrite !inE ntx (subsetP sXMis). - have CMix_xs: xs \in ('C_Mi[x])^#. - rewrite 2!inE -order_gt1 oxs prime_gt1 // inE -!cycle_subG. - rewrite (subset_trans sXsKs) //= sub_cent1 (subsetP _ x Xx) //. - by rewrite centsC (centSS sXsKs sXK). - have{sMi'Xs} [|[_ _]] := pi_of_cent_sigma maxMi Mis_x CMix_xs sMi'Xs. - by case; rewrite /p_elt oxs pnatE. - case/mem_uniq_mmax=> _ sCxsMi; case/negP: notMGMi. - by rewrite -(eq_uniq_mmax uniqM maxMi) ?orbit_refl //= cent_cycle. - have{kMiKs} [Ki hallKi sKsKi] := Hall_superset (mmax_sol maxMi) sKsMi kMiKs. - have{ntKs} PmaxMi: Mi \in 'M_'P. - rewrite !(maxMi, inE) andbT /= -partG_eq1 -(card_Hall hallKi) -trivg_card1. - exact: subG1_contra sKsKi ntKs. - have [_ [defNKi defNXs] _ _ _] := Ptype_structure PmaxMi hallKi. - split=> //= [|Xs]; first by exists Ki; apply/and3P. - rewrite -{1}[Ks](setIidPr sKsKi) nElemI -setIdE => /setIdP[E1Xs sXsKs]. - have{defNXs} [defNXs _] := defNXs _ E1Xs; rewrite join_subG /= {2}defNXs. - by rewrite !subsetI sKMi sKsMi cents_norm ?normsG ?(centsS sXsKs) // centsC. -move=> M K PmaxM hallK /=; set Ks := 'C_(M`_\sigma)(K); set Z := K <*> Ks. -move: {2}_.+1 (ltnSn #|class_support (Z :\: (K :|: Ks)) G|) => nTG. -elim: nTG => // nTG IHn in M K PmaxM hallK Ks Z *; rewrite ltnS => leTGn. -have [maxM notFmaxM]: M \in 'M /\ M \notin 'M_'F := setDP PmaxM. -have{notFmaxM} ntK: K :!=: 1 by rewrite (trivg_kappa maxM). -have [_ [defNK defNX] [ntKs uniqCKs] _ _] := Ptype_structure PmaxM hallK. -rewrite -/Ks in defNK ntKs uniqCKs; have [_ mulKKs cKKs _] := dprodP defNK. -have{mulKKs} defZ: 'N_M(K) = Z by rewrite -mulKKs -cent_joinEr. -pose MNX := \bigcup_(X in 'E^1(K)) 'M('N(X)); pose MX := M |: MNX. -have notMG_MNX: {in MNX, forall Mi, gval Mi \notin M :^: G}. - by move=> Mi /bigcupP[X E1X /(Pmax_sym M K)[]]. -have MX0: M \in MX := setU11 M MNX. -have notMNX0: M \notin MNX by apply/negP=> /notMG_MNX; rewrite orbit_refl. -pose K_ Mi := odflt K [pick Ki | isKi Ks Mi Ki]. -pose Ks_ Mi := 'C_(Mi`_\sigma)(K_ Mi). -have K0: K_ M = K. - rewrite /K_; case: pickP => // K1 /and3P[_ /and3P[_ kK1 _] sKsK1]. - have sM_Ks: \sigma(M).-group Ks := pgroupS (subsetIl _ _) (pcore_pgroup _ _). - rewrite -(setIid Ks) coprime_TIg ?eqxx ?(pnat_coprime sM_Ks) // in ntKs. - exact: sub_pgroup (@kappa_sigma' M) (pgroupS sKsK1 kK1). -have Ks0: Ks_ M = Ks by rewrite /Ks_ K0. -have K_spec: {in MNX, forall Mi, isKi Ks Mi (K_ Mi)}. - move=> Mi /bigcupP[X _ /(Pmax_sym M K)[] // _ _ [Ki Ki_ok] _]. - by rewrite /K_; case: pickP => // /(_ Ki)/idP. -have PmaxMX: {in MX, forall Mi, Mi \in 'M_'P /\ \kappa(Mi).-Hall(Mi)(K_ Mi)}. - by move=> Mi /setU1P[-> | /K_spec/and3P[]//]; rewrite K0. -have ntKsX: {in MX, forall Mi, Ks_ Mi != 1}. - by move=> Mi /PmaxMX[MX_Mi /Ptype_structure[] // _ _ []]. -pose co_sHallK Mi Zi := - let sMi := \sigma(Mi) in sMi^'.-Hall(Zi) (K_ Mi) /\ sMi.-Hall(Zi) (Ks_ Mi). -have hallK_Zi: {in MX, forall Mi, co_sHallK Mi (K_ Mi \x Ks_ Mi)}. - move=> Mi MXi; have [PmaxMi hallKi] := PmaxMX _ MXi. - have [_ [defNKs _] _ _ _] := Ptype_structure PmaxMi hallKi. - have [_ mulKKs _ _] := dprodP defNKs; rewrite defNKs. - have sMi_Kis: _.-group (Ks_ Mi) := pgroupS (subsetIl _ _) (pcore_pgroup _ _). - have sMi'Ki := sub_pgroup (@kappa_sigma' _) (pHall_pgroup hallKi). - exact: coprime_mulGp_Hall mulKKs sMi'Ki sMi_Kis. -have{K_spec} defZX: {in MX, forall Mi, K_ Mi \x Ks_ Mi = Z}. - move=> Mi MXi; have [-> | MNXi] := setU1P MXi; first by rewrite K0 Ks0 defNK. - have /and3P[PmaxMi hallKi sKsKi] := K_spec _ MNXi. - have [X E1X maxNMi] := bigcupP MNXi. - have{defNX} [defNX /(_ Mi maxNMi) sXMis] := defNX X E1X. - have /rank_geP[Xs E1Xs]: 0 < 'r(Ks) by rewrite rank_gt0. - have [_ [defNi defNXi] _ _ _] := Ptype_structure PmaxMi hallKi. - have [defNXs _] := defNXi _ (subsetP (nElemS 1 sKsKi) _ E1Xs). - have [_ hallKis] := hallK_Zi _ MXi; rewrite defNi in hallKis. - have sZNXs: Z \subset 'N_Mi(Xs) by case/(Pmax_sym M K): maxNMi => // _ _ _ ->. - apply/eqP; rewrite eqEsubset andbC {1}defNi -defNXs sZNXs. - have [_ _ cKiKis tiKiKis] := dprodP defNi; rewrite dprodEY // -defZ -defNX. - have E1KiXs: Xs \in 'E^1(K_ Mi) := subsetP (nElemS 1 sKsKi) Xs E1Xs. - have [|_ _ _ -> //] := Pmax_sym Mi _ Xs M PmaxMi hallKi E1KiXs. - have [p EpXs] := nElemP E1Xs; have [_] := pnElemP EpXs; case/andP=> pXs _ _. - rewrite inE maxM (sub_uniq_mmax (uniqCKs _ E1Xs)) ?cent_sub //=. - exact: mFT_norm_proper (nt_pnElem EpXs isT) (mFT_pgroup_proper pXs). - have [q /pnElemP[sXK abelX dimX]] := nElemP E1X. - apply/nElemP; exists q; apply/pnElemP; split=> //. - have nKisZi: Ks_ Mi <| 'N_Mi(K_ Mi) by case/dprod_normal2: defNi. - rewrite (sub_normal_Hall hallKis) ?(pgroupS sXMis (pcore_pgroup _ _)) //=. - by rewrite -defNXs (subset_trans sXK) // (subset_trans (joing_subl _ Ks)). -have{hallK_Zi} hallK_Z: {in MX, forall Mi, co_sHallK Mi Z}. - by move=> Mi MXi; rewrite -(defZX _ MXi); apply: hallK_Zi. -have nsK_Z: {in MX, forall Mi, K_ Mi <| Z /\ Ks_ Mi <| Z}. - by move=> Mi /defZX; apply: dprod_normal2. -have tiKs: {in MX &, forall Mi Mj, gval Mi != gval Mj -> Ks_ Mi :&: Ks_ Mj = 1}. - move=> Mi Mj MXi MXj; apply: contraNeq; rewrite -rank_gt0. - case/rank_geP=> X E1X; move: E1X (E1X); rewrite /= {1}setIC {1}nElemI. - case/setIP=> E1jX _; rewrite nElemI => /setIP[E1iX _]. - have [[maxKi hallKi] [maxKj hallKj]] := (PmaxMX _ MXi, PmaxMX _ MXj). - have [_ _ [_ uniqMi] _ _] := Ptype_structure maxKi hallKi. - have [_ _ [_ uniqMj] _ _] := Ptype_structure maxKj hallKj. - by rewrite val_eqE -in_set1 -(uniqMj _ E1jX) (uniqMi _ E1iX) set11. -have sKsKX: {in MX &, forall Mi Mj, Mj != Mi -> Ks_ Mj \subset K_ Mi}. - move=> Mi Mj MXi MXj /= neqMji; have [hallKi hallKsi] := hallK_Z _ MXi. - have [[_ nsKsjZ] [nsKiZ _]] := (nsK_Z _ MXj, nsK_Z _ MXi). - rewrite (sub_normal_Hall hallKi) ?(normal_sub nsKsjZ) // -partG_eq1. - by rewrite -(card_Hall (Hall_setI_normal _ hallKsi)) //= setIC tiKs ?cards1. -have exMNX X: X \in 'E^1(K) -> exists2 Mi, Mi \in MNX & X \subset Mi`_\sigma. - move=> E1X; have [p EpX] := nElemP E1X; have [_ abelX _] := pnElemP EpX. - have ltXG: X \proper G := mFT_pgroup_proper (abelem_pgroup abelX). - have [Mi maxNMi] := mmax_exists (mFT_norm_proper (nt_pnElem EpX isT) ltXG). - have MNXi: Mi \in MNX by apply/bigcupP; exists X. - by exists Mi => //; have [_ ->] := defNX X E1X. -have dprodKs_eqZ: \big[dprod/1]_(Mi in MX) Ks_ Mi = Z; last clear dprodKs_eqZ. - have sYKs_KX Mi: - Mi \in MX -> <<\bigcup_(Mj in MX | Mj != Mi) Ks_ Mj>> \subset K_ Mi. - - move=> MXi; rewrite gen_subG. - by apply/bigcupsP=> Mj /= /andP[]; apply: sKsKX. - transitivity <<\bigcup_(Mi in MX) Ks_ Mi>>; apply/eqP. - rewrite -bigprodGE; apply/bigdprodYP => Mi MXi; rewrite bigprodGE. - apply: subset_trans (sYKs_KX _ MXi) _; apply/dprodYP. - have [_ defZi cKiKs tiKiKs] := dprodP (defZX _ MXi). - by rewrite dprodC joingC dprodEY. - rewrite eqEsubset {1}(bigD1 M) //= Ks0 setUC -joingE -joing_idl. - rewrite genS ?setSU ?big_setU1 //=; last by rewrite -K0 sYKs_KX. - rewrite setUC -joingE -joing_idl Ks0 genS ?setSU // -(Sylow_gen K) gen_subG. - apply/bigcupsP=> P; case/SylowP=> p p_pr /=; case/and3P=> sPK pP _. - have [-> | ] := eqsVneq P 1; first exact: sub1G. - rewrite -rank_gt0 (rank_pgroup pP); case/p_rank_geP=> X EpX. - have EpKX: X \in 'E_p^1(K) := subsetP (pnElemS p 1 sPK) X EpX. - have{EpKX} E1X: X \in 'E^1(K) by apply/nElemP; exists p. - have [Mi MNXi sXMis] := exMNX X E1X; have MXi: Mi \in MX by rewrite setU1r. - have [[_ nsKsi] [_ hallKsi]] := (nsK_Z _ MXi, hallK_Z _ MXi). - have sPZ: P \subset Z := subset_trans sPK (joing_subl _ _). - rewrite sub_gen ?(bigcup_max Mi) // (sub_normal_Hall hallKsi) //. - rewrite (pi_pgroup pP) // (pnatPpi (pcore_pgroup _ _) (piSg sXMis _)) //. - by have [_ ? dimX] := pnElemP EpX; rewrite -p_rank_gt0 p_rank_abelem ?dimX. -pose PZ := [set (Ks_ Mi)^# | Mi in MX]; pose T := Z^# :\: cover PZ. -have defT: \bigcup_(Mi in MX) (Ks_ Mi)^# * (K_ Mi)^# = T. - apply/setP=> x; apply/bigcupP/setDP=> [[Mi MXi] | [Zx notZXx]]. - case/mulsgP=> y y' /setD1P[nty Ks_y] /setD1P[nty' Ky'] defx. - have [_ defZi cKsKi tiKsKi] := dprodP (defZX _ MXi). - rewrite 2!inE -[Z]defZi -(centC cKsKi) andbC {1}defx mem_mulg //=. - have notKx: x \notin K_ Mi. - by rewrite -in_set1 -set1gE -tiKsKi inE Ks_y andbT defx groupMr in nty *. - split; first exact: group1_contra notKx. - rewrite cover_imset; apply/bigcupP=> [[Mj MXj /setD1P[_ Ksj_x]]]. - rewrite (subsetP (sKsKX Mi Mj _ _ _)) // in notKx. - apply: contraNneq nty' => eqMji; rewrite -in_set1 -set1gE -tiKsKi inE Ky'. - by rewrite -(groupMl _ Ks_y) -defx -eqMji. - have{Zx} [ntx Zx] := setD1P Zx. - have [Mi MXi notKi_x]: exists2 Mi, Mi \in MX & x \notin K_ Mi. - have [Kx | notKx] := boolP (x \in K); last by exists M; rewrite ?K0. - pose p := pdiv #[x]; have xp: p \in \pi(#[x]) by rewrite pi_pdiv order_gt1. - have /p_rank_geP[X EpX]: 0 < 'r_p(<[x]>) by rewrite p_rank_gt0. - have [sXx abelX dimX] := pnElemP EpX. - have piXp: p \in \pi(X) by rewrite -p_rank_gt0 p_rank_abelem ?dimX. - have sXK: X \subset K by rewrite (subset_trans sXx) ?cycle_subG. - have E1X: X \in 'E^1(K) by apply/nElemP; exists p; apply/pnElemP. - have [Mi MNXi sXMis] := exMNX X E1X; have MXi: Mi \in MX := setU1r M MNXi. - have sXZ: X \subset Z := subset_trans sXK (joing_subl _ _). - have sMip: p \in \sigma(Mi) := pnatPpi (pcore_pgroup _ _) (piSg sXMis piXp). - have [hallKi _] := hallK_Z _ MXi. - exists Mi => //; apply: contraL sMip => Ki_x. - exact: pnatPpi (mem_p_elt (pHall_pgroup hallKi) Ki_x) xp. - have [_ defZi cKisKi _] := dprodP (defZX _ MXi). - rewrite -[Z]defZi -(centC cKisKi) in Zx. - have [y y' Kis_y Ki_y' defx] := mulsgP Zx. - have Kis1y: y \in (Ks_ Mi)^#. - rewrite 2!inE Kis_y andbT; apply: contraNneq notKi_x => y1. - by rewrite defx y1 mul1g. - exists Mi; rewrite // defx mem_mulg // 2!inE Ki_y' andbT. - apply: contraNneq notZXx => y'1; rewrite cover_imset. - by apply/bigcupP; exists Mi; rewrite // defx y'1 mulg1. -have oT: #|T| = #|Z| + #|MNX| - (\sum_(Mi in MX) #|Ks_ Mi|). - have tiTPZ Kis: Kis \in PZ -> [disjoint T & Kis]. - move=> Z_Kis; rewrite -setI_eq0 setIDAC setD_eq0. - by rewrite (bigcup_max Kis) ?subsetIr. - have notPZset0: set0 \notin PZ. - apply/imsetP=> [[Mi MXi]]; apply/eqP; rewrite /= eq_sym setD_eq0 subG1. - exact: ntKsX. - have [| tiPZ injKs] := trivIimset _ notPZset0. - move=> Mi Mj MXi MXj /= neqMji. - by rewrite -setI_eq0 -setDIl setD_eq0 setIC tiKs. - have{tiPZ} [tiPZ notPZ_T] := trivIsetU1 tiTPZ tiPZ notPZset0. - rewrite (eq_bigr (fun Mi : {group gT} => 1 + #|(Ks_ Mi)^#|)%N); last first. - by move=> Mi _; rewrite (cardsD1 1) group1. - rewrite big_split sum1_card cardsU1 notMNX0 (cardsD1 1 Z) group1 /=. - have ->: Z^# = cover (T |: PZ). - rewrite -(setID Z^# (cover PZ)) setUC (setIidPr _) /cover ?big_setU1 //=. - apply/bigcupsP=> _ /imsetP[Mi MXi ->]; apply: setSD. - by case/nsK_Z: MXi => _ /andP[]. - by rewrite addnAC subnDl -(eqnP tiPZ) big_setU1 // big_imset //= addnK. -have tiTscov: {in 'M, forall H, [disjoint T & H^~~]}. - move=> H maxH; apply/pred0P=> t; apply/andP=> [[/= Tt scovHt]]. - have ntt: t != 1 by have [/setD1P[]] := setDP Tt. - have [x Hs_x xR_y] := bigcupP scovHt; have ell1x := Msigma_ell1 maxH Hs_x. - have:= sigma_decomposition_dichotomy ntt. - rewrite (introT existsP) /=; last by exists x; rewrite ell1x -mem_lcoset. - rewrite -defT in Tt; have [Mi MXi Zi_t] := bigcupP Tt. - case/mulsgP: Zi_t => y y' /setD1P[nty Ks_y] /setD1P[nty' Ky'] ->. - case/existsP; exists y; rewrite mulKg. - have [[Mis_y cKy] [PmaxMi hallKi]] := (setIP Ks_y, PmaxMX _ MXi). - have [[maxMi _] [sKiMi kMiKi _]] := (setDP PmaxMi, and3P hallKi). - rewrite (Msigma_ell1 maxMi) ?inE ?nty //=; apply/existsP; exists Mi. - rewrite inE maxMi cycle_subG Mis_y 3!inE nty' (subsetP sKiMi) //=. - by rewrite (subsetP _ _ Ky') ?sub_cent1 // (mem_p_elt kMiKi). -have nzT: T != set0. - have [[y Ksy nty] [y' Ky' nty']] := (trivgPn _ ntKs, trivgPn _ ntK). - apply/set0Pn; exists (y * y'); rewrite -defT; apply/bigcupP. - by exists M; rewrite ?MX0 // K0 Ks0 mem_mulg 2?inE ?nty ?nty'. -have ntiT: normedTI T G Z. - have sTZ: {subset T <= Z} by apply/subsetP; rewrite 2!subDset setUA subsetUr. - have nTZ: Z \subset 'N(T). - rewrite normsD ?norms_bigcup ?normD1 ?normG //. - apply/bigcapsP=> _ /imsetP[Mi MXi ->]; rewrite normD1. - by case/nsK_Z: MXi => _ /andP[]. - apply/normedTI_P; rewrite setTI /= -/Z. - split=> // a _ /pred0Pn[t /andP[/= Tt]]; rewrite mem_conjg => Tta. - have{Tta} [Zt Zta] := (sTZ t Tt, sTZ _ Tta). - move: Tt; rewrite -defT => /bigcupP[Mi MXi]. - case/mulsgP=> y y' /setD1P[nty Kisy] /setD1P[nty' Kiy'] def_yy'. - have [[hallKi hallKis] [nsKiZ _]] := (hallK_Z _ MXi, nsK_Z _ MXi). - have [[PmaxMi hallKiMi] defZi] := (PmaxMX _ MXi, defZX _ MXi). - have [_ [defNKi _] _ [[]]] := Ptype_structure PmaxMi hallKiMi. - rewrite -defNKi defZi -/(Ks_ _) => tiKsi tiKi _ _ _. - have [defy defy']: y = t.`_\sigma(Mi) /\ y' = t.`_\sigma(Mi)^'. - have [_ cKiy] := setIP Kisy; have cy'y := centP cKiy _ Kiy'. - have sMi_y := mem_p_elt (pHall_pgroup hallKis) Kisy. - have sMi'y' := mem_p_elt (pHall_pgroup hallKi) Kiy'. - rewrite def_yy' !consttM // constt_p_elt // 2?(constt1P _) ?p_eltNK //. - by rewrite mulg1 mul1g constt_p_elt. - have: a \in Mi. - apply: contraR nty; rewrite -in_setC -in_set1 -set1gE; move/tiKsi <-. - rewrite inE Kisy mem_conjg defy -consttJ groupX ?(subsetP _ _ Zta) //. - by rewrite -defZi defNKi subsetIl. - apply/implyP; apply: contraR nty'; rewrite negb_imply andbC -in_setD. - rewrite -in_set1 -set1gE => /tiKi <-; rewrite inE Kiy' defy' mem_conjg. - by rewrite -consttJ (mem_normal_Hall hallKi nsKiZ) ?p_elt_constt ?groupX. -have [_ tiT /eqP defNT] := and3P ntiT; rewrite setTI in defNT. -pose n : rat := #|MNX|%:R; pose g : rat := #|G|%:R. -pose z : rat := #|Z|%:R; have nz_z: z != 0%R := natrG_neq0 _ _. -pose k_ Mi : rat := #|K_ Mi|%:R. -have nz_ks: #|Ks_ _|%:R != 0%R :> rat := natrG_neq0 _ _. -pose TG := class_support T G. -have oTG: (#|TG|%:R = (1 + n / z - \sum_(Mi in MX) (k_ Mi)^-1) * g)%R. - rewrite /TG class_supportEr -cover_imset -(eqnP tiT). - rewrite (eq_bigr (fun _ => #|T|)) => [|_ /imsetP[x _ ->]]; last first. - by rewrite cardJg. - rewrite sum_nat_const card_conjugates setTI defNT. - rewrite natrM natf_indexg ?subsetT //= -/z -mulrA mulrC; congr (_ * _)%R. - rewrite oT natrB; last by rewrite ltnW // -subn_gt0 lt0n -oT cards_eq0. - rewrite mulrC natrD -/n -/z natr_sum /=. - rewrite mulrBl mulrDl big_distrl divff //=; congr (_ - _)%R. - apply: eq_bigr => Mi MXi; have defZi := defZX _ MXi. - by rewrite /z -(dprod_card defZi) natrM invfM mulrC divfK. -have neMNX: MNX != set0. - move: ntK; rewrite -rank_gt0 => /rank_geP[X /exMNX[Mi MNXi _]]. - by apply/set0Pn; exists Mi. -have [Mi MXi P2maxMi]: exists2 Mi, Mi \in MX & Mi \in 'M_'P2. - apply/exists_inP; apply: negbNE; rewrite negb_exists_in. - apply/forall_inP=> allP1; pose ssup Mi := class_support (gval Mi)^~~ G. - have{allP1} min_ssupMX Mi: - Mi \in MX -> (#|ssup Mi|%:R >= ((k_ Mi)^-1 - (z *+ 2)^-1) * g)%R. - - move=> MXi; have [PmaxMi hallKi] := PmaxMX _ MXi. - have [[U [complU defMi] _]] := Ptype_structure PmaxMi hallKi. - case=> defZi _ _ _ _; have [maxMi _] := setDP PmaxMi. - have{complU} U1: U :==: 1; last rewrite {U U1}(eqP U1) sdprod1g in defMi. - rewrite (trivg_kappa_compl maxMi complU). - by apply: contraR (allP1 _ MXi) => ?; apply/setDP. - rewrite card_class_support_sigma // natrM natf_indexg ?subsetT // -/g. - rewrite mulrCA mulrC ler_wpmul2r ?ler0n // -subn1 natrB ?cardG_gt0 //. - rewrite mulr1n mulrBl -{1}(sdprod_card defMi) natrM invfM. - rewrite mulVKf ?natrG_neq0 // ler_add2l ler_opp2 -(mulr_natr _ 2) invfM. - rewrite ler_pdivr_mulr ?natrG_gt0 // mulrC mulrA. - have sZM: Z \subset M by rewrite -defZ subsetIl. - have sZMi: Z \subset Mi by rewrite -(defZX _ MXi) defZi subsetIl. - rewrite -natf_indexg //= -/Z ler_pdivl_mulr ?(ltr0Sn _ 1) // mul1r ler_nat. - rewrite indexg_gt1 /= -/Z subEproper /proper sZMi andbF orbF. - apply: contraNneq notMNX0 => defMiZ; have [Mj MNXj] := set0Pn _ neMNX. - have maxZ: [group of Z] \in 'M by rewrite !inE defMiZ in maxMi *. - have eqZ := group_inj (eq_mmax maxZ _ _); rewrite -(eqZ M) //. - have [Xj E1Xj maxNMj] := bigcupP MNXj; have [maxMj _] := setIdP maxNMj. - by rewrite (eqZ Mj) //; case/(Pmax_sym M K): maxNMj. - pose MXsup := [set ssup Mi | Mi in MX]. - have notMXsup0: set0 \notin MXsup. - apply/imsetP=> [[Mi /PmaxMX[/setDP[maxMi _] _] /esym/eqP/set0Pn[]]]. - have [x Mis_x ntx] := trivgPn _ (Msigma_neq1 maxMi). - exists (x ^ 1); apply: mem_imset2; rewrite ?inE //. - by apply/bigcupP; exists x; rewrite ?inE ?ntx // lcoset_refl. - have [Mi Mj MXi MXj /= neqMij | tiMXsup inj_ssup] := trivIimset _ notMXsup0. - apply/pred0Pn=> [[_ /andP[/imset2P[x y1 signMi_x _ ->]]]] /=. - rewrite /ssup class_supportEr /= => /bigcupP[y2 _]. - rewrite -mem_conjgV -conjsgM -sigma_supportJ; set H := Mj :^ _ => Hx. - suffices: [disjoint Mi^~~ & H^~~]. - by case/pred0Pn; exists x; rewrite /= {1}signMi_x Hx. - have [[PmaxMi _] [PmaxMj _]] := (PmaxMX _ MXi, PmaxMX _ MXj). - have [[maxMi _] [maxMj _]] := (setDP PmaxMi, setDP PmaxMj). - apply: sigma_support_disjoint; rewrite ?mmaxJ //. - rewrite (orbit_transl _ (mem_orbit _ _ _)) ?inE //=. - apply: contra (ntKsX _ MXi); case/imsetP=> y _ /= defMj; rewrite -/(Ks_ _). - have sKisKj: Ks_ Mi \subset K_ Mj by rewrite sKsKX // eq_sym. - rewrite -(setIidPl sKisKj) coprime_TIg //. - have [[_ hallKis] [hallKj _]] := (hallK_Z _ MXi, hallK_Z _ MXj). - apply: pnat_coprime (pHall_pgroup hallKj). - by rewrite defMj -pgroupE (eq_pgroup _ (sigmaJ _ _)) (pHall_pgroup hallKis). - have [|tiPG notMXsupTG]: _ /\ TG \notin _ := trivIsetU1 _ tiMXsup notMXsup0. - move=> _ /imsetP[Mi /PmaxMX[/setDP[maxMi _] _] ->]. - apply/pred0Pn=> [[_ /andP[/imset2P[x y1 Tx _ ->]]]] /=. - rewrite /ssup class_supportEr => /bigcupP[y2 _]. - rewrite -mem_conjgV -conjsgM -sigma_supportJ; set H := Mi :^ _ => Hx. - have maxH: [group of H] \in 'M by rewrite mmaxJ. - by case/andP: (pred0P (tiTscov _ maxH) x). - suffices: (g <= #|cover (TG |: MXsup)|%:R)%R. - rewrite ler_nat (cardsD1 1 G) group1 ltnNge subset_leq_card //. - apply/bigcupsP=> _ /setU1P[|/imsetP[Mi /PmaxMX[/setDP[maxMi _] _]]] ->. - rewrite /TG class_supportEr; apply/bigcupsP=> x _. - rewrite sub_conjg (normP _) ?normD1 ?(subsetP (normG _)) ?inE //. - by rewrite subDset setUC subsetU // setSD ?subsetT. - rewrite /ssup class_supportEr; apply/bigcupsP=> x _. - rewrite subsetD1 subsetT mem_conjg conj1g {x}/=. - move/ell_sigma0P: (@erefl gT 1); rewrite cards_eq0. - apply: contraL => /bigcupP[x Mis_x xR1]; apply/set0Pn; exists x. - exact: mem_sigma_cover_decomposition (Msigma_ell1 maxMi Mis_x) xR1. - rewrite -(eqnP tiPG) big_setU1 ?big_imset //= natrD natr_sum. - suffices: (g <= #|TG|%:R + \sum_(i in MX) ((k_ i)^-1 - (z *+ 2)^-1) * g)%R. - by move/ler_trans->; rewrite // ler_add2l ler_sum. - rewrite -big_distrl /= oTG -/g -mulrDl big_split /= sumr_const. - rewrite addrA subrK -(mulr_natl _ 2) -[_ *+ _]mulr_natl invfM mulrN. - rewrite mulrA -addrA -mulrBl -{1}(mul1r g) ler_wpmul2r ?ler0n //. - rewrite ler_addl -(mul0r z^-1)%R ler_wpmul2r ?invr_ge0 ?ler0n //. - rewrite subr_ge0 ler_pdivr_mulr ?(ltr0Sn _ 1) // -natrM ler_nat. - by rewrite muln2 -addnn cardsU1 leq_add2r notMNX0 lt0n cards_eq0. -have [prKi nilMis]: prime #|K_ Mi| /\ nilpotent Mi`_\sigma. - by have [PmaxMi /Ptype_structure[] // _ _ _ _ []] := PmaxMX _ MXi. -have [Mj MXj neqMji]: exists2 Mj, Mj \in MX & Mj :!=: Mi. - have [Mj |] := pickP (mem ((MX) :\ Mi)); first by case/setD1P; exists Mj. - move/eq_card0/eqP; rewrite -(eqn_add2l true) -{1}MXi -cardsD1 cardsU1. - by rewrite notMNX0 eqSS cards_eq0 (negPf neMNX). -have defKjs: Ks_ Mj = K_ Mi. - have sKjsKi: Ks_ Mj \subset K_ Mi by rewrite sKsKX. - apply/eqP; rewrite eqEcard sKjsKi (prime_nt_dvdP _ _ (cardSg sKjsKi)) //=. - by rewrite -trivg_card1 ntKsX. -have defMXij: MX = [set Mi; Mj]. - symmetry; rewrite -(setD1K MXi); congr (_ |: _); apply/eqP. - rewrite eqEcard sub1set cards1 (cardsD1 Mj) 2!inE neqMji MXj /= ltnS leqn0. - apply/pred0Pn=> [[Mk /setD1P[neMkj /setD1P[neMki MXk]]]]. - have sKskKsj: Ks_ Mk \subset Ks_ Mj by rewrite defKjs sKsKX. - by case/negP: (ntKsX _ MXk); rewrite -(setIidPl sKskKsj) tiKs. -have defKsi: Ks_ Mi = K_ Mj. - apply/eqP; rewrite eqEcard sKsKX 1?eq_sym //=. - rewrite -(@leq_pmul2r #|Ks_ Mj|) ?cardG_gt0 // (dprod_card (defZX _ MXj)). - by rewrite defKjs mulnC (dprod_card (defZX _ MXi)). -have{nilMis} cycZ: cyclic Z. - have cycKi := prime_cyclic prKi. - apply: nil_Zgroup_cyclic. - apply/forall_inP=> S /SylowP[p _ /and3P[sSZ pS _]]. - have [[hallKi hallKis] [nsKi nsKis]] := (hallK_Z _ MXi, nsK_Z _ MXi). - have [sMi_p | sMi'p] := boolP (p \in \sigma(Mi)); last first. - by rewrite (cyclicS _ cycKi) // (sub_normal_Hall hallKi) ?(pi_pgroup pS). - have sSKj: S \subset K_ Mj. - by rewrite -defKsi (sub_normal_Hall hallKis) ?(pi_pgroup pS). - rewrite (odd_pgroup_rank1_cyclic pS) ?mFT_odd //. - apply: wlog_neg; rewrite -ltnNge ltn_neqAle p_rank_gt0 => /andP[_ piSp]. - have [_ /and3P[sKjMj kKj _]] := PmaxMX _ MXj. - rewrite -(rank_kappa (pnatPpi kKj (piSg sSKj piSp))) p_rankS //. - exact: subset_trans sSKj sKjMj. - rewrite (dprod_nil (defZX _ MXi)) abelian_nil ?cyclic_abelian //=. - exact: (nilpotentS (subsetIl _ _)) nilMis. -have cycK: cyclic K := cyclicS (joing_subl _ _) cycZ. -have defM: M^`(1) ><| K = M. - have [U complU] := ex_kappa_compl maxM hallK; have [hallU _ _] := complU. - have [_ defM _ regUK _] := kappa_compl_context maxM complU. - have{hallU} [[sUM _] [sKM kK _]] := (andP hallU, and3P hallK). - case/sdprodP: defM => [[_ E _ defE]]; rewrite defE. - case/sdprodP: defE => _ <-{E} nUK _ defM /mulGsubP[nMsU nMsK] tiMsUK. - pose MsU := M`_\sigma <*> U; have nMsUK: K \subset 'N(MsU) by rewrite normsY. - have defMl: MsU * K = M by rewrite [MsU]norm_joinEr // -mulgA. - have coUK := regular_norm_coprime nUK regUK. - have ->: M^`(1) = MsU. - apply/eqP; rewrite eqEsubset; apply/andP; split; last first. - have solU := solvableS sUM (mmax_sol maxM). - rewrite join_subG Msigma_der1 //= -(coprime_cent_prod nUK coUK solU). - by rewrite (cent_semiregular regUK) // mulg1 commgSS. - apply: der1_min; first by rewrite -{1}defMl mulG_subG normG. - by rewrite -{2}defMl quotientMidl quotient_abelian ?cyclic_abelian. - rewrite sdprodE ?coprime_TIg //= norm_joinEr //. - rewrite (coprime_dvdl (dvdn_cardMg _ _)) // coprime_mull coUK. - rewrite (pnat_coprime (pcore_pgroup _ _) (sub_pgroup _ kK)) //. - exact: kappa_sigma'. -have{neMNX} [Mstar MNX'star] := set0Pn _ neMNX. -have defMNX: MNX = [set Mstar]. - apply/eqP; rewrite eq_sym eqEcard sub1set MNX'star /= -(leq_add2l true). - by rewrite -{1}notMNX0 -cardsU1 -/MX defMXij setUC cards2 neqMji !cards1. -have MXstar: Mstar \in MX by rewrite setU1r. -have [[PmaxMstar hallKstar] defZstar] := (PmaxMX _ MXstar, defZX _ MXstar). -have [maxMstar _] := setDP PmaxMstar. -have notMGMstar := notMG_MNX _ MNX'star; exists Mstar => //. -have [defKs defKs_star]: Ks = K_ Mstar /\ Ks_ Mstar = K. - rewrite /Ks /Ks_ -K0; rewrite /MX defMNX 3!inE val_eqE in neqMji MXj MXi. - by case/set2P: MXi (negPf neqMji) MXj => <- ->; rewrite ?orbF /= => /eqP <-. -have hallKs: \sigma(M).-Hall(Mstar) Ks. - have sKsMstar: Ks \subset Mstar by rewrite defKs (pHall_sub hallKstar). - have sM_Ks: \sigma(M).-group Ks := pgroupS (subsetIl _ _) (pcore_pgroup _ _). - have [Y hallY sKsY] := Hall_superset (mmax_sol maxMstar) sKsMstar sM_Ks. - have [sYMstar sM_Y _] := and3P hallY; apply: etrans hallY; congr pHall. - have sYMs: Y \subset M`_\sigma. - case/Ptype_structure: hallK => // _ _ _ [_ _ -> //]. - by rewrite (setIidPr sKsY). - apply/eqP; rewrite eqEsubset sKsY subsetI sYMs (sameP commG1P trivgP) /=. - have <-: M`_\sigma :&: Mstar`_\sigma = 1. - rewrite coprime_TIg // (pnat_coprime (pcore_pgroup _ _)) //. - apply: sub_pgroup (pcore_pgroup _ _) => q sM1q. - apply: contraFN (sigma_partition maxM maxMstar notMGMstar q) => sMq. - exact/andP. - rewrite commg_subI //. - by rewrite subsetI sYMs (subset_trans sYMstar) ?gFnorm. - rewrite subsetI -{1}defKs_star subsetIl. - by rewrite (subset_trans (pHall_sub hallK)) ?gFnorm. -have oTGgt_g2: (g / 2%:R < #|TG|%:R)%R. - rewrite oTG big_setU1 //= /n defMNX big_set1 cards1 mulrC mul1r. - rewrite ltr_pmul2r ?(ltr_nat _ 0) ?cardG_gt0 // /k_ K0 -defKs. - rewrite /z -defZ -(dprod_card defNK) natrM invfM opprD. - pose hm u : rat := (1 - u%:R^-1)%R; set lhs := (_^-1)%R. - suffices: (lhs < hm #|K| * hm #|Ks|)%R. - by rewrite mulrBl !mulrBr !mul1r mulr1 opprB addrAC !addrA. - have hm_inc u v: 0 < u <= v -> (hm u <= hm v)%R. - case/andP=> u_gt0 le_uv; rewrite ler_add2l ler_opp2. - have v_gt0 := leq_trans u_gt0 le_uv. - rewrite -(mul1r _^-1)%R ler_pdivr_mulr ?ltr0n //. - by rewrite ler_pdivl_mull ?ltr0n // mulr1 ler_nat. - have le_pdiv H: 0 < pdiv #|H| <= #|H| by rewrite pdiv_gt0 dvdn_leq ?pdiv_dvd. - have{le_pdiv} hm_pdiv := hm_inc _ _ (le_pdiv _). - have hm_ge0 u: (0 <= hm u)%R. - by case: u => // u; rewrite subr_ge0 invf_le1 ?ltr0Sn ?(ler_nat _ 1). - do 2![rewrite mulrC (ltr_le_trans _ (ler_wpmul2r (hm_ge0 _) (hm_pdiv _))) //]. - set p := pdiv #|K|; set q := pdiv #|Ks|. - have [odd_p odd_q]: odd p /\ odd q. - by split; apply: dvdn_odd (pdiv_dvd _) (mFT_odd _). - without loss [lt1p ltpq]: p q odd_p odd_q / 1 < p /\ p < q. - have [p_pr q_pr]: prime p /\ prime q by rewrite !pdiv_prime ?cardG_gt1. - have [ltpq | ltqp | eqpq] := ltngtP p q. - - by apply; rewrite ?prime_gt1. - - by rewrite mulrC; apply; rewrite ?prime_gt1. - have [] := hallK_Z _ MX0. - rewrite K0 Ks0 => /and3P[_ sM'K _] /and3P[_ sMKs _]. - case/negP: (pgroupP sM'K _ p_pr (pdiv_dvd _)); rewrite eqpq. - exact: pgroupP sMKs _ q_pr (pdiv_dvd _). - have p_gt2: 2 < p by rewrite odd_geq. - apply: ltr_le_trans (isT : lhs < hm 3 * hm 5)%R _. - by rewrite ler_pmul ?hm_inc ?hm_ge0 //= odd_geq ?(leq_trans _ ltpq). -have defZhat: Z :\: (K :|: Ks) = T. - rewrite /T cover_imset big_setU1 //= defMNX big_set1 defKs_star Ks0. - by rewrite -setDUl setDDl setUC setD1K // inE group1. -rewrite defZhat {1}defKs; split; first 2 [by split]. -- by rewrite -defKs_star; case/Ptype_structure: hallKstar => // _ _ []. -- split=> [|p]; first by rewrite -defKs_star defKs. - apply/idP/idP=> [kMp | t1p]. - have /orP[// | /and3P[_ _ p_dv_M']] := kappa_tau13 kMp. - have hallM': \kappa(M)^'.-Hall(M) M^`(1). - exact/(sdprod_normal_pHallP (der_normal 1 M) hallK). - have piMp: p \in \pi(M) by rewrite kappa_pi. - case/idPn: kMp; apply: (pnatPpi (pHall_pgroup hallM')). - by move: piMp; rewrite !mem_primes !cardG_gt0 /= => /andP[->]. - apply: (pnatPpi (pHall_pgroup hallK)); have [_ _ not_p_dv_M'] := and3P t1p. - have: p \in \pi(M) by rewrite (partition_pi_mmax maxM) t1p ?orbT. - rewrite !mem_primes !cardG_gt0 /= => /andP[p_pr]. - by rewrite p_pr -(sdprod_card defM) Euclid_dvdM // (negPf not_p_dv_M'). -- split=> // [| x | y | x y K1_x Ks1_y]. - + have defMsMstar: M`_\sigma :&: Mstar = Ks. - apply: sub_pHall hallKs _ _ (subsetIr _ _). - exact: pgroupS (subsetIl _ _) (pcore_pgroup _ _). - by rewrite subsetI subsetIl /= -/Ks defKs (pHall_sub hallKstar). - have nKsMMstar: M :&: Mstar \subset 'N(Ks). - by rewrite -defMsMstar normsIG ?gFnorm. - have [_ [defNKs _] _ _ _] := Ptype_structure PmaxMstar hallKstar. - rewrite -(setIidPl nKsMMstar) -setIA defKs -defNKs defZstar. - by rewrite -defZ setIA setIid. - + case/setD1P; rewrite -cycle_eq1 -cycle_subG -cent_cycle => ntx sxK. - apply/eqP; rewrite eqEsubset andbC subsetI -{1}defZ subsetIl. - rewrite sub_abelian_cent ?cyclic_abelian //=; last first. - by rewrite (subset_trans sxK) ?joing_subl. - move: ntx; rewrite -rank_gt0 /= -{1}(setIidPr sxK) => /rank_geP[X]. - rewrite nElemI -setIdE -defZ => /setIdP[E1X sXx]. - by have [<- _] := defNX _ E1X; rewrite setIS ?cents_norm ?centS. - + case/setD1P; rewrite -cycle_eq1 -cycle_subG -cent_cycle => nty syKs. - have [_ [defNKs defNY] _ _ _] := Ptype_structure PmaxMstar hallKstar. - rewrite defZstar -defKs in defNKs defNY. - apply/eqP; rewrite eqEsubset andbC subsetI {1}defNKs subsetIl. - rewrite sub_abelian_cent ?cyclic_abelian //=; last first. - by rewrite (subset_trans syKs) ?joing_subr. - move: nty; rewrite -rank_gt0 /= -{1}(setIidPr syKs) => /rank_geP[Y]. - rewrite nElemI -setIdE defNKs => /setIdP[E1Y sYy]. - by have [<- _] := defNY _ E1Y; rewrite setIS ?cents_norm ?centS. - have [[_ K_x] [_ Ks_y]] := (setD1P K1_x, setD1P Ks1_y). - apply/eqP; rewrite eqEsubset sub_cent1 -(centsP cKKs) //. - have Tyx: y * x \in T by rewrite -defT big_setU1 //= inE Ks0 K0 mem_mulg. - rewrite (subset_trans _ (cent1_normedTI ntiT Tyx)) ?setTI //. - rewrite (subsetP _ _ Tyx) // -defZhat setDE subIset //. - by rewrite -abelianE cyclic_abelian. -split=> // [||H PmaxH]. -- split=> // a notMa. - have{tiKs} [_ _ _ [[tiKs _] _ _] _] := Ptype_structure PmaxM hallK. - rewrite -defT big_setU1 //= defMNX big_set1 -defKs defKs_star Ks0 K0. - rewrite centC ?(centSS _ _ cKKs) ?subsetDl // setUid. - apply/pred0Pn=> [[_ /andP[/mulsgP[x y K1_x Ks1_y ->] /= Ma_xy]]]. - have [[_ K_x] [nty Ks_y]] := (setD1P K1_x, setD1P Ks1_y); case/negP: nty. - rewrite -in_set1 -set1gE -(tiKs a notMa) inE Ks_y. - suffices ->: y = (x * y).`_\sigma(M) by rewrite groupX. - rewrite consttM; last by red; rewrite -(centsP cKKs). - have sM'K := sub_pgroup (@kappa_sigma' M) (pHall_pgroup hallK). - rewrite (constt1P (mem_p_elt sM'K K_x)) mul1g constt_p_elt //. - exact: mem_p_elt (pHall_pgroup hallKs) Ks_y. -- have:= set21 Mi Mj; rewrite -defMXij /MX defMNX defKs -K0. - by case/set2P=> <-; [left | right]. -have [maxH _] := setDP PmaxH. -have{maxH}[L hallL] := Hall_exists \kappa(H) (mmax_sol maxH). -pose Ls := 'C_(H`_\sigma)(L); pose S := (L <*> Ls) :\: (L :|: Ls). -have{IHn} oSGgt_g2: (g / 2%:R < #|class_support S G|%:R)%R. - have [|nTG_leS] := ltnP #|class_support S G| nTG. - by case/IHn=> // Sstar _ [_ _ _ _ [[_ _ -> //]]]. - apply: ltr_le_trans oTGgt_g2 _; rewrite ler_nat /TG -defZhat. - exact: leq_trans leTGn nTG_leS. -have{oSGgt_g2 oTGgt_g2} meetST: ~~ [disjoint TG & class_support S G]. - rewrite -leq_card_setU; apply: contraTneq (leqnn #|G|) => tiTGS. - rewrite -ltnNge -(ltr_nat [realFieldType of rat]) -/g. - rewrite -{1}[g](@divfK _ 2%:R) // mulr_natr. - apply: ltr_le_trans (ltr_add oTGgt_g2 oSGgt_g2) _. - by rewrite -natrD -tiTGS ler_nat cardsT max_card. -have{meetST} [x Tx [a Sx]]: exists2 x, x \in T & exists a, x \in S :^ a. - have [_ /andP[/imset2P[x a1 Tx _ ->]]] := pred0Pn meetST. - rewrite class_supportEr => /bigcupP[a2 _ Sa2_xa1]. - by exists x => //; exists (a2 * a1^-1); rewrite conjsgM mem_conjgV. -rewrite {}/S {}/Ls in Sx; without loss a1: a H L PmaxH hallL Sx / a = 1. - move/(_ 1 (H :^ a)%G (L :^ a)%G); rewrite conjsg1 PtypeJ PmaxH pHallJ2. - rewrite (eq_pHall _ _ (kappaJ H a)) hallL MsigmaJ centJ. - rewrite -conjIg -conjYg -conjUg -conjDg Sx !inE. - by rewrite !(orbit_transl _ (mem_orbit _ _ _)) ?inE //; apply. -have [_ [defNL _] [_ uniqH] _ _] := Ptype_structure PmaxH hallL. -do [rewrite {a}a1 conjsg1; set Ls := 'C_(_)(L)] in Sx defNL. -have{x Sx Tx} [Mk MXk ntLsMks]: exists2 Mk, Mk \in MX & Ls :&: Ks_ Mk != 1. - have [_ _ cLLs tiLLs] := dprodP defNL. - pose W := L <*> Ls; pose y := x.`_\sigma(H); pose ys := y.`_\sigma(Mi). - have Zy: y \in Z by apply: groupX; case/setDP: Tx; case/setD1P=> _ ->. - have{hallL} [hallL hallLs]: \sigma(H)^'.-Hall(W) L /\ \sigma(H).-Hall(W) Ls. - apply: coprime_mulGp_Hall; first by rewrite /= cent_joinEr. - exact: sub_pgroup (@kappa_sigma' H) (pHall_pgroup hallL). - exact: pgroupS (subsetIl _ _) (pcore_pgroup _ _). - have [nsLW nsLsW]: L <| W /\ Ls <| W := cprod_normal2 (cprodEY cLLs). - have{Sx} [Ls_y nty]: y \in Ls /\ y != 1. - move: Sx; rewrite 2!inE negb_or -andbA -/W; case/and3P=> notLx _ Wx. - split; first by rewrite (mem_normal_Hall hallLs) ?p_elt_constt ?groupX. - by rewrite (sameP eqP constt1P) -(mem_normal_Hall hallL). - have [[hallKi hallKis] [nsKi nsKis]] := (hallK_Z _ MXi, nsK_Z _ MXi). - have [/constt1P sM'y | ntys] := altP (ys =P 1). - exists Mj; rewrite // defKjs. - by apply/trivgPn; exists y; rewrite // inE Ls_y (mem_normal_Hall hallKi). - exists Mi => //; apply/trivgPn; exists ys; rewrite // inE groupX //=. - by rewrite (mem_normal_Hall hallKis) ?p_elt_constt // groupX. -suffices ->: H = Mk. - by move: MXk; rewrite /MX defMNX => /set2P[]->; rewrite inE orbit_refl ?orbT. -move: ntLsMks; rewrite -rank_gt0 => /rank_geP[Y E1Y]. -have:= E1Y; rewrite nElemI => /setIP[E1LsY _]. -apply: set1_inj; rewrite -(uniqH _ E1LsY). -have [PmaxMk hallKk] := PmaxMX _ MXk. -have [_ _ [_ -> //]] := Ptype_structure PmaxMk hallKk. -by rewrite /= setIC nElemI in E1Y; case/setIP: E1Y. -Qed. - -End PTypeEmbedding. - -(* This is the first part of B & G, Corollary 14.8. *) -Corollary P1type_trans : {in 'M_'P1 &, forall M H, gval H \in M :^: G}. -Proof. -move=> M H P1maxM P1maxH; have [PmaxM _] := setIdP P1maxM. -have [[maxM _] [PmaxH _]] := (setDP PmaxM, setIdP P1maxH). -have [K hallK] := Hall_exists \kappa(M) (mmax_sol maxM). -have [Mstar _ [_ _ _ _ [_ [|]]]] := Ptype_embedding PmaxM hallK. - by case; rewrite inE P1maxM. -case=> /setDP[_ /negP notP1maxMstar] _. -case/(_ H PmaxH)/setUP=> // /imsetP[a _ /group_inj defH]. -by rewrite defH P1typeJ in P1maxH. -Qed. - -(* This is the second part of B & G, Corollary 14.8. *) -Corollary Ptype_trans : {in 'M_'P, forall M, - exists2 Mstar, Mstar \in 'M_'P /\ gval Mstar \notin M :^: G - & {in 'M_'P, forall H, gval H \in M :^: G :|: Mstar :^: G}}. -Proof. -move=> M PmaxM; have [maxM _] := setDP PmaxM. -have [K hallK] := Hall_exists \kappa(M) (mmax_sol maxM). -have [Mstar PmaxMstar [_ _ _ _ [_ _ inMMs _]]] := Ptype_embedding PmaxM hallK. -by exists Mstar. -Qed. - -(* This is B & G, Corollary 14.9. *) -Corollary mFT_partition : - let Pcover := [set class_support M^~~ G | M : {group gT} in 'M] in - [/\ (*1*) 'M_'P == set0 :> {set {group gT}} -> partition Pcover G^# - & (*2*) forall M K, M \in 'M_'P -> \kappa(M).-Hall(M) K -> - let Ks := 'C_(M `_\sigma)(K) in let Z := K <*> Ks in - let Zhat := Z :\: (K :|: Ks) in - let ClZhat := class_support Zhat G in - partition (ClZhat |: Pcover) G^# /\ ClZhat \notin Pcover]. -Proof. -move=> Pcover; have notPcover0: set0 \notin Pcover. - apply/imsetP=> [[M maxM]]; apply/eqP; rewrite eq_sym; apply/set0Pn. - have [x Ms_x ntx] := trivgPn _ (Msigma_neq1 maxM); exists x. - rewrite class_supportEl; apply/bigcupP; exists x; last exact: class_refl. - by apply/bigcupP; exists x; [apply/setD1P | apply: lcoset_refl]. -have tiPcover: trivIset Pcover. - apply/trivIsetP=> _ _ /imsetP[M maxM ->] /imsetP[H maxH ->] notMGH. - rewrite -setI_eq0 !{1}class_supportEr big_distrr big1 //= => a Ga. - rewrite big_distrl big1 //= => b Gb; apply/eqP. - rewrite -!{1}sigma_supportJ setI_eq0 sigma_support_disjoint ?mmaxJ //. - apply: contra notMGH; rewrite {a Ga}(orbit_transl _ (mem_orbit _ _ Ga)). - rewrite {b Gb}(orbit_eqP (mem_orbit _ _ Gb))=> /imsetP[c Gc ->] /=. - by rewrite sigma_supportJ class_supportGidl. -have ntPcover: cover Pcover \subset G^#. - apply/bigcupsP=> _ /imsetP[M maxM ->]; rewrite class_supportEr. - apply/bigcupsP=> a _; rewrite subsetD1 subsetT mem_conjg conj1g {a}//=. - move/ell_sigma0P: (@erefl gT 1); rewrite cards_eq0; apply: contraL. - case/bigcupP=> x Ms_x xR1; apply/set0Pn; exists x. - exact: mem_sigma_cover_decomposition (Msigma_ell1 maxM Ms_x) xR1. -split=> [MP0 | M K PmaxM hallK Ks Z Zhat ClZhat]. - rewrite /partition eqEsubset ntPcover tiPcover notPcover0 !andbT /=. - apply/subsetP=> x; rewrite !inE andbT => ntx. - have:= sigma_decomposition_dichotomy ntx. - have [[y ell1y yRx] _ | _] := exists_inP. - have [nty /set0Pn[M /setIdP[maxM Ms_y]]] := ell_sigma1P _ ell1y. - apply/bigcupP; exists (class_support M^~~ G); first exact: mem_imset. - rewrite -(conjg1 x) mem_imset2 ?inE //. - apply/bigcupP; exists y; last by rewrite mem_lcoset. - by rewrite !inE nty -cycle_subG. - case/exists_inP=> y _; move: (_ * x) => y' /existsP[M]. - case/and3P => /setIdP[maxM _] /setD1P[nty' /setIP[My' _]] kMy' {y}. - case/set0Pn: MP0; exists M; rewrite 2!inE maxM andbT. - apply: contra nty' => kM'M; rewrite -order_eq1 (pnat_1 kMy') //. - exact: mem_p_elt kM'M My'. -have [_ [defNK _] [ntKs _] _ _] := Ptype_structure PmaxM hallK. -have [Mst [PmaxMst _] [_ [hallKst _] [defK _]]] := Ptype_embedding PmaxM hallK. -rewrite -/Ks -/Z -/Zhat in ntKs hallKst * => _ [_ _ conjMMst _]. -have [_ _ [ntK _] _ _] := Ptype_structure PmaxMst hallKst. -have [maxM _] := setDP PmaxM; rewrite defK in ntK. -have [|//|tiZPcover notPcovZ]: _ /\ ClZhat \notin _ := trivIsetU1 _ tiPcover _. - move=> HcovG; case/imsetP=> H maxH ->{HcovG}. - rewrite -setI_eq0 /ClZhat !class_supportEr big_distrr big1 //= => a _. - rewrite big_distrl big1 //= => b _; apply/eqP; rewrite -cards_eq0. - rewrite -(cardJg _ b^-1) conjIg conjsgK -conjsgM -sigma_supportJ cards_eq0. - wlog ->: a b H maxH / H :^ (a * b^-1) = H. - by move/(_ a a (H :^ (a * b^-1))%G); rewrite mmaxJ mulgV act1 => ->. - rewrite setIC big_distrl big1 //= => y Hs_y; apply/setP=> x; rewrite in_set0. - rewrite 3!inE mem_lcoset negb_or -andbA; apply/and4P=> [[yRx notKx notKs_x]]. - rewrite /Z cent_joinEr ?subsetIr //; case/mulsgP=> z z' Kz Ks_z' defx. - have:= sigma_decomposition_dichotomy (group1_contra notKx). - rewrite (introT exists_inP) /=; last first. - by exists y; rewrite // (Msigma_ell1 maxH). - have [Ms_z' cKz'] := setIP Ks_z'; case/exists_inP; exists z'. - rewrite (Msigma_ell1 maxM) ?inE // Ms_z' andbT. - by apply: contraNneq notKx => z'1; rewrite defx z'1 mulg1. - apply/existsP; exists M; rewrite inE maxM cycle_subG Ms_z'. - rewrite defx -(centP cKz') // mulKg (mem_p_elt (pHall_pgroup hallK)) //=. - rewrite 3!inE (subsetP (pHall_sub hallK)) //= cent1C !andbT. - rewrite andbC cent1C (subsetP _ _ Kz) ?sub_cent1 //=. - by apply: contraNneq notKs_x => z1; rewrite defx z1 mul1g. -split=> //; rewrite /partition eqEsubset 2!inE {}tiZPcover negb_or notPcover0. -rewrite /cover big_setU1 {notPcovZ}//= subUset ntPcover subsetD1 subsetT. -rewrite {}/ClZhat {}/Zhat !andbT /= andbC; apply/and3P; split. -- have [[y Ks_y nty] [y' Ky' nty']] := (trivgPn _ ntKs, trivgPn _ ntK). - rewrite eq_sym; apply/set0Pn; exists ((y' * y) ^ 1). - apply: mem_imset2; rewrite 2?inE // groupMl // groupMr // -/Ks negb_or. - have [_ _ _ tiKKs] := dprodP defNK. - rewrite -[Z]genM_join ?mem_gen ?mem_mulg //= andbT; apply/andP; split. - by apply: contra nty => Ky; rewrite -in_set1 -set1gE -tiKKs inE Ky. - by apply: contra nty' => Ks_y'; rewrite -in_set1 -set1gE -tiKKs inE Ky'. -- rewrite class_supportEr; apply/bigcupP=> [[a _]]. - by rewrite mem_conjg conj1g 2!inE !group1. -apply/subsetP=> x; case/setD1P=> ntx _; apply/setUP. -case: exists_inP (sigma_decomposition_dichotomy ntx) => [[y ell1y yRx] _ | _]. - have [nty] := ell_sigma1P _ ell1y; case/set0Pn=> H; case/setIdP=> maxH Hs_y. - right; apply/bigcupP; exists (class_support H^~~ G); first exact: mem_imset. - rewrite -[x]conjg1 mem_imset2 ?inE //; apply/bigcupP. - by exists y; rewrite ?mem_lcoset // !inE nty -cycle_subG. -case/exists_inP=> y ell1y /existsP[H]; set y' := y^-1 * x. -case/and3P=> /setIdP[maxH Hs_y] /setD1P[nty' /setIP[Hy' cyy']] kHy'. -rewrite {ntK ntKs maxM defNK}/Z /Ks; left. -wlog{Ks Mst PmaxMst hallKst conjMMst defK maxH} defH: M K PmaxM hallK / H :=: M. - move=> IH; have PmaxH: H \in 'M_'P. - apply/PtypeP; split=> //; exists (pdiv #[y']). - by rewrite (pnatPpi kHy') // pi_pdiv order_gt1. - have [|] := setUP (conjMMst H PmaxH); case/imsetP=> a Ga defH. - have:= IH _ (K :^ a)%G _ _ defH. - rewrite (eq_pHall _ _ (kappaJ _ _)) pHallJ2 PtypeJ MsigmaJ centJ. - by rewrite -conjIg -conjUg -conjYg -conjDg class_supportGidl //; apply. - have:= IH _ [group of Ks :^ a] _ _ defH. - rewrite (eq_pHall _ _ (kappaJ _ _)) pHallJ2 PtypeJ MsigmaJ centJ. - rewrite -conjIg -conjUg -conjYg -conjDg setUC joingC defK. - by rewrite class_supportGidl //; apply. -have /andP[sMsM nMsM]: M`_\sigma <| M := pcore_normal _ M. -have{Hs_y} Ms_y: y \in M`_\sigma by rewrite -defH -cycle_subG. -wlog{H defH Hy' kHy'} Ky': K hallK / y' \in K. - have [maxM _] := setDP PmaxM; rewrite -cycle_subG defH in Hy' kHy'. - have [a Ma Ka_y'] := Hall_subJ (mmax_sol maxM) hallK Hy' kHy'. - move/(_ (K :^ a)%G); rewrite pHallJ // -cycle_subG. - rewrite -{1 2}(normsP nMsM a Ma) centJ -conjIg -conjYg -conjUg -conjDg. - by rewrite class_supportGidl ?inE //; apply. -rewrite -[x]conjg1 mem_imset2 ?group1 //. -have [Mst _ [_ _ _ [cycZ _ defZ _ _] _]] := Ptype_embedding PmaxM hallK. -rewrite -(mulKVg y x) -/y' 2!inE negb_or andbC. -do [set Ks := 'C_(_)(K); set Z := K <*> _] in cycZ defZ *. -have Ks_y: y \in Ks. - have cKZ := sub_abelian_cent (cyclic_abelian cycZ) (joing_subl K Ks). - rewrite inE Ms_y (subsetP cKZ) // -(defZ y'); last by rewrite !inE nty'. - by rewrite inE cent1C (subsetP sMsM). -have [_ [defNK _] _ _ _] := Ptype_structure PmaxM hallK. -have{defNK} [_ _ cKKs tiKKs] := dprodP defNK. -rewrite [Z]joingC cent_joinEl // mem_mulg // groupMr // groupMl //= -/Ks. -apply/andP; split. - have [nty _] := ell_sigma1P _ ell1y. - by apply: contra nty => Ky; rewrite -in_set1 -set1gE -tiKKs inE Ky. -by apply: contra nty' => Ks_y'; rewrite -in_set1 -set1gE -tiKKs inE Ky'. -Qed. - -(* This is B & G, Corollary 14.10. *) -Corollary ell_sigma_leq_2 x : \ell_\sigma(x) <= 2. -Proof. -have [/ell_sigma0P/eqP-> // | ntx] := eqVneq x 1. -case sigma_x: (x \in cover [set class_support M^~~ G | M : {group gT} in 'M]). - case/bigcupP: sigma_x => _ /imsetP[M maxM ->]. - case/imset2P=> x0 a /bigcupP[y Ms_y yRx0] _ ->; rewrite ell_sigmaJ. - exact: ell_sigma_cover (Msigma_ell1 maxM Ms_y) yRx0. -have G1x: x \in G^# by rewrite !inE andbT. -have [FpartG1 PpartG1] := mFT_partition. -have [/eqP/FpartG1 partG1 | [M PmaxM]] := set_0Vmem ('M_'P : {set {group gT}}). - by rewrite -(cover_partition partG1) sigma_x in G1x. -have [maxM _] := setDP PmaxM. -have [K hallK] := Hall_exists \kappa(M) (mmax_sol maxM). -have{PpartG1} [/cover_partition defG1 notZsigma] := PpartG1 M K PmaxM hallK. -rewrite -{}defG1 /cover big_setU1 {notZsigma}// inE {}sigma_x orbF in G1x. -case/imset2P: G1x => x0 a /setDP[]. -have [Mst [PmaxMst _] [_ _ [defK _] _ _]] := Ptype_embedding PmaxM hallK. -rewrite cent_joinEr ?subsetIr // => /mulsgP[y' y Ky' /= Ks_y ->]. -rewrite inE; have [-> | nty] := eqVneq y 1; first by rewrite mulg1 Ky'. -have [-> | nty' _ _ ->] := eqVneq y' 1; first by rewrite mul1g Ks_y orbT. -have [Ms_y cKy] := setIP Ks_y; set Ks := 'C_(_)(_) in Ks_y defK. -have Msts_y': y' \in Mst`_\sigma by move: Ky'; rewrite -defK => /setIP[]. -have kMy': \kappa(M).-elt y' := mem_p_elt (pHall_pgroup hallK) Ky'. -have{kMy'} sM'y': \sigma(M)^'.-elt y' := sub_pgroup (@kappa_sigma' _) kMy'. -rewrite ell_sigmaJ /sigma_length (cardsD1 (y' * y).`_\sigma(M)). -rewrite (leq_add (leq_b1 _)) // -sigma_decomposition_constt' //. -rewrite consttM /commute ?(centP cKy) // constt_p_elt //. -rewrite (constt1P _) ?p_eltNK ?(mem_p_elt (pcore_pgroup _ _) Ms_y) // mulg1. -have [maxMst _] := setDP PmaxMst; rewrite leq_eqVlt (Msigma_ell1 maxMst) //. -by rewrite !inE nty' Msts_y'. -Qed. - -(* This is B & G, Lemma 14.11. *) -Lemma primes_non_Fitting_Ftype M E q Q : - M \in 'M_'F -> \sigma(M)^'.-Hall(M) E -> - Q \in 'E_q^1(E) -> ~~ (Q \subset 'F(E)) -> - exists2 Mstar, Mstar \in 'M & - [\/ (*1*) q \in \tau2(Mstar) /\ 'M('C(Q)) = [set Mstar] - | (*2*) q \in \kappa(Mstar) /\ Mstar \in 'M_'P1 ]. -Proof. -move=> FmaxM hallE EqQ notsFE_Q; have [maxM k'M] := FtypeP _ FmaxM. -have [sQE abelQ dimQ] := pnElemP EqQ; have [qQ _] := andP abelQ. -have [q_pr oQ] := (pnElem_prime EqQ, card_pnElem EqQ : #|Q| = q). -have t1Mq: q \in \tau1(M). - have: q \in \pi(E) by rewrite -p_rank_gt0; apply/p_rank_geP; exists Q. - rewrite (partition_pi_sigma_compl maxM hallE) => /or3P[// | t2q | t3q]. - have [A EqA _] := ex_tau2Elem hallE t2q. - have [[nsAE defA1] _ _ _] := tau2_compl_context maxM hallE t2q EqA. - have sQA: Q \subset A by move: EqQ; rewrite defA1 => /pnElemP[]. - rewrite (subset_trans sQA) ?Fitting_max // ?abelian_nil // in notsFE_Q. - by have [_ abelA _] := pnElemP EqA; apply: abelem_abelian abelA. - have [[E1 hallE1] [E3 hallE3]] := ex_tau13_compl hallE. - have [E2 _ complEi] := ex_tau2_compl hallE hallE1 hallE3. - have [[_ nsE3E] _ [_ cycE3] _ _] := sigma_compl_context maxM complEi. - have sQE3: Q \subset E3 by rewrite (sub_normal_Hall hallE3) ?(pi_pgroup qQ). - rewrite (subset_trans sQE3) ?Fitting_max ?abelian_nil // in notsFE_Q. - exact: cyclic_abelian cycE3. -have q'FE: q^'.-group 'F(E). - have [R sylR sQR] := Sylow_superset sQE qQ; have [sRE qR _] := and3P sylR. - have cycR: cyclic R. - rewrite (odd_pgroup_rank1_cyclic qR) ?mFT_odd // (p_rank_Sylow sylR) //. - by move: t1Mq; rewrite (tau1E maxM hallE) eqn_leq; case/and4P. - rewrite -partG_eq1 -(card_Hall (Hall_setI_normal (Fitting_normal E) sylR)). - have sRFER: R :&: 'F(E) \subset R := subsetIl _ _. - apply: contraR notsFE_Q; rewrite -trivg_card1 => ntRFE. - rewrite (subset_trans _ (subsetIr R _)) // -(cardSg_cyclic cycR) // oQ. - by have [] := pgroup_pdiv (pgroupS sRFER qR) ntRFE. -have cE'E': abelian E^`(1) := der_mmax_compl_abelian maxM hallE. -pose K := [~: E, Q]; have cKK: abelian K by rewrite (abelianS (commgS E sQE)). -have nsKE: K <| E by rewrite /normal commg_norml comm_subG. -have q'K: q^'.-group K by rewrite (pgroupS _ q'FE) // Fitting_max ?abelian_nil. -have [sKE nKE] := andP nsKE; have nKQ := subset_trans sQE nKE. -have defKQ: [~: K, Q] = K. - have nsKQ_E: K <*> Q <| E. - rewrite -(quotientGK nsKE) -(quotientYK nKQ) cosetpre_normal /= -/K. - by rewrite /normal quotientS // cents_norm // quotient_cents2r. - have [_ sylQ] := coprime_mulGp_Hall (esym (norm_joinEr nKQ)) q'K qQ. - have defE: K * 'N_E(Q) = E. - rewrite -{2}(Frattini_arg nsKQ_E sylQ) /= norm_joinEr //= -/K -mulgA. - by congr (K * _); rewrite mulSGid // subsetI sQE normG. - have cQ_NEQ: [~: 'N_E(Q), Q] = 1. - apply/trivgP; rewrite -(coprime_TIg (pnat_coprime qQ q'K)) subsetI. - by rewrite commg_subr subsetIr commSg ?subsetIl. - by rewrite {2}/K -defE commMG ?cQ_NEQ ?mulg1 1?normsR ?subsetIr ?subIset ?nKE. -have [sEM s'E _] := and3P hallE; have sQM := subset_trans sQE sEM. -have [sKM s'K] := (subset_trans sKE sEM, pgroupS sKE s'E). -have regQ: 'C_(M`_\sigma)(Q) = 1. - apply/eqP; apply: contraFT (k'M q) => nregQ. - have EqQ_M: Q \in 'E_q^1(M) by apply/pnElemP. - by rewrite unlock 3!inE /= t1Mq; apply/exists_inP; exists Q. -have nsKM: K <| M. - have [s'q _] := andP t1Mq. - have EqQ_NK: Q \in 'E_q^1('N_M(K)) by apply/pnElemP; rewrite subsetI sQM. - have:= commG_sigma'_1Elem_cyclic maxM sKM s'K s'q EqQ_NK regQ q'K cKK. - by rewrite defKQ; case. -have ntK: K != 1. - apply: contraNneq notsFE_Q => /commG1P cQE. - by rewrite Fitting_max ?(pgroup_nil qQ) // /normal sQE cents_norm. -pose p := pdiv #|K|; have p_pr: prime p by rewrite pdiv_prime ?cardG_gt1. -have piKp: p \in \pi(K) by rewrite pi_pdiv cardG_gt1. -have t2Mp: p \in \tau2(M). - have s'p := pnatPpi s'K piKp. - have sylKp: p.-Sylow(K) 'O_p(K) := nilpotent_pcore_Hall p (abelian_nil cKK). - have ntKp: 'O_p(K) != 1 by rewrite -rank_gt0 (rank_Sylow sylKp) p_rank_gt0. - rewrite inE /= s'p ?(sigma'_norm_mmax_rank2 maxM s'p (pHall_pgroup sylKp)) //. - by rewrite (mmax_normal maxM) ?gFnormal_trans. -have [A EpA _] := ex_tau2Elem hallE t2Mp. -have [sAE /andP[pA _] dimA] := pnElemP EpA. -have [[nsAE _] _ _ _] := tau2_compl_context maxM hallE t2Mp EpA. -have nAQ := subset_trans sQE (normal_norm nsAE). -have [S sylS sAS]:= Sylow_superset (subsetT A) pA. -have not_cSS: ~~ abelian S. - apply: contra notsFE_Q => cSS; rewrite Fitting_max ?(pgroup_nil qQ) //. - have solE := sigma_compl_sol hallE. - have [E1 hallE1 sQE1] := Hall_superset solE sQE (pi_pgroup qQ t1Mq). - have [_ [E3 hallE3]] := ex_tau13_compl hallE. - have [E2 _ complEi] := ex_tau2_compl hallE hallE1 hallE3. - have [_ _ _ sQZ] := abelian_tau2 maxM complEi t2Mp EpA sylS sAS cSS. - by rewrite sub_center_normal ?{}sQZ //; apply/nElemP; exists q; apply/pnElemP. -have [] := nonabelian_tau2 maxM hallE t2Mp EpA (pHall_pgroup sylS) not_cSS. -set A0 := 'C_A(M`_\sigma)%G => _ [oA0 defFM] _ _. -have defA0: A0 :=: K. - have sA0E: A0 \subset E by rewrite subIset ?sAE. - have sKA0: K \subset A0. - have [_ _ _ tiMsE] := sdprodP (sdprod_sigma maxM hallE). - rewrite -(mul1g A0) -tiMsE setIC group_modr // subsetI sKE. - by have [_ -> _ _] := dprodP defFM; rewrite Fitting_max ?abelian_nil. - by apply/eqP; rewrite eqEsubset prime_meetG ?(setIidPr sKA0) ?oA0. -have ntA: A :!=: 1 := nt_pnElem EpA isT. -have [H maxNH] := mmax_exists (mFT_norm_proper ntA (mFT_pgroup_proper pA)). -have [maxH sNH] := setIdP maxNH; have sQH := subset_trans nAQ sNH. -exists H => //. -have: p \in [predD \sigma(H) & \beta(H)] /\ q \in [predU \tau1(H) & \tau2(H)]. - have [-> // piAb _] := primes_norm_tau2Elem maxM hallE t2Mp EpA maxNH. - rewrite (pnatPpi piAb) // (piSg (quotientS _ sQE)) //=. - have piQq: q \in \pi(Q) by rewrite -p_rank_gt0 p_rank_abelem ?dimQ. - rewrite /= card_quotient ?normsI ?norms_cent // ?normsG //. - rewrite -indexgI setIA (setIidPl sQE) prime_TIg ?indexg1 // ?oQ //. - rewrite (sameP commG1P eqP) (subG1_contra _ ntK) //= -/K -defKQ commGC. - by rewrite -defA0 commgS ?subsetIl. -case=> /andP[/= b'Hp sHP] t12Hq. -have nregQHs: 'C_(H`_\sigma)(Q) != 1. - apply: subG1_contra (setSI _ _) (_ : 'C_A(Q) != 1). - rewrite (sub_Hall_pcore (Msigma_Hall maxH)) ?(pi_pgroup pA) //. - exact: subset_trans (normG A) sNH. - apply: contraTneq (leqnn 1) => regQA; rewrite -ltnNge -dimA. - rewrite -(leq_exp2l _ _ (prime_gt1 p_pr)) -card_pgroup // -oA0 defA0. - have coAQ := pnat_coprime (pi_pnat pA t2Mp) (pi_pnat qQ (tau2'1 t1Mq)). - rewrite subset_leq_card // -(coprime_cent_prod nAQ) ?(pgroup_sol pA) //. - by rewrite regQA mulg1 commSg. -have{t12Hq} [/= t1Hq | /= t2Hq] := orP t12Hq. - have EqQ_H: Q \in 'E_q^1(H) by apply/pnElemP. - have kHq: q \in \kappa(H). - by rewrite unlock 3!inE /= t1Hq; apply/exists_inP; exists Q. - right; split=> //; apply: contraR b'Hp => notP1maxH. - have PmaxH: H \in 'M_'P by apply/PtypeP; split=> //; exists q. - have [L hallL] := Hall_exists \kappa(H) (mmax_sol maxH). - by have [_ _ _ _ [|<- //]] := Ptype_structure PmaxH hallL; apply/setDP. -left; split=> //. -have [x defQ]: exists x, Q :=: <[x]> by apply/cyclicP; rewrite prime_cyclic ?oQ. -rewrite defQ cent_cycle in nregQHs *; rewrite (cent1_nreg_sigma_uniq maxH) //. - by rewrite 2!inE -cycle_eq1 -cycle_subG -defQ (nt_pnElem EqQ). -by rewrite /p_elt /order -defQ oQ pnatE. -Qed. - -(* This is B & G, Lemma 14.12. *) -(* Note that the assumption M \in 'M_'P2 could be weakened to M \in 'M_'P, *) -(* since the assumption H \in 'M('N(R)) implies H != 1, and hence U != 1. *) -Lemma P2type_signalizer M Mstar U K r R H : - M \in 'M_'P2 -> kappa_complement M U K -> Mstar \in 'M('C(K)) -> - r.-Sylow(U) R -> H \in 'M('N(R)) -> - [/\ H \in 'M_'F, U \subset H`_\sigma, U <*> K = M :&: H - & [/\ ~~ ('N_H(U) \subset M), K \subset 'F(H :&: Mstar) - & \sigma(H)^'.-Hall(H) (H :&: Mstar)]]. -Proof. -move=> P2maxM complU maxCMstar sylR maxNH; have [hallU hallK _] := complU. -have [PmaxM notP1maxM] := setDP P2maxM; have [maxM notFmaxM] := setDP PmaxM. -have [[sUM sk'M_U _] [sKM kK _]] := (and3P hallU, and3P hallK). -have{notFmaxM} ntK: K :!=: 1 by rewrite (trivg_kappa maxM). -have [hallE defM _ regK /(_ ntK)cUU] := kappa_compl_context maxM complU. -case/sdprodP: defM => [[_ E _ defE] _ _ _]. -have [nsUE sKE mulUK nUK tiUK] := sdprod_context defE. -rewrite (norm_joinEr nUK) mulUK in hallE *. -have [Mst [PmaxMst notMGMst] [uniqMst []]] := Ptype_embedding PmaxM hallK. -set Ks := 'C_(_)(K) => hallKs; case/and3P=> sKsMst sM_Ks _ [defK _]. -case=> cycZ ziMMst _ _ _ [_ _ defPmax _]. -have [_ [defNK _] [ntKs _] _ [//|_ q_pr _ _]] := Ptype_structure PmaxM hallK. -set q := #|K| in q_pr. -have{uniqMst} uniqMst: 'M('C(K)) = [set Mst]. - by apply: uniqMst; apply/nElemP; exists q; rewrite p1ElemE // !inE subxx /=. -have{maxCMstar} ->: Mstar = Mst by [apply/set1P; rewrite -uniqMst] => {Mstar}. -have [maxH sNRH] := setIdP maxNH. -have ntR: R :!=: 1. - by apply: contraTneq sNRH => ->; rewrite norm1 proper_subn ?mmax_proper. -have piUr: r \in \pi(U) by rewrite -p_rank_gt0 -(rank_Sylow sylR) rank_gt0. -have r_pr: prime r by move: piUr; rewrite mem_primes; case/andP. -have sylR_M := subHall_Sylow hallU (pnatPpi sk'M_U piUr) sylR. -have [/= s'Mr k'Mr] := norP (pnatPpi sk'M_U piUr). -have [sRH [sRM rR _]] := (subset_trans (normG R) sNRH, and3P sylR_M). -have notMGH: gval H \notin M :^: G. - apply: contra s'Mr; case/imsetP=> a _ defH. - rewrite -(sigmaJ _ a) -defH; apply/exists_inP; exists R => //. - by rewrite pHallE sRH /= (card_Hall sylR_M) defH cardJg. -have sK_uniqMst a: K \subset Mst :^ a -> a \in Mst. - move=> sKMa; apply: contraR ntK; rewrite -in_setC => Mst'a. - have [_ _ _ [[tiK_MstG _] _ _] _] := Ptype_structure PmaxMst hallKs. - by rewrite -(tiK_MstG a) // defK (setIidPl sKMa). -have [_ _] := dprodP defNK; rewrite -/Ks => cKKs tiKKs. -have snK_sMst L: K <|<| L -> L \subset Mst. - elim: {L}_.+1 {-2}L (ltnSn #|L|) => // n IHn A leAn. - case/subnormalEr=> [<- | [L [snKL nsLA ltLA]]]. - by rewrite -defK subIset // pcore_sub. - have [sKL sLMst]: K \subset L /\ L \subset Mst. - by rewrite subnormal_sub // IHn // (leq_trans (proper_card ltLA)). - apply/subsetP=> a Aa; rewrite -groupV sK_uniqMst // (subset_trans sKL) //. - by rewrite -sub_conjg (normsP (normal_norm nsLA)). -have sEH: E \subset H. - have defR: R :=: 'O_r(U) := nilpotent_Hall_pcore (abelian_nil cUU) sylR. - by apply: subset_trans sNRH; rewrite defR gFnorm_trans ?normal_norm. -have [sUH sKH]: U \subset H /\ K \subset H by apply/mulGsubP; rewrite mulUK. -have notMstGH: gval H \notin Mst :^: G. - apply: contra ntR => /imsetP[a _ defH]. - have{a defH} defH: H :=: Mst by rewrite -(conjGid (sK_uniqMst a _)) -?defH. - rewrite -(setIidPl sRH) -(setIidPl sRM) -setIA defH ziMMst coprime_TIg //=. - rewrite cent_joinEr // TI_cardMg //= coprime_mulr -/Ks. - rewrite (p'nat_coprime (pi_pnat rR _) kK) //=. - exact: p'nat_coprime (pi_pnat rR _) sM_Ks. -have FmaxH: H \in 'M_'F. - suffices: H \notin 'M_'P by rewrite inE maxH andbT negbK. - by apply: (contra (defPmax H)); rewrite inE; apply/norP. -have sKMsts: K \subset Mst`_\sigma by rewrite -defK subsetIl. -have s'H_K: \sigma(H)^'.-group K. - apply/pgroupP=> p p_pr p_dv_K; have [maxMst _] := setDP PmaxMst. - apply: contraFN (sigma_partition maxMst maxH notMstGH p) => /= sHp. - by rewrite inE /= (pgroupP (pgroupS sKMsts _)) ?pcore_pgroup. -have [D hallD sKD] := Hall_superset (mmax_sol maxH) sKH s'H_K. -have piKq: q \in \pi(K) by rewrite pi_of_prime ?inE. -have sK_FD: K \subset 'F(D). - have EqK: K \in 'E_q^1(D) by rewrite p1ElemE // !inE sKD /=. - have sMst_q: q \in \sigma(Mst). - by rewrite (pnatPpi (pcore_pgroup _ _) (piSg sKMsts _)). - apply: contraR notP1maxM => not_sKFD. - have [L _ ] := primes_non_Fitting_Ftype FmaxH hallD EqK not_sKFD. - case=> [[t2Lq ]|[kLq P1maxL]]. - rewrite uniqMst => /set1_inj defL. - by rewrite -defL 3!inE sMst_q in t2Lq. - have [PmaxL _] := setIdP P1maxL. - case/setUP: (defPmax L PmaxL) => /imsetP[a _ defL]. - by rewrite (group_inj defL) P1typeJ in P1maxL. - move: kLq; rewrite defL kappaJ unlock 3!inE /=. - by rewrite -andb_orr inE /= sMst_q. -have sDMst: D \subset Mst. - apply: snK_sMst (subnormal_trans _ (normal_subnormal (Fitting_normal D))). - exact: nilpotent_subnormal (Fitting_nil D) sK_FD. -have defUK: [~: U, K] = U. - rewrite -{2}(coprime_cent_prod nUK) ?abelian_sol //; last first. - by apply: p'nat_coprime (sub_pgroup _ sk'M_U) kK => ? /norP[]. - by rewrite (cent_semiregular regK) ?mulg1. -have qK: q.-group K := pnat_id q_pr. -have sUHs: U \subset H`_\sigma. - have [nsHsH _ mulHsD nHsD _] := sdprod_context (sdprod_sigma maxH hallD). - have nHsDq: 'O_q(D) \subset 'N(H`_\sigma) by apply: gFsub_trans. - pose HsDq := H`_\sigma <*> 'O_q(D). - have defHsDq: H`_\sigma * 'O_q(D) = HsDq by rewrite -norm_joinEr. - have hallHs_HsDq: q^'.-Hall(HsDq) H`_\sigma. - have [|//] := coprime_mulGp_Hall defHsDq _ (pcore_pgroup _ _). - rewrite p'groupEpi; apply: (contra (pnatPpi (pcore_pgroup _ _))). - exact: pnatPpi s'H_K piKq. - have sK_HsDq: K \subset HsDq. - rewrite sub_gen ?subsetU // orbC -p_core_Fitting. - by rewrite (sub_Hall_pcore (nilpotent_pcore_Hall _ (Fitting_nil _))) ?qK. - have [|sHsDq_H nHsDq_H] := andP (_ : HsDq <| H). - rewrite -(quotientGK nsHsH) -[HsDq]quotientYK //= cosetpre_normal //. - by rewrite -{3}mulHsD quotientMidl quotient_normal // pcore_normal. - have sU_HsDq: U \subset HsDq. - by rewrite -defUK (subset_trans (commgSS sUH sK_HsDq)) // commg_subr. - rewrite (sub_normal_Hall hallHs_HsDq) ?normalYl // p'groupEpi. - by apply: contraL (pnatPpi sk'M_U) _; rewrite !inE /= orbC (pnatPpi kK). -have defNMU: 'N_M(U) = E. - have [_ mulHsE nHsE _] := sdprodP (sdprod_sigma maxM hallE). - have [sUE nUE] := andP nsUE; rewrite -mulHsE -normC // -group_modl //=. - rewrite coprime_norm_cent ?(subset_trans sUE) //; last first. - exact: coprimegS sUE (coprime_sigma_compl hallE). - have sR1U: 'Ohm_1(R) \subset U := gFsub_trans _ (pHall_sub sylR). - rewrite (trivgP (subset_trans (setIS _ (centS sR1U)) _)) ?mulg1 //. - have [|_ _ -> //] := sigma'_kappa'_facts maxM sylR_M. - by rewrite s'Mr (piSg sUM). -have sHsFH: H`_\sigma \subset 'F(H). - rewrite Fitting_max ?pcore_normal //. - have [S] := Sylow_exists q H; case/sigma'_kappa'_facts=> {S}//. - have [_ k'H] := setIdP FmaxH. - rewrite [~~ _](pnatPpi (pHall_pgroup hallD) (piSg sKD _)) //=. - by rewrite [~~ _](pnatPpi k'H) (piSg sKH). -suffices ->: H :&: Mst = D. - set sk' := _^' in sk'M_U hallU; pose Fu := 'O_sk'('F(H)). - have [sUFH nilFH] := (subset_trans sUHs sHsFH, Fitting_nil H). - have hallFu: sk'.-Hall('F(H)) Fu := nilpotent_pcore_Hall sk' nilFH. - have sUFu: U \subset Fu by rewrite (sub_Hall_pcore hallFu). - have nsFuH: Fu <| H by rewrite !gFnormal_trans. - have [[sFuFH sk'Fu _] [sFuH nFuH]] := (and3P hallFu, andP nsFuH). - have defU: M :&: Fu = U. - have sk'MFu: sk'.-group(M :&: Fu) := pgroupS (subsetIr M _) sk'Fu. - by rewrite (sub_pHall hallU sk'MFu) ?subsetIl // subsetI sUM. - do 2?split=> //. - apply/eqP; rewrite eqEsubset subsetI (pHall_sub hallE) sEH /=. - by rewrite -defNMU subsetI subsetIl -defU normsGI. - apply: contra (contra_orbit _ _ notMGH) => sNHU_M. - rewrite (eq_mmax maxH maxM (subset_trans _ sNHU_M)) // subsetIidl. - rewrite -(nilpotent_sub_norm (nilpotentS sFuFH nilFH) sUFu) //= -/Fu. - by rewrite -{2}defU subsetI subsetIl (subset_trans (setSI _ sFuH)). -have [maxMst _] := setDP PmaxMst. -have [_ <- _ _] := sdprodP (sdprod_sigma maxH hallD). -rewrite -{2}(mul1g D) setIC -group_modr // setIC; congr (_ * _). -apply/eqP; apply: wlog_neg => ntHsMst. -have nregHsK: 'C_(H`_\sigma)(K) != 1. - rewrite (subG1_contra _ ntHsMst) // subsetI subsetIl (sameP commG1P trivgP). - have <-: H`_\sigma :&: Mst`_\sigma = 1. - apply: card_le1_trivg; rewrite leqNgt -pi_pdiv; set p := pdiv _. - apply: contraFN (sigma_partition maxMst maxH notMstGH p) => piIp. - rewrite inE /= (pnatPpi (pcore_pgroup _ _) (piSg (subsetIl _ _) piIp)). - by rewrite (pnatPpi (pcore_pgroup _ _) (piSg (subsetIr _ _) piIp)). - rewrite commg_subI ?setIS ?gFnorm // subsetI sKMsts. - by rewrite (subset_trans sKH) ?gFnorm. -have t2Hq: q \in \tau2(H). - have: q \in \pi(D) := piSg sKD piKq. - rewrite (partition_pi_sigma_compl maxH hallD) orbCA; case/orP=> // t13Hq. - case/FtypeP: FmaxH => _ /(_ q)/idP[]; rewrite unlock 3!inE /= t13Hq. - by apply/exists_inP; exists K => //; rewrite p1ElemE // !inE sKH /=. -have [A EqA_D EqA] := ex_tau2Elem hallD t2Hq. -have [_ _ _ -> //] := tau2_context maxH t2Hq EqA. -rewrite 3!inE -val_eqE /= eq_sym (contra_orbit _ _ notMstGH) maxMst. -by have [sAD _ _] := pnElemP EqA_D; apply: subset_trans sAD sDMst. -Qed. - -(* This is B & G, Lemma 14.13(a). *) -(* Part (b) is not needed for the Peterfalvi revision of the character theory *) -(* part of the proof. *) -Lemma non_disjoint_signalizer_Frobenius x M : - \ell_\sigma(x) == 1%N -> #|'M_\sigma[x]| > 1 -> - M \in 'M_\sigma[x] -> ~~ (\sigma('N[x])^'.-group M) -> - M \in 'M_'F /\ \tau2(M)^'.-group M. -Proof. -move=> ell1x ntR SMxM; have [maxM Ms_x] := setIdP SMxM. -rewrite negb_and cardG_gt0 all_predC negbK => /hasP[q /= piMq sNq]. -have [Q EqQ]: exists Q, Q \in 'E_q^1(M) by apply/p_rank_geP; rewrite p_rank_gt0. -have [ntQ [sQM abelQ dimQ]] := (nt_pnElem EqQ isT, pnElemP EqQ). -have [[qQ _] q_pr] := (andP abelQ, pnElem_prime EqQ). -have [_ [//| uniqN _ t2Nx _]] := FT_signalizer_context ell1x. -case/(_ M SMxM)=> _ st2NsM spM_sbN _; have [maxN sCxN] := mem_uniq_mmax uniqN. -have bNq: q \in \beta('N[x]) by rewrite spM_sbN //= 4!inE /= piMq. -have bGq: q \in \beta(G) by move: bNq; rewrite -predI_sigma_beta // inE /= sNq. -set p := pdiv #[x]; have pi_p: p \in \pi(#[x]). - by rewrite pi_pdiv order_gt1 (sameP eqP (ell_sigma0P _)) (eqP ell1x). -have sMp: p \in \sigma(M) := pnatPpi (pcore_pgroup _ _) (piSg Ms_x pi_p). -have t2Np: p \in \tau2('N[x]) := pnatPpi t2Nx pi_p. -have notMGN: gval 'N[x] \notin M :^: G. - apply: contraL t2Np => /imsetP[a _ ->]. - by rewrite negb_and negbK /= sigmaJ sMp. -have sM'q: q \in \sigma(M)^'. - by apply: contraFN (sigma_partition maxM maxN notMGN q) => sMq; apply/andP. -have [g sQNg]: exists g, Q \subset 'N[x] :^ g. - have [Q1 sylQ1] := Sylow_exists q 'N[x]. - have [g _ sQQ1g] := Sylow_subJ (sigma_Sylow_G maxN sNq sylQ1) (subsetT Q) qQ. - by exists g; rewrite (subset_trans sQQ1g) // conjSg (pHall_sub sylQ1). -have EqNQ: Q \in 'E_q^1('N[x] :^ g) by apply/pnElemP. -have uniqNg: 'M('C(Q)) = [set 'N[x] :^ g]%G. - by case/cent_der_sigma_uniq: EqNQ; rewrite ?mmaxJ 1?betaJ ?bNq. -have b'Mp: p \notin \beta(M). - by rewrite -predI_sigma_beta // inE /= sMp /=; case/tau2_not_beta: t2Np. -have{p pi_p sMp t2Np b'Mp} FmaxM: M \in 'M_'F. - have [P1maxM | notP1maxM] := boolP (M \in 'M_'P1); last first. - have [K hallK] := Hall_exists \kappa(M) (mmax_sol maxM). - apply: contraR b'Mp => notFmaxM; have PmaxM: M \in 'M_'P by apply/setDP. - by have [_ _ _ _ [|<- //]] := Ptype_structure PmaxM hallK; apply/setDP. - have [PmaxM skM] := setIdP P1maxM. - have kMq: q \in \kappa(M). - by case/orP: (pnatPpi skM piMq) => //= sMq; case/negP: sM'q. - have [K hallK sQK] := Hall_superset (mmax_sol maxM) sQM (pi_pnat qQ kMq). - have EqKQ: Q \in 'E_q^1(K) by apply/pnElemP. - have [L _ [uniqL [kLhallKs sMhallKs] _ _ _]] := Ptype_embedding PmaxM hallK. - set Ks := 'C_(_)(K) in kLhallKs sMhallKs. - have{uniqL} defL: 'N[x] :^ g = L. - apply: congr_group; apply: set1_inj; rewrite -uniqNg uniqL //. - by apply/nElemP; exists q. - have rpL: 'r_p(L) = 2. - by apply/eqP; case/andP: t2Np => _; rewrite -defL p_rankJ. - suffices piKs_p: p \in \pi(Ks). - by rewrite rank_kappa // (pnatPpi (pHall_pgroup kLhallKs)) in rpL. - have [P sylP] := Sylow_exists p [group of Ks]. - have sylP_L: p.-Sylow(L) P := subHall_Sylow sMhallKs sMp sylP. - by rewrite -p_rank_gt0 -(rank_Sylow sylP) (rank_Sylow sylP_L) ?rpL. -split=> //; apply: sub_pgroup (pgroup_pi _) => p piMp; apply/negP=> /= t2Mp. -have rpN: 'r_p('N[x]) <= 1. - have: p \notin \beta('N[x]). - rewrite -(predI_sigma_beta maxN) negb_and /= orbC. - by have [-> _] := tau2_not_beta maxM t2Mp. - apply: contraR; rewrite -ltnNge => rpN; rewrite spM_sbN // inE /= piMp. - have: p \in \pi('N[x]) by rewrite -p_rank_gt0 ltnW. - rewrite (partition_pi_mmax maxN) orbCA => /orP[t2Np | ]. - by case/andP: t2Mp => /negP[]; apply: st2NsM. - by rewrite orbA -!andb_orr eqn_leq leqNgt rpN andbF. -have [E hallE sQE] := Hall_superset (mmax_sol maxM) sQM (pi_pgroup qQ sM'q). -have [A Ep2A _] := ex_tau2Elem hallE t2Mp; have [_ abelA dimA] := pnElemP Ep2A. -pose A0 := [~: A, Q]%G; pose A1 := 'C_A(Q)%G. -have sCQNg: 'C(Q) \subset 'N[x] :^ g by have [] := mem_uniq_mmax uniqNg. -have ntA0: A0 :!=: 1. - rewrite (sameP eqP commG1P); apply: contraL rpN => cQA. - rewrite -ltnNge -(p_rankJ p _ g); apply/p_rank_geP. - by exists A; apply/pnElemP; rewrite (subset_trans cQA). -have t1Mq: q \in \tau1(M). - have [_ nsCEA_E t1Eb] := tau1_cent_tau2Elem_factor maxM hallE t2Mp Ep2A. - rewrite (pnatPpi t1Eb) // (piSg (quotientS _ sQE)) // -p_rank_gt0. - rewrite -rank_pgroup ?quotient_pgroup // rank_gt0 -subG1. - rewrite quotient_sub1 ?(subset_trans _ (normal_norm nsCEA_E)) //. - by rewrite subsetI sQE centsC (sameP commG1P eqP). -have EqEQ: Q \in 'E_q^1(E) by apply/pnElemP. -have regMsQ: 'C_(M`_\sigma)(Q) = 1. - apply: contraTeq FmaxM => nregMsQ; apply/FtypeP=> [[_]]; move/(_ q). - by rewrite unlock 3!inE /= t1Mq; case/exists_inP; exists Q. -have [[]] := tau1_act_tau2 maxM hallE t2Mp Ep2A t1Mq EqEQ regMsQ ntA0. -rewrite -/A0 -/A1 => EpA0 cMsA0 _ notA1GA0 [EpA1 _]. -have [sA0A abelA0 oA0] := pnElemPcard EpA0; have [pA0 _] := andP abelA0. -have [sA1A abelA1 oA1] := pnElemPcard EpA1; have [pA1 _] := andP abelA1. -have sA0N: A0 \subset 'N[x]. - rewrite -cMsA0 (subset_trans _ sCxN) //= -cent_cycle (centsS Ms_x) //. - exact: subsetIr. -have [P sylP sA0P] := Sylow_superset sA0N pA0; have [_ pP _] := and3P sylP. -have cycP: cyclic P. - by rewrite (odd_pgroup_rank1_cyclic pP) ?mFT_odd ?(p_rank_Sylow sylP). -have sA1gN: A1 :^ g^-1 \subset 'N[x] by rewrite sub_conjgV subIset ?sCQNg ?orbT. -have [|z _ sA1gzP] := Sylow_Jsub sylP sA1gN; first by rewrite pgroupJ. -case/imsetP: notA1GA0; exists (g^-1 * z); rewrite ?inE // conjsgM. -by apply/eqP; rewrite (eq_subG_cyclic cycP) // !cardJg oA0 oA1. -Qed. - -End Section14. - - diff --git a/mathcomp/odd_order/BGsection15.v b/mathcomp/odd_order/BGsection15.v deleted file mode 100644 index 704e98d..0000000 --- a/mathcomp/odd_order/BGsection15.v +++ /dev/null @@ -1,1511 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq choice div fintype. -From mathcomp -Require Import path bigop finset prime fingroup morphism perm automorphism. -From mathcomp -Require Import quotient action gproduct gfunctor pgroup cyclic commutator. -From mathcomp -Require Import center gseries nilpotent sylow abelian maximal hall frobenius. -From mathcomp -Require Import BGsection1 BGsection2 BGsection3 BGsection4 BGsection5. -From mathcomp -Require Import BGsection6 BGsection7 BGsection9 BGsection10 BGsection12. -From mathcomp -Require Import BGsection13 BGsection14. - -(******************************************************************************) -(* This file covers B & G, section 15; it fills in the picture of maximal *) -(* subgroups that was sketched out in section14, providing an intrinsic *) -(* characterization of M`_\sigma and establishing the TI property for the *) -(* "kernels" of maximal groups. We introduce only one new definition: *) -(* M`_\F == the (direct) product of all the normal Sylow subgroups of M; *) -(* equivalently, the largest normal nilpotent Hall subgroup of M *) -(* We will refer to M`_\F as the Fitting core or F-core of M. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope. - -Section Definitions. - -Variables (gT : finGroupType) (M : {set gT}). - -Definition Fitting_core := - <<\bigcup_(P : {group gT} | Sylow M P && (P <| M)) P>>. -Canonical Structure Fitting_core_group := [group of Fitting_core]. - -End Definitions. - -Notation "M `_ \F" := (Fitting_core M) - (at level 3, format "M `_ \F") : group_scope. -Notation "M `_ \F" := (Fitting_core_group M) : Group_scope. - -Section FittingCore. - -Variable (gT : finGroupType) (M : {group gT}). -Implicit Types H P : {group gT}. -Implicit Type p : nat. - -Lemma Fcore_normal : M`_\F <| M. -Proof. -rewrite -[M`_\F]bigprodGE. -elim/big_ind: _ => [|P Q nsP nsG|P /andP[] //]; first exact: normal1. -by rewrite /normal normsY ?normal_norm // join_subG ?normal_sub. -Qed. -Hint Resolve Fcore_normal. - -Lemma Fcore_sub : M`_\F \subset M. -Proof. by case/andP: Fcore_normal. Qed. - -Lemma Fcore_sub_Fitting : M`_\F \subset 'F(M). -Proof. -rewrite gen_subG; apply/bigcupsP=> P /andP[/SylowP[p _ /and3P[_ pP _]] nsP]. -by rewrite Fitting_max // (pgroup_nil pP). -Qed. - -Lemma Fcore_nil : nilpotent M`_\F. -Proof. exact: nilpotentS Fcore_sub_Fitting (Fitting_nil M). Qed. - -Lemma Fcore_max pi H : - pi.-Hall(M) H -> H <| M -> nilpotent H -> H \subset M`_\F. -Proof. -move=> hallH nsHM nilH; have [sHM pi_H _] := and3P hallH. -rewrite -(nilpotent_Fitting nilH) FittingEgen genS //. -apply/bigcupsP=> [[p /= _] piHp]; rewrite (bigcup_max 'O_p(H)%G) //. -have sylHp := nilpotent_pcore_Hall p nilH. -have sylHp_M := subHall_Sylow hallH (pnatPpi pi_H piHp) sylHp. -by rewrite (p_Sylow sylHp_M) gFnormal_trans. -Qed. - -Lemma Fcore_dprod : \big[dprod/1]_(P | Sylow M (gval P) && (P <| M)) P = M`_\F. -Proof. -rewrite -[M`_\F]bigprodGE. -apply/eqP/bigdprodYP=> P /andP[/SylowP[p p_pr sylP] nsPM]. -have defP := normal_Hall_pcore sylP nsPM. -have /dprodP[_ _ cFpFp' tiFpFp'] := nilpotent_pcoreC p (Fitting_nil M). -have /dprodYP := dprodEY cFpFp' tiFpFp'; rewrite /= p_core_Fitting defP. -apply: subset_trans; rewrite bigprodGE gen_subG. -apply/bigcupsP=> Q => /andP[/andP[/SylowP[q _ sylQ] nsQM] neqQP]. -have defQ := normal_Hall_pcore sylQ nsQM; rewrite -defQ -p_core_Fitting. -apply: sub_pcore => q' /eqnP->; apply: contraNneq neqQP => eq_qp. -by rewrite -val_eqE /= -defP -defQ eq_qp. -Qed. - -Lemma Fcore_pcore_Sylow p : p \in \pi(M`_\F) -> p.-Sylow(M) 'O_p(M). -Proof. -rewrite /= -(bigdprod_card Fcore_dprod) mem_primes => /and3P[p_pr _]. -have not_p_dv_1: ~ p %| 1 by rewrite gtnNdvd ?prime_gt1. -elim/big_ind: _ => // [p1 p2 IH1 IH2|P /andP[/SylowP[q q_pr sylP] nsPM p_dv_P]]. - by rewrite Euclid_dvdM // => /orP[/IH1 | /IH2]. -have qP := pHall_pgroup sylP. -by rewrite (eqnP (pgroupP qP p p_pr p_dv_P)) (normal_Hall_pcore sylP). -Qed. - -Lemma p_core_Fcore p : p \in \pi(M`_\F) -> 'O_p(M`_\F) = 'O_p(M). -Proof. -move=> piMFp /=; rewrite -(pcore_setI_normal p Fcore_normal). -apply/setIidPl; rewrite sub_gen // (bigcup_max 'O_p(M)%G) //= pcore_normal. -by rewrite (p_Sylow (Fcore_pcore_Sylow piMFp)). -Qed. - -Lemma Fcore_Hall : \pi(M`_\F).-Hall(M) M`_\F. -Proof. -rewrite Hall_pi // /Hall Fcore_sub coprime_pi' ?cardG_gt0 //=. -apply/pnatP=> // p p_pr; apply: contraL => /= piMFp; rewrite -p'natE //. -rewrite -partn_eq1 // -(eqn_pmul2l (part_gt0 p #|M`_\F|)) muln1. -rewrite -partnM ?cardG_gt0 // Lagrange ?Fcore_sub //. -rewrite -(card_Hall (nilpotent_pcore_Hall p Fcore_nil)) /=. -by rewrite p_core_Fcore // (card_Hall (Fcore_pcore_Sylow piMFp)). -Qed. - -Lemma pcore_Fcore pi : {subset pi <= \pi(M`_\F)} -> 'O_pi(M`_\F) = 'O_pi(M). -Proof. -move=> s_pi_MF; rewrite -(pcore_setI_normal pi Fcore_normal). -apply/setIidPl; rewrite (sub_normal_Hall Fcore_Hall) ?pcore_sub //. -exact: sub_pgroup s_pi_MF (pcore_pgroup pi M). -Qed. - -Lemma Fcore_pcore_Hall pi : {subset pi <= \pi(M`_\F)} -> pi.-Hall(M) 'O_pi(M). -Proof. -move=> s_pi_MF; apply: (subHall_Hall Fcore_Hall s_pi_MF). -by rewrite /= -pcore_Fcore // (nilpotent_pcore_Hall pi Fcore_nil). -Qed. - -End FittingCore. - -Lemma morphim_Fcore : GFunctor.pcontinuous Fitting_core. -Proof. -move=> gT rT G D f; have nsGF_G := Fcore_normal G. -suffices hall_fGF: \pi(G`_\F).-Hall(f @* (D :&: G)) (f @* (D :&: G`_\F)). - rewrite !morphimIdom in hall_fGF. - by rewrite (Fcore_max hall_fGF) ?morphim_normal // morphim_nil ?Fcore_nil. -rewrite morphim_pHall ?subsetIl //= -{2}(setIidPr (Fcore_sub G)) setIA. -by rewrite !(setIC (D :&: G)) (setI_normal_Hall nsGF_G) ?subsetIr ?Fcore_Hall. -Qed. - -Canonical Structure Fcore_igFun := [igFun by Fcore_sub & morphim_Fcore]. -Canonical Structure Fcore_gFun := [gFun by morphim_Fcore]. -Canonical Structure Fcore_pgFun := [pgFun by morphim_Fcore]. - -Section MoreFittingCore. - -Variables (gT rT : finGroupType) (D : {group gT}) (f : {morphism D >-> rT}). -Implicit Types (M H : {group gT}) (R : {group rT}). - -Lemma Fcore_char M : M`_\F \char M. Proof. exact: gFchar. Qed. - -Lemma FcoreJ M x : (M :^ x)`_\F = M`_\F :^ x. -Proof. -rewrite -{1}(setTI M) -morphim_conj. -by rewrite -injmF ?injm_conj ?subsetT // morphim_conj setTI. -Qed. - -Lemma injm_Fcore M : 'injm f -> M \subset D -> f @* M`_\F = (f @* M)`_\F. -Proof. by move=> injf sMD; rewrite injmF. Qed. - -Lemma isom_Fcore M R : isom M R f -> M \subset D -> isom M`_\F R`_\F f. -Proof. by move=> isoMR sMD; apply: gFisom. Qed. - -Lemma isog_Fcore M R : M \isog R -> M`_\F \isog R`_\F. -Proof. by move=> isoMR; apply: gFisog. Qed. - -End MoreFittingCore. - -Section Section15. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). -Implicit Types p q q_star r : nat. -Implicit Types x y z : gT. -Implicit Types A E H K L M Mstar N P Q Qstar R S T U V W X Y Z : {group gT}. - -Lemma Fcore_sub_Msigma M : M \in 'M -> M`_\F \subset M`_\sigma. -Proof. -move=> maxM; rewrite gen_subG. -apply/bigcupsP=> P /andP[/SylowP[p _ sylP] nsPM]; have [sPM pP _] := and3P sylP. -have [-> | ntP] := eqsVneq P 1; first exact: sub1G. -rewrite (sub_Hall_pcore (Msigma_Hall maxM)) // (pi_pgroup pP) //. -by apply/exists_inP; exists P; rewrite ?(mmax_normal maxM). -Qed. - -Lemma Fcore_eq_Msigma M : - M \in 'M -> reflect (M`_\F = M`_\sigma) (nilpotent M`_\sigma). -Proof. -move=> maxM; apply: (iffP idP) => [nilMs | <-]; last exact: Fcore_nil. -apply/eqP; rewrite eqEsubset Fcore_sub_Msigma //. -by rewrite (Fcore_max (Msigma_Hall maxM)) ?pcore_normal. -Qed. - -(* This is B & G, Lemma 15.1. *) -(* We have made all semidirect products explicits, and omitted the assertion *) -(* M`_\sigma \subset M^`(1), which is exactly covered by Msigma_der1. *) -(* Some refactoring is definitely needed here, to avoid the mindless cut *) -(* and paste of a large fragment of the proof of Lemma 12.12. *) -Lemma kappa_structure M U K (Ms := M`_\sigma) : - M \in 'M -> kappa_complement M U K -> - [/\ (*a*) [/\ (Ms ><| U) ><| K = M, cyclic K & abelian (M^`(1) / Ms)], - (*b*) K :!=: 1 -> Ms ><| U = M^`(1) /\ abelian U, - (*c*) forall X, X \subset U -> X :!=: 1 -> 'C_Ms(X) != 1 -> - [/\ 'M('C(X)) = [set M], cyclic X & \tau2(M).-group X], - (*d*) abelian <<\bigcup_(x in Ms^#) 'C_U[x]>> - & (*e*) U :!=: 1 -> exists U0, - [/\ gval U0 \subset U, exponent (gval U0) = exponent U - & [Frobenius Ms <*> U0 = Ms ><| U0]]]. -Proof. -move=> maxM complU; have [hallU hallK _] := complU. -have [hallE defM _ regUK cUU] := kappa_compl_context maxM complU. -have [[_ E _ defE]] := sdprodP defM. -have [nsUE sKE mulUK nUK tiUK] := sdprod_context defE. -rewrite defE -{1 2}mulUK mulgA => defMl /mulGsubP[nMsU nMsK] tiMsE. -have [/andP[sMsM nMsM] [sUE nUE]] := (pcore_normal _ M : Ms <| M, andP nsUE). -rewrite norm_joinEr // mulUK in hallE. -have [[sEM s'M_E _] [sUM sk'U _]] := (and3P hallE, and3P hallU). -have defMsU: Ms ><| U = Ms <*> U. - by apply: sdprodEY nMsU (trivgP _); rewrite -tiMsE -mulUK setIS ?mulG_subl. -have{defM} defM: Ms <*> U ><| K = M. - rewrite sdprodE ?normsY ?coprime_TIg //=; first by rewrite norm_joinEr. - rewrite -(sdprod_card defMsU) coprime_mull andbC regular_norm_coprime //=. - by rewrite (coprimegS sKE) ?(pnat_coprime (pcore_pgroup _ _)). -rewrite defMsU quotient_der //= -/Ms -{2}defMl -mulgA mulUK. -rewrite quotientMidl -quotient_der ?(subset_trans sEM) //. -rewrite quotient_abelian ?(der_mmax_compl_abelian maxM hallE) //. -set part_c := forall U, _; have c_holds: part_c. - move=> X sXU ntX nregMsX; have sXE := subset_trans sXU sUE. - have [x /setIP[Ms_x cXx] ntx] := trivgPn _ nregMsX. - have Ms1x: x \in Ms^# by apply/setD1P. - have piCx_hyp: {in X^#, forall x', x' \in ('C_M[x])^# /\ \sigma(M)^'.-elt x'}. - move=> x' /setD1P[ntx' Xx']; have Ex' := subsetP sXE x' Xx'. - rewrite 3!inE ntx' (subsetP sEM) ?(mem_p_elt s'M_E) //=. - by rewrite (subsetP _ _ Xx') ?sub_cent1. - have piCx x' X1x' := (* GG -- ssreflect evar generalization fails in trunk *) - let: conj c e := piCx_hyp x' X1x' in pi_of_cent_sigma maxM Ms1x c e. - have t2X: \tau2(M).-group X. - apply/pgroupP=> p p_pr /Cauchy[] // x' Xx' ox'. - have X1x': x' \in X^# by rewrite !inE Xx' -order_gt1 ox' prime_gt1. - have [[]|[]] := piCx _ X1x'; last by rewrite /p_elt ox' pnatE. - case/idPn; have:= mem_p_elt (pgroupS sXU sk'U) Xx'. - by rewrite /p_elt ox' !pnatE // => /norP[]. - suffices cycX: cyclic X. - split=> //; have [x' defX] := cyclicP cycX. - have X1x': x' \in X^# by rewrite !inE -cycle_eq1 -cycle_subG -defX ntX /=. - have [[kX _]|[_ _]] := piCx _ X1x'; last by rewrite defX cent_cycle. - rewrite -(setIid X) coprime_TIg ?eqxx // {2}defX in ntX. - rewrite (pnat_coprime t2X (sub_pgroup _ kX)) // => p kp. - by rewrite inE /= negb_and rank_kappa ?orbT. - have [E2 hallE2 sXE2] := Hall_superset (sigma_compl_sol hallE) sXE t2X. - rewrite abelian_rank1_cyclic; last first. - exact: abelianS sXE2 (tau2_compl_abelian maxM hallE hallE2). - have [p _ ->] := rank_witness X; rewrite leqNgt; apply: contra nregMsX => rpX. - have t2p: p \in \tau2(M) by rewrite (pnatPpi t2X) // -p_rank_gt0 ltnW. - rewrite -(setIidPr (subset_trans sXE sEM)) in rpX. - case/p_rank_geP: rpX => A; rewrite pnElemI -setIdE; case/setIdP=> Ep2A sAX. - rewrite -subG1; have [_ _ <- _ _] := tau2_context maxM t2p Ep2A. - by rewrite setIS ?centS. -have hallU_E: Hall E U := pHall_Hall (pHall_subl sUE sEM hallU). -have UtypeF := FTtypeF_complement maxM hallE hallU_E nsUE. -set k'U13 := ({in _, _}) in UtypeF. -have/UtypeF{UtypeF k'U13}UtypeF: k'U13. - move=> x /setD1P[]; rewrite -order_gt1 -pi_pdiv. - set p := pdiv _ => pi_x_p Ux t13x. - apply: contraNeq (pnatPpi (mem_p_elt sk'U Ux) pi_x_p) => nreg_x. - apply/orP; right; rewrite unlock /= inE /= (pnatPpi t13x) //=. - have sxM: <[x]> \subset M by rewrite cycle_subG (subsetP sUM). - move: pi_x_p; rewrite -p_rank_gt0 /= -(setIidPr sxM) => /p_rank_geP[P]. - rewrite pnElemI -setIdE => /setIdP[EpP sPx]; apply/exists_inP; exists P => //. - by rewrite (subG1_contra _ nreg_x) //= -cent_cycle setIS ?centS. -have [K1 | ntK] := altP (K :=P: 1). - rewrite {2}K1 cyclic1; rewrite K1 mulg1 in mulUK; rewrite -mulUK in hallE. - have ltM'M := sol_der1_proper (mmax_sol maxM) (subxx _) (mmax_neq1 maxM). - suffices /UtypeF[[A0 [_ abA0 genA0]] frobM]: U :!=: 1. - by split => //; apply: abelianS abA0; rewrite gen_subG; apply/bigcupsP. - apply: contraNneq (proper_subn ltM'M); rewrite -{1}defMl => ->. - by rewrite K1 !mulg1 Msigma_der1. -have PmaxM: M \in 'M_'P by rewrite inE maxM -(trivg_kappa maxM hallK) andbT. -have [_ _ [_ _ _ [cycZ _ _ _ _] [_ _ _ defM']]] := Ptype_embedding PmaxM hallK. -have{cycZ cUU} [cycK cUU] := (cyclicS (joing_subl _ _) cycZ, cUU ntK). -split=> // [_||/UtypeF[] //]; first split=> //. - apply/eqP; rewrite eq_sym eqEcard -(leq_pmul2r (cardG_gt0 K)). - have [nsMsU_M _ mulMsU _ _] := sdprod_context defM. - rewrite (sdprod_card defM) (sdprod_card defM') der1_min ?normal_norm //=. - by rewrite -(isog_abelian (sdprod_isog defM)) cyclic_abelian. -by apply: abelianS cUU; rewrite gen_subG -big_distrr subsetIl. -Qed. - -(* This is B & G, Theorem 15.2. *) -(* It is this theorem that implies that the non-functorial definition of *) -(* M`_\sigma used in B & G is equivalent to the original definition in FT *) -(* (also used in Peterfalvi). *) -(* Proof notes: this proof contained two non-structural arguments: taking D *) -(* to be K-invariant, and reusing the nilpotent Frobenius kernel argument for *) -(* Q1 (bottom of p. 118). We handled the first with a "without loss", but for *) -(* the second we had to spell out explicitly the assumptions and conclusions *) -(* of the nilpotent kernel argument that were spread throughout the last *) -(* paragraph p. 118. *) -(* We also had to make a few additions to the argument at the top of p. 119; *) -(* while the statement of the Theorem states that F(M) = C_M(Qbar), the text *) -(* only shows that F(M) = C_Msigma(Qbar), and we need to show that K acts *) -(* regularly on Qbar to complete the proof; this follows from the values of *) -(* orders of K, Kstar and Qbar. In addition we need to show much earlier *) -(* that K acts faithfully on Q, to show that C_M(Q) is included in Ms, and *) -(* this requires a use of 14.2(e) not mentioned in the text; in addition, the *) -(* reference to coprime action (Proposition 1.5) on p. 119 l. 1 is somewhat *) -(* misleading, since we actually need to use the coprime stabilizer Lemma 1.9 *) -(* to show that C_D(Qbar) = C_D(Q) = 1 (unless we splice in the proof of that *) -(* lemma). *) -Theorem Fcore_structure M (Ms := M`_\sigma) : - M \in 'M -> - [/\ M`_\F != 1, M`_\F \subset Ms, Ms \subset M^`(1) & M^`(1) \proper M] - /\ (forall K D : {group gT}, - \kappa(M).-Hall(M) K -> M`_\F != M`_\sigma -> - let p := #|K| in let Ks := 'C_Ms(K) in - let q := #|Ks| in let Q := 'O_q(M) in - let Q0 := 'C_Q(D) in let Qbar := Q / Q0 in - q^'.-Hall(M`_\sigma) D -> - [/\ (*a*) [/\ M \in 'M_'P1, Ms ><| K = M & Ms = M ^`(1)], - (*b*) [/\ prime p, prime q, q \in \pi(M`_\F) & q \in \beta(M)], - [/\ (*c*) q.-Sylow(M) Q, - (*d*) nilpotent D - & (*e*) Q0 <| M], - (*f*) [/\ minnormal Qbar (M / Q0), q.-abelem Qbar & #|Qbar| = (q ^ p)%N] - & (*g*) [/\ Ms^`(1) = M^`(2), - M^`(2) \subset 'F(M), - [/\ Q <*> 'C_M(Q) = 'F(M), - 'C_M(Qbar | 'Q) = 'F(M) - & 'C_Ms (Ks / Q0 | 'Q) = 'F(M)] - & 'F(M) \proper Ms]]). -Proof. -move=> maxM; set M' := M^`(1); set M'' := M^`(2). -have nsMsM: Ms <| M := pcore_normal _ M; have [sMsM nMsM] := andP nsMsM. -have solM := mmax_sol maxM; have solMs: solvable Ms := solvableS sMsM solM. -have sMF_Ms: M`_\F \subset Ms := Fcore_sub_Msigma maxM. -have ltM'M: M' \proper M by rewrite (sol_der1_proper solM) ?mmax_neq1. -have sMsM': Ms \subset M' := Msigma_der1 maxM. -have [-> | ltMF_Ms] := eqVproper sMF_Ms; first by rewrite eqxx Msigma_neq1. -set KDpart := (X in _ /\ X); suffices KD_holds: KDpart. - do 2!split=> //; have [K hallK] := Hall_exists \kappa(M) solM. - pose q := #|'C_(M`_\sigma)(K)|; have [D hallD] := Hall_exists q^' solMs. - have [_ [_ _ piMFq _] _ _ _] := KD_holds K D hallK (proper_neq ltMF_Ms) hallD. - by rewrite -rank_gt0 (leq_trans _ (p_rank_le_rank q _)) ?p_rank_gt0. -move=> {KDpart} K D hallK neMF_Ms p Ks q Q /= hallD. -have not_nilMs: ~~ nilpotent Ms by rewrite (sameP (Fcore_eq_Msigma maxM) eqP). -have P1maxM: M \in 'M_'P1; last have [PmaxM _] := setIdP P1maxM. - apply: contraR not_nilMs => notP1maxM; apply: notP1type_Msigma_nil. - by rewrite orbC inE notP1maxM inE maxM andbT orNb. -have ntK: K :!=: 1 by rewrite inE maxM andbT -(trivg_kappa maxM hallK) in PmaxM. -have [defMs defM]: Ms = M' /\ Ms ><| K = M. - have [U complU] := ex_kappa_compl maxM hallK. - have U1: U :=: 1 by apply/eqP; rewrite (trivg_kappa_compl maxM complU). - have [[defM _ _] [//| defM' _] _ _ _] := kappa_structure maxM complU. - by rewrite U1 sdprodg1 in defM defM'. -have [_ mulMsK nMsK _] := sdprodP defM; rewrite /= -/Ms in mulMsK nMsK. -have [sKM kK _] := and3P hallK; have s'K := sub_pgroup (@kappa_sigma' _ _) kK. -have coMsK: coprime #|Ms| #|K| := pnat_coprime (pcore_pgroup _ _) s'K. -have q_pr: prime q. - have [L _ [_ _ _ _ [_]]] := Ptype_embedding PmaxM hallK. - by rewrite inE P1maxM => [[] []]. -have hallMs: \sigma(M).-Hall(M) Ms := Msigma_Hall maxM. -have sMq: q \in \sigma(M). - by rewrite -pnatE // -pgroupE (pgroupS (subsetIl _ _) (pcore_pgroup _ _)). -have{s'K kK} q'K: q^'.-group K := pi'_p'group s'K sMq. -have nsQM: Q <| M := pcore_normal q M; have [sQM nQM] := andP nsQM. -have qQ: q.-group Q := pcore_pgroup _ _. -have sQMs: Q \subset Ms by rewrite (sub_Hall_pcore hallMs) ?(pi_pgroup qQ). -have [K1 prK1 sK1K]: exists2 K1, prime #|gval K1| & K1 \subset K. - have:= ntK; rewrite -rank_gt0; have [r r_pr ->] := rank_witness K. - by case/p_rank_geP=> K1 /pnElemPcard[? _ oK1]; exists K1; rewrite ?oK1. -have coMsK1 := coprimegS sK1K coMsK; have coQK1 := coprimeSg sQMs coMsK1. -have prMsK: semiprime Ms K by have [[? _ []] ] := Ptype_structure PmaxM hallK. -have defCMsK1: 'C_Ms(K1) = Ks. - by rewrite (cent_semiprime prMsK) // -cardG_gt1 prime_gt1. -have sK1M := subset_trans sK1K sKM; have nQK1 := subset_trans sK1M nQM. -have{sMsM'} sKsQ: Ks \subset Q. - have defMsK: [~: Ms, K] = Ms by case/coprime_der1_sdprod: defM. - have hallQ := nilpotent_pcore_Hall q (Fitting_nil M). - rewrite -[Q]p_core_Fitting (sub_Hall_pcore hallQ) //; first exact: pnat_id. - apply: prime_meetG => //; apply: contraNneq not_nilMs => tiKsFM. - suffices <-: 'F(Ms) = Ms by apply: Fitting_nil. - apply/eqP; rewrite eqEsubset Fitting_sub /= -{1}defMsK. - rewrite (odd_sdprod_primact_commg_sub_Fitting defM) ?mFT_odd //. - apply/trivgP; rewrite -tiKsFM setIAC setSI //= -/Ms subsetI Fitting_sub /=. - by rewrite Fitting_max ?Fitting_nil // gFnormal_trans. -have nilMs_Q: nilpotent (Ms / Q). - have [nMsK1 tiQK1] := (subset_trans sK1K nMsK, coprime_TIg coQK1). - have prK1b: prime #|K1 / Q| by rewrite -(card_isog (quotient_isog _ _)). - have defMsK1: (Ms / Q) ><| (K1 / Q) = (Ms / Q) <*> (K1 / Q). - by rewrite sdprodEY ?quotient_norms // coprime_TIg ?coprime_morph. - apply: (prime_Frobenius_sol_kernel_nil defMsK1) => //. - by rewrite (solvableS _ (quotient_sol _ solM)) ?join_subG ?quotientS. - by rewrite -coprime_quotient_cent ?quotientS1 /= ?defCMsK1. -have defQ: 'O_q(Ms) = Q by rewrite -(setIidPl sQMs) pcore_setI_normal. -have sylQ: q.-Sylow(Ms) Q. - have nsQMs: Q <| Ms by rewrite -defQ pcore_normal. - rewrite -(pquotient_pHall qQ) // /= -/Q -{3}defQ. - by rewrite -(pquotient_pcore _ qQ) ?nilpotent_pcore_Hall. -have{sMq hallMs} sylQ_M := subHall_Sylow hallMs sMq sylQ. -have sQ_MF: Q \subset M`_\F. - by rewrite sub_gen ?(bigcup_max [group of Q]) ?(p_Sylow sylQ_M) ?pcore_normal. -have{sQ_MF} piMFq: q \in \pi(M`_\F). - by rewrite (piSg sQ_MF) // (piSg sKsQ) // pi_of_prime ?inE /=. -without loss nDK: D hallD / K \subset 'N(D). - have [E hallE nEK] := coprime_Hall_exists q^' nMsK coMsK solMs. - have [x Ms_x ->] := Hall_trans solMs hallD hallE. - set Q0 := 'C__(_)%G; rewrite -(isog_nil (conj_isog _ _)) -['C_Q(_)]/(gval Q0). - move/(_ E hallE nEK)=> IH; suffices ->: Q0 = [group of 'C_Q(E)] by []. - apply: group_inj => /=; have Mx: x \in M := subsetP (pcore_sub _ _) x Ms_x. - rewrite /= -/Q -{1}(normsP nQM x Mx) centJ -conjIg (normsP _ x Mx) //. - by case: IH => _ _ [_ _]; case/andP. -set Q0 := 'C_Q(D); set Qb := Q / Q0. -have defQD: Q ><| D = Ms by rewrite -defQ in sylQ *; apply/sdprod_Hall_pcoreP. -have [_ mulQD nQD tiQD] := sdprodP defQD; rewrite /= -/Q -/Ms in mulQD nQD tiQD. -have nilD: nilpotent D. - by rewrite (isog_nil (quotient_isog nQD tiQD)) /= -quotientMidl mulQD. -have [sDMs q'D _] := and3P hallD; have sDM := subset_trans sDMs sMsM. -have sDKM: D <*> K \subset M by rewrite join_subG sDM. -have q'DK: q^'.-group (D <*> K) by rewrite norm_joinEr // pgroupM q'D. -have{K1 sK1M sK1K coMsK1 coQK1 prK1 defCMsK1 nQK1 solMs} Qi_rec Qi: - Qi \in |/|_Q(D <*> K; q) -> Q0 \subset Qi -> Qi \proper Q -> - exists L, [/\ L \in |/|_Q(D <*> K; q), Qi <| L, minnormal (L / Qi) (M / Qi) - & ~~ ((Ks \subset L) ==> (Ks \subset Qi))]. -- case/setIdP=> /andP[sQiQ qQi] nQiDK sQ0i ltQiQ. - have ltQiN := nilpotent_proper_norm (pgroup_nil qQ) ltQiQ. - have [Lb minLb sLbQ]: {Lb | minnormal (gval Lb) (M / Qi) & Lb \subset Q / Qi}. - apply: mingroup_exists; rewrite quotient_norms //= andbT -quotientInorm. - by rewrite -subG1 quotient_sub1 ?subsetIr // proper_subn. - have [ntLb nLbM] := andP (mingroupp minLb). - have nsQiN: Qi <| 'N_M(Qi) by rewrite normal_subnorm (subset_trans sQiQ). - have: Lb <| 'N_M(Qi) / Qi. - by rewrite quotientInorm /normal (subset_trans sLbQ) ?quotientS. - case/(inv_quotientN nsQiN) => L defLb sQij /=; case/andP. - case/subsetIP=> sLM nQij nLN; exists L. - have{sLbQ} sLQ: L \subset Q by rewrite -(quotientSGK nQij sQiQ) -defLb. - rewrite inE /psubgroup /normal sLQ sQij nQij (pgroupS sLQ qQ) -defLb. - have nLDK: D <*> K \subset 'N(L) by apply: subset_trans nLN; apply/subsetIP. - have sLD_Ms: L <*> D \subset Ms by rewrite join_subG (subset_trans sLQ). - have coLD_K1: coprime #|L <*> D| #|K1| := coprimeSg sLD_Ms coMsK1. - have [[nQiD nQiK] [nLD nLK]] := (joing_subP nQiDK, joing_subP nLDK). - have [nQiK1 nLK1] := (subset_trans sK1K nQiK, subset_trans sK1K nLK). - split=> //; apply: contra ntLb => regLK. - have [sLLD sDLD] := joing_subP (subxx (L <*> D)). - suffices nilLDbar: nilpotent (L <*> D / Qi). - rewrite defLb -subG1 -(quotientS1 sQ0i) /= -/Q. - rewrite coprime_quotient_cent ?(pgroup_sol qQ) ?(pnat_coprime qQ) //=. - rewrite subsetI quotientS //= (sub_nilpotent_cent2 nilLDbar) ?quotientS //. - by rewrite coprime_morph ?(p'nat_coprime q'D (pgroupS sLQ qQ)). - have defLK1b: (L <*> D / Qi) ><| (K1 / Qi) = (L <*> D / Qi) <*> (K1 / Qi). - rewrite sdprodEY ?coprime_TIg ?quotient_norms //=. - by rewrite (subset_trans sK1K) // normsY. - by rewrite coprime_morph // (coprimeSg sLD_Ms). - have [sQiLD sLD_M] := (subset_trans sQij sLLD, subset_trans sLD_Ms sMsM). - have{regLK}: 'C_(L <*> D / Qi)(K1 / Qi) = 1. - rewrite -coprime_quotient_cent ?(subset_trans sK1K) ?(solvableS sLD_M) //=. - rewrite -(setIidPr sLD_Ms) setIAC defCMsK1 quotientS1 //= -/Ks joingC. - rewrite norm_joinEl // -(setIidPl sKsQ) -setIA -group_modr // tiQD mul1g. - have [-> | ntLKs] := eqVneq (Ks :&: L) 1; first exact: sub1G. - by rewrite subIset ?(implyP regLK) // prime_meetG. - apply: (prime_Frobenius_sol_kernel_nil defLK1b). - by apply: solvableS (quotient_sol _ solM); rewrite join_subG !quotientS. - by rewrite -(card_isog (quotient_isog _ _)) ?coprime_TIg // (coprimeSg sQiQ). -have ltQ0Q: Q0 \proper Q. - rewrite properEneq subsetIl andbT; apply: contraNneq not_nilMs => defQ0. - rewrite -dprodEsd // in defQD; last by rewrite centsC -defQ0 subsetIr. - by rewrite (dprod_nil defQD) (pgroup_nil qQ). -have [nQK coQK] := (subset_trans sKM nQM, pnat_coprime qQ q'K). -have solQ := pgroup_sol qQ. (* must come late: Coq diverges on solQ <> solMs *) -have [coDK coQD] := (coprimeSg sDMs coMsK, pnat_coprime qQ q'D). -have nQ0K: K \subset 'N(Q0) by rewrite normsI ?norms_cent. -have nQ0D: D \subset 'N(Q0) by rewrite cents_norm // centsC subsetIr. -have nQ0DK: D <*> K \subset 'N(Q0) by apply/joing_subP. -have [|Q1 [DKinvQ1 nsQ01 minQ1b nregQ1b]] := Qi_rec _ _ (subxx _) ltQ0Q. - by rewrite inE /psubgroup (pgroupS _ qQ) ?subsetIl. -have{Qi_rec nregQ1b DKinvQ1} [tiQ0Ks defQ1]: Q0 :&: Ks = 1 /\ Q1 :=: Q. - move: nregQ1b; rewrite negb_imply; case/andP=> sKsQ1 not_sKsQ0. - split=> //; first by rewrite setIC prime_TIg. - have [] := setIdP DKinvQ1; case/andP; case/eqVproper=> // ltQ1Q _ _. - have [Q2 [_ _ _]] := Qi_rec Q1 DKinvQ1 (normal_sub nsQ01) ltQ1Q. - by rewrite sKsQ1 implybT. -have [nsQ0Q minQb]: Q0 <| Q /\ minnormal Qb (M / Q0) by rewrite /Qb -defQ1. -have{Q1 defQ1 minQ1b nsQ01} abelQb: q.-abelem Qb. - have qQb: q.-group Qb := quotient_pgroup _ qQ; have solQb := pgroup_sol qQb. - by rewrite -is_abelem_pgroup // (minnormal_solvable_abelem minQb). -have [cQbQb [sQ0Q nQ0Q]] := (abelem_abelian abelQb, andP nsQ0Q). -have nQ0M: M \subset 'N(Q0) by rewrite -mulMsK -mulQD -mulgA !mul_subG. -have nsQ0M: Q0 <| M by rewrite /normal subIset ?sQM. -have sFM_QCQ: 'F(M) \subset Q <*> 'C_M(Q). - have [_ /= mulQQ' cQQ' _] := dprodP (nilpotent_pcoreC q (Fitting_nil M)). - rewrite -{3}mulQQ' p_core_Fitting cent_joinEr ?subsetIr //= -/Q in cQQ' *. - by rewrite mulgS // subsetI gFsub_trans ?gFsub. -have sQCQ_CMsQb: Q <*> 'C_M(Q) \subset 'C_Ms(Qb | 'Q). - rewrite join_subG !(subsetI _ Ms) sQMs /= !sub_astabQ nQ0Q /= -/Q0 -/Qb. - rewrite -abelianE cQbQb quotient_cents ?subsetIr //= andbC subIset ?nQ0M //=. - rewrite -(coprime_mulG_setI_norm mulMsK) ?norms_cent //= -/Ms. - suffices ->: 'C_K(Q) = 1 by rewrite mulg1 subsetIl. - have: ~~ (Q \subset Ks); last apply: contraNeq => ntCKQ. - have [_ _ _ [_]] := Ptype_structure PmaxM hallK. - by move/(_ q); rewrite pi_of_prime //; case/(_ (eqxx q) _ sylQ_M). - rewrite -[Ks](cent_semiprime prMsK _ ntCKQ) ?subsetIl //. - by rewrite subsetI sQMs centsC subsetIr. -have nCQb: M \subset 'N('C(Qb | 'Q)). - by rewrite (subset_trans _ (astab_norm _ _)) ?actsQ. -have defFM: 'C_Ms(Qb | 'Q) = 'F(M). - apply/eqP; rewrite eqEsubset andbC (subset_trans sFM_QCQ) //=. - rewrite Fitting_max //=; first by rewrite /normal subIset ?sMsM //= normsI. - rewrite -(coprime_mulG_setI_norm mulQD) ?(subset_trans sMsM) //= -/Q. - rewrite mulg_nil ?(nilpotentS (subsetIl _ _)) ?(pgroup_nil qQ) //= -/Q. - rewrite (centsS (subsetIl _ _)) //= -/Q. - have cDQ0: 'C_D(Qb | 'Q) \subset 'C(Q0) by rewrite subIset // centsC subsetIr. - rewrite (stable_factor_cent cDQ0) ?(coprimegS (subsetIl _ _) coQD) //. - by rewrite /stable_factor commGC -sub_astabQR ?subsetIr // subIset ?nQ0D. -have{sFM_QCQ sQCQ_CMsQb} ->: Q <*> 'C_M(Q) = 'F(M). - by apply/eqP; rewrite eqEsubset sFM_QCQ andbT -defFM. -have ltFM_Ms: 'F(M) \proper Ms. - rewrite properEneq -{2}defFM subsetIl andbT. - by apply: contraNneq not_nilMs => <-; apply: Fitting_nil. -have sQFM: Q \subset 'F(M) by rewrite -[Q]p_core_Fitting pcore_sub. -have not_cDQb: ~~ (D / Q0 \subset 'C(Qb)). - apply: contra (proper_subn ltFM_Ms) => cDQb; rewrite -mulQD mulG_subG sQFM /=. - by rewrite -defFM subsetI sDMs sub_astabQ nQ0D. -have [_ minQbP] := mingroupP minQb. -have regQbDb: 'C_Qb(D / Q0) = 1. - apply: contraNeq not_cDQb => ntCQDb; rewrite centsC; apply/setIidPl. - apply: minQbP (subsetIl _ _); rewrite ntCQDb /= -/Qb -(setIidPl cQbQb) -setIA. - by rewrite -centM -quotientMl //= mulQD normsI ?norms_cent ?quotient_norms. -have tiQ0 R: q^'.-group R -> Q0 :&: R = 1. - by move/(pnat_coprime (pgroupS sQ0Q qQ))/coprime_TIg. -have oKb: #|K / Q0| = p by rewrite -(card_isog (quotient_isog _ (tiQ0 _ _))). -have oKsb: #|Ks / Q0| = q. - by rewrite -(card_isog (quotient_isog _ tiQ0Ks)) ?(subset_trans sKsQ). -have regDK: 'C_D(K) = 1. - by rewrite -(setIidPl sDMs) -setIA setIC coprime_TIg ?(coprimeSg sKsQ). -have{tiQ0} frobDKb: [Frobenius D <*> K / Q0 = (D / Q0) ><| (K / Q0)]. - have ntDb: D / Q0 != 1 by apply: contraNneq not_cDQb => ->; apply: sub1G. - have ntKb: K / Q0 != 1 by rewrite -(isog_eq1 (quotient_isog _ (tiQ0 _ _))). - apply/Frobenius_semiregularP => // [|xb]. - by apply: quotient_coprime_sdprod; rewrite ?sdprodEY ?coprime_TIg. - have [f [_ ker_f _ im_f]] := restrmP (coset_morphism Q0) nQ0DK. - have{ker_f} inj_f: 'injm f by rewrite ker_f ker_coset setIC tiQ0. - rewrite /= /quotient -!im_f ?joing_subl ?joing_subr //. - rewrite 2!inE andbC => /andP[/morphimP[x DKx Kx ->{xb}]]. - rewrite morph_injm_eq1 // -injm_subcent1 ?joing_subl // => ntx. - rewrite -{3}(setIidPl sDMs) -setIA prMsK ?inE ?ntx //. - by rewrite setICA regDK setIg1 morphim1. -have defKsb: 'C_Qb(K / Q0) = Ks / Q0. - rewrite /Ks -mulQD coprime_cent_mulG // regDK mulg1. - by rewrite coprime_quotient_cent ?subsetIl. -have{frobDKb regQbDb} [p_pr oQb cQbD']: - [/\ prime p, #|Qb| = (q ^ p)%N & (D / Q0)^`(1) \subset 'C(Qb)]. -- have ntQb: Qb != 1 by rewrite -subG1 quotient_sub1 ?proper_subn. - have prQbK: semiprime Qb (K / Q0). - move=> xb; rewrite 2!inE andbC; case/andP; case/morphimP=> x nQ0x Kx -> ntx. - have{ntx} ntx: x != 1 by apply: contraNneq ntx => ->; rewrite morph1. - transitivity ('C_Q[x] / Q0); last first. - rewrite -(coprime_quotient_cent (subsetIl Q _) nQ0K coQK solQ) /= -/Q0. - by rewrite -/Q -(setIidPl sQMs) -!setIA prMsK // !inE ntx. - rewrite -!cent_cycle -quotient_cycle //; rewrite -!cycle_subG in Kx nQ0x. - by rewrite coprime_quotient_cent ?(coprimegS Kx). - have:= Frobenius_primact frobDKb _ _ _ ntQb _ prQbK regQbDb. - have [nQDK solDK] := (subset_trans sDKM nQM, solvableS sDKM solM). - rewrite !quotient_sol ?quotient_norms // coprime_morph ?(pnat_coprime qQ) //=. - rewrite -/Qb oKb defKsb prime_cyclic oKsb // subsetI der_sub /=. - by case=> //= -> -> ->. -have{cQbD'} sM''FM: M'' \subset 'F(M). - have nQMs := subset_trans sMsM nQM. - rewrite [M'']dergSn -/M' -defMs -(quotientSGK _ sQFM) ?comm_subG //. - rewrite (quotient_der 1) //= -/Ms -mulQD quotientMidl -quotient_der //= -/Q. - by rewrite quotientS // -defFM subsetI sub_astabQ !comm_subG ?quotient_der. -have sQ0Ms := subset_trans sQ0Q sQMs. -have ->: 'C_Ms(Ks / Q0 | 'Q) = 'F(M). - have sFMcKsb: 'F(M) \subset 'C_Ms(Ks / Q0 | 'Q). - by rewrite -defFM setIS ?astabS ?quotientS. - have nCMsKsbM: M \subset 'N('C_Ms(Ks / Q0 | 'Q)). - rewrite -{1}mulMsK mulG_subG sub_der1_norm ?subsetIl //= -/Ms; last first. - by rewrite {1}defMs (subset_trans sM''FM sFMcKsb). - rewrite normsI // (subset_trans _ (astab_norm _ _)) ?actsQ //. - by rewrite cents_norm // centsC subsetIr. - apply/eqP; rewrite eqEsubset sFMcKsb -defFM subsetI subsetIl. - rewrite sub_astabQ /= -/Q0 subIset ?(subset_trans sMsM) //= andbT centsC. - apply/setIidPl; apply: minQbP (subsetIl _ _). - rewrite andbC normsI ?norms_cent ?quotient_norms //= -/Qb. - have: Ks / Q0 != 1 by rewrite -cardG_gt1 oKsb prime_gt1. - apply: subG1_contra; rewrite (quotientGI _ sQ0Ms) quotient_astabQ /= -/Q0. - by rewrite subsetI quotientS // centsC subsetIr. -have ->: 'C_M(Qb | 'Q) = 'F(M). - apply/eqP; rewrite eqEsubset -{2}defFM setSI //= andbT. - rewrite -(coprime_mulG_setI_norm mulMsK) //= -defFM mulG_subG subxx /=. - rewrite subsetI subsetIr -(quotientSGK _ sQ0Ms) 1?subIset ?nQ0K //= -/Q0. - rewrite quotientIG; last by rewrite sub_astabQ normG trivg_quotient sub1G. - rewrite quotient_astabQ /= -/Q0 prime_TIg ?sub1G ?oKb //. - rewrite centsC -subsetIidl defKsb; apply: contra (@subset_leq_card _ _ _) _. - by rewrite -ltnNge oQb oKsb (ltn_exp2l 1) prime_gt1. -suffices ->: q \in \beta(M) by do 2!split=> //; last rewrite {1}defMs. -apply: contraR not_cDQb; rewrite negb_forall_in; case/exists_inP=> Q1 sylQ1. -rewrite negbK {Q1 sylQ1}(eq_Hall_pcore sylQ_M sylQ1) -/Q => nnQ. -have sD_DK': D \subset (D <*> K)^`(1). - rewrite -{1}(coprime_cent_prod nDK) ?nilpotent_sol // regDK mulg1. - by rewrite commgSS ?joing_subl ?joing_subr. -rewrite quotient_cents // (subset_trans sD_DK') //. -have nQDK := subset_trans sDKM nQM; have nCQDK := norms_cent nQDK. -rewrite der1_min // -(isog_abelian (second_isog nCQDK)) setIC /=. -rewrite -ker_conj_aut (isog_abelian (first_isog_loc _ _)) //=; set A := _ @* _. -have norm_q := normal_norm (pcore_normal q _). -rewrite {norm_q}(isog_abelian (quotient_isog (norm_q _ _) _)) /=; last first. - by rewrite coprime_TIg ?coprime_morphr //= (pnat_coprime (pcore_pgroup q _)). -have AutA: A \subset [Aut Q] := Aut_conj_aut _ _. -have [|//] := Aut_narrow qQ (mFT_odd _) nnQ _ AutA (morphim_odd _ (mFT_odd _)). -exact: morphim_sol (solvableS sDKM solM). -Qed. - -(* This is B & G, Corollary 15.3(a). *) -Corollary cent_Hall_sigma_sdprod M H pi : - M \in 'M -> pi.-Hall(M`_\sigma) H -> H :!=: 1 -> - exists X, [/\ gval X \subset M, cyclic X, \tau2(M).-group X - & 'C_(M`_\sigma)(H) ><| X = 'C_M(H)]. -Proof. -move=> maxM hallH ntH; have hallMs := Msigma_Hall maxM. -have nsMsM: M`_\sigma <| M := pcore_normal _ M; have [sMsM nMsM] := andP nsMsM. -have sMs := pHall_pgroup hallMs; have [sHMs piH _] := and3P hallH. -have k'CH: \kappa(M)^'.-group 'C_M(H). - apply/idPn; rewrite negb_and cardG_gt0 all_predC negbK => /hasP[p piCHp kMp]. - have PmaxM: M \in 'M_'P by apply/PtypeP; split; last exists p. - have [X]: exists X, X \in 'E_p^1('C_M(H)). - by apply/p_rank_geP; rewrite p_rank_gt0. - case/pnElemP; case/subsetIP=> sXM cHX abelX dimX; have [pX _] := andP abelX. - have [K hallK sXK] := Hall_superset (mmax_sol maxM) sXM (pi_pgroup pX kMp). - have E1X: X \in 'E^1(K) by apply/nElemP; exists p; apply/pnElemP. - have [q q_pr rqH] := rank_witness H; have [S sylS] := Sylow_exists q H. - have piSq: q \in \pi(S). - by rewrite -p_rank_gt0 (p_rank_Sylow sylS) -rqH rank_gt0. - have [_ [defNK defNX] _ [_ not_sylCP _] _] := Ptype_structure PmaxM hallK. - have{defNX} [defNX _] := defNX X E1X. - have [[_ nsKs] [_ mulKKs _ _]] := (dprod_normal2 defNK, dprodP defNK). - have s'K := sub_pgroup (@kappa_sigma' _ _) (pHall_pgroup hallK). - have [_ hallKs] := coprime_mulGp_Hall mulKKs s'K (pgroupS (subsetIl _ _) sMs). - have [sSH _] := andP sylS. - have sylS_Ms := subHall_Sylow hallH (pnatPpi piH (piSg sSH piSq)) sylS. - have [sSMs _] := andP sylS_Ms; have sS := pgroupS sSMs sMs. - have sylS_M := subHall_Sylow hallMs (pnatPpi sS piSq) sylS_Ms. - have sSKs: S \subset 'C_(M`_\sigma)(K). - rewrite (sub_normal_Hall hallKs) //= -defNX subsetI (pHall_sub sylS_M) /=. - by rewrite cents_norm // centsC (centsS sSH). - by have [_ /negP] := not_sylCP q (piSg sSKs piSq) S sylS_M. -have solCH := solvableS (subsetIl M 'C(H)) (mmax_sol maxM). -have [X hallX] := Hall_exists \sigma(M)^' solCH; exists X. -have nsCsH: 'C_(M`_\sigma)(H) <| 'C_M(H) by rewrite /normal setSI // normsIG. -have hallCs: \sigma(M).-Hall('C_M(H)) 'C_(M`_\sigma)(H). - by rewrite -(setIidPl sMsM) -setIA (setI_normal_Hall nsMsM) ?subsetIl. -rewrite (sdprod_normal_p'HallP nsCsH hallX hallCs). -have [-> | ntX] := eqsVneq X 1; first by rewrite sub1G cyclic1 pgroup1. -have [sXCH s'X _] := and3P hallX; have [sXM cHX] := subsetIP sXCH. -have sk'X: \sigma_kappa(M)^'.-group X. - apply/pgroupP=> p p_pr p_dv_X; apply/norP=> /=. - by split; [apply: (pgroupP s'X) | apply: (pgroupP (pgroupS sXCH k'CH))]. -have [K hallK] := Hall_exists \kappa(M) (mmax_sol maxM). -have [U complU] := ex_kappa_compl maxM hallK; have [hallU _ _] := complU. -have [a Ma sXaU] := Hall_Jsub (mmax_sol maxM) hallU sXM sk'X. -have [_ _ cycX _ _] := kappa_structure maxM complU. -rewrite -(cyclicJ _ a) -(pgroupJ _ _ a); have [||//] := cycX _ sXaU. - by rewrite -(isog_eq1 (conj_isog X a)). -rewrite -(normsP nMsM a Ma) centJ -conjIg -(isog_eq1 (conj_isog _ a)). -by rewrite (subG1_contra _ ntH) // subsetI sHMs centsC. -Qed. - -(* This is B & G, Corollary 15.3(b). *) -Corollary sigma_Hall_tame M H pi x a : - M \in 'M -> pi.-Hall(M`_\sigma) H -> x \in H -> x ^ a \in H -> - exists2 b, b \in 'N_M(H) & x ^ a = x ^ b. -Proof. -move=> maxM hallH Hx Hxa; have [sHMs piH _] := and3P hallH. -have SMxM: M \in 'M_\sigma[x] by rewrite inE maxM cycle_subG (subsetP sHMs). -have SMxMa: (M :^ a^-1)%G \in 'M_\sigma[x]. - by rewrite inE mmaxJ maxM cycle_subG /= MsigmaJ mem_conjgV (subsetP sHMs). -have [-> | ntx] := eqVneq x 1; first by exists 1; rewrite ?group1 ?conj1g. -have ell1x: \ell_\sigma(x) == 1%N. - by apply/ell_sigma1P; split=> //; apply/set0Pn; exists M. -have ntH: H :!=: 1 by apply/trivgPn; exists x. -have [[transR _ _ _] _] := FT_signalizer_context ell1x. -have [c Rc defMc] := atransP2 transR SMxM SMxMa. -pose b := c * a; have def_xa: x ^ a = x ^ b. - by have [_ cxc] := setIP Rc; rewrite conjgM {3}/conjg -(cent1P cxc) mulKg. -have Mb: b \in M. - by rewrite -(norm_mmax maxM) inE conjsgM -(congr_group defMc) actKV. -have nsMsM: M`_\sigma <| M := pcore_normal _ _; have [sMsM _] := andP nsMsM. -have [nsHM | not_nsHM] := boolP (H <| M). - by exists b; rewrite // (mmax_normal maxM) ?setIid. -have neqMFs: M`_\F != M`_\sigma. - apply: contraNneq not_nsHM => /(Fcore_eq_Msigma maxM)nilMs. - by rewrite (nilpotent_Hall_pcore nilMs hallH) gFnormal_trans. -have [K hallK] := Hall_exists \kappa(M) (mmax_sol maxM). -pose q := #|'C_(M`_\sigma)(K)|. -have [D hallD] := Hall_exists q^' (solvableS sMsM (mmax_sol maxM)). -have [[_ sMFs _ _]] := Fcore_structure maxM; case/(_ K D) => //; rewrite -/q. -set Q := 'O_q(M) => _ [_ q_pr piMFq _] [sylQ nilD _] _ _. -have sQMs: Q \subset M`_\sigma. - by apply: subset_trans sMFs; rewrite -[Q](p_core_Fcore piMFq) pcore_sub. -have sylQ_Ms: q.-Hall(M`_\sigma) Q := pHall_subl sQMs sMsM sylQ. -have nsQM: Q <| M := pcore_normal q M; have [_ qQ _] := and3P sylQ. -have nsQ_Ms: Q <| M`_\sigma := normalS sQMs sMsM nsQM. -have defMs: Q ><| D = M`_\sigma := sdprod_normal_p'HallP nsQ_Ms hallD sylQ_Ms. -have [_ mulQD nQD tiQD] := sdprodP defMs; rewrite -/Q in mulQD nQD tiQD. -have nQH := subset_trans sHMs (normal_norm nsQ_Ms). -have nsQHM: Q <*> H <| M. - rewrite -(quotientGK nsQM) -quotientYK // cosetpre_normal //= -/Q. - suffices ->: H / Q = 'O_pi(M`_\sigma / Q). - by rewrite gFnormal_trans ?quotient_normal. - apply: nilpotent_Hall_pcore; last exact: quotient_pHall. - by rewrite /= -mulQD quotientMidl -(isog_nil (quotient_isog _ _)). -have tiQH: Q :&: H = 1. - apply: coprime_TIg (p'nat_coprime (pi_pgroup qQ _) piH). - apply: contra not_nsHM => pi_q; rewrite (joing_idPr _) // in nsQHM. - by rewrite (normal_sub_max_pgroup (Hall_max hallH)) ?(pi_pgroup qQ). -have defM: Q * 'N_M(H) = M. - have hallH_QH: pi.-Hall(Q <*> H) H. - by rewrite (pHall_subl (joing_subr _ _) _ hallH) // join_subG sQMs. - have solQH := solvableS (normal_sub nsQHM) (mmax_sol maxM). - rewrite -[RHS](Hall_Frattini_arg solQH nsQHM hallH_QH) /= norm_joinEr //. - by rewrite -mulgA [H * _]mulSGid // subsetI (subset_trans sHMs sMsM) normG. -rewrite -defM in Mb; case/mulsgP: Mb => z n Qz Nn defb; exists n => //. -rewrite def_xa defb conjgM [x ^ z](conjg_fixP _) // -in_set1 -set1gE -tiQH. -rewrite inE {1}commgEr groupMr // -mem_conjgV groupV /=. -rewrite (normsP (normal_norm nsQM)) ?Qz; last first. - by rewrite groupV (subsetP sMsM) // (subsetP sHMs). -rewrite commgEl groupMl ?groupV //= -(conjsgK n H) mem_conjgV -conjgM -defb. -by have [_ nHn] := setIP Nn; rewrite (normP nHn) -def_xa. -Qed. - -(* This is B & G, Corollary 15.4. *) -(* This result does not appear to be needed for the actual proof. *) -Corollary nilpotent_Hall_sigma H : - nilpotent H -> Hall G H -> exists2 M, M \in 'M & H \subset M`_\sigma. -Proof. -move=> nilH /Hall_pi/=hallH; have [_ piH _] := and3P hallH. -have [-> | ntH] := eqsVneq H 1. - by have [M maxM] := any_mmax gT; exists M; rewrite ?sub1G. -pose p := pdiv #|H|; have piHp: p \in \pi(H) by rewrite pi_pdiv cardG_gt1. -pose S := 'O_p(H)%G; have sylS: p.-Sylow(H) S := nilpotent_pcore_Hall p nilH. -have [sSH pS _] := and3P sylS. -have ntS: S :!=: 1 by rewrite -rank_gt0 (rank_Sylow sylS) p_rank_gt0. -have [M maxNM] := mmax_exists (mFT_norm_proper ntS (mFT_pgroup_proper pS)). -have [maxM sNM] := setIdP maxNM; exists M => //. -have sSM: S \subset M := subset_trans (normG _) sNM. -have sylS_G := subHall_Sylow hallH (pnatPpi piH piHp) sylS. -have sylS_M := pHall_subl sSM (subsetT M) sylS_G. -have sMp: p \in \sigma(M) by apply/exists_inP; exists S. -have sSMs: S \subset M`_\sigma. - by rewrite (sub_Hall_pcore (Msigma_Hall maxM)) ?(pi_pgroup pS). -rewrite -(nilpotent_Fitting nilH) FittingEgen gen_subG. -apply/bigcupsP=> [[q /= _] piHq]; have [-> // | p'q] := eqVneq q p. -have sylS_Ms := pHall_subl sSMs (pcore_sub _ _) sylS_M. -have [X [_ cycX t2X defCS]] := cent_Hall_sigma_sdprod maxM sylS_Ms ntS. -have{defCS} [nCMsCS _ defCS _ _] := sdprod_context defCS. -have t2'CMs: \tau2(M)^'.-group 'C_(M`_\sigma)(S). - apply: pgroupS (subsetIl _ _) (sub_pgroup _ (pcore_pgroup _ _)) => r. - by apply: contraL => /andP[]. -have [hallCMs hallX] := coprime_mulGp_Hall defCS t2'CMs t2X. -have sHqCS: 'O_q(H) \subset 'C_M(S). - rewrite (setIidPr (subset_trans (cent_sub _) sNM)). - rewrite (sub_nilpotent_cent2 nilH) ?pcore_sub //. - exact: pnat_coprime pS (pi_pgroup (pcore_pgroup _ _) _). -have [t2q | t2'q] := boolP (q \in \tau2(M)); last first. - apply: subset_trans (subsetIl _ 'C(S)). - by rewrite (sub_normal_Hall hallCMs) // (pi_pgroup (pcore_pgroup _ _)). -have sylHq := nilpotent_pcore_Hall q nilH. -have sylHq_G := subHall_Sylow hallH (pnatPpi piH piHq) sylHq. -have sylHq_CS := pHall_subl sHqCS (subsetT _) sylHq_G. -have [Q sylQ] := Sylow_exists q X; have [sQX _] := andP sylQ. -have sylQ_CS := subHall_Sylow hallX t2q sylQ. -case/andP: t2q => _. -rewrite eqn_leq andbC ltnNge (leq_trans (p_rankS q (subsetT _))) //. -rewrite -(rank_Sylow sylHq_G) (rank_Sylow sylHq_CS) -(rank_Sylow sylQ_CS). -by rewrite (leq_trans (rankS sQX)) // -abelian_rank1_cyclic ?cyclic_abelian. -Qed. - -(* This is B & G, Corollary 15.5. *) -(* We have changed the condition K != 1 to the equivalent M \in 'M_'P, as *) -(* avoids a spurrious quantification on K. *) -(* The text is quite misleading here, since Corollary 15.3(a) is needed for *) -(* bith the nilpotent and the non-nilpotent case -- indeed, it is not really *) -(* needed in the non-nilpotent case! *) -Corollary Fitting_structure M (H := M`_\F) (Y := 'O_\sigma(M)^'('F(M))) : - M \in 'M -> - [/\ (*a*) cyclic Y /\ \tau2(M).-group Y, - (*b*) [/\ M^`(2) \subset 'F(M), - H \* 'C_M(H) = 'F(M) - & 'F(M`_\sigma) \x Y = 'F(M)], - (*c*) H \subset M^`(1) /\ nilpotent (M^`(1) / H) - & (*d*) M \in 'M_'P -> 'F(M) \subset M^`(1)]. -Proof. -move=> maxM; have nilF := Fitting_nil M. -have sHF: H \subset 'F(M) := Fcore_sub_Fitting M. -have nsMsM: M`_\sigma <| M := pcore_normal _ _; have [sMsM nMsM] := andP nsMsM. -have sMs: \sigma(M).-group M`_\sigma := pcore_pgroup _ _. -have nsFM: 'F(M) <| M := Fitting_normal M; have [sFM nFM] := andP nsFM. -have sYF: Y \subset 'F(M) := pcore_sub _ _; have sYM := subset_trans sYF sFM. -have defF: 'F(M`_\sigma) \x Y = 'F(M). - rewrite -(nilpotent_pcoreC \sigma(M) nilF); congr (_ \x _). - apply/eqP; rewrite eqEsubset pcore_max ?(pgroupS (Fitting_sub _)) //=. - rewrite Fitting_max ?(nilpotentS (pcore_sub _ _)) //=. - by rewrite -(pcore_setI_normal _ nsFM) norm_normalI ?(subset_trans sMsM). - rewrite /normal (char_norm_trans (Fitting_char _)) ?(subset_trans sFM) //. - by rewrite Fitting_max ?Fitting_nil ?gFnormal_trans. -have [[ntH sHMs sMsM' _] nnil_struct] := Fcore_structure maxM. -have hallH: \pi(H).-Hall(M`_\sigma) H := pHall_subl sHMs sMsM (Fcore_Hall M). -have [X [_ cycX t2X defCH]] := cent_Hall_sigma_sdprod maxM hallH ntH. -have hallX: \sigma(M)^'.-Hall('C_M(H)) X. - have [_ mulCsH_X _ _] := sdprodP defCH. - have [|//] := coprime_mulpG_Hall mulCsH_X (pgroupS (subsetIl _ _) sMs). - by apply: sub_pgroup t2X => p /andP[]. -have sYX: Y \subset X. - rewrite (normal_sub_max_pgroup (Hall_max hallX)) ?pcore_pgroup //. - rewrite /normal gFnorm_trans ?subIset ?nFM //= -/Y andbT. - have [_ _ cFsY _] := dprodP defF. - rewrite subsetI sYM (sub_nilpotent_cent2 nilF) //= -/Y -/H. - exact: pnat_coprime (pgroupS sHMs sMs) (pcore_pgroup _ _). -have [cycY t2Y]: cyclic Y /\ \tau2(M).-group Y. - by rewrite (cyclicS sYX cycX) (pgroupS sYX t2X). -have [K hallK] := Hall_exists \kappa(M) (mmax_sol maxM). -have [U complU] := ex_kappa_compl maxM hallK. -have [[defM _ cM'M'b] defM' _ _ _] := kappa_structure maxM complU. -have d_holds: M \in 'M_'P -> 'F(M) \subset M^`(1). - rewrite inE maxM andbT -(trivg_kappa maxM hallK) => ntK. - rewrite -(dprodW defF) mulG_subG gFsub_trans //= -/Y. - have{defM'} [[defM' _] nsM'M] := (defM' ntK, der_normal 1 M). - have hallM': \kappa(M)^'.-Hall(M) M^`(1). - by apply/(sdprod_normal_pHallP nsM'M hallK); rewrite /= -defM'. - rewrite (sub_normal_Hall hallM') ?(sub_pgroup _ t2Y) // => p /andP[_]. - by apply: contraL => /rank_kappa->. -have defF_H: 'C_M(H) \subset 'F(M) -> H \* 'C_M(H) = 'F(M). - move=> sCHF; apply/eqP; rewrite cprodE ?subsetIr // eqEsubset ?mul_subG //=. - have hallH_F := pHall_subl sHF sFM (Fcore_Hall M). - have nsHF := normalS sHF sFM (Fcore_normal M). - have /dprodP[_] := nilpotent_pcoreC \pi(H) nilF. - rewrite (normal_Hall_pcore hallH_F nsHF) /= -/H => defF_H cHFH' _. - by rewrite -defF_H mulgS // subsetI gFsub_trans. -have [eqHMs | neqHMs] := eqVneq H M`_\sigma. - split=> //; [split=> // | by rewrite eqHMs abelian_nil]. - by rewrite (subset_trans _ sHF) //= eqHMs der1_min ?comm_subG. - rewrite defF_H // -(sdprodW defCH) -eqHMs mulG_subG subIset ?sHF //=. - rewrite Fitting_max ?abelian_nil ?cyclic_abelian //. - rewrite -(normal_Hall_pcore hallX) ?gFnormal_trans //. - by rewrite norm_normalI // eqHMs norms_cent. - move: defCH; rewrite -dprodEsd; first by case/dprod_normal2. - by rewrite -eqHMs (centsS (subsetIl _ _)); case/subsetIP: (pHall_sub hallX). -pose q := #|'C_(M`_\sigma)(K)|; pose Q := 'O_q(M). -have [D hallD] := Hall_exists q^' (solvableS sMsM (mmax_sol maxM)). -case/(_ K D): nnil_struct => //=; rewrite -/H -/q -/Q. -move=> [_ _ defMs] [_ _ piHq _] [sylQ nilD _] _ [_ -> [defF_Q _ _] _]. -have sQH: Q \subset H by rewrite -[Q](p_core_Fcore piHq) pcore_sub. -split=> //; rewrite -?{}defMs; split=> //. - by rewrite defF_H // -defF_Q joingC sub_gen // subsetU ?setIS ?centS. -have sQMs := subset_trans sQH sHMs; have sylQ_Ms := pHall_subl sQMs sMsM sylQ. -have nsQ_Ms: Q <| M`_\sigma := normalS sQMs sMsM (pcore_normal _ _). -have defMs: Q ><| D = M`_\sigma := sdprod_normal_p'HallP nsQ_Ms hallD sylQ_Ms. -have [_ <- _ _] := sdprodP defMs; rewrite -quotientMidl mulgA (mulGSid sQH). -by rewrite quotientMidl quotient_nil. -Qed. - -(* This is B & G, Corollary 15.6. *) -(* Note that the proof of the F-core noncyclicity given in the text only *) -(* applies to the nilpotent case, and we need to use a different assertion of *) -(* 15.2 if Msigma is not nilpotent. *) -Corollary Ptype_cyclics M K (Ks := 'C_(M`_\sigma)(K)) : - M \in 'M_'P -> \kappa(M).-Hall(M) K -> - [/\ Ks != 1, cyclic Ks, Ks \subset M^`(2), Ks \subset M`_\F - & ~~ cyclic M`_\F]. -Proof. -move=> PmaxM hallK; have [ntK maxM] := setIdP PmaxM. -rewrite -(trivg_kappa maxM hallK) in ntK. -have [_ _ [ntKs _] _ _] := Ptype_structure PmaxM hallK. -have [_ _ [_ _ _ [cycZ _ _ _ _] [_ _ _ defM]]] := Ptype_embedding PmaxM hallK. -have{cycZ} cycKs: cyclic Ks := cyclicS (joing_subr _ _) cycZ. -have solM': solvable M^`(1) := solvableS (der_sub 1 M) (mmax_sol maxM). -have sMsM' := Msigma_der1 maxM. -have{defM} sKsM'': Ks \subset M^`(2). - have coM'K: coprime #|M^`(1)| #|K|. - by rewrite (coprime_sdprod_Hall_r defM) (pHall_Hall hallK). - have [_] := coprime_der1_sdprod defM coM'K solM' (subxx _). - exact: subset_trans (setSI _ sMsM'). -have [eqMFs | neqMFs] := eqVneq M`_\F M`_\sigma. - split=> //; rewrite eqMFs ?subsetIl //; apply: contra ntKs => cycMs. - rewrite -subG1 (subset_trans sKsM'') // (sameP trivgP derG1P) /= -derg1. - have cycF: cyclic 'F(M). - have [[cycY _] [_ _ defF] _ _] := Fitting_structure maxM. - have [[x defMs] [y defY]] := (cyclicP cycMs, cyclicP cycY). - rewrite defMs (nilpotent_Fitting (abelian_nil (cycle_abelian _))) in defF. - have [_ mulXY cxy _] := dprodP defF. - rewrite -mulXY defY -cycleM ?cycle_cyclic //. - by apply/cent1P; rewrite -cycle_subG sub_cent1 -cycle_subG -defY. - by rewrite /order -defMs -defY coprime_pcoreC. - apply: abelianS (cyclic_abelian cycF). - apply: subset_trans (cent_sub_Fitting (mmax_sol maxM)). - rewrite der1_min ?normsI ?normG ?norms_cent ?gFnorm //=. - rewrite -ker_conj_aut (isog_abelian (first_isog_loc _ _)) ?gFnorm //=. - exact: abelianS (Aut_conj_aut _ _) (Aut_cyclic_abelian cycF). -have [D hallD] := Hall_exists #|Ks|^' (solvableS sMsM' solM'). -have [_ /(_ K D)[]//=] := Fcore_structure maxM; rewrite -/Ks. -set q := #|Ks|; set Q := 'O_q(M) => _ [_ q_pr piMFq bMq] [sylQ _ _] _ _. -have sQMF: Q \subset M`_\F by rewrite -[Q]p_core_Fcore ?pcore_sub. -have qKs: q.-group Ks := pnat_id q_pr. -have sKsM := subset_trans sKsM'' (der_sub 2 M). -split=> //; first by apply: subset_trans sQMF; rewrite (sub_Hall_pcore sylQ). -apply: contraL (beta_sub_alpha bMq) => /(cyclicS sQMF)cycQ; rewrite -leqNgt. -by rewrite leqW // -(rank_Sylow sylQ) -abelian_rank1_cyclic ?cyclic_abelian. -Qed. - -(* This is B & G, Theorem 15.7. *) -(* We had to change the statement of the Theorem, because the first equality *) -(* of part (c) does not appear to be valid: if M is of type F, we know very *) -(* little of the action E1 on the Sylow subgroups of E2, and so E2 might have *) -(* a Sylow subgroup that meets F(M) but is also centralised by E1 and hence *) -(* intesects M' trivially; luckily, only the inclusion M' \subset F(M) seems *) -(* to be needed in the sequel. *) -(* We have also restricted the quantification on the Ei to part (c), and *) -(* factored and simplified some of the assertions of parts (e2) and (e3); it *) -(* appears they could perhaps be simplified futher, since the assertions on *) -(* Op(H) and Op'(H) do not appear to be used in the Peterfalvi revision of *) -(* the character theory part of the proof. *) -(* Proof notes: we had to correct/complete several arguments of the B & G *) -(* text. The use of 12.6(d) for parts (c) and (d), p. 120, l. 5 from the *) -(* bottom, is inapropriate as tau2 could be empty. The assertion X1 != Z0 on *) -(* l. 5, p. 121 needs to be strengthened to ~~ (X1 \subset Z0) in order to *) -(* prove that #|Z0| is prime -- only then are the assertions equivalent. The *) -(* use of Lemma 10.13(b), l. 7, p. 121, requires that B be maximal in G, not *) -(* only in P as is stated l. 6; proving the stronger assertion requires using *) -(* Corollary 15.3(b), which the text does not mention. The regularity *) -(* property stated l. 11-13 is too weak to be used in the type P1 case -- the *) -(* regularity assumption need to be restricted to a subgroup of prime order. *) -(* Finally, the cyclicity of Z(H) is not actually needed in the proof. *) -Theorem nonTI_Fitting_structure M g (H := (M`_\F)%G) : - let X := ('F(M) :&: 'F(M) :^ g)%G in - M \in 'M -> g \notin M -> X :!=: 1 -> - [/\ (*a*) M \in 'M_'F :|: 'M_'P1 /\ H :=: M`_\sigma, - (*b*) X \subset H /\ cyclic X, - (*c*) M^`(1) \subset 'F(M) /\ M`_\sigma \x 'O_\sigma(M)^'('F(M)) = 'F(M), - (*d*) forall E E1 E2 E3, sigma_complement M E E1 E2 E3 -> - [/\ E3 :=: 1, E2 <| E, E / E2 \isog E1 & cyclic (E / E2)] - & (*e*) (*1*) [/\ M \in 'M_'F, abelian H & 'r(H) = 2] - \/ let p := #|X| in [/\ prime p, ~~ abelian 'O_p(H), cyclic 'O_p^'(H) - & (*2*) {in \pi(H), forall q, exponent (M / H) %| q.-1} - \/ (*3*) [/\ #|'O_p(H)| = (p ^ 3)%N, M \in 'M_'P1 & #|M / H| %| p.+1] - ]]. -Proof. -move=> X maxM notMg ntX; have nilH: nilpotent H := Fcore_nil M. -have /andP[sHM nHM]: H <| M := Fcore_normal M. -have [[cycY t2Y] [_ _ defF] _ _] := Fitting_structure maxM. -set Y := 'O_\sigma(M)^'('F(M)) in cycY t2Y defF *. -have not_cycMp: {in \pi(X), forall p, ~~ cyclic 'O_p(M)}. - move=> p; rewrite mem_primes => /and3P[p_pr _ p_dv_X]. - apply: contra notMg => cycMp. - have hallMp := nilpotent_pcore_Hall p (Fitting_nil M). - have{cycMp} defNx1: {in 'F(M), forall x1, #[x1] = p -> 'N(<[x1]>) = M}. - move=> x1; rewrite /order -cycle_subG => sX1F oX1. - rewrite (mmax_normal maxM) //; last by rewrite -cardG_gt1 oX1 prime_gt1. - rewrite (char_normal_trans _ (pcore_normal p M)) ?sub_cyclic_char //=. - by rewrite -p_core_Fitting (sub_Hall_pcore hallMp) // /pgroup oX1 pnat_id. - have [x1 Xx1 ox1] := Cauchy p_pr p_dv_X; have [Fx1 Fgx1] := setIP Xx1. - rewrite -(norm_mmax maxM) inE -{1}(defNx1 (x1 ^ g^-1)) -?mem_conjg ?orderJ //. - by rewrite cycleJ normJ actKV -(defNx1 x1). -have{cycY} sX: \sigma(M).-group X. - apply: sub_pgroup (pgroup_pi X) => p piXp. - apply: contraR (not_cycMp p piXp) => s'p; rewrite -p_core_Fitting. - by apply: cyclicS (sub_pcore _ _) cycY => p1; move/eqnP->. -have sXMs: X \subset M`_\sigma. - by rewrite (sub_Hall_pcore (Msigma_Hall maxM)) // subIset ?Fitting_sub. -have E1X_facts p X1 (C1 := 'C_H(X1)%G): - X1 \in 'E_p^1(X) -> [/\ C1 \notin 'U, 'r(C1) <= 2 & abelian C1]. -- move=> EpX1; have [sX1X /andP[pX1 _] _] := pnElemP EpX1. - have piXp: p \in \pi(X) by rewrite -p_rank_gt0; apply/p_rank_geP; exists X1. - have not_sCX1M: ~~ ('C(X1) \subset M). - have [[sX1F sX1Fg] sFM] := (subsetIP sX1X, Fitting_sub M). - apply: contra notMg => sCX1M; rewrite -groupV. - have [trCX1 _ _] := sigma_group_trans maxM (pnatPpi sX piXp) pX1. - have [||c cX1c] := trCX1 g^-1; rewrite ?(subset_trans _ sFM) ?sub_conjgV //. - by case=> m Mm ->; rewrite groupM // (subsetP sCX1M). - have ltCX1_G: 'C(X1) \proper G := mFT_cent_proper (nt_pnElem EpX1 isT). - have ltC1G: C1 \proper G := sub_proper_trans (subsetIr H _) ltCX1_G. - have{ltCX1_G} nonuniqC1: C1 \notin 'U. - have sC1M: C1 \subset M by rewrite subIset ?Fcore_sub. - apply: contra not_sCX1M => uniqC1. - by rewrite (sub_uniq_mmax (def_uniq_mmax uniqC1 maxM sC1M)) ?subsetIr. - split=> //; first by rewrite leqNgt (contra (rank3_Uniqueness _)). - have sC1H: C1 \subset H := subsetIl _ _. - have dprodC1: 'F(C1) = C1 := nilpotent_Fitting (nilpotentS sC1H nilH). - apply/center_idP; rewrite -{2}dprodC1 -(center_bigdprod dprodC1). - apply: eq_bigr => r _; apply/center_idP; apply: contraR nonuniqC1. - move/(nonabelian_Uniqueness (pcore_pgroup _ _)). - exact: uniq_mmaxS (pcore_sub _ _) ltC1G. -pose p := pdiv #|X|; have piXp: p \in \pi(X) by rewrite pi_pdiv cardG_gt1. -have /p_rank_geP[X1 EpX1]: 0 < 'r_p(X) by rewrite p_rank_gt0. -have [sMp ntX1] := (pnatPpi sX piXp, nt_pnElem EpX1 isT). -have [p_pr oX1] := (pnElem_prime EpX1, card_pnElem EpX1 : #|X1| = p). -have [sX1X abelX1 dimX1] := pnElemP EpX1; have [pX1 _] := andP abelX1. -have [nonuniqC1 rC1 cC1C1] := E1X_facts p X1 EpX1. -have [cycX b'p]: cyclic X /\ p \in \beta(M)^'. - have [E hallE] := ex_sigma_compl maxM. - have [_ _] := sigma_compl_embedding maxM hallE. - case/(_ g notMg); set X2 := _ :&: _ => cycX2 b'X2 _. - have sXMg: X \subset M :^ g by rewrite subIset // conjSg Fitting_sub orbT. - have{sXMg} sXX2: X \subset X2 by rewrite subsetI sXMs. - by rewrite (pnatPpi b'X2 (piSg sXX2 piXp)) (cyclicS sXX2). -have b'H: \beta(M)^'.-group H. - apply: sub_pgroup (pgroup_pi _) => r piHr; have [-> // | p'r] := eqVneq r p. - apply/existsP; exists 'O_r(M)%G; rewrite /= Fcore_pcore_Sylow // negbK. - apply/implyP; rewrite ltnNge -rank_pgroup ?pcore_pgroup ?(leq_trans _ rC1) //. - rewrite rankS // subsetI /= -{1}(p_core_Fcore piHr) pcore_sub //. - rewrite -p_core_Fitting (sub_nilpotent_cent2 (Fitting_nil M)) ?pcore_sub //. - exact: subset_trans sX1X (subsetIl _ _). - exact: pnat_coprime pX1 (pi_pgroup (pcore_pgroup r _) _). -have [K hallK] := Hall_exists \kappa(M) (mmax_sol maxM). -have [sKM kK _] := and3P hallK; have s'K := sub_pgroup (@kappa_sigma' _ M) kK. -have [U complU] := ex_kappa_compl maxM hallK. -have [[defM cycK _] defM' _ _ exU0] := kappa_structure maxM complU. -have{b'p} FP1maxM: M \in 'M_'F :|: 'M_'P1. - apply: contraR b'p; rewrite inE /=; case/norP=> notFmaxF notP1maxF. - have PmaxM: M \in 'M_'P by apply/setDP. - by have [_ _ _ _ [| <- //]] := Ptype_structure PmaxM hallK; apply/setDP. -have defH: H :=: M`_\sigma. - apply/eqP; apply/idPn=> neqHMs; pose q := #|'C_(M`_\sigma)(K)|. - have solMs: solvable M`_\sigma := solvableS (pcore_sub _ _) (mmax_sol maxM). - have [D hallD] := Hall_exists q^' solMs. - have [_ /(_ K D)[] // _ [_ _ piHq /idPn[]]] := Fcore_structure maxM. - exact: pnatPpi b'H piHq. -have{sXMs} sXH: X \subset H by rewrite defH. -have{b'H} sM'F: M^`(1) \subset 'F(M). - rewrite Fitting_max ?der_normal // (isog_nil (quotient1_isog _)). - suffices <-: M`_\beta = 1 by apply: Mbeta_quo_nil. - apply/eqP; rewrite trivg_card1 (card_Hall (Mbeta_Hall maxM)). - rewrite -(partn_part _ (beta_sub_sigma maxM)) -(card_Hall (Msigma_Hall maxM)). - by rewrite /= -defH partG_eq1. -have{defF} defF: M`_\sigma \x Y = 'F(M). - by rewrite -defF -defH nilpotent_Fitting. -split=> // [E E1 E2 E3 complEi | {Y t2Y defF sM'F}]. - have [[sE3E' _] _ [cycE1 _] [_ defE] _]:= sigma_compl_context maxM complEi. - have [hallE _ _ hallE3 _] := complEi; have [sE3E t3E3 _] := and3P hallE3. - have E3_1: E3 :=: 1. - have [sEM s'E _] := and3P hallE; have sE'M' := dergS 1 sEM. - have sE3F: E3 \subset 'F(M) := subset_trans sE3E' (subset_trans sE'M' sM'F). - rewrite -(setIidPr sE3F) coprime_TIg // -(dprod_card defF) coprime_mull. - rewrite (pnat_coprime (pcore_pgroup _ _) (pgroupS sE3E s'E)). - exact: p'nat_coprime (sub_pgroup (@tau3'2 _ M) t2Y) t3E3. - have{defE} defE: E2 ><| E1 = E by rewrite -defE E3_1 sdprod1g. - have [-> _ mulE21 nE21 tiE21] := sdprod_context defE. - by rewrite -mulE21 quotientMidl quotient_cyclic // isog_sym quotient_isog. -have{defM'} defM_P1: M \in 'M_'P1 -> H ><| K = M /\ M^`(1) = H. - move=> P1maxM; have [PmaxM _] := setIdP P1maxM. - have U1: U :=: 1 by apply/eqP; rewrite (trivg_kappa_compl maxM complU). - have ntK: K :!=: 1 by rewrite (trivg_kappa maxM hallK); case/setDP: PmaxM. - by have [<- _] := defM' ntK; rewrite -{1}defM U1 sdprodg1 -defH. -pose P := 'O_p(H); have sylP: p.-Sylow(H) P := nilpotent_pcore_Hall p nilH. -have [sPH pP _] := and3P sylP. -have [cHH | {not_cycMp} not_cHH] := boolP (abelian H); [left | right]. - have [-> | P1maxM] := setUP FP1maxM; last first. - have [PmaxM _] := setIdP P1maxM. - have [ntKs _ sKsM'' _ _] := Ptype_cyclics PmaxM hallK. - case/eqP: (subG1_contra sKsM'' ntKs); apply/derG1P. - by rewrite /= -derg1; have [_ ->] := defM_P1 P1maxM. - split=> //; apply/eqP; rewrite eqn_leq (leq_trans _ rC1) //=; last first. - by rewrite rankS // subsetIidl (centsS sX1X) // (sub_abelian_cent cHH). - apply: leq_trans (rankS (pcore_sub p _)). - rewrite ltnNge -abelian_rank1_cyclic ?(abelianS sPH) //=. - by rewrite p_core_Fcore ?(piSg sXH) ?not_cycMp. -have sX1P: X1 \subset P by rewrite (sub_Hall_pcore sylP) ?(subset_trans sX1X). -have [_ mulPHp' cPHp' _] := dprodP (nilpotent_pcoreC p nilH : P \x _ = H). -have cHp'Hp': abelian 'O_p^'(H). - by rewrite (abelianS _ cC1C1) // subsetI pcore_sub (centsS sX1P). -have not_cPP: ~~ abelian P. - by apply: contra not_cHH => cPP; rewrite -mulPHp' abelianM cPP cHp'Hp'. -have{E1X_facts} pX: p.-group X. - apply: sub_pgroup (pgroup_pi _) => q; rewrite -p_rank_gt0. - case/p_rank_geP=> X2 EqX2; have [_ _ cC2C2] := E1X_facts _ _ EqX2. - case/pnElemP: EqX2 => sX2X /andP[qX2 _] _; have sX2H := subset_trans sX2X sXH. - apply: contraR not_cPP => q'p; rewrite (abelianS _ cC2C2) // subsetI sPH. - by rewrite (sub_nilpotent_cent2 nilH) ?(p'nat_coprime (pi_pgroup qX2 _) pP). -have sXP: X \subset P by rewrite (sub_Hall_pcore sylP). -pose Z0 := 'Ohm_1('Z(P)); have sZ0ZP: Z0 \subset 'Z(P) := Ohm_sub 1 _. -have{sZ0ZP} [sZ0P cPZ0] := subsetIP sZ0ZP. -have not_sX1Z0: ~~ (X1 \subset Z0). - apply: contra not_cPP => sX1Z0; apply: abelianS cC1C1. - by rewrite subsetI sPH (centsS sX1Z0) // centsC. -pose B := X1 <*> Z0; have sBP: B \subset P by rewrite join_subG sX1P. -have defB: X1 \x Z0 = B by rewrite dprodEY ?prime_TIg ?oX1 ?(centsS sX1P). -have pZP: p.-group 'Z(P) := pgroupS (center_sub _) pP. -have abelZ0: p.-abelem Z0 by rewrite Ohm1_abelem ?center_abelian. -have{abelZ0} abelB: p.-abelem B by rewrite (dprod_abelem _ defB) abelX1. -have sylP_Ms: p.-Sylow(M`_\sigma) P by rewrite -defH. -have sylP_G: p.-Sylow(G) P := subHall_Sylow (Msigma_Hall_G maxM) sMp sylP_Ms. -have max_rB A: p.-abelem A -> B \subset A -> 'r_p(A) <= 2. - move=> abelA /joing_subP[sX1A _]; have [pA cAA _] := and3P abelA. - suffices [a [nX1a sAaP]]: exists a, a \in 'N(X1) /\ A :^ a \subset P. - rewrite -rank_pgroup // -(rankJ _ a) (leq_trans _ rC1) ?rankS //= subsetI. - by rewrite -(normP nX1a) centJ conjSg (subset_trans sAaP) ?(centsS sX1A). - have [a _ sAaP] := Sylow_Jsub sylP_G (subsetT A) pA. - have [x1 defX1]: exists x1, X1 :=: <[x1]>. - by apply/cyclicP; rewrite prime_cyclic ?oX1. - have Px1: x1 \in P by rewrite -cycle_subG -defX1. - have Px1a: x1 ^ a \in P. - by rewrite (subsetP sAaP) // memJ_conjg -cycle_subG -defX1. - have [b nPb def_xb] := sigma_Hall_tame maxM sylP_Ms Px1 Px1a. - exists (a * b^-1); rewrite !inE !actM !sub_conjgV defX1 /= -!cycleJ def_xb. - by have{nPb} [_ nPb] := setIP nPb; rewrite (normP nPb). -have rpB: 'r_p(B) = 2. - apply/eqP; rewrite eqn_leq max_rB // -(p_rank_dprod p defB). - rewrite p_rank_abelem ?dimX1 // ltnS p_rank_Ohm1 -rank_pgroup // rank_gt0. - by rewrite center_nil_eq1 ?(pgroup_nil pP) ?(subG1_contra sXP). -have oZ0: #|Z0| = p. - apply/eqP; rewrite -(eqn_pmul2l (cardG_gt0 X1)) (dprod_card defB) oX1. - by rewrite (card_pgroup (abelem_pgroup abelB)) -p_rank_abelem ?rpB. -have p2maxElemB: [group of B] \in 'E_p^2(G) :&: 'E*_p(G). - rewrite !inE subsetT abelB -p_rank_abelem // rpB /=. - apply/maxgroupP; rewrite !inE subsetT /= -/B; split=> // A. - case/pElemP=> _ abelA sBA; have [pA _] := andP abelA. - apply/eqP; rewrite eq_sym eqEcard sBA (card_pgroup pA). - rewrite (card_pgroup (abelem_pgroup abelB)) -!p_rank_abelem // rpB. - by rewrite leq_exp2l ?prime_gt1 ?max_rB. -have{not_sX1Z0} defX: X :=: X1. - have sX_CPB: X \subset 'C_P(B). - rewrite centY !subsetI sXP sub_abelian_cent ?cyclic_abelian //=. - by rewrite centsC (centsS sXP). - have [C defCPB]: exists C, X1 \x C = 'C_P(B). - have [_ [C]] := basic_p2maxElem_structure p2maxElemB pP sBP not_cPP. - case=> _ _ defCPB _; exists C; rewrite defCPB // !inE joing_subl abelX1. - by rewrite -val_eqE eqEsubset negb_and not_sX1Z0 /= dimX1. - have defX: X1 \x (C :&: X) = X by rewrite (dprod_modl defCPB) // (setIidPr _). - by move/eqP: ntX1; case/(cyclic_pgroup_dprod_trivg pX cycX): defX; case. -have cycHp': cyclic 'O_p^'(H). - rewrite abelian_rank1_cyclic // leqNgt; apply: contra nonuniqC1 => rHp'. - apply: (uniq_mmaxS (setIS H (centS sX1P))). - by rewrite mFT_sol_proper nilpotent_sol // (nilpotentS (subsetIl _ _)). - apply: cent_uniq_Uniqueness (subsetIr _ _) (leq_trans rHp' (rankS _)). - exact: nonabelian_Uniqueness pP not_cPP. - by rewrite subsetI pcore_sub. -rewrite {1}defX oX1 /= -[M`_\F]/(gval H) -/P; split=> //. -pose Z q := 'Ohm_1('Z('O_q(H)))%G. -have charZ q: Z q \char H by rewrite 3?gFchar_trans. -have{cycHp'} oZ: {in \pi(H), forall q, #|Z q| = q}. - move=> q piHp; have [-> // | p'q] := eqVneq q p. - have qHq: q.-group 'O_q(H) := pcore_pgroup q H. - have sHqHp': 'O_q(H) \subset 'O_p^'(H) by apply: sub_pcore => r /eqnP->. - rewrite /= (center_idP (abelianS sHqHp' cHp'Hp')). - apply: Ohm1_cyclic_pgroup_prime (cyclicS sHqHp' cycHp') qHq _. - by rewrite -rank_gt0 (rank_Sylow (nilpotent_pcore_Hall q nilH)) p_rank_gt0. -have regZq_dv_q1 A q: - A \subset 'N(H) -> q \in \pi(H) -> semiregular (Z q) A -> #|A| %| q.-1. -- move=> nHA piHq regA. - by rewrite -(oZ q piHq) regular_norm_dvd_pred // (char_norm_trans (charZ q)). -have [FmaxM | {U complU defM exU0}P1maxM] := setUP FP1maxM. - left=> q piHq; have K1: K :=: 1 by apply/eqP; rewrite (trivg_kappa maxM). - have ntU: U :!=: 1 by rewrite (trivg_kappa_compl maxM complU) 2!inE FmaxM. - rewrite K1 sdprodg1 -defH in defM; have [_ mulHU nHU tiHU] := sdprodP defM. - rewrite -mulHU quotientMidl -(exponent_isog (quotient_isog nHU tiHU)). - have [U0 [sU0U <- frobMsU0]] := exU0 ntU; have nHU0 := subset_trans sU0U nHU. - apply: dvdn_trans (exponent_dvdn U0) _; apply: regZq_dv_q1 => // x U0x. - apply/trivgP; rewrite -(Frobenius_reg_ker frobMsU0 U0x) setSI //= -defH. - exact: (char_sub (charZ _)). -have{defM_P1} [[defM defM'] [PmaxM _]] := (defM_P1 P1maxM, setIdP P1maxM). -have [_ mulHK nHK tiHK] := sdprodP defM; have p'K := pi'_p'group s'K sMp. -have coHK: coprime #|H| #|K| by rewrite defH (pnat_coprime (pcore_pgroup _ _)). -have{coHK} coPK: coprime #|P| #|K| := coprimeSg sPH coHK. -have oMH: #|M / H| = #|K|. - by rewrite -mulHK quotientMidl -(card_isog (quotient_isog nHK tiHK)). -pose Ks := 'C_H(K); have prKs: prime #|Ks|. - have [Ms _ [_ _ _ _ [_]]] := Ptype_embedding PmaxM hallK. - by rewrite inE P1maxM -defH; do 2!case. -have sKsP: Ks \subset P. - have sKsM'': Ks \subset M^`(2) by rewrite /Ks defH; case/Ptype_cyclics: hallK. - rewrite (subset_trans sKsM'') 1?der1_min //= -derg1 defM' ?gFnorm //. - by rewrite -mulPHp' quotientMidl quotient_abelian. -have oKs: #|Ks| = p. - apply/eqP; apply: pnatPpi pP (piSg sKsP _). - by rewrite mem_primes prKs cardG_gt0 dvdnn. -have [prHK ntKs]: semiprime H K /\ Ks != 1. - by rewrite /Ks defH; case/Ptype_structure: hallK => // [[_ _ [_ ? _]] _ []]. -have [K_dv_p1 | {regZq_dv_q1}] := altP (@implyP (Ks :==: Z0) (#|K| %| p.-1)). - left=> q piHq; rewrite (dvdn_trans (exponent_dvdn _)) // oMH. - have [eqZqKs | neqZqKs] := eqVneq Ks (Z q). - have def_q: q = p by rewrite -(oZ q piHq) -eqZqKs. - by rewrite def_q K_dv_p1 // eqZqKs def_q. - apply: regZq_dv_q1 => // x Kx; rewrite -(setIidPl (char_sub (charZ q))). - rewrite -setIA prHK {x Kx}// setIC (prime_TIg prKs) //. - have q_pr: prime q by rewrite mem_primes in piHq; case/and3P: piHq. - apply: contra neqZqKs => sKsZq; rewrite eqEsubset sKsZq /=. - by rewrite prime_meetG ?oZ // (setIidPr sKsZq). -rewrite {Z oZ charZ}negb_imply; case/andP; move/eqP=> defKs not_K_dv_p1. -have nPK: K \subset 'N(P) by apply: gFnorm_trans. -have defZP: 'Z(P) = Ks. - apply/eqP; rewrite eqEsubset andbC {1}defKs Ohm_sub subsetI subIset ?sPH //. - have nZPK: K \subset 'N('Z(P)) by apply: gFnorm_trans. - have coZPK: coprime #|'Z(P)| #|K| := coprimeSg (center_sub _) coPK. - rewrite centsC (coprime_odd_faithful_Ohm1 pZP) ?mFT_odd //. - by rewrite /= -/Z0 -defKs centsC subsetIr. -have rPle2: 'r(P) <= 2. - case/setIP: p2maxElemB; case/pnElemP=> _ _ dimB pmaxB. - have Ep2B: [group of B] \in 'E_p^2(P) by apply/pnElemP. - rewrite leqNgt; apply: contra not_K_dv_p1 => rPgt2. - have tiKcP: 'C_K(P) = 1. - apply/trivgP/subsetP=> x => /setIP[Kx cPx]. - apply: contraR ntX1 => ntx; rewrite -subG1. - have [_ _ _ <-] := dprodP defB; rewrite subsetIidl -defKs. - rewrite -[Ks](prHK x) 1?inE ?ntx // (subset_trans sX1P) //=. - by rewrite subsetI sPH sub_cent1. - rewrite (card_isog (quotient1_isog _)) -tiKcP -ker_conj_aut. - rewrite (card_isog (first_isog_loc _ nPK)) /=. - set A := _ @* _; have AutA: A \subset Aut P := Aut_conj_aut _ _. - have solA: solvable A by rewrite morphim_sol ?abelian_sol ?cyclic_abelian. - have oddA: odd #|A| by rewrite morphim_odd ?mFT_odd. - have nnP: p.-narrow P. - apply/implyP=> _; apply/set0Pn; exists [group of B]. - by rewrite inE Ep2B (subsetP (pmaxElemS p (subsetT P))) // inE pmaxB inE. - have [x defK] := cyclicP cycK; have Kx: x \in K by rewrite defK cycle_id. - have nPx := subsetP nPK x Kx; rewrite /A defK morphim_cycle //. - have Axj: conj_aut [group of P] x \in A by apply: mem_morphim. - have [_ _ -> //] := Aut_narrow pP (mFT_odd _) nnP solA AutA oddA. - by rewrite morph_p_elt // (mem_p_elt p'K). -have{rPle2} dimP: logn p #|P| = 3. - have [S [_ <- _] [C cycC]] := mFT_rank2_Sylow_cprod sylP_G rPle2 not_cPP. - case=> defP defZS; congr (logn p #|(_ : {set _})|). - suffices defC: 'Ohm_1(C) = C by rewrite -defC defZS cprod_center_id in defP. - suffices <-: 'Z(P) = C by rewrite defZP (@Ohm1_id _ p) // prime_abelem. - have [_ <- _] := cprodP (center_cprod defP). - by rewrite -defZS (center_idP (cyclic_abelian cycC)) mulSGid ?Ohm_sub. -have oP: #|P| = (p ^ 1.*2.+1)%N by rewrite (card_pgroup pP) dimP. -right; split; rewrite // {}oMH. -have esP: extraspecial P by apply: (p3group_extraspecial pP); rewrite ?dimP. -have defPK: P ><| K = P <*> K by rewrite sdprodEY // coprime_TIg. -have copK: coprime p #|K| by rewrite -oX1 (coprimeSg sX1P). -have [x|] := repr_extraspecial_prime_sdprod_cycle pP esP defPK cycK oP copK. - move/prHK=> defCHx /=; rewrite /= -/P -{1}(setIidPl sPH) -setIA defCHx -/Ks. - by rewrite -defZP setIA setIid. -by rewrite addn1 subn1 (negPf not_K_dv_p1) orbF. -Qed. - -(* A subset of the above, that does not require the non-TI witness. *) -Lemma nonTI_Fitting_facts M : - M \in 'M -> ~~ normedTI 'F(M)^# G M -> - [/\ M \in 'M_'F :|: 'M_'P1, M`_\F = M`_\sigma & M^`(1) \subset 'F(M)]. -Proof. -move=> maxM nonTI; suff: [exists (y | y \notin M), 'F(M) :&: 'F(M) :^ y != 1]. - by case/exists_inP=> y notMy /nonTI_Fitting_structure[] // [-> dMF] _ []. -rewrite -negb_forall_in; apply: contra nonTI => /forall_inP tiF. -apply/normedTI_P; rewrite normD1 setTI gFnorm setD_eq0 subG1. -split=> // [|g _]; first by rewrite (trivg_Fitting (mmax_sol maxM)) mmax_neq1. -by apply: contraR => /tiF; rewrite -setI_eq0 conjD1g -setDIl setD_eq0 subG1. -Qed. - -(* This is B & G, Theorem 15.8, due to Feit and Thompson (1991). *) -(* We handle the non-structural step on l. 5, p. 122 by choosing A not to be *) -(* a q-group, if possible, so that when it turns out to be we know q is the *) -(* only prime in tau2(H). Since this uniqueness does not appear to be used *) -(* later we could also eliminate this complication. *) -(* We also avoid the circularity in proving that A is a q-group and that Q *) -(* is non-abelian by deriving that Q is in U from 14.2(e) rather than 12.13. *) -Theorem tau2_P2type_signalizer M Mstar U K r R H (q := #|K|) : - M \in 'M_'P2 -> kappa_complement M U K -> Mstar \in 'M('C(K)) -> - r.-Sylow(U) R -> H \in 'M('N(R)) -> ~~ \tau2(H)^'.-group H -> - [/\ prime q, \tau2(H) =i (q : nat_pred) & \tau2(M)^'.-group M]. -Proof. -move: Mstar => L P2maxM complU maxCK_L sylR maxNR_H not_t2'H. -have [[PmaxM notP1maxM] [hallU hallK _]] := (setDP P2maxM, complU). -have q_pr: prime q by have [_ _ _ _ []] := Ptype_structure PmaxM hallK. -have [[maxH _] [maxM _]] := (setIdP maxNR_H, setDP PmaxM). -have [maxL sCKL] := setIdP maxCK_L; have hallLs := Msigma_Hall maxL. -have [_ sUHs] := P2type_signalizer P2maxM complU maxCK_L sylR maxNR_H. -set D := H :&: L => defUK [_ sKFD hallD] {r R sylR maxNR_H}. -set uniq_q := _ =i _. -have{not_t2'H} [q1 t2Hq neq_q]: exists2 q1, q1 \in \tau2(H) & q1 = q -> uniq_q. - move: not_t2'H; rewrite negb_and cardG_gt0 all_predC negbK /= has_filter. - set s := filter _ _ => nts. - have mem_s: s =i \tau2(H). - move=> q1; rewrite mem_filter; apply: andb_idr => /= t2q1. - by rewrite (partition_pi_mmax maxH) t2q1 !orbT. - have [all_q | ] := altP (@allP _ (pred1 q) s); last first. - by case/allPn=> q1; rewrite mem_s=> t2q1; move/eqnP=> ne_q1q; exists q1. - have s_q1: head q s \in s by case: (s) nts => // q1 s' _; apply: predU1l. - exists (head q s) => [|def_q q1]; rewrite -mem_s //. - by apply/idP/idP; [apply: all_q | move/eqnP->; rewrite -def_q]. -have [A /= Eq2A Eq2A_H] := ex_tau2Elem hallD t2Hq; rewrite -/D in Eq2A. -have [b'q qmaxA]: q1 \notin \beta(G) /\ A \in 'E*_q1(G). - by have [-> ->] := tau2_not_beta maxH t2Hq. -have [sDH s'HD _] := and3P hallD. -have [sAH abelA dimA] := pnElemP Eq2A_H; have [qA _] := andP abelA. -have [[nsAD _] _ _ _] := tau2_compl_context maxH hallD t2Hq Eq2A. -have cKA: A \subset 'C(K). - have sFD: 'F(D) \subset D := Fitting_sub _; have sFH := subset_trans sFD sDH. - have cFF: abelian 'F(D). - exact: sigma'_nil_abelian maxH sFH (pgroupS sFD s'HD) (Fitting_nil _). - exact: sub_abelian_cent2 cFF (Fitting_max nsAD (pgroup_nil qA)) sKFD. -have sAL: A \subset L := subset_trans cKA sCKL. -pose Ks := 'C_(M`_\sigma)(K). -have [PmaxL hallKs defK]: - [/\ L \in 'M_'P, \kappa(L).-Hall(L) Ks & 'C_(L`_\sigma)(Ks) = K]. -- have [L1 [? _] [defL1 [? _] [? _] _ _]] := Ptype_embedding PmaxM hallK. - suffices ->: L = L1 by []; apply/set1P; rewrite defL1 // in maxCK_L. - by apply/nElemP; exists q; rewrite p1ElemE // !inE subxx eqxx. -have sKLs: K \subset L`_\sigma by rewrite -defK subsetIl. -have sLq: q \in \sigma(L). - by rewrite -pnatE // -pgroupE (pgroupS sKLs) ?pcore_pgroup. -have sLq1: q1 \in \sigma(L). - apply: contraLR sLq => s'Lq1; rewrite -negnK negbK /= -pnatE // -pgroupE. - have s'LA: \sigma(L)^'.-group A by apply: pi_pgroup qA _. - have [E hallE sAE] := Hall_superset (mmax_sol maxL) sAL s'LA. - have EqA_E: A \in 'E_q1^2(E) by apply/pnElemP. - have [[sEL s'E _] t2Lq1] := (and3P hallE, sigma'2Elem_tau2 maxL hallE EqA_E). - have [_ [sCAE _ _] _ _] := tau2_compl_context maxL hallE t2Lq1 EqA_E. - by apply: pgroupS (subset_trans _ sCAE) s'E; rewrite centsC. -have sALs: A \subset L`_\sigma by rewrite sub_Hall_pcore ?(pi_pgroup qA). -have solL: solvable L`_\sigma := solvableS (pcore_sub _ _) (mmax_sol maxL). -pose Q := 'O_q(L)%G; have{solL} [Ds hallDs] := Hall_exists q^' solL. -have sQFL: Q \subset 'F(L) by rewrite -[gval Q]p_core_Fitting pcore_sub. -have [sAFL sylQ]: A \subset 'F(L) /\ q.-Sylow(L) Q. - have [defLF | neqLF] := eqVneq L`_\F L`_\sigma. - split; first by rewrite (subset_trans sALs) // -defLF Fcore_sub_Fitting. - by rewrite Fcore_pcore_Sylow // defLF mem_primes q_pr cardG_gt0 cardSg. - have [_ /(_ _ Ds hallKs neqLF)] := Fcore_structure maxL. - rewrite /= defK -/q -/Q; case=> // _ _ [-> _ nsQ0L] _ [_ _ [_ _ <-] _]. - rewrite subsetI sALs sub_astabQ quotient_cents // (subset_trans sAL) //. - exact: normal_norm nsQ0L. -have{sLq1} neqHL: H :!=: L. - by apply: contraTneq t2Hq => ->; rewrite negb_and negbK /= sLq1. -have def_q1: q1 = q. - have uniqQ: Q \in 'U. - have [_ _ _ [_ uniqQ _] _] := Ptype_structure PmaxL hallKs. - apply/uniq_mmaxP; exists L; case/uniqQ: sylQ => //=; rewrite defK. - by rewrite pi_of_prime ?inE. - apply: contraNeq neqHL => q'q1. - rewrite (eq_uniq_mmax (def_uniq_mmax _ maxL sAL) maxH sAH) //. - rewrite (cent_uniq_Uniqueness uniqQ) ?(rank_abelem abelA) ?dimA //. - rewrite (sub_nilpotent_cent2 (Fitting_nil L)) //. - exact: pnat_coprime (pcore_pgroup _ _) (pi_pgroup qA _). -split=> //; first exact: neq_q. -rewrite {q1 neq_q}def_q1 in qA Eq2A Eq2A_H t2Hq abelA dimA qmaxA b'q. -have{b'q} b'q: q \notin \beta(L) by rewrite -predI_sigma_beta // inE /= sLq. -have P1maxL: L \in 'M_'P1. - apply: contraR b'q => notP1maxL. - by have [_ _ _ _ [|<- //]] := Ptype_structure PmaxL hallKs; apply/setDP. -have nilLs: nilpotent L`_\sigma. - rewrite (sameP (Fcore_eq_Msigma maxL) eqP); apply: contraR b'q => neqLF. - have [_ /(_ _ Ds hallKs neqLF)] := Fcore_structure maxL. - by rewrite /= defK -/q -/Q; case=> // _ [_ _ _ ->] _ _ _. -have defL': L^`(1) = L`_\sigma. - have [Us complUs] := ex_kappa_compl maxL hallKs. - have [_ [|<- _ _ _ _]] := kappa_structure maxL complUs. - by rewrite (trivg_kappa maxL hallKs) //; case/setDP: PmaxL. - suffices ->: Us :=: 1 by rewrite sdprodg1. - by apply/eqP; rewrite (trivg_kappa_compl maxL complUs). -have [ntK sKLs']: K :!=: 1 /\ K \subset L`_\sigma^`(1). - by rewrite -defL' -defK; case/Ptype_cyclics: hallKs. -have [sQL qQ _] := and3P sylQ. -have not_cQQ: ~~ abelian Q. - have sKL: K \subset L := subset_trans sKLs (pcore_sub _ _). - have sKQ: K \subset Q by rewrite (sub_Hall_pcore sylQ) /pgroup ?pnat_id. - have sQLs: Q \subset L`_\sigma by rewrite sub_Hall_pcore ?(pi_pgroup qQ). - have defLs: 'O_q^'(L`_\sigma) * Q = L`_\sigma. - rewrite -(setIidPl sQLs) pcore_setI_normal ?pcore_normal //. - by have [_] := dprodP (nilpotent_pcoreC q^' nilLs); rewrite pcoreNK. - apply: contra ntK => cQQ; rewrite -subG1 /= -(derG1P cQQ) -subsetIidl. - rewrite -(pprod_focal_coprime defLs) ?subsetIidl ?pcore_normal //. - by rewrite coprime_sym (coprimeSg sKQ) ?coprime_pcoreC. -pose X := 'C_A(H`_\sigma)%G. -have [sXA cHsX]: X \subset A /\ X \subset 'C(H`_\sigma) by apply/subsetIP. -have{not_cQQ} oX: #|X| = q. - by have [_ []] := nonabelian_tau2 maxH hallD t2Hq Eq2A qQ not_cQQ. -have neqXK: X :!=: K. - apply: contraNneq neqHL => defX; rewrite (eq_mmax maxH maxL) //. - have [_ <- _ _] := sdprodP (sdprod_sigma maxH hallD). - by rewrite mulG_subG subsetIr (subset_trans _ sCKL) // centsC -defX. -have{neqXK sXA} not_sXM: ~~ (X \subset M). - apply: contra neqXK => sXM; rewrite eqEcard oX leqnn andbT; apply/joing_idPl. - have [[sKM kK _] cKX] := (and3P hallK, subset_trans sXA cKA). - apply: sub_pHall hallK _ (joing_subl _ _) _; last by rewrite join_subG sKM. - by rewrite /= (cent_joinEr cKX) pgroupM {2}/pgroup oX andbb. -have{not_sXM} not_sCUM: ~~ ('C(U) \subset M). - exact: contra (subset_trans (centsS sUHs cHsX)) not_sXM. -apply/pgroupP=> r r_pr _; apply: contra not_sCUM => /= t2Mr. -have [hallUK _ _ _ _] := kappa_compl_context maxM complU. -have [[B Er2B _] [sUKM _]] := (ex_tau2Elem hallUK t2Mr, andP hallUK). -have [[nsBUK _] [sCBUK _ _] _ _ ] := tau2_compl_context maxM hallUK t2Mr Er2B. -apply: subset_trans (centS _) (subset_trans sCBUK sUKM). -have [sBUK /andP[rB _] _] := pnElemP Er2B. -have maxU_UK := Hall_max (pHall_subl (joing_subl _ _) sUKM hallU). -rewrite (normal_sub_max_pgroup maxU_UK) // (pi_pgroup rB) //. -apply: contraL t2Mr; rewrite negb_and negbK /= inE /=. -by case: (r \in _) => //=; move/rank_kappa->. -Qed. - -(* This is B & G, Theorem 15.9, parts (a) and (b), due to D. Sibley and Feit *) -(* and Thompson, respectively. *) -(* We have dropped part (c) because it is not used later, and localizing the *) -(* quantification on r would complicate the proof needlessly. *) -Theorem nonFtype_signalizer_base M x : - M \in 'M -> x \in M`_\sigma^# -> - ~~ ('C[x] \subset M) -> 'N[x] \notin 'M_'F -> - [/\ (*a*) M \in 'M_'F, 'N[x] \in 'M_'P2 - & (*b*) exists2 E : {group gT}, \sigma(M)^'.-Hall(M) E - & cyclic (gval E) /\ [Frobenius M = M`_\sigma ><| E]]. -Proof. -move=> maxM Ms1x not_sCxM notFmaxN; have ell1x := Msigma_ell1 maxM Ms1x. -have [[ntx Ms_x] [y cxy notMy]] := (setD1P Ms1x, subsetPn not_sCxM). -have SMxM: M \in 'M_\sigma[x] by rewrite inE maxM cycle_subG. -have SMxMy: (M :^ y)%G \in 'M_\sigma[x]. - by rewrite inE mmaxJ maxM gen_subG -(normP cxy) /= MsigmaJ conjSg sub1set. -have neq_MyM: M :^ y != M by rewrite (sameP eqP normP) norm_mmax. -have SMx_gt1: #|'M_\sigma[x]| > 1. - by rewrite (cardD1 M) SMxM (cardD1 (M :^ y)%G) inE /= SMxMy neq_MyM. -have [_ [//|uniqN _ t2Nx]] := FT_signalizer_context ell1x. -rewrite inE (negPf notFmaxN) /= => P2maxN /(_ M SMxM)[_ st2NsM _ hallMN]. -pose r := pdiv #[x]; have pixr: r \in \pi(#[x]) by rewrite pi_pdiv order_gt1. -have t2Nr := pnatPpi t2Nx pixr; have sMr := st2NsM r t2Nr. -have [[PmaxN _] [_ s'N_MN _]] := (setDP P2maxN, and3P hallMN). -have [K hallK] := Hall_exists \kappa('N[x]) (sigma_compl_sol hallMN). -have [U hallU] := Hall_exists \kappa('N[x])^' (sigma_compl_sol hallMN). -have hallK_N := subHall_Hall hallMN (@kappa_sigma' _ _) hallK. -have [[sKMN kK _] [sUMN k'U _]] := (and3P hallK, and3P hallU). -have mulUK: U * K = M :&: 'N[x]. - apply/eqP; rewrite eqEcard mulG_subG sUMN sKMN. - rewrite coprime_cardMg ?(p'nat_coprime k'U) //= mulnC. - by rewrite (card_Hall hallU) (card_Hall hallK) partnC ?cardG_gt0. -have complU: kappa_complement 'N[x] U K. - split=> //; last by rewrite mulUK groupP. - apply: (subHall_Hall hallMN) => [p|]; first by case/norP. - rewrite pHallE sUMN /= (card_Hall hallU) eq_sym; apply/eqP. - apply: eq_in_partn => p piMNp; rewrite inE /= negb_or /=. - by rewrite [~~ _](pnatPpi s'N_MN). -have prK: prime #|K| by case/Ptype_structure: hallK_N => // _ _ _ _ []. -have ntK: K :!=: 1 by rewrite -cardG_gt1 prime_gt1. -have [maxN _] := setDP PmaxN. -have [defUK cUU regUK]: [/\ U ><| K = M :&: 'N[x], abelian U & 'C_U(K) = 1]. - have [_ defM _ regUK -> //] := kappa_compl_context maxN complU. - have [[_ UK _ defUK] _ _ _] := sdprodP defM. - by rewrite (cent_semiregular regUK) // defUK; case/sdprodP: defUK => _ <-. -have [[R sylR] [s'Nr rrN]] := (Sylow_exists r (M :&: 'N[x]), andP t2Nr). -have [[sRMN rR _] sylR_N] := (and3P sylR, subHall_Sylow hallMN s'Nr sylR). -have [nsUMN _ _ nUK _] := sdprod_context defUK. -have [[sRM sRN] [sKM _]] := (subsetIP sRMN, subsetIP sKMN). -have sRU: R \subset U. - rewrite (sub_normal_Hall hallU nsUMN sRMN) (pi_pgroup rR) //. - by apply: contraL rrN; move/rank_kappa->. -have sNRM: 'N(R) \subset M. - apply: (norm_noncyclic_sigma maxM sMr rR sRM). - rewrite (odd_pgroup_rank1_cyclic rR) ?mFT_odd //. - by rewrite (p_rank_Sylow sylR_N) (eqnP rrN). -have sylR_U := pHall_subl sRU sUMN sylR. -have maxNRM: M \in 'M('N(R)) by rewrite inE maxM. -have [L maxCK_L] := mmax_exists (mFT_cent_proper ntK). -have FmaxM: M \in 'M_'F; last split=> //. - by have [] := P2type_signalizer P2maxN complU maxCK_L sylR_U maxNRM. -have nilMs: nilpotent M`_\sigma by rewrite notP1type_Msigma_nil ?FmaxM. -have sMsF: M`_\sigma \subset 'F(M) by rewrite Fitting_max ?pcore_normal. -have defR: R :=: 'O_r(U) := nilpotent_Hall_pcore (abelian_nil cUU) sylR_U. -have nRK: K \subset 'N(R) by rewrite defR gFnorm_trans. -have ntR: R :!=: 1. - rewrite -rank_gt0 (rank_Sylow sylR_N) p_rank_gt0. - by rewrite (partition_pi_mmax maxN) t2Nr !orbT. -have not_nilRK: ~~ nilpotent (R <*> K). - apply: contra ntR => nilRK; rewrite -subG1 -regUK subsetI sRU. - rewrite (sub_nilpotent_cent2 nilRK) ?joing_subl ?joing_subr //. - by rewrite (coprimegS sRU) ?(pnat_coprime kK). -have{not_nilRK} not_sKMs: ~~ (K \subset M`_\sigma). - apply: contra not_nilRK => sKMs; apply: nilpotentS nilMs. - by rewrite join_subG (sub_Hall_pcore (Msigma_Hall maxM)) // (pi_pgroup rR). -have s'MK: \sigma(M)^'.-group K. - rewrite /pgroup pnatE //; apply: contra not_sKMs; rewrite /= -pnatE // => sK. - by rewrite (sub_Hall_pcore (Msigma_Hall maxM)). -have [E hallE sKE] := Hall_superset (mmax_sol maxM) sKM s'MK. -have [[E1 hallE1] [E3 hallE3]] := ex_tau13_compl hallE. -have [E2 hallE2 complEi] := ex_tau2_compl hallE hallE1 hallE3. -have [[_ t1E1 _] [sEM _]] := (and3P hallE1, andP hallE). -have E2_1: E2 :=: 1. - have [sE2E t2E2 _] := and3P hallE2. - rewrite -(setIidPl sE2E) coprime_TIg ?(pnat_coprime t2E2 (pgroupS sEM _)) //. - apply: contraR ntR => not_t2'M. - have:= tau2_P2type_signalizer P2maxN complU maxCK_L sylR_U maxNRM not_t2'M. - case=> _ _ t2'N; rewrite -(setIidPl sRN) coprime_TIg //. - by rewrite (pnat_coprime (pi_pgroup rR t2Nr)). -have E3_1: E3 :=: 1. - have ntX: 'F(M) :&: 'F(M) :^ y != 1. - apply/trivgPn; exists x; rewrite // inE mem_conjg !(subsetP sMsF) //. - by rewrite /conjg invgK mulgA (cent1P cxy) mulgK. - have [_ _ _ defE _] := nonTI_Fitting_structure maxM notMy ntX. - by case/defE: complEi. -have [cycE defE]: cyclic E /\ E :=: E1. - have [_ _ [cycE1 _] [<- _] _] := sigma_compl_context maxM complEi. - by rewrite E2_1 E3_1 !sdprod1g. -have [ntMs ntE] := (Msigma_neq1 maxM, subG1_contra sKE ntK). -have defM := sdprod_sigma maxM hallE. -exists E => //; split=> //; apply/Frobenius_semiregularP=> // z Ez. -have{Ez} [ntz szE1] := setD1P Ez; rewrite defE -cycle_subG in szE1. -pose q := pdiv #[z]; have pizq: q \in \pi(#[z]) by rewrite pi_pdiv order_gt1. -have szM: <[z]> \subset M by rewrite (subset_trans _ sEM) ?defE. -have [_ k'M] := setIdP FmaxM; have k'q := pnatPpi k'M (piSg szM pizq). -have t1q := pnatPpi t1E1 (piSg szE1 pizq). -move: pizq; rewrite -p_rank_gt0 => /p_rank_geP[Z]. -rewrite /= -(setIidPr szM) pnElemI -setIdE => /setIdP[EqZ sZz]. -apply: contraNeq k'q => ntCMsx /=. -rewrite unlock 3!inE /= t1q; apply/exists_inP; exists Z => //. -by rewrite (subG1_contra _ ntCMsx) ?setIS //= -cent_cycle centS. -Qed. - -End Section15. diff --git a/mathcomp/odd_order/BGsection16.v b/mathcomp/odd_order/BGsection16.v deleted file mode 100644 index ca73c4b..0000000 --- a/mathcomp/odd_order/BGsection16.v +++ /dev/null @@ -1,1368 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq div path fintype. -From mathcomp -Require Import bigop finset prime fingroup morphism perm automorphism quotient. -From mathcomp -Require Import action gproduct gfunctor pgroup cyclic center commutator. -From mathcomp -Require Import gseries nilpotent sylow abelian maximal hall frobenius. -From mathcomp -Require Import BGsection1 BGsection2 BGsection3 BGsection4 BGsection5. -From mathcomp -Require Import BGsection6 BGsection7 BGsection9 BGsection10 BGsection12. -From mathcomp -Require Import BGsection13 BGsection14 BGsection15. - -(******************************************************************************) -(* This file covers B & G, section 16; it summarises all the results of the *) -(* local analysis. Some of the definitions of B & G have been adapted to fit *) -(* in beter with Peterfalvi, section 8, dropping unused properties and adding *) -(* a few missing ones. This file also defines the following: *) -(* of_typeF M U <-> M = M`_\F ><| U is of type F, in the sense of *) -(* Petervalvi (8.1) rather than B & G section 14. *) -(* is_typeF_complement M U U0 <-> U0 is a subgroup of U with the same *) -(* exponent as U, such that M`_\F ><| U0 is a Frobenius *) -(* group; this corresponds to Peterfalvi (8.1)(c). *) -(* is_typeF_inertia M U U1 <-> U1 <| U is abelian and contains 'C_U[x] for *) -(* all x in M`_\F^#, and thus the inertia groups of all *) -(* nonprincipal irreducible characters of M`_\F; this *) -(* corresponds to Peterfalvi (8.1)(b). *) -(* of_typeI M U <-> M = M`_\F ><| U is of type I, in the sense of *) -(* Peterfalvi (8.3); this definition is almost identical *) -(* to B & G conditions (Ii) - (Iv), except that (Iiv) is *) -(* dropped, as is the condition p \in \pi* in (Iv)(c). *) -(* Also, the condition 'O_p^'(M) cyclic, present in both *) -(* B & G and Peterfalvi, is weakened to 'O_p^'(M`_\F) *) -(* cyclic, because B & G, Theorem 15.7 only proves the *) -(* weaker statement, and we did not manage to improve it. *) -(* This appears to be a typo in B & G that was copied *) -(* over to Petrfalvi (8.3). It is probably no consequence *) -(* because (8.3) is only used in (12.6) and (12.10) and *) -(* neither use the assumption that 'O_p^'(M) is cyclic. *) -(* For defW : W1 \x W2 = W we also define: *) -(* of_typeP M U defW <-> M = M`_\F ><| U ><| W1 is of type P, in the sense of *) -(* Peterfalvi (8.4) rather than B & G section 14, where *) -(* (8.4)(d,e) hold for W and W2 (i.e., W2 = C_M^(1)(W1)). *) -(* of_typeII_IV M U defW <-> M = M`_\F ><| U ><| W1 is of type II, III, or IV *) -(* in the sense of Peterfalvi (8.6)(a). This is almost *) -(* exactly the contents of B & G, (T1)-(T7), except that *) -(* (T6) is dropped, and 'C_(M`_\F)(W1) \subset M^`(2) is *) -(* added (PF, (8.4)(d) and B & G, Theorem C(3)). *) -(* of_typeII M U defW <-> M = M`_\F ><| U ><| W1 is of type II in the sense *) -(* of Peterfalvi (8.6); this differs from B & G by *) -(* dropping the rank 2 clause in IIiii and replacing IIv *) -(* by B(2)(3) (note that IIv is stated incorrectly: M' *) -(* should be M'^#). *) -(* of_typeIII M U defW <-> M = M`_\F ><| U ><| W1 is of type III in the sense *) -(* of Peterfalvi (8.6). *) -(* of_typeIV M U defW <-> M = M`_\F ><| U ><| W1 is of type IV in the sense *) -(* of Peterfalvi (8.6). *) -(* of_typeV M U defW <-> U = 1 and M = M`_\F ><| W1 is of type V in the *) -(* sense of Peterfalvi (8.7); this differs from B & G (V) *) -(* dropping the p \in \pi* condition in clauses (V)(b) *) -(* and (V)(c). *) -(* exists_typeP spec <-> spec U defW holds for some groups U, W, W1 and W2 *) -(* such that defW : W1 \x W2 = W; spec will be one of *) -(* (of_typeP M), (of_typeII_IV M), (of_typeII M), etc. *) -(* FTtype_spec i M <-> M is of type i, for 0 < i <= 5, in the sense of the *) -(* predicates above, for the appropriate complements to *) -(* M`_\F and M^`(1). *) -(* FTtype M == the type of M, in the sense above, when M is a maximal *) -(* subgroup of G (this is an integer i between 1 and 5). *) -(* M`_\s == an alternative, combinatorial definition of M`_\sigma *) -(* := M`_\F if M is of type I or II, else M^`(1) *) -(* 'A1(M) == the "inner Dade support" of a maximal group M, as *) -(* defined in Peterfalvi (8.10). *) -(* := (M`_\s)^# *) -(* 'A(M) == the "Dade support" of M as defined in Peterfalvi (8.10) *) -(* (this differs from B & G by excluding 1). *) -(* 'A0(M) == the "outer Dade support" of M as defined in Peterfalvi *) -(* (8.10) (this differs from B & G by excluding 1). *) -(* 'M^G == a transversal of the conjugacy classes of 'M. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope. - -Section GeneralDefinitions. - -Variable gT : finGroupType. -Implicit Types V W X : {set gT}. - -End GeneralDefinitions. - -Section Definitions. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). - -Implicit Types M U V W X : {set gT}. - -Definition is_typeF_inertia M U (H := M`_\F) U1 := - [/\ U1 <| U, abelian U1 & {in H^#, forall x, 'C_U[x] \subset U1}]. - -Definition is_typeF_complement M U (H := M`_\F) U0 := - [/\ U0 \subset U, exponent U0 = exponent U & [Frobenius H <*> U0 = H ><| U0]]. - -Definition of_typeF M U (H := M`_\F) := - [/\ (*a*) [/\ H != 1, U :!=: 1 & H ><| U = M], - (*b*) exists U1 : {group gT}, is_typeF_inertia M U U1 - & (*c*) exists U0 : {group gT}, is_typeF_complement M U U0]. - -Definition of_typeI M (H := M`_\F) U := - of_typeF M U - /\ [\/ (*a*) normedTI H^# G M, - (*b*) abelian H /\ 'r(H) = 2 - | (*c*) {in \pi(H), forall p, exponent U %| p.-1} - /\ (exists2 p, p \in \pi(H) & cyclic 'O_p^'(H))]. - -Section Ptypes. - -Variables M U W W1 W2 : {set gT}. -Let H := M`_\F. -Let M' := M^`(1). -Implicit Type defW : W1 \x W2 = W. - -Definition of_typeP defW := - [/\ (*a*) [/\ cyclic W1, Hall M W1, W1 != 1 & M' ><| W1 = M], - (*b*) [/\ nilpotent U, U \subset M', W1 \subset 'N(U) & H ><| U = M'], - (*c*) [/\ ~~ cyclic H, M^`(2) \subset 'F(M), H * 'C_M(H) = 'F(M) - & 'F(M) \subset M'], - (*d*) [/\ cyclic W2, W2 != 1, W2 \subset H, W2 \subset M^`(2) - & {in W1^#, forall x, 'C_M'[x] = W2}] - & (*e*) normedTI (W :\: (W1 :|: W2)) G W]. - -Definition of_typeII_IV defW := - [/\ of_typeP defW, U != 1, prime #|W1| & normedTI 'F(M)^# G M]. - -Definition of_typeII defW := - [/\ of_typeII_IV defW, abelian U, ~~ ('N(U) \subset M), - of_typeF M' U & M'`_\F = H]. - -Definition of_typeIII defW := - [/\ of_typeII_IV defW, abelian U & 'N(U) \subset M]. - -Definition of_typeIV defW := - [/\ of_typeII_IV defW, ~~ abelian U & 'N(U) \subset M]. - -Definition of_typeV defW := - [/\ of_typeP defW /\ U = 1 - & [\/ (*a*) normedTI H^# G M, - (*b*) exists2 p, p \in \pi(H) & #|W1| %| p.-1 /\ cyclic 'O_p^'(H) - | (*c*) exists2 p, p \in \pi(H) - & [/\ #|'O_p(H)| = (p ^ 3)%N, #|W1| %| p.+1 & cyclic 'O_p^'(H)]]]. - -End Ptypes. - -CoInductive exists_typeP (spec : forall U W W1 W2, W1 \x W2 = W -> Prop) : Prop - := FTtypeP_Spec (U W W1 W2 : {group gT}) defW of spec U W W1 W2 defW. - -Definition FTtype_spec i M := - match i with - | 1%N => exists U : {group gT}, of_typeI M U - | 2 => exists_typeP (of_typeII M) - | 3 => exists_typeP (of_typeIII M) - | 4 => exists_typeP (of_typeIV M) - | 5 => exists_typeP (of_typeV M) - | _ => False - end. - -Definition FTtype M := - if \kappa(M)^'.-group M then 1%N else - if M`_\sigma != M^`(1) then 2 else - if M`_\F == M`_\sigma then 5 else - if abelian (M`_\sigma / M`_\F) then 3 else 4. - -Lemma FTtype_range M : 0 < FTtype M <= 5. -Proof. by rewrite /FTtype; do 4!case: ifP => // _. Qed. - -Definition FTcore M := if 0 < FTtype M <= 2 then M`_\F else M^`(1). -Fact FTcore_is_group M : group_set (FTcore M). -Proof. by rewrite [group_set _]fun_if !groupP if_same. Qed. -Canonical Structure FTcore_group M := Group (FTcore_is_group M). - -Definition FTsupport1 M := (FTcore M)^#. - -Let FTder M := M^`(FTtype M != 1%N). - -Definition FTsupport M := \bigcup_(x in FTsupport1 M) 'C_(FTder M)[x]^#. - -Definition FTsupport0 M (pi := \pi(FTder M)) := - FTsupport M :|: [set x in M | ~~ pi.-elt x & ~~ pi^'.-elt x]. - -Definition mmax_transversal U := orbit_transversal 'JG U 'M. - -End Definitions. - -Notation "M `_ \s" := (FTcore M) (at level 3, format "M `_ \s") : group_scope. -Notation "M `_ \s" := (FTcore_group M) : Group_scope. - -Notation "''A1' ( M )" := (FTsupport1 M) - (at level 8, format "''A1' ( M )") : group_scope. - -Notation "''A' ( M )" := (FTsupport M) - (at level 8, format "''A' ( M )") : group_scope. - -Notation "''A0' ( M )" := (FTsupport0 M) - (at level 8, format "''A0' ( M )") : group_scope. - -Notation "''M^' G" := (mmax_transversal G) - (at level 3, format "''M^' G") : group_scope. - -Section Section16. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). -Implicit Types p q q_star r : nat. -Implicit Types x y z : gT. -Implicit Types A E H K L M Mstar N P Q Qstar R S T U V W X Y Z : {group gT}. - -(* Structural properties of the M`_\s definition. *) -Lemma FTcore_char M : M`_\s \char M. -Proof. by rewrite /FTcore; case: ifP; rewrite gFchar. Qed. - -Lemma FTcore_normal M : M`_\s <| M. -Proof. by rewrite char_normal ?FTcore_char. Qed. - -Lemma FTcore_norm M : M \subset 'N(M`_\s). -Proof. by rewrite char_norm ?FTcore_char. Qed. - -Lemma FTcore_sub M : M`_\s \subset M. -Proof. by rewrite char_sub ?FTcore_char. Qed. - -Lemma FTcore_type1 M : FTtype M == 1%N -> M`_\s = M`_\F. -Proof. by rewrite /M`_\s => /eqP->. Qed. - -Lemma FTcore_type2 M : FTtype M == 2 -> M`_\s = M`_\F. -Proof. by rewrite /M`_\s => /eqP->. Qed. - -Lemma FTcore_type_gt2 M : FTtype M > 2 -> M`_\s = M^`(1). -Proof. by rewrite /M`_\s => /subnKC <-. Qed. - -Lemma FTsupp1_type1 M : FTtype M == 1%N -> 'A1(M) = M`_\F^#. -Proof. by move/FTcore_type1 <-. Qed. - -Lemma FTsupp1_type2 M : FTtype M == 2 -> 'A1(M) = M`_\F^#. -Proof. by move/FTcore_type2 <-. Qed. - -Lemma FTsupp1_type_gt2 M : FTtype M > 2 -> 'A1(M) = M^`(1)^#. -Proof. by move/FTcore_type_gt2 <-. Qed. - -(* This section covers the characterization of the F, P, P1 and P2 types of *) -(* maximal subgroups summarized at the top of p. 125. in B & G. *) -Section KappaClassification. - -Variables M U K : {group gT}. -Hypotheses (maxM : M \in 'M) (complU : kappa_complement M U K). - -Remark trivgFmax : (M \in 'M_'F) = (K :==: 1). -Proof. by rewrite (trivg_kappa maxM); case: complU. Qed. - -Remark trivgPmax : (M \in 'M_'P) = (K :!=: 1). -Proof. by rewrite inE trivgFmax maxM andbT. Qed. - -Remark FmaxP : reflect (K :==: 1 /\ U :!=: 1) (M \in 'M_'F). -Proof. -rewrite (trivg_kappa_compl maxM complU) 2!inE. -have [_ hallK _] := complU; rewrite (trivg_kappa maxM hallK). -by apply: (iffP idP) => [-> | []]. -Qed. - -Remark P1maxP : reflect (K :!=: 1 /\ U :==: 1) (M \in 'M_'P1). -Proof. -rewrite (trivg_kappa_compl maxM complU) inE -trivgPmax. -by apply: (iffP idP) => [|[] //]; case/andP=> ->. -Qed. - -Remark P2maxP : reflect (K :!=: 1 /\ U :!=: 1) (M \in 'M_'P2). -Proof. -rewrite (trivg_kappa_compl maxM complU) -trivgPmax. -by apply: (iffP setDP) => [] []. -Qed. - -End KappaClassification. - -(* This section covers the combinatorial statements of B & G, Lemma 16.1. It *) -(* needs to appear before summary theorems A-E because we are following *) -(* Peterfalvi in anticipating the classification in the definition of the *) -(* kernel sets A1(M), A(M) and A0(M). The actual correspondence between the *) -(* combinatorial classification and the mathematical description, i.e., the *) -(* of_typeXX predicates, will be given later. *) -Section FTtypeClassification. - -Variable M : {group gT}. -Hypothesis maxM : M \in 'M. - -Lemma kappa_witness : - exists UK : {group gT} * {group gT}, kappa_complement M UK.1 UK.2. -Proof. -have [K hallK] := Hall_exists \kappa(M) (mmax_sol maxM). -by have [U complU] := ex_kappa_compl maxM hallK; exists (U, K). -Qed. - -(* This is B & G, Lemma 16.1(a). *) -Lemma FTtype_Fmax : (M \in 'M_'F) = (FTtype M == 1%N). -Proof. -by rewrite inE maxM /FTtype; case: (_.-group M) => //; do 3!case: ifP => // _. -Qed. - -Lemma FTtype_Pmax : (M \in 'M_'P) = (FTtype M != 1%N). -Proof. by rewrite inE maxM andbT FTtype_Fmax. Qed. - -(* This is B & G, Lemma 16.1(b). *) -Lemma FTtype_P2max : (M \in 'M_'P2) = (FTtype M == 2). -Proof. -have [[U K] /= complU] := kappa_witness. -rewrite (sameP (P2maxP maxM complU) andP) -(trivgFmax maxM complU) FTtype_Fmax. -have [-> // | notMtype1] := altP eqP. -have ntK: K :!=: 1 by rewrite -(trivgFmax maxM complU) FTtype_Fmax. -have [_ [//|defM' _] _ _ _] := kappa_structure maxM complU. -do [rewrite /FTtype; case: ifP => // _] in notMtype1 *. -rewrite -cardG_gt1 eqEcard Msigma_der1 //= -(sdprod_card defM') -ltnNge. -rewrite -(@ltn_pmul2l #|M`_\sigma|) ?cardG_gt0 //= muln1. -by case: leqP => // _; do 2!case: ifP=> //. -Qed. - -(* This covers the P1 part of B & G, Lemma 16.1 (c) and (d). *) -Lemma FTtype_P1max : (M \in 'M_'P1) = (2 < FTtype M <= 5). -Proof. -rewrite 2!ltn_neqAle -!andbA FTtype_range andbT eq_sym -FTtype_P2max. -rewrite eq_sym -FTtype_Pmax in_setD inE. -by case: (M \in _); rewrite ?andbT ?andbF ?negbK. -Qed. - -Lemma Msigma_eq_der1 : M \in 'M_'P1 -> M`_\sigma = M^`(1). -Proof. -have [[U K] /= complU] := kappa_witness. -case/(P1maxP maxM complU)=> ntK; move/eqP=> U1. -by have [_ [//|<- _] _ _ _] := kappa_structure maxM complU; rewrite U1 sdprodg1. -Qed. - -Lemma def_FTcore : M`_\s = M`_\sigma. -Proof. -rewrite /FTcore -mem_iota 2!inE -FTtype_Fmax -FTtype_P2max. -have [notP1maxM |] := ifPn. - by apply/Fcore_eq_Msigma; rewrite ?notP1type_Msigma_nil. -case/norP=> notFmaxM; rewrite inE andbC inE maxM notFmaxM negbK => P1maxM. -by rewrite Msigma_eq_der1. -Qed. - -(* Other relations between the 'core' groups. *) - -Lemma FTcore_sub_der1 : M`_\s \subset M^`(1)%g. -Proof. by rewrite def_FTcore Msigma_der1. Qed. - -Lemma Fcore_sub_FTcore : M`_\F \subset M`_\s. -Proof. by rewrite def_FTcore Fcore_sub_Msigma. Qed. - -Lemma mmax_Fcore_neq1 : M`_\F != 1. -Proof. by have [[]] := Fcore_structure maxM. Qed. - -Lemma mmax_Fitting_neq1 : 'F(M) != 1. -Proof. exact: subG1_contra (Fcore_sub_Fitting M) mmax_Fcore_neq1. Qed. - -Lemma FTcore_neq1 : M`_\s != 1. -Proof. exact: subG1_contra Fcore_sub_FTcore mmax_Fcore_neq1. Qed. - -Lemma norm_mmax_Fcore : 'N(M`_\F) = M. -Proof. exact: mmax_normal (gFnormal _ _) mmax_Fcore_neq1. Qed. - -Lemma norm_FTcore : 'N(M`_\s) = M. -Proof. exact: mmax_normal (FTcore_normal _) FTcore_neq1. Qed. - -Lemma norm_mmax_Fitting : 'N('F(M)) = M. -Proof. exact: mmax_normal (gFnormal _ _) mmax_Fitting_neq1. Qed. - -(* This is B & G, Lemma 16.1(f). *) -Lemma Fcore_eq_FTcore : reflect (M`_\F = M`_\s) (FTtype M \in pred3 1%N 2 5). -Proof. -rewrite /FTcore -mem_iota 3!inE orbA; case type12M: (_ || _); first by left. -move: type12M FTtype_P1max; rewrite /FTtype; do 2![case: ifP => // _] => _. -rewrite !(fun_if (leq^~ 5)) !(fun_if (leq 3)) !if_same /= => P1maxM. -rewrite Msigma_eq_der1 // !(fun_if (eq_op^~ 5)) if_same. -by rewrite [if _ then _ else _]andbT; apply: eqP. -Qed. - -(* This is the second part of B & G, Lemma 16.1(c). *) -Lemma Fcore_neq_FTcore : (M`_\F != M`_\s) = (FTtype M \in pred2 3 4). -Proof. -have:= FTtype_range M; rewrite -mem_iota (sameP eqP Fcore_eq_FTcore). -by do 5!case/predU1P=> [-> //|]. -Qed. - -Lemma FTcore_eq_der1 : FTtype M > 2 -> M`_\s = M^`(1). -Proof. -move=> FTtype_gt2; rewrite def_FTcore Msigma_eq_der1 // FTtype_P1max. -by rewrite FTtype_gt2; case/andP: (FTtype_range M). -Qed. - -End FTtypeClassification. - -(* Internal automorphism. *) -Lemma FTtypeJ M x : FTtype (M :^ x) = FTtype M. -Proof. -rewrite /FTtype (eq_p'group _ (kappaJ _ _)) pgroupJ MsigmaJ FcoreJ derJ. -rewrite !(can_eq (conjsgK x)); do 4!congr (if _ then _ else _). -rewrite -quotientInorm normJ -conjIg /= setIC -{1 3}(setIidPr (normG M`_\F)). -rewrite -!morphim_conj -morphim_quotm ?normalG //= => nsMFN. -by rewrite injm_abelian /= ?im_quotient // injm_quotm ?injm_conj. -Qed. - -Lemma FTcoreJ M x : (M :^ x)`_\s = M`_\s :^ x. -Proof. by rewrite /FTcore FTtypeJ FcoreJ derJ; case: ifP. Qed. - -Lemma FTsupp1J M x : 'A1(M :^ x) = 'A1(M) :^ x. -Proof. by rewrite conjD1g -FTcoreJ. Qed. - -Lemma FTsuppJ M x : 'A(M :^ x) = 'A(M) :^ x. -Proof. -rewrite -bigcupJ /'A(_) FTsupp1J big_imset /=; last exact: in2W (conjg_inj x). -by apply: eq_bigr => y _; rewrite FTtypeJ derJ cent1J -conjIg conjD1g. -Qed. - -Lemma FTsupp0J M x : 'A0(M :^ x) = 'A0(M) :^ x. -Proof. -apply/setP=> y; rewrite mem_conjg !inE FTsuppJ !mem_conjg; congr (_ || _ && _). -by rewrite FTtypeJ !p_eltJ derJ /= cardJg. -Qed. - -(* Inclusion/normality of class function supports. *) - -Lemma FTsupp_sub0 M : 'A(M) \subset 'A0(M). -Proof. exact: subsetUl. Qed. - -Lemma FTsupp0_sub M : 'A0(M) \subset M^#. -Proof. -rewrite subUset andbC subsetD1 setIdE subsetIl !inE p_elt1 andbF /=. -by apply/bigcupsP=> x _; rewrite setSD ?subIset ?der_sub. -Qed. - -Lemma FTsupp_sub M : 'A(M) \subset M^#. -Proof. exact: subset_trans (FTsupp_sub0 M) (FTsupp0_sub M). Qed. - -Lemma FTsupp1_norm M : M \subset 'N('A1(M)). -Proof. by rewrite normD1 (normal_norm (FTcore_normal M)). Qed. - -Lemma FTsupp_norm M : M \subset 'N('A(M)). -Proof. -apply/subsetP=> y My; rewrite inE -bigcupJ; apply/bigcupsP=> x A1x. -rewrite (bigcup_max (x ^ y)) ?memJ_norm ?(subsetP (FTsupp1_norm M)) //. -by rewrite conjD1g conjIg cent1J (normsP _ y My) ?gFnorm. -Qed. - -Lemma FTsupp0_norm M : M \subset 'N('A0(M)). -Proof. -rewrite normsU ?FTsupp_norm // setIdE normsI //. -by apply/normsP=> x _; apply/setP=> y; rewrite mem_conjg !inE !p_eltJ. -Qed. - -Section MmaxFTsupp. -(* Support inclusions that depend on the maximality of M. *) - -Variable M : {group gT}. -Hypothesis maxM : M \in 'M. - -Lemma FTsupp1_sub : 'A1(M) \subset 'A(M). -Proof. -apply/subsetP=> x A1x; apply/bigcupP; exists x => //. -have [ntx Ms_x] := setD1P A1x; rewrite 3!inE ntx cent1id (subsetP _ x Ms_x) //. -by case: (~~ _); rewrite ?FTcore_sub_der1 ?FTcore_sub. -Qed. - -Lemma FTsupp1_sub0 : 'A1(M) \subset 'A0(M). -Proof. exact: subset_trans FTsupp1_sub (FTsupp_sub0 M). Qed. - -Lemma FTsupp1_neq0 : 'A1(M) != set0. -Proof. by rewrite setD_eq0 subG1 FTcore_neq1. Qed. - -Lemma FTsupp_neq0 : 'A(M) != set0. -Proof. -by apply: contraNneq FTsupp1_neq0 => AM_0; rewrite -subset0 -AM_0 FTsupp1_sub. -Qed. - -Lemma FTsupp0_neq0 : 'A0(M) != set0. -Proof. -by apply: contraNneq FTsupp_neq0 => A0M_0; rewrite -subset0 -A0M_0 FTsupp_sub0. -Qed. - -Lemma Fcore_sub_FTsupp1 : M`_\F^# \subset 'A1(M). -Proof. exact: setSD (Fcore_sub_FTcore maxM). Qed. - -Lemma Fcore_sub_FTsupp : M`_\F^# \subset 'A(M). -Proof. exact: subset_trans Fcore_sub_FTsupp1 FTsupp1_sub. Qed. - -Lemma Fcore_sub_FTsupp0 : M`_\F^# \subset 'A0(M). -Proof. exact: subset_trans Fcore_sub_FTsupp1 FTsupp1_sub0. Qed. - -Lemma Fitting_sub_FTsupp : 'F(M)^# \subset 'A(M). -Proof. -pose pi := \pi(M`_\F); have nilF := Fitting_nil M. -have [U defF]: {U : {group gT} | M`_\F \x U = 'F(M)}. - have hallH := pHall_subl (Fcore_sub_Fitting M) (gFsub _ _) (Fcore_Hall M). - exists 'O_pi^'('F(M))%G; rewrite (nilpotent_Hall_pcore nilF hallH). - exact: nilpotent_pcoreC. -apply/subsetP=> xy /setD1P[ntxy Fxy]; apply/bigcupP. -have [x [y [Hx Vy Dxy _]]] := mem_dprod defF Fxy. -have [z [ntz Hz czxy]]: exists z, [/\ z != 1%g, z \in M`_\F & x \in 'C[z]]. - have [-> | ntx] := eqVneq x 1%g; last by exists x; rewrite ?cent1id. - by have /trivgPn[z ntz] := mmax_Fcore_neq1 maxM; exists z; rewrite ?group1. -exists z; first by rewrite !inE ntz (subsetP (Fcore_sub_FTcore maxM)). -rewrite 3!inE ntxy {2}Dxy groupMl //= andbC (subsetP _ y Vy) //=; last first. - by rewrite sub_cent1 (subsetP _ _ Hz) // centsC; have [] := dprodP defF. -rewrite -FTtype_Pmax // (subsetP _ xy Fxy) //. -case MtypeP: (M \in _); last exact: gFsub. -by have [_ _ _ ->] := Fitting_structure maxM. -Qed. - -Lemma Fitting_sub_FTsupp0 : 'F(M)^# \subset 'A0(M). -Proof. exact: subset_trans Fitting_sub_FTsupp (FTsupp_sub0 M). Qed. - -Lemma FTsupp_eq1 : (2 < FTtype M)%N -> 'A(M) = 'A1(M). -Proof. -move=> typeMgt2; rewrite /'A(M) -(subnKC typeMgt2) /= -FTcore_eq_der1 //. -apply/setP=> y; apply/bigcupP/idP=> [[x A1x /setD1P[nty /setIP[Ms_y _]]] | A1y]. - exact/setD1P. -by exists y; rewrite // inE in_setI cent1id andbT -in_setD. -Qed. - -End MmaxFTsupp. - -Section SingleGroupSummaries. - -Variables M U K : {group gT}. -Hypotheses (maxM : M \in 'M) (complU : kappa_complement M U K). - -Let Kstar := 'C_(M`_\sigma)(K). - -Theorem BGsummaryA : - [/\ (*1*) [/\ M`_\sigma <| M, \sigma(M).-Hall(M) M`_\sigma & - \sigma(M).-Hall(G) M`_\sigma], - (*2*) \kappa(M).-Hall(M) K /\ cyclic K, - (*3*) [/\ U \in [complements to M`_\sigma <*> K in M], - K \subset 'N(U), - M`_\sigma <*> U <| M, - U <| U <*> K - & M`_\sigma * U * K = M], - (*4*) {in K^#, forall k, 'C_U[k] = 1} - & - [/\ (*5*) Kstar != 1 /\ {in K^#, forall k, K \x Kstar = 'C_M[k]}, - (*6*) [/\ M`_\F != 1, M`_\F \subset M`_\sigma, M`_\sigma \subset M^`(1), - M^`(1) \proper M & nilpotent (M^`(1) / M`_\F)], - (*7*) [/\ M^`(2) \subset 'F(M), M`_\F * 'C_M(M`_\F) = 'F(M) - & K :!=: 1 -> 'F(M) \subset M^`(1)] - & (*8*) M`_\F != M`_\sigma -> - [/\ U :=: 1, normedTI 'F(M)^# G M & prime #|K| ]]]. -Proof. -have [hallU hallK _] := complU; split. -- by rewrite pcore_normal Msigma_Hall // Msigma_Hall_G. -- by have [[]] := kappa_structure maxM complU. -- have [_ defM _ _ _] := kappa_compl_context maxM complU. - have [[_ UK _ defUK]] := sdprodP defM; rewrite defUK. - have [nsKUK _ mulUK nUK _] := sdprod_context defUK. - rewrite -mulUK mulG_subG mulgA => mulMsUK /andP[nMsU nMsK] _. - rewrite (norm_joinEr nUK) mulUK; split=> //. - rewrite inE coprime_TIg /= norm_joinEr //=. - by rewrite -mulgA (normC nUK) mulgA mulMsUK !eqxx. - rewrite (pnat_coprime _ (pHall_pgroup hallU)) // -pgroupE pgroupM. - rewrite (sub_pgroup _ (pHall_pgroup hallK)) => [|p k_p]; last first. - by apply/orP; right. - by rewrite (sub_pgroup _ (pcore_pgroup _ _)) => // p s_p; apply/orP; left. - have{defM} [[defM _ _] _ _ _ _] := kappa_structure maxM complU. - have [[MsU _ defMsU] _ _ _ _] := sdprodP defM; rewrite defMsU in defM. - have [_ mulMsU _ _] := sdprodP defMsU. - by rewrite norm_joinEr // mulMsU; case/sdprod_context: defM. -- by have [] := kappa_compl_context maxM complU. -split. -- have [K1 | ntK] := eqsVneq K 1. - rewrite /Kstar K1 cent1T setIT Msigma_neq1 // setDv. - by split=> // k; rewrite inE. - have PmaxM: M \in 'M_'P by rewrite inE -(trivg_kappa maxM hallK) ntK. - have [_ [defNK _] [-> _] _ _] := Ptype_structure PmaxM hallK. - have [_ _ cKKs tiKKs] := dprodP defNK; rewrite dprodEY //; split=> // k Kk. - by have [_ _ [_ _ _ [_ _ -> // _ _] _]] := Ptype_embedding PmaxM hallK. -- have [_ _ [_ ->] _] := Fitting_structure maxM. - by have [[]] := Fcore_structure maxM. -- have [_ [-> defF _] _ sFM'] := Fitting_structure maxM. - have [_ -> _] := cprodP defF; split=> // ntK. - by rewrite sFM' // inE -(trivg_kappa maxM hallK) ntK. -move=> not_nilMs; pose q := #|Kstar|. -have solMs: solvable M`_\sigma := solvableS (pcore_sub _ _) (mmax_sol maxM). -have [D hallD] := Hall_exists q^' solMs. -have [_] := Fcore_structure maxM; case/(_ K D)=> //. -case=> P1maxM _ _ [-> _ _ _] _ _ _; split=> //. - by apply/eqP; rewrite (trivg_kappa_compl maxM complU). -by apply: contraR not_nilMs; case/nonTI_Fitting_facts=> // _ -> _. -Qed. - -(* This is a variant of B & G, Lemma 16.1(e) that better fits the Peterfalvi *) -(* definitions. *) -Lemma sdprod_FTder : M`_\sigma ><| U = M^`(FTtype M != 1%N). -Proof. -rewrite -FTtype_Fmax // (trivgFmax maxM complU). -have [[defM _ _] defM' _ _ _] := kappa_structure maxM complU. -by case: (altP eqP) defM' defM => [-> _ | _ [] //]; rewrite sdprodg1. -Qed. - -Theorem BGsummaryB : - [/\ (*1*) forall p S, p.-Sylow(U) S -> abelian S /\ 'r(S) <= 2, - (*2*) abelian <<U :&: 'A(M)>>, - (*3*) exists U0 : {group gT}, - [/\ U0 \subset U, exponent U0 = exponent U & [disjoint U0 & 'A(M)]] - & (*4*) (forall X, X \subset U -> X :!=: 1 -> 'C_(M`_\sigma)(X) != 1 -> - 'M('C(X)) = [set M]) - /\ (*5*) ('A(M) != 'A1(M) -> normedTI ('A(M) :\: 'A1(M)) G M)]. -Proof. -split. -- move=> p S sylS; have [hallU _ _] := complU; have [sUM sk'U _] := and3P hallU. - have [-> | ntS] := eqsVneq S 1; first by rewrite abelian1 rank1. - have sk'p: p \in \sigma_kappa(M)^'. - by rewrite (pnatPpi sk'U) // -p_rank_gt0 -(rank_Sylow sylS) rank_gt0. - have{sylS} sylS := subHall_Sylow hallU sk'p sylS. - have [[sSM pS _] [/= s'p _]] := (and3P sylS, norP sk'p). - rewrite (sigma'_nil_abelian maxM) ?(pi_pgroup pS) ?(pgroup_nil pS) //. - by rewrite (rank_Sylow sylS) leqNgt (contra _ s'p) //; apply: alpha_sub_sigma. -- have [_ _ _ cUA_UA _] := kappa_structure maxM complU. - apply: abelianS cUA_UA; rewrite genS // -big_distrr ?setIS -?def_FTcore //=. - by apply/bigcupsP=> x A1x; rewrite (bigcup_max x) // setDE setIAC subsetIr. -- have [-> | ntU] := eqsVneq U 1. - exists 1%G; split; rewrite // disjoint_sym disjoints_subset. - by apply/bigcupsP=> x _; rewrite setDE subsetIr. - have [_ _ _ _ [// | U0 [sU0U expU0 frobU0]]] := kappa_structure maxM complU. - exists U0; split; rewrite // -setI_eq0 big_distrr /= /'A1(M) def_FTcore //. - rewrite big1 // => x A1x; apply/eqP; rewrite setIDA setD_eq0 setICA. - by rewrite (Frobenius_reg_compl frobU0) ?subsetIr. -set part4 := forall X, _; have part4holds: part4. - move=> X sXU ntX nregX. - by have [_ _] := kappa_structure maxM complU; case/(_ X). -have [[nsMsM _ _] _ [_ _ nsMsUM _ _] _ _] := BGsummaryA. -have{nsMsM nsMsUM}[[_ nMsM] [_ nMsUM]] := (andP nsMsM, andP nsMsUM). -rewrite eqEsubset FTsupp1_sub // -setD_eq0 andbT; set B := _ :\: _. -have nBM: M \subset 'N(B) by rewrite normsD ?FTsupp_norm ?FTsupp1_norm. -have uniqB y (u := y.`_\sigma(M)^'): y \in B -> 'M('C[u]) = [set M]. - case/setDP=> /bigcupP[x /setD1P[ntx Ms_x] /setD1P[nty /setIP[M'y cxy]]]. - rewrite !inE nty def_FTcore //= in Ms_x * => notMs_y; set M' := M^`(_) in M'y. - have [nsMsM' _ _ _ _] := sdprod_context sdprod_FTder. - have [[sMsM' nMsM'] sM'M]:= (andP nsMsM', der_sub _ M : M' \subset M). - have hallMs := pHall_subl sMsM' sM'M (Msigma_Hall maxM). - have hallU: \sigma(M)^'.-Hall(M') U. - by rewrite -(compl_pHall _ hallMs) sdprod_compl ?sdprod_FTder. - have suM': <[u]> \subset M' by rewrite cycle_subG groupX. - have solM': solvable M' := solvableS sM'M (mmax_sol maxM). - have [z M'z suzU] := Hall_Jsub solM' hallU suM' (p_elt_constt _ _). - have Mz': z^-1 \in M by rewrite groupV (subsetP sM'M). - rewrite -(conjgK z u) -(group_inj (conjGid Mz')) -cent_cycle. - rewrite !cycleJ centJ; apply: def_uniq_mmaxJ (part4holds _ suzU _ _). - rewrite /= -cycleJ cycle_eq1 -consttJ; apply: contraNneq notMs_y. - move/constt1P; rewrite p_eltNK p_eltJ => sMy. - by rewrite (mem_normal_Hall hallMs). - rewrite -(normsP nMsM' z M'z) centJ -conjIg -(isog_eq1 (conj_isog _ _)). - by apply/trivgPn; exists x; rewrite //= inE Ms_x cent_cycle cent1C groupX. -split=> // nzB; apply/normedTI_P; rewrite setTI; split=> // a _. -case/pred0Pn=> x /andP[/= Bx]; rewrite mem_conjg => /uniqB/(def_uniq_mmaxJ a). -rewrite consttJ -normJ conjg_set1 conjgKV uniqB // => /set1_inj defM. -by rewrite -(norm_mmax maxM) inE {2}defM. -Qed. - -Let Z := K <*> Kstar. -Let Zhat := Z :\: (K :|: Kstar). - -(* We strengthened the uniqueness condition in part (4) to *) -(* 'M_\sigma(K) = [set Mstar]. *) -Theorem BGsummaryC : K :!=: 1 -> - [/\ - [/\ (*1*) abelian U /\ ~~ ('N(U) \subset M), - (*2*) [/\ cyclic Kstar, Kstar != 1, Kstar \subset M`_\F & ~~ cyclic M`_\F] - & (*3*) M`_\sigma ><| U = M^`(1) /\ Kstar \subset M^`(2)], - exists Mstar, - [/\ (*4*) [/\ Mstar \in 'M_'P, 'C_(Mstar`_\sigma)(Kstar) = K, - \kappa(Mstar).-Hall(Mstar) Kstar - & 'M_\sigma(K) = [set Mstar]], (* uniqueness *) - (*5*) {in 'E^1(Kstar), forall X, 'M('C(X)) = [set M]} - /\ {in 'E^1(K), forall Y, 'M('C(Y)) = [set Mstar]}, - (*6*) [/\ M :&: Mstar = Z, K \x Kstar = Z & cyclic Z] - & (*7*) (M \in 'M_'P2 \/ Mstar \in 'M_'P2) - /\ {in 'M_'P, forall H, gval H \in M :^: G :|: Mstar :^: G}] -& [/\ (*8*) normedTI Zhat G Z, - (*9*) let B := 'A0(M) :\: 'A(M) in - B = class_support Zhat M /\ normedTI B G M, - (*10*) U :!=: 1 -> - [/\ prime #|K|, normedTI 'F(M)^# G M & M`_\sigma \subset 'F(M)] - & (*11*) U :==: 1 -> prime #|Kstar| ]]. -Proof. -move=> ntK; have [_ hallK _] := complU. -have PmaxM: M \in 'M_'P by rewrite inE -(trivg_kappa maxM hallK) ntK. -split. -- have [_ [//|-> ->] _ _ _] := kappa_structure maxM complU. - have [-> -> -> -> ->] := Ptype_cyclics PmaxM hallK; do 2!split=> //. - have [L maxCK_L] := mmax_exists (mFT_cent_proper ntK). - have [-> | ntU] := eqsVneq U 1. - by rewrite norm1 proper_subn // mmax_proper. - have P2maxM: M \in 'M_'P2 by rewrite inE -(trivg_kappa_compl maxM complU) ntU. - have [r _ rU] := rank_witness U; have [R sylR] := Sylow_exists r U. - have ntR: R :!=: 1 by rewrite -rank_gt0 (rank_Sylow sylR) -rU rank_gt0. - have ltRG: R \proper G := mFT_pgroup_proper (pHall_pgroup sylR). - have [H maxNR_H] := mmax_exists (mFT_norm_proper ntR ltRG). - apply: contra (subset_trans (subsetIr H _)) _. - by have [_ _ _ [->]] := P2type_signalizer P2maxM complU maxCK_L sylR maxNR_H. -- have [L [PmaxL _] [uniqL []]] := Ptype_embedding PmaxM hallK. - rewrite -/Kstar -/Z -/Zhat => hallKstar _ [defK _] [cycZ defML _ _ _]. - case=> _ P2_MorL Pmax_conjMorL _; exists L. - suffices uniqMSK: 'M_\sigma(K) = [set L]. - have [_ [defNK _] [_ uniqM] _ _] := Ptype_structure PmaxM hallK. - do 2!split=> //; last by case: P2_MorL => [] [-> _]; [left | right]. - by have [_ _ cKKs tiKKs] := dprodP defNK; rewrite dprodEY. - have sKLs: K \subset L`_\sigma by rewrite -defK subsetIl. - have [X E1X]: exists X, X \in 'E^1(K) by apply/rank_geP; rewrite rank_gt0. - have sXK: X \subset K by case/nElemP: E1X => ? /pnElemP[]. - have [maxL sCXL] := mem_uniq_mmax (uniqL X E1X). - have [x defKx] := cyclicP (cyclicS (joing_subl _ _) cycZ). - have SMxL: L \in 'M_\sigma[x] by rewrite -defKx inE maxL. - have ell1x: \ell_\sigma(x) == 1%N. - by rewrite (Msigma_ell1 maxL) // !inE -cycle_eq1 -cycle_subG -defKx ntK. - apply/eqP; rewrite eq_sym eqEcard defKx sub1set SMxL cards1 leqNgt. - apply/negP=> ntSMx; have [_ [//|_ ntR _ _]] := FT_signalizer_context ell1x. - case/(_ L)=> // /sdprodP[_ _ _ tiRL]; case/negP: ntR. - rewrite -subG1 -tiRL subsetIidl -setIA setICA setISS ?pcore_sub //. - by rewrite subsetIidr /= -cent_cycle -defKx (subset_trans (centS sXK) sCXL). -split; last 1 first. -- rewrite (trivg_kappa_compl maxM complU) => P1maxM. - have [L _ [_ _ _ _ [_ [] [] //]]] := Ptype_embedding PmaxM hallK. - by rewrite inE P1maxM. -- by have [L _ [_ _ _ _ [[]]]] := Ptype_embedding PmaxM hallK. -- have [L _ [_ _ _]] := Ptype_embedding PmaxM hallK; rewrite -/Zhat -/Z. - case=> cycZ defML defCK defCKs defCZhat [[tiZhat tiZhatM _] _ _ defM] B. - have sZM: Z \subset M by rewrite -[Z]defML subsetIl. - have sZhM: Zhat \subset M by rewrite subDset setUC subsetU ?sZM. - suffices defB: B = class_support Zhat M. - split=> //; apply/normedTI_P. - rewrite setTI normsD ?FTsupp_norm ?FTsupp0_norm //; split=> // [|g _]. - case/andP: tiZhat => /set0Pn[z Zz] _; apply/set0Pn; exists z. - by rewrite defB mem_class_support. - rewrite defB => /pred0Pn[_ /andP[/imset2P[z x Zz Mx ->] /= Bg_zx]]. - apply/idPn; rewrite -(groupMr g (groupVr Mx)) -in_setC. - case/tiZhatM/pred0Pn; exists z; rewrite /= Zz conjsgM mem_conjgV. - by apply: subsetP Bg_zx; rewrite conjSg class_support_subG. - rewrite /B /'A0(M); set M' := M^`(_); set su := \pi(M'). - have defM': M' = M^`(1) by rewrite /M' -FTtype_Pmax ?PmaxM. - have{hallK} hallM': su.-Hall(M) M'. - by rewrite Hall_pi //= -/M' defM' (sdprod_Hall defM) (pHall_Hall hallK). - have{hallM'} hallK: su^'.-Hall(M) K. - by rewrite -(compl_pHall _ hallM') /= -/M' defM' sdprod_compl. - have su'K: su^'.-group K := pHall_pgroup hallK. - have suKs: su.-group Kstar. - by rewrite (pgroupS _ (pgroup_pi _)) ///= -/M' defM' subIset ?Msigma_der1. - apply/setP=> x; rewrite !inE; apply/andP/imset2P=> [[]| [y a]]; last first. - case/setDP=> Zy; rewrite inE => /norP[not_Ky notKs_y] Ma ->. - have My := subsetP sZM y Zy; have Mya := groupJ My Ma. - have [not_suy not_su'y]: ~~ su.-elt y /\ ~~ su^'.-elt y. - have defZ: K * Kstar = Z by rewrite -cent_joinEr ?subsetIr. - have [hallK_Z hallKs] := coprime_mulGp_Hall defZ su'K suKs. - have ns_Z := sub_abelian_normal _ (cyclic_abelian cycZ). - rewrite -(mem_normal_Hall hallKs) -?ns_Z ?joing_subr // notKs_y. - by rewrite -(mem_normal_Hall hallK_Z) -?ns_Z ?joing_subl. - rewrite Mya !p_eltJ not_suy not_su'y orbT; split=> //. - apply: contra not_suy => /bigcupP[_ _ /setD1P[_ /setIP[M'ya _]]]. - by rewrite -(p_eltJ _ y a) (mem_p_elt (pgroup_pi _)). - move/negPf=> -> /and3P[Mx not_sux not_su'x]; set y := x.`_su^'. - have syM: <[y]> \subset M by rewrite cycle_subG groupX. - have [a Ma Kya] := Hall_Jsub (mmax_sol maxM) hallK syM (p_elt_constt _ _). - have{Kya} K1ya: y ^ a \in K^#. - rewrite !inE -cycle_subG cycleJ Kya andbT -consttJ. - by apply: contraNneq not_sux; move/constt1P; rewrite p_eltNK p_eltJ. - exists (x ^ a) a^-1; rewrite ?groupV ?conjgK // 2!inE andbC negb_or. - rewrite -[Z](defCK _ K1ya) inE groupJ // cent1C -consttJ groupX ?cent1id //. - by rewrite (contra (mem_p_elt su'K)) ?(contra (mem_p_elt suKs)) ?p_eltJ. -rewrite (trivg_kappa_compl maxM complU) => notP1maxM. -have P2maxM: M \in 'M_'P2 by apply/setDP. -split; first by have [_ _ _ _ []] := Ptype_structure PmaxM hallK. - apply: contraR notP1maxM; case/nonTI_Fitting_facts=> //. - by case/setUP=> //; case/idPn; case/setDP: PmaxM. -have [<- | neqMF_Ms] := eqVneq M`_\F M`_\sigma; first exact: Fcore_sub_Fitting. -have solMs: solvable M`_\sigma := solvableS (pcore_sub _ _) (mmax_sol maxM). -have [D hallD] := Hall_exists #|Kstar|^' solMs. -by case: (Fcore_structure maxM) notP1maxM => _ /(_ K D)[] // [->]. -Qed. - -End SingleGroupSummaries. - -Theorem BGsummaryD M : M \in 'M -> - [/\ (*1*) {in M`_\sigma &, forall x y, y \in x ^: G -> y \in x ^: M}, - (*2*) forall g (Ms := M`_\sigma), g \notin M -> - Ms:&: M :^ g = Ms :&: Ms :^ g /\ cyclic (Ms :&: M :^ g), - (*3*) {in M`_\sigma^#, forall x, - [/\ Hall 'C[x] 'C_M[x], 'R[x] ><| 'C_M[x] = 'C[x] - & let MGx := [set Mg in M :^: G | x \in Mg] in - [transitive 'R[x], on MGx | 'Js] /\ #|'R[x]| = #|MGx| ]} - & (*4*) {in M`_\sigma^#, forall x (N := 'N[x]), ~~ ('C[x] \subset M) -> - [/\ 'M('C[x]) = [set N] /\ N`_\F = N`_\sigma, - x \in 'A(N) :\: 'A1(N) /\ N \in 'M_'F :|: 'M_'P2, - \sigma(N)^'.-Hall(N) (M :&: N) - & N \in 'M_'P2 -> - [/\ M \in 'M_'F, - exists2 E, [Frobenius M = M`_\sigma ><| gval E] & cyclic E - & ~~ normedTI (M`_\F)^# G M]]}]. -Proof. -move=> maxM; have [[U K] /= complU] := kappa_witness maxM. -have defSM: {in M`_\sigma^#, - forall x, [set Mg in M :^: G | x \in Mg] = val @: 'M_\sigma[x]}. -- move=> x /setD1P[ntx Ms_x]. - have SMxM: M \in 'M_\sigma[x] by rewrite inE maxM cycle_subG. - apply/setP=> /= Mg; apply/setIdP/imsetP=> [[] | [H]]. - case/imsetP=> g _ -> Mg_x; exists (M :^ g)%G => //=. - rewrite inE cycle_subG (mem_Hall_pcore (Msigma_Hall _)) ?mmaxJ // maxM. - by rewrite (eq_p_elt _ (sigmaJ _ _)) (mem_p_elt (pcore_pgroup _ M)). - case/setIdP=> maxH; rewrite cycle_subG => Hs_x ->. - split; last exact: subsetP (pcore_sub _ _) x Hs_x. - pose p := pdiv #[x]; have pixp: p \in \pi(#[x]) by rewrite pi_pdiv order_gt1. - apply/idPn=> /(sigma_partition maxM maxH)/(_ p). - rewrite inE /= (pnatPpi (mem_p_elt (pcore_pgroup _ _) Ms_x)) //. - by rewrite (pnatPpi (mem_p_elt (pcore_pgroup _ _) Hs_x)). -split. -- have hallMs := pHall_subl (subxx _) (subsetT _) (Msigma_Hall_G maxM). - move=> x y Ms_x Ms_y /=/imsetP[a _ def_y]; rewrite def_y in Ms_y *. - have [b /setIP[Mb _ ->]] := sigma_Hall_tame maxM hallMs Ms_x Ms_y. - exact: mem_imset. -- move=> g notMg; split. - apply/eqP; rewrite eqEsubset andbC setIS ?conjSg ?pcore_sub //=. - rewrite subsetI subsetIl -MsigmaJ. - rewrite (sub_Hall_pcore (Msigma_Hall _)) ?mmaxJ ?subsetIr //. - rewrite (eq_pgroup _ (sigmaJ _ _)). - exact: pgroupS (subsetIl _ _) (pcore_pgroup _ _). - have [E hallE] := ex_sigma_compl maxM. - by have [_ _] := sigma_compl_embedding maxM hallE; case/(_ g). -- move=> x Ms1x /=. - have [[ntx Ms_x] ell1x] := (setD1P Ms1x, Msigma_ell1 maxM Ms1x). - have [[trR oR nsRC hallR] defC] := FT_signalizer_context ell1x. - have SMxM: M \in 'M_\sigma[x] by rewrite inE maxM cycle_subG. - suffices defCx: 'R[x] ><| 'C_M[x] = 'C[x]. - split=> //; first by rewrite -(sdprod_Hall defCx). - rewrite defSM //; split; last by rewrite (card_imset _ val_inj). - apply/imsetP; exists (gval M); first exact: mem_imset. - by rewrite -(atransP trR _ SMxM) -imset_comp. - have [| SMgt1] := leqP #|'M_\sigma[x]| 1. - rewrite leq_eqVlt {2}(cardD1 M) SMxM orbF => eqSMxM. - have ->: 'R[x] = 1 by apply/eqP; rewrite trivg_card1 oR. - by rewrite sdprod1g (setIidPr _) ?cent1_sub_uniq_sigma_mmax. - have [uniqN _ _ _ defCx] := defC SMgt1. - have{defCx} [[defCx _ _ _] [_ sCxN]] := (defCx M SMxM, mem_uniq_mmax uniqN). - by rewrite -setIA (setIidPr sCxN) in defCx. -move=> x Ms1x /= not_sCM. -have [[ntx Ms_x] ell1x] := (setD1P Ms1x, Msigma_ell1 maxM Ms1x). -have SMxM: M \in 'M_\sigma[x] by rewrite inE maxM cycle_subG. -have SMgt1: #|'M_\sigma[x]| > 1. - apply: contraR not_sCM; rewrite -leqNgt leq_eqVlt {2}(cardD1 M) SMxM orbF. - by move/cent1_sub_uniq_sigma_mmax->. -have [_ [//|uniqN ntR t2Nx notP1maxN]] := FT_signalizer_context ell1x. -have [maxN sCxN] := mem_uniq_mmax uniqN. -case/(_ M SMxM)=> _ st2NsM _ ->; split=> //. -- by rewrite (Fcore_eq_Msigma maxN (notP1type_Msigma_nil _)) // -in_setU. -- split=> //; apply/setDP; split. - have [y Ry nty] := trivgPn _ ntR; have [Nsy cxy] := setIP Ry. - apply/bigcupP; exists y; first by rewrite 2!inE def_FTcore ?nty. - rewrite 3!inE ntx cent1C cxy -FTtype_Pmax //= andbT. - have Nx: x \in 'N[x] by rewrite (subsetP sCxN) ?cent1id. - case PmaxN: ('N[x] \in 'M_'P) => //. - have [KN hallKN] := Hall_exists \kappa('N[x]) (mmax_sol maxN). - have [_ _ [_ _ _ _ [_ _ _ defN]]] := Ptype_embedding PmaxN hallKN. - have hallN': \kappa('N[x])^'.-Hall('N[x]) 'N[x]^`(1). - exact/(sdprod_normal_pHallP (der_normal 1 _) hallKN). - rewrite (mem_normal_Hall hallN') ?der_normal // (sub_p_elt _ t2Nx) // => p. - by case/andP=> _; apply: contraL => /rank_kappa->. - rewrite 2!inE ntx def_FTcore //=; apply: contra ntx => Ns_x. - rewrite -(constt_p_elt (mem_p_elt (pcore_pgroup _ _) Ns_x)). - by rewrite (constt1P (sub_p_elt _ t2Nx)) // => p; case/andP. -move=> P2maxN; have [PmaxN _] := setDP P2maxN; have [_ notFmaxN] := setDP PmaxN. -have [FmaxM _ [E _]] := nonFtype_signalizer_base maxM Ms1x not_sCM notFmaxN. -case=> cycE frobM; split=> //; first by exists E. -move: SMgt1; rewrite (cardsD1 M) SMxM ltnS lt0n => /pred0Pn[My /setD1P[neqMyM]]. -move/(mem_imset val); rewrite -defSM //= => /setIdP[/imsetP[y _ defMy] My_x]. -rewrite (Fcore_eq_Msigma maxM (notP1type_Msigma_nil _)) ?FmaxM //. -apply/normedTI_P=> [[_ _ /(_ y (in_setT y))/contraR/implyP/idPn[]]]. -rewrite -{1}(norm_mmax maxM) (sameP normP eqP) -defMy neqMyM. -apply/pred0Pn; exists x; rewrite /= conjD1g !inE ntx Ms_x /= -MsigmaJ. -rewrite (mem_Hall_pcore (Msigma_Hall _)) ?mmaxJ /= -?defMy //. -by rewrite defMy (eq_p_elt _ (sigmaJ _ _)) (mem_p_elt (pcore_pgroup _ _) Ms_x). -Qed. - -Lemma mmax_transversalP : - [/\ 'M^G \subset 'M, is_transversal 'M^G (orbit 'JG G @: 'M) 'M, - {in 'M^G &, injective (fun M => M :^: G)} - & {in 'M, forall M, exists x, (M :^ x)%G \in 'M^G}]. -Proof. -have: [acts G, on 'M | 'JG] by apply/actsP=> x _ M; rewrite mmaxJ. -case/orbit_transversalP; rewrite -/mmax_transversal => -> -> injMX memMX. -split=> // [M H MX_M MX_H /= eqMH | M /memMX[x _]]; last by exists x. -have /orbitP[x Gx defH]: val H \in M :^: G by rewrite eqMH orbit_refl. -by apply/eqP; rewrite -injMX // -(group_inj defH) (mem_orbit 'JG). -Qed. - -(* We are conforming to the statement of B & G, but we defer the introduction *) -(* of 'M^G to Peterfalvi (8.17), which requires several other changes. *) -Theorem BGsummaryE : - [/\ (*1*) forall M, M \in 'M -> - #|class_support M^~~ G| = (#|M`_\sigma|.-1 * #|G : M|)%N, - (*2*) {in \pi(G), forall p, - exists2 M : {group gT}, M \in 'M & p \in \sigma(M)} - /\ {in 'M &, forall M H, - gval H \notin M :^: G -> [predI \sigma(M) & \sigma(H)] =i pred0} - & (*3*) let PG := [set class_support M^~~ G | M : {group gT} in 'M] in - [/\ partition PG (cover PG), - 'M_'P = set0 :> {set {group gT}} -> cover PG = G^# - & forall M K, M \in 'M_'P -> \kappa(M).-Hall(M) K -> - let Kstar := 'C_(M`_\sigma)(K) in - let Zhat := (K <*> Kstar) :\: (K :|: Kstar) in - partition [set class_support Zhat G; cover PG] G^#]]. -Proof. -split=> [||PG]; first exact: card_class_support_sigma. - by split=> [p /sigma_mmax_exists[M]|]; [exists M | apply: sigma_partition]. -have [noPmax | ntPmax] := eqVneq 'M_'P (set0 : {set {group gT}}). - rewrite noPmax; move/eqP in noPmax; have [partPG _] := mFT_partition gT. - have /and3P[/eqP-> _ _] := partPG noPmax; rewrite partPG //. - by split=> // M K; rewrite inE. -have [_ partZPG] := mFT_partition gT. -have partPG: partition PG (cover PG). - have [M PmaxM] := set0Pn _ ntPmax; have [maxM _] := setDP PmaxM. - have [K hallK] := Hall_exists \kappa(M) (mmax_sol maxM). - have{partZPG} [/and3P[_ tiPG]] := partZPG M K PmaxM hallK. - rewrite inE => /norP[_ notPGset0] _; apply/and3P; split=> //; apply/trivIsetP. - by apply: sub_in2 (trivIsetP tiPG) => C; apply: setU1r. -split=> // [noPmax | M K PmaxM hallK]; first by case/eqP: ntPmax. -have [/=] := partZPG M K PmaxM hallK; rewrite -/PG; set Z := class_support _ G. -case/and3P=> /eqP defG1 tiZPG; rewrite 2!inE => /norP[nzZ _] notPGZ. -have [_ tiPG nzPG] := and3P partPG; have [maxM _] := setDP PmaxM. -rewrite /cover big_setU1 //= -/(cover PG) in defG1. -rewrite /trivIset /cover !big_setU1 //= (eqnP tiPG) -/(cover PG) in tiZPG. -have tiZ_PG: Z :&: cover PG = set0. - by apply/eqP; rewrite setI_eq0 -leq_card_setU eq_sym. -have notUPGZ: Z \notin [set cover PG]. - by rewrite inE; apply: contraNneq nzZ => defZ; rewrite -tiZ_PG -defZ setIid. -rewrite /partition /trivIset /(cover _) !big_setU1 // !big_set1 /= -defG1. -rewrite eqxx tiZPG !inE negb_or nzZ /= eq_sym; apply: contraNneq nzPG => PG0. -apply/imsetP; exists M => //; apply/eqP; rewrite eq_sym -subset0 -PG0. -by rewrite (bigcup_max (class_support M^~~ G)) //; apply: mem_imset. -Qed. - -Let typePfacts M (H := M`_\F) U W1 W2 W (defW : W1 \x W2 = W) : - M \in 'M -> of_typeP M U defW -> - [/\ M \in 'M_'P, \kappa(M).-Hall(M) W1, 'C_H(W1) = W2, - (M \in 'M_'P1) = (U :==: 1) || ('N(U) \subset M) - & let Ms := M`_\sigma in - Ms = M^`(1) -> (H == Ms) = (U :==: 1) /\ abelian (Ms / H) = abelian U]. -Proof. -move=> maxM []{defW}; move: W1 W2 => K Ks [cycK hallK ntK defM] /=. -have [[_ /= sHMs sMsM' _] _] := Fcore_structure maxM. -rewrite -/H in sHMs * => [] [nilU sUM' nUK defM'] _ [_ ntKs sKsH _ prKsK _]. -have [_ sKM mulM'K _ tiM'K] := sdprod_context defM. -have defKs: 'C_H(K) = Ks. - have [[x defK] sHM'] := (cyclicP cycK, subset_trans sHMs sMsM'). - have K1x: x \in K^# by rewrite !inE -cycle_eq1 -cycle_subG -defK subxx andbT. - by rewrite -(setIidPl sHM') -setIA defK cent_cycle prKsK // (setIidPr _). -have{hallK} kK: \kappa(M).-group K. - apply: sub_pgroup (pgroup_pi K) => p piKp. - rewrite unlock 4!inE -!andb_orr orNb andbT -andbA. - have [X EpX]: exists X, X \in 'E_p^1(K). - by apply/p_rank_geP; rewrite p_rank_gt0. - have [sXK abelX dimX] := pnElemP EpX; have [pX _] := andP abelX. - have sXM := subset_trans sXK sKM. - have ->: p \in \sigma(M)^'. - apply: contra (nt_pnElem EpX isT) => sp. - rewrite -subG1 -tiM'K subsetI (subset_trans _ sMsM') //. - by rewrite (sub_Hall_pcore (Msigma_Hall maxM)) ?(pi_pgroup pX). - have ->: 'r_p(M) == 1%N. - rewrite -(p_rank_Hall (Hall_pi hallK)) // eqn_leq p_rank_gt0 piKp andbT. - apply: leq_trans (p_rank_le_rank p K) _. - by rewrite -abelian_rank1_cyclic ?cyclic_abelian. - apply/existsP; exists X; rewrite 2!inE sXM abelX dimX /=. - by rewrite (subG1_contra _ ntKs) // -defKs setISS ?centS. -have PmaxM : M \in 'M_'P. - apply/PtypeP; split=> //; exists (pdiv #|K|). - by rewrite (pnatPpi kK) // pi_pdiv cardG_gt1. -have hallK: \kappa(M).-Hall(M) K. - rewrite pHallE sKM -(eqn_pmul2l (cardG_gt0 M^`(1))) (sdprod_card defM). - have [K1 hallK1] := Hall_exists \kappa(M) (mmax_sol maxM). - have [_ _ [_ _ _ _ [_ _ _ defM1]]] := Ptype_embedding PmaxM hallK1. - by rewrite -(card_Hall hallK1) /= (sdprod_card defM1). -split=> // [|->]; first set Ms := M`_\sigma; last first. - rewrite trivg_card_le1 -(@leq_pmul2l #|H|) ?cardG_gt0 // muln1. - split; first by rewrite (sdprod_card defM') eqEcard (subset_trans sHMs). - have [_ mulHU nHU tiHU] := sdprodP defM'. - by rewrite -mulHU quotientMidl (isog_abelian (quotient_isog nHU tiHU)). -have [U1 | /= ntU] := altP eqP. - rewrite inE PmaxM -{2}mulM'K /= -defM' U1 sdprodg1 pgroupM. - have sH: \sigma(M).-group H := pgroupS sHMs (pcore_pgroup _ _). - rewrite (sub_pgroup _ sH) => [|p sMp]; last by rewrite inE /= sMp. - by rewrite (sub_pgroup _ kK) // => p kMp; rewrite inE /= kMp orbT. -have [P1maxM | notP1maxM] := boolP (M \in _). - have defMs: Ms = M^`(1). - have [U1 complU1] := ex_kappa_compl maxM hallK. - have [_ [//|<- _] _ _ _] := kappa_structure maxM complU1. - by case: (P1maxP maxM complU1 P1maxM) => _; move/eqP->; rewrite sdprodg1. - pose p := pdiv #|U|; have piUp: p \in \pi(U) by rewrite pi_pdiv cardG_gt1. - have hallU: \pi(H)^'.-Hall(M^`(1)) U. - have sHM': H \subset M^`(1) by rewrite -defMs. - have hallH := pHall_subl sHM' (der_sub 1 M) (Fcore_Hall M). - by rewrite -(compl_pHall _ hallH) ?sdprod_compl. - have piMs_p: p \in \pi(Ms) by rewrite defMs (piSg sUM'). - have{piMs_p} sMp: p \in \sigma(M) := pnatPpi (pcore_pgroup _ _) piMs_p. - have sylP: p.-Sylow(M^`(1)) 'O_p(U). - apply: (subHall_Sylow hallU (pnatPpi (pHall_pgroup hallU) piUp)). - exact: nilpotent_pcore_Hall nilU. - rewrite (subset_trans (char_norms (pcore_char p U))) //. - rewrite (norm_sigma_Sylow sMp) //. - by rewrite (subHall_Sylow (Msigma_Hall maxM)) //= -/Ms defMs. -suffices complU: kappa_complement M U K. - by symmetry; apply/idPn; have [[[]]] := BGsummaryC maxM complU ntK. -split=> //; last by rewrite -norm_joinEr ?groupP. -rewrite pHallE (subset_trans _ (der_sub 1 M)) //=. -rewrite -(@eqn_pmul2l #|H|) ?cardG_gt0 // (sdprod_card defM'). -have [U1 complU1] := ex_kappa_compl maxM hallK. -have [hallU1 _ _] := complU1; rewrite -(card_Hall hallU1). -have [_ [// | defM'1 _] _ _ _] := kappa_structure maxM complU1. -rewrite [H](Fcore_eq_Msigma maxM _) ?(sdprod_card defM'1) //. -by rewrite notP1type_Msigma_nil // in_setD notP1maxM PmaxM orbT. -Qed. - -(* This is B & G, Lemma 16.1. *) -Lemma FTtypeP i M : M \in 'M -> reflect (FTtype_spec i M) (FTtype M == i). -Proof. -move=> maxM; pose Ms := M`_\sigma; pose M' := M^`(1); pose H := M`_\F. -have [[ntH sHMs sMsM' _] _] := Fcore_structure maxM. -apply: (iffP eqP) => [<- | ]; last first. - case: i => [// | [[U [[[_ _ defM] _ [U0 [sU0U expU0 frobM]]] _]] | ]]. - apply/eqP; rewrite -FTtype_Fmax //; apply: wlog_neg => notFmaxM. - have PmaxM: M \in 'M_'P by apply/setDP. - apply/FtypeP; split=> // p; apply/idP=> kp. - have [X EpX]: exists X, X \in 'E_p^1(U0). - apply/p_rank_geP; rewrite p_rank_gt0 -pi_of_exponent expU0 pi_of_exponent. - have: p \in \pi(M) by rewrite kappa_pi. - rewrite /= -(sdprod_card defM) pi_ofM ?cardG_gt0 //; case/orP=> // Fk. - have [[_ sMFMs _ _] _] := Fcore_structure maxM. - case/negP: (kappa_sigma' kp). - exact: pnatPpi (pcore_pgroup _ _) (piSg sMFMs Fk). - have [[sXU0 abelX _] ntX] := (pnElemP EpX, nt_pnElem EpX isT). - have kX := pi_pgroup (abelem_pgroup abelX) kp. - have [_ sUM _ _ _] := sdprod_context defM. - have sXM := subset_trans sXU0 (subset_trans sU0U sUM). - have [K hallK sXK] := Hall_superset (mmax_sol maxM) sXM kX. - have [ntKs _ _ sKsMF _] := Ptype_cyclics PmaxM hallK; case/negP: ntKs. - rewrite -subG1 -(cent_semiregular (Frobenius_reg_ker frobM) sXU0 ntX). - by rewrite subsetI sKsMF subIset // centS ?orbT. - case=> [[U W K Ks defW [[PtypeM ntU _ _] _ not_sNUM _ _]] | ]. - apply/eqP; rewrite -FTtype_P2max // inE andbC. - by have [-> _ _ -> _] := typePfacts maxM PtypeM; rewrite negb_or ntU. - case=> [[U W K Ks defW [[PtypeM ntU _ _] cUU sNUM]] | ]. - have [_ _ _] := typePfacts maxM PtypeM. - rewrite (negPf ntU) sNUM FTtype_P1max // cUU /FTtype -/Ms -/M' -/H. - by case: ifP => // _; case: (Ms =P M') => // -> _ [//|-> ->]. - case=> [[U W K Ks defW [[PtypeM ntU _ _] not_cUU sNUM]] | ]. - have [_ _ _] := typePfacts maxM PtypeM. - rewrite (negPf ntU) (negPf not_cUU) sNUM FTtype_P1max // /FTtype -/Ms -/M'. - by case: ifP => // _; case: (Ms =P M') => // -> _ [//|-> ->]. - case=> // [[U K Ks W defW [[PtypeM U_1] _]]]. - have [_ _ _] := typePfacts maxM PtypeM. - rewrite U_1 eqxx FTtype_P1max //= /FTtype -/Ms -/M' -/H. - by case: ifP => // _; case: (Ms =P M') => // -> _ [//|-> _]. -have [[U K] /= complU] := kappa_witness maxM; have [hallU hallK _] := complU. -have [K1 | ntK] := eqsVneq K 1. - have FmaxM: M \in 'M_'F by rewrite -(trivg_kappa maxM hallK) K1. - have ->: FTtype M = 1%N by apply/eqP; rewrite -FTtype_Fmax. - have ntU: U :!=: 1 by case/(FmaxP maxM complU): FmaxM. - have defH: H = Ms. - by apply/Fcore_eq_Msigma; rewrite // notP1type_Msigma_nil ?FmaxM. - have defM: H ><| U = M. - by have [_] := kappa_compl_context maxM complU; rewrite defH K1 sdprodg1. - exists U; split. - have [_ _ _ cU1U1 exU0] := kappa_structure maxM complU. - split=> //; last by rewrite -/Ms -defH in exU0; apply: exU0. - exists [group of <<\bigcup_(x in (M`_\sigma)^#) 'C_U[x]>>]. - split=> //= [|x Hx]; last by rewrite sub_gen //= -/Ms -defH (bigcup_max x). - rewrite -big_distrr /= /normal gen_subG subsetIl. - rewrite norms_gen ?normsI ?normG //; apply/subsetP=> u Uu. - rewrite inE sub_conjg; apply/bigcupsP=> x Msx. - rewrite -sub_conjg -normJ conjg_set1 (bigcup_max (x ^ u)) ?memJ_norm //. - by rewrite normD1 (subsetP (gFnorm _ _)) // (subsetP (pHall_sub hallU)). - have [|] := boolP [forall (y | y \notin M), 'F(M) :&: 'F(M) :^ y == 1]. - move/forall_inP=> TI_F; constructor 1; apply/normedTI_P. - rewrite setD_eq0 subG1 mmax_Fcore_neq1 // setTI normD1 gFnorm. - split=> // x _; apply: contraR => /TI_F/eqP tiFx. - rewrite -setI_eq0 conjD1g -setDIl setD_eq0 -set1gE -tiFx. - by rewrite setISS ?conjSg ?Fcore_sub_Fitting. - rewrite negb_forall_in => /exists_inP[y notMy ntX]. - have [_ _ _ _] := nonTI_Fitting_structure maxM notMy ntX. - case=> [[] | [_]]; first by constructor 2. - move: #|_| => p; set P := 'O_p(H); rewrite /= -/H => not_cPP cycHp'. - case=> [expU | [_]]; [constructor 3 | by rewrite 2!inE FmaxM]. - split=> [q /expU | ]. - have [_ <- nHU tiHU] := sdprodP defM. - by rewrite quotientMidl -(exponent_isog (quotient_isog _ _)). - have sylP: p.-Sylow(H) P := nilpotent_pcore_Hall _ (Fcore_nil M). - have ntP: P != 1 by apply: contraNneq not_cPP => ->; apply: abelian1. - by exists p; rewrite // -p_rank_gt0 -(rank_Sylow sylP) rank_gt0. -have PmaxM: M \in 'M_'P by rewrite inE -(trivg_kappa maxM hallK) ntK. -have [Mstar _ [_ _ _ [cycW _ _ _ _]]] := Ptype_embedding PmaxM hallK. -case=> [[tiV _ _] _ _ defM {Mstar}]. -have [_ [_ cycK] [_ nUK _ _ _] _] := BGsummaryA maxM complU; rewrite -/H. -case=> [[ntKs defCMK] [_ _ _ _ nilM'H] [sM''F defF /(_ ntK)sFM'] types34]. -have hallK_M := pHall_Hall hallK. -have [/= [[cUU not_sNUM]]] := BGsummaryC maxM complU ntK; rewrite -/H -/M' -/Ms. -case=> cycKs _ sKsH not_cycH [defM' sKsM''] _ [_ _ type2 _]. -pose Ks := 'C_H(K); pose W := K <*> Ks; pose V := W :\: (K :|: Ks). -have defKs: 'C_Ms(K) = Ks by rewrite -(setIidPr sKsH) setIA (setIidPl sHMs). -rewrite {}defKs -/W -/V in ntKs tiV cycW cycKs sKsM'' sKsH defCMK. -have{defCMK} prM'K: {in K^#, forall k, 'C_M'[k] = Ks}. - have sKsM': Ks \subset M' := subset_trans sKsM'' (der_sub 1 _). - move=> k; move/defCMK=> defW; have:= dprod_modr defW sKsM'. - have [_ _ _ ->] := sdprodP defM; rewrite dprod1g. - by rewrite setIA (setIidPl (der_sub 1 M)). -have [sHM' nsM'M] := (subset_trans sHMs sMsM', der_normal 1 M : M' <| M). -have hallM': \kappa(M)^'.-Hall(M) M' by apply/(sdprod_normal_pHallP _ hallK). -have [sM'M k'M' _] := and3P hallM'. -have hallH_M': \pi(H).-Hall(M') H := pHall_subl sHM' sM'M (Fcore_Hall M). -have nsHM' := normalS sHM' sM'M (Fcore_normal M). -have defW: K \x Ks = W. - rewrite dprodEY ?subsetIr //= setIC; apply/trivgP. - by have [_ _ _ <-] := sdprodP defM; rewrite setSI ?subIset ?sHM'. -have [Ueq1 | ntU] := eqsVneq U 1; last first. - have P2maxM: M \in 'M_'P2 by rewrite inE -(trivg_kappa_compl maxM complU) ntU. - have ->: FTtype M = 2 by apply/eqP; rewrite -FTtype_P2max. - have defH: H = Ms. - by apply/Fcore_eq_Msigma; rewrite // notP1type_Msigma_nil ?P2maxM ?orbT. - have [//|pr_K tiFM _] := type2; rewrite -defH in defM'. - have [_ sUM' _ _ _] := sdprod_context defM'. - have MtypeP: of_typeP M U defW by split; rewrite // abelian_nil. - have defM'F: M'`_\F = H. - apply/eqP; rewrite eqEsubset (Fcore_max hallH_M') ?Fcore_nil // andbT. - rewrite (Fcore_max (subHall_Hall hallM' _ (Fcore_Hall _))) ?Fcore_nil //. - by move=> p piM'Fp; apply: pnatPpi k'M' (piSg (Fcore_sub _) piM'Fp). - exact: gFnormal_trans nsM'M. - exists U _ K _ defW; split=> //; split; first by rewrite defM'F. - by exists U; split=> // x _; apply: subsetIl. - have [_ _ _ _ /(_ ntU)] := kappa_structure maxM complU. - by rewrite -/Ms -defH -defM'F. -have P1maxM: M \in 'M_'P1 by rewrite -(trivg_kappa_compl maxM complU) Ueq1. -have: 2 < FTtype M <= 5 by rewrite -FTtype_P1max. -rewrite /FTtype -/H -/Ms; case: ifP => // _; case: eqP => //= defMs _. -have [Y hallY nYK]: exists2 Y, \pi(H)^'.-Hall(M') (gval Y) & K \subset 'N(Y). - apply: coprime_Hall_exists; first by case/sdprodP: defM. - by rewrite (coprime_sdprod_Hall_l defM) (pHall_Hall hallM'). - exact: solvableS sM'M (mmax_sol maxM). -have{defM'} defM': H ><| Y = M' by apply/(sdprod_normal_p'HallP _ hallY). -have MtypeP: of_typeP M Y defW. - have [_ sYM' mulHY nHY tiHY] := sdprod_context defM'. - do 2!split=> //; rewrite (isog_nil (quotient_isog nHY tiHY)). - by rewrite /= -quotientMidl mulHY. -have [_ _ _ sNYG [//| defY1 ->]] := typePfacts maxM MtypeP. -rewrite defY1; have [Y1 | ntY] := altP (Y :=P: 1); last first. - move/esym: sNYG; rewrite (negPf ntY) P1maxM /= => sNYG. - have [|_ tiFM prK] := types34; first by rewrite defY1. - by case: ifPn; exists Y _ K _ defW. -exists Y _ K _ defW; split=> //=. -have [|] := boolP [forall (y | y \notin M), 'F(M) :&: 'F(M) :^ y == 1]. - move/forall_inP=> TI_F; constructor 1; apply/normedTI_P. - rewrite setD_eq0 subG1 mmax_Fcore_neq1 // setTI normD1 gFnorm. - split=> // x _; apply: contraR => /TI_F/eqP tiFx. - rewrite -setI_eq0 conjD1g -setDIl setD_eq0 -set1gE -tiFx. - by rewrite setISS ?conjSg ?Fcore_sub_Fitting. -rewrite negb_forall_in => /exists_inP[y notMy ntX]. -have [_ _ _ _] := nonTI_Fitting_structure maxM notMy ntX. -case=> [[] | [_]]; first by case/idPn; case/setDP: PmaxM. -move: #|_| => p; set P := 'O_p(H); rewrite /= -/H => not_cPP cycHp'. -have sylP: p.-Sylow(H) P := nilpotent_pcore_Hall _ (Fcore_nil M). -have ntP: P != 1 by apply: contraNneq not_cPP => ->; apply: abelian1. -have piHp: p \in \pi(H) by rewrite -p_rank_gt0 -(rank_Sylow sylP) rank_gt0. -have defH: H = Ms by apply/eqP; rewrite defY1 Y1. -rewrite -defMs -defH in defM; have [_ <- nHU tiHU] := sdprodP defM. -rewrite quotientMidl -(card_isog (quotient_isog _ _)) //. -rewrite -(exponent_isog (quotient_isog _ _)) // exponent_cyclic //=. -case=> [K_dv_H1 | []]; [constructor 2 | constructor 3]; exists p => //. -by rewrite K_dv_H1. -Qed. - -(* This is B & G, Theorem I. *) -(* Note that the first assertion is not used in the Perterfalvi revision of *) -(* the character theory part of the proof. *) -Theorem BGsummaryI : - [/\ forall H x a, Hall G H -> nilpotent H -> x \in H -> x ^ a \in H -> - exists2 y, y \in 'N(H) & x ^ a = x ^ y - & {in 'M, forall M, FTtype M == 1%N} - \/ exists ST : {group gT} * {group gT}, let (S, T) := ST in - [/\ S \in 'M /\ T \in 'M, - exists Wi : {group gT} * {group gT}, let (W1, W2) := Wi in - let W := W1 <*> W2 in let V := W :\: (W1 :|: W2) in - (*a*) [/\ cyclic W, normedTI V G W & W1 :!=: 1 /\ W2 :!=: 1] /\ - (*b*) [/\ S^`(1) ><| W1 = S, T^`(1) ><| W2 = T & S :&: T = W], - (*c*) {in 'M, forall M, FTtype M != 1%N -> - exists x, S :^ x = M \/ T :^ x = M}, - (*d*) FTtype S == 2 \/ FTtype T == 2 - & (*e*) 1 < FTtype S <= 5 /\ 1 < FTtype T <= 5]]. -Proof. -split=> [H x a hallH nilH Hx|]. - have [M maxM sHMs] := nilpotent_Hall_sigma nilH hallH. - have{hallH} hallH := pHall_subl sHMs (subsetT _) (Hall_pi hallH). - by case/(sigma_Hall_tame maxM hallH Hx) => // y; case/setIP; exists y. -have [allFM | ] := boolP (('M : {set {group gT}}) \subset 'M_'F). - by left=> M maxM; rewrite -FTtype_Fmax // (subsetP allFM). -case/subsetPn=> S maxS notFmaxS; right. -have PmaxS: S \in 'M_'P by apply/setDP. -have [[U W1] /= complU] := kappa_witness maxS; have [_ hallW1 _] := complU. -have ntW1: W1 :!=: 1 by rewrite (trivg_kappa maxS). -have [[_ [_]]] := BGsummaryC maxS complU ntW1; set W2 := 'C_(_)(W1) => ntW2 _. -set W := W1 <*> W2; set V := W :\: _ => _ _ [T [[PmaxT defW1 hallW2 _] _]]. -case=> defST _ cycW [P2maxST PmaxST] [tiV _ _] _. -have [maxT _] := setDP PmaxT. -have [_ _ [_ _ _ _ [_ _ _ defS]]] := Ptype_embedding PmaxS hallW1. -have [_ _ [_ _ _ _ [_ _ _ defT]]] := Ptype_embedding PmaxT hallW2. -exists (S, T); split=> //; first by exists (W1, [group of W2]). -- move=> M maxM; rewrite /= -FTtype_Pmax //. - by case/PmaxST/setUP => /imsetP[x _ ->]; exists x; by [left | right]. -- by rewrite -!{1}FTtype_P2max. -rewrite !{1}(ltn_neqAle 1) -!{1}andbA !{1}FTtype_range // !{1}andbT. -by rewrite !{1}(eq_sym 1%N) -!{1}FTtype_Pmax. -Qed. - -Lemma FTsupp0_type1 M : FTtype M == 1%N -> 'A0(M) = 'A(M). -Proof. -move=> typeM; apply/setUidPl/subsetP=> x; rewrite typeM !inE => /and3P[Mx]. -by rewrite (mem_p_elt (pgroup_pi M)). -Qed. - -Lemma FTsupp0_typeP M (H := M`_\F) U W1 W2 W (defW : W1 \x W2 = W) : - M \in 'M -> of_typeP M U defW -> - let V := W :\: (W1 :|: W2) in 'A0(M) :\: 'A(M) = class_support V M. -Proof. -move: W1 W2 => K Ks in defW * => maxM MtypeP /=. -have [[_ _ ntK _] _ _ _ _] := MtypeP. -have [PmaxM hallK defKs _ _] := typePfacts maxM MtypeP. -have [[_ sHMs _ _] _] := Fcore_structure maxM. -have [V complV] := ex_kappa_compl maxM hallK. -have [[_ [_ _ sKsH _] _] _ [_ [-> _] _ _]] := BGsummaryC maxM complV ntK. -by rewrite -(setIidPr sKsH) setIA (setIidPl sHMs) defKs -(dprodWY defW). -Qed. - -(* This is the part of B & G, Theorem II that is relevant to the proof of *) -(* Peterfalvi (8.7). We drop the considerations on the set of supporting *) -(* groups, in particular (Tii)(a), but do include additional information on D *) -(* namely the fact that D is included in 'A1(M), not just 'A(M). *) -Theorem BGsummaryII M (X : {set gT}) : - M \in 'M -> X \in pred2 'A(M) 'A0(M) -> - let D := [set x in X | ~~ ('C[x] \subset M)] in - [/\ D \subset 'A1(M), (* was 'A(M) in B & G *) - (*i*) {in X, forall x a, x ^ a \in X -> exists2 y, y \in M & x ^ a = x ^ y} - & {in D, forall x (L := 'N[x]), - [/\ (*ii*) 'M('C[x]) = [set L], FTtype L \in pred2 1%N 2, - [/\ (*b*) L`_\F ><| (M :&: L) = L, - (*c*) {in X, forall y, coprime #|L`_\F| #|'C_M[y]| }, - (*d*) x \in 'A(L) :\: 'A1(L) - & (*e*) 'C_(L`_\F)[x] ><| 'C_M[x] = 'C[x]] - & (*iii*) FTtype L == 2 -> - exists2 E, [Frobenius M = M`_\F ><| gval E] & cyclic E]}]. -Proof. -move=> maxM defX. -have sA0M: 'A0(M) \subset M := subset_trans (FTsupp0_sub M) (subsetDl M 1). -have sAA0: 'A(M) \subset 'A0(M) := FTsupp_sub0 M. -have sAM: 'A(M) \subset M := subset_trans sAA0 sA0M. -without loss {defX} ->: X / X = 'A0(M). - case/pred2P: defX => ->; move/(_ _ (erefl _))=> //. - set D0 := finset _ => [[sD0A1 tameA0 signD0]] D. - have sDD0: D \subset D0 by rewrite /D /D0 !setIdE setSI. - split=> [|x Ax a Axa|x Dx]; first exact: subset_trans sDD0 sD0A1. - by apply: tameA0; apply: (subsetP sAA0). - have [/= -> -> [-> coA0L -> -> frobL]] := signD0 x (subsetP sDD0 x Dx). - by do 2![split=> //] => y Ay; rewrite coA0L // (subsetP sAA0). -move=> {X} D; pose Ms := M`_\sigma. -have tiA0A x a: x \in 'A0(M) :\: 'A(M) -> x ^ a \notin 'A(M). - rewrite 3!inE; case: (x \in _) => //= /and3P[_ notM'x _]. - apply: contra notM'x => /bigcupP[y _ /setD1P[_ /setIP[Mx _]]]. - by rewrite -(p_eltJ _ _ a) (mem_p_elt (pgroup_pi _)). -have tiA0 x a: x \in 'A0(M) :\: 'A1(M) -> x ^ a \in 'A0(M) -> a \in M. - case/setDP=> A0x notA1x A0xa. - have [Mx Mxa] := (subsetP sA0M x A0x, subsetP sA0M _ A0xa). - have [[U K] /= complU] := kappa_witness maxM. - have [Ax | notAx] := boolP (x \in 'A(M)). - have [_ _ _ [_]] := BGsummaryB maxM complU; set B := _ :\: _ => tiB. - have Bx: x \in B by apply/setDP. - have /tiB/normedTI_memJ_P: 'A(M) != 'A1(M) by apply: contraTneq Ax => ->. - case=> _ _ /(_ x) <- //; rewrite 3?inE // conjg_eq1; apply/andP; split. - apply: contra notA1x; rewrite !inE def_FTcore // => /andP[->]. - by rewrite !(mem_Hall_pcore (Msigma_Hall maxM)) // p_eltJ. - by apply: contraLR Ax => notAxa; rewrite -(conjgK a x) tiA0A // inE notAxa. - have ntK: K :!=: 1. - rewrite -(trivgFmax maxM complU) FTtype_Fmax //. - by apply: contra notAx => /FTsupp0_type1 <-. - have [_ _ [_ [_ /normedTI_memJ_P[_ _ tiB]] _ _]]:= BGsummaryC maxM complU ntK. - by rewrite -(tiB x) inE ?tiA0A ?notAx // inE notAx. -have sDA1: D \subset 'A1(M). - apply/subsetPn=> [[x /setIdP[A0x not_sCxM] notA1x]]. - case/subsetP: not_sCxM => a cxa. - by apply: (tiA0 x); [apply/setDP | rewrite /conjg -(cent1P cxa) mulKg]. -have sDMs1: D \subset Ms^# by rewrite /Ms -def_FTcore. -have [tameMs _ signM PsignM] := BGsummaryD maxM. -split=> // [x A0x a A0xa|x Dx]. - have [A1x | notA1x] := boolP (x \in 'A1(M)); last first. - by exists a; rewrite // (tiA0 x) // inE notA1x. - case/setD1P: A1x => _; rewrite def_FTcore // => Ms_x. - apply/imsetP; rewrite tameMs ?mem_imset ?inE //. - rewrite (mem_Hall_pcore (Msigma_Hall maxM)) ?(subsetP sA0M) //. - by rewrite p_eltJ (mem_p_elt (pcore_pgroup _ _) Ms_x). -have [Ms1x [_ not_sCxM]] := (subsetP sDMs1 x Dx, setIdP Dx). -have [[uniqN defNF] [ANx typeN hallMN] type2] := PsignM x Ms1x not_sCxM. -have [maxN _] := mem_uniq_mmax uniqN. -split=> //; last 1 first. -- rewrite -FTtype_P2max // => /type2[FmaxM]. - by rewrite (Fcore_eq_Msigma maxM _) // notP1type_Msigma_nil ?FmaxM. -- by rewrite !inE -FTtype_Fmax // -FTtype_P2max // -in_setU. -split=> // [|y A0y|]; rewrite defNF ?sdprod_sigma //=; last by case/signM: Ms1x. -rewrite coprime_pi' ?cardG_gt0 // -pgroupE. -rewrite (eq_p'group _ (pi_Msigma maxN)); apply: wlog_neg => not_sNx'CMy. -have ell1x := Msigma_ell1 maxM Ms1x. -have SMxM: M \in 'M_\sigma[x] by rewrite inE maxM cycle_subG; case/setD1P: Ms1x. -have MSx_gt1: #|'M_\sigma[x]| > 1. - rewrite ltn_neqAle lt0n {2}(cardD1 M) SMxM andbT eq_sym. - by apply: contra not_sCxM; move/cent1_sub_uniq_sigma_mmax->. -have [FmaxM t2'M]: M \in 'M_'F /\ \tau2(M)^'.-group M. - apply: (non_disjoint_signalizer_Frobenius ell1x MSx_gt1 SMxM). - by apply: contra not_sNx'CMy; apply: pgroupS (subsetIl _ _). -have defA0: 'A0(M) = Ms^#. - rewrite FTsupp0_type1; last by rewrite -FTtype_Fmax. - rewrite /'A(M) /'A1(M) -FTtype_Fmax // FmaxM def_FTcore //= -/Ms. - apply/setP => z; apply/bigcupP/idP=> [[t Ms1t] | Ms1z]; last first. - have [ntz Ms_z] := setD1P Ms1z. - by exists z; rewrite // 3!inE ntz cent1id (subsetP (pcore_sub _ _) z Ms_z). - case/setD1P=> ntz; case/setIP=> Mz ctz. - rewrite 2!inE ntz (mem_Hall_pcore (Msigma_Hall maxM)) //. - apply: sub_in_pnat (pnat_pi (order_gt0 z)) => p _ pi_z_p. - have szM: <[z]> \subset M by rewrite cycle_subG. - have [piMp [_ k'M]] := (piSg szM pi_z_p, setIdP FmaxM). - apply: contraR (pnatPpi k'M piMp) => s'p /=. - rewrite unlock; apply/andP; split. - have:= piMp; rewrite (partition_pi_mmax maxM) (negPf s'p) orbF. - by rewrite orbCA [p \in _](negPf (pnatPpi t2'M piMp)). - move: pi_z_p; rewrite -p_rank_gt0 /= -(setIidPr szM). - case/p_rank_geP=> P; rewrite pnElemI -setIdE => /setIdP[EpP sPz]. - apply/exists_inP; exists P => //; apply/trivgPn. - have [ntt Ms_t] := setD1P Ms1t; exists t => //. - by rewrite inE Ms_t (subsetP (centS sPz)) // cent_cycle cent1C. -move: A0y; rewrite defA0 => /setD1P[nty Ms_y]. -have sCyMs: 'C_M[y] \subset Ms. - rewrite -[Ms](setD1K (group1 _)) -subDset /= -defA0 subsetU //. - rewrite (bigcup_max y) //; first by rewrite 2!inE nty def_FTcore. - by rewrite -FTtype_Fmax ?FmaxM. -have notMGN: gval 'N[x] \notin M :^: G. - have [_ [//|_ _ t2Nx _ _]] := FT_signalizer_context ell1x. - have [ntx Ms_x] := setD1P Ms1x; have sMx := mem_p_elt (pcore_pgroup _ _) Ms_x. - apply: contra ntx => /imsetP[a _ defN]. - rewrite -order_eq1 (pnat_1 sMx (sub_p_elt _ t2Nx)) // => p. - by rewrite defN tau2J // => /andP[]. -apply: sub_pgroup (pgroupS sCyMs (pcore_pgroup _ _)) => p sMp. -by apply: contraFN (sigma_partition maxM maxN notMGN p) => sNp; apply/andP. -Qed. - -End Section16. - - diff --git a/mathcomp/odd_order/BGsection2.v b/mathcomp/odd_order/BGsection2.v deleted file mode 100644 index 85b95b2..0000000 --- a/mathcomp/odd_order/BGsection2.v +++ /dev/null @@ -1,1161 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div fintype. -From mathcomp -Require Import bigop prime binomial finset fingroup morphism perm automorphism. -From mathcomp -Require Import quotient action gfunctor commutator gproduct. -From mathcomp -Require Import ssralg finalg zmodp cyclic center pgroup gseries nilpotent. -From mathcomp -Require Import sylow abelian maximal hall. -From mathcomp -Require poly ssrint. -From mathcomp -Require Import matrix mxalgebra mxrepresentation mxabelem. -From mathcomp -Require Import BGsection1. - -(******************************************************************************) -(* This file covers the useful material in B & G, Section 2. This excludes *) -(* part (c) of Proposition 2.1 and part (b) of Proposition 2.2, which are not *) -(* actually used in the rest of the proof; also the rest of Proposition 2.1 *) -(* is already covered by material in file mxrepresentation.v. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Section BGsection2. - -Import GroupScope GRing.Theory FinRing.Theory poly.UnityRootTheory ssrint.IntDist. -Local Open Scope ring_scope. - -Implicit Types (F : fieldType) (gT : finGroupType) (p : nat). - -(* File mxrepresentation.v covers B & G, Proposition 2.1 as follows: *) -(* - Proposition 2.1 (a) is covered by Lemmas mx_abs_irr_cent_scalar and *) -(* cent_mx_scalar_abs_irr. *) -(* - Proposition 2.2 (b) is our definition of "absolutely irreducible", and *) -(* is thus covered by cent_mx_scalar_abs_irr and mx_abs_irrP. *) -(* - Proposition 2.2 (c) is partly covered by the construction in submodule *) -(* MatrixGenField, which extends the base field with a single element a of *) -(* K = Hom_FG(M, M), rather than all of K, thus avoiding the use of the *) -(* Wedderburn theorem on finite division rings (by the primitive element *) -(* theorem this is actually equivalent). The corresponding representation *) -(* is built by MatrixGenField.gen_repr. In B & G, Proposition 2.1(c) is *) -(* only used in case II of the proof of Theorem 3.10, which we greatly *) -(* simplify by making use of the Wielandt fixpoint formula, following *) -(* Peterfalvi (Theorem 9.1). In this formalization the limited form of *) -(* 2.1(c) is used to streamline the proof that groups of odd order are *) -(* p-stable (B & G, Appendix A.5(c)). *) - -(* This is B & G, Proposition 2.2(a), using internal isomorphims (mx_iso). *) -Proposition mx_irr_prime_index F gT (G H : {group gT}) n M (nsHG : H <| G) - (rG : mx_representation F G n) (rH := subg_repr rG (normal_sub nsHG)) : - group_closure_field F gT -> mx_irreducible rG -> cyclic (G / H)%g -> - mxsimple rH M -> {in G, forall x, mx_iso rH M (M *m rG x)} -> - mx_irreducible rH. -Proof. -move=> closedF irrG /cyclicP[Hx defGH] simM isoM; have [sHG nHG] := andP nsHG. -have [modM nzM _] := simM; pose E_H := enveloping_algebra_mx rH. -have absM f: (M *m f <= M)%MS -> {a | (a \in E_H)%MS & M *m a = M *m f}. - move=> sMf; set rM := submod_repr modM; set E_M := enveloping_algebra_mx rM. - pose u := mxvec (in_submod M (val_submod 1%:M *m f)) *m pinvmx E_M. - have EHu: (gring_mx rH u \in E_H)%MS := gring_mxP rH u. - exists (gring_mx rH u) => //; rewrite -(in_submodK sMf). - rewrite -(in_submodK (mxmodule_envelop modM EHu _)) //; congr (val_submod _). - transitivity (in_submod M M *m gring_mx rM u). - rewrite /gring_mx /= !mulmx_sum_row !linear_sum; apply: eq_bigr => i /= _. - by rewrite !linearZ /= !rowK !mxvecK -in_submodJ. - rewrite /gring_mx /= mulmxKpV ?submx_full ?mxvecK //; last first. - by have/andP[]: mx_absolutely_irreducible rM by apply/closedF/submod_mx_irr. - rewrite {1}[in_submod]lock in_submodE -mulmxA mulmxA -val_submodE -lock. - by rewrite mulmxA -in_submodE in_submodK. -have /morphimP[x nHx Gx defHx]: Hx \in (G / H)%g by rewrite defGH cycle_id. -have{Hx defGH defHx} defG : G :=: <[x]> <*> H. - rewrite -(quotientGK nsHG) defGH defHx -quotient_cycle //. - by rewrite joingC quotientK ?norm_joinEr // cycle_subG. -have [e def1]: exists e, 1%:M = \sum_(z in G) e z *m (M *m rG z). - apply/sub_sumsmxP; have [X sXG [<- _]] := Clifford_basis irrG simM. - by apply/sumsmx_subP=> z Xz; rewrite (sumsmx_sup z) ?(subsetP sXG). -have [phi inj_phi hom_phi defMx] := isoM x Gx. -have Mtau: (M *m (phi *m rG x^-1%g) <= M)%MS. - by rewrite mulmxA (eqmxMr _ defMx) repr_mxK. -have Mtau': (M *m (rG x *m invmx phi) <= M)%MS. - by rewrite mulmxA -(eqmxMr _ defMx) mulmxK. -have [[tau Htau defMtau] [tau' Htau' defMtau']] := (absM _ Mtau, absM _ Mtau'). -have tau'K: tau' *m tau = 1%:M. - rewrite -[tau']mul1mx def1 !mulmx_suml; apply: eq_bigr => z Gz. - have [f _ hom_f] := isoM z Gz; move/eqmxP; case/andP=> _; case/submxP=> v ->. - rewrite (mulmxA _ v) -2!mulmxA; congr (_ *m _). - rewrite -(hom_envelop_mxC hom_f) ?envelop_mxM //; congr (_ *m _). - rewrite mulmxA defMtau' -(mulmxKpV Mtau') -mulmxA defMtau (mulmxA _ M). - by rewrite mulmxKpV // !mulmxA mulmxKV // repr_mxK. -have cHtau_x: centgmx rH (tau *m rG x). - apply/centgmxP=> y Hy; have [u defMy] := submxP (mxmoduleP modM y Hy). - have Gy := subsetP sHG y Hy. - rewrite mulmxA; apply: (canRL (repr_mxKV rG Gx)). - rewrite -!mulmxA /= -!repr_mxM ?groupM ?groupV // (conjgC y) mulKVg. - rewrite -[rG y]mul1mx -{1}[tau]mul1mx def1 !mulmx_suml. - apply: eq_bigr => z Gz; have [f _ hom_f] := isoM z Gz. - move/eqmxP; case/andP=> _; case/submxP=> v ->; rewrite -!mulmxA. - congr (_ *m (_ *m _)); rewrite {v} !(mulmxA M). - rewrite -!(hom_envelop_mxC hom_f) ?envelop_mxM ?(envelop_mx_id rH) //. - congr (_ *m f); rewrite !mulmxA defMy -(mulmxA u) defMtau (mulmxA u) -defMy. - rewrite !mulmxA (hom_mxP hom_phi) // -!mulmxA; congr (M *m (_ *m _)). - by rewrite /= -!repr_mxM ?groupM ?groupV // -conjgC. - by rewrite -mem_conjg (normsP nHG). -have{cHtau_x} cGtau_x: centgmx rG (tau *m rG x). - rewrite /centgmx {1}defG join_subG cycle_subG !inE Gx /= andbC. - rewrite (subset_trans cHtau_x); last by rewrite rcent_subg subsetIr. - apply/eqP; rewrite -{2 3}[rG x]mul1mx -tau'K !mulmxA; congr (_ *m _ *m _). - case/envelop_mxP: Htau' => u ->. - rewrite !(mulmx_suml, mulmx_sumr); apply: eq_bigr => y Hy. - by rewrite -!(scalemxAl, scalemxAr) (centgmxP cHtau_x) ?mulmxA. -have{cGtau_x} [a def_tau_x]: exists a, tau *m rG x = a%:M. - by apply/is_scalar_mxP; apply: mx_abs_irr_cent_scalar cGtau_x; apply: closedF. -apply: mx_iso_simple (eqmx_iso _ _) simM; apply/eqmxP; rewrite submx1 sub1mx. -case/mx_irrP: (irrG) => _ -> //; rewrite /mxmodule {1}defG join_subG /=. -rewrite cycle_subG inE Gx andbC (subset_trans modM) ?rstabs_subg ?subsetIr //=. -rewrite -{1}[M]mulmx1 -tau'K mulmxA -mulmxA def_tau_x mul_mx_scalar. -by rewrite scalemx_sub ?(mxmodule_envelop modM Htau'). -Qed. - -(* This is B & G, Lemma 2.3. Note that this is not used in the FT proof. *) -Lemma rank_abs_irr_dvd_solvable F gT (G : {group gT}) n rG : - @mx_absolutely_irreducible F _ G n rG -> solvable G -> n %| #|G|. -Proof. -move=> absG solG. -without loss closF: F rG absG / group_closure_field F gT. - move=> IH; apply: (@group_closure_field_exists gT F) => [[F' f closF']]. - by apply: IH (map_repr f rG) _ closF'; rewrite map_mx_abs_irr. -elim: {G}_.+1 {-2}G (ltnSn #|G|) => // m IHm G leGm in n rG absG solG *. -have [G1 | ntG] := eqsVneq G 1%g. - by rewrite abelian_abs_irr ?G1 ?abelian1 // in absG; rewrite (eqP absG) dvd1n. -have [H nsHG p_pr] := sol_prime_factor_exists solG ntG. -set p := #|G : H| in p_pr. -pose sHG := normal_sub nsHG; pose rH := subg_repr rG sHG. -have irrG := mx_abs_irrW absG. -wlog [L simL _]: / exists2 L, mxsimple rH L & (L <= 1%:M)%MS. - by apply: mxsimple_exists; rewrite ?mxmodule1 //; case: irrG. -have ltHG: H \proper G. - by rewrite properEcard sHG -(Lagrange sHG) ltn_Pmulr // prime_gt1. -have dvLH: \rank L %| #|H|. - have absL: mx_absolutely_irreducible (submod_repr (mxsimple_module simL)). - exact/closF/submod_mx_irr. - apply: IHm absL (solvableS (normal_sub nsHG) solG). - by rewrite (leq_trans (proper_card ltHG)). -have [_ [x Gx H'x]] := properP ltHG. -have prGH: prime #|G / H|%g by rewrite card_quotient ?normal_norm. -wlog sH: / socleType rH by apply: socle_exists. -pose W := PackSocle (component_socle sH simL). -have card_sH: #|sH| = #|G : 'C_G[W | 'Cl]|. - rewrite -cardsT; have ->: setT = orbit 'Cl G W. - apply/eqP; rewrite eqEsubset subsetT. - have /imsetP[W' _ defW'] := Clifford_atrans irrG sH. - have WW': W' \in orbit 'Cl G W by rewrite orbit_in_sym // -defW' inE. - by rewrite defW' andbT; apply/subsetP=> W'' /orbit_in_trans->. - rewrite orbit_stabilizer // card_in_imset //. - exact: can_in_inj (act_reprK _). -have sHcW: H \subset 'C_G[W | 'Cl]. - apply: subset_trans (subset_trans (joing_subl _ _) (Clifford_astab sH)) _. - by rewrite subsetI subsetIl astabS ?subsetT. -have [|] := prime_subgroupVti ('C_G[W | 'Cl] / H)%G prGH. - rewrite quotientSGK ?normal_norm // => cClG. - have def_sH: setT = [set W]. - apply/eqP; rewrite eq_sym eqEcard subsetT cards1 cardsT card_sH. - by rewrite -indexgI (setIidPl cClG) indexgg. - suffices L1: (L :=: 1%:M)%MS. - by rewrite L1 mxrank1 in dvLH; apply: dvdn_trans (cardSg sHG). - apply/eqmxP; rewrite submx1. - have cycH: cyclic (G / H)%g by rewrite prime_cyclic. - have [y Gy|_ _] := mx_irr_prime_index closF irrG cycH simL; last first. - by apply; rewrite ?submx1 //; case simL. - have simLy: mxsimple rH (L *m rG y) by apply: Clifford_simple. - pose Wy := PackSocle (component_socle sH simLy). - have: (L *m rG y <= Wy)%MS by rewrite PackSocleK component_mx_id. - have ->: Wy = W by apply/set1P; rewrite -def_sH inE. - by rewrite PackSocleK; apply: component_mx_iso. -rewrite (setIidPl _) ?quotientS ?subsetIl // => /trivgP. -rewrite quotient_sub1 //; last by rewrite subIset // normal_norm. -move/setIidPl; rewrite (setIidPr sHcW) /= => defH. -rewrite -(Lagrange sHG) -(Clifford_rank_components irrG W) card_sH -defH. -rewrite mulnC dvdn_pmul2r // (_ : W :=: L)%MS //; apply/eqmxP. -have sLW: (L <= W)%MS by rewrite PackSocleK component_mx_id. -rewrite andbC sLW; have [modL nzL _] := simL. -have [_ _] := (Clifford_rstabs_simple irrG W); apply=> //. -rewrite /mxmodule rstabs_subg /= -Clifford_astab1 -astabIdom -defH. -by rewrite -(rstabs_subg rG sHG). -Qed. - -(* This section covers the many parts B & G, Proposition 2.4; only the last *) -(* part (k) in used in the rest of the proof, and then only for Theorem 2.5. *) -Section QuasiRegularCyclic. - -Variables (F : fieldType) (q' h : nat). - -Local Notation q := q'.+1. -Local Notation V := 'rV[F]_q. -Local Notation E := 'M[F]_q. - -Variables (g : E) (eps : F). - -Hypothesis gh1 : g ^+ h = 1. -Hypothesis prim_eps : h.-primitive_root eps. - -Let h_gt0 := prim_order_gt0 prim_eps. -Let eps_h := prim_expr_order prim_eps. -Let eps_mod_h m := expr_mod m eps_h. -Let inj_eps : injective (fun i : 'I_h => eps ^+ i). -Proof. -move=> i j eq_ij; apply/eqP; move/eqP: eq_ij. -by rewrite (eq_prim_root_expr prim_eps) !modn_small. -Qed. - -Let inhP m : m %% h < h. Proof. by rewrite ltn_mod. Qed. -Let inh m := Ordinal (inhP m). - -Let V_ i := eigenspace g (eps ^+ i). -Let n_ i := \rank (V_ i). -Let E_ i := eigenspace (lin_mx (mulmx g^-1 \o mulmxr g)) (eps ^+ i). -Let E2_ i t := - (kermx (lin_mx (mulmxr (cokermx (V_ t)) \o mulmx (V_ i))) - :&: kermx (lin_mx (mulmx (\sum_(j < h | j != i %[mod h]) V_ j)%MS)))%MS. - -Local Notation "''V_' i" := (V_ i) (at level 8, i at level 2, format "''V_' i"). -Local Notation "''n_' i" := (n_ i) (at level 8, i at level 2, format "''n_' i"). -Local Notation "''E_' i" := (E_ i) (at level 8, i at level 2, format "''E_' i"). -Local Notation "'E_ ( i )" := (E_ i) (at level 8, only parsing). -Local Notation "e ^g" := (g^-1 *m (e *m g)) - (at level 8, format "e ^g") : ring_scope. -Local Notation "'E_ ( i , t )" := (E2_ i t) - (at level 8, format "''E_' ( i , t )"). - -Let inj_g : g \in GRing.unit. -Proof. by rewrite -(unitrX_pos _ h_gt0) gh1 unitr1. Qed. - -Let Vi_mod i : 'V_(i %% h) = 'V_i. -Proof. by rewrite /V_ eps_mod_h. Qed. - -Let g_mod i := expr_mod i gh1. - -Let EiP i e : reflect (e^g = eps ^+ i *: e) (e \in 'E_i)%MS. -Proof. -rewrite (sameP eigenspaceP eqP) mul_vec_lin -linearZ /=. -by rewrite (can_eq mxvecK); apply: eqP. -Qed. - -Let E2iP i t e : - reflect ('V_i *m e <= 'V_t /\ forall j, j != i %[mod h] -> 'V_j *m e = 0)%MS - (e \in 'E_(i, t))%MS. -Proof. -rewrite sub_capmx submxE !(sameP sub_kermxP eqP) /=. -rewrite !mul_vec_lin !mxvec_eq0 /= -submxE -submx0 sumsmxMr. -apply: (iffP andP) => [[->] | [-> Ve0]]; last first. - by split=> //; apply/sumsmx_subP=> j ne_ji; rewrite Ve0. -move/sumsmx_subP=> Ve0; split=> // j ne_ji; apply/eqP. -by rewrite -submx0 -Vi_mod (Ve0 (inh j)) //= modn_mod. -Qed. - -Let sumV := (\sum_(i < h) 'V_i)%MS. - -(* This is B & G, Proposition 2.4(a). *) -Proposition mxdirect_sum_eigenspace_cycle : (sumV :=: 1%:M)%MS /\ mxdirect sumV. -Proof. -have splitF: group_splitting_field F (Zp_group h). - move: prim_eps (abelianS (subsetT (Zp h)) (Zp_abelian _)). - by rewrite -{1}(card_Zp h_gt0); apply: primitive_root_splitting_abelian. -have F'Zh: [char F]^'.-group (Zp h). - apply/pgroupP=> p p_pr; rewrite card_Zp // => /dvdnP[d def_h]. - apply/negP=> /= charFp. - have d_gt0: d > 0 by move: h_gt0; rewrite def_h; case d. - have: eps ^+ d == 1. - rewrite -(inj_eq (fmorph_inj [rmorphism of Frobenius_aut charFp])). - by rewrite rmorph1 /= Frobenius_autE -exprM -def_h eps_h. - by rewrite -(prim_order_dvd prim_eps) gtnNdvd // def_h ltn_Pmulr // prime_gt1. -case: (ltngtP h 1) => [|h_gt1|h1]; last first; last by rewrite ltnNge h_gt0. - rewrite /sumV mxdirectE /= h1 !big_ord1; split=> //. - apply/eqmxP; rewrite submx1; apply/eigenspaceP. - by rewrite mul1mx scale1r idmxE -gh1 h1. -pose mxZ (i : 'Z_h) := g ^+ i. -have mxZ_repr: mx_repr (Zp h) mxZ. - by split=> // i j _ _; rewrite /mxZ /= {3}Zp_cast // expr_mod // exprD. -pose rZ := MxRepresentation mxZ_repr. -have ZhT: Zp h = setT by rewrite /Zp h_gt1. -have memZh: _ \in Zp h by move=> i; rewrite ZhT inE. -have def_g: g = rZ Zp1 by []. -have lin_rZ m (U : 'M_(m, q)) a: - U *m g = a *: U -> forall i, U *m rZ i%:R = (a ^+ i) *: U. -- move=> defUg i; rewrite repr_mxX //. - elim: i => [|i IHi]; first by rewrite mulmx1 scale1r. - by rewrite !exprS -scalerA mulmxA defUg -IHi scalemxAl. -rewrite mxdirect_sum_eigenspace => [|j k _ _]; last exact: inj_eps. -split=> //; apply/eqmxP; rewrite submx1. -wlog [I M /= simM <- _]: / mxsemisimple rZ 1. - exact: mx_reducible_semisimple (mxmodule1 _) (mx_Maschke rZ F'Zh) _. -apply/sumsmx_subP=> i _; have simMi := simM i; have [modMi _ _] := simMi. -set v := nz_row (M i); have nz_v: v != 0 by apply: nz_row_mxsimple simMi. -have rankMi: \rank (M i) = 1%N. - by rewrite (mxsimple_abelian_linear splitF _ simMi) //= ZhT Zp_abelian. -have defMi: (M i :=: v)%MS. - apply/eqmxP; rewrite andbC -(geq_leqif (mxrank_leqif_eq _)) ?nz_row_sub //. - by rewrite rankMi lt0n mxrank_eq0. -have [a defvg]: exists a, v *m rZ 1%R = a *: v. - by apply/sub_rVP; rewrite -defMi mxmodule_trans ?socle_module ?defMi. -have: a ^+ h - 1 == 0. - apply: contraR nz_v => nz_pZa; rewrite -(eqmx_eq0 (eqmx_scale _ nz_pZa)). - by rewrite scalerBl scale1r -lin_rZ // subr_eq0 char_Zp ?mulmx1. -rewrite subr_eq0; move/eqP; case/(prim_rootP prim_eps) => k def_a. -by rewrite defMi (sumsmx_sup k) // /V_ -def_a; apply/eigenspaceP. -Qed. - -(* This is B & G, Proposition 2.4(b). *) -Proposition rank_step_eigenspace_cycle i : 'n_ (i + h) = 'n_ i. -Proof. by rewrite /n_ -Vi_mod modnDr Vi_mod. Qed. - -Let sumE := (\sum_(it : 'I_h * 'I_h) 'E_(it.1, it.2))%MS. - -(* This is B & G, Proposition 2.4(c). *) -Proposition mxdirect_sum_proj_eigenspace_cycle : - (sumE :=: 1%:M)%MS /\ mxdirect sumE. -Proof. -have [def1V] := mxdirect_sum_eigenspace_cycle; move/mxdirect_sumsP=> dxV. -pose p (i : 'I_h) := proj_mx 'V_i (\sum_(j | j != i) 'V_j)%MS. -have def1p: 1%:M = \sum_i p i. - rewrite -[\sum_i _]mul1mx; move/eqmxP: def1V; rewrite submx1. - case/sub_sumsmxP=> u ->; rewrite mulmx_sumr; apply: eq_bigr => i _. - rewrite (bigD1 i) //= mulmxDl proj_mx_id ?submxMl ?dxV //. - rewrite proj_mx_0 ?dxV ?addr0 ?summx_sub // => j ne_ji. - by rewrite (sumsmx_sup j) ?submxMl. -split; first do [apply/eqmxP; rewrite submx1]. - apply/(@memmx_subP F _ _ q)=> A _; apply/memmx_sumsP. - pose B i t := p i *m A *m p t. - exists (fun it => B it.1 it.2) => [|[i t] /=]. - rewrite -(pair_bigA _ B) /= -[A]mul1mx def1p mulmx_suml. - by apply: eq_bigr => i _; rewrite -mulmx_sumr -def1p mulmx1. - apply/E2iP; split=> [|j ne_ji]; first by rewrite mulmxA proj_mx_sub. - rewrite 2!mulmxA -mulmxA proj_mx_0 ?dxV ?mul0mx //. - rewrite (sumsmx_sup (inh j)) ?Vi_mod //. - by rewrite (modn_small (valP i)) in ne_ji. -apply/mxdirect_sumsP=> [[i t] _] /=. -apply/eqP; rewrite -submx0; apply/(@memmx_subP F _ _ q)=> A. -rewrite sub_capmx submx0 mxvec_eq0 -submx0. -case/andP=> /E2iP[ViA Vi'A] /memmx_sumsP[B /= defA sBE]. -rewrite -[A]mul1mx -(eqmxMr A def1V) sumsmxMr (bigD1 i) //=. -rewrite big1 ?addsmx0 => [|j ne_ij]; last by rewrite Vi'A ?modn_small. -rewrite -[_ *m A]mulmx1 def1p mulmx_sumr (bigD1 t) //=. -rewrite big1 ?addr0 => [|u ne_ut]; last first. - by rewrite proj_mx_0 ?dxV ?(sumsmx_sup t) // eq_sym. -rewrite {A ViA Vi'A}defA mulmx_sumr mulmx_suml summx_sub // => [[j u]]. -case/E2iP: (sBE (j, u)); rewrite eqE /=; case: eqP => [-> sBu _ ne_ut|]. - by rewrite proj_mx_0 ?dxV ?(sumsmx_sup u). -by move/eqP=> ne_ji _ ->; rewrite ?mul0mx // eq_sym !modn_small. -Qed. - -(* This is B & G, Proposition 2.4(d). *) -Proposition rank_proj_eigenspace_cycle i t : \rank 'E_(i, t) = ('n_i * 'n_t)%N. -Proof. -have [def1V] := mxdirect_sum_eigenspace_cycle; move/mxdirect_sumsP=> dxV. -pose p (i : 'I_h) := proj_mx 'V_i (\sum_(j | j != i) 'V_j)%MS. -have def1p: 1%:M = \sum_i p i. - rewrite -[\sum_i _]mul1mx; move/eqmxP: def1V; rewrite submx1. - case/sub_sumsmxP=> u ->; rewrite mulmx_sumr; apply: eq_bigr => j _. - rewrite (bigD1 j) //= mulmxDl proj_mx_id ?submxMl ?dxV //. - rewrite proj_mx_0 ?dxV ?addr0 ?summx_sub // => k ne_kj. - by rewrite (sumsmx_sup k) ?submxMl. -move: i t => i0 t0; pose i := inh i0; pose t := inh t0. -transitivity (\rank 'E_(i, t)); first by rewrite /E2_ !Vi_mod modn_mod. -transitivity ('n_i * 'n_t)%N; last by rewrite /n_ !Vi_mod. -move: {i0 t0}i t => i t; pose Bi := row_base 'V_i; pose Bt := row_base 'V_t. -pose B := lin_mx (mulmx (p i *m pinvmx Bi) \o mulmxr Bt). -pose B' := lin_mx (mulmx Bi \o mulmxr (pinvmx Bt)). -have Bk : B *m B' = 1%:M. - have frVpK m (C : 'M[F]_(m, q)) : row_free C -> C *m pinvmx C = 1%:M. - by move/row_free_inj; apply; rewrite mul1mx mulmxKpV. - apply/row_matrixP=> k; rewrite row_mul mul_rV_lin /= rowE mx_rV_lin /= -row1. - rewrite (mulmxA _ _ Bt) -(mulmxA _ Bt) [Bt *m _]frVpK ?row_base_free //. - rewrite mulmx1 2!mulmxA proj_mx_id ?dxV ?eq_row_base //. - by rewrite frVpK ?row_base_free // mul1mx vec_mxK. -have <-: \rank B = ('n_i * 'n_t)%N by apply/eqP; apply/row_freeP; exists B'. -apply/eqP; rewrite eqn_leq !mxrankS //. - apply/row_subP=> k; rewrite rowE mul_rV_lin /=. - apply/E2iP; split=> [|j ne_ji]. - rewrite 3!mulmxA mulmx_sub ?eq_row_base //. - rewrite 2!(mulmxA 'V_j) proj_mx_0 ?dxV ?mul0mx //. - rewrite (sumsmx_sup (inh j)) ?Vi_mod //. - by rewrite (modn_small (valP i)) in ne_ji. -apply/(@memmx_subP F _ _ q) => A /E2iP[ViA Vi'A]. -apply/submxP; exists (mxvec (Bi *m A *m pinvmx Bt)); rewrite mul_vec_lin /=. -rewrite mulmxKpV; last by rewrite eq_row_base (eqmxMr _ (eq_row_base _)). -rewrite mulmxA -[p i]mul1mx mulmxKpV ?eq_row_base ?proj_mx_sub // mul1mx. -rewrite -{1}[A]mul1mx def1p mulmx_suml (bigD1 i) //= big1 ?addr0 // => j neji. -rewrite -[p j]mul1mx -(mulmxKpV (proj_mx_sub _ _ _)) -mulmxA Vi'A ?mulmx0 //. -by rewrite !modn_small. -Qed. - -(* This is B & G, Proposition 2.4(e). *) -Proposition proj_eigenspace_cycle_sub_quasi_cent i j : - ('E_(i, i + j) <= 'E_j)%MS. -Proof. -apply/(@memmx_subP F _ _ q)=> A /E2iP[ViA Vi'A]. -apply/EiP; apply: canLR (mulKmx inj_g) _; rewrite -{1}[A]mul1mx -{2}[g]mul1mx. -have: (1%:M <= sumV)%MS by have [->] := mxdirect_sum_eigenspace_cycle. -case/sub_sumsmxP=> p ->; rewrite -!mulmxA !mulmx_suml. -apply: eq_bigr=> k _; have [-> | ne_ki] := eqVneq (k : nat) (i %% h)%N. - rewrite Vi_mod -mulmxA (mulmxA _ A) (eigenspaceP ViA). - rewrite (mulmxA _ g) (eigenspaceP (submxMl _ _)). - by rewrite -!(scalemxAl, scalemxAr) scalerA mulmxA exprD. -rewrite 2!mulmxA (eigenspaceP (submxMl _ _)) -!(scalemxAr, scalemxAl). -by rewrite -(mulmxA _ 'V_k A) Vi'A ?linear0 ?mul0mx ?scaler0 // modn_small. -Qed. - -Let diagE m := - (\sum_(it : 'I_h * 'I_h | it.1 + m == it.2 %[mod h]) 'E_(it.1, it.2))%MS. - -(* This is B & G, Proposition 2.4(f). *) -Proposition diag_sum_proj_eigenspace_cycle m : - (diagE m :=: 'E_m)%MS /\ mxdirect (diagE m). -Proof. -have sub_diagE n: (diagE n <= 'E_n)%MS. - apply/sumsmx_subP=> [[i t] /= def_t]. - apply: submx_trans (proj_eigenspace_cycle_sub_quasi_cent i n). - by rewrite /E2_ -(Vi_mod (i + n)) (eqP def_t) Vi_mod. -pose sum_diagE := (\sum_(n < h) diagE n)%MS. -pose p (it : 'I_h * 'I_h) := inh (h - it.1 + it.2). -have def_diag: sum_diagE = sumE. - rewrite /sumE (partition_big p xpredT) //. - apply: eq_bigr => n _; apply: eq_bigl => [[i t]] /=. - rewrite /p -val_eqE /= -(eqn_modDl (h - i)). - by rewrite addnA subnK 1?ltnW // modnDl modn_small. -have [Efull dxE] := mxdirect_sum_proj_eigenspace_cycle. -have /mxdirect_sumsE[/= dx_diag rank_diag]: mxdirect sum_diagE. - apply/mxdirectP; rewrite /= -/sum_diagE def_diag (mxdirectP dxE) /=. - rewrite (partition_big p xpredT) //. - apply: eq_bigr => n _; apply: eq_bigl => [[i t]] /=. - symmetry; rewrite /p -val_eqE /= -(eqn_modDl (h - i)). - by rewrite addnA subnK 1?ltnW // modnDl modn_small. -have dx_sumE1: mxdirect (\sum_(i < h) 'E_i). - by apply: mxdirect_sum_eigenspace => i j _ _; apply: inj_eps. -have diag_mod n: diagE (n %% h) = diagE n. - by apply: eq_bigl=> it; rewrite modnDmr. -split; last first. - apply/mxdirectP; rewrite /= -/(diagE m) -diag_mod. - rewrite (mxdirectP (dx_diag (inh m) _)) //=. - by apply: eq_bigl=> it; rewrite modnDmr. -apply/eqmxP; rewrite sub_diagE /=. -rewrite -(capmx_idPl (_ : _ <= sumE))%MS ?Efull ?submx1 //. -rewrite -def_diag /sum_diagE (bigD1 (inh m)) //= addsmxC. -rewrite diag_mod -matrix_modr ?sub_diagE //. -rewrite ((_ :&: _ =P 0)%MS _) ?adds0mx // -submx0. -rewrite -{2}(mxdirect_sumsP dx_sumE1 (inh m)) ?capmxS //. - by rewrite /E_ eps_mod_h. -by apply/sumsmx_subP=> i ne_i_m; rewrite (sumsmx_sup i) ?sub_diagE. -Qed. - -(* This is B & G, Proposition 2.4(g). *) -Proposition rank_quasi_cent_cycle m : - \rank 'E_m = (\sum_(i < h) 'n_i * 'n_(i + m))%N. -Proof. -have [<- dx_diag] := diag_sum_proj_eigenspace_cycle m. -rewrite (mxdirectP dx_diag) /= (reindex (fun i : 'I_h => (i, inh (i + m)))) /=. - apply: eq_big => [i | i _]; first by rewrite modn_mod eqxx. - by rewrite rank_proj_eigenspace_cycle /n_ Vi_mod. -exists (@fst _ _) => // [] [i t] /=. -by rewrite !inE /= (modn_small (valP t)) => def_t; apply/eqP/andP. -Qed. - -(* This is B & G, Proposition 2.4(h). *) -Proposition diff_rank_quasi_cent_cycle m : - (2 * \rank 'E_0 = 2 * \rank 'E_m + \sum_(i < h) `|'n_i - 'n_(i + m)| ^ 2)%N. -Proof. -rewrite !rank_quasi_cent_cycle !{1}mul2n -addnn. -rewrite {1}(reindex (fun i : 'I_h => inh (i + m))) /=; last first. - exists (fun i : 'I_h => inh (i + (h - m %% h))%N) => i _. - apply: val_inj; rewrite /= modnDml -addnA addnCA -modnDml addnCA. - by rewrite subnKC 1?ltnW ?ltn_mod // modnDr modn_small. - apply: val_inj; rewrite /= modnDml -modnDmr -addnA. - by rewrite subnK 1?ltnW ?ltn_mod // modnDr modn_small. -rewrite -mul2n big_distrr -!big_split /=; apply: eq_bigr => i _. -by rewrite !addn0 (addnC (2 * _)%N) sqrn_dist addnC /n_ Vi_mod. -Qed. - -Hypothesis rankEm : forall m, m != 0 %[mod h] -> \rank 'E_0 = (\rank 'E_m).+1. - -(* This is B & G, Proposition 2.4(j). *) -Proposition rank_eigenspaces_quasi_homocyclic : - exists2 n, `|q - h * n| = 1%N & - exists i : 'I_h, [/\ `|'n_i - n| = 1%N, (q < h * n) = ('n_i < n) - & forall j, j != i -> 'n_j = n]. -Proof. -have [defV dxV] := mxdirect_sum_eigenspace_cycle. -have sum_n: (\sum_(i < h) 'n_i)%N = q by rewrite -(mxdirectP dxV) defV mxrank1. -suffices [n [i]]: exists n : nat, exists2 i : 'I_h, - `|'n_i - n| == 1%N & forall i', i' != i -> 'n_i' = n. -- move/eqP=> n_i n_i'; rewrite -{1 5}(prednK h_gt0). - rewrite -sum_n (bigD1 i) //= (eq_bigr _ n_i') sum_nat_const cardC1 card_ord. - by exists n; last exists i; rewrite ?distnDr ?ltn_add2r. -case: (leqP h 1) sum_n {defV dxV} => [|h_gt1 _]. - rewrite leq_eqVlt ltnNge h_gt0 orbF; move/eqP->; rewrite big_ord1 => n_0. - by exists q', 0 => [|i']; rewrite ?(ord1 i') // n_0 distSn. -pose dn1 i := `|'n_i - 'n_(i + 1)|. -have sum_dn1: (\sum_(0 <= i < h) dn1 i ^ 2 == 2)%N. - rewrite big_mkord -(eqn_add2l (2 * \rank 'E_1)) -diff_rank_quasi_cent_cycle. - by rewrite -mulnSr -rankEm ?modn_small. -pose diff_n := [seq i <- index_iota 0 h | dn1 i != 0%N]. -have diff_n_1: all (fun i => dn1 i == 1%N) diff_n. - apply: contraLR sum_dn1; case/allPn=> i; rewrite mem_filter. - case def_i: (dn1 i) => [|[|ni]] //=; case/splitPr=> e e' _. - by rewrite big_cat big_cons /= addnCA def_i -add2n sqrnD. -have: sorted ltn diff_n. - by rewrite (sorted_filter ltn_trans) // /index_iota subn0 iota_ltn_sorted. -have: all (ltn^~ h) diff_n. - by apply/allP=> i; rewrite mem_filter mem_index_iota; case/andP. -have: size diff_n = 2%N. - move: diff_n_1; rewrite size_filter -(eqnP sum_dn1) /diff_n. - elim: (index_iota 0 h) => [|i e IHe]; rewrite (big_nil, big_cons) //=. - by case def_i: (dn1 i) => [|[]] //=; rewrite def_i //; move/IHe->. -case def_jk: diff_n diff_n_1 => [|j [|k []]] //=; case/and3P=> dn1j dn1k _ _. -case/and3P=> lt_jh lt_kh _ /andP[lt_jk _]. -have def_n i: - i <= h -> 'n_i = if i <= j then 'n_0 else if i <= k then 'n_j.+1 else 'n_k.+1. -- elim: i => // i IHi lt_ik; have:= IHi (ltnW lt_ik); rewrite !(leq_eqVlt i). - have:= erefl (i \in diff_n); rewrite {2}def_jk !inE mem_filter mem_index_iota. - case: (i =P j) => [-> _ _ | _]; first by rewrite ltnn lt_jk. - case: (i =P k) => [-> _ _ | _]; first by rewrite ltnNge ltnW // ltnn. - by rewrite distn_eq0 lt_ik addn1; case: eqP => [->|]. -have n_j1: 'n_j.+1 = 'n_k by rewrite (def_n k (ltnW lt_kh)) leqnn leqNgt lt_jk. -have n_k1: 'n_k.+1 = 'n_0. - rewrite -(rank_step_eigenspace_cycle 0) (def_n h (leqnn h)). - by rewrite leqNgt lt_jh leqNgt lt_kh; split. -case: (leqP k j.+1) => [ | lt_j1_k]. - rewrite leq_eqVlt ltnNge lt_jk orbF; move/eqP=> def_k. - exists 'n_(k + 1); exists (Ordinal lt_kh) => [|i' ne_i'k]; first exact: dn1k. - rewrite addn1 {1}(def_n _ (ltnW (valP i'))) n_k1. - by rewrite -ltnS -def_k ltn_neqAle ne_i'k /=; case: leqP; split. -case: (leqP h.-1 (k - j)) => [le_h1_kj | lt_kj_h1]. - have k_h1: k = h.-1. - apply/eqP; rewrite eqn_leq -ltnS (prednK h_gt0) lt_kh. - exact: leq_trans (leq_subr j k). - have j0: j = 0%N. - apply/eqP; rewrite -leqn0 -(leq_add2l k) -{2}(subnK (ltnW lt_jk)). - by rewrite addn0 leq_add2r {1}k_h1. - exists 'n_(j + 1); exists (Ordinal lt_jh) => [|i' ne_i'j]; first exact: dn1j. - rewrite addn1 {1}(def_n _ (ltnW (valP i'))) j0 leqNgt lt0n -j0. - by rewrite ne_i'j -ltnS k_h1 (prednK h_gt0) (valP i'); split. -suffices: \sum_(i < h) `|'n_i - 'n_(i + 2)| ^ 2 > 2. - rewrite -(ltn_add2l (2 * \rank 'E_2)) -diff_rank_quasi_cent_cycle. - rewrite -mulnSr -rankEm ?ltnn ?modn_small //. - by rewrite -(prednK h_gt0) ltnS (leq_trans _ lt_kj_h1) // ltnS subn_gt0. -have lt_k1h: k.-1 < h by rewrite ltnW // (ltn_predK lt_jk). -rewrite (bigD1 (Ordinal lt_jh)) // (bigD1 (Ordinal lt_k1h)) /=; last first. - by rewrite -val_eqE neq_ltn /= orbC -subn1 ltn_subRL lt_j1_k. -rewrite (bigD1 (Ordinal lt_kh)) /=; last first. - by rewrite -!val_eqE !neq_ltn /= lt_jk (ltn_predK lt_jk) leqnn !orbT. -rewrite !addnA ltn_addr // !addn2 (ltn_predK lt_jk) n_k1. -rewrite (def_n j (ltnW lt_jh)) leqnn (def_n _ (ltn_trans lt_j1_k lt_kh)). -rewrite lt_j1_k -if_neg -leqNgt leqnSn n_j1. -rewrite (def_n _ (ltnW lt_k1h)) leq_pred -if_neg -ltnNge. -rewrite -subn1 ltn_subRL lt_j1_k n_j1. -suffices ->: 'n_k.+2 = 'n_k.+1. - by rewrite distnC -n_k1 -(addn1 k) -/(dn1 k) (eqP dn1k). -case: (leqP k.+2 h) => [le_k2h | ]. - by rewrite (def_n _ le_k2h) (leqNgt _ k) leqnSn n_k1 if_same. -rewrite ltnS leq_eqVlt ltnNge lt_kh orbF; move/eqP=> def_h. -rewrite -{1}def_h -add1n rank_step_eigenspace_cycle (def_n _ h_gt0). -rewrite -(subSn (ltnW lt_jk)) def_h leq_subLR in lt_kj_h1. -by rewrite -(leq_add2r k) lt_kj_h1 n_k1. -Qed. - -(* This is B & G, Proposition 2.4(k). *) -Proposition rank_eigenspaces_free_quasi_homocyclic : - q > 1 -> 'n_0 = 0%N -> h = q.+1 /\ (forall j, j != 0 %[mod h] -> 'n_j = 1%N). -Proof. -move=> q_gt1 n_0; rewrite mod0n. -have [n d_q_hn [i [n_i lt_q_hn n_i']]] := rank_eigenspaces_quasi_homocyclic. -move/eqP: d_q_hn; rewrite distn_eq1 {}lt_q_hn. -case: (eqVneq (Ordinal h_gt0) i) n_i n_i' => [<- | ne0i _ n_i']; last first. - by rewrite -(n_i' _ ne0i) n_0 /= muln0 -(subnKC q_gt1). -rewrite n_0 dist0n => -> n_i'; rewrite muln1 => /eqP->; split=> // i'. -by move/(n_i' (inh i')); rewrite /n_ Vi_mod. -Qed. - -End QuasiRegularCyclic. - -(* This is B & G, Theorem 2.5, used for Theorems 3.4 and 15.7. *) -Theorem repr_extraspecial_prime_sdprod_cycle p n gT (G P H : {group gT}) : - p.-group P -> extraspecial P -> P ><| H = G -> cyclic H -> - let h := #|H| in #|P| = (p ^ n.*2.+1)%N -> coprime p h -> - {in H^#, forall x, 'C_P[x] = 'Z(P)} -> - (h %| p ^ n + 1) || (h %| p ^ n - 1) - /\ ((h != p ^ n + 1)%N -> forall F q (rG : mx_representation F G q), - [char F]^'.-group G -> mx_faithful rG -> rfix_mx rG H != 0). -Proof. -move=> pP esP sdPH_G cycH h oPpn co_p_h primeHP. -set dvd_h_pn := _ || _; set neq_h_pn := h != _. -suffices IH F q (rG : mx_representation F G q): - [char F]^'.-group G -> mx_faithful rG -> - dvd_h_pn && (neq_h_pn ==> (rfix_mx rG H != 0)). -- split=> [|ne_h F q rG F'G ffulG]; last first. - by case/andP: (IH F q rG F'G ffulG) => _; rewrite ne_h. - pose r := pdiv #|G|.+1. - have r_pr: prime r by rewrite pdiv_prime // ltnS cardG_gt0. - have F'G: [char 'F_r]^'.-group G. - rewrite /pgroup (eq_pnat _ (eq_negn (charf_eq (char_Fp r_pr)))). - rewrite p'natE // -prime_coprime // (coprime_dvdl (pdiv_dvd _)) //. - by rewrite /coprime -addn1 gcdnC gcdnDl gcdn1. - by case/andP: (IH _ _ _ F'G (regular_mx_faithful _ _)). -move=> F'G ffulG. -without loss closF: F rG F'G ffulG / group_closure_field F gT. - move=> IH; apply: (@group_closure_field_exists gT F) => [[Fs f clFs]]. - rewrite -(map_mx_eq0 f) map_rfix_mx {}IH ?map_mx_faithful //. - by rewrite (eq_p'group _ (fmorph_char f)). -have p_pr := extraspecial_prime pP esP; have p_gt1 := prime_gt1 p_pr. -have oZp := card_center_extraspecial pP esP; have[_ prZ] := esP. -have{sdPH_G} [nsPG sHG defG nPH tiPH] := sdprod_context sdPH_G. -have sPG := normal_sub nsPG. -have coPH: coprime #|P| #|H| by rewrite oPpn coprime_pexpl. -have nsZG: 'Z(P) <| G := gFnormal_trans _ nsPG. -have defCP: 'C_G(P) = 'Z(P). - apply/eqP; rewrite eqEsubset andbC setSI //=. - rewrite -(coprime_mulG_setI_norm defG) ?norms_cent ?normal_norm //=. - rewrite mul_subG // -(setD1K (group1 H)). - apply/subsetP=> x; case/setIP; case/setU1P=> [-> // | H'x]. - rewrite -sub_cent1; move/setIidPl; rewrite primeHP // => defP. - by have:= min_card_extraspecial pP esP; rewrite -defP oZp (leq_exp2l 3 1). -have F'P: [char F]^'.-group P by apply: pgroupS sPG F'G. -have F'H: [char F]^'.-group H by apply: pgroupS sHG F'G. -wlog{ffulG F'G} [irrG regZ]: q rG / mx_irreducible rG /\ rfix_mx rG 'Z(P) = 0. - move=> IH; wlog [I W /= simW defV _]: / mxsemisimple rG 1%:M. - exact: (mx_reducible_semisimple (mxmodule1 _) (mx_Maschke rG F'G)). - have [z Zz ntz]: exists2 z, z \in 'Z(P) & z != 1%g. - by apply/trivgPn; rewrite -cardG_gt1 oZp prime_gt1. - have Gz := subsetP sPG z (subsetP (center_sub P) z Zz). - case: (pickP (fun i => z \notin rstab rG (W i))) => [i ffZ | z1]; last first. - case/negP: ntz; rewrite -in_set1 (subsetP ffulG) // inE Gz /=. - apply/eqP; move/eqmxP: defV; case/andP=> _; case/sub_sumsmxP=> w ->. - rewrite mulmx_suml; apply: eq_bigr => i _. - by move/negbFE: (z1 i) => /rstab_act-> //; rewrite submxMl. - have [modW _ _] := simW i; pose rW := submod_repr modW. - rewrite -(eqmx_rstab _ (val_submod1 (W i))) -(rstab_submod modW) in ffZ. - have irrW: mx_irreducible rW by apply/submod_mx_irr. - have regZ: rfix_mx rW 'Z(P)%g = 0. - apply/eqP; apply: contraR ffZ; case/mx_irrP: irrW => _ minW /minW. - by rewrite normal_rfix_mx_module // -sub1mx inE Gz /= => /implyP/rfix_mxP->. - have ffulP: P :&: rker rW = 1%g. - apply: (TI_center_nil (pgroup_nil pP)). - by rewrite /normal subsetIl normsI ?normG ?(subset_trans _ (rker_norm _)). - rewrite /= setIC setIA (setIidPl (center_sub _)); apply: prime_TIg=> //. - by apply: contra ffZ => /subsetP->. - have cPker: rker rW \subset 'C_G(P). - rewrite subsetI rstab_sub (sameP commG1P trivgP) /= -ffulP subsetI. - rewrite commg_subl commg_subr (subset_trans sPG) ?rker_norm //. - by rewrite (subset_trans (rstab_sub _ _)) ?normal_norm. - have [->] := andP (IH _ _ (conj irrW regZ)); case: (neq_h_pn) => //. - apply: contra; rewrite (eqmx_eq0 (rfix_submod modW sHG)) => /eqP->. - by rewrite capmx0 linear0. -pose rP := subg_repr rG sPG; pose rH := subg_repr rG sHG. -wlog [M simM _]: / exists2 M, mxsimple rP M & (M <= 1%:M)%MS. - by apply: (mxsimple_exists (mxmodule1 _)); last case irrG. -have{M simM irrG regZ F'P} [irrP def_q]: mx_irreducible rP /\ q = (p ^ n)%N. - have [modM nzM _]:= simM. - have [] := faithful_repr_extraspecial _ _ oPpn _ _ simM => // [|<- isoM]. - apply/eqP; apply: (TI_center_nil (pgroup_nil pP)). - rewrite /= -(eqmx_rstab _ (val_submod1 M)) -(rstab_submod modM). - exact: rker_normal. - rewrite setIC prime_TIg //=; apply: contra nzM => cMZ. - rewrite -submx0 -regZ; apply/rfix_mxP=> z; move/(subsetP cMZ)=> cMz. - by rewrite (rstab_act cMz). - suffices irrP: mx_irreducible rP. - by split=> //; apply/eqP; rewrite eq_sym; case/mx_irrP: irrP => _; apply. - apply: (@mx_irr_prime_index F _ G P _ M nsPG) => // [|x Gx]. - by rewrite -defG quotientMidl quotient_cyclic. - rewrite (bool_irrelevance (normal_sub nsPG) sPG). - apply: isoM; first exact: (@Clifford_simple _ _ _ _ nsPG). - have cZx: x \in 'C_G('Z(P)). - rewrite (setIidPl _) // -defG mulG_subG centsC subsetIr. - rewrite -(setD1K (group1 H)) subUset sub1G /=. - by apply/subsetP=> y H'y; rewrite -sub_cent1 -(primeHP y H'y) subsetIr. - by have [f] := Clifford_iso nsZG rG M cZx; exists f. -pose E_P := enveloping_algebra_mx rP; have{irrP} absP := closF P _ _ irrP. -have [q_gt0 EPfull]: q > 0 /\ (1%:M <= E_P)%MS by apply/andP; rewrite sub1mx. -pose Z := 'Z(P); have [sZP nZP] := andP (center_normal P : Z <| P). -have nHZ: H \subset 'N(Z) := subset_trans sHG (normal_norm nsZG). -pose clPqH := [set Zx ^: (H / Z) | Zx in P / Z]%g. -pose b (ZxH : {set coset_of Z}) := repr (repr ZxH). -have Pb ZxH: ZxH \in clPqH -> b ZxH \in P. - case/imsetP=> Zx P_Zx ->{ZxH}. - rewrite -(quotientGK (center_normal P)) /= -/Z inE repr_coset_norm /=. - rewrite inE coset_reprK; apply: subsetP (mem_repr _ (class_refl _ _)). - rewrite -class_support_set1l class_support_sub_norm ?sub1set //. - by rewrite quotient_norms. -have{primeHP coPH} card_clPqH ZxH: ZxH \in clPqH^# -> #|ZxH| = #|H|. - case/setD1P=> ntZxH P_ZxH. - case/imsetP: P_ZxH ntZxH => Zx P_Zx ->{ZxH}; rewrite classG_eq1 => ntZx. - rewrite -index_cent1 ['C__[_]](trivgP _). - rewrite indexg1 card_quotient // -indexgI setICA setIA tiPH. - by rewrite (setIidPl (sub1G _)) indexg1. - apply/subsetP=> Zy => /setIP[/morphimP[y Ny]]; rewrite -(setD1K (group1 H)). - case/setU1P=> [-> | Hy] ->{Zy} cZxy; first by rewrite morph1 set11. - have: Zx \in 'C_(P / Z)(<[y]> / Z). - by rewrite inE P_Zx quotient_cycle // cent_cycle cent1C. - case/idPn; rewrite -coprime_quotient_cent ?cycle_subG ?(pgroup_sol pP) //. - by rewrite /= cent_cycle primeHP // trivg_quotient inE. - by apply: coprimegS coPH; rewrite cycle_subG; case/setD1P: Hy. -pose B x := \matrix_(i < #|H|) mxvec (rP (x ^ enum_val i)%g). -have{E_P EPfull absP} sumB: (\sum_(ZxH in clPqH) <<B (b ZxH)>> :=: 1%:M)%MS. - apply/eqmxP; rewrite submx1 (submx_trans EPfull) //. - apply/row_subP=> ix; set x := enum_val ix; pose ZxH := coset Z x ^: (H / Z)%g. - have Px: x \in P by [rewrite enum_valP]; have nZx := subsetP nZP _ Px. - have P_ZxH: ZxH \in clPqH by apply: mem_imset; rewrite mem_quotient. - have Pbx := Pb _ P_ZxH; have nZbx := subsetP nZP _ Pbx. - rewrite rowK (sumsmx_sup ZxH) {P_ZxH}// genmxE -/x. - have: coset Z x \in coset Z (b ZxH) ^: (H / Z)%g. - by rewrite class_sym coset_reprK (mem_repr _ (class_refl _ _)). - case/imsetP=> _ /morphimP[y Ny Hy ->]. - rewrite -morphJ //; case/kercoset_rcoset; rewrite ?groupJ // => z Zz ->. - have [Pz cPz] := setIP Zz; rewrite repr_mxM ?memJ_norm ?(subsetP nPH) //. - have [a ->]: exists a, rP z = a%:M. - apply/is_scalar_mxP; apply: (mx_abs_irr_cent_scalar absP). - by apply/centgmxP=> t Pt; rewrite -!repr_mxM ?(centP cPz). - rewrite mul_scalar_mx linearZ scalemx_sub //. - by rewrite (eq_row_sub (gring_index H y)) // rowK gring_indexK. -have{card_clPqH} Bfree_if ZxH: - ZxH \in clPqH^# -> \rank <<B (b ZxH)>> <= #|ZxH| ?= iff row_free (B (b ZxH)). -- by move=> P_ZxH; rewrite genmxE card_clPqH // /leqif rank_leq_row. -have B1_if: \rank <<B (b 1%g)>> <= 1 ?= iff (<<B (b 1%g)>> == mxvec 1%:M)%MS. - have r1: \rank (mxvec 1%:M : 'rV[F]_(q ^ 2)) = 1%N. - by rewrite rank_rV mxvec_eq0 -mxrank_eq0 mxrank1 -lt0n q_gt0. - rewrite -{1}r1; apply: mxrank_leqif_eq; rewrite genmxE. - have ->: b 1%g = 1%g by rewrite /b repr_set1 repr_coset1. - by apply/row_subP=> i; rewrite rowK conj1g repr_mx1. -have rankEP: \rank (1%:M : 'A[F]_q) = (\sum_(ZxH in clPqH) #|ZxH|)%N. - rewrite acts_sum_card_orbit ?astabsJ ?quotient_norms // card_quotient //. - rewrite mxrank1 -divgS // -mulnn oPpn oZp expnS -muln2 expnM -def_q. - by rewrite mulKn // ltnW. -have cl1: 1%g \in clPqH by apply/imsetP; exists 1%g; rewrite ?group1 ?class1G. -have{B1_if Bfree_if}:= leqif_add B1_if (leqif_sum Bfree_if). -case/(leqif_trans (mxrank_sum_leqif _)) => _ /=. -rewrite -{1}(big_setD1 _ cl1) sumB {}rankEP (big_setD1 1%g) // cards1 eqxx. -case/esym/and3P=> dxB /eqmxP defB1 /forall_inP/= Bfree. -have [yg defH] := cyclicP cycH; pose g := rG yg. -have Hxg: yg \in H by [rewrite defH cycle_id]; have Gyg := subsetP sHG _ Hxg. -pose gE : 'A_q := lin_mx (mulmx (invmx g) \o mulmxr g). -pose yr := regular_repr F H yg. -have mulBg x: x \in P -> B x *m gE = yr *m B x. - move/(subsetP sPG)=> Gx. - apply/row_matrixP=> i; have Hi := enum_valP i; have Gi := subsetP sHG _ Hi. - rewrite 2!row_mul !rowK mul_vec_lin /= -rowE rowK gring_indexK ?groupM //. - by rewrite conjgM -repr_mxV // -!repr_mxM // ?(groupJ, groupM, groupV). -wlog sH: / irrType F H by apply: socle_exists. -have{cycH} linH: irr_degree (_ : sH) = 1%N. - exact: irr_degree_abelian (cyclic_abelian cycH). -have baseH := linear_irr_comp F'H (closF H) (linH _). -have{linH} linH (W : sH): \rank W = 1%N by rewrite baseH; apply: linH. -have [w] := cycle_repr_structure sH defH F'H (closF H). -rewrite -/h => prim_w [Wi [bijWi _ _ Wi_yg]]. -have{Wi_yg baseH} Wi_yr i: Wi i *m yr = w ^+ i *: (Wi i : 'M_h). - have /submxP[u ->]: (Wi i <= val_submod (irr_repr (Wi i) 1%g))%MS. - by rewrite repr_mx1 val_submod1 -baseH. - rewrite repr_mx1 -mulmxA -2!linearZ; congr (u *m _). - by rewrite -mul_mx_scalar -Wi_yg /= val_submodJ. -pose E_ m := eigenspace gE (w ^+ m). -have dxE: mxdirect (\sum_(m < h) E_ m)%MS. - apply: mxdirect_sum_eigenspace => m1 m2 _ _ eq_m12; apply/eqP. - by move/eqP: eq_m12; rewrite (eq_prim_root_expr prim_w) !modn_small. -pose B2 ZxH i : 'A_q := <<Wi i *m B (b ZxH)>>%MS. -pose B1 i : 'A_q := (\sum_(ZxH in clPqH^#) B2 ZxH i)%MS. -pose SB := (<<B (b 1%g)>> + \sum_i B1 i)%MS. -have{yr Wi_yr Pb mulBg} sB1E i: (B1 i <= E_ i)%MS. - apply/sumsmx_subP=> ZxH /setIdP[_]; rewrite genmxE => P_ZxH. - by apply/eigenspaceP; rewrite -mulmxA mulBg ?Pb // mulmxA Wi_yr scalemxAl. -have{bijWi sumB cl1 F'H} defSB: (SB :=: 1%:M)%MS. - apply/eqmxP; rewrite submx1 -sumB (big_setD1 _ cl1) addsmxS //=. - rewrite exchange_big sumsmxS // => ZxH _; rewrite genmxE /= -sumsmxMr_gen. - rewrite -((reindex Wi) xpredT val) /=; last by apply: onW_bij. - by rewrite -/(Socle _) (reducible_Socle1 sH (mx_Maschke _ F'H)) mul1mx. -rewrite mxdirect_addsE /= in dxB; case/and3P: dxB => _ dxB dxB1. -have{linH Bfree dxB} rankB1 i: \rank (B1 i) = #|clPqH^#|. - rewrite -sum1_card (mxdirectP _) /=. - by apply: eq_bigr => ZxH P_ZxH; rewrite genmxE mxrankMfree ?Bfree. - apply/mxdirect_sumsP=> ZxH P_ZxH. - apply/eqP; rewrite -submx0 -{2}(mxdirect_sumsP dxB _ P_ZxH) capmxS //. - by rewrite !genmxE submxMl. - by rewrite sumsmxS // => ZyH _; rewrite !genmxE submxMl. -have rankEi (i : 'I_h) : i != 0%N :> nat -> \rank (E_ i) = #|clPqH^#|. - move=> i_gt0; apply/eqP; rewrite -(rankB1 i) (mxrank_leqif_sup _) ?sB1E //. - rewrite -[E_ i]cap1mx -(cap_eqmx defSB (eqmx_refl _)) /SB. - rewrite (bigD1 i) //= (addsmxC (B1 i)) addsmxA addsmxC -matrix_modl //. - rewrite -(addsmx0 (q ^ 2) (B1 i)) addsmxS //. - rewrite capmxC -{2}(mxdirect_sumsP dxE i) // capmxS // addsmx_sub // . - rewrite (sumsmx_sup (Ordinal (cardG_gt0 H))) ?sumsmxS 1?eq_sym //. - rewrite defB1; apply/eigenspaceP; rewrite mul_vec_lin scale1r /=. - by rewrite mul1mx mulVmx ?repr_mx_unit. -have{b B defB1 rP rH sH Wi rankB1 dxB1 defSB sB1E B1 B2 dxE SB} rankE0 i: - (i : 'I_h) == 0%N :> nat -> \rank (E_ i) = #|clPqH^#|.+1. -- move=> i_eq0; rewrite -[E_ i]cap1mx -(cap_eqmx defSB (eqmx_refl _)) /SB. - rewrite (bigD1 i) // addsmxA -matrix_modl; last first. - rewrite addsmx_sub // sB1E andbT defB1; apply/eigenspaceP. - by rewrite mul_vec_lin (eqP i_eq0) scale1r /= mul1mx mulVmx ?repr_mx_unit. - rewrite (((_ :&: _)%MS =P 0) _). - rewrite addsmx0 mxrank_disjoint_sum /=. - by rewrite defB1 rank_rV rankB1 mxvec_eq0 -mxrank_eq0 mxrank1 -lt0n q_gt0. - apply/eqP; rewrite -submx0 -(eqP dxB1) capmxS // sumsmxS // => ZxH _. - by rewrite !genmxE ?submxMl. - by rewrite -submx0 capmxC /= -{2}(mxdirect_sumsP dxE i) // capmxS ?sumsmxS. -have{clPqH rankE0 rankEi} (m): - m != 0 %[mod h] -> \rank (E_ 0%N) = (\rank (E_ m)).+1. -- move=> nz_m; rewrite (rankE0 (Ordinal (cardG_gt0 H))) //. - rewrite /E_ -(prim_expr_mod prim_w); rewrite mod0n in nz_m. - have lt_m: m %% h < h by rewrite ltn_mod ?cardG_gt0. - by rewrite (rankEi (Ordinal lt_m)). -have: q > 1. - rewrite def_q (ltn_exp2l 0) // lt0n. - apply: contraL (min_card_extraspecial pP esP). - by rewrite oPpn; move/eqP->; rewrite leq_exp2l. -rewrite {}/E_ {}/gE {}/dvd_h_pn {}/neq_h_pn -{n oPpn}def_q subn1 addn1 /=. -case: q q_gt0 => // q' _ in rG g * => q_gt1 rankE. -have gh1: g ^+ h = 1 by rewrite -repr_mxX // /h defH expg_order repr_mx1. -apply/andP; split. - have [n' def_q _]:= rank_eigenspaces_quasi_homocyclic gh1 prim_w rankE. - move/eqP: def_q; rewrite distn_eq1 eqSS. - by case: ifP => _ /eqP->; rewrite dvdn_mulr ?orbT. -apply/implyP; apply: contra => regH. -have [|-> //]:= rank_eigenspaces_free_quasi_homocyclic gh1 prim_w rankE q_gt1. -apply/eqP; rewrite mxrank_eq0 -submx0 -(eqP regH). -apply/rV_subP=> v /eigenspaceP; rewrite scale1r => cvg. -apply/rfix_mxP=> y Hy; apply: rstab_act (submx_refl v); apply: subsetP y Hy. -by rewrite defH cycle_subG !inE Gyg /= cvg. -Qed. - -(* This is the main part of B & G, Theorem 2.6; it implies 2.6(a) and most of *) -(* 2.6(b). *) -Theorem der1_odd_GL2_charf F gT (G : {group gT}) - (rG : mx_representation F G 2) : - odd #|G| -> mx_faithful rG -> [char F].-group G^`(1)%g. -Proof. -move=> oddG ffulG. -without loss closF: F rG ffulG / group_closure_field F gT. - move=> IH; apply: (@group_closure_field_exists gT F) => [[Fc f closFc]]. - rewrite -(eq_pgroup _ (fmorph_char f)). - by rewrite -(map_mx_faithful f) in ffulG; apply: IH ffulG closFc. -elim: {G}_.+1 {-2}G (ltnSn #|G|) => // m IHm G le_g_m in rG oddG ffulG *. -apply/pgroupP=> p p_pr pG'; rewrite !inE p_pr /=; apply: wlog_neg => p_nz. -have [P sylP] := Sylow_exists p G. -have nPG: G \subset 'N(P). - apply/idPn=> ltNG; pose N := 'N_G(P); have sNG: N \subset G := subsetIl _ _. - have{IHm ltNG} p'N': [char F].-group N^`(1)%g. - apply: IHm (subg_mx_faithful sNG ffulG); last exact: oddSg oddG. - rewrite -ltnS (leq_trans _ le_g_m) // ltnS proper_card //. - by rewrite /proper sNG subsetI subxx. - have{p'N'} tiPN': P :&: N^`(1)%g = 1%g. - rewrite coprime_TIg ?(pnat_coprime (pHall_pgroup sylP)) //= -/N. - apply: sub_in_pnat p'N' => q _; apply: contraL; move/eqnP->. - by rewrite !inE p_pr. - have sPN: P \subset N by rewrite subsetI normG (pHall_sub sylP). - have{tiPN'} cPN: N \subset 'C(P). - rewrite (sameP commG1P trivgP) -tiPN' subsetI commgS //. - by rewrite commg_subr subsetIr. - have /sdprodP[_ /= defG nKP _] := Burnside_normal_complement sylP cPN. - set K := 'O_p^'(G) in defG nKP; have nKG: G \subset 'N(K) by apply: gFnorm. - suffices p'G': p^'.-group G^`(1)%g by case/eqnP: (pgroupP p'G' p p_pr pG'). - apply: pgroupS (pcore_pgroup p^' G); rewrite -quotient_cents2 //= -/K. - by rewrite -defG quotientMidl /= -/K quotient_cents ?(subset_trans sPN). -pose Q := G^`(1)%g :&: P; have sQG: Q \subset G by rewrite subIset ?der_subS. -have nQG: G \subset 'N(Q) by rewrite normsI // normal_norm ?der_normalS. -have pQ: (p %| #|Q|)%N. - have sylQ: p.-Sylow(G^`(1)%g) Q. - by apply: Sylow_setI_normal (der_normalS _ _) _. - apply: contraLR pG'; rewrite -!p'natE // (card_Hall sylQ) -!partn_eq1 //. - by rewrite part_pnat_id ?part_pnat. -have{IHm} abelQ: abelian Q. - apply/commG1P/eqP/idPn => ntQ'. - have{IHm} p'Q': [char F].-group Q^`(1)%g. - apply: IHm (subg_mx_faithful sQG ffulG); last exact: oddSg oddG. - rewrite -ltnS (leq_trans _ le_g_m) // ltnS proper_card //. - rewrite /proper sQG subsetI //= andbC subEproper. - case: eqP => [-> /= | _]; last by rewrite /proper (pHall_sub sylP) andbF. - have: nilpotent P by rewrite (pgroup_nil (pHall_pgroup sylP)). - move/forallP/(_ P); apply: contraL; rewrite subsetI subxx => -> /=. - apply: contra ntQ'; rewrite /Q => /eqP->. - by rewrite (setIidPr _) ?sub1G // commG1. - case/eqP: ntQ'; have{p'Q'}: P :&: Q^`(1)%g = 1%g. - rewrite coprime_TIg ?(pnat_coprime (pHall_pgroup sylP)) //= -/Q. - by rewrite (pi_p'nat p'Q') // !inE p_pr. - by rewrite (setIidPr _) // comm_subG ?subsetIr. -pose rQ := subg_repr rG sQG. -wlog [U simU sU1]: / exists2 U, mxsimple rQ U & (U <= 1%:M)%MS. - by apply: mxsimple_exists; rewrite ?mxmodule1 ?oner_eq0. -have Uscal: \rank U = 1%N by apply: (mxsimple_abelian_linear (closF _)) simU. -have{simU} [Umod _ _] := simU. -have{sU1} [|V Vmod sumUV dxUV] := mx_Maschke _ _ Umod sU1. - have: p.-group Q by apply: pgroupS (pHall_pgroup sylP); rewrite subsetIr. - by apply: sub_in_pnat=> q _; move/eqnP->; rewrite !inE p_pr. -have [u defU]: exists u : 'rV_2, (u :=: U)%MS. - by move: (row_base U) (eq_row_base U); rewrite Uscal => u; exists u. -have{dxUV Uscal} [v defV]: exists v : 'rV_2, (v :=: V)%MS. - move/mxdirectP: dxUV; rewrite /= Uscal sumUV mxrank1 => [[Vscal]]. - by move: (row_base V) (eq_row_base V); rewrite -Vscal => v; exists v. -pose B : 'M_(1 + 1) := col_mx u v; have{sumUV} uB: B \in unitmx. - rewrite -row_full_unit /row_full eqn_leq rank_leq_row {1}addn1. - by rewrite -addsmxE -(mxrank1 F 2) -sumUV mxrankS // addsmxS ?defU ?defV. -pose Qfix (w : 'rV_2) := {in Q, forall y, w *m rG y <= w}%MS. -have{U defU Umod} u_fix: Qfix u. - by move=> y Qy; rewrite /= (eqmxMr _ defU) defU (mxmoduleP Umod). -have{V defV Vmod} v_fix: Qfix v. - by move=> y Qy; rewrite /= (eqmxMr _ defV) defV (mxmoduleP Vmod). -case/Cauchy: pQ => // x Qx oxp; have Gx := subsetP sQG x Qx. -case/submxP: (u_fix x Qx) => a def_ux. -case/submxP: (v_fix x Qx) => b def_vx. -have def_x: rG x = B^-1 *m block_mx a 0 0 b *m B. - rewrite -mulmxA -[2]/(1 + 1)%N mul_block_col !mul0mx addr0 add0r. - by rewrite -def_ux -def_vx -mul_col_mx mulKmx. -have ap1: a ^+ p = 1. - suff: B^-1 *m block_mx (a ^+ p) 0 0 (b ^+ p) *m B = 1. - move/(canRL (mulmxK uB))/(canRL (mulKVmx uB)); rewrite mul1mx. - by rewrite mulmxV // scalar_mx_block; case/eq_block_mx. - transitivity (rG x ^+ p); last first. - by rewrite -(repr_mxX (subg_repr rG sQG)) // -oxp expg_order repr_mx1. - elim: (p) => [|k IHk]; first by rewrite -scalar_mx_block mulmx1 mulVmx. - rewrite !exprS -IHk def_x -!mulmxE !mulmxA mulmxK // -2!(mulmxA B^-1). - by rewrite -[2]/(1 + 1)%N mulmx_block !mulmx0 !mul0mx !addr0 mulmxA add0r. -have ab1: a * b = 1. - have: Q \subset <<[set y in G | \det (rG y) == 1]>>. - rewrite subIset // genS //; apply/subsetP=> yz; case/imset2P=> y z Gy Gz ->. - rewrite inE !repr_mxM ?groupM ?groupV //= !detM (mulrCA _ (\det (rG y))). - rewrite -!det_mulmx -!repr_mxM ?groupM ?groupV //. - by rewrite mulKg mulVg repr_mx1 det1. - rewrite gen_set_id; last first. - apply/group_setP; split=> [|y z /setIdP[Gy /eqP y1] /setIdP[Gz /eqP z1]]. - by rewrite inE group1 /= repr_mx1 det1. - by rewrite inE groupM ?repr_mxM //= detM y1 z1 mulr1. - case/subsetP/(_ x Qx)/setIdP=> _. - rewrite def_x !detM mulrAC -!detM -mulrA mulKr // -!mulmxE. - rewrite -[2]/(1 + 1)%N det_lblock // [a]mx11_scalar [b]mx11_scalar. - by rewrite !det_scalar1 -scalar_mxM => /eqP->. -have{ab1 ap1 def_x} ne_ab: a != b. - apply/eqP=> defa; have defb: b = 1. - rewrite -ap1 (divn_eq p 2) modn2. - have ->: odd p by rewrite -oxp (oddSg _ oddG) // cycle_subG. - by rewrite addn1 exprS mulnC exprM exprS {1 3}defa ab1 expr1n mulr1. - suff x1: x \in [1] by rewrite -oxp (set1P x1) order1 in p_pr. - rewrite (subsetP ffulG) // inE Gx def_x defa defb -scalar_mx_block mulmx1. - by rewrite mul1mx mulVmx ?eqxx. -have{a b ne_ab def_ux def_vx} nx_uv (w : 'rV_2): - (w *m rG x <= w -> w <= u \/ w <= v)%MS. -- case/submxP=> c; have:= mulmxKV uB w. - rewrite -[_ *m invmx B]hsubmxK [lsubmx _]mx11_scalar [rsubmx _]mx11_scalar. - move: (_ 0) (_ 0) => dv du; rewrite mul_row_col !mul_scalar_mx => <-{w}. - rewrite mulmxDl -!scalemxAl def_ux def_vx mulmxDr -!scalemxAr. - rewrite !scalemxAl -!mul_row_col; move/(can_inj (mulmxK uB)). - case/eq_row_mx => eqac eqbc; apply/orP. - have [-> | nz_dv] := eqVneq dv 0; first by rewrite scale0r addr0 scalemx_sub. - have [-> | nz_du] := eqVneq du 0. - by rewrite orbC scale0r add0r scalemx_sub. - case/eqP: ne_ab; rewrite -[b]scale1r -(mulVf nz_dv) -[a]scale1r. - by rewrite -(mulVf nz_du) -!scalerA eqac eqbc !scalerA !mulVf. -have{x Gx Qx oxp nx_uv} redG y (A := rG y): - y \in G -> (u *m A <= u /\ v *m A <= v)%MS. -- move=> Gy; have uA: row_free A by rewrite row_free_unit repr_mx_unit. - have Ainj (w t : 'rV_2): (w *m A <= w -> t *m A <= w -> t *m A <= t)%MS. - case/sub_rVP=> [c ryww] /sub_rVP[d rytw]. - rewrite -(submxMfree _ _ uA) rytw -scalemxAl ryww scalerA mulrC. - by rewrite -scalerA scalemx_sub. - have{Qx nx_uv} nAx w: Qfix w -> (w *m A <= u \/ w *m A <= v)%MS. - move=> nwQ; apply: nx_uv; rewrite -mulmxA -repr_mxM // conjgCV. - rewrite repr_mxM ?groupJ ?groupV // mulmxA submxMr // nwQ // -mem_conjg. - by rewrite (normsP nQG). - have [uAu | uAv] := nAx _ u_fix; have [vAu | vAv] := nAx _ v_fix; eauto. - have [k ->]: exists k, A = A ^+ k.*2. - exists #[y].+1./2; rewrite -mul2n -divn2 mulnC divnK. - by rewrite -repr_mxX // expgS expg_order mulg1. - by rewrite dvdn2 negbK; apply: oddSg oddG; rewrite cycle_subG. - elim: k => [|k [IHu IHv]]; first by rewrite !mulmx1. - case/sub_rVP: uAv => c uAc; case/sub_rVP: vAu => d vAd. - rewrite doubleS !exprS !mulmxA; do 2!rewrite uAc vAd -!scalemxAl. - by rewrite !scalemx_sub. -suffices trivG': G^`(1)%g = 1%g. - by rewrite /= trivG' cards1 gtnNdvd ?prime_gt1 in pG'. -apply/trivgP; apply: subset_trans ffulG; rewrite gen_subG. -apply/subsetP=> _ /imset2P[y z Gy Gz ->]; rewrite inE groupR //=. -rewrite -(inj_eq (can_inj (mulKmx (repr_mx_unit rG (groupM Gz Gy))))). -rewrite mul1mx mulmx1 -repr_mxM ?(groupR, groupM) // -commgC !repr_mxM //. -rewrite -(inj_eq (can_inj (mulKmx uB))) !mulmxA !mul_col_mx. -case/redG: Gy => /sub_rVP[a uya] /sub_rVP[b vyb]. -case/redG: Gz => /sub_rVP[c uzc] /sub_rVP[d vzd]. -by do 2!rewrite uya vyb uzc vzd -?scalemxAl; rewrite !scalerA mulrC (mulrC d). -Qed. - -(* This is B & G, Theorem 2.6(a) *) -Theorem charf'_GL2_abelian F gT (G : {group gT}) - (rG : mx_representation F G 2) : - odd #|G| -> mx_faithful rG -> [char F]^'.-group G -> abelian G. -Proof. -move=> oddG ffG char'G; apply/commG1P/eqP. -rewrite trivg_card1 (pnat_1 _ (pgroupS _ char'G)) ?comm_subG //=. -exact: der1_odd_GL2_charf ffG. -Qed. - -(* This is B & G, Theorem 2.6(b) *) -Theorem charf_GL2_der_subS_abelian_Sylow p F gT (G : {group gT}) - (rG : mx_representation F G 2) : - odd #|G| -> mx_faithful rG -> p \in [char F] -> - exists P : {group gT}, [/\ p.-Sylow(G) P, abelian P & G^`(1)%g \subset P]. -Proof. -move=> oddG ffG charFp. -have{oddG} pG': p.-group G^`(1)%g. - rewrite /pgroup -(eq_pnat _ (charf_eq charFp)). - exact: der1_odd_GL2_charf ffG. -have{pG'} [P SylP sG'P]:= Sylow_superset (der_sub _ _) pG'. -exists P; split=> {sG'P}//; case/and3P: SylP => sPG pP _. -apply/commG1P/trivgP; apply: subset_trans ffG; rewrite gen_subG. -apply/subsetP=> _ /imset2P[y z Py Pz ->]; rewrite inE (subsetP sPG) ?groupR //=. -pose rP := subg_repr rG sPG; pose U := rfix_mx rP P. -rewrite -(inj_eq (can_inj (mulKmx (repr_mx_unit rP (groupM Pz Py))))). -rewrite mul1mx mulmx1 -repr_mxM ?(groupR, groupM) // -commgC !repr_mxM //. -have: U != 0 by apply: (rfix_pgroup_char charFp). -rewrite -mxrank_eq0 -lt0n 2!leq_eqVlt ltnNge rank_leq_row orbF orbC eq_sym. -case/orP=> [Ufull | Uscal]. - suffices{y z Py Pz} rP1 y: y \in P -> rP y = 1%:M by rewrite !rP1 ?mulmx1. - move=> Py; apply/row_matrixP=> i. - by rewrite rowE -row1 (rfix_mxP P _) ?submx_full. -have [u defU]: exists u : 'rV_2, (u :=: U)%MS. - by move: (row_base U) (eq_row_base U); rewrite -(eqP Uscal) => u; exists u. -have fix_u: {in P, forall x, u *m rP x = u}. - by move/eqmxP: defU; case/andP; move/rfix_mxP. -have [v defUc]: exists u : 'rV_2, (u :=: U^C)%MS. - have UCscal: \rank U^C = 1%N by rewrite mxrank_compl -(eqP Uscal). - by move: (row_base _)%MS (eq_row_base U^C)%MS; rewrite UCscal => v; exists v. -pose B := col_mx u v; have uB: B \in unitmx. - rewrite -row_full_unit -sub1mx -(eqmxMfull _ (addsmx_compl_full U)). - by rewrite mulmx1 -addsmxE addsmxS ?defU ?defUc. -have Umod: mxmodule rP U by apply: rfix_mx_module. -pose W := rfix_mx (factmod_repr Umod) P. -have ntW: W != 0. - apply: (rfix_pgroup_char charFp) => //. - rewrite eqmxMfull ?row_full_unit ?unitmx_inv ?row_ebase_unit //. - by rewrite rank_copid_mx -(eqP Uscal). -have{ntW} Wfull: row_full W. - by rewrite -col_leq_rank {1}mxrank_coker -(eqP Uscal) lt0n mxrank_eq0. -have svW: (in_factmod U v <= W)%MS by rewrite submx_full. -have fix_v: {in P, forall x, v *m rG x - v <= u}%MS. - move=> x Px /=; rewrite -[v *m _](add_sub_fact_mod U) (in_factmodJ Umod) //. - move/rfix_mxP: svW => -> //; rewrite in_factmodK ?defUc // addrK. - by rewrite defU val_submodP. -have fixB: {in P, forall x, exists2 a, u *m rG x = u & v *m rG x = v + a *: u}. - move=> x Px; case/submxP: (fix_v x Px) => a def_vx. - exists (a 0 0); first exact: fix_u. - by rewrite addrC -mul_scalar_mx -mx11_scalar -def_vx subrK. -rewrite -(inj_eq (can_inj (mulKmx uB))) // !mulmxA !mul_col_mx. -case/fixB: Py => a uy vy; case/fixB: Pz => b uz vz. -by rewrite uy uz vy vz !mulmxDl -!scalemxAl uy uz vy vz addrAC. -Qed. - -(* This is B & G, Lemma 2.7. *) -Lemma regular_abelem2_on_abelem2 p q gT (P Q : {group gT}) : - p.-abelem P -> q.-abelem Q -> 'r_p(P) = 2 ->'r_q(Q) = 2 -> - Q \subset 'N(P) -> 'C_Q(P) = 1%g -> - (q %| p.-1)%N - /\ (exists2 a, a \in Q^# & exists r, - [/\ {in P, forall x, x ^ a = x ^+ r}%g, - r ^ q = 1 %[mod p] & r != 1 %[mod p]]). -Proof. -move=> abelP abelQ; rewrite !p_rank_abelem // => logP logQ nPQ regQ. -have ntP: P :!=: 1%g by case: eqP logP => // ->; rewrite cards1 logn1. -have [p_pr _ _]:= pgroup_pdiv (abelem_pgroup abelP) ntP. -have ntQ: Q :!=: 1%g by case: eqP logQ => // ->; rewrite cards1 logn1. -have [q_pr _ _]:= pgroup_pdiv (abelem_pgroup abelQ) ntQ. -pose rQ := abelem_repr abelP ntP nPQ. -have [|P1 simP1 _] := dec_mxsimple_exists (mxmodule1 rQ). - by rewrite oner_eq0. -have [modP1 nzP1 _] := simP1. -have ffulQ: mx_faithful rQ by apply: abelem_mx_faithful. -have linP1: \rank P1 = 1%N. - apply/eqP; have:= abelem_cyclic abelQ; rewrite logQ; apply: contraFT. - rewrite neq_ltn ltnNge lt0n mxrank_eq0 nzP1 => P1full. - have irrQ: mx_irreducible rQ. - apply: mx_iso_simple simP1; apply: eqmx_iso; apply/eqmxP. - by rewrite submx1 sub1mx -col_leq_rank {1}(dim_abelemE abelP ntP) logP. - exact: mx_faithful_irr_abelian_cyclic irrQ (abelem_abelian abelQ). -have ne_qp: q != p. - move/implyP: (logn_quotient_cent_abelem nPQ abelP). - by rewrite logP regQ indexg1 /=; case: eqP => // <-; rewrite logQ. -have redQ: mx_completely_reducible rQ 1%:M. - apply: mx_Maschke; apply: pi_pnat (abelem_pgroup abelQ) _. - by rewrite inE /= (charf_eq (char_Fp p_pr)). -have [P2 modP2 sumP12 dxP12] := redQ _ modP1 (submx1 _). -have{dxP12} linP2: \rank P2 = 1%N. - apply: (@addnI 1%N); rewrite -{1}linP1 -(mxdirectP dxP12) /= sumP12. - by rewrite mxrank1 (dim_abelemE abelP ntP) logP. -have{sumP12} [u def1]: exists u, 1%:M = u.1 *m P1 + u.2 *m P2. - by apply/sub_addsmxP; rewrite sumP12. -pose lam (Pi : 'M(P)) b := (nz_row Pi *m rQ b *m pinvmx (nz_row Pi)) 0 0. -have rQ_lam Pi b: - mxmodule rQ Pi -> \rank Pi = 1%N -> b \in Q -> Pi *m rQ b = lam Pi b *: Pi. -- rewrite /lam => modPi linPi Qb; set v := nz_row Pi; set a := _ 0. - have nz_v: v != 0 by rewrite nz_row_eq0 -mxrank_eq0 linPi. - have sPi_v: (Pi <= v)%MS. - by rewrite -mxrank_leqif_sup ?nz_row_sub // rank_rV nz_v linPi. - have [v' defPi] := submxP sPi_v; rewrite {2}defPi scalemxAr -mul_scalar_mx. - rewrite -mx11_scalar !(mulmxA v') -defPi mulmxKpV ?(submx_trans _ sPi_v) //. - exact: (mxmoduleP modPi). -have lam_q Pi b: - mxmodule rQ Pi -> \rank Pi = 1%N -> b \in Q -> lam Pi b ^+ q = 1. -- move=> modPi linPi Qb; apply/eqP; rewrite eq_sym -subr_eq0. - have: \rank Pi != 0%N by rewrite linPi. - apply: contraR; move/eqmx_scale=> <-. - rewrite mxrank_eq0 scalerBl subr_eq0 -mul_mx_scalar -(repr_mx1 rQ). - have <-: (b ^+ q = 1)%g by case/and3P: abelQ => _ _; move/exponentP->. - apply/eqP; rewrite repr_mxX //. - elim: (q) => [|k IHk]; first by rewrite scale1r mulmx1. - by rewrite !exprS mulmxA rQ_lam // -scalemxAl IHk scalerA. -pose f b := (lam P1 b, lam P2 b). -have inj_f: {in Q &, injective f}. - move=> b c Qb Qc /= [eq_bc1 eq_bc2]; apply: (mx_faithful_inj ffulQ) => //. - rewrite -[rQ b]mul1mx -[rQ c]mul1mx {}def1 !mulmxDl -!mulmxA. - by rewrite !{1}rQ_lam ?eq_bc1 ?eq_bc2. -pose rs := [set x : 'F_p | x ^+ q == 1]. -have s_fQ_rs: f @: Q \subset setX rs rs. - apply/subsetP=> _ /imsetP[b Qb ->]. - by rewrite !{1}inE /= !{1}lam_q ?eqxx. -have le_rs_q: #|rs| <= q ?= iff (#|rs| == q). - split; rewrite // cardE max_unity_roots ?enum_uniq ?prime_gt0 //. - by apply/allP=> x; rewrite mem_enum inE unity_rootE. -have:= subset_leqif_card s_fQ_rs. -rewrite card_in_imset // (card_pgroup (abelem_pgroup abelQ)) logQ. -case/(leqif_trans (leqif_mul le_rs_q le_rs_q))=> _; move/esym. -rewrite cardsX eqxx andbb muln_eq0 orbb eqn0Ngt prime_gt0 //= => /andP[rs_q]. -rewrite subEproper /proper {}s_fQ_rs andbF orbF => /eqP rs2_Q. -have: ~~ (rs \subset [set 1 : 'F_p]). - apply: contraL (prime_gt1 q_pr); move/subset_leq_card. - by rewrite cards1 (eqnP rs_q) leqNgt. -case/subsetPn => r rs_r; rewrite inE => ne_r_1. -have rq1: r ^+ q = 1 by apply/eqP; rewrite inE in rs_r. -split. - have Ur: r \in GRing.unit. - by rewrite -(unitrX_pos _ (prime_gt0 q_pr)) rq1 unitr1. - pose u_r : {unit 'F_p} := Sub r Ur; have:= order_dvdG (in_setT u_r). - rewrite card_units_Zp ?pdiv_gt0 // {2}/pdiv primes_prime //=. - rewrite (@totient_pfactor p 1) // muln1; apply: dvdn_trans. - have: (u_r ^+ q == 1)%g. - by rewrite -val_eqE unit_Zp_expg -Zp_nat natrX natr_Zp rq1. - case/primeP: q_pr => _ q_min; rewrite -order_dvdn; move/q_min. - by rewrite order_eq1 -val_eqE (negPf ne_r_1) /=; move/eqnP->. -have /imsetP[a Qa [def_a1 def_a2]]: (r, r) \in f @: Q. - by rewrite -rs2_Q inE andbb. -have rQa: rQ a = r%:M. - rewrite -[rQ a]mul1mx def1 mulmxDl -!mulmxA !rQ_lam //. - by rewrite -def_a1 -def_a2 !linearZ -scalerDr -def1 /= scalemx1. -exists a. - rewrite !inE Qa andbT; apply: contra ne_r_1 => a1. - by rewrite (eqP a1) repr_mx1 in rQa; rewrite (fmorph_inj _ rQa). -exists r; rewrite -!val_Fp_nat // natrX natr_Zp rq1. -split=> // x Px; apply: (@abelem_rV_inj _ _ _ abelP ntP); rewrite ?groupX //. - by rewrite memJ_norm ?(subsetP nPQ). -by rewrite abelem_rV_X // -mul_mx_scalar natr_Zp -rQa -abelem_rV_J. -Qed. - -End BGsection2. diff --git a/mathcomp/odd_order/BGsection3.v b/mathcomp/odd_order/BGsection3.v deleted file mode 100644 index 5e9f5db..0000000 --- a/mathcomp/odd_order/BGsection3.v +++ /dev/null @@ -1,1832 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div. -From mathcomp -Require Import fintype tuple bigop prime binomial finset ssralg fingroup finalg. -From mathcomp -Require Import morphism perm automorphism quotient action commutator gproduct. -From mathcomp -Require Import zmodp cyclic gfunctor center pgroup gseries nilpotent sylow. -From mathcomp -Require Import finmodule abelian frobenius maximal extremal hall. -From mathcomp -Require Import matrix mxalgebra mxrepresentation mxabelem wielandt_fixpoint. -From mathcomp -Require Import BGsection1 BGsection2. - -(******************************************************************************) -(* This file covers the material in B & G, Section 3. *) -(* Note that in spite of the use of Gorenstein 2.7.6, the material in all *) -(* of Section 3, and in all likelyhood the whole of B & G, does NOT depend on *) -(* the general proof of existence of Frobenius kernels, because results on *) -(* Frobenius groups are only used when the semidirect product decomposition *) -(* is already known, and (see file frobenius.v) in this case the kernel is *) -(* equal to the normal complement of the Frobenius complement. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Local Open Scope ring_scope. -Import GroupScope GRing.Theory. - -Section BGsection3. - -Implicit Type F : fieldType. -Implicit Type gT : finGroupType. -Implicit Type p : nat. - -(* B & G, Lemma 3.1 is covered by frobenius.Frobenius_semiregularP. *) - -(* This is B & G, Lemma 3.2. *) -Section FrobeniusQuotient. - -Variables (gT : finGroupType) (G K R : {group gT}). -Implicit Type N : {group gT}. - -(* This is a special case of B & G, Lemma 3.2 (b). *) -Lemma Frobenius_proper_quotient N : - [Frobenius G = K ><| R] -> solvable K -> N <| G -> N \proper K -> - [Frobenius G / N = (K / N) ><| (R / N)]. -Proof. -move=> frobG solK nsNG /andP[sNK ltNK]. -have [defG _ ntR _ _] := Frobenius_context frobG. -have [nsKG sRG defKR nKR tiKR] := sdprod_context defG; have [sKG _]:= andP nsKG. -have nsNK := normalS sNK sKG nsNG. -apply/Frobenius_semiregularP=> [|||Nx]. -- rewrite sdprodE ?quotient_norms //. - by rewrite -quotientMl ?defKR ?normal_norm. - by rewrite -quotientGI // tiKR quotient1. -- by rewrite -subG1 quotient_sub1 ?normal_norm. -- rewrite -subG1 quotient_sub1; last by rewrite (subset_trans sRG) ?normal_norm. - apply: contra ntR => sRN. - by rewrite -subG1 -tiKR subsetI (subset_trans sRN) /=. -rewrite !inE andbC => /andP[/morphimP[x nNx Rx ->{Nx}] notNx]. -apply/trivgP; rewrite /= -cent_cycle -quotient_cycle //. -rewrite -coprime_quotient_cent ?cycle_subG //; last first. - by apply: coprimegS (Frobenius_coprime frobG); rewrite cycle_subG. -rewrite cent_cycle (Frobenius_reg_ker frobG) ?quotient1 // !inE Rx andbT. -by apply: contraNneq notNx => ->; rewrite morph1. -Qed. - -(* This is B & G, Lemma 3.2 (a). *) -Lemma Frobenius_normal_proper_ker N : - [Frobenius G = K ><| R] -> solvable K -> N <| G -> ~~ (K \subset N) -> - N \proper K. -Proof. -move=> frobG solK nsNG ltNK; have [sNG nNG] := andP nsNG; pose H := N :&: K. -have [defG _ ntR _ _] := Frobenius_context frobG. -have [nsKG _ /mulG_sub[sKG _] nKR tiKR] := sdprod_context defG. -have nsHG: H <| G := normalI nsNG nsKG; have [_ nHG] := andP nsHG. -have ltHK: H \proper K by rewrite /proper subsetIr subsetI subxx andbT. -suffices /eqP tiNR: N :&: R == 1. - rewrite /proper ltNK andbT -(setIidPl sNG). - rewrite -(cover_partition (Frobenius_partition frobG)) big_distrr /=. - apply/bigcupsP=> _ /setU1P[->| /imsetP[x Kx ->]]; first exact: subsetIr. - rewrite conjD1g setIDA subDset -(normsP (subset_trans sKG nNG) x) //. - by rewrite -conjIg tiNR conjs1g subsetUl. -suffices: (N :&: R) / H \subset [1]. - by rewrite -subG1 quotient_sub1 ?normsGI // -subsetIidr setIACA tiKR setIg1. -have frobGq := Frobenius_proper_quotient frobG solK nsHG ltHK. -have [_ ntKq _ _ _] := Frobenius_context frobGq. -rewrite -(cent_semiregular (Frobenius_reg_compl frobGq) _ ntKq) //. -rewrite subsetI quotientS ?subsetIr // quotient_cents2r //. -by rewrite commg_subI ?setIS // subsetIidl (subset_trans sKG). -Qed. - -(* This is B & G, Lemma 3.2 (b). *) -Lemma Frobenius_quotient N : - [Frobenius G = K ><| R] -> solvable K -> N <| G -> ~~ (K \subset N) -> - [Frobenius G / N = (K / N) ><| (R / N)]. -Proof. -move=> frobG solK nsNG ltKN; apply: Frobenius_proper_quotient => //. -exact: (Frobenius_normal_proper_ker frobG). -Qed. - -End FrobeniusQuotient. - -(* This is B & G, Lemma 3.3. *) -Lemma Frobenius_rfix_compl F gT (G K R : {group gT}) n - (rG : mx_representation F G n) : - [Frobenius G = K ><| R] -> [char F]^'.-group K -> - ~~ (K \subset rker rG) -> rfix_mx rG R != 0. -Proof. -rewrite /pgroup charf'_nat => frobG nzK. -have [defG _ _ ltKG ltRG]:= Frobenius_context frobG. -have{ltKG ltRG} [sKG sRG]: K \subset G /\ R \subset G by rewrite !proper_sub. -apply: contraNneq => fixR0; rewrite rfix_mx_rstabC // -(eqmx_scale _ nzK). -pose gsum H := gring_op rG (gset_mx F G H). -have fixsum (H : {group gT}): H \subset G -> (gsum H <= rfix_mx rG H)%MS. - move/subsetP=> sHG; apply/rfix_mxP=> x Hx; have Gx := sHG x Hx. - rewrite -gring_opG // -gring_opM ?envelop_mx_id //; congr (gring_op _ _). - rewrite {2}/gset_mx (reindex_acts 'R _ Hx) ?astabsR //= mulmx_suml. - by apply: eq_bigr=> y; move/sHG=> Gy; rewrite repr_mxM. -have: gsum G + rG 1 *+ #|K| = gsum K + \sum_(x in K) gsum (R :^ x). - rewrite -gring_opG // -sumr_const -!linear_sum -!linearD; congr gring_op. - rewrite {1}/gset_mx (set_partition_big _ (Frobenius_partition frobG)) /=. - rewrite big_setU1 -?addrA /=; last first. - by apply: contraL (group1 K) => /imsetP[x _ ->]; rewrite conjD1g !inE eqxx. - congr (_ + _); rewrite big_imset /= => [|x y Kx Ky /= eqRxy]; last first. - have [/eqP/sdprodP[_ _ _ tiKR] _ _ _ /eqP snRG] := and5P frobG. - apply/eqP; rewrite eq_mulgV1 -in_set1 -set1gE -tiKR -snRG setIA. - by rewrite (setIidPl sKG) !inE conjsgM eqRxy actK groupM /= ?groupV. - rewrite -big_split; apply: eq_bigr => x Kx /=. - by rewrite addrC conjD1g -big_setD1 ?group1. -have ->: gsum G = 0. - apply/eqP; rewrite -submx0 -fixR0; apply: submx_trans (rfix_mxS rG sRG). - exact: fixsum. -rewrite repr_mx1 -scaler_nat add0r => ->. -rewrite big1 ?addr0 ?fixsum // => x Kx; have Gx := subsetP sKG x Kx. -apply/eqP; rewrite -submx0 (submx_trans (fixsum _ _)) ?conj_subG //. -by rewrite -(mul0mx _ (rG x)) -fixR0 rfix_mx_conjsg. -Qed. - -(* This is Aschbacher (40.6)(3), or G. (3.14)(iii). *) -Lemma regular_pq_group_cyclic gT p q (H R : {group gT}) : - [/\ prime p, prime q & p != q] -> #|R| = (p * q)%N -> - H :!=: 1 -> R \subset 'N(H) -> semiregular H R -> - cyclic R. -Proof. -case=> pr_p pr_q q'p oR ntH nHR regHR. -without loss{q'p} ltpq: p q pr_p pr_q oR / p < q. - by move=> IH; case: ltngtP q'p => // /IH-> //; rewrite mulnC. -have [p_gt0 q_gt0]: 0 < p /\ 0 < q by rewrite !prime_gt0. -have [[P sylP] [Q sylQ]] := (Sylow_exists p R, Sylow_exists q R). -have [sPR sQR] := (pHall_sub sylP, pHall_sub sylQ). -have [oP oQ]: #|P| = p /\ #|Q| = q. - rewrite (card_Hall sylQ) (card_Hall sylP) oR !p_part !lognM ?logn_prime //. - by rewrite !eqxx eq_sym gtn_eqF. -have [ntP ntQ]: P :!=: 1 /\ Q :!=: 1 by rewrite -!cardG_gt1 oP oQ !prime_gt1. -have nQR: R \subset 'N(Q). - rewrite -subsetIidl -indexg_eq1 -(card_Syl_mod R pr_q) (card_Syl sylQ) /=. - rewrite modn_small // -divgS ?subsetIl ?ltn_divLR // mulnC oR ltn_pmul2r //. - by rewrite (leq_trans ltpq) // -oQ subset_leq_card // subsetI sQR normG. -have coQP: coprime #|Q| #|P|. - by rewrite oP oQ prime_coprime ?dvdn_prime2 ?gtn_eqF. -have defR: Q ><| P = R. - rewrite sdprodE ?coprime_TIg ?(subset_trans sPR) //. - by apply/eqP; rewrite eqEcard mul_subG //= oR coprime_cardMg // oP oQ mulnC. -have [cycP cycQ]: cyclic P /\ cyclic Q by rewrite !prime_cyclic ?oP ?oQ. -suffices cQP: P \subset 'C(Q) by rewrite (@cyclic_dprod _ Q P) ?dprodEsd. -without loss /is_abelemP[r pr_r abelH]: H ntH nHR regHR / is_abelem H. - move=> IH; have [r _ rH] := rank_witness H. - have solR: solvable R. - apply/metacyclic_sol/metacyclicP; exists Q. - by rewrite /(Q <| R) sQR -(isog_cyclic (sdprod_isog defR)). - have coHR: coprime #|H| #|R| := regular_norm_coprime nHR regHR. - have [H1 sylH1 nH1R] := sol_coprime_Sylow_exists r solR nHR coHR. - have ntH1: H1 :!=: 1 by rewrite -rank_gt0 (rank_Sylow sylH1) -rH rank_gt0. - have [H2 minH2 sH21] := minnormal_exists ntH1 nH1R. - have [sH1H rH1 _] := and3P sylH1; have sH2H := subset_trans sH21 sH1H. - have [nH2R ntH2 abelH2] := minnormal_solvable minH2 sH21 (pgroup_sol rH1). - by apply: IH abelH2 => //; apply: semiregularS regHR. -have: rfix_mx (abelem_repr abelH ntH nHR) P == 0. - rewrite -mxrank_eq0 rfix_abelem // mxrank_eq0 rowg_mx_eq0 /=. - by rewrite (cent_semiregular regHR) ?morphim1. -apply: contraLR => not_cQP; have{not_cQP} frobR: [Frobenius R = Q ><| P]. - by apply/prime_FrobeniusP; rewrite ?prime_TIg ?oP ?oQ // centsC. -apply: (Frobenius_rfix_compl frobR). - rewrite (eq_p'group _ (charf_eq (char_Fp pr_r))). - rewrite (coprime_p'group _ (abelem_pgroup abelH)) //. - by rewrite coprime_sym (coprimegS sQR) ?regular_norm_coprime. -rewrite rker_abelem subsetI sQR centsC. -by rewrite -subsetIidl (cent_semiregular regHR) ?subG1. -Qed. - -(* This is B & G, Theorem 3.4. *) -Theorem odd_prime_sdprod_rfix0 F gT (G K R : {group gT}) n - (rG : mx_representation F G n) : - K ><| R = G -> solvable G -> odd #|G| -> coprime #|K| #|R| -> prime #|R| -> - [char F]^'.-group G -> rfix_mx rG R = 0 -> - [~: R, K] \subset rker rG. -Proof. -move: {2}_.+1 (ltnSn #|G|) => m; elim: m => // m IHm in gT G K R n rG *. -rewrite ltnS; set p := #|R| => leGm defG solG oddG coKR p_pr F'G regR. -have [nsKG sRG defKR nKR tiKR] := sdprod_context defG. -have [sKG nKG] := andP nsKG; have solK := solvableS sKG solG. -have [-> | ntK] := eqsVneq K 1; first by rewrite commG1 sub1G. -have ker_ltK (H : {group gT}): - H \proper K -> R \subset 'N(H) -> [~: R, H] \subset rker rG. -- move=> ltKH nHR; have sHK := proper_sub ltKH; set G1 := H <*> R. - have sG1G: G1 \subset G by rewrite join_subG (subset_trans sHK). - have coHR := coprimeSg sHK coKR. - have defG1: H ><| R = G1 by rewrite sdprodEY // coprime_TIg. - apply: subset_trans (subsetIr G1 _); rewrite -(rker_subg _ sG1G). - apply: IHm; rewrite ?(solvableS sG1G) ?(oddSg sG1G) ?(pgroupS sG1G) //. - apply: leq_trans leGm; rewrite /= norm_joinEr // -defKR !coprime_cardMg //. - by rewrite ltn_pmul2r ?proper_card. -without loss [q q_pr qK]: / exists2 q, prime q & q.-group K. - move=> IH; set q := pdiv #|K|. - have q_pr: prime q by rewrite pdiv_prime ?cardG_gt1. - have exHall := coprime_Hall_exists _ nKR coKR solK. - have [Q sylQ nQR] := exHall q; have [Q' hallQ' nQ'R] := exHall q^'. - have [sQK qQ _] := and3P sylQ; have [sQ'K q'Q' _] := and3P hallQ'. - without loss{IH} ltQK: / Q \proper K. - by rewrite properEneq; case: eqP IH => [<- -> | _ _ ->] //; exists q. - have ltQ'K: Q' \proper K. - rewrite properEneq; case: eqP (pgroupP q'Q' q q_pr) => //= ->. - by rewrite !inE pdiv_dvd eqxx; apply. - have nkerG := subset_trans _ (rker_norm rG). - rewrite -quotient_cents2 ?nkerG //. - have <-: Q * Q' = K. - apply/eqP; rewrite eqEcard mulG_subG sQK sQ'K. - rewrite coprime_cardMg ?(pnat_coprime qQ) //=. - by rewrite (card_Hall sylQ) (card_Hall hallQ') partnC. - rewrite quotientMl ?nkerG ?(subset_trans sQK) // centM subsetI. - by rewrite !quotient_cents2r ?ker_ltK. -without loss{m IHm leGm} [ffulG cycZ]: / rker rG = 1 /\ cyclic 'Z(G). - move=> IH; wlog [I M /= simM sumM _]: / mxsemisimple rG 1%:M. - exact: (mx_reducible_semisimple (mxmodule1 _) (mx_Maschke _ F'G)). - pose not_cRK_M i := ~~ ([~: R, K] \subset rstab rG (M i)). - case: (pickP not_cRK_M) => [i | cRK_M]; last first. - rewrite rfix_mx_rstabC ?comm_subG // -sumM. - apply/sumsmx_subP=> i _; move/negbFE: (cRK_M i). - by rewrite rfix_mx_rstabC ?comm_subG. - have [modM ntM _] := simM i; pose rM := kquo_repr (submod_repr modM). - do [rewrite {+}/not_cRK_M -(rker_submod modM) /=; set N := rker _] in rM *. - have [N1 _ | ntN] := eqVneq N 1. - apply: IH; split. - by apply/trivgP; rewrite -N1 /N rker_submod rstabS ?submx1. - have: mx_irreducible (submod_repr modM) by apply/submod_mx_irr. - by apply: mx_faithful_irr_center_cyclic; apply/trivgP. - have tiRN: R :&: N = 1. - by apply: prime_TIg; rewrite //= rker_submod rfix_mx_rstabC // regR submx0. - have nsNG: N <| G := rker_normal _; have [sNG nNG] := andP nsNG. - have nNR := subset_trans sRG nNG. - have sNK: N \subset K. - have [pi hallK]: exists pi, pi.-Hall(G) K. - by apply: HallP; rewrite -(coprime_sdprod_Hall_l defG). - rewrite (sub_normal_Hall hallK) //=. - apply: pnat_dvd (pHall_pgroup hallK). - rewrite -(dvdn_pmul2r (prime_gt0 p_pr)) -!TI_cardMg // 1?setIC // defKR. - by rewrite -norm_joinEr // cardSg // join_subG sNG. - have defGq: (K / N) ><| (R / N) = G / N. - rewrite sdprodE ?quotient_norms -?quotientMr ?defKR //. - by rewrite -quotientGI // tiKR quotient1. - case/negP; rewrite -quotient_cents2 ?(subset_trans _ nNG) //= -/N. - rewrite (sameP commG1P trivgP). - apply: subset_trans (kquo_mx_faithful (submod_repr modM)). - rewrite IHm ?quotient_sol ?coprime_morph ?morphim_odd ?quotient_pgroup //. - - by apply: leq_trans leGm; apply: ltn_quotient. - - by rewrite card_quotient // -indexgI tiRN indexg1. - apply/eqP; rewrite -submx0 rfix_quo // rfix_submod //. - by rewrite regR capmx0 linear0 sub0mx. -without loss perfectK: / [~: K, R] = K. - move=> IH; have: [~: K, R] \subset K by rewrite commg_subl. - rewrite subEproper; case/predU1P=> //; move/ker_ltK. - by rewrite commGC commg_normr coprime_commGid // commGC => ->. -have primeR: {in R^#, forall x, 'C_K[x] = 'C_K(R)}. - move=> x; case/setD1P=> nt_x Rx; rewrite -cent_cycle ((<[x]> =P R) _) //. - rewrite eqEsubset cycle_subG Rx; apply: contraR nt_x; move/prime_TIg. - by rewrite -cycle_eq1 (setIidPr _) ?cycle_subG // => ->. -case cKK: (abelian K). - rewrite commGC perfectK; move/eqP: regR; apply: contraLR. - apply: Frobenius_rfix_compl => //; last exact: pgroupS F'G. - rewrite -{2 4}perfectK coprime_abel_cent_TI // in primeR. - by apply/Frobenius_semiregularP; rewrite // -cardG_gt1 prime_gt1. -have [spK defZK]: special K /\ 'C_K(R) = 'Z(K). - apply: (abelian_charsimple_special qK) => //. - apply/bigcupsP=> H /andP[chHK cHH]. - have:= char_sub chHK; rewrite subEproper. - case/predU1P=> [eqHK | ltHK]; first by rewrite eqHK cKK in cHH. - have nHR: R \subset 'N(H) := char_norm_trans chHK nKR. - by rewrite (sameP commG1P trivgP) /= commGC -ffulG ker_ltK. -have{spK} esK: extraspecial K. - have abelZK := center_special_abelem qK spK; have [qZK _] := andP abelZK. - have /(pgroup_pdiv qZK)[_ _ []]: 'Z(K) != 1. - by case: spK => _ <-; rewrite (sameP eqP commG1P) -abelianE cKK. - case=> [|e] oK; first by split; rewrite ?oK. - suffices: cyclic 'Z(K) by rewrite (abelem_cyclic abelZK) oK pfactorK. - rewrite (cyclicS _ cycZ) // subsetI subIset ?sKG //=. - by rewrite -defKR centM subsetI -{2}defZK !subsetIr. -have [e e_gt0 oKqe] := card_extraspecial qK esK. -have cycR: cyclic R := prime_cyclic p_pr. -have co_q_p: coprime q p by rewrite oKqe coprime_pexpl in coKR. -move/eqP: regR; case/idPn. -rewrite defZK in primeR. -case: (repr_extraspecial_prime_sdprod_cycle _ _ defG _ oKqe) => // _. -apply=> //; last exact/trivgP. -apply: contraL (oddSg sRG oddG); move/eqP->; have:= oddSg sKG oddG. -by rewrite oKqe addn1 /= !odd_exp /= orbC => ->. -Qed. - -(* Internal action version of B & G, Theorem 3.4. *) -Theorem odd_prime_sdprod_abelem_cent1 k gT (G K R V : {group gT}) : - solvable G -> odd #|G| -> K ><| R = G -> coprime #|K| #|R| -> prime #|R| -> - k.-abelem V -> G \subset 'N(V) -> k^'.-group G -> 'C_V(R) = 1 -> - [~: R, K] \subset 'C_K(V). -Proof. -move=> solG oddG defG coKR prR abelV nVG k'G regR. -have [_ sRG _ nKR _] := sdprod_context defG; rewrite subsetI commg_subr nKR. -case: (eqsVneq V 1) => [-> | ntV]; first exact: cents1. -pose rV := abelem_repr abelV ntV nVG. -apply: subset_trans (_ : rker rV \subset _); last first. - by rewrite rker_abelem subsetIr. -apply: odd_prime_sdprod_rfix0 => //. - have k_pr: prime k by case/pgroup_pdiv: (abelem_pgroup abelV). - by rewrite (eq_pgroup G (eq_negn (charf_eq (char_Fp k_pr)))). -by apply/eqP; rewrite -submx0 rfix_abelem //= regR morphim1 rowg_mx1. -Qed. - -(* This is B & G, Theorem 3.5. *) -Theorem Frobenius_prime_rfix1 F gT (G K R : {group gT}) n - (rG : mx_representation F G n) : - K ><| R = G -> solvable G -> prime #|R| -> 'C_K(R) = 1 -> - [char F]^'.-group G -> \rank (rfix_mx rG R) = 1%N -> - K^`(1) \subset rker rG. -Proof. -move=> defG solG p_pr regR F'G fixRlin. -wlog closF: F rG F'G fixRlin / group_closure_field F gT. - move=> IH; apply: (@group_closure_field_exists gT F) => [[Fc f closFc]]. - rewrite -(rker_map f) IH //; last by rewrite -map_rfix_mx mxrank_map. - by rewrite (eq_p'group _ (fmorph_char f)). -move: {2}_.+1 (ltnSn #|K|) => m. -elim: m => // m IHm in gT G K R rG solG p_pr regR F'G closF fixRlin defG *. -rewrite ltnS => leKm. -have [nsKG sRG defKR nKR tiKR] := sdprod_context defG. -have [sKG nKG] := andP nsKG; have solK := solvableS sKG solG. -have cycR := prime_cyclic p_pr. -case: (eqsVneq K 1) => [-> | ntK]; first by rewrite derg1 commG1 sub1G. -have defR x: x \in R^# -> <[x]> = R. - case/setD1P; rewrite -cycle_subG -cycle_eq1 => ntX sXR. - apply/eqP; rewrite eqEsubset sXR; apply: contraR ntX => /(prime_TIg p_pr). - by rewrite /= (setIidPr sXR) => ->. -have ntR: R :!=: 1 by rewrite -cardG_gt1 prime_gt1. -have frobG: [Frobenius G = K ><| R]. - by apply/Frobenius_semiregularP=> // x Rx; rewrite -cent_cycle defR. -case: (eqVneq (rker rG) 1) => [ffulG | ntC]; last first. - set C := rker rG in ntC *; have nsCG: C <| G := rker_normal rG. - have [sCG nCG] := andP nsCG. - have nCK := subset_trans sKG nCG; have nCR := subset_trans sRG nCG. - case sKC: (K \subset C); first exact: gFsub_trans. - have sCK: C \subset K. - by rewrite proper_sub // (Frobenius_normal_proper_ker frobG) ?sKC. - have frobGq: [Frobenius G / C = (K / C) ><| (R / C)]. - by apply: Frobenius_quotient; rewrite ?sKC. - have [defGq _ ntRq _ _] := Frobenius_context frobGq. - rewrite -quotient_sub1 ?comm_subG ?quotient_der //= -/C. - apply: subset_trans (kquo_mx_faithful rG). - apply: IHm defGq _; rewrite 1?(quotient_sol, quotient_pgroup, rfix_quo) //. - - rewrite card_quotient // -indexgI /= -/C setIC. - by rewrite -(setIidPl sCK) -setIA tiKR (setIidPr (sub1G _)) indexg1. - - have: cyclic (R / C) by [rewrite quotient_cyclic]; case/cyclicP=> Cx defRq. - rewrite /= defRq cent_cycle (Frobenius_reg_ker frobGq) //= !inE defRq. - by rewrite cycle_id -cycle_eq1 -defRq ntRq. - - move=> Hq; rewrite -(group_inj (cosetpreK Hq)). - by apply: quotient_splitting_field; rewrite ?subsetIl. - by apply: leq_trans leKm; apply: ltn_quotient. -have ltK_abelian (N : {group gT}): R \subset 'N(N) -> N \proper K -> abelian N. - move=> nNR ltNK; have [sNK _] := andP ltNK; apply/commG1P/trivgP. - rewrite -(setIidPr (sub1G (N <*> R))) /= -ffulG; set G1 := N <*> R. - have sG1: G1 \subset G by rewrite join_subG (subset_trans sNK). - have defG1: N ><| R = G1. - by rewrite sdprodEY //; apply/trivgP; rewrite -tiKR setSI. - rewrite -(rker_subg _ sG1). - apply: IHm defG1 _; rewrite ?(solvableS sG1) ?(pgroupS sG1) //. - by apply/trivgP; rewrite -regR setSI. - by apply: leq_trans leKm; apply: proper_card. -have cK'K': abelian K^`(1). - exact: ltK_abelian (gFnorm_trans _ nKR) (sol_der1_proper solK _ ntK). -pose fixG := rfix_mx rG; pose NRmod N (U : 'M_n) := N <*> R \subset rstabs rG U. -have dx_modK_rfix (N : {group gT}) U V: - N \subset K -> R \subset 'N(N) -> NRmod N U -> NRmod N V -> - mxdirect (U + V) -> (U <= fixG N)%MS || (V <= fixG N)%MS. -- move=> sNK nNR nUNR nVNR dxUV. - have [-> | ntN] := eqsVneq N 1; first by rewrite -rfix_mx_rstabC sub1G. - have sNRG: N <*> R \subset G by rewrite join_subG (subset_trans sNK). - pose rNR := subg_repr rG sNRG. - have nfixU W: NRmod N W -> ~~ (W <= fixG N)%MS -> (fixG R <= W)%MS. - move=> nWN not_cWN; rewrite (sameP capmx_idPr eqmxP). - rewrite -(geq_leqif (mxrank_leqif_eq (capmxSr _ _))) fixRlin lt0n. - rewrite mxrank_eq0 -(in_submodK (capmxSl _ _)) val_submod_eq0. - have modW: mxmodule rNR W by rewrite /mxmodule rstabs_subg subsetI subxx. - rewrite -(eqmx_eq0 (rfix_submod modW _)) ?joing_subr //. - apply: Frobenius_rfix_compl (pgroupS (subset_trans sNK sKG) F'G) _. - apply/Frobenius_semiregularP=> // [|x Rx]. - by rewrite sdprodEY //; apply/trivgP; rewrite -tiKR setSI. - by apply/trivgP; rewrite -regR /= -cent_cycle defR ?setSI. - by rewrite rker_submod rfix_mx_rstabC ?joing_subl. - have: fixG R != 0 by rewrite -mxrank_eq0 fixRlin. - apply: contraR; case/norP=> not_fixU not_fixW. - by rewrite -submx0 -(mxdirect_addsP dxUV) sub_capmx !nfixU. -have redG := mx_Maschke rG F'G. -wlog [U simU nfixU]: / exists2 U, mxsimple rG U & ~~ (U <= fixG K)%MS. - move=> IH; wlog [I U /= simU sumU _]: / mxsemisimple rG 1%:M. - exact: (mx_reducible_semisimple (mxmodule1 _) redG). - have [i nfixU | fixK] := pickP (fun i => ~~ (U i <= fixG K)%MS). - by apply: IH; exists (U i). - rewrite gFsub_trans // rfix_mx_rstabC // -sumU. - by apply/sumsmx_subP=> i _; apply/idPn; rewrite fixK. -have [modU ntU minU] := simU; pose rU := submod_repr modU. -have irrU: mx_irreducible rU by apply/submod_mx_irr. -have [W modW sumUW dxUW] := redG U modU (submx1 U). -have cWK: (W <= fixG K)%MS. - have:= dx_modK_rfix _ _ _ (subxx _) nKR _ _ dxUW. - by rewrite /NRmod /= norm_joinEr // defKR (negPf nfixU); apply. -have nsK'G: K^`(1) <| G by rewrite gFnormal_trans. -have [sK'G nK'G] := andP nsK'G. -suffices nregK'U: (rfix_mx rU K^`(1))%MS != 0. - rewrite rfix_mx_rstabC ?normal_sub // -sumUW addsmx_sub andbC. - rewrite (submx_trans cWK) ?rfix_mxS ?der_sub //= (sameP capmx_idPl eqmxP). - rewrite minU ?capmxSl ?capmx_module ?normal_rfix_mx_module //. - apply: contra nregK'U => cUK'; rewrite (eqmx_eq0 (rfix_submod _ _)) //. - by rewrite (eqP cUK') linear0. -pose rK := subg_repr rU (normal_sub nsKG); set p := #|R| in p_pr. -wlog sK: / socleType rK by apply: socle_exists. -have [i _ def_sK]: exists2 i, i \in setT & [set: sK] = orbit 'Cl G i. - exact/imsetP/Clifford_atrans. -have card_sK: #|[set: sK]| = #|G : 'C[i | 'Cl]|. - by rewrite def_sK card_orbit_in ?indexgI. -have ciK: K \subset 'C[i | 'Cl]. - apply: subset_trans (astabS _ (subsetT _)). - by apply: subset_trans (Clifford_astab _); apply: joing_subl. -pose M := socle_base i; have simM: mxsimple rK M := socle_simple i. -have [sKp | sK1 {ciK card_sK}]: #|[set: sK]| = p \/ #|[set: sK]| = 1%N. -- apply/pred2P; rewrite orbC card_sK; case/primeP: p_pr => _; apply. - by rewrite (_ : p = #|G : K|) ?indexgS // -divgS // -(sdprod_card defG) mulKn. -- have{def_sK} def_sK: [set: sK] = orbit 'Cl R i. - apply/eqP; rewrite eq_sym -subTset def_sK -[G in orbit _ G i]defKR. - apply/subsetP=> _ /imsetP[_ /imset2P[y z /(subsetP ciK)ciy Rz ->] ->]. - rewrite !(inE, sub1set) in ciy; have{ciy}[Gy /eqP-ciy]:= andP ciy. - by rewrite actMin ?(subsetP sRG z Rz) // ciy mem_orbit. - have inj_i: {in R &, injective ('Cl%act i)}. - apply/dinjectiveP/card_uniqP; rewrite size_map -cardE -/p. - by rewrite -sKp def_sK /orbit [in _ @: _]unlock cardsE. - pose sM := (\sum_(y in R) M *m rU y)%MS. - have dxM: mxdirect sM. - apply/mxdirect_sumsP=> y Ry; have Gy := subsetP sRG y Ry. - pose j := 'Cl%act i y. - apply/eqP; rewrite -submx0 -{2}(mxdirect_sumsP (Socle_direct sK) j) //. - rewrite capmxS ?val_Clifford_act // ?submxMr ?component_mx_id //. - apply/sumsmx_subP => z; case/andP=> Rz ne_z_y; have Gz := subsetP sRG z Rz. - rewrite (sumsmx_sup ('Cl%act i z)) ?(inj_in_eq inj_i) //. - by rewrite val_Clifford_act // ?submxMr // ?component_mx_id. - pose inCR := \sum_(x in R) rU x. - have im_inCR: (inCR <= rfix_mx rU R)%MS. - apply/rfix_mxP=> x Rx; have Gx := subsetP sRG x Rx. - rewrite {2}[inCR](reindex_astabs 'R x) ?astabsR //= mulmx_suml. - by apply: eq_bigr => y; move/(subsetP sRG)=> Gy; rewrite repr_mxM. - pose inM := proj_mx M (\sum_(x in R | x != 1) M *m rU x)%MS. - have dxM1 := mxdirect_sumsP dxM _ (group1 R). - rewrite repr_mx1 mulmx1 in dxM1. - have inCR_K: M *m inCR *m inM = M. - rewrite mulmx_sumr (bigD1 1) //= repr_mx1 mulmx1 mulmxDl proj_mx_id //. - by rewrite proj_mx_0 ?addr0 // summx_sub_sums. - have [modM ntM _] := simM. - have linM: \rank M = 1%N. - apply/eqP; rewrite eqn_leq lt0n mxrank_eq0 ntM andbT. - rewrite -inCR_K; apply: leq_trans (mxrankM_maxl _ _) _. - apply: leq_trans (mxrankS (mulmx_sub _ im_inCR)) _. - rewrite rfix_submod //; apply: leq_trans (mxrankM_maxl _ _) _. - by rewrite -fixRlin mxrankS ?capmxSr. - apply: contra (ntM); move/eqP; rewrite -submx0 => <-. - by rewrite -(rfix_mx_rstabC rK) ?der_sub // -(rker_submod modM) rker_linear. -have{sK i M simM sK1 def_sK} irrK: mx_irreducible rK. - have cycGq: cyclic (G / K) by rewrite -defKR quotientMidl quotient_cyclic. - apply: (mx_irr_prime_index closF irrU cycGq simM) => x Gx /=. - apply: (component_mx_iso simM); first exact: Clifford_simple. - have jP: component_mx rK (M *m rU x) \in socle_enum sK. - exact/component_socle/Clifford_simple. - pose j := PackSocle jP; apply: submx_trans (_ : j <= _)%MS. - by rewrite PackSocleK component_mx_id //; apply: Clifford_simple. - have def_i: [set i] == [set: sK] by rewrite eqEcard subsetT cards1 sK1. - by rewrite ((j =P i) _) // -in_set1 (eqP def_i) inE. -pose G' := K^`(1) <*> R. -have sG'G: G' \subset G by rewrite join_subG sK'G. -pose rG' := subg_repr rU sG'G. -wlog irrG': / mx_irreducible rG'. - move=> IH; wlog [M simM sM1]: / exists2 M, mxsimple rG' M & (M <= 1%:M)%MS. - by apply: mxsimple_exists; rewrite ?mxmodule1; case: irrK. - have [modM ntM _] := simM. - have [M' modM' sumM dxM] := mx_Maschke rG' (pgroupS sG'G F'G) modM sM1. - wlog{IH} ntM': / M' != 0. - case: eqP sumM => [-> M1 _ | _ _ -> //]; apply: IH. - by apply: mx_iso_simple simM; apply: eqmx_iso; rewrite addsmx0_id in M1. - suffices: (K^`(1) \subset rstab rG' M) || (K^`(1) \subset rstab rG' M'). - rewrite !rfix_mx_rstabC ?joing_subl //; rewrite -!submx0 in ntM ntM' *. - by case/orP; move/submx_trans=> sM; apply: (contra (sM _ _)). - rewrite !rstab_subg !rstab_submod !subsetI joing_subl !rfix_mx_rstabC //. - rewrite /mxmodule !rstabs_subg !rstabs_submod !subsetI !subxx in modM modM'. - do 2!rewrite orbC -genmxE. - rewrite dx_modK_rfix // /NRmod ?(eqmx_rstabs _ (genmxE _)) ?der_sub //. - exact: subset_trans sRG nK'G. - apply/mxdirect_addsP; apply/eqP; rewrite -genmx_cap (eqmx_eq0 (genmxE _)). - rewrite -(in_submodK (submx_trans (capmxSl _ _) (val_submodP _))). - rewrite val_submod_eq0 in_submodE -submx0 (submx_trans (capmxMr _ _ _)) //. - by rewrite -!in_submodE !val_submodK (mxdirect_addsP dxM). -have nsK'K: K^`(1) <| K by apply: der_normal. -pose rK'K := subg_repr rK (normal_sub nsK'K). -have irrK'K: mx_absolutely_irreducible rK'K. - wlog sK'K: / socleType rK'K by apply: socle_exists. - have sK'_dv_K: #|[set: sK'K]| %| #|K|. - exact: atrans_dvd_in (Clifford_atrans _ _). - have nsK'G': K^`(1) <| G' := normalS (joing_subl _ _) sG'G nsK'G. - pose rK'G' := subg_repr rG' (normal_sub nsK'G'). - wlog sK'G': / socleType rK'G' by apply: socle_exists. - have coKp: coprime #|K| p := Frobenius_coprime frobG. - have nK'R := subset_trans sRG nK'G. - have sK'_dv_p: #|[set: sK'G']| %| p. - suffices: #|G' : 'C([set: sK'G'] | 'Cl)| %| #|G' : K^`(1)|. - rewrite -(divgS (joing_subl _ _)) /= {2}norm_joinEr //. - rewrite coprime_cardMg ?(coprimeSg (normal_sub nsK'K)) //. - rewrite mulKn ?cardG_gt0 // -indexgI; apply: dvdn_trans. - exact: atrans_dvd_index_in (Clifford_atrans _ _). - rewrite indexgS //; apply: subset_trans (Clifford_astab sK'G'). - exact: joing_subl. - have eq_sK': #|[set: sK'K]| = #|[set: sK'G']|. - rewrite !cardsT !cardE -!(size_map (fun i => socle_val i)). - apply: perm_eq_size. - rewrite uniq_perm_eq 1?(map_inj_uniq val_inj) 1?enum_uniq // => V. - apply/mapP/mapP=> [] [i _ ->{V}]. - exists (PackSocle (component_socle sK'G' (socle_simple i))). - by rewrite mem_enum. - by rewrite PackSocleK. - exists (PackSocle (component_socle sK'K (socle_simple i))). - by rewrite mem_enum. - by rewrite PackSocleK. - have [i def_i]: exists i, [set: sK'G'] = [set i]. - apply/cards1P; rewrite -dvdn1 -{7}(eqnP coKp) dvdn_gcd. - by rewrite -{1}eq_sK' sK'_dv_K sK'_dv_p. - pose M := socle_base i; have simM : mxsimple rK'G' M := socle_simple i. - have cycGq: cyclic (G' / K^`(1)). - by rewrite /G' joingC quotientYidr ?quotient_cyclic. - apply closF; apply: (mx_irr_prime_index closF irrG' cycGq simM) => x K'x /=. - apply: (component_mx_iso simM); first exact: Clifford_simple. - have jP: component_mx rK'G' (M *m rG' x) \in socle_enum sK'G'. - exact/component_socle/Clifford_simple. - pose j := PackSocle jP; apply: submx_trans (_ : j <= _)%MS. - by rewrite PackSocleK component_mx_id //; apply: Clifford_simple. - by rewrite ((j =P i) _) // -in_set1 -def_i inE. -have linU: \rank U = 1%N by apply/eqP; rewrite abelian_abs_irr in irrK'K. -case: irrU => _ nz1 _; apply: contra nz1; move/eqP=> fix0. -by rewrite -submx0 -fix0 -(rfix_mx_rstabC rK) ?der_sub // rker_linear. -Qed. - -(* Internal action version of B & G, Theorem 3.5. *) -Theorem Frobenius_prime_cent_prime k gT (G K R V : {group gT}) : - solvable G -> K ><| R = G -> prime #|R| -> 'C_K(R) = 1 -> - k.-abelem V -> G \subset 'N(V) -> k^'.-group G -> #|'C_V(R)| = k -> - K^`(1) \subset 'C_K(V). -Proof. -move=> solG defG prR regRK abelV nVG k'G primeRV. -have [_ sRG _ nKR _] := sdprod_context defG; rewrite subsetI der_sub. -have [-> | ntV] := eqsVneq V 1; first exact: cents1. -pose rV := abelem_repr abelV ntV nVG. -apply: subset_trans (_ : rker rV \subset _); last first. - by rewrite rker_abelem subsetIr. -have k_pr: prime k by case/pgroup_pdiv: (abelem_pgroup abelV). -apply: (Frobenius_prime_rfix1 defG) => //. - by rewrite (eq_pgroup G (eq_negn (charf_eq (char_Fp k_pr)))). -apply/eqP; rewrite rfix_abelem // -(eqn_exp2l _ _ (prime_gt1 k_pr)). -rewrite -{1}(card_Fp k_pr) -card_rowg rowg_mxK. -by rewrite card_injm ?abelem_rV_injm ?subsetIl ?primeRV. -Qed. - -Section Theorem_3_6. -(* Limit the scope of the FiniteModule notations *) -Import FiniteModule. - -(* This is B & G, Theorem 3.6. *) -Theorem odd_sdprod_Zgroup_cent_prime_plength1 p gT (G H R R0 : {group gT}) : - solvable G -> odd #|G| -> H ><| R = G -> coprime #|H| #|R| -> - R0 \subset R -> prime #|R0| -> Zgroup 'C_H(R0) -> - p.-length_1 [~: H, R]. -Proof. -move: {2}_.+1 (ltnSn #|G|) => n; elim: n => // n IHn in gT G H R R0 *. -rewrite ltnS; move oR0: #|R0| => r leGn solG oddG defG coHR sR0R r_pr ZgrCHR0. -have rR0: r.-group R0 by rewrite /pgroup oR0 pnat_id. -have [nsHG sRG mulHR nHR tiHR]:= sdprod_context defG. -have [sHG nHG] := andP nsHG; have solH := solvableS sHG solG. -have IHsub (H1 R1 : {group gT}): - H1 \subset H -> H1 * R1 \subset 'N(H1) -> R0 \subset R1 -> R1 \subset R -> - (#|H1| < #|H|) || (#|R1| < #|R|) -> p.-length_1 [~: H1, R1]. -- move=> sH1 nH1 sR01 sR1 ltG1; set G1 := H1 <*> R1. - have coHR1: coprime #|H1| #|R1| by rewrite (coprimeSg sH1) // (coprimegS sR1). - have defG1: H1 ><| R1 = G1. - by rewrite sdprodEY ?coprime_TIg ?(subset_trans (mulG_subr H1 R1)). - have sG1: G1 \subset G by rewrite join_subG -mulG_subG -mulHR mulgSS. - have{ltG1} ltG1n: #|G1| < n. - rewrite (leq_trans _ leGn) // -(sdprod_card defG1) -(sdprod_card defG). - have leqifS := leqif_geq (subset_leq_card _). - rewrite ltn_neqAle !(leqif_mul (leqifS _ _ _ sH1) (leqifS _ _ _ sR1)). - by rewrite muln_eq0 !negb_or negb_and -!ltnNge ltG1 -!lt0n !cardG_gt0. - apply: IHn defG1 _ sR01 _ _; rewrite ?oR0 ?(solvableS sG1) ?(oddSg sG1) //. - exact: ZgroupS (setSI _ sH1) ZgrCHR0. -without loss defHR: / [~: H, R] = H; last rewrite defHR. - have sHR_H: [~: H, R] \subset H by rewrite commg_subl. - have:= sHR_H; rewrite subEproper; case/predU1P=> [-> -> //|ltHR_H _]. - rewrite -coprime_commGid // IHsub 1?proper_card //. - by apply: subset_trans (commg_norm H R); rewrite norm_joinEr ?mulSg. -have{n leGn IHn tiHR} IHquo (X : {group gT}): - X :!=: 1 -> X \subset H -> G \subset 'N(X) -> p.-length_1 (H / X). -- move=> ntX sXH nXG; have nXH := subset_trans sHG nXG. - have nXR := subset_trans sRG nXG; have nXR0 := subset_trans sR0R nXR. - rewrite -defHR quotientE morphimR // -!quotientE. - have ltGbn: #|G / X| < n. - exact: leq_trans (ltn_quotient ntX (subset_trans sXH sHG)) _. - have defGb: (H / X) ><| (R / X) = G / X by apply: quotient_coprime_sdprod. - have pr_R0b: prime #|R0 / X|. - have tiXR0: X :&: R0 = 1 by apply/trivgP; rewrite -tiHR setISS. - by rewrite card_quotient // -indexgI setIC tiXR0 indexg1 oR0. - have solGb: solvable (G / X) by apply: quotient_sol. - have coHRb: coprime #|H / X| #|R / X| by apply: coprime_morph. - apply: IHn defGb coHRb _ pr_R0b _; rewrite ?quotientS ?quotient_odd //. - by rewrite -coprime_quotient_cent ?(coprimegS sR0R) // morphim_Zgroup. -without loss Op'H: / 'O_p^'(H) = 1. - have [_ -> // | ntO _] := eqVneq 'O_p^'(H) 1. - suffices: p.-length_1 (H / 'O_p^'(H)). - by rewrite p'quo_plength1 ?pcore_normal ?pcore_pgroup. - apply: IHquo => //; first by rewrite normal_sub ?pcore_normal. - by rewrite normal_norm // gFnormal_trans. -move defV: 'F(H)%G => V. -have charV: V \char H by rewrite -defV Fitting_char. -have /andP[sVH nVH]: V <| H := char_normal charV. -have nsVG: V <| G := char_normal_trans charV nsHG. -have [_ nVG] := andP nsVG; have nVR: R \subset 'N(V) := subset_trans sRG nVG. -without loss ntV: / V :!=: 1. - by rewrite -defV trivg_Fitting //; case: eqP => [|_] ->; rewrite ?plength1_1. -have scVHV: 'C_H(V) \subset V by rewrite -defV cent_sub_Fitting. -have{defV Op'H} defV: 'O_p(H) = V by rewrite -(Fitting_eq_pcore Op'H) -defV. -have pV: p.-group V by rewrite -defV pcore_pgroup. -have [p_pr p_dv_V _] := pgroup_pdiv pV ntV. -have p'r: r != p. - rewrite eq_sym -dvdn_prime2 // -prime_coprime // (coprime_dvdl p_dv_V) //. - by rewrite -oR0 (coprimegS sR0R) // (coprimeSg sVH). -without loss{charV} abelV: / p.-abelem V; last have [_ cVV eV] := and3P abelV. - move/implyP; rewrite implybE -trivg_Phi //; case/orP=> // ntPhi. - have charPhi: 'Phi(V) \char H := gFchar_trans _ charV. - have nsPhiH := char_normal charPhi; have [sPhiH nPhiH] := andP nsPhiH. - have{charPhi} nPhiG: G \subset 'N('Phi(V)):= char_norm_trans charPhi nHG. - rewrite -(pquo_plength1 nsPhiH) 1?IHquo ?(pgroupS (Phi_sub _)) //. - have [/= W defW sPhiW nsWH] := inv_quotientN nsPhiH (pcore_normal p^' _). - have p'Wb: p^'.-group (W / 'Phi(V)) by rewrite -defW pcore_pgroup. - have{p'Wb} tiWb := coprime_TIg (pnat_coprime (quotient_pgroup _ _) p'Wb). - suffices pW: p.-group W by rewrite -(tiWb W pW) setIid. - apply/pgroupP=> q q_pr; case/Cauchy=> // x Wx ox; apply: wlog_neg => q'p. - suffices Vx: x \in V by rewrite (pgroupP pV) // -ox order_dvdG. - have [sWH nWH] := andP nsWH; rewrite (subsetP scVHV) // inE (subsetP sWH) //=. - have coVx: coprime #|V| #[x] by rewrite ox (pnat_coprime pV) // pnatE. - rewrite -cycle_subG (coprime_cent_Phi pV coVx) //. - have: V :&: W \subset 'Phi(V); last apply: subset_trans. - rewrite -quotient_sub1; last by rewrite subIset ?(subset_trans sWH) ?orbT. - by rewrite quotientIG ?tiWb. - rewrite commg_subI //; first by rewrite subsetI subxx (subset_trans sVH). - by rewrite cycle_subG inE Wx (subsetP nVH) // (subsetP sWH). -have{scVHV} scVH: 'C_H(V) = V by apply/eqP; rewrite eqEsubset scVHV subsetI sVH. -without loss{IHquo} indecomposableV: / forall U W, - U \x W = V -> G \subset 'N(U) :&: 'N(W) -> U = 1 \/ U = V. -- pose decV UW := let: (U, W) := UW in - [&& U \x W == V, G \subset 'N(U) :&: 'N(W), U != 1 & W != 1]. - case: (pickP decV) => [[A B /=] | indecV]; last first. - apply=> U W defUW nUW_G; have:= indecV (U, W); rewrite /= -defUW nUW_G eqxx. - by rewrite -negb_or; case/pred2P=> ->; [left | right; rewrite dprodg1]. - rewrite subsetI -!andbA => /and5P[/eqP/dprodP[[U W -> ->{A B}]]]. - move=> defUW _ tiUW nUG nWG ntU ntW _. - have [sUH sWH]: U \subset H /\ W \subset H. - by apply/andP; rewrite -mulG_subG defUW. - have [nsUH nsWH]: U <| H /\ W <| H. - by rewrite /normal !(subset_trans sHG) ?andbT. - by rewrite -(quo2_plength1 _ nsUH nsWH) ?tiUW ?IHquo. -have nsFb: 'F(H / V) <| G / V by rewrite gFnormal_trans ?quotient_normal. -have{nsVG nsFb} [/= U defU sVU nsUG] := inv_quotientN nsVG nsFb. -have{nsUG} [sUG nUG] := andP nsUG. -have [solU nVU] := (solvableS sUG solG, subset_trans sUG nVG). -have sUH: U \subset H by rewrite -(quotientSGK nVU sVH) -defU Fitting_sub. -have [K hallK nKR]: exists2 K : {group gT}, p^'.-Hall(U) K & R \subset 'N(K). - by apply: coprime_Hall_exists; rewrite ?(coprimeSg sUH) ?(subset_trans sRG). -have [sKU p'K _] := and3P hallK; have{sUG} sKG := subset_trans sKU sUG. -have coVK: coprime #|V| #|K| := pnat_coprime pV p'K. -have [sKH nVK] := (subset_trans sKU sUH, subset_trans sKU nVU). -have{defV} p'Ub: p^'.-group (U / V). - rewrite -defU -['F(H / V)](nilpotent_pcoreC p (Fitting_nil _)) /=. - by rewrite p_core_Fitting -defV trivg_pcore_quotient dprod1g pcore_pgroup. -have{p'Ub} sylV: p.-Sylow(U) V by rewrite /pHall sVU pV -card_quotient. -have{sKU} mulVK: V * K = U. - apply/eqP; rewrite eqEcard mul_subG //= coprime_cardMg //. - by rewrite (card_Hall sylV) (card_Hall hallK) partnC. -have [sKN sNH]: K \subset 'N_H(K) /\ 'N_H(K) \subset H. - by rewrite subsetIl subsetI sKH normG. -have [solN nVN] := (solvableS sNH solH, subset_trans sNH nVH). -have{solU hallK sUH nUG} defH: V * 'N_H(K) = H. - have nsUH: U <| H by apply/andP; rewrite (subset_trans sHG). - by rewrite -(mulSGid sKN) mulgA mulVK (Hall_Frattini_arg solU nsUH hallK). -have [P sylP nPR]: exists2 P : {group _}, p.-Sylow('N_H(K)) P & R \subset 'N(P). - apply: coprime_Hall_exists (coprimeSg sNH coHR) solN. - by rewrite normsI ?norms_norm. -have [sPN pP _]: [/\ P \subset 'N_H(K), p.-group P & _] := and3P sylP. -have [sPH nKP]: P \subset H /\ P \subset 'N(K) by apply/andP; rewrite -subsetI. -have nVP := subset_trans sPH nVH. -have coKP: coprime #|K| #|P| by rewrite coprime_sym (pnat_coprime pP). -have{sylP} sylVP: p.-Sylow(H) (V <*> P). - rewrite pHallE /= norm_joinEr ?mul_subG //= -defH -!LagrangeMl. - rewrite partnM // part_pnat_id // -!card_quotient //. - by apply/eqP; congr (_ * _)%N; apply: card_Hall; apply: quotient_pHall. -have [trKP | {sylV sVU nVU}ntKP] := eqVneq [~: K, P] 1. - suffices sylVH: p.-Sylow(H) V. - rewrite p_elt_gen_length1 // (_ : p_elt_gen p H = V). - rewrite /pHall pcore_sub pcore_pgroup /= pnatNK. - by apply: pnat_dvd pV; apply: dvdn_indexg. - rewrite -(genGid V) -(setIidPr sVH); congr <<_>>; apply/setP=> x. - rewrite !inE; apply: andb_id2l => Hx. - by rewrite (mem_normal_Hall sylVH) /normal ?sVH. - suffices sPV: P \subset V by rewrite -(joing_idPl sPV). - suffices sPU: P \subset U by rewrite (sub_normal_Hall sylV) //; apply/andP. - have cUPb: P / V \subset 'C_(H / V)(U / V). - rewrite subsetI morphimS // -mulVK quotientMidl quotient_cents2r //. - by rewrite commGC trKP sub1G. - rewrite -(quotientSGK nVP sVU) (subset_trans cUPb) //. - by rewrite -defU cent_sub_Fitting ?quotient_sol. -have{sylVP} dxV: [~: V, K] \x 'C_V(K) = V by apply: coprime_abelian_cent_dprod. -have tiVsub_VcK: 'C_V(K) = 1 \/ 'C_V(K) = V. - apply: (indecomposableV _ [~: V, K]); first by rewrite dprodC. - rewrite -mulHR -defH -mulgA mul_subG // subsetI. - by rewrite commg_norml cents_norm // centsC subIset // -abelianE cVV. - have nK_NR: 'N_H(K) * R \subset 'N(K) by rewrite mul_subG ?subsetIr. - have nV_NR: 'N_H(K) * R \subset 'N(V) by rewrite mul_subG. - by rewrite normsR // normsI ?norms_cent. -have{tiVsub_VcK dxV} [defVK tiVcK]: [~: V, K] = V /\ 'C_V(K) = 1. - have [tiVcK | eqC] := tiVsub_VcK; first by rewrite -{2}dxV // tiVcK dprodg1. - rewrite (card1_trivg (pnat_1 (pgroupS _ pV) p'K)) ?comm1G ?eqxx // in ntKP. - by rewrite -scVH subsetI sKH centsC -eqC subsetIr. -have eqVncK: 'N_V(K) = 'C_V(K) := coprime_norm_cent nVK (pnat_coprime pV p'K). -have{eqVncK} tiVN: V :&: 'N_H(K) = 1 by rewrite setIA (setIidPl sVH) eqVncK. -have{sPN} tiVP: V :&: P = 1 by apply/trivgP; rewrite -tiVN setIS. -have{U defU mulVK} defK: 'F('N_H(K)) = K. - have [injV imV] := isomP (quotient_isom nVN tiVN). - rewrite -(im_invm injV) -injm_Fitting ?injm_invm //= {2}imV /=. - rewrite -quotientMidl defH defU -mulVK quotientMidl morphim_invmE. - by rewrite morphpre_restrm quotientK // -group_modr // setIC tiVN mul1g. -have scKH: 'C_H(K) \subset K. - rewrite -{2}defK; apply: subset_trans (cent_sub_Fitting _) => //. - by rewrite defK subsetI subsetIr setIS // cent_sub. -have{nVN} ntKR0: [~: K, R0] != 1. - rewrite (sameP eqP commG1P); apply: contra ntKP => cR0K. - have ZgrK: Zgroup K by apply: ZgroupS ZgrCHR0; rewrite subsetI sKH. - have{ZgrK} cycK: cyclic K by rewrite nil_Zgroup_cyclic // -defK Fitting_nil. - have{cycK} sNR_K: [~: 'N_H(K), R] \subset K. - apply: subset_trans scKH; rewrite subsetI; apply/andP; split. - by rewrite (subset_trans (commSg R sNH)) // commGC commg_subr. - suffices: 'N(K)^`(1) \subset 'C(K). - by apply: subset_trans; rewrite commgSS ?subsetIr. - rewrite der1_min ?cent_norm //= -ker_conj_aut (isog_abelian (first_isog _)). - exact: abelianS (Aut_conj_aut K 'N(K)) (Aut_cyclic_abelian cycK). - suffices sPV: P \subset V by rewrite -(setIidPr sPV) tiVP commG1. - have pPV: p.-group (P / V) := quotient_pgroup V pP. - rewrite -quotient_sub1 // subG1 (card1_trivg (pnat_1 pPV _)) //. - apply: pgroupS (quotient_pgroup V p'K). - apply: subset_trans (quotientS V sNR_K). - by rewrite quotientR // -quotientMidl defH -quotientR ?defHR ?quotientS. -have nKR0: R0 \subset 'N(K) := subset_trans sR0R nKR. -have mulKR0: K * R0 = K <*> R0 by rewrite norm_joinEr. -have sKR0_G : K <*> R0 \subset G by rewrite -mulKR0 -mulHR mulgSS. -have nV_KR0: K <*> R0 \subset 'N(V) := subset_trans sKR0_G nVG. -have solKR0: solvable (K <*> R0) by apply: solvableS solG. -have coKR0: coprime #|K| #|R0| by rewrite (coprimeSg sKH) ?(coprimegS sR0R). -have r'K: r^'.-group K. - by rewrite /pgroup p'natE -?prime_coprime // coprime_sym -oR0. -have tiKcV: 'C_K(V) = 1. - by apply/trivgP; rewrite -tiVN -{2}scVH -setIIr setICA setIC setSI. -have tiKR0cV: 'C_(K <*> R0)(V) = 1. - set C := 'C_(K <*> R0)(V); apply/eqP; apply: contraR ntKR0 => ntC. - have nC_KR0: K <*> R0 \subset 'N(C) by rewrite normsI ?normG ?norms_cent. - rewrite -subG1 -(coprime_TIg coKR0) commg_subI ?subsetI ?subxx //=. - suff defC: C == R0 by rewrite -(eqP defC) (subset_trans (joing_subl K R0)). - have sC_R0: C \subset R0. - rewrite -[C](coprime_mulG_setI_norm mulKR0) ?norms_cent //= tiKcV mul1g. - apply: subsetIl. - rewrite eqEsubset sC_R0; apply: contraR ntC => not_sR0C. - by rewrite -(setIidPr sC_R0) prime_TIg ?oR0. -have{nKR0 mulKR0 sKR0_G solKR0 nV_KR0} oCVR0: #|'C_V(R0)| = p. - case: (eqVneq 'C_V(R0) 1) => [tiVcR0 | ntCVR0]. - case/negP: ntKR0; rewrite -subG1/= commGC -tiKcV. - have defKR0: K ><| R0 = K <*> R0 by rewrite sdprodE ?coprime_TIg. - have odd_KR0: odd #|K <*> R0| := oddSg sKR0_G oddG. - apply: odd_prime_sdprod_abelem_cent1 abelV nV_KR0 _ _; rewrite // ?oR0 //=. - by rewrite -mulKR0 pgroupM p'K /pgroup oR0 pnatE. - have [x defC]: exists x, 'C_V(R0) = <[x]>. - have ZgrC: Zgroup 'C_V(R0) by apply: ZgroupS ZgrCHR0; apply: setSI. - apply/cyclicP; apply: (forall_inP ZgrC); apply/SylowP; exists p => //. - by rewrite /pHall subxx indexgg (pgroupS (subsetIl V _)). - rewrite defC; apply: nt_prime_order => //; last by rewrite -cycle_eq1 -defC. - by rewrite (exponentP eV) // -cycle_subG -defC subsetIl. -have tiPcR0: 'C_P(R0) = 1. - rewrite -(setIidPl (joing_subl P V)) setIIl TI_Ohm1 //=. - set C := 'C_(P <*> V)(R0); suffices <-: 'C_V(R0) = 'Ohm_1(C). - by rewrite setIC -setIIl tiVP (setIidPl (sub1G _)). - have pPV: p.-group (P <*> V) by rewrite norm_joinEl // pgroupM pP. - have pC: p.-group C := pgroupS (subsetIl _ _) pPV. - have abelCVR0: p.-abelem 'C_V(R0) by rewrite prime_abelem ?oCVR0. - have sCV_C: 'C_V(R0) \subset C by rewrite setSI ?joing_subr. - apply/eqP; rewrite eqEcard -(Ohm1_id abelCVR0) OhmS //=. - have [-> | ntC] := eqVneq C 1; first by rewrite subset_leq_card ?OhmS ?sub1G. - rewrite (Ohm1_id abelCVR0) oCVR0 (Ohm1_cyclic_pgroup_prime _ pC) //=. - have ZgrC: Zgroup C by rewrite (ZgroupS _ ZgrCHR0) ?setSI // join_subG sPH. - apply: (forall_inP ZgrC); apply/SylowP; exists p => //. - by apply/pHallP; rewrite part_pnat_id. -have defP: [~: P, R0] = P. - have solvP := pgroup_sol pP; have nPR0 := subset_trans sR0R nPR. - have coPR0: coprime #|P| #|R0| by rewrite (coprimeSg sPH) ?(coprimegS sR0R). - by rewrite -{2}(coprime_cent_prod nPR0) // tiPcR0 mulg1. -have{IHsub nVH} IHsub: forall X : {group gT}, - P <*> R0 \subset 'N(X) -> X \subset K -> - (#|V <*> X <*> P| < #|H|) || (#|R0| < #|R|) -> [~: X, P] = 1. -- move=> X; rewrite join_subG; case/andP=> nXP nXR0 sXK. - set H0 := V <*> X <*> P => ltG0G; have sXH := subset_trans sXK sKH. - have sXH0: X \subset H0 by rewrite /H0 joingC joingA joing_subr. - have sH0H: H0 \subset H by rewrite !join_subG sVH sXH. - have nH0R0: R0 \subset 'N(H0). - by rewrite 2?normsY ?nXR0 ?(subset_trans sR0R) // (subset_trans sRG). - have Op'H0: 'O_p^'(H0) = 1. - have [sOp' nOp'] := andP (pcore_normal _ _ : 'O_p^'(H0) <| H0). - have p'Op': p^'.-group 'O_p^'(H0) by apply: pcore_pgroup. - apply: card1_trivg (pnat_1 (pgroupS _ pV) p'Op'). - rewrite -scVH subsetI (subset_trans sOp') //= centsC; apply/setIidPl. - rewrite -coprime_norm_cent ?(pnat_coprime pV p'Op') //. - by rewrite (setIidPl (subset_trans _ nOp')) // /H0 -joingA joing_subl. - exact: subset_trans (subset_trans sH0H nVH). - have Op'HR0: 'O_p^'([~: H0, R0]) = 1. - apply/trivgP; rewrite -Op'H0 pcore_max ?pcore_pgroup // gFnormal_trans //. - by rewrite /(_ <| _) commg_norml andbT commg_subl. - have{ltG0G IHsub} p1_HR0: p.-length_1 [~: H0, R0]. - by apply: IHsub ltG0G => //=; rewrite mul_subG ?normG. - have{p1_HR0} sPOpHR0: P \subset 'O_p([~: H0, R0]). - rewrite sub_Hall_pcore //; last by rewrite -defP commSg ?joing_subr. - rewrite /pHall pcore_sub pcore_pgroup /= -(pseries_pop2 _ Op'HR0). - rewrite -card_quotient ?normal_norm ?pseries_normal // -/(pgroup _ _). - by rewrite -{1}((_ :=P: _) p1_HR0) (quotient_pseries [::_; _]) pcore_pgroup. - apply/trivgP; have <-: K :&: 'O_p([~: H0, R0]) = 1. - by rewrite setIC coprime_TIg // (pnat_coprime (pcore_pgroup p _)). - by rewrite commg_subI // subsetI ?sPOpHR0 ?sXK //= gFnorm_trans // normsRl. -have{defH sR0R} [defH defR0]: V * K * P = H /\ R0 :=: R. - suffices: (V * K * P == H) && (R0 :==: R) by do 2!case: eqP => // ->. - apply: contraR ntKP; rewrite -subG1 !eqEcard sR0R ?mul_subG //= negb_and. - rewrite -!ltnNge -!norm_joinEr // 1?normsY //; move/IHsub=> -> //. - by rewrite join_subG nKP (subset_trans sR0R). -move: IHsub defP oR0 rR0 ZgrCHR0 coKR0 ntKR0 tiKR0cV oCVR0 tiPcR0. -rewrite {R0}defR0 ltnn => IHsub defP oR rR ZgrCHR coKR ntKR tiKRcV oCVR tiPcR. -have mulVK: V * K = V <*> K by rewrite norm_joinEr. -have oVK: #|V <*> K| = (#|V| * #|K|)%N by rewrite -mulVK coprime_cardMg. -have tiVK_P: V <*> K :&: P = 1. - have sylV: p.-Sylow(V <*> K) V. - by rewrite /pHall pV -divgS joing_subl //= oVK mulKn. - apply/trivgP; rewrite -tiVP subsetI subsetIr. - rewrite (sub_normal_Hall sylV) ?subsetIl ?(pgroupS (subsetIr _ P)) //=. - by rewrite /normal joing_subl join_subG normG. -have{mulVK oVK} oH: (#|H| = #|V| * #|K| * #|P|)%N. - by rewrite -defH mulVK -oVK (TI_cardMg tiVK_P). -have{oH tiVK_P IHsub} IHsub: forall X : {group gT}, - P <*> R \subset 'N(X) -> X \subset K -> X :=: K \/ X \subset 'C(P). -- move=> X nX_PR sXK; have p'X: p^'.-group X := pgroupS sXK p'K. - have nXP: P \subset 'N(X) := subset_trans (joing_subl P R) nX_PR. - apply/predU1P; rewrite eqEcard sXK; case: leqP => //= ltXK. - apply/commG1P; rewrite {}IHsub // orbF (norm_joinEr (normsY _ _)) //=. - rewrite TI_cardMg /=; last first. - by apply/trivgP; rewrite -tiVK_P setSI ?genS ?setUS. - rewrite oH ltn_pmul2r ?cardG_gt0 // norm_joinEr ?(subset_trans sXK) //. - by rewrite coprime_cardMg ?ltn_pmul2l ?(pnat_coprime pV). -have defKP: [~: K, P] = K. - have sKP_K: [~: K, P] \subset K by rewrite commg_subl. - have{sKP_K} [|//|cP_KP] := IHsub _ _ sKP_K. - by rewrite join_subG /= commg_normr normsR. - by case/eqP: ntKP; rewrite -coprime_commGid ?(commG1P cP_KP) ?(solvableS sKH). -have nKPR: P <*> R \subset 'N(K) by rewrite join_subG nKP. -have coPR: coprime #|P| #|R| by rewrite (coprimeSg sPH). -have{scKH} tiPRcK: 'C_(P <*> R)(K) = 1. - have tiPK: P :&: K = 1 by rewrite setIC coprime_TIg. - have tiPcK: 'C_P(K) = 1. - by apply/trivgP; rewrite /= -{1}(setIidPl sPH) -setIA -tiPK setIS. - have tiRcK: 'C_R(K) = 1. - by rewrite prime_TIg ?oR // centsC (sameP commG1P eqP). - have mulPR: P * R = P <*> R by rewrite norm_joinEr. - by rewrite -(coprime_mulG_setI_norm mulPR) ?tiPcK ?mul1g ?norms_cent. -have [K1 | ntK]:= eqsVneq K 1; first by rewrite K1 comm1G eqxx in ntKR. -have [K1 | [q q_pr q_dv_K]] := trivgVpdiv K; first by case/eqP: ntK. -have q_gt1 := prime_gt1 q_pr. -have p'q: q != p by apply: (pgroupP p'K). -have{r'K} q'r: r != q by rewrite eq_sym; apply: (pgroupP r'K). -have{defK} qK: q.-group K. - have{defK} nilK: nilpotent K by rewrite -defK Fitting_nil. - have{nilK} [_ defK _ _] := dprodP (nilpotent_pcoreC q nilK). - have{IHsub} IHpi: forall pi, 'O_pi(K) = K \/ 'O_pi(K) \subset 'C(P). - move=> pi; apply: IHsub (pcore_sub _ _). - by rewrite gFnorm_trans // join_subG nKP. - case: (IHpi q) => [<-| cPKq]; first exact: pcore_pgroup. - case/eqP: ntKP; apply/commG1P; rewrite -{}defK mul_subG //. - case: (IHpi q^') => // defK; case/idPn: q_dv_K. - by rewrite -p'natE // -defK; apply: pcore_pgroup. -pose K' := K^`(1); have charK': K' \char K := der_char 1 K. -have nsK'K: K' <| K := der_normal 1 K; have [sK'K nK'K] := andP nsK'K. -have nK'PR: P <*> R \subset 'N(K') := char_norm_trans charK' nKPR. -have iK'K: 'C_(P <*> R / K')(K / K') = 1 -> #|K / K'| > q ^ 2. - have qKb: q.-group (K / K') by apply: morphim_pgroup qK. - rewrite ltnNge => trCK'; apply: contra ntKP => Kq_le_q2. - suffices sPR_K': [~: P, R] \subset K'. - rewrite -defP -(setIidPl sPR_K') coprime_TIg ?commG1 //. - by rewrite (pnat_coprime (pgroupS _ pP) (pgroupS sK'K p'K)) ?commg_subl. - rewrite -quotient_cents2 ?(char_norm_trans charK') //. - suffices cPRbPrb: abelian (P <*> R / K'). - by rewrite (sub_abelian_cent2 cPRbPrb) ?quotientS ?joing_subl ?joing_subr. - have nKbPR: P <*> R / K' \subset 'N(K / K') by apply: quotient_norms. - case cycK: (cyclic (K / K')). - rewrite (isog_abelian (quotient1_isog _)) -trCK' -ker_conj_aut. - rewrite (isog_abelian (first_isog_loc _ _)) //. - by rewrite (abelianS (Aut_conj_aut _ _)) ?Aut_cyclic_abelian. - have{cycK} [oKb abelKb]: #|K / K'| = (q ^ 2)%N /\ q.-abelem (K / K'). - have sKb1: 'Ohm_1(K / K') \subset K / K' by apply: Ohm_sub. - have cKbKb: abelian (K / K') by rewrite sub_der1_abelian. - have: #|'Ohm_1(K / K')| >= q ^ 2. - rewrite (card_pgroup (pgroupS sKb1 qKb)) leq_exp2l // ltnNge. - by rewrite -p_rank_abelian -?rank_pgroup // -abelian_rank1_cyclic ?cycK. - rewrite (geq_leqif (leqif_trans (subset_leqif_card sKb1) (leqif_eq _))) //. - by case/andP=> sKbKb1; move/eqP->; rewrite (abelemS sKbKb1) ?Ohm1_abelem. - have ntKb: K / K' != 1 by rewrite -cardG_gt1 oKb (ltn_exp2l 0). - pose rPR := abelem_repr abelKb ntKb nKbPR. - have: mx_faithful rPR by rewrite abelem_mx_faithful. - move: rPR; rewrite (dim_abelemE abelKb ntKb) oKb pfactorK // => rPR ffPR. - apply: charf'_GL2_abelian ffPR _. - by rewrite quotient_odd ?(oddSg _ oddG) // join_subG (subset_trans sPH). - rewrite (eq_pgroup _ (eq_negn (charf_eq (char_Fp q_pr)))). - rewrite quotient_pgroup //= norm_joinEr // pgroupM. - by rewrite /pgroup (pi_pnat rR) // (pi_pnat pP) // !inE eq_sym. -case cKK: (abelian K); last first. - have [|[dPhiK dK'] dCKP] := abelian_charsimple_special qK coKP defKP. - apply/bigcupsP=> L /andP[charL]; have sLK := char_sub charL. - by case/IHsub: sLK cKK => // [|-> -> //]; apply: char_norm_trans charL _. - have eK: exponent K %| q. - have oddK: odd #|K| := oddSg sKG oddG. - have [Q [charQ _ _ eQ qCKQ]] := critical_odd qK oddK ntK; rewrite -eQ. - have sQK: Q \subset K := char_sub charQ. - have [<- // | cQP] := IHsub Q (char_norm_trans charQ nKPR) sQK. - case/negP: ntKP; rewrite (sameP eqP commG1P) centsC. - rewrite -ker_conj_aut -sub_morphim_pre // subG1 trivg_card1. - rewrite (pnat_1 (morphim_pgroup _ pP) (pi_pnat (pgroupS _ qCKQ) _)) //. - apply/subsetP=> a; case/morphimP=> x nKx Px ->{a}. - rewrite /= astab_ract inE /= Aut_aut; apply/astabP=> y Qy. - rewrite [_ y _]norm_conj_autE ?(subsetP sQK) //. - by rewrite /conjg (centsP cQP y) ?mulKg. - have tiPRcKb: 'C_(P <*> R / K')(K / K') = 1. - rewrite -quotient_astabQ -quotientIG /=; last first. - by rewrite sub_astabQ normG trivg_quotient sub1G. - apply/trivgP; rewrite -quotient1 quotientS // -tiPRcK subsetI subsetIl /=. - rewrite (coprime_cent_Phi qK) ?(coprimegS (subsetIl _ _)) //=. - by rewrite norm_joinEr // coprime_cardMg // coprime_mulr coKP. - rewrite dPhiK -dK' -/K' (subset_trans (commgS _ (subsetIr _ _))) //. - by rewrite astabQ -quotient_cents2 ?subsetIl // cosetpreK centsC /=. - have [nK'P nK'R] := (char_norm_trans charK' nKP, char_norm_trans charK' nKR). - have solK: solvable K := pgroup_sol qK. - have dCKRb: 'C_K(R) / K' = 'C_(K / K')(R / K'). - by rewrite coprime_quotient_cent. - have abelKb: q.-abelem (K / K') by rewrite [K']dK' -dPhiK Phi_quotient_abelem. - have [qKb cKbKb _] := and3P abelKb. - have [tiKcRb | ntCKRb]:= eqVneq 'C_(K / K')(R / K') 1. - have coK'P: coprime #|K'| #|P| by rewrite (coprimeSg sK'K). - suffices sPK': P \subset K'. - by case/negP: ntKP; rewrite -(setIidPr sPK') coprime_TIg ?commG1. - rewrite -quotient_sub1 // -defP commGC quotientR //= -/K'. - have <-: 'C_(P / K')(K / K') = 1. - by apply/trivgP; rewrite -tiPRcKb setSI ?morphimS ?joing_subl. - have q'P: q^'.-group P by rewrite /pgroup (pi_pnat pP) // !inE eq_sym. - move: tiKcRb; have: q^'.-group (P <*> R / K'). - rewrite quotient_pgroup //= norm_joinEr //. - by rewrite pgroupM q'P /pgroup oR pnatE. - have sPRG: P <*> R \subset G by rewrite join_subG sRG (subset_trans sPH). - have coPRb: coprime #|P / K'| #|R / K'| by rewrite coprime_morph. - apply: odd_prime_sdprod_abelem_cent1 abelKb _; rewrite ?quotient_norms //. - - by rewrite quotient_sol // (solvableS sPRG). - - by rewrite quotient_odd // (oddSg sPRG). - - by rewrite /= quotientY // sdprodEY ?quotient_norms ?coprime_TIg. - rewrite -(card_isog (quotient_isog nK'R _)) ?oR //. - by rewrite coprime_TIg // (coprimeSg sK'K). - have{ntCKRb} not_sCKR_K': ~~ ('C_K(R) \subset K'). - by rewrite -quotient_sub1 ?subIset ?nK'K // dCKRb subG1. - have oCKR: #|'C_K(R)| = q. - have [x defCKR]: exists x, 'C_K(R) = <[x]>. - have ZgrCKR: Zgroup 'C_K(R) := ZgroupS (setSI _ sKH) ZgrCHR. - have qCKR: q.-group 'C_K(R) by rewrite (pgroupS (subsetIl K _)). - by apply/cyclicP; apply: nil_Zgroup_cyclic (pgroup_nil qCKR). - have Kx: x \in K by rewrite -cycle_subG -defCKR subsetIl. - rewrite defCKR cycle_subG in not_sCKR_K' *. - exact: nt_prime_order (exponentP eK x Kx) (group1_contra not_sCKR_K'). - have tiCKR_K': 'C_K(R) :&: K' = 1 by rewrite prime_TIg ?oCKR. - have sKR_K: [~: K, R] \subset K by rewrite commg_subl nKR. - have ziKRcR: 'C_K(R) :&: [~: K, R] \subset K'. - rewrite -quotient_sub1 ?subIset ?nK'K // setIC. - rewrite (subset_trans (quotientI _ _ _)) // dCKRb setIA. - rewrite (setIidPl (quotientS _ sKR_K)) // ?quotientR //= -/K'. - by rewrite coprime_abel_cent_TI ?quotient_norms ?coprime_morph. - have not_sK_KR: ~~ (K \subset [~: K, R]). - by apply: contra not_sCKR_K' => sK_KR; rewrite -{1}(setIidPl sK_KR) setIAC. - have tiKRcR: 'C_[~: K, R](R) = 1. - rewrite -(setIidPr sKR_K) setIAC -(setIidPl ziKRcR) setIAC tiCKR_K'. - by rewrite (setIidPl (sub1G _)). - have cKR_KR: abelian [~: K, R]. - have: 'C_[~: K, R](V) \subset [1]. - rewrite -tiVN -{2}scVH -setIIr setICA setIC setIS //. - exact: subset_trans sKR_K sKN. - rewrite /abelian (sameP commG1P trivgP) /= -derg1; apply: subset_trans. - have nKR_R: R \subset 'N([~: K, R]) by rewrite commg_normr. - have sKRR_G: [~: K, R] <*> R \subset G by rewrite join_subG comm_subG. - move: oCVR; have: p^'.-group ([~: K, R] <*> R). - by rewrite norm_joinEr // pgroupM (pgroupS sKR_K p'K) /pgroup oR pnatE. - have solKR_R := solvableS sKRR_G solG. - apply: Frobenius_prime_cent_prime; rewrite ?oR ?(subset_trans _ nVG) //. - by rewrite sdprodEY // coprime_TIg // (coprimeSg sKR_K). - case nKR_P: (P \subset 'N([~: K, R])). - have{nKR_P} nKR_PR: P <*> R \subset 'N([~: K, R]). - by rewrite join_subG nKR_P commg_normr. - have{nKR_PR} [dKR | cP_KR] := IHsub _ nKR_PR sKR_K. - by rewrite dKR subxx in not_sK_KR. - have{cP_KR} cKRb: R / K' \subset 'C(K / K'). - by rewrite quotient_cents2r //= dK' -dCKP commGC subsetI sKR_K. - case/negP: ntKR; rewrite (sameP eqP commG1P) centsC. - by rewrite (coprime_cent_Phi qK) // dPhiK -dK' commGC -quotient_cents2. - have{nKR_P} [x Px not_nKRx] := subsetPn (negbT nKR_P). - have iKR: #|K : [~: K, R]| = q. - rewrite -divgS // -{1}(coprime_cent_prod nKR) // TI_cardMg ?mulKn //. - by rewrite setIA (setIidPl sKR_K). - have sKRx_K: [~: K, R] :^ x \subset K by rewrite -{2}(normsP nKP x Px) conjSg. - have nKR_K: K \subset 'N([~: K, R]) by apply: commg_norml. - have mulKR_Krx: [~: K, R] * [~: K, R] :^ x = K. - have maxKR: maximal [~: K, R] K by rewrite p_index_maximal ?iKR. - apply: mulg_normal_maximal; rewrite ?(p_maximal_normal qK) //. - by rewrite inE in not_nKRx. - have ziKR_KRx: [~: K, R] :&: [~: K, R] :^ x \subset K'. - rewrite /K' dK' subsetI subIset ?sKR_K // -{3}mulKR_Krx centM centJ. - by rewrite setISS ?conjSg. - suffices: q ^ 2 >= #|K / K'| by rewrite leqNgt iK'K. - rewrite -divg_normal // leq_divLR ?cardSg //. - rewrite -(@leq_pmul2l (#|[~: K, R]| ^ 2)) ?expn_gt0 ?cardG_gt0 // mulnA. - rewrite -expnMn -iKR Lagrange // -mulnn -{2}(cardJg _ x) mul_cardG. - by rewrite mulKR_Krx mulnAC leq_pmul2l ?muln_gt0 ?cardG_gt0 ?subset_leq_card. -have tiKcP: 'C_K(P) = 1 by rewrite -defKP coprime_abel_cent_TI. -have{IHsub} abelK: q.-abelem K. - have [/abelem_Ohm1P->//|cPK1] := IHsub _ (gFnorm_trans _ nKPR) (Ohm_sub 1 K). - rewrite -(setIid K) TI_Ohm1 ?eqxx // in ntK. - by apply/eqP; rewrite -subG1 -tiKcP setIS. -have{K' iK'K charK' nsK'K sK'K nK'K nK'PR} oKq2: q ^ 2 < #|K|. - have K'1: K' :=: 1 by apply/commG1P. - rewrite -indexg1 -K'1 -card_quotient ?normal_norm // iK'K // K'1. - by rewrite -injm_subcent ?coset1_injm ?norms1 //= tiPRcK morphim1. -pose S := [set Vi : {group gT} | 'C_V('C_K(Vi)) == Vi & maximal 'C_K(Vi) K]. -have defSV Vi: Vi \in S -> 'C_V('C_K(Vi)) = Vi by rewrite inE; case: eqP. -have maxSK Vi: Vi \in S -> maximal 'C_K(Vi) K by case/setIdP. -have sSV Vi: Vi \in S -> Vi \subset V by move/defSV <-; rewrite subsetIl. -have ntSV Vi: Vi \in S -> Vi :!=: 1. - move=> Si; apply: contraTneq (maxgroupp (maxSK _ Si)) => ->. - by rewrite /= cent1T setIT proper_irrefl. -have nSK Vi: Vi \in S -> K \subset 'N(Vi). - by move/defSV <-; rewrite normsI ?norms_cent // sub_abelian_norm ?subsetIl. -have defV: <<\bigcup_(Vi in S) Vi>> = V. - apply/eqP; rewrite eqEsubset gen_subG. - apply/andP; split; first by apply/bigcupsP; apply: sSV. - rewrite -(coprime_abelian_gen_cent cKK nVK) ?(pnat_coprime pV) // gen_subG. - apply/bigcupsP=> Kj /= /and3P[cycKbj sKjK nKjK]. - have [xb defKbj] := cyclicP cycKbj. - have Kxb: xb \in K / Kj by rewrite defKbj cycle_id. - set Vj := 'C_V(Kj); have [-> | ntVj] := eqsVneq Vj 1; first exact: sub1G. - have nt_xb: xb != 1. - apply: contra ntVj; rewrite -cycle_eq1 -defKbj -!subG1 -tiVcK. - by rewrite quotient_sub1 // => sKKj; rewrite setIS ?centS. - have maxKj: maximal Kj K. - rewrite p_index_maximal // -card_quotient // defKbj -orderE. - by rewrite (abelem_order_p (quotient_abelem Kj abelK) Kxb nt_xb). - suffices defKj: 'C_K(Vj) = Kj. - by rewrite sub_gen // (bigcup_max 'C_V(Kj))%G // inE defKj eqxx. - have{maxKj} [_ maxKj] := maxgroupP maxKj. - rewrite ['C_K(Vj)]maxKj //; last by rewrite subsetI sKjK centsC subsetIr. - rewrite properEneq subsetIl andbT (sameP eqP setIidPl) centsC. - by apply: contra ntVj; rewrite -subG1 -tiVcK subsetI subsetIl. -pose dxp := [fun D : {set {group gT}} => \big[dprod/1]_(Vi in D) Vi]. -have{defV} defV: \big[dprod/1]_(Vi in S) Vi = V. - have [D maxD]: {D | maxset [pred E | group_set (dxp E) & E \subset S] D}. - by apply: ex_maxset; exists set0; rewrite /= sub0set big_set0 groupP. - have [gW sDS] := andP (maxsetp maxD); have{maxD} [_ maxD] := maxsetP maxD. - have{gW} [W /= defW]: {W : {group gT} | dxp D = W} by exists (Group gW). - have [eqDS | ltDS] := eqVproper sDS. - by rewrite eqDS in defW; rewrite defW -(bigdprodWY defW). - have{ltDS} [_ [Vi Si notDi]] := properP ltDS. - have sWV: W \subset V. - rewrite -(bigdprodWY defW) gen_subG. - by apply/bigcupsP=> Vj Dj; rewrite sSV ?(subsetP sDS). - suffices{maxD sWV defV} tiWcKi: 'C_W('C_K(Vi)) = 1. - have:= notDi; rewrite -(maxD (Vi |: D)) ?setU11 ?subsetUr //= subUset sDS. - rewrite sub1set Si big_setU1 //= defW dprodEY ?groupP //. - by rewrite (sub_abelian_cent2 cVV) // sSV. - by rewrite -(defSV Vi Si) setIAC (setIidPr sWV). - apply/trivgP/subsetP=> w /setIP[Ww cKi_w]. - have [v [Vv def_w v_uniq]] := mem_bigdprod defW Ww. - rewrite def_w big1 ?inE // => Vj Dj; have Sj := subsetP sDS Vj Dj. - have cKi_vj: v Vj \in 'C('C_K(Vi)). - apply/centP=> x Ki_x; apply/commgP/conjg_fixP. - apply: (v_uniq (fun Vk => v Vk ^ x)) => // [Vk Dk|]. - have [[Kx _] Sk]:= (setIP Ki_x, subsetP sDS Vk Dk). - by rewrite memJ_norm ?Vv // (subsetP (nSK Vk Sk)). - rewrite -(mulKg x w) -(centP cKi_w) // -conjgE def_w. - by apply: (big_morph (conjg^~ x)) => [y z|]; rewrite ?conj1g ?conjMg. - suffices mulKji: 'C_K(Vj) * 'C_K(Vi) = K. - by apply/set1gP; rewrite -tiVcK -mulKji centM setIA defSV // inE Vv. - have maxKj := maxSK Vj Sj; have [_ maxKi] := maxgroupP (maxSK Vi Si). - rewrite (mulg_normal_maximal _ maxKj) -?sub_abelian_normal ?subsetIl //. - have [eqVji|] := eqVneq Vj Vi; first by rewrite -eqVji Dj in notDi. - apply: contra => /= sKiKj; rewrite -val_eqE /= -(defSV Vj Sj). - by rewrite (maxKi _ (maxgroupp maxKj) sKiKj) defSV. -have nVPR: P <*> R \subset 'N(V) by rewrite join_subG nVP. -have actsPR: [acts P <*> R, on S | 'JG]. - apply/subsetP=> x PRx; rewrite !inE; apply/subsetP=> Vi. - rewrite !inE /= => Si; rewrite -(normsP nKPR x PRx) !centJ -!conjIg centJ . - by rewrite -(normsP nVPR x PRx) -conjIg (inj_eq (@conjsg_inj _ _)) maximalJ. -have transPR: [transitive P <*> R, on S | 'JG]. - pose ndxp D (U A B : {group gT}) := dxp (S :&: D) = U -> A * B \subset 'N(U). - have nV_VK D U: ndxp D U V K. - move/bigdprodWY <-; rewrite norms_gen ?norms_bigcup //. - apply/bigcapsP=> Vi /setIP[Si _]. - by rewrite mulG_subG nSK // sub_abelian_norm // sSV. - have nV_PR D U: [acts P <*> R, on S :&: D | 'JG] -> ndxp D U P R. - move=> actsU /bigdprodWY<-; rewrite -norm_joinEr ?norms_gen //. - apply/subsetP=> x PRx; rewrite inE sub_conjg; apply/bigcupsP=> Vi Di. - by rewrite -sub_conjg (bigcup_max (Vi :^ x)%G) //= (acts_act actsU). - have [S0 | [V1 S1]] := set_0Vmem S. - by case/eqP: ntV; rewrite -defV S0 big_set0. - apply/imsetP; exists V1 => //; set D := orbit _ _ _. - rewrite (big_setID D) /= setDE in defV. - have [[U W defU defW] _ _ tiUW] := dprodP defV. - rewrite defU defW in defV tiUW. - have [|U1|eqUV]:= indecomposableV _ _ defV. - - rewrite -mulHR -defH -mulgA mul_subG //. - by rewrite subsetI (nV_VK _ _ defU) (nV_VK _ _ defW). - rewrite subsetI (nV_PR _ _ _ defU) ?actsI ?acts_orbit ?subsetT //=. - by rewrite (nV_PR _ _ _ defW) // actsI ?astabsC ?acts_orbit ?subsetT /=. - - case/negP: (ntSV V1 S1); rewrite -subG1 -U1 -(bigdprodWY defU) sub_gen //. - by rewrite (bigcup_max V1) // inE S1 orbit_refl. - apply/eqP; rewrite eqEsubset (acts_sub_orbit _ actsPR) S1 andbT. - apply/subsetP=> Vi Si; apply: contraR (ntSV Vi Si) => D'i; rewrite -subG1. - rewrite -tiUW eqUV subsetI sSV // -(bigdprodWY defW). - by rewrite (bigD1 Vi) ?joing_subl // inE Si inE. -have [cSR | not_cSR] := boolP (R \subset 'C(S | 'JG)). - have{cSR} sRnSV: R \subset \bigcap_(Vi in S) 'N(Vi). - apply/bigcapsP=> Vi Si. - by rewrite -astab1JG (subset_trans cSR) ?astabS ?sub1set. - have sPRnSV: P <*> R \subset 'N(\bigcap_(Vi in S) 'N(Vi)). - apply/subsetP=> x PRx; rewrite inE; apply/bigcapsP=> Vi Si. - by rewrite sub_conjg -normJ bigcap_inf ?(acts_act actsPR) ?groupV. - have [V1 S1] := imsetP transPR. - have: P <*> R \subset 'N(V1). - rewrite join_subG (subset_trans sRnSV) /= ?bigcap_inf // andbT -defP. - apply: (subset_trans (commgS P sRnSV)). - have:= subset_trans (joing_subl P R) sPRnSV; rewrite -commg_subr /=. - by move/subset_trans; apply; apply: bigcap_inf. - rewrite -afixJG; move/orbit1P => -> allV1. - have defV1: V1 = V by apply: group_inj; rewrite /= -defV allV1 big_set1. - case/idPn: oKq2; rewrite -(Lagrange (subsetIl K 'C(V1))). - rewrite (p_maximal_index qK (maxSK V1 S1)) defV1 /= tiKcV cards1 mul1n. - by rewrite (ltn_exp2l 2 1). -have actsR: [acts R, on S | 'JG] := subset_trans (joing_subr P R) actsPR. -have ntSRcR Vi: - Vi \in S -> ~~ (R \subset 'N(Vi)) -> - #|Vi| = p /\ 'C_V(R) \subset <<class_support Vi R>>. -- move=> Si not_nViR; have [sVi nV] := (subsetP (sSV Vi Si), subsetP nVR). - pose f v := fmval (\sum_(x in R) fmod cVV v ^@ x). - have fM: {in Vi &, {morph f: u v / u * v}}. - move=> u v /sVi Vu /sVi Vv; rewrite -fmvalA -big_split. - by congr (fmval _); apply: eq_bigr => x Rx; rewrite /= -actAr fmodM. - have injf: 'injm (Morphism fM). - apply/subsetP=> v /morphpreP[Vi_v]; have Vv := sVi v Vi_v. - rewrite (bigD1 Vi) //= in defV; have [[_ W _ dW] _ _ _] := dprodP defV. - have [u [w [_ _ uw Uuw]]] := mem_dprod defV (group1 V). - case: (Uuw 1 1) => // [||u1 w1]; rewrite ?dW ?mulg1 // !inE eq_sym /f /=. - move/eqP; rewrite (big_setD1 1) // actr1 ?fmodK // fmvalA //= fmval_sum. - do [case/Uuw; rewrite ?dW ?fmodK -?u1 ?group_prod //] => [x R'x | ->] //. - rewrite (nt_gen_prime _ R'x) ?cycle_subG ?oR // inE in not_nViR nVR actsR. - rewrite fmvalJ ?fmodK // -(bigdprodWY dW) ?mem_gen //; apply/bigcupP. - exists (Vi :^ x)%G; rewrite ?memJ_conjg // (astabs_act _ actsR) Si. - by apply: contraNneq not_nViR => /congr_group->. - have im_f: Morphism fM @* Vi \subset 'C_V(R). - apply/subsetP=> _ /morphimP[v _ Vi_v ->]; rewrite inE fmodP. - apply/centP=> x Rx; red; rewrite conjgC -fmvalJ ?nV //; congr (x * fmval _). - rewrite {2}(reindex_acts 'R _ Rx) ?astabsR //= actr_sum. - by apply: eq_bigr => y Ry; rewrite actrM ?nV. - have defCVR: Morphism fM @* Vi = 'C_V(R). - apply/eqP; rewrite eqEcard im_f (prime_nt_dvdP _ _ (cardSg im_f)) ?oCVR //=. - by rewrite -trivg_card1 morphim_injm_eq1 ?ntSV. - rewrite -oCVR -defCVR; split; first by rewrite card_injm. - apply/subsetP=> _ /morphimP[v _ Vi_v ->] /=; rewrite /f fmval_sum. - have Vv := sVi v Vi_v; apply: group_prod => x Rx. - by rewrite fmvalJ ?fmodK ?nV // mem_gen // mem_imset2. -have{not_cSR} [V1 S1 not_nV1R]: exists2 V1, V1 \in S & ~~ (R \subset 'N(V1)). - by move: not_cSR; rewrite astabC; case/subsetPn=> v; rewrite afixJG; exists v. -set D := orbit 'JG%act R V1. -have oD: #|D| = r by rewrite card_orbit astab1JG prime_TIg ?indexg1 ?oR. -have oSV Vi: Vi \in S -> #|Vi| = p. - move=> Si; have [z _ ->]:= atransP2 transPR S1 Si. - by rewrite cardJg; case/ntSRcR: not_nV1R. -have cSnS' Vi: Vi \in S -> 'N(Vi)^`(1) \subset 'C(Vi). - move=> Si; rewrite der1_min ?cent_norm //= -ker_conj_aut. - rewrite (isog_abelian (first_isog _)) (abelianS (Aut_conj_aut _ _)) //. - by rewrite Aut_cyclic_abelian // prime_cyclic // oSV. -have nVjR Vj: Vj \in S :\: D -> 'C_K(Vj) = [~: K, R]. - case/setDP=> Sj notDj; set Kj := 'C_K(Vj). - have [nVjR|] := boolP (R \subset 'N(Vj)). - have{nVjR} sKRVj: [~: K, R] \subset Kj. - rewrite subsetI {1}commGC commg_subr nKR. - by rewrite (subset_trans _ (cSnS' Vj Sj)) // commgSS ?nSK. - have iKj: #|K : Kj| = q by rewrite (p_maximal_index qK (maxSK Vj Sj)). - have dxKR: [~: K, R] \x 'C_K(R) = K by rewrite coprime_abelian_cent_dprod. - have{dxKR} [_ defKR _ tiKRcR] := dprodP dxKR. - have Z_CK: Zgroup 'C_K(R) by apply: ZgroupS ZgrCHR; apply: setSI. - have abelCKR: q.-abelem 'C_K(R) := abelemS (subsetIl _ _) abelK. - have [qCKR _] := andP abelCKR. - apply/eqP; rewrite eq_sym eqEcard sKRVj -(leq_pmul2r (ltnW q_gt1)). - rewrite -{1}iKj Lagrange ?subsetIl // -{1}defKR (TI_cardMg tiKRcR). - rewrite leq_pmul2l ?cardG_gt0 //= (card_pgroup qCKR). - rewrite (leq_exp2l _ 1) // -abelem_cyclic // (forall_inP Z_CK) //. - by rewrite (@p_Sylow _ q) // /pHall subxx indexgg qCKR. - case/ntSRcR=> // _ sCVj; case/ntSRcR: not_nV1R => // _ sCV1. - suffices trCVR: 'C_V(R) = 1 by rewrite -oCVR trCVR cards1 in p_pr. - apply/trivgP; rewrite (big_setID D) in defV. - have{defV} [[W U /= defW defU] _ _ <-] := dprodP defV. - rewrite defW defU subsetI (subset_trans sCV1) /=; last first. - rewrite class_supportEr -(bigdprodWY defW) genS //. - apply/bigcupsP=> x Rx; rewrite (bigcup_max (V1 :^ x)%G) // inE. - by rewrite (actsP actsR) //= S1 mem_imset. - rewrite (subset_trans sCVj) // class_supportEr -(bigdprodWY defU) genS //. - apply/bigcupsP=> x Rx; rewrite (bigcup_max (Vj :^ x)%G) // inE. - by rewrite (actsP actsR) // Sj andbT (orbit_transl _ (mem_orbit 'JG Vj Rx)). -have sDS: D \subset S. - by rewrite acts_sub_orbit //; apply: subset_trans actsPR; apply: joing_subr. -have [eqDS | ltDS] := eqVproper sDS. - have [fix0 | [Vj cVjP]] := set_0Vmem 'Fix_(S | 'JG)(P). - case/negP: p'r; rewrite eq_sym -dvdn_prime2 // -oD eqDS /dvdn. - rewrite (pgroup_fix_mod pP (subset_trans (joing_subl P R) actsPR)). - by rewrite fix0 cards0 mod0n. - have{cVjP} [Sj nVjP] := setIP cVjP; rewrite afixJG in nVjP. - case/negP: (ntSV Vj Sj); rewrite -subG1 -tiVcK subsetI sSV // centsC -defKP. - by rewrite (subset_trans _ (cSnS' Vj Sj)) // commgSS ?nSK. -have [_ [Vj Sj notDj]] := properP ltDS. -have defS: S = Vj |: D. - apply/eqP; rewrite eqEsubset andbC subUset sub1set Sj sDS. - apply/subsetP=> Vi Si; rewrite !inE orbC /= -val_eqE /= -(defSV Vi Si). - have [//|notDi] := boolP (Vi \in _); rewrite -(defSV Vj Sj) /=. - by rewrite !nVjR // inE ?notDi ?notDj. -suffices: odd #|S| by rewrite defS cardsU1 (negPf notDj) /= oD -oR (oddSg sRG). -rewrite (dvdn_odd (atrans_dvd transPR)) // (oddSg _ oddG) //. -by rewrite join_subG (subset_trans sPH). -Qed. - -End Theorem_3_6. - -(* This is B & G, Theorem 3.7. *) -Theorem prime_Frobenius_sol_kernel_nil gT (G K R : {group gT}) : - K ><| R = G -> solvable G -> prime #|R| -> 'C_K(R) = 1 -> nilpotent K. -Proof. -move=> defG solG R_pr regR. -elim: {K}_.+1 {-2}K (ltnSn #|K|) => // m IHm K leKm in G defG solG regR *. -have [nsKG sRG defKR nKR tiKR] := sdprod_context defG. -have [sKG nKG] := andP nsKG. -wlog ntK: / K :!=: 1 by case: eqP => [-> _ | _ ->] //; apply: nilpotent1. -have [L maxL _]: {L : {group gT} | maxnormal L K G & [1] \subset L}. - by apply: maxgroup_exists; rewrite proper1G ntK norms1. -have [ltLK nLG]:= andP (maxgroupp maxL); have [sLK not_sKL]:= andP ltLK. -have{m leKm IHm}nilL: nilpotent L. - pose G1 := L <*> R; have nLR := subset_trans sRG nLG. - have sG1G: G1 \subset G by rewrite join_subG (subset_trans sLK). - have defG1: L ><| R = G1. - by rewrite sdprodEY //; apply/eqP; rewrite -subG1 -tiKR setSI. - apply: (IHm _ _ _ defG1); rewrite ?(solvableS sG1G) ?(oddSg sG1G) //. - exact: leq_trans (proper_card ltLK) _. - by apply/eqP; rewrite -subG1 -regR setSI. -have sLG := subset_trans sLK sKG; have nsLG: L <| G by apply/andP. -have sLF: L \subset 'F(G) by apply: Fitting_max. -have frobG: [Frobenius G = K ><| R] by apply/prime_FrobeniusP. -have solK := solvableS sKG solG. -have frobGq := Frobenius_quotient frobG solK nsLG not_sKL. -suffices sKF: K \subset 'F(K) by apply: nilpotentS sKF (Fitting_nil K). -apply: subset_trans (chief_stab_sub_Fitting solG nsKG). -rewrite subsetI subxx; apply/bigcapsP=> [[X Y] /= /andP[chiefXY sXF]]. -set V := X / Y; have [maxY nsXG] := andP chiefXY. -have [ltYX nYG] := andP (maxgroupp maxY); have [sYX _]:= andP ltYX. -have [sXG nXG] := andP nsXG; have sXK := subset_trans sXF (Fitting_sub K). -have minV := chief_factor_minnormal chiefXY. -have cVL: L \subset 'C(V | 'Q). - apply: subset_trans (subset_trans sLF (Fitting_stab_chief solG _)) _ => //. - exact: (bigcap_inf (X, Y)). -have nVG: {acts G, on group V | 'Q}. - by split; rewrite ?quotientS ?subsetT // actsQ // normal_norm. -pose V1 := sdpair1 <[nVG]> @* V. -have [p p_pr abelV]: exists2 p, prime p & p.-abelem V. - apply/is_abelemP; apply: charsimple_solvable (quotient_sol _ _). - exact: minnormal_charsimple minV. - exact: nilpotent_sol (nilpotentS sXF (Fitting_nil _)). -have abelV1: p.-abelem V1 by rewrite morphim_abelem. -have injV1 := injm_sdpair1 <[nVG]>. -have ntV1: V1 :!=: 1. - by rewrite -cardG_gt1 card_injm // cardG_gt1; case/andP: (mingroupp minV). -have nV1_G1 := im_sdpair_norm <[nVG]>. -pose rV := morphim_repr (abelem_repr abelV1 ntV1 nV1_G1) (subxx G). -have def_kerV: rker rV = 'C_G(V | 'Q). - rewrite rker_morphim rker_abelem morphpreIdom morphpreIim -astabEsd //. - by rewrite astab_actby setIid. -have kerL: L \subset rker rV by rewrite def_kerV subsetI sLG. -pose rVq := quo_repr kerL nLG. -suffices: K / L \subset rker rVq. - rewrite rker_quo def_kerV quotientSGK //= 1?subsetI 1?(subset_trans sKG) //. - by rewrite sLG. -have irrVq: mx_irreducible rVq. - apply/quo_mx_irr; apply/morphim_mx_irr; apply/abelem_mx_irrP. - apply/mingroupP; rewrite ntV1; split=> // U1; case/andP=> ntU1 nU1G sU1V. - rewrite -(morphpreK sU1V); congr (_ @* _). - case/mingroupP: minV => _; apply; last by rewrite sub_morphpre_injm. - rewrite -subG1 sub_morphpre_injm ?sub1G // morphim1 subG1 ntU1 /=. - set U := _ @*^-1 U1; rewrite -(cosetpreK U) quotient_norms //. - have: [acts G, on U | <[nVG]>] by rewrite actsEsd ?subsetIl // morphpreK. - rewrite astabs_actby subsetI subxx (setIidPr _) ?subsetIl //=. - by rewrite -{1}(cosetpreK U) astabsQ ?normal_cosetpre //= -/U subsetI nYG. -have [q q_pr abelKq]: exists2 q, prime q & q.-abelem (K / L). - apply/is_abelemP; apply: charsimple_solvable (quotient_sol _ solK). - exact: maxnormal_charsimple maxL. -case (eqVneq q p) => [def_q | neq_qp]. - have sKGq: K / L \subset G / L by apply: quotientS. - rewrite rfix_mx_rstabC //; have [_ _]:= irrVq; apply; rewrite ?submx1 //. - by rewrite normal_rfix_mx_module ?quotient_normal. - rewrite -(rfix_subg _ sKGq) (@rfix_pgroup_char _ p) ?char_Fp -?def_q //. - exact: (abelem_pgroup abelKq). -suffices: rfix_mx rVq (R / L) == 0. - apply: contraLR; apply: (Frobenius_rfix_compl frobGq). - apply: pi_pnat (abelem_pgroup abelKq) _. - by rewrite inE /= (charf_eq (char_Fp p_pr)). -rewrite -mxrank_eq0 (rfix_quo _ _ sRG) (rfix_morphim _ _ sRG). -rewrite (rfix_abelem _ _ _ (morphimS _ sRG)) mxrank_eq0 rowg_mx_eq0 -subG1. -rewrite (sub_abelem_rV_im _ _ _ (subsetIl _ _)) -(morphpreSK _ (subsetIl _ _)). -rewrite morphpreIim -gacentEsd gacent_actby gacentQ (setIidPr sRG) /=. -rewrite -coprime_quotient_cent ?(solvableS sXG) ?(subset_trans sRG) //. - by rewrite {1}['C_X(R)](trivgP _) ?quotient1 ?sub1G // -regR setSI. -by apply: coprimeSg sXK _; apply: Frobenius_coprime frobG. -Qed. - -Corollary Frobenius_sol_kernel_nil gT (G K H : {group gT}) : - [Frobenius G = K ><| H] -> solvable G -> nilpotent K. -Proof. -move=> frobG solG; have [defG ntK ntH _ _] := Frobenius_context frobG. -have{defG} /sdprodP[_ defG nKH tiKH] := defG. -have[H1 | [p p_pr]] := trivgVpdiv H; first by case/eqP: ntH. -case/Cauchy=> // x Hx ox; rewrite -ox in p_pr. -have nKx: <[x]> \subset 'N(K) by rewrite cycle_subG (subsetP nKH). -have tiKx: K :&: <[x]> = 1 by apply/trivgP; rewrite -tiKH setIS ?cycle_subG. -apply: (prime_Frobenius_sol_kernel_nil (sdprodEY nKx tiKx)) => //. - by rewrite (solvableS _ solG) // join_subG -mulG_subG -defG mulgS ?cycle_subG. -by rewrite cent_cycle (Frobenius_reg_ker frobG) // !inE -order_gt1 prime_gt1. -Qed. - -(* This is B & G, Theorem 3.8. *) -Theorem odd_sdprod_primact_commg_sub_Fitting gT (G K R : {group gT}) : - K ><| R = G -> odd #|G| -> solvable G -> - (*1*) coprime #|K| #|R| -> - (*2*) semiprime K R -> - (*3*) 'C_('F(K))(R) = 1 -> - [~: K, R] \subset 'F(K). -Proof. -elim: {G}_.+1 {-2}G (ltnSn #|G|) K R => // n IHn G. -rewrite ltnS => leGn K R defG oddG solG coKR primR regR_F. -have [nsKG sRG defKR nKR tiKR] := sdprod_context defG. -have [sKG nKG] := andP nsKG. -have chF: 'F(K) \char K := Fitting_char K; have nFR := char_norm_trans chF nKR. -have nsFK := char_normal chF; have [sFK nFK] := andP nsFK. -pose KqF := K / 'F(K); have solK := solvableS sKG solG. -without loss [p p_pr pKqF]: / exists2 p, prime p & p.-group KqF. - move=> IHp; apply: wlog_neg => IH_KR; rewrite -quotient_cents2 //= -/KqF. - set Rq := R / 'F(K); have nKRq: Rq \subset 'N(KqF) by apply: quotient_norms. - rewrite centsC. - apply: subset_trans (coprime_cent_Fitting nKRq _ _); last first. - - exact: quotient_sol. - - exact: coprime_morph. - rewrite subsetI subxx centsC -['F(KqF)]Sylow_gen gen_subG. - apply/bigcupsP=> Pq /SylowP[p p_pr /= sylPq]; rewrite -/KqF in sylPq. - have chPq: Pq \char KqF. - apply: char_trans (Fitting_char _); rewrite /= -/KqF. - by rewrite (nilpotent_Hall_pcore (Fitting_nil _) sylPq) ?pcore_char. - have [P defPq sFP sPK] := inv_quotientS nsFK (char_sub chPq). - have nsFP: 'F(K) <| P by rewrite /normal sFP (subset_trans sPK). - have{chPq} chP: P \char K. - by apply: char_from_quotient nsFP (Fitting_char _) _; rewrite -defPq. - have defFP: 'F(P) = 'F(K). - apply/eqP; rewrite eqEsubset !Fitting_max ?Fitting_nil //. - by rewrite char_normal ?gFchar_trans. - have coPR := coprimeSg sPK coKR. - have nPR: R \subset 'N(P) := char_norm_trans chP nKR. - pose G1 := P <*> R. - have sG1G: G1 \subset G by rewrite /G1 -defKR norm_joinEr ?mulSg. - have defG1: P ><| R = G1 by rewrite sdprodEY ?coprime_TIg. - rewrite defPq quotient_cents2r //= -defFP. - have:= sPK; rewrite subEproper; case/predU1P=> [defP | ltPK]. - rewrite IHp // in IH_KR; exists p => //. - by rewrite /KqF -{2}defP -defPq (pHall_pgroup sylPq). - move/IHn: defG1 => ->; rewrite ?(oddSg sG1G) ?(solvableS sG1G) ?defFP //. - apply: leq_trans leGn; rewrite /= norm_joinEr //. - by rewrite -defKR !coprime_cardMg // ltn_pmul2r ?proper_card. - by move=> x Rx; rewrite -(setIidPl sPK) -!setIA primR. -without loss r_pr: / prime #|R|; last set r := #|R| in r_pr. - have [-> _ | [r r_pr]] := trivgVpdiv R; first by rewrite commG1 sub1G. - case/Cauchy=> // x; rewrite -cycle_subG subEproper orderE; set X := <[x]>. - case/predU1P=> [-> -> -> // | ltXR rX _]; have sXR := proper_sub ltXR. - have defCX: 'C_K(X) = 'C_K(R). - rewrite cent_cycle primR // !inE -order_gt1 orderE rX prime_gt1 //=. - by rewrite -cycle_subG. - have primX: semiprime K X. - by move=> y; case/setD1P=> nty Xy; rewrite primR // !inE nty (subsetP sXR). - have nKX := subset_trans sXR nKR; have coKX := coprimegS sXR coKR. - pose H := K <*> X; have defH: K ><| X = H by rewrite sdprodEY ?coprime_TIg. - have sHG: H \subset G by rewrite /H -defKR norm_joinEr ?mulgSS. - have ltHn: #|H| < n. - rewrite (leq_trans _ leGn) /H ?norm_joinEr // -defKR !coprime_cardMg //. - by rewrite ltn_pmul2l ?proper_card. - have oddH := oddSg sHG oddG; have solH := solvableS sHG solG. - have regX_F: 'C_('F(K))(X) = 1. - by rewrite -regR_F -(setIidPl sFK) -!setIA defCX. - have:= IHn _ ltHn _ _ defH oddH solH coKX primX regX_F. - rewrite -!quotient_cents2 ?(subset_trans sXR) //; move/setIidPl <-. - rewrite -coprime_quotient_cent ?(subset_trans sXR) // defCX. - by rewrite coprime_quotient_cent ?subsetIr. -apply: subset_trans (chief_stab_sub_Fitting solG nsKG) => //. -rewrite subsetI commg_subl nKR; apply/bigcapsP => [[U V]] /=. -case/andP=> chiefUV sUF; set W := U / V. -have minW := chief_factor_minnormal chiefUV. -have [ntW nWG] := andP (mingroupp minW). -have /andP[/maxgroupp/andP[/andP[sVU _] nVG] nsUG] := chiefUV. -have sUK := subset_trans sUF sFK; have sVK := subset_trans sVU sUK. -have nVK := subset_trans sKG nVG; have nVR := subset_trans sRG nVG. -have [q q_pr abelW]: exists2 q, prime q & q.-abelem W. - apply/is_abelemP; apply: charsimple_solvable (minnormal_charsimple minW) _. - by rewrite quotient_sol // (solvableS sUK). -have regR_W: 'C_(W)(R / V) = 1. - rewrite -coprime_quotient_cent ?(coprimeSg sUK) ?(solvableS sUK) //. - by rewrite -(setIidPl sUF) -setIA regR_F (setIidPr _) ?quotient1 ?sub1G. -rewrite sub_astabQ comm_subG ?quotientR //=. -have defGv: (K / V) * (R / V) = G / V by rewrite -defKR quotientMl. -have oRv: #|R / V| = r. - rewrite card_quotient // -indexgI -(setIidPr sVK) setICA setIA tiKR. - by rewrite (setIidPl (sub1G _)) indexg1. -have defCW: 'C_(G / V)(W) = 'C_(K / V)(W). - apply/eqP; rewrite eqEsubset andbC setSI ?quotientS //=. - rewrite subsetI subsetIr /= andbT. - rewrite -(coprime_mulG_setI_norm defGv) ?coprime_morph ?norms_cent //=. - suffices ->: 'C_(R / V)(W) = 1 by rewrite mulg1 subsetIl. - apply/trivgP; apply/subsetP=> x; case/setIP=> Rx cWx. - apply: contraR ntW => ntx; rewrite -subG1 -regR_W subsetI subxx centsC /= -/W. - by apply: contraR ntx; move/prime_TIg <-; rewrite ?oRv // inE Rx. -have [P sylP nPR] := coprime_Hall_exists p nKR coKR solK. -have [sPK pP _] := and3P sylP. -have nVP := subset_trans sPK nVK; have nFP := subset_trans sPK nFK. -have sylPv: p.-Sylow(K / V) (P / V) by rewrite quotient_pHall. -have defKv: (P / V) * 'C_(G / V)(W) = (K / V). - rewrite defCW; apply/eqP; rewrite eqEsubset mulG_subG subsetIl quotientS //=. - have sK_PF: K \subset P * 'F(K). - rewrite (normC nFP) -quotientSK // subEproper eq_sym eqEcard quotientS //=. - by rewrite (card_Hall (quotient_pHall nFP sylP)) part_pnat_id ?leqnn. - rewrite (subset_trans (quotientS _ sK_PF)) // quotientMl // mulgS //. - rewrite subsetI -quotient_astabQ !quotientS //. - by rewrite (subset_trans (Fitting_stab_chief solG nsKG)) ?(bigcap_inf (U, V)). -have nW_ := subset_trans (quotientS _ _) nWG; have nWK := nW_ _ sKG. -rewrite -quotient_cents2 ?norms_cent ?(nW_ _ sRG) //. -have [eq_qp | p'q] := eqVneq q p. - apply: subset_trans (sub1G _); rewrite -trivg_quotient quotientS // centsC. - apply/setIidPl; case/mingroupP: minW => _; apply; last exact: subsetIl. - rewrite andbC normsI ?norms_cent // ?quotient_norms //=. - have nsWK: W <| K / V by rewrite /normal quotientS. - have sWP: W \subset P / V. - by rewrite (normal_sub_max_pgroup (Hall_max sylPv)) -?eq_qp ?abelem_pgroup. - rewrite -defKv centM setIA setIAC /=. - rewrite ['C_W(_)](setIidPl _); last by rewrite centsC subsetIr. - have nilPv: nilpotent (P / V) := pgroup_nil (pHall_pgroup sylPv). - rewrite -/W -(setIidPl sWP) -setIA meet_center_nil //. - exact: normalS (quotientS V sPK) nsWK. -rewrite -defKv -quotientMidr -mulgA mulSGid ?subsetIr // quotientMidr. -have sPG := subset_trans sPK sKG. -rewrite quotient_cents2 ?norms_cent ?nW_ //= commGC. -pose Hv := (P / V) <*> (R / V). -have sHGv: Hv \subset G / V by rewrite join_subG !quotientS. -have solHv: solvable Hv := solvableS sHGv (quotient_sol V solG). -have sPHv: P / V \subset Hv by apply: joing_subl. -have nPRv: R / V \subset 'N(P / V) := quotient_norms _ nPR. -have coPRv: coprime #|P / V| #|R / V| := coprime_morph _ (coprimeSg sPK coKR). -apply: subset_trans (subsetIr (P / V) _). -have oHv: #|Hv| = (#|P / V| * #|R / V|)%N. - by rewrite /Hv norm_joinEr // coprime_cardMg // oRv. -move/(odd_prime_sdprod_abelem_cent1 solHv): (abelW); apply=> //. -- exact: oddSg sHGv (quotient_odd _ _). -- by rewrite sdprodEY ?quotient_norms // coprime_TIg. -- by rewrite oRv. -- by rewrite (subset_trans _ nWG) ?join_subG ?quotientS. -rewrite /= norm_joinEr // pgroupM /pgroup. -rewrite (pi_pnat (quotient_pgroup _ pP)) ?inE 1?eq_sym //=. -apply: coprime_p'group (abelem_pgroup abelW) ntW. -by rewrite coprime_sym coprime_morph // (coprimeSg sUK). -Qed. - -(* This is B & G, Proposition 3.9 (for external action), with the incorrectly *) -(* omitted nontriviality assumption reinstated. *) -Proposition ext_odd_regular_pgroup_cyclic (aT rT : finGroupType) p - (D R : {group aT}) (K H : {group rT}) (to : groupAction D K) : - p.-group R -> odd #|R| -> H :!=: 1 -> - {acts R, on group H | to} -> {in R^#, forall x, 'C_(H | to)[x] = 1} -> - cyclic R. -Proof. -move: R H => R0 H0 pR0 oddR0 ntH0 actsR0 regR0. -pose gT := sdprod_groupType <[actsR0]>. -pose H : {group gT} := (sdpair1 <[actsR0]> @* H0)%G. -pose R : {group gT} := (sdpair2 <[actsR0]> @* R0)%G. -pose G : {group gT} := [set: gT]%G. -have{pR0} pR: p.-group R by rewrite morphim_pgroup. -have{oddR0} oddR: odd #|R| by rewrite morphim_odd. -have [R1 | ntR] := eqsVneq R 1. - by rewrite -(im_invm (injm_sdpair2 <[actsR0]>)) {2}R1 morphim1 cyclic1. -have{ntH0} ntH: H :!=: 1. - apply: contraNneq ntH0 => H1. - by rewrite -(im_invm (injm_sdpair1 <[actsR0]>)) {2}H1 morphim1. -have{regR0 ntR} frobG: [Frobenius G = H ><| R]. - apply/Frobenius_semiregularP => // [|x]; first exact: sdprod_sdpair. - case/setD1P=> nt_x; case/morphimP=> x2 _ Rx2 def_x. - apply/trivgP; rewrite -(morphpreSK _ (subsetIl _ _)) morphpreI. - rewrite /= -cent_cycle def_x -morphim_cycle // -gacentEsd. - rewrite injmK ?injm_sdpair1 // (trivgP (injm_sdpair1 _)). - rewrite -(regR0 x2) ?inE ?Rx2 ?andbT; last first. - by apply: contra nt_x; rewrite def_x; move/eqP->; rewrite morph1. - have [sRD sHK]: R0 \subset D /\ H0 \subset K by case actsR0; move/acts_dom. - have sx2R: <[x2]> \subset R0 by rewrite cycle_subG. - rewrite gacent_actby setIA setIid (setIidPr sx2R). - rewrite !gacentE ?cycle_subG ?sub1set ?(subsetP sRD) //. - by rewrite !setIS ?afixS ?sub_gen. -suffices: cyclic R by rewrite (injm_cyclic (injm_sdpair2 _)). -move: gT H R G => {aT rT to D K H0 R0 actsR0} gT H R G in ntH pR oddR frobG *. -have [defG _ _ _ _] := Frobenius_context frobG; case/sdprodP: defG => _ _ nHR _. -have coHR := Frobenius_coprime frobG. -rewrite (odd_pgroup_rank1_cyclic pR oddR) leqNgt. -apply: contra ntH => /p_rank_geP[E /pnElemP[sER abelE dimE2]]. -have ncycE: ~~ cyclic E by rewrite (abelem_cyclic abelE) dimE2. -have nHE := subset_trans sER nHR; have coHE := coprimegS sER coHR. -rewrite -subG1 -(coprime_abelian_gen_cent1 _ _ nHE) ?(abelem_abelian abelE) //. -rewrite -bigprodGE big1 // => x /setD1P[nt_x Ex]; apply: val_inj => /=. -by apply: (Frobenius_reg_ker frobG); rewrite !inE nt_x (subsetP sER). -Qed. - -(* Internal action version of B & G, Proposition 3.9 (possibly, the only one *) -(* we should keep). *) -Proposition odd_regular_pgroup_cyclic gT p (H R : {group gT}) : - p.-group R -> odd #|R| -> H :!=: 1 -> R \subset 'N(H) -> semiregular H R -> - cyclic R. -Proof. -move=> pR oddR ntH nHR regR. -have actsR: {acts R, on group H | 'J} by split; rewrite ?subsetT ?astabsJ. -apply: ext_odd_regular_pgroup_cyclic pR oddR ntH actsR _ => // x Rx. -by rewrite gacentJ cent_set1 regR. -Qed. - -(* Another proof of Proposition 3.9, which avoids Frobenius groups entirely. *) -Proposition simple_odd_regular_pgroup_cyclic gT p (H R : {group gT}) : - p.-group R -> odd #|R| -> H :!=: 1 -> R \subset 'N(H) -> semiregular H R -> - cyclic R. -Proof. -move=> pR oddR ntH nHR regR; rewrite (odd_pgroup_rank1_cyclic pR oddR) leqNgt. -apply: contra ntH => /p_rank_geP[E /pnElemP[sER abelE dimE2]]. -have ncycE: ~~ cyclic E by rewrite (abelem_cyclic abelE) dimE2. -have nHE := subset_trans sER nHR. -have coHE := coprimegS sER (regular_norm_coprime nHR regR). -rewrite -subG1 -(coprime_abelian_gen_cent1 _ _ nHE) ?(abelem_abelian abelE) //. -rewrite -bigprodGE big1 // => x; case/setD1P=> nt_x Ex; apply: val_inj => /=. -by rewrite regR // !inE nt_x (subsetP sER). -Qed. - -(* This is Aschbacher (40.6)(4). *) -Lemma odd_regular_metacyclic gT (H R : {group gT}) : - odd #|R| -> H :!=: 1 -> R \subset 'N(H) -> semiregular H R -> - metacyclic R. -Proof. -move=> oddR ntH nHR regHR. -apply/Zgroup_metacyclic/forall_inP=> P /SylowP[p pr_p /and3P[sPR pP _]]. -have [oddP nHP] := (oddSg sPR oddR, subset_trans sPR nHR). -exact: odd_regular_pgroup_cyclic pP oddP ntH nHP (semiregularS _ sPR regHR). -Qed. - -(* This is Huppert, Kapitel V, Satz 18.8 b (used in Peterfalvi, Section 13). *) -Lemma prime_odd_regular_normal gT (H R P : {group gT}) : - prime #|P| -> odd #|R| -> P \subset R -> - H :!=: 1 -> R \subset 'N(H) -> semiregular H R -> - P <| R. -Proof. -set p := #|P| => pr_p oddR sPR ntH nHR regHR. -have pP: p.-group P := pnat_id pr_p. -have cycQ (q : nat) (Q : {group gT}) : q.-group Q -> Q \subset R -> cyclic Q. - move=> qQ sQR; have [oddQ nHQ] := (oddSg sQR oddR, subset_trans sQR nHR). - exact: odd_regular_pgroup_cyclic qQ oddQ ntH nHQ (semiregularS _ sQR regHR). -have cycRq (q : nat): cyclic 'O_q(R) by rewrite (cycQ q) ?pcore_pgroup ?gFsub. -suffices cFP: P \subset 'C('F(R)). - have nilF: nilpotent 'F(R) := Fitting_nil R. - have hallRp: p.-Hall('F(R)) 'O_p('F(R)) := nilpotent_pcore_Hall p nilF. - apply: char_normal_trans (pcore_normal p R); rewrite sub_cyclic_char //=. - rewrite -p_core_Fitting (sub_normal_Hall hallRp) ?gFnormal //. - have solR: solvable R. - by apply: metacyclic_sol; apply: odd_regular_metacyclic regHR. - by apply: subset_trans (cent_sub_Fitting solR); rewrite subsetI sPR. -rewrite centsC -(bigdprodWY (erefl 'F(R))) gen_subG big_tnth. -apply/bigcupsP=> i _; move: {i}(tuple.tnth _ i) => q. -have [<- | q'p] := eqVneq p q. - have [Q sylQ sPQ] := Sylow_superset sPR pP; have [sQR pQ _] := and3P sylQ. - rewrite (sub_abelian_cent2 (cyclic_abelian (cycQ _ _ pQ sQR))) //. - by rewrite pcore_sub_Hall. -have [-> | ntRq] := eqVneq 'O_q(R) 1%g; first exact: sub1G. -have /andP[sRqR qRq]: q.-subgroup(R) 'O_q(R) by apply: pcore_psubgroup. -have [pr_q _ _] := pgroup_pdiv qRq ntRq. -have coRqP: coprime #|'O_q(R)| p by rewrite (pnat_coprime qRq) // pnatE. -have nRqP: P \subset 'N('O_q(R)) by rewrite (subset_trans sPR) ?gFnorm. -rewrite centsC (coprime_odd_faithful_Ohm1 qRq) ?(oddSg sRqR) //. -apply: sub_abelian_cent2 (joing_subl _ _) (joing_subr _ _) => /=. -set PQ := P <*> _; have oPQ: #|PQ| = (p * q)%N. - rewrite /PQ norm_joinEl 1?gFnorm_trans //. - rewrite coprime_cardMg 1?coprime_sym ?(coprimeSg (Ohm_sub 1 _)) // -/p. - by congr (p * _)%N; apply: Ohm1_cyclic_pgroup_prime => /=. -have sPQ_R: PQ \subset R by rewrite join_subG sPR (subset_trans (Ohm_sub 1 _)). -have nH_PQ := subset_trans sPQ_R nHR. -apply: cyclic_abelian; apply: regular_pq_group_cyclic oPQ ntH nH_PQ _ => //. -exact: semiregularS regHR. -Qed. - -Section Wielandt_Frobenius. - -Variables (gT : finGroupType) (G K R : {group gT}). -Implicit Type A : {group gT}. - -(* This is Peterfalvi (9.1). *) -Lemma Frobenius_Wielandt_fixpoint (M : {group gT}) : - [Frobenius G = K ><| R] -> - G \subset 'N(M) -> coprime #|M| #|G| -> solvable M -> - [/\ (#|'C_M(G)| ^ #|R| * #|M| = #|'C_M(R)| ^ #|R| * #|'C_M(K)|)%N, - 'C_M(R) = 1 -> K \subset 'C(M) - & 'C_M(K) = 1 -> (#|M| = #|'C_M(R)| ^ #|R|)%N]. -Proof. -move=> frobG nMG coMG solM; have [defG _ ntR _ _] := Frobenius_context frobG. -have [_ _ _ _ /eqP snRG] := and5P frobG. -have [nsKG sRG _ _ tiKR] := sdprod_context defG; have [sKG _] := andP nsKG. -pose m0 (_ : {group gT}) := 0%N. -pose Dm := [set 1%G; G]; pose Dn := K |: orbit 'JG K R. -pose m := [fun A => 0%N with 1%G |-> #|K|, G |-> 1%N]. -pose n A : nat := A \in Dn. -have out_m: {in [predC Dm], m =1 m0}. - by move=> A; rewrite !inE /=; case/norP; do 2!move/negbTE->. -have out_n: {in [predC Dn], n =1 m0}. - by rewrite /n => A /=; move/negbTE=> /= ->. -have ntG: G != 1%G by case: eqP sRG => // -> <-; rewrite subG1. -have neqKR: K \notin orbit 'JG K R. - apply/imsetP=> [[x _ defK]]; have:= Frobenius_dvd_ker1 frobG. - by rewrite defK cardJg gtnNdvd // ?prednK // -subn1 subn_gt0 cardG_gt1. -have Gmn A: m A + n A > 0 -> A \subset G. - rewrite /=; case: eqP => [-> | ] _; first by rewrite sub1G. - rewrite /n 2!inE; do 2!case: eqP => [-> // | ] _. - case R_A: (A \in _) => // _; case/imsetP: R_A => x Kx ->{A}. - by rewrite conj_subG ?(subsetP sKG). -have partG: {in G, forall a, - \sum_(A | a \in gval A) m A = \sum_(A | a \in gval A) n A}%N. -- move=> a Ga; have [-> | nt_a] := eqVneq a 1. - rewrite (bigD1 1%G) ?inE ?eqxx //= (bigD1 G) ?inE ?group1 //=. - rewrite (negbTE ntG) !eqxx big1 ?addn1 => [|A]; last first. - by rewrite group1 -negb_or -in_set2; apply: out_m. - rewrite (bigID (mem Dn)) /= addnC big1 => [|A]; last first. - by rewrite group1; apply: out_n. - transitivity #|Dn|. - rewrite cardsU1 neqKR card_orbit astab1JG. - by rewrite -{3}(setIidPl sKG) -setIA -normD1 snRG tiKR indexg1. - by rewrite -sum1_card /n; apply: eq_big => [A | A ->]; rewrite ?group1. - rewrite (bigD1 G) //= (negbTE ntG) eqxx big1 => [|A]; last first. - case/andP=> Aa neAG; apply: out_m; rewrite !inE; case: eqP => // A1. - by rewrite A1 inE (negbTE nt_a) in Aa. - have [partG tiG _] := and3P (Frobenius_partition frobG). - do [rewrite -(eqP partG); set pG := _ |: _] in Ga tiG. - rewrite (bigD1 <<pblock pG a>>%G) /=; last by rewrite mem_gen // mem_pblock. - rewrite big1 => [|B]; last first. - case/andP=> Ba neqBA; rewrite -/(false : nat); congr (nat_of_bool _). - apply: contraTF neqBA; rewrite negbK -val_eqE /=. - case/setU1P=> [BK | /imsetP[x Kx defB]]. - by rewrite (def_pblock tiG _ Ba) BK ?setU11 ?genGid. - have Rxa: a \in R^# :^ x by rewrite conjD1g !inE nt_a -(congr_group defB). - rewrite (def_pblock tiG _ Rxa) ?setU1r ?mem_imset // conjD1g. - by rewrite genD1 ?group1 // genGid defB. - rewrite /n !inE -val_eqE /= -/(true : nat); congr ((_ : bool) + _)%N. - case/setU1P: (pblock_mem Ga) => [-> |]; first by rewrite genGid eqxx. - case/imsetP=> x Kx ->; symmetry; apply/orP; right. - apply/imsetP; exists x => //. - by apply: val_inj; rewrite conjD1g /= genD1 ?group1 // genGid. -move/eqP: (solvable_Wielandt_fixpoint Gmn nMG coMG solM partG). -rewrite (bigD1 1%G) // (bigD1 G) //= eqxx (setIidPl (cents1 _)) cards1 muln1. -rewrite (negbTE ntG) eqxx mul1n -(sdprod_card defG) (mulnC #|K|) expnM. -rewrite mulnA -expnMn big1 ?muln1 => [|A]; last first. - by rewrite -negb_or -in_set2; move/out_m; rewrite /m => /= ->. -rewrite mulnC eq_sym (bigID (mem Dn)) /= mulnC. -rewrite big1 ?mul1n => [|A]; last by move/out_n->. -rewrite big_setU1 //= /n setU11 mul1n. -rewrite (eq_bigr (fun _ => #|'C_M(R)| ^ #|R|)%N) => [|A R_A]; last first. - rewrite inE R_A orbT mul1n; case/imsetP: R_A => x Kx ->. - suffices nMx: x \in 'N(M) by rewrite -{1}(normP nMx) centJ -conjIg !cardJg. - exact: subsetP (subsetP sKG x Kx). -rewrite mulnC prod_nat_const card_orbit astab1JG. -have ->: 'N_K(R) = 1 by rewrite -(setIidPl sKG) -setIA -normD1 snRG tiKR. -rewrite indexg1 -expnMn eq_sym eqn_exp2r ?cardG_gt0 //; move/eqP=> eq_fix. -split=> // [regR | regK]. - rewrite centsC (sameP setIidPl eqP) eqEcard subsetIl /=. - move: eq_fix; rewrite regR cards1 exp1n mul1n => <-. - suffices ->: 'C_M(G) = 1 by rewrite cards1 exp1n mul1n. - by apply/trivgP; rewrite -regR setIS ?centS //; case/sdprod_context: defG. -move: eq_fix; rewrite regK cards1 muln1 => <-. -suffices ->: 'C_M(G) = 1 by rewrite cards1 exp1n mul1n. -by apply/trivgP; rewrite -regK setIS ?centS. -Qed. - -End Wielandt_Frobenius. - -(* This is B & G, Theorem 3.10. *) -Theorem Frobenius_primact gT (G K R M : {group gT}) : - [Frobenius G = K ><| R] -> solvable G -> - G \subset 'N(M) -> solvable M -> M :!=: 1 -> - (*1*) coprime #|M| #|G| -> - (*2*) semiprime M R -> - (*3*) 'C_M(K) = 1 -> - [/\ prime #|R|, - #|M| = (#|'C_M(R)| ^ #|R|)%N - & cyclic 'C_M(R) -> K^`(1) \subset 'C_K(M)]. -Proof. -move: {2}_.+1 (ltnSn #|M|) => n; elim: n => // n IHn in gT G K R M *. -rewrite ltnS => leMn frobG solG nMG solM ntM coMG primRM tcKM. -case: (Frobenius_Wielandt_fixpoint frobG nMG) => // _ _ /(_ tcKM) oM. -have [defG ntK ntR ltKG _]:= Frobenius_context frobG. -have Rpr: prime #|R|. - have [R1 | [r r_pr]] := trivgVpdiv R; first by case/eqP: ntR. - case/Cauchy=> // x Rx ox; pose R0 := <[x]>; pose G0 := K <*> R0. - have [_ defKR nKR tiKR] := sdprodP defG. - have sR0R: R0 \subset R by rewrite cycle_subG. - have sG0G: G0 \subset G by rewrite /G0 -genM_join gen_subG -defKR mulgS. - have nKR0 := subset_trans sR0R nKR; have nMG0 := subset_trans sG0G nMG. - have ntx: <[x]> != 1 by rewrite cycle_eq1 -order_gt1 ox prime_gt1. - have [tcRM | ntcRM] := eqVneq 'C_M(R) 1. - by rewrite -cardG_gt1 oM tcRM cards1 exp1n in ntM. - have frobG0: [Frobenius G0 = K ><| R0]. - apply/Frobenius_semiregularP=> // [|y /setD1P[nty x_y]]. - by apply: sdprodEY nKR0 (trivgP _); rewrite -tiKR setIS. - by apply: (Frobenius_reg_ker frobG); rewrite !inE nty (subsetP sR0R). - case: (Frobenius_Wielandt_fixpoint frobG0 nMG0 (coprimegS _ coMG)) => // _ _. - move/(_ tcKM)/eqP; rewrite oM cent_cycle. - rewrite primRM; last by rewrite !inE Rx andbT -cycle_eq1. - by rewrite eqn_exp2l ?cardG_gt1 // -orderE ox => /eqP->. -split=> // cyc_cMR. -have nM_MG: M <*> G \subset 'N(M) by rewrite join_subG normG. -have [V minV sVM] := minnormal_exists ntM nM_MG. -have [] := minnormal_solvable minV sVM solM. -rewrite join_subG; case/andP=> nVM nVG ntV; case/is_abelemP=> [q q_pr abelV]. -have coVG := coprimeSg sVM coMG; have solV := solvableS sVM solM. -have cVK': K^`(1) \subset 'C_K(V). - case: (eqVneq 'C_V(R) 1) => [tcVR | ntcRV]. - case: (Frobenius_Wielandt_fixpoint frobG nVG) => // _. - by move/(_ tcVR)=> cVK _; rewrite (setIidPl cVK) der_sub. - have ocVR: #|'C_V(R)| = q. - have [u def_u]: exists u, 'C_V(R) = <[u]>. - by apply/cyclicP; apply: cyclicS (setSI _ sVM) cyc_cMR. - rewrite def_u -orderE (abelem_order_p abelV) -?cycle_eq1 -?def_u //. - by rewrite -cycle_subG -def_u subsetIl. - apply: (Frobenius_prime_cent_prime _ defG _ _ abelV) => //. - by case/prime_FrobeniusP: frobG. - by rewrite (coprime_p'group _ (abelem_pgroup abelV) ntV) // coprime_sym. -have cMK': K^`(1) / V \subset 'C_(K / V)(M / V). - have [-> | ntMV] := eqVneq (M / V) 1. - by rewrite subsetI cents1 quotientS ?der_sub. - have coKR := Frobenius_coprime frobG. - case/prime_FrobeniusP: frobG => //. - case/sdprod_context=> nsKG sRG defKR nKR tiKR regR; have [sKG _] := andP nsKG. - have nVK := subset_trans sKG nVG; have nVR := subset_trans sRG nVG. - have RVpr: prime #|R / V|. - rewrite card_quotient // -indexgI setIC coprime_TIg ?(coprimegS sRG) //. - by rewrite indexg1. - have frobGV: [Frobenius G / V = (K / V) ><| (R / V)]. - apply/prime_FrobeniusP; rewrite // -?cardG_gt1 ?card_quotient //. - rewrite -indexgI setIC coprime_TIg ?(coprimegS sKG) //. - by rewrite indexg1 cardG_gt1. - rewrite -coprime_norm_quotient_cent ?(coprimegS sRG) //= regR quotient1. - rewrite -defKR quotientMl // sdprodE ?quotient_norms //. - by rewrite coprime_TIg ?coprime_morph. - have ltMVn: #|M / V| < n by apply: leq_trans leMn; rewrite ltn_quotient. - rewrite quotient_der //; move/IHn: frobGV. - case/(_ _ ltMVn); rewrite ?quotient_sol ?quotient_norms ?coprime_morph //. - - move=> Vx; case/setD1P=> ntVx; case/morphimP=> x nVx Rx defVx. - rewrite defVx /= -cent_cycle -quotient_cycle //; congr 'C__(_ / V). - apply/eqP; rewrite eqEsubset cycle_subG Rx /=. - apply: contraR ntVx => /(prime_TIg Rpr)/trivgP. - by rewrite defVx /= (setIidPr _) cycle_subG // => /set1P->; rewrite morph1. - - rewrite -coprime_norm_quotient_cent ?(coprimegS sKG) ?(subset_trans sKG) //. - by rewrite tcKM quotient1. - move=> _ _ -> //; rewrite -coprime_quotient_cent ?quotient_cyclic //. - by rewrite (coprimegS sRG). -have{cVK' cMK'} [[sK'K cVK'] [_ cMVK']] := (subsetIP cVK', subsetIP cMK'). -have sK'G: K^`(1) \subset G by rewrite (subset_trans sK'K) ?proper_sub. -have coMK': coprime #|M| #|K^`(1)| := coprimegS sK'G coMG. -rewrite subsetI sK'K (stable_factor_cent cVK') //; apply/and3P; split=> //. -by rewrite commGC -quotient_cents2 // (subset_trans sK'G). -Qed. - -End BGsection3. diff --git a/mathcomp/odd_order/BGsection4.v b/mathcomp/odd_order/BGsection4.v deleted file mode 100644 index c35c9ab..0000000 --- a/mathcomp/odd_order/BGsection4.v +++ /dev/null @@ -1,1416 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq div. -From mathcomp -Require Import fintype finfun bigop ssralg finset prime binomial. -From mathcomp -Require Import fingroup morphism automorphism perm quotient action gproduct. -From mathcomp -Require Import gfunctor commutator zmodp cyclic center pgroup gseries nilpotent. -From mathcomp -Require Import sylow abelian maximal extremal hall. -From mathcomp -Require Import matrix mxalgebra mxrepresentation mxabelem. -From mathcomp -Require Import BGsection1 BGsection2. - -(******************************************************************************) -(* This file covers B & G, Section 4, i.e., the proof of structure theorems *) -(* for solvable groups with a small (of rank at most 2) Fitting subgroup. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope. - -Section Section4. - -Implicit Type gT : finGroupType. -Implicit Type p : nat. - -(* B & G, Lemma 4.1 (also, Gorenstein, 1.3.4, and Aschbacher, ex. 2.4) is *) -(* covered by Lemma center_cyclic_abelian, in center.v. *) - -(* B & G, Lemma 4.2 is covered by Lemmas commXg, commgX, commXXg (for 4.2(a)) *) -(* and expMg_Rmul (for 4.2(b)) in commutators.v. *) - -(* This is B & G, Proposition 4.3. *) -Proposition exponent_odd_nil23 gT (R : {group gT}) p : - p.-group R -> odd #|R| -> nil_class R <= 2 + (p > 3) -> - [/\ (*a*) exponent 'Ohm_1(R) %| p - & (*b*) R^`(1) \subset 'Ohm_1(R) -> - {in R &, {morph expgn^~ p : x y / x * y}}]. -Proof. -move=> pR oddR classR. -pose f n := 'C(n, 3); pose g n := 'C(n, 3).*2 + 'C(n, 2). -have fS n: f n.+1 = 'C(n, 2) + f n by rewrite /f binS addnC. -have gS n: g n.+1 = 'C(n, 2).*2 + 'C(n, 1) + g n. - by rewrite /g !binS doubleD -!addnA; do 3!nat_congr. -have [-> | ntR] := eqsVneq R 1. - rewrite Ohm1 exponent1 der_sub dvd1n; split=> // _ _ _ /set1P-> /set1P->. - by rewrite !(mulg1, expg1n). -have{ntR} [p_pr p_dv_R _] := pgroup_pdiv pR ntR. -have pdivbin2: p %| 'C(p, 2). - by rewrite prime_dvd_bin //= odd_prime_gt2 // (dvdn_odd p_dv_R). -have p_dv_fp: p > 3 -> p %| f p by move=> pgt3; apply: prime_dvd_bin. -have p_dv_gp: p > 3 -> p %| g p. - by move=> pgt3; rewrite dvdn_add // -muln2 dvdn_mulr // p_dv_fp. -have exp_dv_p x m (S : {group gT}): - exponent S %| p -> p %| m -> x \in S -> x ^+ m = 1. -- move=> expSp p_dv_m Sx; apply/eqP; rewrite -order_dvdn. - by apply: dvdn_trans (dvdn_trans expSp p_dv_m); apply: dvdn_exponent. -have p3_L21: p <= 3 -> {in R & &, forall u v w, [~ u, v, w] = 1}. - move=> lep3 u v w Ru Rv Rw; rewrite (ltnNge 3) lep3 nil_class2 in classR. - by apply/eqP/commgP; red; rewrite (centerC Rw) // (subsetP classR) ?mem_commg. -have{fS gS} expMR_fg: {in R &, forall u v n (r := [~ v, u]), - (u * v) ^+ n = u ^+ n * v ^+ n * r ^+ 'C(n, 2) - * [~ r, u] ^+ f n * [~ r, v] ^+ g n}. -- move=> u v Ru Rv n r; have Rr: r \in R by apply: groupR. - have cRr: {in R &, forall x y, commute x [~ r, y]}. - move=> x y Rx Ry /=; red; rewrite (centerC Rx) //. - have: [~ r, y] \in 'L_3(R) by rewrite !mem_commg. - by apply: subsetP; rewrite -nil_class3 (leq_trans classR) // !ltnS leq_b1. - elim: n => [|n IHn]; first by rewrite !mulg1. - rewrite 3!expgSr {}IHn -!mulgA (mulgA (_ ^+ f n)); congr (_ * _). - rewrite -commuteM; try by apply: commuteX; red; rewrite cRr ?groupM. - rewrite -mulgA; do 2!rewrite (mulgA _ u) (commgC _ u) -2!mulgA. - congr (_ * (_ * _)); rewrite (mulgA _ v). - have ->: [~ v ^+ n, u] = r ^+ n * [~ r, v] ^+ 'C(n, 2). - elim: n => [|n IHn]; first by rewrite comm1g mulg1. - rewrite !expgS commMgR -/r {}IHn commgX; last exact: cRr. - rewrite binS bin1 addnC expgD -2!mulgA; congr (_ * _); rewrite 2!mulgA. - by rewrite commuteX2 // /commute cRr. - rewrite commXg 1?commuteX2 -?[_ * v]commuteX; try exact: cRr. - rewrite mulgA {1}[mulg]lock mulgA -mulgA -(mulgA v) -!expgD -fS -lock. - rewrite -{2}(bin1 n) addnC -binS -2!mulgA (mulgA _ v) (commgC _ v). - rewrite -commuteX; last by red; rewrite cRr ?(Rr, groupR, groupX, groupM). - rewrite -3!mulgA; congr (_ * (_ * _)); rewrite 2!mulgA. - rewrite commXg 1?commuteX2; try by red; rewrite cRr 1?groupR. - by rewrite -!mulgA -!expgD addnCA binS addnAC addnn addnC -gS. -have expR1p: exponent 'Ohm_1(R) %| p. - elim: _.+1 {-2 4}R (ltnSn #|R|) (subxx R) => // n IHn Q leQn sQR. - rewrite (OhmE 1 (pgroupS sQR pR)) expn1 -sub_LdivT. - rewrite gen_set_id ?subsetIr //. - apply/group_setP; rewrite !inE group1 expg1n /=. - split=> // x y /LdivP[Qx xp1] /LdivP[Qy yp1]; rewrite !inE groupM //=. - have sxQ: <[x]> \subset Q by rewrite cycle_subG. - have [{sxQ}defQ|[S maxS /= sxS]] := maximal_exists sxQ. - rewrite expgMn; first by rewrite xp1 yp1 mulg1. - by apply: (centsP (cycle_abelian x)); rewrite ?defQ. - have:= maxgroupp maxS; rewrite properEcard => /andP[sSQ ltSQ]. - have pQ := pgroupS sQR pR; have pS := pgroupS sSQ pQ. - have{ltSQ leQn} ltSn: #|S| < n by apply: leq_trans ltSQ _. - have expS1p := IHn _ ltSn (subset_trans sSQ sQR). - have defS1 := Ohm1Eexponent p_pr expS1p; move/exp_dv_p: expS1p => expS1p. - have nS1Q: [~: Q, 'Ohm_1(S)] \subset 'Ohm_1(S). - by rewrite commg_subr gFnorm_trans ?normal_norm // (p_maximal_normal pQ). - have S1x : x \in 'Ohm_1(S) by rewrite defS1 !inE -cycle_subG sxS xp1 /=. - have S1yx : [~ y, x] \in 'Ohm_1(S) by rewrite (subsetP nS1Q) ?mem_commg. - have S1yxx : [~ y, x, x] \in 'Ohm_1(S) by rewrite groupR. - have S1yxy : [~ y, x, y] \in 'Ohm_1(S). - by rewrite -invg_comm groupV (subsetP nS1Q) 1?mem_commg. - rewrite expMR_fg ?(subsetP sQR) //= xp1 yp1 expS1p ?mul1g //. - case: (leqP p 3) => [p_le3 | p_gt3]; last by rewrite ?expS1p ?mul1g; auto. - by rewrite !p3_L21 // ?(subsetP sQR) // !expg1n mulg1. -split=> // sR'R1 x y Rx Ry; rewrite -[x ^+ p * _]mulg1 expMR_fg // -2!mulgA //. -have expR'p := exp_dv_p _ _ _ (dvdn_trans (exponentS sR'R1) expR1p). -congr (_ * _); rewrite expR'p ?mem_commg // mul1g. -case: (leqP p 3) => [p_le3 | p_gt3]. - by rewrite !p3_L21 // ?(subsetP sQR) // !expg1n mulg1. -by rewrite !expR'p 1?mem_commg ?groupR ?mulg1; auto. -Qed. - -(* Part (a) of B & G, Proposition 4.4 is covered in file maximal.v by lemmas *) -(* max_SCN and SCN_max. *) - -(* This is B & G, Proposition 4.4(b), or Gorenstein 7.6.5. *) -Proposition SCN_Sylow_cent_dprod gT (R G A : {group gT}) p : - p.-Sylow(G) R -> A \in 'SCN(R) -> 'O_p^'('C_G(A)) \x A = 'C_G(A). -Proof. -move=> sylR scnA; have [[sRG _] [nAR CRA_A]] := (andP sylR, SCN_P scnA). -set C := 'C_G(A); have /maxgroupP[/andP[nAG abelA] maxA] := SCN_max scnA. -have CiP_eq : C :&: R = A by rewrite -CRA_A setIC setIA (setIidPl sRG). -have sylA: p.-Sylow(C) A. - rewrite -CiP_eq; apply: (Sylow_setI_normal (subcent_normal _ _)). - by apply: pHall_subl sylR; rewrite ?subsetIl // subsetI sRG normal_norm. -rewrite dprodEsd; last by rewrite centsC gFsub_trans ?subsetIr. -by apply: Burnside_normal_complement; rewrite // subIset ?subsetIr. -Qed. - -(* This is B & G, Lemma 4.5(b), or Gorenstein, 5.4.4 and 5.5.5. *) -Lemma Ohm1_extremal_odd gT (R : {group gT}) p x : - p.-group R -> odd #|R| -> ~~ cyclic R -> x \in R -> #|R : <[x]>| = p -> - ('Ohm_1(R))%G \in 'E_p^2(R). -Proof. -move=> pR oddR ncycR Rx ixR; rewrite -cycle_subG in Rx. -have ntR: R :!=: 1 by apply: contra ncycR; move/eqP->; apply: cyclic1. -have [p_pr _ [e oR]]:= pgroup_pdiv pR ntR. -case p2: (p == 2); first by rewrite oR odd_exp (eqP p2) in oddR. -have [cRR | not_cRR] := orP (orbN (abelian R)). - rewrite 2!inE Ohm_sub Ohm1_abelem // -p_rank_abelian //= eqn_leq. - rewrite -rank_pgroup // ltnNge -abelian_rank1_cyclic // ncycR andbT. - have maxX: maximal <[x]> R by rewrite (p_index_maximal Rx) ?ixR. - have nsXR: <[x]> <| R := p_maximal_normal pR maxX. - have [_ [y Ry notXy]] := properP (maxgroupp maxX). - have defR: <[x]> * <[y]> = R. - by apply: mulg_normal_maximal; rewrite ?cycle_subG. - rewrite -grank_abelian // -(genGid R) -defR genM_join joing_idl joing_idr. - by rewrite (leq_trans (grank_min _)) // cards2 ltnS leq_b1. -have{x Rx ixR} [e_gt1 isoR]: 2 < e.+1 /\ R \isog 'Mod_(p ^ e.+1). - have:= maximal_cycle_extremal pR not_cRR (cycle_cyclic x) Rx ixR. - rewrite p2 orbF /extremal_class oR pfactorKpdiv // pdiv_pfactor //. - by do 4!case: andP => //. -have [[x y] genR modR] := generators_modular_group p_pr e_gt1 isoR. -have [_ _ _ _] := modular_group_structure p_pr e_gt1 genR isoR modR. -rewrite xpair_eqE p2; case/(_ 1%N) => // _ oR1. -by rewrite 2!inE Ohm_sub oR1 pfactorK ?abelem_Ohm1 ?(card_p2group_abelian p_pr). -Qed. - -Section OddNonCyclic. - -Variables (gT : finGroupType) (p : nat) (R : {group gT}). -Hypotheses (pR : p.-group R) (oddR : odd #|R|) (ncycR : ~~ cyclic R). - -(* This is B & G, Lemma 4.5(a), or Gorenstein 5.4.10. *) -Lemma ex_odd_normal_p2Elem : {S : {group gT} | S <| R & S \in 'E_p^2(R)}. -Proof. -have [M minM]: {M | [min M | M <| R & ~~ cyclic M]}. - by apply: ex_mingroup; exists R; rewrite normal_refl. -have{minM} [[nsMR ncycM] [_ minM]] := (andP (mingroupp minM), mingroupP minM). -have [sMR _] := andP nsMR; have pM := pgroupS sMR pR. -exists ('Ohm_1(M))%G; first exact: gFnormal_trans. -apply: (subsetP (pnElemS _ _ sMR)). -have [M1 | ntM] := eqsVneq M 1; first by rewrite M1 cyclic1 in ncycM. -have{ntM} [p_pr _ [e oM]] := pgroup_pdiv pM ntM. -have le_e_M: e <= logn p #|M| by rewrite ltnW // oM pfactorK. -have{le_e_M} [N [sNM nsNR] oN] := normal_pgroup pR nsMR le_e_M. -have ltNM: ~~ (#|N| >= #|M|) by rewrite -ltnNge oM oN ltn_exp2l ?prime_gt1. -have cycN : cyclic N by apply: contraR ltNM => ncycN; rewrite minM //= nsNR. -case/cyclicP: cycN => x defN; have Mx : x \in M by rewrite -cycle_subG -defN. -apply: Ohm1_extremal_odd Mx _; rewrite ?(oddSg sMR) //. -by rewrite -divgS /= -defN // oM oN expnS mulnK // expn_gt0 prime_gt0. -Qed. - -(* This is B & G, Lemma 4.5(c). *) -Lemma Ohm1_odd_ucn2 (Z := 'Ohm_1('Z_2(R))) : ~~ cyclic Z /\ exponent Z %| p. -Proof. -have [S nsSR Ep2S] := ex_odd_normal_p2Elem; have p_pr := pnElem_prime Ep2S. -have [sSR abelS dimS] := pnElemP Ep2S; have [pS cSS expSp]:= and3P abelS. -pose SR := [~: S, R]; pose SRR := [~: SR, R]. -have nilR := pgroup_nil pR. -have ntS: S :!=: 1 by rewrite -rank_gt0 (rank_abelem abelS) dimS. -have sSR_S: SR \subset S by rewrite commg_subl normal_norm. -have sSRR_SR: SRR \subset SR by rewrite commSg. -have sSR_R := subset_trans sSR_S sSR. -have{ntS} prSR: SR \proper S. - by rewrite (nil_comm_properl nilR) // subsetI subxx -commg_subl. -have SRR1: SRR = 1. - have [SR1 | ntSR] := eqVneq SR 1; first by rewrite /SRR SR1 comm1G. - have prSRR: SRR \proper SR. - rewrite /proper sSRR_SR; apply: contra ntSR => sSR_SRR. - by rewrite (forall_inP nilR) // subsetI sSR_R. - have pSR := pgroupS sSR_R pR; have pSRR := pgroupS sSRR_SR pSR. - have [_ _ [e oSR]] := pgroup_pdiv pSR ntSR; have [f oSRR] := p_natP pSRR. - have e0: e = 0. - have:= proper_card prSR; rewrite oSR (card_pnElem Ep2S). - by rewrite ltn_exp2l ?prime_gt1 // !ltnS leqn0; move/eqP. - apply/eqP; have:= proper_card prSRR; rewrite trivg_card1 oSR oSRR e0. - by rewrite ltn_exp2l ?prime_gt1 // ltnS; case f. -have sSR_ZR: [~: S, R] \subset 'Z(R). - by rewrite subsetI sSR_R /=; apply/commG1P. -have sS_Z2R: S \subset 'Z_2(R). - rewrite ucnSnR; apply/subsetP=> s Ss; rewrite inE (subsetP sSR) //= ucn1. - by rewrite (subset_trans _ sSR_ZR) ?commSg ?sub1set. -have sZ2R_R := ucn_sub 2 R; have pZ2R := pgroupS sZ2R_R pR. -have pZ: p.-group Z by apply: pgroupS pR; apply/gFsub_trans/gFsub. -have sSZ: S \subset Z. - by rewrite /Z (OhmE 1 pZ2R) sub_gen // subsetI sS_Z2R sub_LdivT. -have ncycX: ~~ cyclic S by rewrite (abelem_cyclic abelS) dimS. -split; first by apply: contra ncycX; apply: cyclicS. -have nclZ2R : nil_class 'Z_2(R) <= 2 + _ := leq_trans (nil_class_ucn _ _) _. -by have [] := exponent_odd_nil23 pZ2R (oddSg sZ2R_R oddR) (nclZ2R _ _). -Qed. - -End OddNonCyclic. - -(* Some "obvious" consequences of the above, which are used casually and *) -(* pervasively throughout B & G. *) -Definition odd_pgroup_rank1_cyclic := odd_pgroup_rank1_cyclic. (* in extremal *) - -Lemma odd_rank1_Zgroup gT (G : {group gT}) : - odd #|G| -> Zgroup G = ('r(G) <= 1). -Proof. -move=> oddG; apply/forallP/idP=> [ZgG | rG_1 P]. - have [p p_pr ->]:= rank_witness G; have [P sylP]:= Sylow_exists p G. - have [sPG pP _] := and3P sylP; have oddP := oddSg sPG oddG. - rewrite -(p_rank_Sylow sylP) -(odd_pgroup_rank1_cyclic pP) //. - by apply: (implyP (ZgG P)); apply: (p_Sylow sylP). -apply/implyP=> /SylowP[p p_pr /and3P[sPG pP _]]. -rewrite (odd_pgroup_rank1_cyclic pP (oddSg sPG oddG)). -by apply: leq_trans (leq_trans (p_rank_le_rank p G) rG_1); apply: p_rankS. -Qed. - -(* This is B & G, Proposition 4.6 (a stronger version of Lemma 4.5(a)). *) -Proposition odd_normal_p2Elem_exists gT p (R S : {group gT}) : - p.-group R -> odd #|R| -> S <| R -> ~~ cyclic S -> - exists E : {group gT}, [/\ E \subset S, E <| R & E \in 'E_p^2(R)]. -Proof. -move=> pR oddR nsSR ncycS; have sSR := normal_sub nsSR. -have{sSR ncycS} []:= Ohm1_odd_ucn2 (pgroupS sSR pR) (oddSg sSR oddR) ncycS. -set Z := 'Ohm_1(_) => ncycZ expZp. -have chZS: Z \char S by rewrite !gFchar_trans. -have{nsSR} nsZR: Z <| R := char_normal_trans chZS nsSR. -have [sZR _] := andP nsZR; have pZ: p.-group Z := pgroupS sZR pR. -have geZ2: 2 <= logn p #|Z|. - rewrite (odd_pgroup_rank1_cyclic pZ (oddSg sZR oddR)) -ltnNge /= -/Z in ncycZ. - by case/p_rank_geP: ncycZ => E; case/pnElemP=> sEZ _ <-; rewrite lognSg. -have [E [sEZ nsER oE]] := normal_pgroup pR nsZR geZ2. -have [sER _] := andP nsER; have{pR} pE := pgroupS sER pR. -have{geZ2} p_pr: prime p by move: geZ2; rewrite lognE; case: (prime p). -have{oE p_pr} dimE2: logn p #|E| = 2 by rewrite oE pfactorK. -exists E; split; rewrite ?(subset_trans _ (char_sub chZS)) {chZS nsZR}//. -rewrite !inE /abelem sER pE (p2group_abelian pE) dimE2 //= andbT. -exact/(dvdn_trans _ expZp)/exponentS. -Qed. - -(* This is B & G, Lemma 4.7, and (except for the trivial converse) Gorenstein *) -(* 5.4.15 and Aschbacher 23.17. *) -Lemma rank2_SCN3_empty gT p (R : {group gT}) : - p.-group R -> odd #|R| -> ('r(R) <= 2) = ('SCN_3(R) == set0). -Proof. -move=> pR oddR; apply/idP/idP=> [leR2 | SCN_3_empty]. - apply/set0Pn=> [[A /setIdP[/SCN_P[/andP[sAR _] _]]]]. - by rewrite ltnNge (leq_trans (rankS sAR)). -rewrite (rank_pgroup pR) leqNgt; apply/negP=> gtR2. -have ncycR: ~~ cyclic R by rewrite (odd_pgroup_rank1_cyclic pR) // -ltnNge ltnW. -have{ncycR} [Z nsZR] := ex_odd_normal_p2Elem pR oddR ncycR. -case/pnElemP=> sZR abelZ dimZ2; have [pZ cZZ _] := and3P abelZ. -have{SCN_3_empty} defZ: 'Ohm_1('C_R(Z)) = Z. - apply: (Ohm1_cent_max_normal_abelem _ pR). - by have:= oddSg sZR oddR; rewrite (card_pgroup pZ) dimZ2 odd_exp. - apply/maxgroupP; split=> [|H /andP[nsHR abelH] sZH]; first exact/andP. - have [pH cHH _] := and3P abelH; apply/eqP; rewrite eq_sym eqEproper sZH /=. - pose normal_abelian := [pred K : {group gT} | K <| R & abelian K]. - have [|K maxK sHK] := @maxgroup_exists _ normal_abelian H; first exact/andP. - apply: contraL SCN_3_empty => ltZR; apply/set0Pn; exists K. - rewrite inE (max_SCN pR) {maxK}//= -dimZ2 (leq_trans _ (rankS sHK)) //. - by rewrite (rank_abelem abelH) properG_ltn_log. -have{gtR2} [A] := p_rank_geP gtR2; pose H := 'C_A(Z); pose K := H <*> Z. -case/pnElemP=> sAR abelA dimA3; have [pA cAA _] := and3P abelA. -have{nsZR} nZA := subset_trans sAR (normal_norm nsZR). -have sHA: H \subset A := subsetIl A _; have abelH := abelemS sHA abelA. -have geH2: logn p #|H| >= 2. - rewrite -ltnS -dimA3 -(Lagrange sHA) lognM // -addn1 leq_add2l /= -/H. - by rewrite logn_quotient_cent_abelem ?dimZ2. -have{abelH} abelK : p.-abelem K. - by rewrite (cprod_abelem _ (cprodEY _)) 1?centsC ?subsetIr ?abelH. -suffices{sZR cZZ defZ}: 'r(Z) < 'r(K). - by rewrite ltnNge -defZ rank_Ohm1 rankS // join_subG setSI // subsetI sZR. -rewrite !(@rank_abelem _ p) // properG_ltn_log ?abelem_pgroup //= -/K properE. -rewrite joing_subr join_subG subxx andbT subEproper; apply: contraL geH2. -case/predU1P=> [defH | ltHZ]; last by rewrite -ltnNge -dimZ2 properG_ltn_log. -rewrite -defH [H](setIidPl _) ?dimA3 // in dimZ2. -by rewrite centsC -defH subIset // -abelianE cAA. -Qed. - -(* This is B & G, Proposition 4.8(a). *) -Proposition rank2_exponent_p_p3group gT (R : {group gT}) p : - p.-group R -> rank R <= 2 -> exponent R %| p -> logn p #|R| <= 3. -Proof. -move=> pR rankR expR. -have [A max_na_A]: {A | [max A | A <| R & abelian A]}. - by apply: ex_maxgroup; exists 1%G; rewrite normal1 abelian1. -have {max_na_A} SCN_A := max_SCN pR max_na_A. -have cAA := SCN_abelian SCN_A; case/SCN_P: SCN_A => nAR cRAA. -have sAR := normal_sub nAR; have pA := pgroupS sAR pR. -have abelA : p.-abelem A. - by rewrite /abelem pA cAA /= (dvdn_trans (exponentS sAR) expR). -have cardA : logn p #|A| <= 2. - by rewrite -rank_abelem // (leq_trans (rankS sAR) rankR). -have cardRA : logn p #|R : A| <= 1. - by rewrite -cRAA logn_quotient_cent_abelem // (normal_norm nAR). -rewrite -(Lagrange sAR) lognM ?cardG_gt0 //. -by apply: (leq_trans (leq_add cardA cardRA)). -Qed. - -(* This is B & G, Proposition 4.8(b). *) -Proposition exponent_Ohm1_rank2 gT p (R : {group gT}) : - p.-group R -> 'r(R) <= 2 -> p > 3 -> exponent 'Ohm_1(R) %| p. -Proof. -move=> pR rR p_gt3; wlog p_pr: / prime p. - have [-> | ntR] := eqsVneq R 1; first by rewrite Ohm1 exponent1 dvd1n. - by apply; have [->] := pgroup_pdiv pR ntR. -wlog minR: R pR rR / forall S, gval S \proper R -> exponent 'Ohm_1(S) %| p. - elim: {R}_.+1 {-2}R (ltnSn #|R|) => // m IHm R leRm in pR rR * => IH. - apply: (IH) => // S; rewrite properEcard; case/andP=> sSR ltSR. - exact: IHm (leq_trans ltSR _) (pgroupS sSR pR) (leq_trans (rankS sSR) rR) IH. -wlog not_clR_le3: / ~~ (nil_class R <= 3). - case: leqP => [clR_le3 _ | _ -> //]. - have [||-> //] := exponent_odd_nil23 pR; last by rewrite p_gt3. - by apply: odd_pgroup_odd pR; case/even_prime: p_pr p_gt3 => ->. -rewrite -sub_LdivT (OhmE 1 pR) gen_set_id ?subsetIr //. -apply/group_setP; rewrite !inE group1 expg1n. -split=> //= x y; case/LdivP=> Rx xp1; case/LdivP=> Ry yp1. -rewrite !inE groupM //=; apply: contraR not_clR_le3 => nt_xyp. -pose XY := <[x]> <*> <[y]>. -have [XYx XYy]: x \in XY /\ y \in XY by rewrite -!cycle_subG; apply/joing_subP. -have{nt_xyp} defR: XY = R. - have sXY_R : XY \subset R by rewrite join_subG !cycle_subG Rx Ry. - have pXY := pgroupS sXY_R pR; have [// | ltXY_R] := eqVproper sXY_R. - rewrite (exponentP (minR _ ltXY_R)) ?eqxx // in nt_xyp. - by rewrite (OhmE 1 pXY) groupM ?mem_gen ?inE ?XYx ?XYy /= ?xp1 ?yp1. -have sXR: <[x]> \subset R by rewrite cycle_subG. -have [<- | ltXR] := eqVproper sXR. - by rewrite 2?leqW // nil_class1 cycle_abelian. -have [S maxS sXS]: {S : {group gT} | maximal S R & <[x]> \subset S}. - exact: maxgroup_exists. -have nsSR: S <| R := p_maximal_normal pR maxS; have [sSR _] := andP nsSR. -have{nsSR} nsS1R: 'Ohm_1(S) <| R := gFnormal_trans _ nsSR. -have [sS1R nS1R] := andP nsS1R; have pS1 := pgroupS sS1R pR. -have expS1p: exponent 'Ohm_1(S) %| p := minR S (maxgroupp maxS). -have{expS1p} dimS1: logn p #|'Ohm_1(S)| <= 3. - exact: rank2_exponent_p_p3group pS1 (leq_trans (rankS sS1R) rR) expS1p. -have sXS1: <[x]> \subset 'Ohm_1(S). - rewrite cycle_subG /= (OhmE 1 (pgroupS sSR pR)) mem_gen //. - by rewrite !inE -cycle_subG sXS xp1 /=. -have dimS1b: logn p #|R / 'Ohm_1(S)| <= 1. - rewrite -quotientYidl // -defR joingA (joing_idPl sXS1). - rewrite quotientYidl ?cycle_subG ?(subsetP nS1R) //. - rewrite (leq_trans (logn_quotient _ _ _)) // -(pfactorK 1 p_pr). - by rewrite dvdn_leq_log ?prime_gt0 // order_dvdn yp1. -rewrite (leq_trans (nil_class_pgroup pR)) // geq_max /= -subn1 leq_subLR. -by rewrite -(Lagrange sS1R) lognM // -card_quotient // addnC leq_add. -Qed. - -(* This is B & G, Lemma 4.9. *) -Lemma quotient_p2_Ohm1 gT p (R : {group gT}) : - p.-group R -> p > 3 -> logn p #|'Ohm_1(R)| <= 2 -> - forall T : {group gT}, T <| R -> logn p #|'Ohm_1(R / T)| <= 2. -Proof. -move=> pR p_gt3 dimR1; move: {2}_.+1 (ltnSn #|R|) => n. -elim: n => // n IHn in gT R pR dimR1 *; rewrite ltnS => leRn. -apply/forall_inP/idPn; rewrite negb_forall_in. -case/existsP/ex_mingroup=> T /mingroupP[/andP[nsTR dimRb1] minT]. -have [sTR nTR] := andP nsTR; have pT: p.-group T := pgroupS sTR pR. -pose card_iso_Ohm := card_isog (gFisog [igFun of Ohm 1] _). -have ntT: T :!=: 1; last have p_pr: prime p by have [] := pgroup_pdiv pT ntT. - apply: contraNneq dimRb1 => ->. - by rewrite -(card_iso_Ohm _ _ _ _ (quotient1_isog R)). -have{minT} dimT: logn p #|T| = 1%N. - have [Z EpZ]: exists Z, Z \in 'E_p^1(T :&: 'Z(R)). - apply/p_rank_geP; rewrite -rank_pgroup ?(pgroupS (subsetIl T _)) //. - by rewrite rank_gt0 (meet_center_nil (pgroup_nil pR)). - have [sZ_ZT _ dimZ] := pnElemP EpZ; have [sZT sZZ] := subsetIP sZ_ZT. - have{sZZ} nsZR: Z <| R := sub_center_normal sZZ. - rewrite -(minT Z) // nsZR; apply: contra dimRb1 => dimRz1. - rewrite -(card_iso_Ohm _ _ _ _ (third_isog sZT nsZR nsTR)) /=. - rewrite IHn ?quotient_pgroup ?quotient_normal ?(leq_trans _ leRn) //. - by rewrite ltn_quotient ?(subset_trans sZT) // (nt_pnElem EpZ). -have pRb: p.-group (R / T) by apply: quotient_pgroup. -have{IHn} minR (Ub : {group coset_of T}): - Ub \subset R / T -> ~~ (logn p #|'Ohm_1(Ub)| <= 2) -> R / T = Ub. -- case/inv_quotientS=> // U -> sTU sUR dimUb; congr (_ / T). - apply/eqP; rewrite eq_sym eqEcard sUR leqNgt; apply: contra dimUb => ltUR. - rewrite IHn ?(pgroupS sUR) ?(normalS _ sUR) ?(leq_trans ltUR) //. - by rewrite (leq_trans _ dimR1) ?lognSg ?OhmS. -have [dimRb eRb]: logn p #|R / T| = 3 /\ exponent (R / T) %| p. - have [Rb_gt2 | Rb_le2] := ltnP 2 'r_p(R / T). - have [Ub Ep3Ub] := p_rank_geP Rb_gt2. - have [sUbR abelUb dimUb] := pnElemP Ep3Ub; have [_ _ eUb] := and3P abelUb. - by rewrite (minR Ub) // (Ohm1_id abelUb) dimUb. - rewrite -rank_pgroup // in Rb_le2. - have eRb: exponent (R / T) %| p. - by rewrite (minR _ (Ohm_sub 1 _)) ?exponent_Ohm1_rank2 ?Ohm_id. - split=> //; apply/eqP; rewrite eqn_leq rank2_exponent_p_p3group // ltnNge. - by apply: contra (leq_trans _) dimRb1; rewrite lognSg ?Ohm_sub. -have ntRb: (R / T) != 1. - by rewrite -cardG_gt1 (card_pgroup pRb) dimRb (ltn_exp2l 0) ?prime_gt1. -have{dimRb} dimR: logn p #|R| = 4. - by rewrite -(Lagrange sTR) lognM ?cardG_gt0 // dimT -card_quotient ?dimRb. -have nsR1R: 'Ohm_1(R) <| R := Ohm_normal 1 R; have [sR1R nR1R] := andP nsR1R. -have pR1: p.-group 'Ohm_1(R) := pgroupS sR1R pR. -have p_odd: odd p by case/even_prime: p_pr p_gt3 => ->. -have{p_odd} oddR: odd #|R| := odd_pgroup_odd p_odd pR. -have{dimR1} dimR1: logn p #|'Ohm_1(R)| = 2. - apply/eqP; rewrite eqn_leq dimR1 -p_rank_abelem; last first. - by rewrite abelem_Ohm1 // (p2group_abelian pR1). - rewrite ltnNge p_rank_Ohm1 -odd_pgroup_rank1_cyclic //. - apply: contra dimRb1 => cycR; have cycRb := quotient_cyclic T cycR. - by rewrite (Ohm1_cyclic_pgroup_prime cycRb pRb ntRb) (pfactorK 1). -have pRs: p.-group (R / 'Ohm_1(R)) by rewrite quotient_pgroup. -have dimRs: logn p #|R / 'Ohm_1(R)| = 2. - by rewrite -divg_normal // logn_div ?cardSg // dimR1 dimR. -have sR'R1: R^`(1) \subset 'Ohm_1(R). - by rewrite der1_min // (p2group_abelian pRs) ?dimRs. -have [|_ phiM] := exponent_odd_nil23 pR oddR. - by rewrite (leq_trans (nil_class_pgroup pR)) // dimR p_gt3. -pose phi := Morphism (phiM sR'R1). -suffices: logn p #|R / 'Ohm_1(R)| <= logn p #|T| by rewrite dimT dimRs. -have ->: 'Ohm_1(R) = 'ker phi. - rewrite -['ker phi]genGid (OhmE 1 pR); congr <<_>>. - by apply/setP=> x; rewrite !inE. -rewrite (card_isog (first_isog phi)) lognSg //=. -apply/subsetP=> _ /morphimP[x _ Rx ->] /=. -apply: coset_idr; first by rewrite groupX ?(subsetP nTR). -by rewrite morphX ?(subsetP nTR) // (exponentP eRb) // mem_quotient. -Qed. - -(* This is B & G, Lemma 4.10. *) -Lemma Ohm1_metacyclic_p2Elem gT p (R : {group gT}) : - metacyclic R -> p.-group R -> odd #|R| -> ~~ cyclic R -> - 'Ohm_1(R)%G \in 'E_p^2(R). -Proof. -case/metacyclicP=> S [cycS nsSR cycRb] pR oddR ncycR. -have [[sSR nSR] [s defS]] := (andP nsSR, cyclicP cycS). -have [T defTb sST sTR] := inv_quotientS nsSR (Ohm_sub 1 (R / S)). -have [pT oddT] := (pgroupS sTR pR, oddSg sTR oddR). -have Ts: s \in T by rewrite -cycle_subG -defS. -have iTs: #|T : <[s]>| = p. - rewrite -defS -card_quotient ?(subset_trans sTR) // -defTb. - rewrite (Ohm1_cyclic_pgroup_prime cycRb (quotient_pgroup _ pR)) // -subG1. - by rewrite quotient_sub1 ?(contra (fun sRS => cyclicS sRS cycS)). -have defR1: 'Ohm_1(R) = 'Ohm_1(T). - apply/eqP; rewrite eqEsubset (OhmS _ sTR) andbT -Ohm_id OhmS //. - by rewrite -(quotientSGK _ sST) ?gFsub_trans // -defTb morphim_Ohm. -rewrite (subsetP (pnElemS _ _ sTR)) // (group_inj defR1). -apply: Ohm1_extremal_odd iTs => //; apply: contra ncycR. -by rewrite !(@odd_pgroup_rank1_cyclic _ p) // -p_rank_Ohm1 -defR1 p_rank_Ohm1. -Qed. - -(* This is B & G, Proposition 4.11 (due to Huppert). *) -Proposition p2_Ohm1_metacyclic gT p (R : {group gT}) : - p.-group R -> p > 3 -> logn p #|'Ohm_1(R)| <= 2 -> metacyclic R. -Proof. -move=> pR p_gt3 dimR1; move: {2}_.+1 (ltnSn #|R|) => n. -elim: n => // n IHn in gT R pR dimR1 *; rewrite ltnS => leRn. -have pR1: p.-group 'Ohm_1(R) := pgroupS (Ohm_sub 1 R) pR. -have [cRR | not_cRR] := boolP (abelian R). - have [b defR typeR] := abelian_structure cRR; move: dimR1 defR. - rewrite -(rank_abelian_pgroup pR cRR) -(size_abelian_type cRR) -{}typeR. - case: b => [|a [|b []]] //= _; first by move <-; rewrite big_nil metacyclic1. - by rewrite big_seq1 => <-; rewrite cyclic_metacyclic ?cycle_cyclic. - rewrite big_cons big_seq1; case/dprodP=> _ <- cAB _. - apply/existsP; exists <[a]>%G; rewrite cycle_cyclic /=. - rewrite /normal mulG_subl mulG_subG normG cents_norm //= quotientMidl. - by rewrite quotient_cycle ?cycle_cyclic // -cycle_subG cents_norm. -pose R' := R^`(1); pose e := 'Mho^1(R') != 1. -have nsR'R: R' <| R := der_normal 1 R; have [sR'R nR'R] := andP nsR'R. -have [T EpT]: exists T, T \in 'E_p^1('Mho^e(R') :&: 'Z(R)). - apply/p_rank_geP; rewrite -rank_pgroup; last first. - by rewrite (pgroupS _ pR) //= setIC subIset ?center_sub. - rewrite rank_gt0 (meet_center_nil (pgroup_nil pR)) ?gFnormal_trans //. - by case ntR'1: e; rewrite //= Mho0 (sameP eqP derG1P). -have [p_gt1 p_pr] := (ltnW (ltnW p_gt3), pnElem_prime EpT). -have p_odd: odd p by case/even_prime: p_pr p_gt3 => ->. -have{p_odd} oddR: odd #|R| := odd_pgroup_odd p_odd pR. -have [sTR'eZ abelT oT] := pnElemPcard EpT; rewrite expn1 in oT. -have{sTR'eZ abelT} [[sTR'e sTZ] [pT cTT eT]] := (subsetIP sTR'eZ, and3P abelT). -have sTR': T \subset R' := subset_trans sTR'e (Mho_sub e _). -have nsTR := sub_center_normal sTZ; have [sTR cRT] := subsetIP sTZ. -have cTR: R \subset 'C(T) by rewrite centsC. -have{n IHn leRn EpT} metaRb: metacyclic (R / T). - have pRb: p.-group (R / T) := quotient_pgroup T pR. - have dimRb: logn p #|'Ohm_1(R / T)| <= 2 by apply: quotient_p2_Ohm1. - by rewrite IHn ?(leq_trans (ltn_quotient _ _)) ?(nt_pnElem EpT). -have{metaRb} [Xb [cycXb nsXbR cycRs]] := metacyclicP metaRb. -have{cycRs} [yb defRb]: exists yb, R / T = Xb <*> <[yb]>. - have [ys defRs] := cyclicP cycRs; have [yb nXyb def_ys] := cosetP ys. - exists yb; rewrite -quotientYK ?cycle_subG ?quotient_cycle // -def_ys -defRs. - by rewrite quotientGK. -have{sTZ} ntXb: Xb :!=: 1. - apply: contraNneq not_cRR => Xb1. - by rewrite (cyclic_factor_abelian sTZ) // defRb Xb1 joing1G cycle_cyclic. -have [TX defTXb sTTX nsTXR] := inv_quotientN nsTR nsXbR. -have{cycXb} [[sTXR nTXR] [xb defXb]] := (andP nsTXR, cyclicP cycXb). -have [[x nTx def_xb] [y nTy def_yb]] := (cosetP xb, cosetP yb). -have{defTXb} defTX: T <*> <[x]> = TX. - rewrite -quotientYK ?cycle_subG ?quotient_cycle // -def_xb -defXb defTXb. - by rewrite quotientGK // (normalS _ sTXR). -have{yb defRb def_yb} defR: TX <*> <[y]> = R. - rewrite -defTX -joingA -quotientYK ?join_subG ?quotientY ?cycle_subG ?nTx //. - by rewrite !quotient_cycle // -def_xb -def_yb -defXb -defRb quotientGK. -have sXYR: <[x]> <*> <[y]> \subset R by rewrite -defR -defTX -joingA joing_subr. -have [Rx Ry]: x \in R /\ y \in R by rewrite -!cycle_subG; apply/joing_subP. -have cTXY := subset_trans sXYR cTR; have [cTX cTY] := joing_subP cTXY. -have [R'1_1 {e sTR'e} | ntR'1] := eqVneq 'Mho^1(R') 1; last first. - have sR'TX: R' \subset TX. - rewrite der1_min // -defR quotientYidl ?cycle_subG ?(subsetP nTXR) //. - by rewrite quotient_abelian // cycle_abelian. - have sTX : T \subset <[x]>. - rewrite (subset_trans (subset_trans sTR'e (MhoS e sR'TX))) // /e ntR'1. - have{defTX} defTX: T \* <[x]> = TX by rewrite cprodEY // centsC. - rewrite -(Mho_cprod 1 defTX) ['Mho^1(_)](trivgP _) ?cprod1g ?Mho_sub //=. - rewrite (MhoE 1 pT) gen_subG; apply/subsetP=> tp; case/imsetP=> t Tt ->{tp}. - by rewrite inE (exponentP eT). - apply/metacyclicP; exists TX; split=> //. - by rewrite -defTX (joing_idPr sTX) cycle_cyclic. - rewrite -defR quotientYidl ?cycle_subG ?(subsetP nTXR) //. - by rewrite quotient_cyclic ?cycle_cyclic. -have{R'1_1} eR': exponent R' %| p. - have <-: 'Ohm_1(R') = R' by apply/eqP; rewrite trivg_Mho ?R'1_1. - rewrite -sub_LdivT (OhmEabelian (pgroupS sR'R pR)) ?subsetIr //. - by rewrite (abelianS (OhmS 1 sR'R)) // (p2group_abelian pR1). -pose r := [~ x, y]; have Rr: r \in R by apply: groupR. -have{defXb ntXb nsXbR} [i def_rb]: exists i, coset T r = (xb ^+ p) ^+ i. - have p_xb: p.-elt xb by rewrite def_xb morph_p_elt ?(mem_p_elt pR). - have pRbb: p.-group (R / T / 'Mho^1(Xb)) by rewrite !quotient_pgroup. - have /andP[_ nXb1R]: 'Mho^1(Xb) <| R / T by apply: gFnormal_trans. - apply/cycleP; rewrite -(Mho_p_cycle 1 p_xb) -defXb. - apply: coset_idr; first by rewrite (subsetP nXb1R) ?mem_quotient. - apply/eqP; rewrite !morphR ?(subsetP nXb1R) ?mem_quotient //=; apply/commgP. - red; rewrite -(@centerC _ (R / T / _)) ?mem_quotient // -cycle_subG. - rewrite -quotient_cycle ?(subsetP nXb1R) ?mem_quotient // -def_xb -defXb. - suffices oXbb: #|Xb / 'Mho^1(Xb)| = p. - apply: prime_meetG; first by rewrite oXbb. - rewrite (meet_center_nil (pgroup_nil pRbb)) ?quotient_normal //. - by rewrite -cardG_gt1 oXbb. - rewrite -divg_normal ?Mho_normal //= defXb. - rewrite -(mul_card_Ohm_Mho_abelian 1) ?cycle_abelian ?mulnK ?cardG_gt0 //. - by rewrite (Ohm1_cyclic_pgroup_prime _ p_xb) ?cycle_cyclic //= -defXb. -have{xb def_xb def_rb} [t Tt def_r]: exists2 t, t \in T & r = t * x ^+ (p * i). - apply/rcosetP; rewrite -val_coset ?groupX ?morphX //= -def_xb. - by rewrite expgM -def_rb val_coset ?groupR // rcoset_refl. -have{eR' def_r cTT} defR': R' = <[r]>. - have R'r : r \in R' by apply: mem_commg. - have cxt: t \in 'C[x] by apply/cent1P; apply: (centsP cRT). - have crx: x \in 'C[r] by rewrite cent1C def_r groupM ?groupX ?cent1id. - have def_xy: x ^ y = t * x ^+ (p * i).+1. - by rewrite conjg_mulR -/r def_r expgS !mulgA (cent1P cxt). - have crR : R \subset 'C[r]. - rewrite -defR -defTX !join_subG sub_cent1 (subsetP cTR) //= !cycle_subG. - rewrite crx cent1C (sameP cent1P commgP); apply/conjg_fixP. - rewrite def_r conjMg conjXg conjgE (centsP cRT t) // mulKg conjg_mulR -/r. - by rewrite (expgMn _ (cent1P crx)) (expgM r) (exponentP eR') ?expg1n ?mulg1. - apply/eqP; rewrite eqEsubset cycle_subG R'r andbT. - have nrR : R \subset 'N(<[r]>) by rewrite cents_norm ?cent_cycle. - rewrite der1_min // -defR -defTX -joingA. - rewrite norm_joinEr ?(subset_trans sXYR) ?normal_norm //. - rewrite quotientMl ?(subset_trans sTR) // abelianM quotient_abelian //=. - rewrite quotient_cents //= -der1_joing_cycles ?der_abelian //. - by rewrite -sub_cent1 (subset_trans sXYR). -have [S maxS sR'S] : {S | [max S | S \subset R & cyclic S] & R' \subset S}. - by apply: maxgroup_exists; rewrite sR'R /= -/R' defR' cycle_cyclic. -case/maxgroupP: maxS; case/andP=> sSR cycS maxS. -have nsSR: S <| R := sub_der1_normal sR'S sSR; have [_ nSR] := andP nsSR. -apply/existsP; exists S; rewrite cycS nsSR //=. -suffices uniqRs1 Us: Us \in 'E_p^1(R / S) -> 'Ohm_1(R) / S = Us. - have pRs: p.-group (R / S) := quotient_pgroup S pR. - rewrite abelian_rank1_cyclic ?sub_der1_abelian ?(rank_pgroup pRs) // leqNgt. - apply: contraFN (ltnn 1) => rRs; have [Us EpUs] := p_rank_geP (ltnW rRs). - have [Vs EpVs] := p_rank_geP rRs; have [sVsR abelVs <-] := pnElemP EpVs. - have [_ _ <-] := pnElemP EpUs; apply: lognSg; apply/subsetP=> vs Vvs. - apply: wlog_neg => notUvs; rewrite -cycle_subG -(uniqRs1 _ EpUs). - rewrite (uniqRs1 <[vs]>%G) ?p1ElemE // !inE cycle_subG (subsetP sVsR) //=. - by rewrite -orderE (abelem_order_p abelVs Vvs (group1_contra notUvs)). -case/pnElemPcard; rewrite expn1 => sUsR _ oUs. -have [U defUs sSU sUR] := inv_quotientS nsSR sUsR. -have [cycU | {maxS} ncycU] := boolP (cyclic U). - by rewrite -[p]oUs defUs (maxS U) ?sUR // trivg_quotient cards1 in p_gt1. -have EpU1: 'Ohm_1(U)%G \in 'E_p^2(U). - have [u defS] := cyclicP cycS; rewrite defS cycle_subG in sSU. - rewrite (Ohm1_extremal_odd (pgroupS sUR pR) (oddSg sUR oddR) _ sSU) //. - by rewrite -defS -card_quotient -?defUs // (subset_trans sUR). -have defU1: 'Ohm_1(U) = 'Ohm_1(R). - apply/eqP; rewrite eqEcard OhmS // (card_pnElem EpU1). - by rewrite (card_pgroup pR1) leq_exp2l. -apply/eqP; rewrite eqEcard oUs defUs -{1}defU1 quotientS ?Ohm_sub //. -rewrite dvdn_leq ?cardG_gt0 //; case/pgroup_pdiv: (quotient_pgroup S pR1) => //. -rewrite -subG1 quotient_sub1 ?(gFsub_trans _ nSR) //. -apply: contraL (cycS) => sR1S; rewrite abelian_rank1_cyclic ?cyclic_abelian //. -rewrite -ltnNge (rank_pgroup (pgroupS sSR pR)); apply/p_rank_geP. -by exists 'Ohm_1(U)%G; rewrite -(setIidPr sSU) pnElemI inE EpU1 inE /= defU1. -Qed. - -(* This is B & G, Theorem 4.12 (also due to Huppert), for internal action. *) -Theorem coprime_metacyclic_cent_sdprod gT p (R A : {group gT}) : - p.-group R -> odd #|R| -> metacyclic R -> p^'.-group A -> A \subset 'N(R) -> - let T := [~: R, A] in let C := 'C_R(A) in - [/\ (*a*) abelian T, - (*b*) T ><| C = R - & (*c*) ~~ abelian R -> T != 1 -> - [/\ C != 1, cyclic T, cyclic C & R^`(1) \subset T]]. -Proof. -move=> pR oddR metaR p'A nRA T C. -suffices{C T} cTT: abelian [~: R, A]. - have sTR: T \subset R by rewrite commg_subl. - have nTR: R \subset 'N(T) by rewrite commg_norml. - have coRA: coprime #|R| #|A| := pnat_coprime pR p'A. - have solR: solvable R := pgroup_sol pR. - have defR: T * C = R by rewrite coprime_cent_prod. - have sCR: C \subset R := subsetIl _ _; have nTC := subset_trans sCR nTR. - have tiTC: T :&: C = 1. - have defTA: [~: T, A] = T by rewrite coprime_commGid. - have coTA: coprime #|T| #|A| := coprimeSg sTR coRA. - by rewrite setIA (setIidPl sTR) -defTA coprime_abel_cent_TI ?commg_normr. - split=> // [|not_cRR ntT]; first by rewrite sdprodE. - have ntC: C != 1 by apply: contraNneq not_cRR => C1; rewrite -defR C1 mulg1. - suffices [cycT cycC]: cyclic T /\ cyclic C. - split=> //; rewrite der1_min //= -/T -defR quotientMidl. - by rewrite cyclic_abelian ?quotient_cyclic. - have [pT pC]: p.-group T /\ p.-group C by rewrite !(pgroupS _ pR). - apply/andP; rewrite (odd_pgroup_rank1_cyclic pC (oddSg sCR oddR)). - rewrite abelian_rank1_cyclic // -rank_pgroup //. - rewrite -(geq_leqif (leqif_add (leqif_geq _) (leqif_geq _))) ?rank_gt0 //. - have le_rTC_dimTC1: 'r(T) + 'r(C) <= logn p #|'Ohm_1(T) * 'Ohm_1(C)|. - rewrite (rank_pgroup pC) -p_rank_Ohm1 (rank_abelian_pgroup pT cTT). - rewrite TI_cardMg; last by apply/trivgP; rewrite -tiTC setISS ?Ohm_sub. - by rewrite lognM ?cardG_gt0 // leq_add2l p_rank_le_logn. - apply: leq_trans le_rTC_dimTC1 _; rewrite add1n. - have ncycR: ~~ cyclic R by apply: contra not_cRR; apply: cyclic_abelian. - have: 'Ohm_1(R)%G \in 'E_p^2(R) by apply: Ohm1_metacyclic_p2Elem. - have nT1C1: 'Ohm_1(C) \subset 'N('Ohm_1(T)). - by rewrite gFsub_trans ?gFnorm_trans. - by case/pnElemP=> _ _ <-; rewrite -norm_joinEr ?lognSg // join_subG !OhmS. -without loss defR: R pR oddR metaR nRA / [~: R, A] = R. - set T := [~: R, A] => IH; have sTR: T \subset R by rewrite commg_subl. - have defTA: [~: T, A] = T. - by rewrite coprime_commGid ?(pgroup_sol pR) ?(pnat_coprime pR). - rewrite -defTA IH ?(pgroupS sTR) ?(oddSg sTR) ?(metacyclicS sTR) //. - exact: commg_normr. -rewrite defR; apply: wlog_neg => not_cRR. -have ncycR: ~~ cyclic R := contra (@cyclic_abelian _ R) not_cRR. -pose cycR_nA S := [&& cyclic S, S \subset R & A \subset 'N(S)]. -have [S maxS sR'S] : {S | [max S | cycR_nA S] & R^`(1) \subset S}. - apply: maxgroup_exists; rewrite {}/cycR_nA der_sub /= gFnorm_trans // andbT. - have [K [cycK nsKR cycKR]] := metacyclicP metaR. - by rewrite (cyclicS _ cycK) // der1_min ?normal_norm // cyclic_abelian. -have{maxS} [/and3P[cycS sSR nSA] maxS] := maxgroupP maxS. -have ntS: S :!=: 1 by rewrite (subG1_contra sR'S) // (sameP eqP derG1P). -have nSR: R \subset 'N(S) := sub_der1_norm sR'S sSR. -have nsSR: S <| R by apply/andP. -have sSZ: S \subset 'Z(R). - have sR_NS': R \subset 'N(S)^`(1) by rewrite -{1}defR commgSS. - rewrite subsetI sSR centsC (subset_trans sR_NS') // der1_min ?cent_norm //=. - rewrite -ker_conj_aut (isog_abelian (first_isog _)). - by rewrite (abelianS (Aut_conj_aut _ _)) ?Aut_cyclic_abelian. -have cRbRb: abelian (R / S) by rewrite sub_der1_abelian. -have pRb: p.-group (R / S) := quotient_pgroup S pR. -pose R1 := 'Ohm_1(R); pose Rb1 := 'Ohm_1(R / S). -have [Xb]: exists2 Xb, R1 / S \x gval Xb = Rb1 & A / S \subset 'N(Xb). - have MaschkeRb1 := Maschke_abelem (Ohm1_abelem pRb cRbRb). - pose normOhm1 := (morphim_Ohm, gFnorm_trans, quotient_norms S). - by apply: MaschkeRb1; rewrite ?quotient_pgroup ?normOhm1. -case/dprodP=> _ defRb1 _ tiR1bX nXbA. -have sXbR: Xb \subset R / S. - by apply: subset_trans (Ohm_sub 1 _); rewrite -defRb1 mulG_subr. -have{sXbR} [X defXb sSX sXR] := inv_quotientS nsSR sXbR. -have{nXbA nsSR} nXA: A \subset 'N(X). - rewrite (subset_trans (mulG_subr S A)) // -quotientK //. - by rewrite -(quotientGK (normalS sSX sXR nsSR)) -defXb morphpre_norms. -have{tiR1bX} cycX: cyclic X. - have sX1_XR1: 'Ohm_1(X) \subset X :&: R1 by rewrite subsetI Ohm_sub OhmS. - have cyc_sR := odd_pgroup_rank1_cyclic (pgroupS _ pR) (oddSg _ oddR). - have:= cycS; rewrite !{}cyc_sR //; apply: leq_trans. - rewrite -p_rank_Ohm1 p_rankS // (subset_trans sX1_XR1) //. - rewrite -quotient_sub1 ?subIset ?(subset_trans sXR) //. - by rewrite quotientGI // setIC -defXb tiR1bX. -rewrite (cyclic_factor_abelian sSZ) // abelian_rank1_cyclic //. -rewrite (rank_abelian_pgroup pRb cRbRb) -defRb1 defXb. -rewrite (maxS X) ?trivg_quotient ?mulg1 //; last exact/and3P. -have EpR1: 'Ohm_1(R)%G \in 'E_p^2(R) by apply: Ohm1_metacyclic_p2Elem. -have [sR1R _ dimR1] := pnElemP EpR1; have pR1 := pgroupS sR1R pR. -rewrite -(card_isog (second_isog _)) ?(subset_trans sR1R) // -ltnS -dimR1. -by rewrite (ltn_log_quotient pR1) ?subsetIr //= meet_Ohm1 // (setIidPl sSR). -Qed. - -(* This covers B & G, Lemmas 4.13 and 4.14. *) -Lemma pi_Aut_rank2_pgroup gT p q (R : {group gT}) : - p.-group R -> odd #|R| -> 'r(R) <= 2 -> q \in \pi(Aut R) -> q != p -> - [/\ q %| (p ^ 2).-1, q < p & q %| p.+1./2 \/ q %| p.-1./2]. -Proof. -move=> pR oddR rR q_Ar p'q; rewrite /= in q_Ar. -have [R1 | ntR] := eqsVneq R 1; first by rewrite R1 Aut1 cards1 in q_Ar. -have{ntR} [p_pr p_dv_R _] := pgroup_pdiv pR ntR. -have{oddR p_dv_R} [p_odd p_gt1] := (dvdn_odd p_dv_R oddR, prime_gt1 p_pr). -have{q_Ar} [q_pr q_dv_Ar]: prime q /\ q %| #|Aut R|. - by move: q_Ar; rewrite mem_primes; case/and3P. -suffices q_dv_p2: q %| (p ^ 2).-1. - have q_dv_p1: q %| p.+1./2 \/ q %| p.-1./2. - apply/orP; have:= q_dv_p2; rewrite -subn1 (subn_sqr p 1). - rewrite -[p]odd_double_half p_odd /= !doubleK addKn addn1 -doubleS -!mul2n. - rewrite mulnC !Euclid_dvdM // dvdn_prime2 // -orbA; case: eqP => // -> _. - by rewrite -Euclid_dvdM // /dvdn modn2 mulnC odd_mul andbN. - have p_gt2: p > 2 by rewrite ltn_neqAle; case: eqP p_odd => // <-. - have p1_ltp: p.+1./2 < p. - by rewrite -divn2 ltn_divLR // muln2 -addnn -addn2 leq_add2l. - split=> //; apply: leq_ltn_trans p1_ltp. - move/orP: q_dv_p1; rewrite -(subnKC p_gt2) leqNgt. - by apply: contraL => lt_p1q; rewrite negb_or !gtnNdvd // ltnW. -wlog{q_dv_Ar} [a oa nRa]: gT R pR rR / {a | #[a] = q & a \in 'N(R) :\: 'C(R)}. - have [a Ar_a oa] := Cauchy q_pr q_dv_Ar. - rewrite -(injm_rank (injm_sdpair1 [Aut R])) // in rR. - move=> IH; apply: IH rR _; rewrite ?morphim_pgroup ?morphim_odd //. - exists (sdpair2 [Aut R] a); rewrite ?(order_injm (injm_sdpair2 _)) //. - rewrite inE (subsetP (im_sdpair_norm _)) ?mem_morphim //= andbT. - apply: contraL (prime_gt1 q_pr) => cRa; rewrite -oa order_gt1 negbK. - apply/eqP; apply: (eq_Aut Ar_a (group1 _)) => x Rx. - by rewrite perm1 [a x](@astab_act _ _ _ [Aut R] R) ?astabEsd ?mem_morphpre. -move: {2}_.+1 (ltnSn #|R|) => n. -elim: n => // n IHn in gT a R pR rR nRa oa *; rewrite ltnS => leRn. -case recR: [exists (S : {group gT} | S \proper R), a \in 'N(S) :\: 'C(S)]. - have [S ltSR nSa] := exists_inP recR; rewrite properEcard in ltSR. - have{ltSR} [sSR ltSR] := andP ltSR; have rS := leq_trans (rankS sSR) rR. - by apply: IHn nSa oa _; rewrite ?(pgroupS sSR) ?(leq_trans ltSR). -do [rewrite inE -!cycle_subG orderE; set A := <[a]>] in nRa oa. -have{nRa oa} [[not_cRA nRA] oA] := (andP nRa, oa). -have coRA : coprime #|R| #|A| by rewrite oA (pnat_coprime pR) ?pnatE. -have{recR} IH: forall S, gval S \proper R -> A \subset 'N(S) -> A \subset 'C(S). - move=> S ltSR; rewrite !cycle_subG => nSa; apply: contraFT recR => not_cSa. - by apply/exists_inP; exists S; rewrite // inE not_cSa nSa. -have defR1: 'Ohm_1(R) = R. -apply: contraNeq not_cRA; rewrite eqEproper Ohm_sub negbK => ltR1R. - rewrite (coprime_odd_faithful_Ohm1 pR) ?IH ?(odd_pgroup_odd p_odd) //. - exact: gFnorm_trans. -have defRA: [~: R, A] = R. - apply: contraNeq not_cRA; rewrite eqEproper commg_subl nRA negbK => ltRAR. - rewrite centsC; apply/setIidPl. - rewrite -{2}(coprime_cent_prod nRA) ?(pgroup_sol pR) //. - by rewrite mulSGid // subsetI commg_subl nRA centsC IH ?commg_normr. -have [cRR | not_cRR] := boolP (abelian R). - rewrite -subn1 (subn_sqr p 1) Euclid_dvdM //. - have abelR: p.-abelem R by rewrite -defR1 Ohm1_abelem. - have ntR: R :!=: 1 by apply: contraNneq not_cRA => ->; apply: cents1. - pose rAR := reprGLm (abelem_repr abelR ntR nRA). - have:= cardSg (subsetT (rAR @* A)); rewrite card_GL ?card_Fp //. - rewrite card_injm ?ker_reprGLm ?rker_abelem ?prime_TIg ?oA // unlock. - rewrite Gauss_dvdr; last by rewrite coprime_expr ?prime_coprime ?dvdn_prime2. - move: rR; rewrite -ltnS -[_ < _](mem_iota 0) !inE eqn0Ngt rank_gt0 ntR. - rewrite (dim_abelemE abelR ntR) (rank_abelem abelR). - do [case/pred2P=> ->; rewrite /= muln1] => [-> // | ]. - by rewrite (subn_sqr p 1) mulnA !Euclid_dvdM ?orbb. -have [[defPhi defR'] _]: special R /\ 'C_R(A) = 'Z(R). - apply: (abelian_charsimple_special pR) => //. - apply/bigcupsP=> S /andP[charS cSS]. - rewrite centsC IH ?(char_norm_trans charS) // properEneq char_sub // andbT. - by apply: contraNneq not_cRR => <-. -have ntZ: 'Z(R) != 1 by rewrite -defR' (sameP eqP derG1P). -have ltRbR: #|R / 'Z(R)| < #|R| by rewrite ltn_quotient ?center_sub. -have pRb: p.-group (R / 'Z(R)) by apply: quotient_pgroup. -have nAZ: A \subset 'N('Z(R)) by apply: gFnorm_trans. -have defAb: A / 'Z(R) = <[coset _ a]> by rewrite quotient_cycle -?cycle_subG. -have oab: #[coset 'Z(R) a] = q. - rewrite orderE -defAb -(card_isog (quotient_isog _ _)) //. - by rewrite coprime_TIg ?(coprimeSg (center_sub R)). -have rRb: 'r(R / 'Z(R)) <= 2. - rewrite (rank_pgroup pRb) (leq_trans (p_rank_le_logn _ _)) // -ltnS. - apply: leq_trans (rank2_exponent_p_p3group pR rR _). - by rewrite -(ltn_exp2l _ _ p_gt1) -!card_pgroup. - by rewrite -defR1 (exponent_Ohm1_class2 p_odd) // nil_class2 defR'. -apply: IHn oab (leq_trans ltRbR leRn) => //. -rewrite inE -!cycle_subG -defAb quotient_norms ?andbT //. -apply: contra not_cRA => cRAb; rewrite (coprime_cent_Phi pR coRA) // defPhi. -by rewrite commGC -quotient_cents2 ?gFnorm. -Qed. - -(* B & G, Lemma 4.15 is covered by maximal/critical_extraspecial. *) - -(* This is B & G, Theorem 4.16 (due to Blackburn). *) -Theorem rank2_coprime_comm_cprod gT p (R A : {group gT}) : - p.-group R -> odd #|R| -> R :!=: 1 -> 'r(R) <= 2 -> - [~: R, A] = R -> p^'.-group A -> odd #|A| -> - [/\ p > 3 - & [\/ abelian R - | exists2 S : {group gT}, - [/\ ~~ abelian S, logn p #|S| = 3 & exponent S %| p] - & exists C : {group gT}, - [/\ S \* C = R, cyclic C & 'Ohm_1(C) = S^`(1)]]]. -Proof. -move=> pR oddR ntR rR defRA p'A oddA. -have [p_pr _ _] := pgroup_pdiv pR ntR; have p_gt1 := prime_gt1 p_pr. -have nilR: nilpotent R := pgroup_nil pR. -have nRA: A \subset 'N(R) by rewrite -commg_subl defRA. -have p_gt3: p > 3; last split => //. - have [Ab1 | [q q_pr q_dv_Ab]] := trivgVpdiv (A / 'C_A(R)). - case/eqP: ntR; rewrite -defRA commGC; apply/commG1P. - by rewrite -subsetIidl -quotient_sub1 ?Ab1 ?normsI ?norms_cent ?normG. - have odd_q := dvdn_odd q_dv_Ab (quotient_odd _ oddA). - have p'q := pgroupP (quotient_pgroup _ p'A) q q_pr q_dv_Ab. - have q_gt1: q > 1 := prime_gt1 q_pr. - have q_gt2: q > 2 by rewrite ltn_neqAle; case: eqP odd_q => // <-. - apply: leq_ltn_trans q_gt2 _. - rewrite /= -ker_conj_aut (card_isog (first_isog_loc _ _)) // in q_dv_Ab. - have q_dv_A := dvdn_trans q_dv_Ab (cardSg (Aut_conj_aut _ _)). - by case/(pi_Aut_rank2_pgroup pR): (pgroupP (pgroup_pi _) q q_pr q_dv_A). -pose S := 'Ohm_1(R); pose S' := S^`(1); pose C := 'C_R(S). -have pS: p.-group S := pgroupS (Ohm_sub 1 _) pR. -have nsSR: S <| R := gFnormal _ R. -have nsS'R: S' <| R := gFnormal_trans _ nsSR. -have [sSR nSR] := andP nsSR; have [_ nS'R] := andP nsS'R. -have [Sle2 | Sgt2] := leqP (logn p #|S|) 2. - have metaR: metacyclic R := p2_Ohm1_metacyclic pR p_gt3 Sle2. - have [cRR _ _] := coprime_metacyclic_cent_sdprod pR oddR metaR p'A nRA. - by left; rewrite -defRA. -have{p_gt3} eS: exponent S %| p by apply: exponent_Ohm1_rank2. -have{rR} rS: 'r(S) <= 2 by rewrite rank_Ohm1. -have{Sgt2} dimS: logn p #|S| = 3. - by apply/eqP; rewrite eqn_leq rank2_exponent_p_p3group. -have{rS} not_cSS: ~~ abelian S. - by apply: contraL rS => cSS; rewrite -ltnNge -dimS -rank_abelem ?abelem_Ohm1. -have esS: extraspecial S by apply: (p3group_extraspecial pS); rewrite ?dimS. -have defS': S' = 'Z(S) by case: esS; case. -have oS': #|S'| = p by rewrite defS' (card_center_extraspecial pS esS). -have dimS': logn p #|S'| = 1%N by rewrite oS' (pfactorK 1). -have nsCR: C <| R := normalGI nSR (cent_normal _); have [sCR nCR] := andP nsCR. -have [pC oddC]: p.-group C * odd #|C| := (pgroupS sCR pR, oddSg sCR oddR). -have defC1: 'Ohm_1(C) = S'. - apply/eqP; rewrite eqEsubset defS' subsetI OhmS ?(OhmE 1 pC) //= -/C. - by rewrite gen_subG setIAC subsetIr sub_gen ?setSI // subsetI sSR sub_LdivT. -have{pC oddC} cycC: cyclic C. - rewrite (odd_pgroup_rank1_cyclic pC) //. - by rewrite -p_rank_Ohm1 defC1 -dimS' p_rank_le_logn. -pose T := [~: S, R]; have nsTR: T <| R by rewrite /normal commg_normr comm_subG. -have [sTR nTR] := andP nsTR; have pT: p.-group T := pgroupS sTR pR. -have [sTS' | not_sTS' {esS}] := boolP (T \subset S'). - right; exists [group of S] => //; exists [group of C]. - by rewrite (critical_extraspecial pR sSR esS sTS'). -have ltTS: T \proper S by rewrite (nil_comm_properl nilR) ?Ohm1_eq1 ?subsetIidl. -have sTS: T \subset S := proper_sub ltTS. -have [sS'T ltS'T]: S' \subset T /\ S' \proper T by rewrite /proper commgS. -have{ltS'T ltTS} dimT: logn p #|T| = 2. - by apply/eqP; rewrite eqn_leq -ltnS -dimS -dimS' !properG_ltn_log. -have{eS} eT: exponent T %| p := dvdn_trans (exponentS sTS) eS. -have cTT: abelian T by rewrite (p2group_abelian pT) ?dimT. -have abelT: p.-abelem T by apply/and3P. -pose B := 'C_R(T); have sTB: T \subset B by rewrite subsetI sTR. -have nsBR: B <| R := normalGI nTR (cent_normal _); have [sBR nBR] := andP nsBR. -have not_sSB: ~~ (S \subset B). - by rewrite defS' !subsetI sTS sSR centsC in not_sTS' *. -have maxB: maximal B R. - rewrite p_index_maximal // (_ : #|R : B| = p) //; apply/prime_nt_dvdP=> //. - by apply: contra not_sSB; rewrite indexg_eq1; apply: subset_trans. - rewrite -(part_pnat_id (pnat_dvd (dvdn_indexg _ _) pR)) p_part. - by rewrite (@dvdn_exp2l _ _ 1) // logn_quotient_cent_abelem ?dimT //. -have{maxB nsBR} defR: B * S = R := mulg_normal_maximal nsBR maxB sSR not_sSB. -have cBbBb: abelian (B / C). - rewrite sub_der1_abelian // subsetI comm_subG ?subsetIl //=; apply/commG1P. - suff cB_SB: [~: S, B, B] = 1 by rewrite three_subgroup // [[~: _, S]]commGC. - by apply/commG1P; rewrite centsC subIset // centS ?orbT // commgS. -have{cBbBb} abelBb: p.-abelem (B / C). - apply/abelemP=> //; split=> // Cg; case/morphimP=> x Nx Bx /= ->. - have [Rx cTx] := setIP Bx; rewrite -morphX //= coset_id // inE groupX //=. - apply/centP=> y Sy; symmetry; have Tyx : [~ y, x] \in T by apply: mem_commg. - by apply/commgP; rewrite commgX ?(exponentP eT) //; apply: (centP cTx). -have nsCB: C <| B by rewrite (normalS _ _ nsCR) ?setIS ?subsetIl // centS. -have p'Ab: p^'.-group (A / C) by apply: quotient_pgroup. -have sTbB: T / C \subset B / C by rewrite quotientS. -have nSA: A \subset 'N(S) := gFnorm_trans _ nRA. -have nTA: A \subset 'N(T) := normsR nSA nRA. -have nTbA: A / C \subset 'N(T / C) := quotient_norms _ nTA. -have nBbA: A / C \subset 'N(B / C). - by rewrite quotient_norms ?normsI ?norms_cent. -have{p'Ab sTbB nBbA abelBb nTbA} - [Xb defBb nXbA] := Maschke_abelem abelBb p'Ab sTbB nBbA nTbA. -have{defBb} [_] := dprodP defBb; rewrite /= -/T -/B => defBb _ tiTbX. -have sXbB: Xb \subset B / C by rewrite -defBb mulG_subr. -have{sXbB} [X] := inv_quotientS nsCB sXbB; rewrite /= -/C -/B => defXb sCX sXB. -have sXR: X \subset R := subset_trans sXB sBR; have pX := pgroupS sXR pR. -have nsCX: C <| X := normalS sCX sXR nsCR. -have{tiTbX} ziTX: T :&: X \subset C. - rewrite -quotient_sub1 ?subIset ?(subset_trans sTR) ?normal_norm //= -/C. - by rewrite quotientIG -?defXb ?tiTbX. -have{nXbA} nXA: A \subset 'N(X). - have nCA: A \subset 'N(C) by rewrite normsI ?norms_cent. - by rewrite -(quotientSGK nCA) ?normsG // quotient_normG -?defXb. -have{abelT} defB1: 'Ohm_1(B) = T. - apply/eqP; rewrite eq_sym eqEcard -{1}[T](Ohm1_id abelT) OhmS //. - have pB1: p.-group 'Ohm_1(B) by apply: pgroupS pR; apply: gFsub_trans. - rewrite (card_pgroup pT) (card_pgroup pB1) leq_exp2l //= -/T -/B. - rewrite dimT -ltnS -dimS properG_ltn_log // properEneq OhmS ?subsetIl //= -/S. - by case: eqP not_sSB => // <-; rewrite Ohm_sub. -have{ziTX defB1} cycX: cyclic X; last have [x defX]:= cyclicP cycX. - rewrite (odd_pgroup_rank1_cyclic pX (oddSg sXR oddR)) -p_rank_Ohm1. - have:= cycC; rewrite abelian_rank1_cyclic ?cyclic_abelian //= -/C. - apply: leq_trans (leq_trans (p_rank_le_rank p _) (rankS _)). - by apply: subset_trans ziTX; rewrite subsetI Ohm_sub -defB1 OhmS. -have{Xb defXb defBb nsCX} mulSX: S * X = R. - have nCT: T \subset 'N(C) := subset_trans sTR nCR. - rewrite -defR -(normC (subset_trans sSR nBR)) -[B](quotientGK nsCB) -defBb. - rewrite cosetpreM quotientK // defXb quotientGK // -(normC nCT). - by rewrite -mulgA (mulSGid sCX) mulgA (mulGSid sTS). -have{mulSX} not_sXS_S': ~~ ([~: X, S] \subset S'). - apply: contra not_sTS' => sXS_S'; rewrite /T -mulSX. - by rewrite commGC commMG ?(subset_trans sXR) // mul_subG. -have [oSb oTb] : #|S / T| = p /\ #|T / S'| = p. - rewrite (card_pgroup (quotient_pgroup _ pS)) -divg_normal ?(normalS _ sSR) //. - rewrite (card_pgroup (quotient_pgroup _ pT)) -divg_normal ?(normalS _ sTR) //. - by rewrite !logn_div ?cardSg // dimS dimT dimS'. -have [Ty defSb]: exists Ty, S / T = <[Ty]>. - by apply/cyclicP; rewrite prime_cyclic ?oSb. -have SbTy: Ty \in S / T by rewrite defSb cycle_id. -have{SbTy} [y nTy Sy defTy] := morphimP SbTy. -have [S'z defTb]: exists S'z, T / S' = <[S'z]>. - apply/cyclicP; rewrite prime_cyclic ?oTb //. -have TbS'z: S'z \in T / S' by rewrite defTb cycle_id. -have{TbS'z} [z nS'z Tz defS'z] := morphimP TbS'z. -have [Ta AbTa not_cSbTa]: exists2 Ta, Ta \in A / T & Ta \notin 'C(S / T). - apply: subsetPn; rewrite quotient_cents2 ?commg_norml //= -/T commGC. - apply: contra not_sSB => sSA_T; rewrite (subset_trans sSR) // -defRA -defR. - rewrite -(normC (subset_trans sSR nBR)) commMG /= -/S -/B; last first. - by rewrite cents_norm ?subIset ?centS ?orbT. - by rewrite mul_subG ?commg_subl ?normsI ?norms_cent // (subset_trans sSA_T). -have [a nTa Aa defTa] := morphimP AbTa. -have nS'a: a \in 'N(S') := subsetP (gFnorm_trans _ nSA) a Aa. -have [i xa]: exists i, x ^ a = x ^+ i. - by apply/cycleP; rewrite -cycle_subG cycleJ /= -defX (normsP nXA). -have [j Tya]: exists j, Ty ^ Ta = Ty ^+ j. - apply/cycleP; rewrite -cycle_subG cycleJ /= -defSb. - by rewrite (normsP (quotient_norms _ nSA)). -suffices {oSb oddA not_cSbTa} j2_1: j ^ 2 == 1 %[mod p]. - have Tya2: Ty ^ coset T (a ^+ 2) = Ty ^+ (j ^ 2). - by rewrite morphX // conjgM -defTa Tya conjXg Tya expgM. - have coA2: coprime #|A| 2 by rewrite coprime_sym prime_coprime // dvdn2 oddA. - case/negP: not_cSbTa; rewrite defTa -(expgK coA2 Aa) morphX groupX //=. - rewrite defSb cent_cycle inE conjg_set1 Tya2 sub1set inE. - by rewrite (eq_expg_mod_order _ _ 1) orderE -defSb oSb. -have {Tya Ta defTa AbTa} [u Tu yj]: exists2 u, u \in T & y ^+ j = u * y ^ a. - apply: rcosetP; apply/rcoset_kercosetP; rewrite ?groupX ?groupJ //. - by rewrite morphX ?morphJ -?defTy // -defTa. -have{Ty defTy defSb} defS: T * <[y]> = S. - rewrite -quotientK ?cycle_subG ?quotient_cycle // -defTy -defSb /= -/T. - by rewrite quotientGK // /normal sTS /= commg_norml. -have{nTA} [k S'zk]: exists k, S'z ^ coset S' a = S'z ^+ k. - apply/cycleP; rewrite -cycle_subG cycleJ /= -defTb. - by rewrite (normsP (quotient_norms _ nTA)) ?mem_quotient. -have S'yz: [~ y, z] \in S' by rewrite mem_commg // (subsetP sTS). -have [v Zv zk]: exists2 v, v \in 'Z(S) & z ^+ k = v * z ^ a. - apply: rcosetP; rewrite -defS'. - by apply/rcoset_kercosetP; rewrite ?groupX ?groupJ ?morphX ?morphJ -?defS'z. -have defT: S' * <[z]> = T. - rewrite -quotientK ?cycle_subG ?quotient_cycle // -defS'z -defTb /= -/S'. - by rewrite quotientGK // (normalS _ sTR) // proper_sub. -have nt_yz: [~ y, z] != 1. - apply: contra not_cSS; rewrite (sameP commgP cent1P) => cyz. - rewrite -defS abelianM cTT cycle_abelian /= -/T -defT centM /= -/S' defS'. - by rewrite cent_cycle subsetI centsC subIset ?centS ?cycle_subG ?orbT. -have sS'X1: S' \subset 'Ohm_1(X) by rewrite -defC1 OhmS. -have i_neq0: i != 0 %[mod p]. - have: 'Ohm_1(X) != 1 by rewrite (subG1_contra sS'X1) //= -cardG_gt1 oS'. - rewrite defX in pX *; rewrite (Ohm_p_cycle 1 pX) subn1 trivg_card1 -orderE. - rewrite -(orderJ _ a) conjXg xa order_eq1 -expgM -order_dvdn mod0n. - apply: contra; case/dvdnP=> m ->; rewrite -mulnA -expnS dvdn_mull //. - by rewrite {1}[#[x]](card_pgroup pX) dvdn_exp2l ?leqSpred. -have Txy: [~ x, y] \in T by rewrite [T]commGC mem_commg // -cycle_subG -defX. -have [Rx Ry]: x \in R /\ y \in R by rewrite -cycle_subG -defX (subsetP sSR). -have [nS'x nS'y] := (subsetP nS'R x Rx, subsetP nS'R y Ry). -have{not_sXS_S'} not_S'xy: [~ x, y] \notin S'. - apply: contra not_sXS_S' => S'xy. - rewrite -quotient_cents2 ?(subset_trans _ nS'R) //= -/S'. - rewrite -defS quotientMl ?(subset_trans _ nS'R) // centM /= -/S' -/T. - rewrite subsetI quotient_cents; last by rewrite (subset_trans sXB) ?subsetIr. - rewrite defX !quotient_cycle // cent_cycle cycle_subG /= -/S'. - by rewrite (sameP cent1P commgP) -morphR /= ?coset_id. -have jk_eq_i: j * k = i %[mod p]. - have Zyz: [~ y, z] \in 'Z(S) by rewrite -defS'. - have Sz: z \in S := subsetP sTS z Tz. - have yz_p: [~ y, z] ^+ p == 1 by rewrite -order_dvdn -oS' order_dvdG. - have <-: #[[~ y, z]] = p by apply: nt_prime_order => //; apply: eqP. - apply: eqP; rewrite -eq_expg_mod_order -commXXg; try exact: centerC Zyz. - have cyv: [~ y ^+ j, v] = 1 by apply/eqP/commgP/(centerC (groupX j Sy) Zv). - have cuz: [~ u, z ^ a] = 1. - by apply/eqP/commgP/(centsP cTT); rewrite ?memJ_norm. - rewrite zk commgMJ cyv yj commMgJ cuz !conj1g mulg1 mul1g -conjRg. - suffices [m ->]: exists m, [~ y, z] = x ^+ m by rewrite conjXg xa expgAC. - by apply/cycleP; rewrite -defX (subsetP (Ohm_sub 1 X)) ?(subsetP sS'X1). -have ij_eq_k: i * j = k %[mod p]. - have <-: #[coset S' [~ x, y]] = p. - apply: nt_prime_order => //. - by apply: eqP; rewrite -order_dvdn -oTb order_dvdG 1?mem_quotient. - by apply: contraNneq not_S'xy; apply: coset_idr; rewrite groupR. - have sTbZ: T / S' \subset 'Z(R / S'). - rewrite prime_meetG ?oTb // (meet_center_nil (quotient_nil _ nilR)) //. - by rewrite quotient_normal //; apply/andP. - by rewrite -cardG_gt1 oTb. - have ZRxyb: [~ coset S' x, coset S' y] \in 'Z(R / S'). - by rewrite -morphR // (subsetP sTbZ) ?mem_quotient. - apply: eqP; rewrite -eq_expg_mod_order {1}morphR //. - rewrite -commXXg; try by apply: centerC ZRxyb; apply: mem_quotient. - have [Ru nRa] := (subsetP sTR u Tu, subsetP nRA a Aa). - rewrite -2?morphX // yj morphM ?(subsetP nS'R) ?memJ_norm //. - have cxu_b: [~ coset S' (x ^+ i), coset S' u] = 1. - apply: eqP; apply/commgP. - by apply: centerC (subsetP sTbZ _ _); rewrite mem_quotient ?groupX. - rewrite commgMJ cxu_b conj1g mulg1 -xa !morphJ // -conjRg -morphR //=. - have: coset S' [~ x, y] \in <[S'z]> by rewrite -defTb mem_quotient. - by case/cycleP=> m ->; rewrite conjXg S'zk expgAC. -have j2_gt0: j ^ 2 > 0. - rewrite expn_gt0 orbF lt0n; apply: contraNneq i_neq0 => j0. - by rewrite -jk_eq_i j0. -have{i_neq0} co_p_i: coprime p i by rewrite mod0n prime_coprime in i_neq0 *. -rewrite eqn_mod_dvd // -(Gauss_dvdr _ co_p_i) mulnBr -eqn_mod_dvd ?leq_mul //. -by rewrite muln1 mulnCA -modnMmr ij_eq_k modnMmr jk_eq_i. -Qed. - -(* This is B & G, Theorem 4.17. *) -Theorem der1_Aut_rank2_pgroup gT p (R : {group gT}) (A : {group {perm gT}}) : - p.-group R -> odd #|R| -> 'r(R) <= 2 -> - A \subset Aut R -> solvable A -> odd #|A| -> - p.-group A^`(1). -Proof. -move=> pR oddR rR AutA solA oddA. -without loss ntR: / R :!=: 1. - case: eqP AutA => [-> | ntR _ -> //]; rewrite Aut1. - by move/trivgP=> ->; rewrite derg1 commG1 pgroup1. -have [p_pr _ _] := pgroup_pdiv pR ntR; have p_gt1 := prime_gt1 p_pr. -have{ntR oddR} [H [charH _] _ eH pCH] := critical_odd pR oddR ntR. -have sHR := char_sub charH; have pH := pgroupS sHR pR. -have{rR} rH: 'r(H) <= 2 := leq_trans (rankS (char_sub charH)) rR. -have dimH: logn p #|H| <= 3 by rewrite rank2_exponent_p_p3group ?eH. -have{eH} ntH: H :!=: 1 by rewrite trivg_exponent eH gtnNdvd. -have charP := Phi_char H; have [sPH nPH] := andP (Phi_normal H : 'Phi(H) <| H). -have nHA: {acts A, on group H | [Aut R]} := gacts_char _ AutA charH. -pose B := 'C(H | <[nHA]>); pose V := H / 'Phi(H); pose C := 'C(V | <[nHA]> / _). -have{pCH} pB: p.-group B. - by rewrite (pgroupS _ pCH) //= astab_actby setIid subsetIr. -have s_p'C_B X: gval X \subset C -> p^'.-group X -> X \subset B. - move=> sXC p'X; have [sDX _] := subsetIP sXC; have [sXA _] := subsetIP sDX. - rewrite -gacentC //; apply/setIidPl; rewrite -[H :&: _]genGid //. - apply: Phi_nongen; apply/eqP; rewrite eqEsubset join_subG sPH subsetIl. - rewrite -quotientYK 1?subIset ?nPH //= -sub_quotient_pre //= -/V gacentIim. - have pP := pgroupS sPH pH; have coPX := pnat_coprime pP p'X. - rewrite -(setIid X) -(gacent_ract _ sXA). - rewrite ext_coprime_quotient_cent ?(pgroup_sol pP) ?acts_char //. - have domXb: X \subset qact_dom (<[nHA]> \ sXA) 'Phi(H). - by rewrite qact_domE ?acts_char. - rewrite gacentE // subsetIidl -/V; apply/subsetP=> v Vv; apply/afixP=> a Xa. - have [cVa dom_a] := (subsetP sXC a Xa, subsetP domXb a Xa). - have [x Nx Hx def_v] := morphimP Vv; rewrite {1}def_v qactE //=. - by rewrite -qactE ?(astab_dom cVa) ?(astab_act cVa) -?def_v. -have{B pB s_p'C_B} pC : p.-group C. - apply/pgroupP=> q q_pr /Cauchy[] // a Ca oa; apply: wlog_neg => p'q. - apply: (pgroupP pB) => //; rewrite -oa cardSg // s_p'C_B ?cycle_subG //. - by rewrite /pgroup -orderE oa pnatE. -have nVA: A \subset qact_dom <[nHA]> 'Phi(H) by rewrite qact_domE // acts_char. -have nCA: A \subset 'N(C). - by rewrite (subset_trans _ (astab_norm _ _)) // astabs_range. -suffices{pC nCA}: p.-group (A / C)^`(1). - by rewrite -quotient_der ?pquotient_pgroup // gFsub_trans. -pose toAV := ((<[nHA]> / 'Phi(H)) \ nVA)%gact. -have defC: C = 'C(V | toAV). - by symmetry; rewrite astab_ract; apply/setIidPr; rewrite subIset ?subsetIl. -have abelV: p.-abelem V := Phi_quotient_abelem pH. -have ntV: V != 1 by rewrite -subG1 quotient_sub1 // proper_subn ?Phi_proper. -have: 'r(V) \in iota 1 2. - rewrite mem_iota rank_gt0 ntV (rank_abelem abelV). - have [abelH | not_abelH] := boolP (p.-abelem H). - by rewrite ltnS (leq_trans _ rH) // (rank_abelem abelH) logn_quotient. - by rewrite (leq_trans _ dimH) // ltn_log_quotient // (trivg_Phi pH). -rewrite !inE; case/pred2P=> dimV. - have isoAb: A / C \isog actperm toAV @* A. - by rewrite defC astab_range -ker_actperm first_isog. - rewrite (derG1P _) ?pgroup1 // (isog_abelian isoAb). - apply: abelianS (im_actperm_Aut _) (Aut_cyclic_abelian _). - by rewrite (abelem_cyclic abelV) -rank_abelem ?dimV. -pose Vb := sdpair1 toAV @* V; pose Ab := sdpair2 toAV @* A. -have [injV injA] := (injm_sdpair1 toAV, injm_sdpair2 toAV). -have abelVb: p.-abelem Vb := morphim_abelem _ abelV. -have ntVb: Vb != 1 by rewrite morphim_injm_eq1. -have nVbA: Ab \subset 'N(Vb) := im_sdpair_norm toAV. -pose rV := morphim_repr (abelem_repr abelVb ntVb nVbA) (subxx A). -have{defC} <-: rker rV = C; last move: rV. - rewrite rker_morphim rker_abelem morphpreI morphimK //=. - by rewrite (trivgP injA) mul1g -astabEsd // defC astab_ract 2!setIA !setIid. -have ->: 'dim Vb = 2 by rewrite (dim_abelemE abelVb) // card_injm -?rank_abelem. -move=> rV; rewrite -(eq_pgroup _ (GRing.charf_eq (char_Fp p_pr))). -by apply: der1_odd_GL2_charf (kquo_mx_faithful rV); rewrite !morphim_odd. -Qed. - -(* This is B & G, Theorem 4.18(a). *) -Theorem rank2_max_pdiv gT p q (G : {group gT}) : - solvable G -> odd #|G| -> 'r_p(G) <= 2 -> q \in \pi(G / 'O_p^'(G)) -> q <= p. -Proof. -rewrite mem_primes => solG oddG rG /and3P[pr_q _ /= q_dv_G]. -without loss Gp'1: gT G solG oddG rG q_dv_G / 'O_p^'(G) = 1. - move/(_ _ (G / 'O_p^'(G))%G); rewrite quotient_odd ?quotient_sol //. - rewrite trivg_pcore_quotient -(card_isog (quotient1_isog _)). - by rewrite p_rank_p'quotient ?pcore_pgroup ?gFnorm //; apply. -set R := 'O_p(G); have pR: p.-group R := pcore_pgroup p G. -have [sRG nRG] := andP (pcore_normal p G : R <| G). -have oddR: odd #|R| := oddSg sRG oddG. -have rR: 'r(R) <= 2 by rewrite (rank_pgroup pR) (leq_trans _ rG) ?p_rankS. -rewrite leq_eqVlt -implyNb; apply/implyP=> p'q. -have [|//] := pi_Aut_rank2_pgroup pR oddR rR _ p'q; rewrite eq_sym in p'q. -apply: (piSg (Aut_conj_aut _ G)); apply: contraLR q_dv_G. -rewrite -p'groupEpi -p'natE // Gp'1 -(card_isog (quotient1_isog _)) /pgroup. -rewrite -(card_isog (first_isog_loc _ _)) // -!pgroupE ker_conj_aut /= -/R. -set C := 'C_G(R); rewrite pquotient_pgroup ?normsI ?norms_cent ?normG //= -/C. -suffices sCR: C \subset R by rewrite (pgroupS sCR (pi_pnat pR _)). -by rewrite /C /R -(Fitting_eq_pcore _) ?cent_sub_Fitting. -Qed. - -(* This is B & G, Theorem 4.18(c,e) *) -Theorem rank2_der1_complement gT p (G : {group gT}) : - solvable G -> odd #|G| -> 'r_p(G) <= 2 -> - [/\ (*c*) p^'.-Hall(G^`(1)) 'O_p^'(G^`(1)), - (*e1*) abelian (G / 'O_{p^',p}(G)) - & (*e2*) p^'.-group (G / 'O_{p^',p}(G))]. -Proof. -move=> solG oddG rG; rewrite /pHall pcore_sub pcore_pgroup /= pnatNK. -rewrite -(pcore_setI_normal _ (der_normal 1 G)) // setIC indexgI /=. -without loss Gp'1: gT G solG oddG rG / 'O_p^'(G) = 1. - have nsGp': 'O_p^'(G) <| G := pcore_normal p^' G; have [_ nGp'] := andP nsGp'. - move/(_ _ (G / 'O_p^'(G))%G); rewrite quotient_sol // quotient_odd //=. - have Gp'1 := trivg_pcore_quotient p^' G. - rewrite p_rank_p'quotient ?pcore_pgroup // Gp'1 indexg1 => -[] //=. - rewrite -quotient_der // card_quotient ?gFsub_trans // => ->. - rewrite (pseries_pop2 _ Gp'1) /= -pseries1 -quotient_pseries /= /pgroup. - pose isos := (isog_abelian (third_isog _ _ _), card_isog (third_isog _ _ _)). - by rewrite !{}isos ?pseries_normal ?pseries_sub_catl. -rewrite pseries_pop2 // Gp'1 indexg1 -pgroupE /=. -set R := 'O_p(G); pose C := 'C_G(R). -have /andP[sRG nRG]: R <| G by apply: gFnormal. -have sCR: C \subset R by rewrite /C /R -(Fitting_eq_pcore _) ?cent_sub_Fitting. -have pR: p.-group R := pcore_pgroup p G; have pC: p.-group C := pgroupS sCR pR. -have nCG: G \subset 'N(C) by rewrite normsI ?normG ?norms_cent. -have nsG'G: G^`(1) <| G := der_normal 1 G; have [sG'G nG'G] := andP nsG'G. -suffices sG'R: G^`(1) \subset R. - have cGbGb: abelian (G / R) := sub_der1_abelian sG'R. - rewrite -{2}(nilpotent_pcoreC p (abelian_nil cGbGb)) trivg_pcore_quotient. - by rewrite dprod1g pcore_pgroup (pgroupS sG'R pR). -rewrite pcore_max // -(pquotient_pgroup pC (subset_trans sG'G nCG)) /= -/C. -pose A := conj_aut 'O_p(G) @* G; have AutA: A \subset Aut R := Aut_conj_aut _ G. -have isoGbA: G / C \isog A by rewrite /C -ker_conj_aut first_isog_loc. -have{isoGbA} [f injf defA] := isogP isoGbA; rewrite /= -/A in defA. -rewrite quotient_der // /pgroup -(card_injm injf) ?der_sub ?morphim_der //. -have [? ?]: odd #|A| /\ solvable A by rewrite -defA !morphim_odd ?morphim_sol. -have rR: 'r(R) <= 2 by rewrite (rank_pgroup pR) (leq_trans (p_rankS p sRG)). -by rewrite defA -pgroupE (der1_Aut_rank2_pgroup pR) ?(oddSg sRG). -Qed. - -(* This is B & G, Theorem 4.18(b) *) -Theorem rank2_min_p_complement gT (G : {group gT}) (p := pdiv #|G|) : - solvable G -> odd #|G| -> 'r_p(G) <= 2 -> p^'.-Hall(G) 'O_p^'(G). -Proof. -move=> solG oddG rG; rewrite /pHall pcore_pgroup pcore_sub pnatNK /=. -rewrite -card_quotient ?gFnorm //; apply/pgroupP=> q q_pr q_dv_Gb. -rewrite inE /= eqn_leq (rank2_max_pdiv _ _ rG) ?mem_primes ?q_pr ?cardG_gt0 //. -by rewrite pdiv_min_dvd ?prime_gt1 ?(dvdn_trans q_dv_Gb) ?dvdn_quotient. -Qed. - -(* This is B & G, Theorem 4.18(d) *) -Theorem rank2_sub_p'core_der1 gT (G A : {group gT}) p : - solvable G -> odd #|G| -> 'r_p(G) <= 2 -> p^'.-subgroup(G^`(1)) A -> - A \subset 'O_p^'(G^`(1)). -Proof. -move=> solG oddG rG /andP[sAG' p'A]; rewrite sub_Hall_pcore //. -by have [-> _ _] := rank2_der1_complement solG oddG rG. -Qed. - -(* This is B & G, Corollary 4.19 *) -Corollary rank2_der1_cent_chief gT p (G Gs U V : {group gT}) : - odd #|G| -> solvable G -> Gs <| G -> 'r_p(Gs) <= 2 -> - chief_factor G V U -> p.-group (U / V) -> U \subset Gs -> - G^`(1) \subset 'C(U / V | 'Q). -Proof. -move=> oddG solG nsGsG rGs chiefUf pUf sUGs. -wlog Gs_p'_1: gT G Gs U V oddG solG nsGsG rGs chiefUf pUf sUGs / 'O_p^'(Gs) = 1. - pose K := 'O_p^'(Gs)%G; move/(_ _ (G / K) (Gs / K) (U / K) (V / K))%G. - rewrite trivg_pcore_quotient quotient_odd ?quotient_sol ?quotientS //. - have p'K: p^'.-group K := pcore_pgroup p^' Gs. - have tiUfK := coprime_TIg (pnat_coprime pUf (quotient_pgroup V p'K)). - have nsKG: K <| G by apply: gFnormal_trans. - have [[sG'G sGsG] nKG] := (der_sub 1 G, normal_sub nsGsG, normal_norm nsKG). - have{sGsG} [nKG' nKGs] := (subset_trans sG'G nKG, subset_trans sGsG nKG). - case/andP: chiefUf; case/maxgroupP; case/andP=> ltVU nVG maxV nsUG. - have [sUG nUG] := andP nsUG; have [sVU not_sUV] := andP ltVU. - have [nUG' nVG'] := (subset_trans sG'G nUG, subset_trans sG'G nVG). - have [sVG nVU] := (subset_trans sVU sUG, subset_trans sUG nVG). - have [nKU nKV] := (subset_trans sUG nKG, subset_trans sVG nKG). - have nsVU: V <| U by apply/andP. - rewrite p_rank_p'quotient // /chief_factor -quotient_der ?quotient_normal //. - rewrite andbT !sub_astabQR ?quotient_norms // -quotientR // => IH. - rewrite -quotient_sub1 ?comm_subG // -tiUfK subsetI quotientS ?commg_subr //. - rewrite quotientSK ?(comm_subG nVG') // (normC nKV) -quotientSK ?comm_subG //. - apply: IH => //=; last first. - rewrite -(setIid U) -(setIidPr sVU) -. - by rewrite -(morphim_quotm _ nsVU) morphim_pgroup. - apply/maxgroupP; rewrite /proper quotientS ?quotient_norms //= andbT. - rewrite quotientSK // -(normC nKV) -quotientSK // -subsetIidl tiUfK. - split=> [|Wb]; first by rewrite quotient_sub1. - do 2![case/andP]=> sWbU not_sUWb nWbG sVWb; apply/eqP; rewrite eqEsubset sVWb. - have nsWbG: Wb <| G / K by rewrite /normal (subset_trans sWbU) ?quotientS. - have [W defWb sKW] := inv_quotientN nsKG nsWbG; case/andP=> sWG nWG. - rewrite -(setIidPl sWbU) defWb -quotientGI // quotientS //. - rewrite (maxV (W :&: U))%G ?normsI //; last first. - by rewrite subsetI sVU andbT -(quotientSGK nKV sKW) -defWb. - by rewrite andbT /proper subsetIr subsetIidr -(quotientSGK nKU sKW) -defWb. -pose R := 'O_p(Gs); have pR: p.-group R := pcore_pgroup p Gs. -have nsRG: R <| G by apply: gFnormal_trans. -have [[sGsG nGsG] [sRG nRG]] := (andP nsGsG, andP nsRG). -have nsRGs: R <| Gs := pcore_normal p Gs; have [sRGs nRGs] := andP nsRGs. -have sylR: p.-Sylow(Gs) R. - have [solGs oddGs] := (solvableS sGsG solG, oddSg sGsG oddG). - have [_ _ p'Gsb] := rank2_der1_complement solGs oddGs rGs. - by rewrite /pHall pcore_sub pR -card_quotient //= -(pseries_pop2 p Gs_p'_1). -case/andP: (chiefUf); case/maxgroupP; case/andP=> ltVU nVG maxV nsUG. -have [sUG nUG] := andP nsUG; have [sVU not_sUV] := andP ltVU. -have [sVG nVU] := (subset_trans sVU sUG, subset_trans sUG nVG). -have nsVU: V <| U by apply/andP. -have nVGs := subset_trans sGsG nVG; have nVR := subset_trans sRGs nVGs. -have{sylR} sUfR: U / V \subset R / V. - have sylRb: p.-Sylow(Gs / V) (R / V) by rewrite quotient_pHall. - by rewrite (sub_normal_Hall sylRb) ?quotientS ?quotient_normal. -have pGb: p.-group((G / 'C_G(R))^`(1)). - pose A := conj_aut 'O_p(Gs) @* G. - have AA: A \subset Aut R := Aut_conj_aut _ G. - have isoGbA: G / 'C_G(R) \isog A by rewrite -ker_conj_aut first_isog_loc. - have{isoGbA} [f injf defA] := isogP isoGbA; rewrite /= -/A in defA. - rewrite /pgroup -(card_injm injf) ?der_sub ?morphim_der //. - have [? ?]: odd #|A| /\ solvable A by rewrite -defA !morphim_odd ?morphim_sol. - have rR: 'r(R) <= 2 by rewrite (rank_pgroup pR) (leq_trans (p_rankS p sRGs)). - by rewrite defA -pgroupE (der1_Aut_rank2_pgroup pR) ?(oddSg sRG). -set C := 'C_G(U / V | 'Q). -have nUfG: [acts G, on U / V | 'Q] by rewrite actsQ. -have nCG: G \subset 'N(C) by rewrite -(setIidPl nUfG) normsGI ?astab_norm. -have{pGb sUfR} pGa': p.-group (G / C)^`(1). - have nCRG : G \subset 'N('C_G(R)) by rewrite normsI ?normG ?norms_cent. - have sCR_C: 'C_G(R) \subset C. - rewrite subsetI subsetIl sub_astabQ ?subIset ?nVG ?(centsS sUfR) //=. - by rewrite quotient_cents ?subsetIr. - have [f /= <-]:= homgP (homg_quotientS nCRG nCG sCR_C). - by rewrite -morphim_der //= morphim_pgroup. -have irrG: acts_irreducibly (G / C) (U / V) ('Q %% _). - by rewrite acts_irr_mod_astab // acts_irrQ // chief_factor_minnormal. -have Ga_p_1: 'O_p(G / C) = 1. - rewrite (pcore_faithful_irr_act pUf _ irrG) ?modact_faithful //. - by rewrite gacentC ?quotientS ?subsetT ?subsetIr //= setICA subsetIl. -have sG'G := der_sub 1 G; have nCG' := subset_trans sG'G nCG. -rewrite -subsetIidl -{2}(setIidPl sG'G) -setIA subsetIidl -/C. -by rewrite -quotient_sub1 /= ?quotient_der //= -Ga_p_1 pcore_max ?der_normal. -Qed. - -(* This is B & G, Theorem 4.20(a) *) -Theorem rank2_der1_sub_Fitting gT (G : {group gT}) : - odd #|G| -> solvable G -> 'r('F(G)) <= 2 -> G^`(1) \subset 'F(G). -Proof. -move=> oddG solG Fle2; have nsFG := Fitting_normal G. -apply: subset_trans (chief_stab_sub_Fitting solG _) => //. -rewrite subsetI der_sub; apply/bigcapsP=> [[U V] /= /andP[chiefUV sUF]]. -have [p p_pr /andP[pUV _]] := is_abelemP (sol_chief_abelem solG chiefUV). -apply: rank2_der1_cent_chief nsFG _ _ pUV sUF => //. -exact: leq_trans (p_rank_le_rank p _) Fle2. -Qed. - -(* This is B & G, Theorem 4.20(b) *) -Theorem rank2_char_Sylow_normal gT (G S T : {group gT}) : - odd #|G| -> solvable G -> 'r('F(G)) <= 2 -> - Sylow G S -> T \char S -> T \subset S^`(1) -> T <| G. -Proof. -set F := 'F(G) => oddG solG Fle2 /SylowP[p p_pr sylS] charT sTS'. -have [sSG pS _] := and3P sylS. -have nsFG: F <| G := Fitting_normal G; have [sFG nFG] := andP nsFG. -have nFS := subset_trans sSG nFG; have nilF: nilpotent F := Fitting_nil _. -have cGGq: abelian (G / F). - by rewrite sub_der1_abelian ?rank2_der1_sub_Fitting. -have nsFS_G: F <*> S <| G. - rewrite -(quotientGK nsFG) norm_joinEr // -(quotientK nFS) cosetpre_normal. - by rewrite -sub_abelian_normal ?quotientS. -have sylSF: p.-Sylow(F <*> S) S. - by rewrite (pHall_subl _ _ sylS) ?joing_subr // join_subG sFG. -have defG: G :=: F * 'N_G(S). - rewrite -{1}(Frattini_arg nsFS_G sylSF) /= norm_joinEr // -mulgA. - by congr (_ * _); rewrite mulSGid // subsetI sSG normG. -rewrite /normal (subset_trans (char_sub charT)) //= defG mulG_subG /= -/F. -rewrite setIC andbC subIset /=; last by rewrite (char_norm_trans charT). -case/dprodP: (nilpotent_pcoreC p nilF); rewrite /= -/F => _ defF cFpFp' _. -have defFp: 'O_p(F) = F :&: S. - rewrite -{2}defF -group_modl ?coprime_TIg ?mulg1 //. - by rewrite coprime_sym (pnat_coprime pS (pcore_pgroup _ _)). - by rewrite p_core_Fitting pcore_sub_Hall. -rewrite -defF mulG_subG /= -/F defFp setIC subIset ?(char_norm charT) //=. -rewrite cents_norm // (subset_trans cFpFp') // defFp centS // subsetI. -rewrite (char_sub charT) (subset_trans (subset_trans sTS' (dergS 1 sSG))) //. -exact: rank2_der1_sub_Fitting. -Qed. - -(* This is B & G, Theorem 4.20(c), for the last factor of the series. *) -Theorem rank2_min_p'core_Hall gT (G : {group gT}) (p := pdiv #|G|) : - odd #|G| -> solvable G -> 'r('F(G)) <= 2 -> p^'.-Hall(G) 'O_p^'(G). -Proof. -set F := 'F(G) => oddG solG Fle2. -have nsFG: F <| G := Fitting_normal G; have [sFG nFG] := andP nsFG. -have [H] := inv_quotientN nsFG (pcore_normal p^' _). -rewrite /= -/F => defH sFH nsHG; have [sHG nHG] := andP nsHG. -have [P sylP] := Sylow_exists p H; have [sPH pP _] := and3P sylP. -have sPF: P \subset F. - rewrite -quotient_sub1 ?(subset_trans (subset_trans sPH sHG)) //. - rewrite -(setIidPl (quotientS _ sPH)) -defH coprime_TIg //. - by rewrite coprime_morphl // (pnat_coprime pP (pcore_pgroup _ _)). -have nilGq: nilpotent (G / F). - by rewrite abelian_nil ?sub_der1_abelian ?rank2_der1_sub_Fitting. -have pGq: p.-group (G / H). - rewrite /pgroup -(card_isog (third_isog sFH nsFG nsHG)) /= -/F -/(pgroup _ _). - rewrite -(dprodW (nilpotent_pcoreC p nilGq)) defH quotientMidr. - by rewrite quotient_pgroup ?pcore_pgroup. -rewrite pHallE pcore_sub -(Lagrange sHG) partnM // -card_quotient //=. -have hallHp': p^'.-Hall(H) 'O_p^'(H). - case p'H: (p^'.-group H). - by rewrite pHallE /= pcore_pgroup_id ?subxx //= part_pnat_id. - have def_p: p = pdiv #|H|. - have [p_pr pH]: prime p /\ p %| #|H|. - apply/andP; apply: contraFT p'H => p'H; apply/pgroupP=> q q_pr qH. - by apply: contraNneq p'H => <-; rewrite q_pr qH. - apply/eqP; rewrite eqn_leq ?pdiv_min_dvd ?prime_gt1 //. - rewrite pdiv_prime // cardG_gt1. - by case: eqP p'H => // ->; rewrite pgroup1. - exact: dvdn_trans (pdiv_dvd _) (cardSg (normal_sub nsHG)). - rewrite def_p rank2_min_p_complement ?(oddSg sHG) ?(solvableS sHG) -?def_p //. - rewrite -(p_rank_Sylow sylP) (leq_trans (p_rank_le_rank _ _)) //. - exact: leq_trans (rankS sPF) Fle2. -rewrite -(card_Hall hallHp') part_p'nat ?pnatNK ?muln1 // subset_leqif_card. - by rewrite pcore_max ?pcore_pgroup ?gFnormal_trans. -rewrite pcore_max ?pcore_pgroup // (normalS _ _ (pcore_normal _ _)) //. -rewrite -quotient_sub1 ?gFsub_trans //. -rewrite -(setIidPr (quotientS _ (pcore_sub _ _))) coprime_TIg //. -by rewrite coprime_morphr // (pnat_coprime pGq (pcore_pgroup _ _)). -Qed. - -(* This is B & G, Theorem 4.20(c), for intermediate factors. *) -Theorem rank2_ge_pcore_Hall gT m (G : {group gT}) (pi := [pred p | p >= m]) : - odd #|G| -> solvable G -> 'r('F(G)) <= 2 -> pi.-Hall(G) 'O_pi(G). -Proof. -elim: {G}_.+1 {-2}G (ltnSn #|G|) => // n IHn G. -rewrite ltnS => leGn oddG solG Fle2; pose p := pdiv #|G|. -have [defGpi | not_pi_G] := eqVneq 'O_pi(G) G. - by rewrite /pHall pcore_sub pcore_pgroup defGpi indexgg. -have pi'_p: (p \in pi^'). - apply: contra not_pi_G => pi_p; rewrite eqEsubset pcore_sub pcore_max //. - apply/pgroupP=> q q_pr qG; apply: leq_trans pi_p _. - by rewrite pdiv_min_dvd ?prime_gt1. -pose Gp' := 'O_p^'(G); have sGp'G: Gp' \subset G := pcore_sub _ _. -have hallGp'pi: pi.-Hall(Gp') 'O_pi(Gp'). - apply: IHn; rewrite ?(oddSg sGp'G) ?(solvableS sGp'G) //; last first. - by apply: leq_trans (rankS _) Fle2; rewrite /= Fitting_pcore pcore_sub. - apply: leq_trans (proper_card _) leGn. - rewrite properEneq pcore_sub andbT; apply/eqP=> defG. - suff: p \in p^' by case/eqnP. - have p'G: p^'.-group G by rewrite -defG pcore_pgroup. - rewrite (pgroupP p'G) ?pdiv_dvd ?pdiv_prime // cardG_gt1. - by apply: contra not_pi_G; move/eqP->; rewrite (trivgP (pcore_sub _ _)). -have defGp'pi: 'O_pi(Gp') = 'O_pi(G). - rewrite -pcoreI; apply: eq_pcore => q; apply: andb_idr. - by apply: contraL => /=; move/eqnP->. -have hallGp': p^'.-Hall(G) Gp' by rewrite rank2_min_p'core_Hall. -rewrite pHallE pcore_sub /= -defGp'pi (card_Hall hallGp'pi) (card_Hall hallGp'). -by rewrite partn_part // => q; apply: contraL => /=; move/eqnP->. -Qed. - -(* This is B & G, Theorem 4.20(c), for the first factor of the series. *) -Theorem rank2_max_pcore_Sylow gT (G : {group gT}) (p := max_pdiv #|G|) : - odd #|G| -> solvable G -> 'r('F(G)) <= 2 -> p.-Sylow(G) 'O_p(G). -Proof. -move=> oddG solG Fle2; pose pi := [pred q | p <= q]. -rewrite pHallE pcore_sub eqn_leq -{1}(part_pnat_id (pcore_pgroup _ _)). -rewrite dvdn_leq ?partn_dvd ?cardSg ?pcore_sub // /=. -rewrite (@eq_in_partn _ pi) => [|q piGq]; last first. - by rewrite !inE eqn_leq; apply: andb_idl => le_q_p; apply: max_pdiv_max. -rewrite -(card_Hall (rank2_ge_pcore_Hall p oddG solG Fle2)) -/pi. -rewrite subset_leq_card // pcore_max ?pcore_normal //. -apply: sub_in_pnat (pcore_pgroup _ _) => q /(piSg (pcore_sub _ _))-piGq. -by rewrite !inE eqn_leq max_pdiv_max. -Qed. - -End Section4. diff --git a/mathcomp/odd_order/BGsection5.v b/mathcomp/odd_order/BGsection5.v deleted file mode 100644 index 9769c86..0000000 --- a/mathcomp/odd_order/BGsection5.v +++ /dev/null @@ -1,534 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq div. -From mathcomp -Require Import fintype finset prime fingroup morphism perm automorphism action. -From mathcomp -Require Import quotient cyclic gfunctor pgroup gproduct center commutator. -From mathcomp -Require Import gseries nilpotent sylow abelian maximal hall. -From mathcomp -Require Import BGsection1 BGsection4. - -(******************************************************************************) -(* This file covers Section 5 of B & G, except for some technical results *) -(* that are not actually used in the proof of the Odd Order Theorem, namely *) -(* part (c) of Theorem 5.5, parts (b), (d) and (e) of Theorem 5.5, and all of *) -(* Theorem 5.7. We also make the following change: in B & G, narrow p-groups *) -(* of rank at least 3 are defined by the structure of the centralisers of *) -(* their prime subgroups, then characterized by their rank 2 elementary *) -(* abelian subgroups in Theorem 5.3. We exchange the two, because the latter *) -(* condition is easier to check, and is the only one used later in the proof. *) -(* *) -(* p.-narrow G == G has a maximal elementary abelian p-subgroup of *) -(* p-rank at most 2. *) -(* := ('r_p(G) > 2) ==> ('E_p^2(G) :&: 'E*_p(G) != set0) *) -(* *) -(* narrow_structure p G <-> G has a subgroup S of order p whose centraliser *) -(* is the direct product of S and a cyclic group C, *) -(* i.e., S \x C = 'C_G(S). This is the condition used *) -(* in the definition of "narrow" in B & G, p. 2. *) -(* Theorem 5.3 states that for odd p this definition *) -(* is equivalent to ours, and this property is not *) -(* used outside of Section 5. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope. - -Reserved Notation "p .-narrow" (at level 2, format "p .-narrow"). - -Section Definitions. - -Variables (gT : finGroupType) (p : nat) (A : {set gT}). - -Definition narrow := ('r_p(A) > 2) ==> ('E_p^2(A) :&: 'E*_p(A) != set0). - -Inductive narrow_structure : Prop := - NarrowStructure (S C : {group gT}) of - S \subset A & C \subset A & #|S| = p & cyclic C & S \x C = 'C_A(S). - -End Definitions. - -Notation "p .-narrow" := (narrow p) : group_scope. - -Section IsoDef. - -Variables (gT rT : finGroupType) (p : nat). -Implicit Types G H : {group gT}. -Implicit Type R : {group rT}. - -Lemma injm_narrow G H (f : {morphism G >-> rT}) : - 'injm f -> H \subset G -> p.-narrow (f @* H) = p.-narrow H. -Proof. -move=> injf sHG; rewrite /narrow injm_p_rank //; congr (_ ==> _). -apply/set0Pn/set0Pn=> [] [E /setIP[Ep2E maxE]]. - exists (invm injf @* E)%G; rewrite -[H](group_inj (morphim_invm injf _)) //. - have sEfG: E \subset f @* G. - by rewrite (subset_trans _ (morphimS _ sHG)) //; case/pnElemP: Ep2E. - by rewrite inE injm_pnElem ?injm_pmaxElem ?injm_invm ?morphimS // Ep2E. -have sEG: E \subset G by rewrite (subset_trans _ sHG) //; case/pnElemP: Ep2E. -by exists (f @* E)%G; rewrite inE injm_pnElem ?injm_pmaxElem // Ep2E. -Qed. - -Lemma isog_narrow G R : G \isog R -> p.-narrow G = p.-narrow R. -Proof. by case/isogP=> f injf <-; rewrite injm_narrow. Qed. - -(* No isomorphism theorems for narrow_structure, which is not used outside of *) -(* this file. *) - -End IsoDef. - -Section Five. - -Implicit Type gT : finGroupType. -Implicit Type p : nat. - -Section OneGroup. - -Variables (gT : finGroupType) (p : nat) (R : {group gT}). -Implicit Types B E S : {group gT}. - -Lemma narrowJ x : p.-narrow (R :^ x) = p.-narrow R. -Proof. by apply: isog_narrow (isog_symr (conj_isog R x)). Qed. - -Hypotheses (pR : p.-group R) (oddR : odd #|R|). - -Section Rank3. - -Hypothesis rR : 2 < 'r_p(R). - -(* This lemma uses only the rR hypothesis. *) -Lemma narrow_pmaxElem : p.-narrow R -> exists E, E \in 'E_p^2(R) :&: 'E*_p(R). -Proof. by move=> nnP; apply: set0Pn; apply: implyP rR. Qed. - -Let ntR : R :!=: 1. Proof. by case: eqP rR => // ->; rewrite p_rank1. Qed. -Let p_pr : prime p. Proof. by case: (pgroup_pdiv pR ntR). Qed. -Let p_gt1 : p > 1. Proof. exact: prime_gt1. Qed. - -(* This is B & G, Lemma 5.1(a). *) -Lemma rank3_SCN3 : exists B, B \in 'SCN_3(R). -Proof. -by apply/set0Pn; rewrite -(rank2_SCN3_empty pR oddR) leqNgt (rank_pgroup pR) rR. -Qed. - -(* This is B & G, Lemma 5.1(b). *) -Lemma normal_p2Elem_SCN3 E : - E \in 'E_p^2(R) -> E <| R -> exists2 B, B \in 'SCN_3(R) & E \subset B. -Proof. -move=> Ep2E /andP[sER nER]; have [_ abelE dimE] := pnElemP Ep2E. -have [B Ep3B nBR]: exists2 B, B \in 'E_p^3(R) & R \subset 'N(B). - have [C] := rank3_SCN3; case/setIdP=> SCN_C rC. - have [nsCR cCC] := andP (maxgroupp (SCN_max SCN_C)). - have [sCR _] := andP nsCR; have pC: p.-group C := pgroupS sCR pR. - have{pC cCC} abelC1: p.-abelem 'Ohm_1(C) := Ohm1_abelem pC cCC. - have dimC1: 3 <= logn p #|'Ohm_1(C)| by rewrite -rank_abelem // rank_Ohm1. - have nsC1R: 'Ohm_1(C) <| R := gFnormal_trans _ nsCR. - have [B [sBC1 nsBR oB]] := normal_pgroup pR nsC1R dimC1. - have [sBR nBR] := andP nsBR; exists B => //; apply/pnElemP. - by rewrite oB pfactorK // (abelemS sBC1). -have [sBR abelB dimB] := pnElemP Ep3B; have [pB cBB _] := and3P abelB. -have [oB oE] := (card_pnElem Ep3B, card_pnElem Ep2E). -pose Bs := (E <*> 'C_B(E))%G; have sCB: 'C_B(E) \subset B := subsetIl B _. -have sBsR: Bs \subset R by rewrite join_subG sER subIset ?sBR. -suffices Bs_gt2: 2 < logn p #|Bs|. - have nBsR: Bs <| R by rewrite /normal sBsR // normsY ?normsI ?norms_cent. - have abelBs: p.-abelem Bs. - by rewrite (cprod_abelem p (cprodEY _)) ?subsetIr // abelE (abelemS sCB). - have [C maxC sBsC] : {H | [max H | H <| R & abelian H ] & Bs \subset H}. - by apply: maxgroup_exists; rewrite nBsR (abelem_abelian abelBs). - exists C; last by rewrite (subset_trans _ sBsC) ?joing_subl. - by rewrite inE (max_SCN pR) ?(leq_trans Bs_gt2) // -rank_abelem ?rankS. -apply: contraFT (ltnn 2); rewrite -leqNgt => Bs_le2. -have{Bs_le2} sCE: 'C_B(E) \subset E. - rewrite (sameP joing_idPl eqP) eq_sym eqEcard joing_subl /=. - by rewrite (card_pgroup (pgroupS sBsR pR)) oE leq_exp2l. -have dimCBE: 2 <= logn p #|'C_B(E)|. - rewrite -ltnS -dimB -addn1 -leq_subLR -logn_div ?divgS ?cardSg //. - by rewrite logn_quotient_cent_abelem ?dimE ?(subset_trans sBR nER). -have defE: 'C_B(E) = E. - apply/eqP; rewrite eqEcard sCE oE /=. - by rewrite (card_pgroup (pgroupS sCB pB)) leq_exp2l. -by rewrite -dimB -dimE -defE lognSg // subsetIidl sub_abelian_cent // -defE. -Qed. - -Let Z := 'Ohm_1('Z(R)). -Let W := 'Ohm_1('Z_2(R)). -Let T := 'C_R(W). - -Let ntZ : Z != 1. -Proof. by rewrite Ohm1_eq1 (center_nil_eq1 (pgroup_nil pR)). Qed. - -Let sZR : Z \subset R. Proof. by rewrite !gFsub_trans. Qed. - -Let abelZ : p.-abelem (Z). -Proof. by rewrite (Ohm1_abelem (pgroupS _ pR)) ?center_sub ?center_abelian. Qed. - -Let pZ : p.-group Z. Proof. exact: abelem_pgroup abelZ. Qed. - -Let defCRZ : 'C_R(Z) = R. -Proof. by apply/setIidPl; rewrite centsC gFsub_trans ?subsetIr. Qed. - -Let sWR : W \subset R. Proof. exact/gFsub_trans/gFsub. Qed. -Let nWR : R \subset 'N(W). Proof. exact/gFnorm_trans/gFnorm. Qed. - -(* This is B & G, Lemma 5.2. *) -Lemma Ohm1_ucn_p2maxElem E : - E \in 'E_p^2(R) :&: 'E*_p(R) -> - [/\ (*a*) ~~ (E \subset T), - (*b*) #|Z| = p /\ [group of W] \in 'E_p^2(R) - & (*c*) T \char R /\ #|R : T| = p ]. -Proof. -case/setIP=> Ep2E maxE; have defCRE1 := Ohm1_cent_max maxE pR. -have [[sER abelE dimE] oE] := (pnElemP Ep2E, card_pnElem Ep2E). -have [[sZR_R nZR_R] [pE _ eE]] := (andP (center_normal R), and3P abelE). -have{nZR_R} nZR: R \subset 'N(Z) := gFnorm_trans _ nZR_R. -have{sZR_R} [pZR pW] := (pgroupS sZR_R pR, pgroupS sWR pR). -have sZE: Z \subset E by rewrite -defCRE1 OhmS ?setIS // centS. -have rCRE : 'r_p('C_R(E)) = 2 by rewrite -p_rank_Ohm1 defCRE1 p_rank_abelem. -have oZ: #|Z| = p. - apply/prime_nt_dvdP; rewrite -?trivg_card1 // (card_pgroup pZ) /= -/Z. - rewrite (@dvdn_exp2l _ _ 1) // -ltnS -dimE properG_ltn_log //= -/Z. - by case/eqVproper: sZE rR => // defZ; rewrite -defCRZ defZ rCRE ltnn. -have ncycR: ~~ cyclic R by rewrite (odd_pgroup_rank1_cyclic pR) // -(subnKC rR). -have [ncycW eW] := Ohm1_odd_ucn2 pR oddR ncycR; rewrite -/W in ncycW eW. -have sWRZ: [~: W, R] \subset Z. - rewrite [Z](OhmE 1 pZR) sub_gen //= -ucn1 subsetI. - rewrite (subset_trans _ (ucn_comm 1 _)) ?commSg ?Ohm_sub //. - by move: nWR eW; rewrite -commg_subl -sub_LdivT; apply: subset_trans. -have sZW: Z \subset W by rewrite OhmS /= -?ucn1 ?ucn_subS //. -have ltZW: Z \proper W. - by rewrite properEneq; case: eqP ncycW => // <-; rewrite prime_cyclic ?oZ. -have sWRE := subset_trans sWRZ sZE. -have nEW: W \subset 'N(E) by rewrite -commg_subr (subset_trans _ sWRE) ?commgSS. -have defZ: 'C_W(E) = Z. - have sCE: 'C_W(E) \subset E. - rewrite -{2}defCRE1 (OhmE 1 (pgroupS (subsetIl R _) pR)) sub_gen //. - by rewrite subsetI setSI // subIset // sub_LdivT eW. - have [defC | ltCE] := eqVproper sCE. - have sEW: E \subset W by rewrite -defC subsetIl. - have nsER: E <| R. - by rewrite /normal sER -commg_subl (subset_trans (commSg R sEW)). - have [B scn3B sEB] := normal_p2Elem_SCN3 Ep2E nsER. - have [scnB dimB] := setIdP scn3B; have [_ scBR] := SCN_P scnB. - rewrite ltnNge -rank_Ohm1 -dimE -rank_abelem ?rankS // in dimB. - by rewrite -scBR -defCRE1 OhmS // setIS ?centS. - apply/eqP; rewrite eq_sym eqEcard oZ (card_pgroup (pgroupS sCE pE)) /= -/W. - rewrite subsetI sZW (centsS sER); last by rewrite centsC -subsetIidl defCRZ. - by rewrite (leq_exp2l _ 1) // -ltnS -dimE properG_ltn_log. -have dimW: logn p #|W| = 2. - apply/eqP; rewrite -(Lagrange sZW) lognM ?cardG_gt0 // oZ (pfactorK 1) //=. - rewrite -/Z eqSS eqn_leq -{1}defZ logn_quotient_cent_abelem ?dimE // -/W. - by rewrite -divgS // logn_div ?cardSg // subn_gt0 properG_ltn_log. -have abelW: p.-abelem W. - by rewrite (abelem_Ohm1 (pgroupS _ pR)) ?(p2group_abelian pW) ?dimW ?ucn_sub. -have charT: T \char R by rewrite subcent_char ?char_refl ?gFchar_trans. -rewrite 2!inE sWR abelW dimW; do 2?split => //. - by apply: contra (proper_subn ltZW); rewrite -defZ !subsetI subxx sER centsC. -apply/prime_nt_dvdP=> //. - rewrite indexg_eq1 subsetIidl centsC; apply: contraFN (ltnn 1) => cRW. - by rewrite -dimW -(setIidPl (centsS sER cRW)) defZ oZ (pfactorK 1). -rewrite -(part_pnat_id (pnat_dvd (dvdn_indexg _ _) pR)) p_part. -by rewrite (@dvdn_exp2l p _ 1) ?logn_quotient_cent_abelem ?dimW. -Qed. - -(* This is B & G, Theorem 5.3(d); we omit parts (a)-(c) as they are mostly *) -(* redundant with Lemma 5.2, given our definition of "narrow". *) -Theorem narrow_cent_dprod S : - p.-narrow R -> #|S| = p -> S \subset R -> 'r_p('C_R(S)) <= 2 -> - [/\ cyclic 'C_T(S), S :&: R^`(1) = 1, S :&: T = 1 & S \x 'C_T(S) = 'C_R(S)]. -Proof. -move=> nnR oS sSR rS; have pS : p.-group S := pgroupS sSR pR. -have [E maxEp2E] := narrow_pmaxElem nnR; have [Ep2E maxE] := setIP maxEp2E. -have [not_sET [oZ Ep2W] [charT maxT]] := Ohm1_ucn_p2maxElem maxEp2E. -have cZS : S \subset 'C(Z) by rewrite (subset_trans sSR) // -defCRZ subsetIr. -have nZS : S \subset 'N(Z) by rewrite cents_norm. -have cSS : abelian S by rewrite cyclic_abelian ?prime_cyclic // oS. -pose SZ := (S <*> [group of Z])%G; have sSSZ: S \subset SZ := joing_subl _ _. -have sSZ_R: SZ \subset R by rewrite join_subG sSR sZR. -have abelSZ : p.-abelem SZ. - by rewrite /= joingC (cprod_abelem p (cprodEY cZS)) abelZ prime_abelem. -have tiSZ: S :&: Z = 1. - rewrite prime_TIg ?oS //= -/Z; apply: contraL rR => sZS. - by rewrite -leqNgt (leq_trans _ rS) ?p_rankS // -{1}defCRZ setIS ?centS. -have{tiSZ} oSZ: #|SZ| = (p ^ 2)%N by rewrite /= norm_joinEl ?TI_cardMg ?oS ?oZ. -have Ep2SZ: SZ \in 'E_p^2(R) by rewrite pnElemE // !inE sSZ_R abelSZ oSZ eqxx. -have{oSZ Ep2SZ abelSZ sSZ_R} maxSZ: SZ \in 'E_p^2(R) :&: 'E*_p(R). - rewrite inE Ep2SZ; apply/pmaxElemP; rewrite inE sSZ_R abelSZ. - split=> // H /setIdP[sHR abelH] sSZH. - have [[_ _ dimSZ] [cHH pH _]] := (pnElemP Ep2SZ, and3P abelH). - have sSH: S \subset H := subset_trans sSSZ sSZH. - have{sSH} sH_CRS: H \subset 'C_R(S) by rewrite subsetI sHR (centsS sSH). - have{sH_CRS}: 'r_p(H) <= 2 by rewrite (leq_trans _ rS) ?p_rankS. - apply: contraTeq; rewrite eq_sym eqEproper sSZH negbK => lSZH. - by rewrite -ltnNge p_rank_abelem // -dimSZ properG_ltn_log. -have sZT: Z \subset T. - by rewrite subsetI sZR (centsS sWR) // centsC -defCRZ subsetIr. -have{SZ sSSZ maxSZ} not_sST: ~~ (S \subset T). - have: ~~ (SZ \subset T) by case/Ohm1_ucn_p2maxElem: maxSZ. - by rewrite join_subG sZT andbT. -have tiST: S :&: T :=: 1 by rewrite prime_TIg ?oS. -have defST: S * T = R. - apply/eqP; rewrite eqEcard TI_cardMg ?mul_subG ?subsetIl //=. - by rewrite mulnC oS -maxT Lagrange ?subsetIl. -have cRRb: abelian (R / T) by rewrite -defST quotientMidr quotient_abelian. -have sR'T: R^`(1) \subset T by rewrite der1_min ?char_norm. -have TI_SR': S :&: R^`(1) :=: 1. - by rewrite prime_TIg ?oS // (contra _ not_sST) // => /subset_trans->. -have defCRS : S \x 'C_T(S) = 'C_R(S). - rewrite (dprodE _ _) ?subsetIr //= -/T; last by rewrite setIA tiST setI1g. - rewrite -{1}(center_idP cSS) subcent_TImulg ?defST //. - by rewrite subsetI normG (subset_trans sSR) ?char_norm. -have sCTSR: 'C_T(S) \subset R by rewrite subIset ?subsetIl. -split; rewrite ?(odd_pgroup_rank1_cyclic (pgroupS _ pR) (oddSg _ oddR)) //= -/T. -rewrite -ltnS (leq_trans _ rS) //= -(p_rank_dprod p defCRS) -add1n leq_add2r. -by rewrite -rank_pgroup // rank_gt0 -cardG_gt1 oS. -Qed. - -(* This is B & G, Corollary 5.4. Given our definition of narrow, this is used *) -(* directly in the proof of the main part of Theorem 5.3. *) -Corollary narrow_centP : - reflect (exists S, [/\ gval S \subset R, #|S| = p & 'r_p('C_R(S)) <= 2]) - (p.-narrow R). -Proof. -rewrite /narrow rR; apply: (iffP (set0Pn _)) => [[E maxEp2E]|[S [sSR oS rCRS]]]. - have [Ep2E maxE] := setIP maxEp2E. - have{maxEp2E} [_ [oZ _] _] := Ohm1_ucn_p2maxElem maxEp2E. - have [sER abelE dimE] := pnElemP Ep2E; have oE := card_pnElem Ep2E. - have sZE: Z \subset E by rewrite -(Ohm1_cent_max maxE pR) OhmS ?setIS ?centS. - have [S defE] := abelem_split_dprod abelE sZE; exists S. - have{defE} [[_ defZS _ _] oZS] := (dprodP defE, dprod_card defE). - split; first by rewrite (subset_trans _ sER) // -defZS mulG_subr. - by apply/eqP; rewrite -(eqn_pmul2l (ltnW p_gt1)) -{1}oZ oZS oE. - rewrite -dimE -p_rank_abelem // -(Ohm1_cent_max maxE pR) p_rank_Ohm1. - by rewrite -defZS /= centM setIA defCRZ. -have abelS := prime_abelem p_pr oS. -have cSZ: Z \subset 'C(S) by rewrite (centsS sSR) // centsC -defCRZ subsetIr. -have sSZR: S <*> Z \subset R by rewrite join_subG sSR. -have defSZ: S \x Z = S <*> Z. - rewrite dprodEY ?prime_TIg ?oS //= -/Z; apply: contraL rR => sSZ. - by rewrite -leqNgt (leq_trans _ rCRS) ?p_rankS // -{1}defCRZ setIS ?centS. -have abelSZ: p.-abelem (S <*> Z) by rewrite (dprod_abelem p defSZ) abelS. -have [pSZ cSZSZ _] := and3P abelSZ. -have dimSZ: logn p #|S <*> Z| = 2. - apply/eqP; rewrite -p_rank_abelem // eqn_leq (leq_trans (p_rankS _ _) rCRS). - rewrite -(p_rank_dprod p defSZ) p_rank_abelem // oS (pfactorK 1) // ltnS. - by rewrite -rank_pgroup // rank_gt0. - by rewrite subsetI sSZR sub_abelian_cent ?joing_subl. -exists [group of S <*> Z]; rewrite 3!inE sSZR abelSZ dimSZ /=. -apply/pmaxElemP; rewrite inE sSZR; split=> // E; case/pElemP=> sER abelE sSZE. -apply: contraTeq rCRS; rewrite eq_sym -ltnNge -dimSZ => neqSZE. -have [[pE cEE _] sSE] := (and3P abelE, subset_trans (joing_subl S Z) sSZE). -rewrite (leq_trans (properG_ltn_log pE _)) ?properEneq ?neqSZE //. -by rewrite -p_rank_abelem ?p_rankS // subsetI sER sub_abelian_cent. -Qed. - -(* This is the main statement of B & G, Theorem 5.3, stating the equivalence *) -(* of the structural and rank characterizations of the "narrow" property. Due *) -(* to our definition of "narrow", the equivalence is the converse of that in *) -(* B & G (we define narrow in terms of maximal elementary abelian subgroups). *) -Lemma narrow_structureP : reflect (narrow_structure p R) (p.-narrow R). -Proof. -apply: (iffP idP) => [nnR | [S C sSR sCR oS cycC defSC]]. - have [S [sSR oS rCRS]] := narrow_centP nnR. - have [cycC _ _ defCRS] := narrow_cent_dprod nnR oS sSR rCRS. - by exists S [group of 'C_T(S)]; rewrite //= -setIA subsetIl. -apply/narrow_centP; exists S; split=> //. -have cycS: cyclic S by rewrite prime_cyclic ?oS. -rewrite -(p_rank_dprod p defSC) -!(rank_pgroup (pgroupS _ pR)) // -addn1. -rewrite leq_add -?abelian_rank1_cyclic ?cyclic_abelian //. -Qed. - -End Rank3. - -(* This is B & G, Theoren 5.5 (a) and (b). Part (c), which is not used in the *) -(* proof of the Odd Order Theorem, is omitted. *) -Theorem Aut_narrow (A : {group {perm gT}}) : - p.-narrow R -> solvable A -> A \subset Aut R -> odd #|A| -> - [/\ (*a*) p^'.-group (A / 'O_p(A)), abelian (A / 'O_p(A)) - & (*b*) 2 < 'r(R) -> forall x, x \in A -> p^'.-elt x -> #[x] %| p.-1]. -Proof. -move=> nnR solA AutA oddA; have nilR := pgroup_nil pR. -have [rR | rR] := leqP 'r(R) 2. - have pA' := der1_Aut_rank2_pgroup pR oddR rR AutA solA oddA. - have sA'Ap: A^`(1) \subset 'O_p(A) by rewrite pcore_max ?der_normal. - have cAbAb: abelian (A / 'O_p(A)) by rewrite sub_der1_abelian. - split; rewrite // -(nilpotent_pcoreC p (abelian_nil cAbAb)). - by rewrite trivg_pcore_quotient dprod1g pcore_pgroup. -have ntR: R :!=: 1 by rewrite -rank_gt0 2?ltnW. -rewrite (rank_pgroup pR) in rR. -have [H [charH sHRZ] _ eH pCH] := critical_odd pR oddR ntR. -have{ntR} [[p_pr _ _] sHR] := (pgroup_pdiv pR ntR, char_sub charH). -have ntH: H :!=: 1 by rewrite trivg_exponent eH -prime_coprime ?coprimen1. -have{nnR} [S C sSR sCR oS cycC defSC] := narrow_structureP rR nnR. -have [_ mulSC cSC tiSC] := dprodP defSC. -have abelS: p.-abelem S := prime_abelem p_pr oS; have [pS cSS _] := and3P abelS. -have cycS: cyclic S by rewrite prime_cyclic ?oS. -have tiHS: H :&: S = 1. - have rCRS: 'r_p('C_R(S)) <= 2. - rewrite -(p_rank_dprod p defSC) -addn1 -!rank_pgroup ?(pgroupS _ pR) //. - by rewrite leq_add -?abelian_rank1_cyclic ?cyclic_abelian. - rewrite setIC prime_TIg ?oS //; apply: contraL (rCRS) => sSH; rewrite -ltnNge. - have cZHS: S \subset 'C('Z(H)) by rewrite centsC (centsS sSH) ?subsetIr. - pose U := S <*> 'Z(H). - have sUH: U \subset H by rewrite join_subG sSH subsetIl. - have cUU: abelian U by rewrite abelianY cSS center_abelian centsC. - have abelU: p.-abelem U by rewrite abelemE // cUU -eH exponentS. - have sUR: U \subset R := subset_trans sUH sHR. - have rU: 'r_p(U) <= 'r_p('C_R(S)). - by rewrite p_rankS //= subsetI sUR (centsS (joing_subl S 'Z(H))). - have nsUR: U <| R. - rewrite /normal sUR -commg_subl (subset_trans (commSg _ sUH)) //= -/U. - by rewrite (subset_trans sHRZ) // joing_subr. - have{rU}:= leq_trans rU rCRS; rewrite leq_eqVlt => /predU1P[] rU. - have Ep2U: [group of U] \in 'E_p^2(R). - by rewrite !inE /= sUR abelU -(p_rank_abelem abelU) rU. - have [F scn3F sUF] := normal_p2Elem_SCN3 rR Ep2U nsUR. - have [scnF rF] := setIdP scn3F; have [_ scF] := SCN_P scnF. - rewrite (leq_trans rF) // -scF -rank_pgroup ?(pgroupS (subsetIl _ _)) //. - by rewrite rankS ?setIS ?centS // (subset_trans _ sUF) ?joing_subl. - have defU: S :=: U. - apply/eqP; rewrite eqEcard oS joing_subl (card_pgroup (pgroupS sUR pR)). - by rewrite -p_rank_abelem // (leq_exp2l _ 1) // prime_gt1. - have ntS: S :!=: 1 by rewrite -cardG_gt1 oS prime_gt1. - have sSZ: S \subset 'Z(R) by rewrite prime_meetG ?oS ?meet_center_nil // defU. - by rewrite (setIidPl _) // centsC (subset_trans sSZ) ?subsetIr. -have{tiHS eH} oCHS: #|'C_H(S)| = p. - have ntCHS: 'C_H(S) != 1. - have: H :&: 'Z(R) != 1 by rewrite meet_center_nil ?char_normal. - by apply: subG1_contra; rewrite setIS // (centsS sSR) ?subsetIr. - have cycCHS: cyclic 'C_H(S). - have tiS_CHS: S :&: 'C_H(S) = 1 by rewrite setICA setIA tiHS setI1g. - rewrite (isog_cyclic (quotient_isog _ tiS_CHS)) ?subIset ?cent_sub ?orbT //. - rewrite (cyclicS _ (quotient_cyclic S cycC)) //= -(quotientMidl S C). - by rewrite mulSC quotientS // setSI // char_sub. - have abelCHS: p.-abelem 'C_H(S). - by rewrite abelemE ?cyclic_abelian // -eH exponentS ?subsetIl. - rewrite -(Ohm1_id abelCHS). - by rewrite (Ohm1_cyclic_pgroup_prime _ (abelem_pgroup abelCHS)). -pose B := A^`(1) <*> [set a ^+ p.-1 | a in A]. -have sBA: B \subset A. - rewrite join_subG (der_sub 1 A) /=. - by apply/subsetP=> _ /imsetP[a Aa ->]; rewrite groupX. -have AutB: B \subset Aut R := subset_trans sBA AutA. -suffices pB (X : {group {perm gT}}): X \subset B -> p^'.-group X -> X :=: 1. - have cAbAb: abelian (A / 'O_p(A)). - rewrite sub_der1_abelian // pcore_max ?der_normal //. - apply/pgroupP=> q q_pr; apply: contraLR => p'q; rewrite -p'natE //. - have [X sylX] := Sylow_exists q A^`(1); have [sXA' qX _] := and3P sylX. - rewrite -partn_eq1 ?cardG_gt0 // -(card_Hall sylX). - by rewrite (pB X) ?cards1 ?(pi_pgroup qX) ?(subset_trans sXA') ?joing_subl. - rewrite cAbAb -(nilpotent_pcoreC p (abelian_nil cAbAb)) trivg_pcore_quotient. - rewrite dprod1g pcore_pgroup; split=> //_ a Aa p'a. - rewrite order_dvdn -cycle_eq1 [<[_]>]pB ?(pgroupS (cycleX _ _) p'a) //. - by rewrite genS // sub1set inE orbC (mem_imset (expgn^~ _)). -move=> sXB p'X; have AutX := subset_trans sXB AutB. -pose toX := ([Aut R] \ AutX)%gact; pose CX := 'C_(H | toX)(X). -suffices sHCX: H \subset CX. - rewrite -(setIid X) coprime_TIg ?(pnat_coprime (pgroupS _ pCH)) //. - by rewrite subsetIidl gacent_ract setIid gacentC in sHCX. -elim: _.+1 {1 2 4 6}H (charH) (subxx H) (ltnSn #|H|) => // n IHn L charL sLH. -rewrite ltnS => leLn; have sLR := char_sub charL; pose K := [~: L, R]. -wlog ntL: / L :!=: 1 by case: eqP => [-> | _ -> //]; rewrite sub1G. -have charK: K \char R by rewrite charR ?char_refl. -have ltKL: K \proper L. - have nLR: R \subset 'N_R(L) by rewrite subsetIidl char_norm. - exact: nil_comm_properl nilR sLR ntL nLR. -have [sKL sKR] := (proper_sub ltKL, char_sub charK). -have [sKH pK] := (subset_trans sKL sLH, pgroupS sKR pR : p.-group K). -have nsKH: K <| H := normalS sKH sHR (char_normal charK). -have sKCX: K \subset CX by rewrite IHn ?(leq_trans (proper_card ltKL)) ?leLn. -have pL := pgroupS sLR pR; have nKL: L \subset 'N(K) := commg_norml _ _. -have{pS cSS} oLb: #|L / K| = p. - have [v defS] := cyclicP cycS; rewrite defS cycle_subG in sSR. - have ntLb: L / K != 1 by rewrite -subG1 quotient_sub1 ?proper_subn. - have [_ p_dv_Lb _] := pgroup_pdiv (quotient_pgroup _ pL) ntLb. - apply/eqP; rewrite eqn_leq {p_dv_Lb}(dvdn_leq _ p_dv_Lb) // andbT. - rewrite -divg_normal ?(normalS sKL sLH nsKH) // leq_divLR ?cardSg //= -/K. - rewrite -(card_lcoset K v) -(LagrangeI L 'C(S)) -indexgI /= -oCHS /K commGC. - rewrite {2}defS cent_cycle index_cent1 leq_mul ?subset_leq_card ?setSI //. - by apply/subsetP=> vx; case/imsetP=> x Lx ->; rewrite mem_lcoset mem_commg. -have cycLb: cyclic (L / K) by rewrite prime_cyclic ?oLb. -rewrite -(quotientSGK _ sKCX) // quotientGI // subsetI quotientS //= -/K. -have actsXK: [acts X, on K | toX] by rewrite acts_ract subxx acts_char. -rewrite ext_coprime_quotient_cent ?(pnat_coprime pK p'X) ?(pgroup_sol pK) //. -have actsAL : {acts A, on group L | [Aut R]} by apply: gacts_char. -have sAD: A \subset qact_dom <[actsAL]> [~: L, R]. - by rewrite qact_domE // acts_actby subxx (setIidPr sKL) acts_char. -suffices cLbX: X \subset 'C(L / K | <[actsAL]> / _). - rewrite gacentE ?qact_domE // subsetI quotientS //=. - apply/subsetP=> Ku LbKu; rewrite inE; apply/subsetP=> x Xx; rewrite inE. - have [Dx cLx] := setIdP (subsetP cLbX x Xx); have [Ax _] := setIdP Dx. - rewrite inE in cLx; have:= subsetP cLx Ku LbKu; rewrite inE /=. - have [u Nu Lu ->] := morphimP LbKu. - by rewrite !{1}qactE // ?actbyE // qact_domE ?(subsetP actsXK). -rewrite (subset_trans sXB) // astab_range -ker_actperm gen_subG. -rewrite -sub_morphim_pre; last by rewrite -gen_subG ?(subset_trans sBA). -rewrite morphimU subUset morphim_der // (sameP trivgP derG1P). -rewrite (abelianS _ (Aut_cyclic_abelian cycLb)); last first. - exact: subset_trans (morphim_sub _ _) (im_actperm_Aut _). -apply/subsetP=> _ /morphimP[_ _ /imsetP[x Ax ->] ->]. -have Dx := subsetP sAD x Ax; rewrite inE morphX //= -order_dvdn. -apply: dvdn_trans (order_dvdG (actperm_Aut _ Dx)) _. -by rewrite card_Aut_cyclic // oLb (@totient_pfactor p 1) ?muln1. -Qed. - -End OneGroup. - -(* This is B & G, Theorem 5.6, parts (a) and (c). We do not prove parts (b), *) -(* (d) and (e), as they are not used in the proof of the Odd Order Theorem. *) -Theorem narrow_der1_complement_max_pdiv gT p (G S : {group gT}) : - odd #|G| -> solvable G -> p.-Sylow(G) S -> p.-narrow S -> - (2 < 'r(S)) ==> p.-length_1 G -> - [/\ (*a*) p^'.-Hall(G^`(1)) 'O_p^'(G^`(1)) - & (*c*) forall q, q \in \pi(G / 'O_p^'(G)) -> q <= p]. -Proof. -move=> oddG solG sylS nnS; case: (leqP 'r(S) 2) => /= rS pl1G. - have rG: 'r_p(G) <= 2 by rewrite -(rank_Sylow sylS). - split=> [|q]; first by have [-> _ _] := rank2_der1_complement solG oddG rG. - exact: rank2_max_pdiv solG oddG rG. -rewrite /pHall pcore_sub pcore_pgroup pnatNK /=. -rewrite -(pcore_setI_normal p^' (der_normal 1 G)) // setIC indexgI /=. -wlog Gp'1: gT G S oddG nnS solG sylS rS pl1G / 'O_p^'(G) = 1. - set K := 'O_p^'(G); have [_ nKG] := andP (pcore_normal _ G : K <| G). - move/(_ _ (G / K) (S / K))%G; rewrite quotient_sol ?quotient_odd //. - have [[sSG pS _] p'K] := (and3P sylS, pcore_pgroup _ G : p^'.-group K). - have [nKS nKG'] := (subset_trans sSG nKG, subset_trans (der_sub 1 G) nKG). - have tiKS: K :&: S = 1 := coprime_TIg (p'nat_coprime p'K pS). - have isoS := isog_symr (quotient_isog nKS tiKS). - rewrite (isog_narrow p isoS) {isoS}(isog_rank isoS) quotient_pHall //. - rewrite plength1_quo // trivg_pcore_quotient indexg1 /= -quotient_der //. - by rewrite card_quotient //= -/K -(card_isog (quotient1_isog _)); apply. -rewrite Gp'1 indexg1 -(card_isog (quotient1_isog _)) -pgroupE. -have [sSG pS _] := and3P sylS; have oddS: odd #|S| := oddSg sSG oddG. -have ntS: S :!=: 1 by rewrite -rank_gt0 (leq_trans _ rS). -have [p_pr _ _] := pgroup_pdiv pS ntS; have p_gt1 := prime_gt1 p_pr. -have{pl1G} defS: 'O_p(G) = S. - by rewrite (eq_Hall_pcore _ sylS) -?plength1_pcore_Sylow. -have nSG: G \subset 'N(S) by rewrite -defS gFnorm. -pose fA := restrm nSG (conj_aut S); pose A := fA @* G. -have AutA: A \subset Aut S by rewrite [A]im_restrm Aut_conj_aut. -have [solA oddA]: solvable A /\ odd #|A| by rewrite morphim_sol ?morphim_odd. -have [/= _ cAbAb p'A_dv_p1] := Aut_narrow pS oddS nnS solA AutA oddA. -have{defS} pKfA: p.-group ('ker fA). - rewrite (pgroupS _ pS) //= ker_restrm ker_conj_aut. - by rewrite -defS -Fitting_eq_pcore ?cent_sub_Fitting. -split=> [|q]. - rewrite -(pmorphim_pgroup pKfA) ?der_sub // morphim_der //. - by rewrite (pgroupS (der1_min _ cAbAb)) ?pcore_pgroup ?gFnorm. -rewrite mem_primes => /and3P[q_pr _ /Cauchy[] // x Gx ox]. -rewrite leq_eqVlt -implyNb; apply/implyP=> p'q; rewrite -(ltn_predK p_gt1) ltnS. -have ofAx: #[fA x] = q. - apply/prime_nt_dvdP=> //; last by rewrite -ox morph_order. - rewrite order_eq1; apply: contraNneq p'q => fAx1. - by apply: (pgroupP pKfA); rewrite // -ox order_dvdG //; apply/kerP. -have p'fAx: p^'.-elt (fA x) by rewrite /p_elt ofAx pnatE. -by rewrite -ofAx dvdn_leq ?p'A_dv_p1 ?mem_morphim // -(subnKC p_gt1). -Qed. - -End Five. diff --git a/mathcomp/odd_order/BGsection6.v b/mathcomp/odd_order/BGsection6.v deleted file mode 100644 index 9e06b1a..0000000 --- a/mathcomp/odd_order/BGsection6.v +++ /dev/null @@ -1,322 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrfun ssrbool eqtype ssrnat seq div fintype finset. -From mathcomp -Require Import prime fingroup morphism automorphism quotient gproduct gfunctor. -From mathcomp -Require Import cyclic center commutator pgroup nilpotent sylow abelian hall. -From mathcomp -Require Import maximal. -From mathcomp -Require Import BGsection1 BGappendixAB. - -(******************************************************************************) -(* This file covers most of B & G section 6. *) -(* Theorem 6.4 is not proved, since it is not needed for the revised proof of *) -(* the odd order theorem. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope. - -Section Six. - -Implicit Type gT : finGroupType. -Implicit Type p : nat. - -Section OneType. - -Variable gT : finGroupType. -Implicit Types G H K S U : {group gT}. - -(* This is B & G, Theorem A.4(b) and 6.1, or Gorenstein 6.5.2, the main Hall- *) -(* Higman style p-stability result used in the proof of the Odd Order Theorem *) -Theorem odd_p_abelian_constrained p G : - odd #|G| -> solvable G -> p.-abelian_constrained G. -Proof. -move/odd_p_stable=> stabG /solvable_p_constrained constrG. -exact: p_stable_abelian_constrained. -Qed. - -(* Auxiliary results from AppendixAB, necessary to exploit the results below. *) -Definition center_Puig_char := BGappendixAB.center_Puig_char. -Definition trivg_center_Puig_pgroup := BGappendixAB.trivg_center_Puig_pgroup. - -(* The two parts of B & G, Theorem 6.2 are established in BGappendixAB. *) -Theorem Puig_factorisation p G S : - odd #|G| -> solvable G -> p.-Sylow(G) S -> 'O_p^'(G) * 'N_G('Z('L(S))) = G. -Proof. exact: BGappendixAB.Puig_factorization. Qed. - -(* This is the main statement of B & G, Theorem 6.2. It is not used in the *) -(* actual proof. *) -Theorem Puig_center_p'core_normal p G S : - odd #|G| -> solvable G -> p.-Sylow(G) S -> 'O_p^'(G) * 'Z('L(S)) <| G. -Proof. -move=> oddG solG sylS; rewrite -{2}(Puig_factorisation _ _ sylS) //. -have sZL_G: 'Z('L(S)) \subset G by rewrite !gFsub_trans ?(pHall_sub sylS). -rewrite -!quotientK ?(subset_trans sZL_G) ?subIset ?gFnorm //=. -by rewrite cosetpre_normal quotient_normal // normalSG. -Qed. - -(* This is the second part (special case) of B & G, Theorem 6.2. *) -Theorem Puig_center_normal p G S : - odd #|G| -> solvable G -> p.-Sylow(G) S -> 'O_p^'(G) = 1 -> 'Z('L(S)) <| G. -Proof. exact: BGappendixAB.Puig_center_normal. Qed. - -(* This is B & G, Lemma 6.3(a). *) -Lemma coprime_der1_sdprod K H G : - K ><| H = G -> coprime #|K| #|H| -> solvable K -> K \subset G^`(1) -> - [~: K, H] = K /\ 'C_K(H) \subset K^`(1). -Proof. -case/sdprodP=> _ defG nKH tiKH coKH solK sKG'. -set K' := K^`(1); have [sK'K nK'K] := andP (der_normal 1 K : K' <| K). -have nK'H: H \subset 'N(K') := gFnorm_trans _ nKH. -set R := [~: K, H]; have sRK: R \subset K by rewrite commg_subl. -have [nRK nRH] := joing_subP (commg_norm K H : K <*> H \subset 'N(R)). -have sKbK'H': K / R \subset (K / R)^`(1) * (H / R)^`(1). - have defGb: (K / R) \* (H / R) = G / R. - by rewrite -defG quotientMl ?cprodE // centsC quotient_cents2r. - have [_ -> _ /=] := cprodP (der_cprod 1 defGb). - by rewrite -quotient_der ?quotientS // -defG mul_subG. -have tiKbHb': K / R :&: (H / R)^`(1) = 1. - by rewrite coprime_TIg // (coprimegS (der_sub 1 _)) ?coprime_morph. -have{sKbK'H' tiKbHb'} derKb: (K / R)^`(1) = K / R. - by rewrite -{2}(setIidPr sKbK'H') -group_modl ?der_sub // setIC tiKbHb' mulg1. -have{derKb} Kb1: K / R = 1. - rewrite (contraNeq (sol_der1_proper _ (subxx (K / R)))) ?quotient_sol //. - by rewrite derKb properxx. -have{Kb1 sRK} defKH: [~: K, H] = K. - by apply/eqP; rewrite eqEsubset sRK -quotient_sub1 ?Kb1 //=. -split=> //; rewrite -quotient_sub1 ?subIset ?nK'K //= -/K'. -have cKaKa: abelian (K / K') := der_abelian 0 K. -rewrite coprime_quotient_cent ?quotient_norms ?coprime_morph //= -/K' -defKH. -by rewrite quotientR // coprime_abel_cent_TI ?quotient_norms ?coprime_morph. -Qed. - -(* This is B & G, Lemma 6.3(b). It is apparently not used later. *) -Lemma prime_nil_der1_factor G : - nilpotent G^`(1) -> prime #|G / G^`(1)| -> - Hall G G^`(1) /\ (forall H, G^`(1) ><| H = G -> G^`(1) = [~: G, H]). -Proof. -move=> nilG' /=; set G' := G^`(1); set p := #|G / G'| => p_pr. -have nsG'G: G' <| G := der_normal 1 G; have [sG'G nG'G] := andP nsG'G. -have nsG'p'G: 'O_p^'(G') <| G := gFnormal_trans _ nsG'G. -have nG'p'G := normal_norm nsG'p'G; have solG' := nilpotent_sol nilG'. -have{nilG'} pGb: p.-group (G / 'O_p^'(G')). - rewrite /pgroup card_quotient -?(Lagrange_index sG'G (pcore_sub _ _)) //=. - rewrite pnat_mul // -card_quotient // pnat_id //= -pnatNK. - by case/and3P: (nilpotent_pcore_Hall p^' nilG'). -have{pGb} cycGb: cyclic (G / 'O_p^'(G')). - apply: (cyclic_nilpotent_quo_der1_cyclic (pgroup_nil pGb)). - rewrite -quotient_der // (isog_cyclic (third_isog _ _ _)) ?pcore_sub //. - by apply: prime_cyclic. -have defG': G' = 'O_p^'(G'). - by apply/eqP; rewrite eqEsubset pcore_sub der1_min ?cyclic_abelian. -have hallG': Hall G G'. - rewrite /Hall sG'G -?card_quotient // defG' //= -/p. - by rewrite (p'nat_coprime (pcore_pgroup _ _)) ?pnat_id. -split=> // H defG; have [_ mulG'H nG'H tiG'H] := sdprodP defG. -rewrite -mulG'H commMG ?commg_normr // -derg1 (derG1P _) ?mulg1 //. - by case/coprime_der1_sdprod: (defG); rewrite ?(coprime_sdprod_Hall_l defG). -rewrite (isog_abelian (quotient_isog nG'H tiG'H)) /= -/G'. -by rewrite -quotientMidl mulG'H der_abelian. -Qed. - -Section PprodSubCoprime. - -Variables K U H G : {group gT}. -Hypotheses (defG : K * U = G) (nsKG : K <| G). -Hypotheses (sHU : H \subset U) (coKH : coprime #|K| #|H|). -Let nKG : G \subset 'N(K). Proof. by case/andP: nsKG. Qed. -Let sKG : K \subset G. Proof. by case/mulG_sub: defG. Qed. -Let sUG : U \subset G. Proof. by case/mulG_sub: defG. Qed. -Let nKU : U \subset 'N(K). Proof. exact: subset_trans sUG nKG. Qed. -Let nKH : H \subset 'N(K). Proof. exact: subset_trans sHU nKU. Qed. - -(* This is B & G, Lemma 6.5(a); note that we do not assume solvability. *) -Lemma pprod_focal_coprime : H :&: G^`(1) = H :&: U^`(1). -Proof. -set G' := G^`(1); set U' := U^`(1). -have [sU'U nU'U] := andP (der_normal 1 U : U' <| U). -have{nU'U} nU_U': U :&: _ \subset 'N(U') by move=> A; rewrite subIset ?nU'U. -suffices sHG'U': H :&: G' \subset U'. - by rewrite -(setIidPl sHG'U') -setIA (setIidPr (dergS 1 sUG)). -rewrite -(setIidPr sHU) -setIA -quotient_sub1 // setICA setIC. -rewrite quotientGI ?subsetI ?sU'U ?dergS ?coprime_TIg //= -/G' -/U'. -have sUG'_UKb: (U :&: G') / U' \subset (U :&: K) / U'. - rewrite quotientSK // -normC ?group_modr ?setIS //. - by rewrite -quotientSK ?comm_subG ?quotient_der // -defG quotientMidl. -rewrite (coprimeSg sUG'_UKb) // -(card_isog (second_isog _)) //=. -rewrite setIA (setIidPl sU'U) coprime_morphl ?coprime_morphr //. -exact: coprimeSg (subsetIr U K) coKH. -Qed. - -Hypothesis solG : solvable G. - -(* This is B & G, Lemma 6.5(c). *) -Lemma pprod_trans_coprime g : - g \in G -> H :^ g \subset U -> - exists2 c, c \in 'C_K(H) & exists2 u, u \in U & g = c * u. -Proof. -rewrite -{1}defG => /mulsgP[k u Kk Uu defg] sHgU. -have [sK_KH sH_KH] := joing_sub (erefl (K <*> H)). -have hallH: \pi(H).-Hall(K <*> H :&: U) H. - rewrite (pHall_subl _ (subsetIl _ _)) ?subsetI ?sH_KH //. - rewrite /pHall sH_KH pgroup_pi /= joingC norm_joinEl // indexMg -indexgI. - by rewrite -coprime_pi' ?cardG_gt0 //= coprime_sym coprime_TIg ?indexg1. -have{sHgU} hallHk: \pi(H).-Hall(K <*> H :&: U) (H :^ k). - rewrite pHallE cardJg (card_Hall hallH) eqxx andbT subsetI andbC. - rewrite -(conjSg _ _ u) (conjGid Uu) -conjsgM -defg sHgU. - by rewrite sub_conjg conjGid // groupV (subsetP sK_KH). -have{hallH hallHk} [w KUw defHk]: exists2 w, w \in K :&: U & H :^ k = H :^ w. - have sKHU_G: K <*> H :&: U \subset G by rewrite setIC subIset ?sUG. - have [hw KHUhw ->] := Hall_trans (solvableS sKHU_G solG) hallHk hallH. - have: hw \in H * (K :&: U) by rewrite group_modl // -norm_joinEl // joingC. - by case/mulsgP=> h w Hh KUw ->; exists w; rewrite // conjsgM (conjGid Hh). -have{KUw} [Kw Uw] := setIP KUw. -exists (k * w^-1); last by exists (w * u); rewrite ?groupM // -mulgA mulKg. -by rewrite -coprime_norm_cent // !inE groupM ?groupV //= conjsgM defHk conjsgK. -Qed. - -(* This is B & G, Lemma 6.5(b). *) -Lemma pprod_norm_coprime_prod : 'C_K(H) * 'N_U(H) = 'N_G(H). -Proof. -apply/eqP; rewrite eqEsubset mul_subG ?setISS ?cent_sub //=. -apply/subsetP=> g /setIP[Gg /normP nHg]. -have [|c Cc [u Uu defg]] := pprod_trans_coprime Gg; first by rewrite nHg. -rewrite defg mem_mulg // !inE Uu -{2}nHg defg conjsgM conjSg (normP _) //=. -by case/setIP: Cc => _; apply: (subsetP (cent_sub H)). -Qed. - -End PprodSubCoprime. - -Section Plength1Prod. - -Variables (p : nat) (G S : {group gT}). -Hypotheses (sylS : p.-Sylow(G) S) (pl1G : p.-length_1 G). -Let K := 'O_p^'(G). -Let sSG : S \subset G. Proof. by case/andP: sylS. Qed. -Let nsKG : K <| G. Proof. apply: pcore_normal. Qed. -Let sKG : K \subset G. Proof. by case/andP: nsKG. Qed. -Let nKG : G \subset 'N(K). Proof. by case/andP: nsKG. Qed. -Let nKS : S \subset 'N(K). Proof. apply: subset_trans sSG nKG. Qed. -Let coKS : coprime #|K| #|S|. -Proof. exact: p'nat_coprime (pcore_pgroup _ G) (pHall_pgroup sylS). Qed. -Let sSN : S \subset 'N_G(S). Proof. by rewrite subsetI sSG normG. Qed. - -Let sylGbp : p.-Sylow(G / K) 'O_p(G / K). -Proof. by rewrite -plength1_pcore_quo_Sylow. Qed. - -(* This is B & G, Lemma 6.6(a1); note that we do not assume solvability. *) -Lemma plength1_Sylow_prod : K * S = 'O_{p^',p}(G). -Proof. -by rewrite -quotientK 1?(eq_Hall_pcore sylGbp) ?quotient_pHall //= /K -pseries1. -Qed. - -Let sylS_Gp'p : p.-Sylow('O_{p^',p}(G)) S. -Proof. -have [_ sSGp'p] := mulG_sub plength1_Sylow_prod. -exact: pHall_subl sSGp'p (pseries_sub _ _) sylS. -Qed. - -(* This is B & G, Lemma 6.6(a2); note that we do not assume solvability. *) -Lemma plength1_Frattini : K * 'N_G(S) = G. -Proof. -rewrite -{2}(Frattini_arg _ sylS_Gp'p) ?pseries_normal //= -plength1_Sylow_prod. -by rewrite -mulgA [S * _]mulSGid // subsetI sSG normG. -Qed. -Local Notation defG := plength1_Frattini. - -(* This is B & G, Lemma 6.6(b); note that we do not assume solvability. *) -Lemma plength1_Sylow_sub_der1 : S \subset G^`(1) -> S \subset ('N_G(S))^`(1). -Proof. -by move/setIidPl=> sSG'; apply/setIidPl; rewrite -(pprod_focal_coprime defG). -Qed. - -Hypothesis solG : solvable G. - -(* This is B & G, Lemma 6.6(c). *) -Lemma plength1_Sylow_trans (Y : {set gT}) g : - Y \subset S -> g \in G -> Y :^ g \subset S -> - exists2 c, c \in 'C_G(Y) & exists2 u, u \in 'N_G(S) & g = c * u. -Proof. -rewrite -gen_subG -(gen_subG (Y :^ g)) genJ => sYS Gg sYgS. -have coKY := coprimegS sYS coKS. -have [sYN sYgN] := (subset_trans sYS sSN, subset_trans sYgS sSN). -have [c Cc defg] := pprod_trans_coprime defG nsKG sYN coKY solG Gg sYgN. -by exists c => //; apply: subsetP Cc; rewrite cent_gen setSI. -Qed. - -(* This is B & G, Lemma 6.6(d). *) -Lemma plength1_Sylow_Jsub (Q : {group gT}) : - Q \subset G -> p.-group Q -> - exists2 x, x \in 'C_G(Q :&: S) & Q :^ x \subset S. -Proof. -move=> sQG pQ; have sQ_Gp'p: Q \subset 'O_{p^',p}(G). - rewrite -sub_quotient_pre /= pcore_mod1 ?(subset_trans sQG) //. - by rewrite (sub_Hall_pcore sylGbp) ?quotientS ?quotient_pgroup. -have [xy /= KSxy sQxyS] := Sylow_Jsub sylS_Gp'p sQ_Gp'p pQ. -rewrite -plength1_Sylow_prod in KSxy; have [x y Kx Sy def_xy] := mulsgP KSxy. -have{sQxyS} sQxS: Q :^ x \subset S. - by rewrite -(conjSg _ _ y) (conjGid Sy) -conjsgM -def_xy. -exists x; rewrite // inE (subsetP sKG) //; apply/centP=> z; case/setIP=> Qz Sz. -apply/commgP; rewrite -in_set1 -set1gE -(coprime_TIg coKS) inE. -rewrite groupMl ?groupV ?memJ_norm ?(subsetP nKS) ?Kx //=. -by rewrite commgEr groupMr // (subsetP sQxS) ?memJ_conjg ?groupV. -Qed. - -End Plength1Prod. - -End OneType. - -(* This is B & G, Theorem 6.7 *) -Theorem plength1_norm_pmaxElem gT p (G E L : {group gT}) : - E \in 'E*_p(G) -> odd p -> solvable G -> p.-length_1 G -> - L \subset G -> E \subset 'N(L) -> p^'.-group L -> - L \subset 'O_p^'(G). -Proof. -move=> maxE p_odd solG pl1G sLG nEL p'L. -case p_pr: (prime p); last first. - by rewrite pcore_pgroup_id // p'groupEpi mem_primes p_pr. -wlog Gp'1: gT G E L maxE solG pl1G sLG nEL p'L / 'O_p^'(G) = 1. - set K := 'O_p^'(G); have [sKG nKG] := andP (pcore_normal _ G : K <| G). - move/(_ _ (G / K) (E / K) (L / K))%G; rewrite morphim_sol ?plength1_quo //. - rewrite morphimS ?morphim_norms ?quotient_pgroup // trivg_pcore_quotient. - rewrite (quotient_sub1 (subset_trans sLG nKG)) => -> //. - have [EpE _] := pmaxElemP maxE; have{EpE} [sEG abelE] := pElemP EpE. - apply/pmaxElemP; rewrite inE quotient_abelem ?quotientS //. - split=> // Fb; case/pElemP=> sFbG abelFb; have [pFb _ _] := and3P abelFb. - have [S sylS sES] := Sylow_superset sEG (abelem_pgroup abelE). - have [sSG pS _] := and3P sylS; have nKS := subset_trans sSG nKG. - have: (E / K)%G \in 'E*_p(S / K). - have: E \in 'E*_p(S) by rewrite (subsetP (pmaxElemS p sSG)) // inE maxE inE. - have coKS: coprime #|K| #|S| := p'nat_coprime (pcore_pgroup _ _) pS. - have [injK imK] := isomP (quotient_isom nKS (coprime_TIg coKS)). - by rewrite -(injm_pmaxElem injK) ?imK ?inE //= morphim_restrm (setIidPr _). - case/pmaxElemP=> _; apply; rewrite inE abelFb andbT. - rewrite (sub_normal_Hall (quotient_pHall _ sylS)) //= -quotientMidl /= -/K. - by rewrite plength1_Sylow_prod // quotient_pseries2 pcore_normal. -have [EpE _] := pmaxElemP maxE; have{EpE} [sEG abelE] := pElemP EpE. -have [S sylS sES] := Sylow_superset sEG (abelem_pgroup abelE). -have [sSG pS _] := and3P sylS; have oddS: odd #|S| := odd_pgroup_odd p_odd pS. -have defS: S :=: 'O_p(G) by apply eq_Hall_pcore; rewrite -?plength1_pcore_Sylow. -have coSL: coprime #|S| #|L| := pnat_coprime pS p'L. -have tiSL: S :&: L = 1 := coprime_TIg coSL. -have{solG} scSG: 'C_G(S) \subset S. - by rewrite defS -Fitting_eq_pcore ?cent_sub_Fitting. -rewrite Gp'1 -tiSL subsetIidr (subset_trans _ scSG) // subsetI sLG /=. -have nSL: L \subset 'N(S) by rewrite (subset_trans sLG) // defS gFnorm. -have cLE: L \subset 'C(E). - by rewrite (sameP commG1P trivgP) -tiSL setIC commg_subI ?(introT subsetIP). -have maxES: E \in 'E*_p(S) by rewrite (subsetP (pmaxElemS p sSG)) ?(maxE, inE). -have EpE: E \in 'E_p(S) by apply/setIdP. -by rewrite (coprime_odd_faithful_cent_abelem EpE) ?(pmaxElem_LdivP p_pr maxES). -Qed. - -End Six. - diff --git a/mathcomp/odd_order/BGsection7.v b/mathcomp/odd_order/BGsection7.v deleted file mode 100644 index 08a589e..0000000 --- a/mathcomp/odd_order/BGsection7.v +++ /dev/null @@ -1,979 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq div fintype bigop. -From mathcomp -Require Import finset prime fingroup morphism automorphism action quotient. -From mathcomp -Require Import gfunctor cyclic pgroup center commutator gseries nilpotent. -From mathcomp -Require Import sylow abelian maximal hall. -From mathcomp -Require Import BGsection1 BGsection6. - -(******************************************************************************) -(* This file covers B & G, section 7, i.e., the proof of the Thompson *) -(* Transitivity Theorem, as well as some generalisations used later in the *) -(* proof. *) -(* This is the first section of the proof that applies to a (hypothetical) *) -(* minimally simple odd group, so we also introduce at this point some *) -(* infrastructure to carry over this assumption into the rest of the proof. *) -(* minSimpleOddGroupType == a finGroupType that ranges exactly over the *) -(* elements of a minimal counter-example to the *) -(* Odd Order Theorem. *) -(* G == the group of all the elements in a *) -(* minSimpleOddGroupType (this is a local notation *) -(* that must be reestablished for each such Type). *) -(* 'M == the set of all (proper) maximal subgroups of G *) -(* 'M(H) == the set of all elements of 'M that contain H *) -(* 'U == the set of all H such that 'M(H) contains a *) -(* single (unique) maximal subgroup of G. *) -(* 'SCN_n[p] == the set of all SCN subgroups of rank at least n *) -(* of all the Sylow p-subgroups of G. *) -(* |/|_H(A, pi) == the set of all pi-subgroups of H that are *) -(* normalised by A. *) -(* |/|*(A, pi) == the set of pi-subgroups of G, normalised by A, *) -(* and maximal subject to this condition. *) -(* normed_constrained A == A is a nontrivial proper subgroup of G, such *) -(* that for any proper subgroup X containing A, *) -(* all Y in |/|_X(A, pi') lie in the pi'-core of X *) -(* (here pi is the set of prime divisors of #|A|). *) -(* This is Hypothesis 7.1 in B & G. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope. - -Reserved Notation "''M'" (at level 8, format "''M'"). -Reserved Notation "''M' ( H )" (at level 8, format "''M' ( H )"). -Reserved Notation "''U'" (at level 8). -Reserved Notation "''SCN_' n [ p ]" - (at level 8, n at level 2, format "''SCN_' n [ p ]"). -Reserved Notation "|/|_ X ( A ; pi )" - (at level 8, X at level 2, format "|/|_ X ( A ; pi )"). -Reserved Notation "|/|* ( A ; pi )" - (at level 8, format "|/|* ( A ; pi )"). - -(* The generic setup for the whole Odd Order Theorem proof. *) -Section InitialReduction. - -Implicit Type gT : finGroupType. - -Record minSimpleOddGroupMixin gT : Prop := MinSimpleOddGroupMixin { - _ : odd #|[set: gT]|; - _ : simple [set: gT]; - _ : ~~ solvable [set: gT]; - _ : forall M : {group gT}, M \proper [set: gT] -> solvable M -}. - -Structure minSimpleOddGroupType := MinSimpleOddGroupType { - minSimpleOddGroupType_base :> finGroupType; - _ : minSimpleOddGroupMixin minSimpleOddGroupType_base -}. - -Hypothesis IH_FT : minSimpleOddGroupType -> False. - -Lemma minSimpleOdd_ind gT (G : {group gT}) : odd #|G| -> solvable G. -Proof. -move: {2}_.+1 (ltnSn #|G|) => n. -elim: n => // n IHn in gT G *; rewrite ltnS => leGn oddG. -have oG: #|[subg G]| = #|G| by rewrite (card_isog (isog_subg G)). -apply/idPn=> nsolG; case: IH_FT; exists [finGroupType of subg_of G]. -do [split; rewrite ?oG //=] => [||M]. -- rewrite -(isog_simple (isog_subg _)); apply/simpleP; split=> [|H nsHG]. - by apply: contra nsolG; move/eqP->; rewrite abelian_sol ?abelian1. - have [sHG _]:= andP nsHG; apply/pred2P; apply: contraR nsolG; case/norP=> ntH. - rewrite eqEcard sHG -ltnNge (series_sol nsHG) => ltHG. - by rewrite !IHn ?(oddSg sHG) ?quotient_odd ?(leq_trans _ leGn) ?ltn_quotient. -- by apply: contra nsolG => solG; rewrite -(im_sgval G) morphim_sol. -rewrite properEcard oG; case/andP=> sMG ltMG. -by apply: IHn (leq_trans ltMG leGn) (oddSg sMG _); rewrite oG. -Qed. - -Lemma minSimpleOdd_prime gT (G : {group gT}) : - odd #|G| -> simple G -> prime #|G|. -Proof. by move/minSimpleOdd_ind; apply: simple_sol_prime. Qed. - -End InitialReduction. - -Notation TheMinSimpleOddGroup gT := - [set: FinGroup.arg_sort (FinGroup.base (minSimpleOddGroupType_base gT))] - (only parsing). - -(* Elementary properties of the minimal counter example. *) -Section MinSimpleOdd. - -Variable gT : minSimpleOddGroupType. -Notation G := (TheMinSimpleOddGroup gT). -Implicit Types H K D M P U V X : {group gT}. -Local Notation sT := {set gT}. -Implicit Type p : nat. - -Lemma mFT_odd H : odd #|H|. -Proof. by apply: (oddSg (subsetT H)); case: gT => ? []. Qed. - -Lemma mFT_simple : simple G. -Proof. by case: gT => ? []. Qed. - -Lemma mFT_nonSolvable : ~~ solvable G. -Proof. by case: gT => ? []. Qed. - -Lemma mFT_sol M : M \proper G -> solvable M. -Proof. by case: gT M => ? []. Qed. - -Lemma mFT_nonAbelian : ~~ abelian G. -Proof. by apply: contra mFT_nonSolvable; apply: abelian_sol. Qed. - -Lemma mFT_neq1 : G != 1. -Proof. by apply: contraNneq mFT_nonAbelian => ->; apply: abelian1. Qed. - -Lemma mFT_gt1 : [1] \proper G. Proof. by rewrite proper1G mFT_neq1. Qed. - -Lemma mFT_quo_odd M H : odd #|M / H|. -Proof. by rewrite quotient_odd ?mFT_odd. Qed. - -Lemma mFT_sol_proper M : (M \proper G) = solvable M. -Proof. -apply/idP/idP; first exact: mFT_sol. -by rewrite properT; apply: contraL; move/eqP->; apply: mFT_nonSolvable. -Qed. - -Lemma mFT_pgroup_proper p P : p.-group P -> P \proper G. -Proof. by move/pgroup_sol; rewrite mFT_sol_proper. Qed. - -Lemma mFT_norm_proper H : H :!=: 1 -> H \proper G -> 'N(H) \proper G. -Proof. -move=> ntH; rewrite !properT; apply: contra; move/eqP=> nHG; apply/eqP. -move/eqP: ntH; case/simpleP: mFT_simple => _; case/(_ H) => //=. -by rewrite -nHG normalG. -Qed. - -Lemma cent_mFT_trivial : 'C(G) = 1. -Proof. -apply/eqP; apply: contraR mFT_nonAbelian => ntC. -rewrite /abelian subTset /= eqEproper subsetT /=; apply/negP=> prC. -have:= mFT_norm_proper ntC prC. -by rewrite /proper subsetT norms_cent ?normG. -Qed. - -Lemma mFT_cent_proper H : H :!=: 1 -> 'C(H) \proper G. -Proof. -case: (eqsVneq H G) => [-> | ]. - by rewrite cent_mFT_trivial properT eq_sym. -rewrite -properT => prH ntH; apply: sub_proper_trans (cent_sub H) _. -exact: mFT_norm_proper. -Qed. - -Lemma mFT_cent1_proper x : x != 1 -> 'C[x] \proper G. -Proof. by rewrite -cycle_eq1 -cent_cycle; apply: mFT_cent_proper. Qed. - -Lemma mFT_quo_sol M H : H :!=: 1 -> solvable (M / H). -Proof. -move=> ntH; case: (eqsVneq H G) => [-> |]. - rewrite [_ / _](trivgP _) ?abelian_sol ?abelian1 //. - by rewrite quotient_sub1 ?normsG ?subsetT. -rewrite -properT => prH; rewrite -quotientInorm morphim_sol //. -by apply: solvableS (subsetIr _ _) (mFT_sol _); rewrite mFT_norm_proper. -Qed. - -(* Maximal groups of the minimal FT counterexample, as defined at the start *) -(* of B & G, section 7. *) -Definition minSimple_max_groups := [set M : {group gT} | maximal M G]. -Local Notation "'M" := minSimple_max_groups : group_scope. - -Definition minSimple_max_groups_of (H : sT) := [set M in 'M | H \subset M]. -Local Notation "''M' ( H )" := (minSimple_max_groups_of H) : group_scope. - -Definition minSimple_uniq_max_groups := [set U : {group gT} | #|'M(U)| == 1%N]. -Local Notation "'U" := minSimple_uniq_max_groups : group_scope. - -Definition minSimple_SCN_at n p := \bigcup_(P in 'Syl_p(G)) 'SCN_n(P). - -Lemma mmax_exists H : H \proper G -> {M | M \in 'M(H)}. -Proof. -case/(@maxgroup_exists _ (fun M => M \proper G)) => M maxM sHM. -by exists M; rewrite !inE sHM andbT. -Qed. - -Lemma any_mmax : {M : {group gT} | M \in 'M}. -Proof. by have [M] := mmax_exists mFT_gt1; case/setIdP; exists M. Qed. - -Lemma mmax_proper M : M \in 'M -> M \proper G. -Proof. by rewrite inE; apply: maxgroupp. Qed. - -Lemma mmax_sol M : M \in 'M -> solvable M. -Proof. by move/mmax_proper/mFT_sol. Qed. - -Lemma mmax_max M H : M \in 'M -> H \proper G -> M \subset H -> H :=: M. -Proof. by rewrite inE; case/maxgroupP=> _; apply. Qed. - -Lemma eq_mmax : {in 'M &, forall M H, M \subset H -> M :=: H}. -Proof. by move=> M H Mmax; move/mmax_proper=> prH; move/mmax_max->. Qed. - -Lemma sub_mmax_proper M H : M \in 'M -> H \subset M -> H \proper G. -Proof. by move=> maxM sHM; apply: sub_proper_trans (mmax_proper maxM). Qed. - -Lemma mmax_norm X M : - M \in 'M -> X :!=: 1 -> X \proper G -> M \subset 'N(X) -> 'N(X) = M. -Proof. by move=> maxM ntX prX; apply: mmax_max (mFT_norm_proper _ _). Qed. - -Lemma mmax_normal_subset A M : - M \in 'M -> A <| M -> ~~ (A \subset [1]) -> 'N(A) = M. -Proof. -rewrite -gen_subG subG1 => maxM /andP[sAM nAM] ntGA. -rewrite (mmax_max maxM) // (sub_proper_trans (norm_gen _)) ?mFT_norm_proper //. -by rewrite (sub_mmax_proper maxM) // gen_subG. -Qed. - -Lemma mmax_normal M H : M \in 'M -> H <| M -> H :!=: 1 -> 'N(H) = M. -Proof. by rewrite -subG1; apply: mmax_normal_subset. Qed. - -Lemma mmax_sigma_Sylow p P M : - M \in 'M -> p.-Sylow(M) P -> 'N(P) \subset M -> p.-Sylow(G) P. -Proof. -by move=> maxM sylP sNM; rewrite -Sylow_subnorm setTI (pHall_subl _ sNM) ?normG. -Qed. - -Lemma mmax_neq1 M : M \in 'M -> M :!=: 1. -Proof. -move=> maxM; apply: contra mFT_nonAbelian; move/eqP=> M1. -case: (eqVneq G 1) => [-> | ]; first exact: abelian1. -case/trivgPn=> x; rewrite -cycle_subG -cycle_eq1 subEproper /=. -case/predU1P=> [<- | ]; first by rewrite cycle_abelian. -by move/(mmax_max maxM)=> ->; rewrite M1 ?sub1G ?eqxx. -Qed. - -Lemma norm_mmax M : M \in 'M -> 'N(M) = M. -Proof. -move=> maxM; apply: mmax_max (normG M) => //. -exact: (mFT_norm_proper (mmax_neq1 maxM) (mmax_proper maxM)). -Qed. - -Lemma mmaxJ M x : (M :^ x \in 'M)%G = (M \in 'M). -Proof. by rewrite !inE /= -{1}[G](@conjGid _ _ x) ?maximalJ ?inE. Qed. - -Lemma mmax_ofS H K : H \subset K -> 'M(K) \subset 'M(H). -Proof. -move=> sHK; apply/subsetP=> M; rewrite !inE => /andP[->]. -exact: subset_trans. -Qed. - -Lemma mmax_ofJ K x M : ((M :^ x)%G \in 'M(K :^ x)) = (M \in 'M(K)). -Proof. by rewrite inE mmaxJ conjSg !inE. Qed. - -Lemma uniq_mmaxP U : reflect (exists M, 'M(U) = [set M]) (U \in 'U). -Proof. by rewrite inE; apply: cards1P. Qed. -Arguments uniq_mmaxP [U]. - -Lemma mem_uniq_mmax U M : 'M(U) = [set M] -> M \in 'M /\ U \subset M. -Proof. by move/setP/(_ M); rewrite set11 => /setIdP. Qed. - -Lemma eq_uniq_mmax U M H : - 'M(U) = [set M] -> H \in 'M -> U \subset H -> H :=: M. -Proof. -by move=> uU_M maxH sUH; apply/congr_group/set1P; rewrite -uU_M inE maxH. -Qed. - -Lemma def_uniq_mmax U M : - U \in 'U -> M \in 'M -> U \subset M -> 'M(U) = [set M]. -Proof. -case/uniq_mmaxP=> D uU_D maxM sUM. -by rewrite (group_inj (eq_uniq_mmax uU_D maxM sUM)). -Qed. - -Lemma uniq_mmax_subset1 U M : - M \in 'M -> U \subset M -> (U \in 'U) = ('M(U) \subset [set M]). -Proof. -move=> maxM sUM; apply/idP/idP=> uU; first by rewrite -(def_uniq_mmax uU). -by apply/uniq_mmaxP; exists M; apply/eqP; rewrite eqEsubset uU sub1set inE maxM. -Qed. - -Lemma sub_uniq_mmax U M H : - 'M(U) = [set M] -> U \subset H -> H \proper G -> H \subset M. -Proof. -move=> uU_M sUH; case/mmax_exists=> D; case/setIdP=> maxD sHD. -by rewrite -(eq_uniq_mmax uU_M maxD) ?(subset_trans sUH). -Qed. - -Lemma mmax_sup_id M : M \in 'M -> 'M(M) = [set M]. -Proof. -move=> maxM; apply/eqP; rewrite eqEsubset sub1set inE maxM subxx !andbT. -apply/subsetP=> H; case/setIdP=> maxH; rewrite inE -val_eqE /=. -by move/eq_mmax=> ->. -Qed. - -Lemma mmax_uniq_id : {subset 'M <= 'U}. -Proof. by move=> M maxM; apply/uniq_mmaxP; exists M; apply: mmax_sup_id. Qed. - -Lemma def_uniq_mmaxJ M K x : 'M(K) = [set M] -> 'M(K :^ x) = [set M :^ x]%G. -Proof. -move=> uK_M; apply/setP=> L; rewrite -(actKV 'JG x L) mmax_ofJ uK_M. -by rewrite !inE (inj_eq (act_inj 'JG x)). -Qed. - -Lemma uniq_mmaxJ K x :((K :^ x)%G \in 'U) = (K \in 'U). -Proof. -apply/uniq_mmaxP/uniq_mmaxP=> [] [M uK_M]. - by exists (M :^ x^-1)%G; rewrite -(conjsgK x K); apply: def_uniq_mmaxJ. -by exists (M :^ x)%G; apply: def_uniq_mmaxJ. -Qed. - -Lemma uniq_mmax_norm_sub (M U : {group gT}) : - 'M(U) = [set M] -> 'N(U) \subset M. -Proof. -move=> uU_M; have [maxM _] := mem_uniq_mmax uU_M. -apply/subsetP=> x nUx; rewrite -(norm_mmax maxM) inE. -have:= set11 M; rewrite -uU_M -(mmax_ofJ _ x) (normP nUx) uU_M. -by move/set1P/congr_group->. -Qed. - -Lemma uniq_mmax_neq1 (U : {group gT}) : U \in 'U -> U :!=: 1. -Proof. -case/uniq_mmaxP=> M uU_M; have [maxM _] := mem_uniq_mmax uU_M. -apply: contraL (uniq_mmax_norm_sub uU_M); move/eqP->. -by rewrite norm1 subTset -properT mmax_proper. -Qed. - -Lemma def_uniq_mmaxS M U V : - U \subset V -> V \proper G -> 'M(U) = [set M] -> 'M(V) = [set M]. -Proof. -move=> sUV prV uU_M; apply/eqP; rewrite eqEsubset sub1set -uU_M. -rewrite mmax_ofS //= inE (sub_uniq_mmax uU_M) //. -by case/mem_uniq_mmax: uU_M => ->. -Qed. - -Lemma uniq_mmaxS U V : U \subset V -> V \proper G -> U \in 'U -> V \in 'U. -Proof. -move=> sUV prV /uniq_mmaxP[M uU_M]; apply/uniq_mmaxP; exists M. -exact: def_uniq_mmaxS uU_M. -Qed. - -End MinSimpleOdd. - -Arguments uniq_mmaxP [gT U]. -Prenex Implicits uniq_mmaxP. - -Notation "''M'" := (minSimple_max_groups _) : group_scope. -Notation "''M' ( H )" := (minSimple_max_groups_of H) : group_scope. -Notation "''U'" := (minSimple_uniq_max_groups _) : group_scope. -Notation "''SCN_' n [ p ]" := (minSimple_SCN_at _ n p) : group_scope. - -Section Hypothesis7_1. - -Variable gT : finGroupType. -Implicit Types X Y A P Q : {group gT}. -Local Notation G := [set: gT]. - -Definition normed_pgroups (X A : {set gT}) pi := - [set Y : {group gT} | pi.-subgroup(X) Y & A \subset 'N(Y)]. -Local Notation "|/|_ X ( A ; pi )" := (normed_pgroups X A pi) : group_scope. - -Definition max_normed_pgroups (A : {set gT}) pi := - [set Y : {group gT} | [max Y | pi.-group Y & A \subset 'N(Y)]]. -Local Notation "|/|* ( A ; pi )" := (max_normed_pgroups A pi) : group_scope. - -(* This is the statement for B & G, Hypothesis 7.1. *) -Inductive normed_constrained (A : {set gT}) := - NormedConstrained (pi := \pi(A)) of A != 1 & A \proper G - & forall X Y : {group gT}, - A \subset X -> X \proper G -> Y \in |/|_X(A; pi^') -> Y \subset 'O_pi^'(X). - -Variable pi : nat_pred. - -Lemma max_normed_exists A X : - pi.-group X -> A \subset 'N(X) -> {Y | Y \in |/|*(A; pi) & X \subset Y}. -Proof. -move=> piX nXA; pose piAn Y := pi.-group(Y) && (A \subset 'N(Y)). -have [|Y] := @maxgroup_exists _ piAn X; first by rewrite /piAn piX. -by exists Y; rewrite // inE. -Qed. - -Lemma mem_max_normed A X : X \in |/|*(A; pi) -> pi.-group X /\ A \subset 'N(X). -Proof. by rewrite inE; move/maxgroupp; move/andP. Qed. - -Lemma norm_acts_max_norm P : [acts 'N(P), on |/|*(P; pi) | 'JG]. -Proof. -apply/subsetP=> z Nz; rewrite !inE; apply/subsetP=> Q; rewrite !inE. -case/maxgroupP=> qQ maxQ; apply/maxgroupP; rewrite pgroupJ norm_conj_norm //. -split=> // Y; rewrite sub_conjg /= => qY; move/maxQ=> <-; rewrite ?conjsgKV //. -by rewrite pgroupJ norm_conj_norm ?groupV. -Qed. - -Lemma trivg_max_norm P : 1%G \in |/|*(P; pi) -> |/|*(P; pi) = [set 1%G]. -Proof. -move=> max1; apply/eqP; rewrite eqEsubset sub1set max1 andbT. -apply/subsetP=> Q; rewrite !inE -val_eqE /= in max1 *. -by case/maxgroupP: max1 => _ max1; move/maxgroupp; move/max1->; rewrite ?sub1G. -Qed. - -Lemma max_normed_uniq A P Q : - |/|*(A; pi) = [set Q] -> A \subset P -> P \subset 'N(Q) -> - |/|*(P; pi) = [set Q]. -Proof. -move=> defAmax sAP nQP; have: Q \in |/|*(A; pi) by rewrite defAmax set11. -rewrite inE; case/maxgroupP; case/andP=> piQ _ maxQ. -apply/setP=> X; rewrite !inE -val_eqE /=; apply/maxgroupP/eqP=> [[]|->{X}]. - case/andP=> piX nXP maxX; have nXA := subset_trans sAP nXP. - have [Y] := max_normed_exists piX nXA. - by rewrite defAmax; move/set1P->; move/maxX=> -> //; rewrite piQ. -rewrite piQ; split=> // X; case/andP=> piX nXP sQX. -by rewrite (maxQ X) // piX (subset_trans sAP). -Qed. - -End Hypothesis7_1. - -Notation "|/|_ X ( A ; pi )" := (normed_pgroups X A pi) : group_scope. -Notation "|/|* ( A ; pi )" := (max_normed_pgroups A pi) : group_scope. - -Section Seven. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). -Local Notation grT := {group gT}. -Implicit Types H P Q R K M A B : grT. -Implicit Type p q : nat. - -Section NormedConstrained. - -Variables (q : nat) (A : grT). -Let pi := Eval simpl in \pi(A). -Let K := 'O_pi^'('C(A)). -Let nsKC : K <| 'C(A) := pcore_normal _ _. - -Lemma cent_core_acts_max_norm : [acts K, on |/|*(A; q) | 'JG]. -Proof. -by rewrite (subset_trans _ (norm_acts_max_norm _ _)) ?cents_norm ?pcore_sub. -Qed. -Let actsKmax := actsP cent_core_acts_max_norm. - -Hypotheses (cstrA : normed_constrained A) (pi'q : q \notin pi). - -Let hyp71 H R : - A \subset H -> H \proper G -> R \in |/|_H(A; pi^') -> R \subset 'O_pi^'(H). -Proof. by case: cstrA H R. Qed. - -(* This is the observation between B & G, Hypothesis 7.1 and Lemma 7.1. *) -Remark normed_constrained_Hall : pi^'.-Hall('C(A)) K. -Proof. -have [_ ntA prA _] := cstrA; rewrite -[setT]/G in prA. -rewrite /pHall pcore_pgroup pcore_sub pnatNK /=. -rewrite -card_quotient ?gFnorm //= -/K. -apply/pgroupP=> p p_pr; case/Cauchy=> // Kx; case/morphimP=> x Nx Cx ->{Kx}. -rewrite /order -quotient_cycle //= -/K => def_p; apply/idPn=> pi'p. -have [P sylP] := Sylow_exists p <[x]>; have [sPx pP _]:= and3P sylP. -suffices: P \subset K. - have nKP: P \subset 'N(K) by rewrite (subset_trans sPx) ?cycle_subG. - rewrite -quotient_sub1 //= -/K (sameP trivgP eqP) trivg_card1. - rewrite (card_Hall (morphim_pHall _ nKP sylP)) def_p part_pnat_id ?pnat_id //. - by case: eqP p_pr => // ->. -suffices sP_pAC: P \subset 'O_pi^'(A <*> 'C(A)). - rewrite (subset_trans sP_pAC) ?pcore_max ?pcore_pgroup //. - rewrite /normal gFnorm_trans ?normsG ?joing_subr // andbT. - rewrite -quotient_sub1; last first. - by rewrite gFsub_trans // join_subG !(normG, norms_cent). - rewrite /= -(setIidPr (pcore_sub _ _)) quotientGI ?joing_subr //=. - rewrite {1}cent_joinEr // quotientMidr coprime_TIg // coprime_morph //. - by rewrite coprime_pi' ?cardG_gt0 //= -/pi [pnat _ _]pcore_pgroup. -apply: hyp71; first exact: joing_subl. - apply: sub_proper_trans (mFT_norm_proper ntA prA). - by rewrite join_subG normG cent_sub. -have sPC: P \subset 'C(A) by rewrite (subset_trans sPx) ?cycle_subG. -rewrite inE /psubgroup cents_norm 1?centsC // andbT. -rewrite (subset_trans sPC) ?joing_subr //=. -by apply: sub_in_pnat pP => p' _; move/eqnP->. -Qed. -Let hallK := normed_constrained_Hall. - -(* This is B & G, Lemma 7.1. *) -Lemma normed_constrained_meet_trans Q1 Q2 H : - A \subset H -> H \proper G -> Q1 \in |/|*(A; q) -> Q2 \in |/|*(A; q) -> - Q1 :&: H != 1 -> Q2 :&: H != 1 -> - exists2 k, k \in K & Q2 :=: Q1 :^ k. -Proof. -move: {2}_.+1 (ltnSn (#|G| - #|Q1 :&: Q2|)) => m. -elim: m => // m IHm in H Q1 Q2 * => geQ12m sAH prHG maxQ1 maxQ2 ntHQ1 ntHQ2. -have:= maxQ1; rewrite inE => /maxgroupP[/andP[qQ1 nQ1A] maxQ1P]. -have:= maxQ2; rewrite inE => /maxgroupP[/andP[qQ2 nQ2A] maxQ2P]. -have prQ12: Q1 :&: Q2 \proper G. - rewrite properT; apply: contraNneq (mFT_nonSolvable gT) => <-. - by apply: pgroup_sol (pgroupS _ qQ1); rewrite subsetIl. -wlog defH: H prHG sAH ntHQ1 ntHQ2 / Q1 :&: Q2 != 1 -> H :=: 'N(Q1 :&: Q2). - case: (eqVneq (Q1 :&: Q2) 1) => [-> | ntQ12] IH. - by apply: (IH H) => //; case/eqP. - apply: (IH 'N(Q1 :&: Q2)%G); rewrite ?normsI ?mFT_norm_proper //; - apply: contra ntQ12; rewrite -!subG1; apply: subset_trans; - by rewrite subsetI normG (subsetIl, subsetIr). -pose L := 'O_pi^'(H); have sLH: L \subset H := pcore_sub _ _. -have [nLA coLA solL]: [/\ A \subset 'N(L), coprime #|L| #|A| & solvable L]. - rewrite gFnorm_trans ?normsG // coprime_sym coprime_pi' ?cardG_gt0 //. - by rewrite -pgroupE pcore_pgroup (solvableS sLH) ?mFT_sol. -have Qsyl Q: Q \in |/|*(A; q) -> Q :&: H != 1 -> - exists R : {group _}, [/\ q.-Sylow(L) R, A \subset 'N(R) & Q :&: H \subset R]. -- case/mem_max_normed=> qQ nQA ntQH. - have qQH: q.-group (Q :&: H) by rewrite (pgroupS _ qQ) ?subsetIl. - have nQHA: A \subset 'N(Q :&: H) by rewrite normsI // normsG. - apply: coprime_Hall_subset => //; apply: (hyp71) => //. - rewrite inE nQHA /psubgroup subsetIr andbT. - by apply: sub_in_pnat qQH => p _; move/eqnP->. -have [R1 [sylR1 nR1A sQR1]] := Qsyl _ maxQ1 ntHQ1. -have [R2 [sylR2 nR2A sQR2]] := Qsyl _ maxQ2 ntHQ2. -have [h Ch defR2] := coprime_Hall_trans nLA coLA solL sylR2 nR2A sylR1 nR1A. -have{Ch} [Hh Kh]: h \in H /\ h \in K. - case/setIP: Ch => Lh Ch; rewrite (subsetP sLH) //. - rewrite (mem_normal_Hall hallK (pcore_normal _ _)) //. - by rewrite (mem_p_elt _ Lh) ?pcore_pgroup. -have [Q3 maxQ3 sR2Q3] := max_normed_exists (pHall_pgroup sylR2) nR2A. -have maxQ1h: (Q1 :^ h)%G \in |/|*(A; q) by rewrite actsKmax. -case: (eqsVneq Q1 Q2) => [| neQ12]; first by exists 1; rewrite ?group1 ?conjsg1. -have ntHQ3: Q3 :&: H != 1. - by apply: subG1_contra ntHQ2; rewrite subsetI subsetIr (subset_trans sQR2). -have ntHQ1h: (Q1 :^ h) :&: H != 1. - by move: ntHQ1; rewrite !trivg_card1 -(cardJg _ h) conjIg (conjGid Hh). -suff [prI1 prI2]: Q1 :&: Q2 \proper Q1 :&: R1 /\ Q1 :&: Q2 \proper Q2 :&: R2. - have: #|G| - #|(Q1 :^ h) :&: Q3| < m. - rewrite ltnS in geQ12m; apply: leq_trans geQ12m. - rewrite ltn_sub2l ?(proper_card prQ12) // -(cardJg _ h) proper_card //. - by rewrite (proper_sub_trans _ (setIS _ sR2Q3)) // defR2 -conjIg properJ. - have: #|G| - #|Q3 :&: Q2| < m. - rewrite ltnS in geQ12m; apply: leq_trans geQ12m. - rewrite ltn_sub2l ?proper_card // (proper_sub_trans prI2) //. - by rewrite setIC setISS. - case/(IHm H) => // k2 Kk2 defQ2; case/(IHm H) => // k3 Kk3 defQ3. - by exists (h * k3 * k2); rewrite ?groupM ?conjsgM // -defQ3. -case: (eqVneq (Q1 :&: Q2) 1) => [-> | ntQ12]. - by rewrite !proper1G; split; [move: ntHQ1 | move: ntHQ2]; - apply: subG1_contra; rewrite subsetI subsetIl. -rewrite -(setIidPr (subset_trans (pHall_sub sylR1) sLH)) setIA. -rewrite -(setIidPr (subset_trans (pHall_sub sylR2) sLH)) setIA. -rewrite (setIidPl sQR1) (setIidPl sQR2) {}defH //. -have nilQ1 := pgroup_nil qQ1; have nilQ2 := pgroup_nil qQ2. -rewrite !nilpotent_proper_norm /proper ?subsetIl ?subsetIr ?subsetI ?subxx //=. - by rewrite andbT; apply: contra neQ12 => sQ21; rewrite (maxQ2P Q1) ?qQ1. -by apply: contra neQ12 => sQ12; rewrite (maxQ1P Q2) ?qQ2. -Qed. - -(* This is B & G, Theorem 7.2. *) -Theorem normed_constrained_rank3_trans : - 'r('Z(A)) >= 3 -> [transitive K, on |/|*(A; q) | 'JG]. -Proof. -case/rank_geP=> B /nElemP[p]; rewrite !inE subsetI -2!andbA. -case/and4P=> sBA cAB abelB mB3; have [_ cBB _] := and3P abelB. -have q'B: forall Q, q.-group Q -> coprime #|Q| #|B|. - move=> Q qQ; rewrite coprime_sym (coprimeSg sBA) ?coprime_pi' //. - exact: pi_pnat qQ _. -have [Q1 maxQ1 _] := max_normed_exists (pgroup1 _ q) (norms1 A). -apply/imsetP; exists Q1 => //; apply/setP=> Q2. -apply/idP/imsetP=> [maxQ2|[k Kk] ->]; last by rewrite actsKmax. -have [qQ1 nQ1A]:= mem_max_normed maxQ1; have [qQ2 nQ2A]:= mem_max_normed maxQ2. -case: (eqVneq Q1 1%G) => [trQ1 | ntQ1]. - exists 1; rewrite ?group1 // act1; apply/eqP. - by rewrite trivg_max_norm -trQ1 // inE in maxQ2. -case: (eqVneq Q2 1%G) => [trQ2 | ntQ2]. - by case/negP: ntQ1; rewrite trivg_max_norm -trQ2 // inE in maxQ1 *. -have: [exists (C : grT | 'C_Q1(C) != 1), cyclic (B / C) && (C <| B)]. - apply: contraR ntQ1 => trQ1; have: B \subset 'N(Q1) := subset_trans sBA nQ1A. - rewrite -val_eqE -subG1 /=; move/coprime_abelian_gen_cent <-; rewrite ?q'B //. - rewrite gen_subG; apply/bigcupsP=> C cocyC; rewrite subG1. - by apply: contraR trQ1 => ntCC; apply/existsP; exists C; rewrite ntCC. -case/existsP=> C /and3P[ntCQ1 cycBC nsCB]; have [sCB nCB]:= andP nsCB. -have{mB3} ncycC: ~~ cyclic C. - rewrite (abelem_cyclic (quotient_abelem _ abelB)) ?card_quotient // in cycBC. - rewrite -divgS // logn_div ?cardSg // leq_subLR addn1 (eqP mB3) in cycBC. - by rewrite (abelem_cyclic (abelemS sCB abelB)) -ltnNge. -have: [exists (z | 'C_Q2[z] != 1), z \in C^#]. - apply: contraR ntQ2 => trQ2; have:= subset_trans sCB (subset_trans sBA nQ2A). - rewrite -[_ == _]subG1 /=. - move/coprime_abelian_gen_cent1 <-; rewrite ?(abelianS sCB) //; last first. - by rewrite (coprimegS sCB) ?q'B. - rewrite gen_subG; apply/bigcupsP=> z Cz. - by apply: contraR trQ2 => ntCz; apply/existsP; exists z; rewrite -subG1 ntCz. -case/existsP=> z; rewrite !inE => /and3P[ntzQ2 ntz Cz]. -have prCz: 'C[z] \proper G by rewrite -cent_cycle mFT_cent_proper ?cycle_eq1. -have sACz: A \subset 'C[z] by rewrite sub_cent1 (subsetP cAB) ?(subsetP sCB). -have [|//|k Kk defQ2]:= normed_constrained_meet_trans sACz prCz maxQ1 maxQ2. - by apply: subG1_contra ntCQ1; rewrite setIS //= -cent_cycle centS ?cycle_subG. -by exists k => //; apply: val_inj. -Qed. - -(* This is B & G, Theorem 7.3. *) -Theorem normed_constrained_rank2_trans : - q %| #|'C(A)| -> 'r('Z(A)) >= 2 -> [transitive K, on |/|*(A; q) | 'JG]. -Proof. -move=> qC /rank_geP[B /nElemP[p /setIdP[/setIdP[/subsetIP[sBA cAB] abelB] oB]]]. -have [_ cBB _] := and3P abelB. -have{abelB oB} ncycB: ~~ cyclic B by rewrite (abelem_cyclic abelB) (eqP oB). -have [R0 sylR0] := Sylow_exists q 'C(A); have [cAR0 qR0 _] := and3P sylR0. -have nR0A: A \subset 'N(R0) by rewrite cents_norm // centsC. -have{nR0A} [R maxR sR0R] := max_normed_exists qR0 nR0A. -apply/imsetP; exists R => //; apply/setP=> Q. -apply/idP/imsetP=> [maxQ|[k Kk] ->]; last by rewrite actsKmax. -have [qR nRA]:= mem_max_normed maxR; have [qQ nQA]:= mem_max_normed maxQ. -have [R1 | ntR] := eqVneq R 1%G. - rewrite trivg_max_norm -R1 // in maxQ. - by exists 1; rewrite ?group1 ?act1 ?(set1P maxQ). -have ntQ: Q != 1%G. - by apply: contra ntR => Q1; rewrite trivg_max_norm -(eqP Q1) // inE in maxR *. -have ntRC: 'C_R(A) != 1. - have sR0CR: R0 \subset 'C_R(A) by rewrite subsetI sR0R. - suffices: R0 :!=: 1 by apply: subG1_contra. - move: ntR; rewrite -!cardG_gt1 -(part_pnat_id qR) (card_Hall sylR0). - by rewrite !p_part_gt1 !mem_primes !cardG_gt0 qC => /and3P[->]. -have: [exists (z | 'C_Q[z] != 1), z \in B^#]. - apply: contraR ntQ => trQ; have:= subset_trans sBA nQA. - rewrite -[_ == _]subG1=> /coprime_abelian_gen_cent1 <- //; last first. - by rewrite coprime_sym (coprimeSg sBA) ?coprime_pi' /pgroup ?(pi_pnat qQ). - rewrite gen_subG; apply/bigcupsP=> z Cz; rewrite subG1. - by apply: contraR trQ => ntCz; apply/existsP; exists z; rewrite ntCz. -case/existsP=> z; rewrite 2!inE => /and3P[ntzQ ntz Bz]. -have prCz: 'C[z] \proper G by rewrite -cent_cycle mFT_cent_proper ?cycle_eq1. -have sACz: A \subset 'C[z] by rewrite sub_cent1 (subsetP cAB). -have [|//|k Kk defQ2]:= normed_constrained_meet_trans sACz prCz maxR maxQ. - apply: subG1_contra ntRC; rewrite setIS //=. - by rewrite -cent_cycle centS // cycle_subG (subsetP sBA). -by exists k => //; apply: val_inj. -Qed. - -(* This is B & G, Theorem 7.4. *) -Theorem normed_trans_superset P : - A <|<| P -> pi.-group P -> [transitive K, on |/|*(A; q) | 'JG] -> - [/\ 'C_K(P) = 'O_pi^'('C(P)), - [transitive 'O_pi^'('C(P)), on |/|*(P; q) | 'JG], - |/|*(P; q) \subset |/|*(A; q) - & {in |/|*(P; q), forall Q, P :&: 'N(P)^`(1) \subset 'N(Q)^`(1) - /\ 'N(P) = 'C_K(P) * 'N_('N(P))(Q)}]. -Proof. -move=> snAP piP trnK; set KP := 'O_pi^'('C(P)). -have defK B: A \subset B -> 'C_K(B) = 'O_pi^'('C(B)). - move=> sAB; apply/eqP; rewrite eqEsubset {1}setIC pcoreS ?centS // subsetI. - by rewrite gFsub (sub_Hall_pcore hallK) ?pcore_pgroup // gFsub_trans ?centS. -suffices: [transitive KP, on |/|*(P; q) | 'JG] /\ |/|*(P; q) \subset |/|*(A; q). - have nsKPN: KP <| 'N(P) := gFnormal_trans _ (cent_normal _). - case=> trKP smnPA; rewrite (defK _ (subnormal_sub snAP)); split=> // Q maxQ. - have defNP: KP * 'N_('N(P))(Q) = 'N(P). - rewrite -(astab1JG Q) -normC; last by rewrite subIset 1?normal_norm. - apply/(subgroup_transitiveP maxQ); rewrite ?normal_sub //=. - by rewrite (atrans_supgroup _ trKP) ?norm_acts_max_norm ?normal_sub. - split=> //; move/pprod_focal_coprime: defNP => -> //. - - by rewrite subIset // orbC commgSS ?subsetIr. - - by rewrite subsetI normG; case/mem_max_normed: maxQ. - by rewrite (p'nat_coprime (pcore_pgroup _ _)). -elim: {P}_.+1 {-2}P (ltnSn #|P|) => // m IHm P lePm in KP piP snAP *. -wlog{snAP} [B maxnB snAB]: / {B : grT | maxnormal B P P & A <|<| B}. - case/subnormalEr: snAP => [|[D [snAD nDP prDP]]]; first by rewrite /KP => <-. - have [B maxnB sDB]: {B : grT | maxnormal B P P & D \subset B}. - by apply: maxgroup_exists; rewrite prDP normal_norm. - apply; exists B => //; apply: subnormal_trans snAD (normal_subnormal _). - by apply: normalS sDB _ nDP; case/andP: (maxgroupp maxnB); case/andP. -have [prBP nBP] := andP (maxgroupp maxnB); have sBP := proper_sub prBP. -have{lePm}: #|B| < m by apply: leq_trans (proper_card prBP) _. -case/IHm=> {IHm}// [|trnB smnBA]; first by rewrite (pgroupS sBP). -have{maxnB} abelPB: is_abelem (P / B). - apply: charsimple_solvable (maxnormal_charsimple _ maxnB) _ => //. - have [_ ntA _ _] := cstrA; have sAB := subnormal_sub snAB. - by apply: mFT_quo_sol; apply: contraL sAB; move/eqP->; rewrite subG1. -have{abelPB} [p p_pr pPB]: exists2 p, prime p & p.-group (P / B). - by case/is_abelemP: abelPB => p p_pr; case/andP; exists p. -have{prBP} pi_p: p \in pi. - case/pgroup_pdiv: pPB => [|_ pPB _]. - by rewrite -subG1 quotient_sub1 // proper_subn. - by apply: pgroupP p_pr pPB; apply: quotient_pgroup. -pose S := |/|*(B; q); have p'S: #|S| %% p != 0. - have pi'S: pi^'.-nat #|S| := pnat_dvd (atrans_dvd trnB) (pcore_pgroup _ _). - by rewrite -prime_coprime // (pnat_coprime _ pi'S) ?pnatE. -have{p'S} [Q S_Q nQP]: exists2 Q, Q \in S & P \subset 'N(Q). - have sTSB: setT \subset G / B by rewrite -im_quotient quotientS ?subsetT. - have modBE: {in P & S, forall x Q, ('JG %% B) Q (coset B x) = 'JG Q x}%act. - move=> x Q Px; rewrite inE; move/maxgroupp; case/andP=> _ nQB. - by rewrite /= modactE ?(subsetP nBP) ?afixJG ?setTI ?inE. - have actsPB: [acts P / B, on S | 'JG %% B \ sTSB]. - apply/subsetP=> _ /morphimP[x Nx Px ->]. - rewrite !inE; apply/subsetP=> Q S_Q; rewrite inE /= modBE //. - by rewrite (actsP (norm_acts_max_norm q B)). - move: p'S; rewrite (pgroup_fix_mod pPB actsPB); set nQ := #|_|. - case: (posnP nQ) => [->|]; first by rewrite mod0n. - rewrite lt0n; case/existsP=> Q /setIP[Q_S fixQ]; exists Q => //. - apply/normsP=> x Px; apply: congr_group; have Nx := subsetP nBP x Px. - by have:= afixP fixQ (coset B x); rewrite /= modBE ?mem_morphim //= => ->. -have [qQ _]:= mem_max_normed S_Q. -have{qQ nQP} [Q0 maxQ0 sQQ0] := max_normed_exists qQ nQP. -have [_ nQ0P]:= mem_max_normed maxQ0. -have actsKmnP: [acts 'O_pi^'('C(P)), on |/|*(P; q) | 'JG]. - by rewrite (subset_trans _ (norm_acts_max_norm q P)) // cents_norm ?pcore_sub. -case nt_mnP: (1%G \in |/|*(P; q)) => [|{Q S_Q sQQ0}]. - rewrite atrans_acts_card actsKmnP trivg_max_norm // imset_set1 in maxQ0 *. - have <-: Q = 1%G by apply/trivGP; rewrite -(congr_group (set1P maxQ0)). - by rewrite cards1 sub1set (subsetP smnBA). -have sAB := subnormal_sub snAB; have sAP := subset_trans sAB sBP. -have smnP_S: |/|*(P; q) \subset S. - apply/subsetP=> Q1 maxQ1; have [qQ1 nQ1P] := mem_max_normed maxQ1. - have ntQ1: Q1 != 1%G by case: eqP nt_mnP maxQ1 => // -> ->. - have prNQ1: 'N(Q1) \proper G := mFT_norm_proper ntQ1 (mFT_pgroup_proper qQ1). - have nQ1A: A \subset 'N(Q1) := subset_trans sAP nQ1P. - have [Q2 maxQ2 sQ12] := max_normed_exists qQ1 (subset_trans sBP nQ1P). - have [qQ2 nQ2B] := mem_max_normed maxQ2; apply: etrans maxQ2; congr in_mem. - apply: val_inj; suffices: q.-Sylow(Q2) Q1 by move/pHall_id=> /= ->. - have qNQ2: q.-group 'N_Q2(Q1) by rewrite (pgroupS _ qQ2) ?subsetIl. - pose KN := 'O_pi^'('N(Q1)); have sNQ2_KN: 'N_Q2(Q1) \subset KN. - rewrite hyp71 // inE normsI ?norms_norm ?(subset_trans sAB nQ2B) //=. - by rewrite /psubgroup subsetIr andbT; apply: pi_pnat qNQ2 _. - rewrite -Sylow_subnorm (pHall_subl _ sNQ2_KN) ?subsetI ?sQ12 ?normG //= -/KN. - suff: exists Q3 : grT, [/\ q.-Sylow(KN) Q3, P \subset 'N(Q3) & Q1 \subset Q3]. - move: maxQ1; rewrite inE; case/maxgroupP=> _ maxQ1 [Q3 [sylQ3 nQ3P sQ13]]. - by rewrite -(maxQ1 Q3) // (pHall_pgroup sylQ3). - apply: coprime_Hall_subset; rewrite //= -/KN. - - by rewrite gFnorm_trans ?norms_norm. - - by rewrite coprime_sym (pnat_coprime piP (pcore_pgroup _ _)). - - by rewrite (solvableS (pcore_sub _ _)) ?mFT_sol. - by rewrite pcore_max ?normalG // /pgroup (pi_pnat qQ1). -split; last exact: subset_trans smnP_S smnBA. -apply/imsetP; exists Q0 => //; apply/setP=> Q2. -apply/idP/imsetP=> [maxQ2 | [k Pk ->]]; last by rewrite (actsP actsKmnP). -have [S_Q0 S_Q2]: Q0 \in S /\ Q2 \in S by rewrite !(subsetP smnP_S). -pose KB := 'O_pi^'('C(B)); pose KBP := KB <*> P. -have pi'KB: pi^'.-group KB by apply: pcore_pgroup. -have nKB_P: P \subset 'N(KB) by rewrite gFnorm_trans ?norms_cent. -have [k KBk defQ2]:= atransP2 trnB S_Q0 S_Q2. -have [qQ2 nQ2P] := mem_max_normed maxQ2. -have hallP: pi.-Hall('N_KBP(Q2)) P. - have sPN: P \subset 'N_KBP(Q2) by rewrite subsetI joing_subr. - rewrite pHallE eqn_leq -{1}(part_pnat_id piP) dvdn_leq ?partn_dvd ?cardSg //. - have ->: #|P| = #|KBP|`_pi. - rewrite /KBP joingC norm_joinEl // coprime_cardMg ?(pnat_coprime piP) //. - by rewrite partnM // part_pnat_id // part_p'nat // muln1. - by rewrite sPN dvdn_leq ?partn_dvd ?cardSg ?cardG_gt0 ?subsetIl. -have hallPk: pi.-Hall('N_KBP(Q2)) (P :^ k). - rewrite pHallE -(card_Hall hallP) cardJg eqxx andbT subsetI /=. - by rewrite defQ2 normJ conjSg conj_subG ?joing_subr // mem_gen // inE KBk. -have [gz]: exists2 gz, gz \in 'N_KBP(Q2) & P :=: (P :^ k) :^ gz. - apply: Hall_trans (solvableS (subsetIr _ _) _) hallP hallPk. - have ntQ2: Q2 != 1%G by case: eqP nt_mnP maxQ2 => // -> ->. - exact: mFT_sol (mFT_norm_proper ntQ2 (mFT_pgroup_proper qQ2)). -rewrite [KBP]norm_joinEr //= setIC -group_modr //= setIC -/KB. -case/imset2P=> g z; case/setIP=> KBg nQ2g Pz ->{gz} defP. -exists (k * g); last first. - by apply: val_inj; rewrite /= conjsgM -(normP nQ2g) defQ2. -rewrite /KP -defK // (subsetP (subsetIl _ 'C(B))) //= setIAC defK // -/KB. -rewrite -coprime_norm_cent 1?coprime_sym ?(pnat_coprime piP) //= -/KB. -rewrite inE groupM //; apply/normP. -by rewrite -{2}(conjsgK z P) (conjGid Pz) {2}defP /= !conjsgM conjsgK. -Qed. - -End NormedConstrained. - -(* This is B & G, Proposition 7.5(a). As this is only used in Proposition *) -(* 10.10, under the assumption A \in E*_p(G), we avoid the in_pmaxElemE *) -(* detour A = [set x in 'C_G(A) | x ^+ p == 1], and just use A \in E*_p(G). *) -Proposition plength_1_normed_constrained p A : - A :!=: 1 -> A \in 'E*_p(G) -> (forall M, M \proper G -> p.-length_1 M) -> - normed_constrained A. -Proof. -move=> ntA EpA pl1subG. -case/pmaxElemP: (EpA); case/pElemP=> sAG; case/and3P=> pA cAA _ _. -have prA: A \proper G := sub_proper_trans cAA (mFT_cent_proper ntA). -split=> // X Y sAX prX; case/setIdP; case/andP=> sYX p'Y nYA. -have pl1X := pl1subG _ prX; have solX := mFT_sol prX. -have [p_pr _ [r oApr]] := pgroup_pdiv pA ntA. -have oddp: odd p by move: (mFT_odd A); rewrite oApr odd_exp. -have def_pi: \pi(A)^' =i p^'. - by move=> q; rewrite inE /= oApr pi_of_exp // pi_of_prime. -have{p'Y} p'Y : p^'.-group Y by rewrite -(eq_pgroup _ def_pi). -rewrite (eq_pcore _ def_pi) (@plength1_norm_pmaxElem _ p X A) //. -by rewrite (subsetP (pmaxElemS p (subsetT _))) // setIC 2!inE sAX. -Qed. - -(* This is B & G, Proposition 7.5(b). *) -Proposition SCN_normed_constrained p P A : - p.-Sylow(G) P -> A \in 'SCN_2(P) -> normed_constrained A. -Proof. -move=> sylP; rewrite 2!inE -andbA => /and3P[nsAP /eqP defCA lt1mA]. -have [sAP nAP]:= andP nsAP. -have pP := pHall_pgroup sylP; have pA := pgroupS sAP pP. -have abA: abelian A by rewrite /abelian -{1}defCA subsetIr. -have prP: P \proper G := mFT_pgroup_proper pP. -have ntA: A :!=: 1 by rewrite -rank_gt0 ltnW. -pose pi := \pi(A); simpl in pi. -have [p_pr pdvA [r oApr]] := pgroup_pdiv pA ntA. -have{r oApr} def_pi: pi =i (p : nat_pred). - by move=> p'; rewrite !inE oApr primes_exp // primes_prime ?inE. -have def_pi' := eq_negn def_pi; have defK := eq_pcore _ def_pi'. -pose Z := 'Ohm_1('Z(P)); have sZ_ZP: Z \subset 'Z(P) by apply: Ohm_sub. -have sZP_A: 'Z(P) \subset A by rewrite -defCA setIS ?centS. -have sZA := subset_trans sZ_ZP sZP_A. -have nsA1: 'Ohm_1(A) <| P by apply: gFnormal_trans. -pose inZor1 B := B \subset Z \/ #|Z| = p /\ Z \subset B. -have [B [E2_B nsBP sBZ]]: exists B, [/\ B \in 'E_p^2(A), B <| P & inZor1 B]. - have pZP: p.-group 'Z(P) by apply: pgroupS (center_sub _) pP. - have pZ: p.-group Z by apply: pgroupS sZ_ZP pZP. - have abelZ: p.-abelem Z by rewrite Ohm1_abelem ?center_abelian. - have nsZP: Z <| P := sub_center_normal sZ_ZP; have [sZP nZP] := andP nsZP. - case: (eqVneq Z 1). - rewrite -(setIidPr sZ_ZP); move/TI_Ohm1; rewrite setIid. - by move/(trivg_center_pgroup pP)=> P1; rewrite -subG1 -P1 sAP in ntA. - case/(pgroup_pdiv pZ)=> _ _ [[|k] /=]; rewrite -/Z => oZ; last first. - have: 2 <= 'r_p(Z) by rewrite p_rank_abelem // oZ pfactorK. - case/p_rank_geP=> B; rewrite /= -/Z => Ep2Z_B; exists B. - rewrite (subsetP (pnElemS _ _ sZA)) //. - case/setIdP: Ep2Z_B; case/setIdP=> sBZ _ _; split=> //; last by left. - by rewrite sub_center_normal ?(subset_trans sBZ). - pose BZ := ('Ohm_1(A) / Z) :&: 'Z(P / Z). - have ntBz: BZ != 1. - rewrite meet_center_nil ?quotient_nil ?(pgroup_nil pP) ?quotient_normal //. - rewrite -subG1 quotient_sub1 ?(subset_trans (normal_sub nsA1) nZP) //= -/Z. - apply: contraL lt1mA => sA1Z; rewrite -(pfactorK 1 p_pr) -oZ -rank_Ohm1. - by rewrite -(rank_abelem abelZ) -leqNgt rankS. - have lt1A1: 1 < logn p #|'Ohm_1(A)| by rewrite -p_rank_abelian -?rank_pgroup. - have [B [sBA1 nsBP oB]] := normal_pgroup pP nsA1 lt1A1. - exists B; split=> //; last do [right; split=> //]. - rewrite 2!inE (subset_trans sBA1) ?Ohm_sub // oB pfactorK //. - by rewrite (abelemS sBA1) ?Ohm1_abelem. - apply/idPn=> s'BZ; have: B :&: Z = 1 by rewrite setIC prime_TIg ?oZ. - move/TI_Ohm1; apply/eqP; rewrite meet_center_nil ?(pgroup_nil pP) //. - by rewrite -cardG_gt1 oB (ltn_exp2l 0 _ (prime_gt1 p_pr)). -split; rewrite ?(sub_proper_trans sAP) // => X Y sAX prX. -rewrite inE defK -andbA (eq_pgroup _ def_pi'); case/and3P=> sYX p'Y nYA. -move: E2_B; rewrite 2!inE -andbA; case/and3P=> sBA abelB dimB2. -have [pB cBB _] := and3P abelB. -have ntB: B :!=: 1 by case: (eqsVneq B 1) dimB2 => // ->; rewrite cards1 logn1. -have cBA b: b \in B -> A \subset 'C[b]. - by move=> Bb; rewrite -cent_set1 centsC sub1set (subsetP abA) ?(subsetP sBA). -have solCB (b : gT): b != 1 -> solvable 'C[b]. - by move=> ntb; rewrite mFT_sol ?mFT_cent1_proper. -wlog{sAX prX} [b B'b defX]: X Y p'Y nYA sYX / exists2 b, b \in B^# & 'C[b] = X. - move=> IH; have nYB := subset_trans sBA nYA. - rewrite -(coprime_abelian_gen_cent1 cBB _ nYB); last first. - - by rewrite coprime_sym (pnat_coprime pB). - - apply: contraL dimB2 => /cyclicP[x defB]. - have Bx: x \in B by rewrite defB cycle_id. - rewrite defB -orderE (abelem_order_p abelB Bx) ?(pfactorK 1) //. - by rewrite -cycle_eq1 -defB. - rewrite gen_subG; apply/bigcupsP=> b B'b. - have [ntb Bb]:= setD1P B'b; have sYbY: 'C_Y[b] \subset Y := subsetIl _ _. - have{IH} sYbKb: 'C_Y[b] \subset 'O_p^'('C[b]). - rewrite IH ?(pgroupS sYbY) ?subsetIr //; last by exists b. - by rewrite normsI // ?normsG ?cBA. - have{sYbKb} sYbKXb: 'C_Y[b] \subset 'O_p^'('C_X(<[b]>)). - apply: subset_trans (pcoreS _ (subsetIr _ _)). - by rewrite /= cent_gen cent_set1 subsetI setSI. - rewrite (subset_trans sYbKXb) // p'core_cent_pgroup ?mFT_sol //. - rewrite /psubgroup ?(pgroupS _ pB) cycle_subG //. - by rewrite (subsetP sAX) ?(subsetP sBA). -wlog Zb: b X Y defX B'b p'Y nYA sYX / b \in Z. - move=> IH; case Zb: (b \in Z); first exact: IH Zb. - case/setD1P: B'b => ntb Bb; have solX := solCB b ntb; rewrite defX in solX. - case: sBZ => [sBZ | [oZ sZB]]; first by rewrite (subsetP sBZ) in Zb. - have defB: Z * <[b]> = B. - apply/eqP; rewrite eqEcard mulG_subG sZB cycle_subG Bb. - have obp := abelem_order_p abelB Bb ntb. - rewrite (card_pgroup pB) /= (eqP dimB2) TI_cardMg -/#[_] ?oZ ?obp //. - rewrite -obp in p_pr; case: (prime_subgroupVti [group of Z] p_pr) => //. - by rewrite cycle_subG Zb. - pose P1 := P :&: X; have sP1P: P1 \subset P := subsetIl _ _. - have pP1 := pgroupS sP1P pP. - have [P2 sylP2 sP12] := Sylow_superset (subsetIr _ _) pP1. - have defP1: P1 = 'C_P(B). - rewrite -defB centM /= -/Z setIA /cycle cent_gen cent_set1 defX. - by rewrite [P :&: _](setIidPl _) // centsC (subset_trans sZ_ZP) ?subsetIr. - have dimPP1: logn p #|P : P1| <= 1. - by rewrite defP1 logn_quotient_cent_abelem ?normal_norm ?(eqP dimB2). - have{dimPP1} nsP12: P1 <| P2. - have pP2 := pHall_pgroup sylP2. - have: logn p #|P2 : P1| <= 1. - apply: leq_trans dimPP1; rewrite dvdn_leq_log //. - rewrite -(dvdn_pmul2l (cardG_gt0 [group of P1])) !Lagrange ?subsetIl //. - rewrite -(part_pnat_id pP2) (card_Hall sylP). - by rewrite partn_dvd ?cardSg ?subsetT. - rewrite -(pfactorK 1 p_pr) -pfactor_dvdn ?prime_gt0 // -p_part. - rewrite part_pnat_id ?(pnat_dvd (dvdn_indexg _ _)) //=. - case: (primeP p_pr) => _ dv_p; move/dv_p=> {dv_p}. - case/pred2P=> oP21; first by rewrite -(index1g sP12 oP21) normal_refl. - by rewrite (p_maximal_normal pP2) ?p_index_maximal ?oP21. - have nsZP1_2: 'Z(P1) <| P2 by rewrite gFnormal_trans. - have sZKp: Z \subset 'O_{p^', p}(X). - suff: 'Z(P1) \subset 'O_{p^', p}(X). - apply: subset_trans; rewrite subsetI {1}defP1 (subset_trans sZB). - by rewrite (subset_trans sZ_ZP) ?subIset // orbC centS. - by rewrite subsetI normal_sub. - apply: odd_p_abelian_constrained sylP2 (center_abelian _) nsZP1_2 => //. - exact: mFT_odd. - have coYZ: coprime #|Y| #|Z|. - by rewrite oZ coprime_sym (pnat_coprime _ p'Y) ?pnatE ?inE. - have nYZ := subset_trans sZA nYA. - have <-: [~: Y, Z] * 'C_Y(Z) = Y. - exact: coprime_cent_prod (solvableS sYX solX). - set K := 'O_p^'(X); have [nKY nKZ]: Y \subset 'N(K) /\ Z \subset 'N(K). - by rewrite !gFnorm_trans ?(subset_trans sZA) ?normsG // -defX cBA. - rewrite mul_subG //. - have coYZK: coprime #|Y / K| #|'O_p(X / K)|. - by rewrite coprime_sym coprime_morphr ?(pnat_coprime (pcore_pgroup _ _)). - rewrite -quotient_sub1 ?comm_subG // -(coprime_TIg coYZK) subsetI. - rewrite /= -quotient_pseries2 !quotientS ?commg_subl //. - by rewrite (subset_trans (commgSS sYX sZKp)) ?commg_subr //= gFnorm. - have: 'O_p^'('C_X(Z)) \subset K. - rewrite p'core_cent_pgroup // /psubgroup /pgroup oZ pnat_id //. - by rewrite -defX (subset_trans sZA) ?cBA. - apply: subset_trans; apply: subset_trans (pcoreS _ (subsetIr _ _)). - have: cyclic Z by rewrite prime_cyclic ?oZ. - case/cyclicP=> z defZ; have Zz: z \in Z by rewrite defZ cycle_id. - rewrite subsetI setSI //= (IH z) ?subsetIr ?(pgroupS (subsetIl _ _)) //. - - by rewrite defZ /= cent_gen cent_set1. - - rewrite !inE -cycle_eq1 -defZ trivg_card_le1 oZ -ltnNge prime_gt1 //=. - by rewrite (subsetP sZB). - by rewrite normsI // norms_cent // cents_norm // centsC (subset_trans sZA). -set K := 'O_p^'(X); have nsKX: K <| X by apply: pcore_normal. -case/setD1P: B'b => ntb Bb. -have [sAX solX]: A \subset X /\ solvable X by rewrite -defX cBA ?solCB. -have sPX: P \subset X. - by rewrite -defX -cent_set1 centsC sub1set; case/setIP: (subsetP sZ_ZP b Zb). -have [nKA nKY nKP]: [/\ A \subset 'N(K), Y \subset 'N(K) & P \subset 'N(K)]. - by rewrite !(subset_trans _ (normal_norm nsKX)). -have sylPX: p.-Sylow(X) P by apply: pHall_subl (subsetT _) sylP. -have sAKb: A \subset 'O_{p^', p}(X). - exact: (odd_p_abelian_constrained (mFT_odd _)) abA nsAP. -have coYZK: coprime #|Y / K| #|'O_p(X / K)|. - by rewrite coprime_sym coprime_morphr ?(pnat_coprime (pcore_pgroup _ _)). -have cYAq: A / K \subset 'C_('O_p(X / K))(Y / K). - rewrite subsetI -quotient_pseries2 quotientS //= (sameP commG1P trivgP). - rewrite /= -quotientR // -(coprime_TIg coYZK) subsetI /= -quotient_pseries2. - rewrite !quotientS ?commg_subr // (subset_trans (commgSS sAKb sYX)) //. - by rewrite commg_subl /= gFnorm. -have cYKq: Y / K \subset 'C('O_p(X / K)). - apply: coprime_nil_faithful_cent_stab => /=. - - by rewrite gFnorm_trans ?normsG ?quotientS. - - by rewrite coprime_sym. - - exact: pgroup_nil (pcore_pgroup _ _). - apply: subset_trans (cYAq); rewrite -defCA -['C_P(A) / K](morphim_restrm nKP). - rewrite injm_cent ?ker_restrm ?ker_coset ?morphim_restrm -?quotientE //. - rewrite setIid (setIidPr sAP) setISS ?centS //. - by rewrite pcore_sub_Hall ?morphim_pHall. - by rewrite coprime_TIg ?(pnat_coprime _ (pcore_pgroup _ _)). -rewrite -quotient_sub1 //= -/K -(coprime_TIg coYZK) subsetI subxx /=. -rewrite -Fitting_eq_pcore ?trivg_pcore_quotient // in cYKq *. -apply: subset_trans (cent_sub_Fitting (quotient_sol _ solX)). -by rewrite subsetI quotientS. -Qed. - -(* This is B & G, Theorem 7.6 (the Thompson Transitivity Theorem). *) -Theorem Thompson_transitivity p q A : - A \in 'SCN_3[p] -> q \in p^' -> - [transitive 'O_p^'('C(A)), on |/|*(A; q) | 'JG]. -Proof. -case/bigcupP=> P; rewrite 2!inE => sylP /andP[SCN_A mA3]. -have [defZ def_pi']: 'Z(A) = A /\ \pi(A)^' =i p^'. - rewrite inE -andbA in SCN_A; case/and3P: SCN_A => sAP _ /eqP defCA. - case: (eqsVneq A 1) mA3 => /= [-> | ntA _]. - rewrite /rank big1_seq // => p1 _; rewrite /p_rank big1 // => E. - by rewrite inE; case/andP; move/trivgP->; rewrite cards1 logn1. - have [p_pr _ [k ->]] := pgroup_pdiv (pgroupS sAP (pHall_pgroup sylP)) ntA. - split=> [|p1]; last by rewrite !inE primes_exp // primes_prime ?inE. - by apply/eqP; rewrite eqEsubset subsetIl subsetI subxx -{1}defCA subsetIr. -rewrite -(eq_pcore _ def_pi') -def_pi' => pi'q. -apply: normed_constrained_rank3_trans; rewrite ?defZ //. -by apply: SCN_normed_constrained sylP _; rewrite inE SCN_A ltnW. -Qed. - -End Seven. - diff --git a/mathcomp/odd_order/BGsection8.v b/mathcomp/odd_order/BGsection8.v deleted file mode 100644 index 513d6d1..0000000 --- a/mathcomp/odd_order/BGsection8.v +++ /dev/null @@ -1,401 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq div fintype path. -From mathcomp -Require Import finset prime fingroup automorphism action gproduct gfunctor. -From mathcomp -Require Import center commutator pgroup gseries nilpotent sylow abelian maximal. -From mathcomp -Require Import BGsection1 BGsection5 BGsection6 BGsection7. - -(******************************************************************************) -(* This file covers B & G, section 8, i.e., the proof of two special cases *) -(* of the Uniqueness Theorem, for maximal groups with Fitting subgroups of *) -(* rank at least 3. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope. - -Section Eight. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). -Implicit Types H M A X P : {group gT}. -Implicit Types p q r : nat. - -Local Notation "K ` p" := 'O_(nat_pred_of_nat p)(K) - (at level 8, p at level 2, format "K ` p") : group_scope. -Local Notation "K ` p" := 'O_(nat_pred_of_nat p)(K)%G : Group_scope. - -(* This is B & G, Theorem 8.1(a). *) -Theorem non_pcore_Fitting_Uniqueness p M A0 : - M \in 'M -> ~~ p.-group ('F(M)) -> A0 \in 'E*_p('F(M)) -> 'r_p(A0) >= 3 -> - 'C_('F(M))(A0)%G \in 'U. -Proof. -set F := 'F(M) => maxM p'F /pmaxElemP[/=/setIdP[sA0F abelA0] maxA0]. -have [pA0 cA0A0 _] := and3P abelA0; rewrite (p_rank_abelem abelA0) => dimA0_3. -rewrite (uniq_mmax_subset1 maxM) //= -/F; last by rewrite subIset ?Fitting_sub. -set A := 'C_F(A0); pose pi := \pi(A). -have [sZA sAF]: 'Z(F) \subset A /\ A \subset F by rewrite subsetIl setIS ?centS. -have nilF: nilpotent F := Fitting_nil _. -have nilZ := nilpotentS (center_sub _) nilF. -have piZ: \pi('Z(F)) = \pi(F) by rewrite pi_center_nilpotent. -have def_pi: pi = \pi(F). - by apply/eq_piP=> q; apply/idP/idP; last rewrite -piZ; apply: piSg. -have def_nZq: forall q, q \in pi -> 'N('Z(F)`q) = M. - move=> q; rewrite def_pi -piZ -p_part_gt1. - rewrite -(card_Hall (nilpotent_pcore_Hall _ nilZ)) cardG_gt1 /= -/F => ntZ. - by apply: mmax_normal => //=; rewrite !gFnormal_trans. -have sCqM: forall q, q \in pi -> 'C(A`q) \subset M. - move=> q /def_nZq <-; rewrite cents_norm // centS //. - rewrite (sub_Hall_pcore (nilpotent_pcore_Hall _ _)) ?pcore_pgroup //. - by apply: nilpotentS (Fitting_nil M); apply: subsetIl. - exact: gFsub_trans. -have sA0A: A0 \subset A by rewrite subsetI sA0F. -have pi_p: p \in pi. - by apply: (piSg sA0A); rewrite -[p \in _]logn_gt0 (leq_trans _ dimA0_3). -have sCAM: 'C(A) \subset M. - by rewrite (subset_trans (centS (pcore_sub p _))) ?sCqM. -have prM: M \proper G := mmax_proper maxM; have solM := mFT_sol prM. -have piCA: pi.-group('C(A)). - apply/pgroupP=> q q_pr; case/Cauchy=> // x cAx oxq; apply/idPn=> pi'q. - have Mx := subsetP sCAM x cAx; pose C := 'C_F(<[x]>). - have sAC: A \subset C by rewrite subsetI sAF centsC cycle_subG. - have sCFC_C: 'C_F(C) \subset C. - by rewrite (subset_trans _ sAC) ?setIS // centS ?(subset_trans _ sAC). - have cFx: x \in 'C_M(F). - rewrite inE Mx -cycle_subG coprime_nil_faithful_cent_stab //=. - by rewrite cycle_subG (subsetP (gFnorm _ _)). - by rewrite -orderE coprime_pi' ?cardG_gt0 // -def_pi oxq pnatE. - case/negP: pi'q; rewrite def_pi mem_primes q_pr cardG_gt0 -oxq cardSg //. - by rewrite cycle_subG (subsetP (cent_sub_Fitting _)). -have{p'F} pi_alt q: exists2 r, r \in pi & r != q. - have [<-{q} | ] := eqVneq p q; last by exists p. - rewrite def_pi; apply/allPn; apply: contra p'F => /allP/=pF. - by apply/pgroupP=> q q_pr qF; rewrite !inE pF // mem_primes q_pr cardG_gt0. -have sNZqXq' q X: - A \subset X -> X \proper G -> 'O_q^'('N_X('Z(F)`q)) \subset 'O_q^'(X). -- move=> sAX prX. - have sZqX: 'Z(F)`q \subset X by apply: gFsub_trans (subset_trans sZA sAX). - have cZqNXZ: 'O_q^'('N_X('Z(F)`q)) \subset 'C('Z(F)`q). - have coNq'Zq: coprime #|'O_q^'('N_X('Z(F)`q))| #|'Z(F)`q|. - by rewrite coprime_sym coprime_pcoreC. - rewrite (sameP commG1P trivgP) -(coprime_TIg coNq'Zq) subsetI commg_subl /=. - rewrite commg_subr /= andbC gFsub_trans ?subsetIr //=. - by rewrite gFnorm_trans ?normsG // subsetI sZqX normG. - have: 'O_q^'('C_X(('Z(F))`q)) \subset 'O_q^'(X). - by rewrite p'core_cent_pgroup ?mFT_sol // /psubgroup sZqX pcore_pgroup. - apply: subset_trans; apply: subset_trans (pcoreS _ (subcent_sub _ _)). - by rewrite !subsetI subxx cZqNXZ gFsub_trans ?subsetIl. -have sArXq' q r X: - q \in pi -> q != r -> A \subset X -> X \proper G -> A`r \subset 'O_q^'(X). -- move=> pi_q r'q sAX prX; apply: subset_trans (sNZqXq' q X sAX prX). - apply: subset_trans (pcoreS _ (subsetIr _ _)). - rewrite -setIA (setIidPr (pcore_sub _ _)) subsetI gFsub_trans //= def_nZq //. - apply: subset_trans (pcore_Fitting _ _); rewrite -/F. - rewrite (sub_Hall_pcore (nilpotent_pcore_Hall _ nilF)) ?gFsub_trans //. - by apply: (pi_pnat (pcore_pgroup _ _)); rewrite !inE eq_sym. -have cstrA: normed_constrained A. - split=> [||X Y sAX prX]. - - by apply/eqP=> A1; rewrite /pi /= A1 cards1 in pi_p. - - exact: sub_proper_trans (subset_trans sAF (Fitting_sub _)) prM. - rewrite !inE -/pi -andbA => /and3P[sYX pi'Y nYA]. - rewrite -bigcap_p'core subsetI sYX; apply/bigcapsP=> [[q /= _] pi_q]. - have [r pi_r q'r] := pi_alt q. - have{sArXq'} sArXq': A`r \subset 'O_q^'(X) by apply: sArXq'; rewrite 1?eq_sym. - have cA_CYr: 'C_Y(A`r) \subset 'C(A). - have coYF: coprime #|Y| #|F|. - by rewrite coprime_sym coprime_pi' ?cardG_gt0 // -def_pi. - rewrite (sameP commG1P trivgP) -(coprime_TIg coYF) commg_subI //. - by rewrite setIS // (subset_trans (sCqM r pi_r)) // gFnorm. - by rewrite subsetI subsetIl. - have{cA_CYr} CYr1: 'C_Y(A`r) = 1. - rewrite -(setIid Y) setIAC coprime_TIg // (coprimeSg cA_CYr) //. - by rewrite (pnat_coprime piCA). - have{CYr1} ->: Y :=: [~: Y, A`r]. - rewrite -(mulg1 [~: Y, _]) -CYr1 coprime_cent_prod ?gFsub_trans //. - rewrite coprime_sym (coprimeSg (pcore_sub _ _)) //= -/A. - by rewrite coprime_pi' ?cardG_gt0. - by rewrite mFT_sol // (sub_proper_trans sYX). - rewrite (subset_trans (commgS _ sArXq')) //. - by rewrite commg_subr gFnorm_trans ?normsG. -have{cstrA} nbyApi'1 q: q \in pi^' -> |/|*(A; q) = [set 1%G]. - move=> pi'q; have trA: [transitive 'O_pi^'('C(A)), on |/|*(A; q) | 'JG]. - apply: normed_constrained_rank3_trans; rewrite //= -/A. - rewrite -rank_abelem // in dimA0_3; apply: leq_trans dimA0_3 (rankS _). - by rewrite /= -/A subsetI sA0A centsC subsetIr. - have [Q maxQ defAmax]: exists2 Q, Q \in |/|*(A; q) & |/|*(A; q) = [set Q]. - case/imsetP: trA => Q maxQ defAmax; exists Q; rewrite // {maxQ}defAmax. - suffices ->: 'O_pi^'('C(A)) = 1 by rewrite /orbit imset_set1 act1. - rewrite -(setIidPr (pcore_sub _ _)) coprime_TIg //. - exact: pnat_coprime piCA (pcore_pgroup _ _). - have{maxQ} qQ: q.-group Q by move: maxQ; rewrite inE => /maxgroupp/andP[]. - have [<- // |] := eqVneq Q 1%G; rewrite -val_eqE /= => ntQ. - have{defAmax trA} defFmax: |/|*(F; q) = [set Q]. - apply/eqP; rewrite eqEcard cards1 -defAmax. - have snAF: A <|<| F by rewrite nilpotent_subnormal ?Fitting_nil. - have piF: pi.-group F by rewrite def_pi /pgroup pnat_pi ?cardG_gt0. - case/(normed_trans_superset _ _ snAF): trA => //= _ /imsetP[R maxR _] -> _. - by rewrite (cardsD1 R) maxR. - have nQM: M \subset 'N(Q). - apply/normsP=> x Mx; apply: congr_group; apply/set1P. - rewrite -defFmax (acts_act (norm_acts_max_norm _ _)) ?defFmax ?set11 //. - by apply: subsetP Mx; apply: gFnorm. - have{nQM} nsQM: Q <| M. - rewrite inE in maxM; case/maxgroupP: maxM => _ maxM. - rewrite -(maxM 'N(Q)%G) ?normalG ?mFT_norm_proper //. - exact: mFT_pgroup_proper qQ. - have sQF: Q \subset F by rewrite Fitting_max ?(pgroup_nil qQ). - rewrite -(setIidPr sQF) coprime_TIg ?eqxx // in ntQ. - by rewrite coprime_pi' ?cardG_gt0 // -def_pi (pi_pnat qQ). -apply/subsetP=> H /setIdP[maxH sAH]; rewrite inE -val_eqE /=. -have prH: H \proper G := mmax_proper maxH; have solH := mFT_sol prH. -pose D := 'F(H); have nilD: nilpotent D := Fitting_nil H. -have card_pcore_nil := card_Hall (nilpotent_pcore_Hall _ _). -have piD: \pi(D) = pi. - set sigma := \pi(_); have pi_sig: {subset sigma <= pi}. - move=> q; rewrite -p_part_gt1 -card_pcore_nil // cardG_gt1 /= -/D. - apply: contraR => /nbyApi'1 defAmax. - have nDqA: A \subset 'N(D`q). - by rewrite gFnorm_trans // (subset_trans sAH) ?gFnorm. - have [Q]:= max_normed_exists (pcore_pgroup _ _) nDqA. - by rewrite defAmax -subG1; move/set1P->. - apply/eq_piP=> q; apply/idP/idP=> [|pi_q]; first exact: pi_sig. - apply: contraLR (pi_q) => sig'q; have nilA := nilpotentS sAF nilF. - rewrite -p_part_eq1 -card_pcore_nil // -trivg_card1 -subG1 /= -/A. - have <-: 'O_sigma^'(H) = 1. - apply/eqP; rewrite -trivg_Fitting ?(solvableS (pcore_sub _ _)) //. - rewrite Fitting_pcore -(setIidPr (pcore_sub _ _)) coprime_TIg //. - by rewrite coprime_pi' ?cardG_gt0 //; apply: pcore_pgroup. - rewrite -bigcap_p'core subsetI gFsub_trans //=. - apply/bigcapsP=> -[r /= _] sig_r; apply: sArXq' => //; first exact: pi_sig. - by apply: contraNneq sig'q => <-. -have cAD q r: q != r -> D`q \subset 'C(A`r). - move=> r'q; have [-> |] := eqVneq D`q 1; first by rewrite sub1G. - rewrite -cardG_gt1 card_pcore_nil // p_part_gt1 piD => pi_q. - have sArHq': A`r \subset 'O_q^'(H) by rewrite sArXq'. - have coHqHq': coprime #|D`q| #|'O_q^'(H)| by rewrite coprime_pcoreC. - rewrite (sameP commG1P trivgP) -(coprime_TIg coHqHq') commg_subI //. - by rewrite subsetI subxx /= p_core_Fitting gFsub_trans ?gFnorm. - rewrite subsetI sArHq' gFsub_trans ?(subset_trans sAH) //=. - by rewrite p_core_Fitting gFnorm. -have sDM: D \subset M. - rewrite [D]FittingEgen gen_subG; apply/bigcupsP=> [[q /= _] _]. - rewrite -p_core_Fitting -/D; have [r pi_r r'q] := pi_alt q. - by apply: subset_trans (sCqM r pi_r); apply: cAD; rewrite eq_sym. -have cApHp': A`p \subset 'C('O_p^'(H)). - have coApHp': coprime #|'O_p^'(H)| #|A`p|. - by rewrite coprime_sym coprime_pcoreC. - have solHp': solvable 'O_p^'(H) by rewrite (solvableS (pcore_sub _ _)). - have nHp'Ap: A`p \subset 'N('O_p^'(H)). - by rewrite gFsub_trans ?gFnorm_trans ?normsG. - apply: subset_trans (coprime_cent_Fitting nHp'Ap coApHp' solHp'). - rewrite subsetI subxx centsC /= FittingEgen gen_subG. - apply/bigcupsP=> [[q /= _] _]; have [-> | /cAD] := eqVneq q p. - by rewrite -(setIidPl (pcore_sub p _)) TI_pcoreC sub1G. - apply: subset_trans; rewrite p_core_Fitting -pcoreI. - by apply: sub_pcore => r /andP[]. -have sHp'M: 'O_p^'(H) \subset M. - by apply: subset_trans (sCqM p pi_p); rewrite centsC. -have ntDp: D`p != 1 by rewrite -cardG_gt1 card_pcore_nil // p_part_gt1 piD. -have sHp'_NMDp': 'O_p^'(H) \subset 'O_p^'('N_M(D`p)). - apply: subset_trans (pcoreS _ (subsetIr _ _)). - rewrite -setIA (setIidPr (pcore_sub _ _)) /= (mmax_normal maxH) //. - by rewrite subsetI sHp'M subxx. - by rewrite /= p_core_Fitting pcore_normal. -have{sHp'_NMDp'} sHp'Mp': 'O_p^'(H) \subset 'O_p^'(M). - have pM_D: p.-subgroup(M) D`p. - by rewrite /psubgroup pcore_pgroup gFsub_trans. - apply: subset_trans (p'core_cent_pgroup pM_D (mFT_sol prM)). - apply: subset_trans (pcoreS _ (subcent_sub _ _)). - rewrite !subsetI sHp'_NMDp' sHp'M andbT /= (sameP commG1P trivgP). - have coHp'Dp: coprime #|'O_p^'(H)| #|D`p|. - by rewrite coprime_sym coprime_pcoreC. - rewrite -(coprime_TIg coHp'Dp) subsetI commg_subl commg_subr /=. - by rewrite p_core_Fitting !gFsub_trans ?gFnorm. -have sMp'H: 'O_p^'(M) \subset H. - rewrite -(mmax_normal maxH (pcore_normal p H)) /= -p_core_Fitting //. - rewrite -/D (subset_trans _ (cent_sub _)) // centsC. - have solMp' := solvableS (pcore_sub p^' _) (mFT_sol prM). - have coMp'Dp: coprime #|'O_p^'(M)| #|D`p|. - by rewrite coprime_sym coprime_pcoreC. - have nMp'Dp: D`p \subset 'N('O_p^'(M)). - by rewrite gFsub_trans ?(subset_trans sDM) ?gFnorm. - apply: subset_trans (coprime_cent_Fitting nMp'Dp coMp'Dp solMp'). - rewrite subsetI subxx centsC /= FittingEgen gen_subG. - apply/bigcupsP=> [[q /= _] _]; have [<- | /cAD] := eqVneq p q. - by rewrite -(setIidPl (pcore_sub p _)) TI_pcoreC sub1G. - rewrite centsC; apply: subset_trans. - rewrite -p_core_Fitting Fitting_pcore pcore_max ?pcore_pgroup //=. - rewrite /normal subsetI -pcoreI pcore_sub subIset ?gFnorm //=. - rewrite pcoreI gFsub_trans //= -/F centsC. - case/dprodP: (nilpotent_pcoreC p nilF) => _ _ /= cFpp' _. - rewrite centsC (subset_trans cFpp' (centS _)) //. - have hallFp := nilpotent_pcore_Hall p nilF. - by rewrite (sub_Hall_pcore hallFp). -have{sHp'Mp' sMp'H} eqHp'Mp': 'O_p^'(H) = 'O_p^'(M). - apply/eqP; rewrite eqEsubset sHp'Mp'. - apply: subset_trans (sNZqXq' p H sAH prH). - apply: subset_trans (pcoreS _ (subsetIr _ _)). - rewrite -setIA (setIidPr (pcore_sub _ _)) subsetI sMp'H /=. - rewrite (mmax_normal maxM) ?gFnormal_trans //. - by rewrite -cardG_gt1 card_pcore_nil // p_part_gt1 piZ -def_pi. -have ntHp': 'O_p^'(H) != 1. - have [q pi_q p'q] := pi_alt p; have: D`q \subset 'O_p^'(H). - by rewrite p_core_Fitting sub_pcore // => r; move/eqnP->. - rewrite -proper1G; apply: proper_sub_trans; rewrite proper1G. - by rewrite -cardG_gt1 card_pcore_nil // p_part_gt1 piD. -rewrite -(mmax_normal maxH (pcore_normal p^' H)) //= eqHp'Mp'. -by rewrite (mmax_normal maxM (pcore_normal _ _)) //= -eqHp'Mp'. -Qed. - -(* This is B & G, Theorem 8.1(b). *) -Theorem SCN_Fitting_Uniqueness p M P A : - M \in 'M -> p.-group ('F(M)) -> p.-Sylow(M) P -> - 'r_p('F(M)) >= 3 -> A \in 'SCN_3(P) -> - [/\ p.-Sylow(G) P, A \subset 'F(M) & A \in 'U]. -Proof. -set F := 'F(M) => maxM pF sylP dimFp3 scn3_A. -have [scnA dimA3] := setIdP scn3_A; have [nsAP defCA] := SCN_P scnA. -have cAA := SCN_abelian scnA; have sAP := normal_sub nsAP. -have [sPM pP _] := and3P sylP; have sAM := subset_trans sAP sPM. -have{dimA3} ntA: A :!=: 1 by case: eqP dimA3 => // ->; rewrite rank1. -have prM := mmax_proper maxM; have solM := mFT_sol prM. -have{pF} Mp'1: 'O_p^'(M) = 1. - apply/eqP; rewrite -trivg_Fitting ?(solvableS (pcore_sub _ _)) //. - rewrite Fitting_pcore -(setIidPr (pcore_sub _ _)) coprime_TIg //. - exact: pnat_coprime (pcore_pgroup _ _). -have defF: F = M`p := Fitting_eq_pcore Mp'1. -have sFP: F \subset P by rewrite defF (pcore_sub_Hall sylP). -have sAF: A \subset F. - rewrite defF -(pseries_pop2 _ Mp'1). - exact: (odd_p_abelian_constrained (mFT_odd _) solM sylP cAA nsAP). -have sZA: 'Z(F) \subset A. - by rewrite -defCA setISS ?centS // defF pcore_sub_Hall. -have sCAM: 'C(A) \subset M. - have nsZM: 'Z(F) <| M by rewrite !gFnormal_trans. - rewrite -(mmax_normal maxM nsZM); last first. - rewrite /= -(setIidPr (center_sub _)) meet_center_nil ?Fitting_nil //. - by rewrite -proper1G (proper_sub_trans _ sAF) ?proper1G. - by rewrite (subset_trans _ (cent_sub _)) ?centS. -have nsZL_M: 'Z('L(P)) <| M. - by rewrite (Puig_center_normal (mFT_odd _) solM sylP). -have sNPM: 'N(P) \subset M. - rewrite -(mmax_normal maxM nsZL_M) ?gFnorm_trans //. - apply/eqP => /(trivg_center_Puig_pgroup (pHall_pgroup sylP))-P1. - by rewrite -subG1 -P1 sAP in ntA. -have sylPG: p.-Sylow(G) P := mmax_sigma_Sylow maxM sylP sNPM. -split; rewrite // (uniq_mmax_subset1 maxM sAM). -have{scn3_A} scn3_A: A \in 'SCN_3[p] by apply/bigcupP; exists P; rewrite // inE. -pose K := 'O_p^'('C(A)); have sKF: K \subset F. - have sKM: K \subset M := gFsub_trans _ sCAM. - apply: subset_trans (cent_sub_Fitting solM). - rewrite subsetI sKM coprime_nil_faithful_cent_stab ?Fitting_nil //. - - by rewrite gFsub_trans ?(subset_trans sCAM) ?gFnorm. - - by rewrite /= -/F defF coprime_pcoreC. - have sACK: A \subset 'C_F(K) by rewrite subsetI sAF centsC pcore_sub. - by rewrite /= -/F -/K (subset_trans _ sACK) //= -defCA setISS ?centS. -have{sKF} K1: K = 1 by rewrite -(setIidPr sKF) defF TI_pcoreC. -have p'nbyA_1 q: q != p -> |/|*(A; q) = [set 1%G]. - move=> p'q. - have: [transitive K, on |/|*(A; q) | 'JG] by apply: Thompson_transitivity. - case/imsetP=> Q maxQ; rewrite K1 /orbit imset_set1 act1 => defAmax. - have nQNA: 'N(A) \subset 'N(Q). - apply/normsP=> x Nx; apply: congr_group; apply/set1P; rewrite -defAmax. - by rewrite (acts_act (norm_acts_max_norm _ _)). - have{nQNA} nQF: F \subset 'N(Q). - exact: subset_trans (subset_trans (normal_norm nsAP) nQNA). - have defFmax: |/|*(F; q) = [set Q] := max_normed_uniq defAmax sAF nQF. - have nQM: M \subset 'N(Q). - apply/normsP=> x Mx; apply: congr_group; apply/set1P; rewrite -defFmax. - rewrite (acts_act (norm_acts_max_norm _ _)) ?defFmax ?set11 //. - by rewrite (subsetP (gFnorm _ _)). - have [<- // | ntQ] := eqVneq Q 1%G. - rewrite inE in maxQ; have [qQ _] := andP (maxgroupp maxQ). - have{nQM} defNQ: 'N(Q) = M. - by rewrite (mmax_norm maxM) // (mFT_pgroup_proper qQ). - case/negP: ntQ; rewrite -[_ == _]subG1 -Mp'1 -defNQ pcore_max ?normalG //. - exact: pi_pnat qQ _. -have{p'nbyA_1} p'nbyA_1 X: - X \proper G -> p^'.-group X -> A \subset 'N(X) -> X :=: 1. -- move=> prX p'X nXA; have solX := mFT_sol prX. - apply/eqP; rewrite -trivg_Fitting // -subG1 /= FittingEgen gen_subG. - apply/bigcupsP=> [[q /= _] _]; have [-> | p'q] := eqVneq q p. - rewrite -(setIidPl (pcore_sub _ _)) coprime_TIg //. - by rewrite (pnat_coprime (pcore_pgroup _ _)). - have [R] := max_normed_exists (pcore_pgroup q X) (gFnorm_trans _ nXA). - by rewrite p'nbyA_1 // => /set1P->. -apply/subsetPn=> -[H0 MA_H0 neH0M]. -pose H := [arg max_(H > H0 | (H \in 'M(A)) && (H != M)) #|H :&: M|`_p]. -case: arg_maxP @H => [|H {H0 MA_H0 neH0M}]; first by rewrite MA_H0 -in_set1. -rewrite /= inE -andbA => /and3P[maxH sAH neHM] maxHM. -have prH: H \proper G by rewrite inE in maxH; apply: maxgroupp maxH. -have sAHM: A \subset H :&: M by rewrite subsetI sAH. -have [R sylR_HM sAR]:= Sylow_superset sAHM (pgroupS sAP pP). -have [/subsetIP[sRH sRM] pR _] := and3P sylR_HM. -have{sylR_HM} sylR_H: p.-Sylow(H) R. - have [Q sylQ] := Sylow_superset sRM pR; have [sQM pQ _] := and3P sylQ. - case/eqVproper=> [defR | /(nilpotent_proper_norm (pgroup_nil pQ)) sRN]. - apply: (pHall_subl sRH (subsetT _)); rewrite pHallE subsetT /=. - by rewrite -(card_Hall sylPG) (card_Hall sylP) defR (card_Hall sylQ). - case/maximal_exists: (subsetT 'N(R)) => [nRG | [D maxD sND]]. - case/negP: (proper_irrefl (mem G)); rewrite -{1}nRG. - rewrite mFT_norm_proper ?(mFT_pgroup_proper pR) //. - by rewrite -proper1G (proper_sub_trans _ sAR) ?proper1G. - move/implyP: (maxHM D); rewrite 2!inE {}maxD leqNgt. - case: eqP sND => [->{D} sNM _ | _ sND]. - rewrite -Sylow_subnorm (pHall_subl _ _ sylR_HM) ?setIS //. - by rewrite subsetI sRH normG. - rewrite (subset_trans (subset_trans sAR (normG R)) sND); case/negP. - rewrite -(card_Hall sylR_HM) (leq_trans (proper_card sRN)) //. - rewrite -(part_pnat_id (pgroupS (subsetIl _ _) pQ)) dvdn_leq //. - by rewrite partn_dvd ?cardG_gt0 // cardSg //= setIC setISS. -have Hp'1: 'O_p^'(H) = 1. - apply: p'nbyA_1 (pcore_pgroup _ _) (subset_trans sAH (gFnorm _ _)). - exact: sub_proper_trans (pcore_sub _ _) prH. -have nsZLR_H: 'Z('L(R)) <| H. - exact: Puig_center_normal (mFT_odd _) (mFT_sol prH) sylR_H _. -have ntZLR: 'Z('L(R)) != 1. - apply/eqP=> /(trivg_center_Puig_pgroup pR) R1. - by rewrite -subG1 -R1 sAR in ntA. -have defH: 'N('Z('L(R))) = H := mmax_normal maxH nsZLR_H ntZLR. -have{sylR_H} sylR: p.-Sylow(G) R. - rewrite -Sylow_subnorm setTI (pHall_subl _ _ sylR_H) ?normG //=. - by rewrite -defH !gFnorm_trans. -have nsZLR_M: 'Z('L(R)) <| M. - have sylR_M := pHall_subl sRM (subsetT _) sylR. - exact: Puig_center_normal (mFT_odd _) solM sylR_M _. -case/eqP: neHM; apply: group_inj. -by rewrite -defH (mmax_normal maxM nsZLR_M). -Qed. - -(* This summarizes the two branches of B & G, Theorem 8.1. *) -Theorem Fitting_Uniqueness M : M \in 'M -> 'r('F(M)) >= 3 -> 'F(M)%G \in 'U. -Proof. -move=> maxM; have [p _ -> dimF3] := rank_witness 'F(M). -have prF: 'F(M) \proper G := sub_mmax_proper maxM (Fitting_sub M). -have [pF | npF] := boolP (p.-group 'F(M)). - have [P sylP] := Sylow_exists p M; have [sPM pP _] := and3P sylP. - have dimP3: 'r_p(P) >= 3. - rewrite (p_rank_Sylow sylP) (leq_trans dimF3) //. - by rewrite p_rankS ?Fitting_sub. - have [A] := rank3_SCN3 pP (mFT_odd _) dimP3. - by case/(SCN_Fitting_Uniqueness maxM pF)=> // _ sAF; apply: uniq_mmaxS. -case/p_rank_geP: dimF3 => A /setIdP[EpA dimA3]. -have [A0 maxA0 sAA0] := @maxgroup_exists _ [pred X in 'E_p('F(M))] _ EpA. -have [_ abelA] := pElemP EpA; have pmaxA0: A0 \in 'E*_p('F(M)) by rewrite inE. -case/pElemP: (maxgroupp maxA0) => sA0F; case/and3P=> _ cA0A0 _. -have dimA0_3: 'r_p(A0) >= 3. - by rewrite -(eqP dimA3) -(p_rank_abelem abelA) p_rankS. -have:= non_pcore_Fitting_Uniqueness maxM npF pmaxA0 dimA0_3. -exact: uniq_mmaxS (subsetIl _ _) prF. -Qed. - -End Eight. - diff --git a/mathcomp/odd_order/BGsection9.v b/mathcomp/odd_order/BGsection9.v deleted file mode 100644 index fe2b86a..0000000 --- a/mathcomp/odd_order/BGsection9.v +++ /dev/null @@ -1,476 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq div fintype path. -From mathcomp -Require Import finset prime fingroup action automorphism quotient cyclic. -From mathcomp -Require Import gproduct gfunctor pgroup center commutator gseries nilpotent. -From mathcomp -Require Import sylow abelian maximal hall. -From mathcomp -Require Import BGsection1 BGsection4 BGsection5 BGsection6. -From mathcomp -Require Import BGsection7 BGsection8. - -(******************************************************************************) -(* This file covers B & G, section 9, i.e., the proof the Uniqueness *) -(* Theorem, along with the several variants and auxiliary results. Note that *) -(* this is the only file to import BGsection8. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope. - -Section Nine. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). -Implicit Types H K L M A B P Q R : {group gT}. -Implicit Types p q r : nat. - -(* This is B & G, Theorem 9.1(b). *) -Theorem noncyclic_normed_sub_Uniqueness p M B : - M \in 'M -> B \in 'E_p(M) -> ~~ cyclic B -> - \bigcup_(K in |/|_G(B; p^')) K \subset M -> - B \in 'U. -Proof. -move=> maxM /pElemP[sBM abelB] ncycB snbBp'_M; have [pB cBB _] := and3P abelB. -have prM := mmax_proper maxM; have solM := mFT_sol prM. -apply/uniq_mmaxP; exists M; symmetry; apply/eqP. -rewrite eqEsubset sub1set inE maxM sBM; apply/subsetPn=> [[H0 MB_H0 neH0M]]. -have:= erefl [arg max_(H > H0 | (H \in 'M(B)) && (H :!=: M)) #|H :&: M|`_p]. -have [|H] := arg_maxP; first by rewrite MB_H0; rewrite inE in neH0M. -rewrite inE -andbA => /and3P[maxH sBH neHM] maxHM _ {H0 MB_H0 neH0M}. -have sB_HM: B \subset H :&: M by rewrite subsetI sBH. -have{sB_HM} [R sylR sBR] := Sylow_superset sB_HM pB. -have [/subsetIP[sRH sRM] pR _] := and3P sylR. -have [P sylP sRP] := Sylow_superset sRM pR; have [sPM pP _] := and3P sylP. -have sHp'M: 'O_p^'(H) \subset M. - apply: subset_trans snbBp'_M; rewrite (bigcup_max 'O_p^'(H)%G) // inE -andbA. - by rewrite subsetT pcore_pgroup (subset_trans sBH) ?gFnorm. -have{snbBp'_M} defMp': <<\bigcup_(K in |/|_G(P; p^')) K>> = 'O_p^'(M). - have nMp'M: M \subset 'N('O_p^'(M)) by apply: gFnorm. - have nMp'P := subset_trans sPM nMp'M. - apply/eqP; rewrite eqEsubset gen_subG sub_gen ?andbT; last first. - by rewrite (bigcup_max 'O_p^'(M)%G) // inE -andbA subsetT pcore_pgroup. - apply/bigcupsP=> K; rewrite inE -andbA => /and3P[_ p'K nKP]. - have sKM: K \subset M. - apply: subset_trans snbBp'_M; rewrite (bigcup_max K) // inE -andbA subsetT. - by rewrite p'K (subset_trans (subset_trans sBR sRP)). - rewrite -quotient_sub1 ?(subset_trans sKM) //=; set Mp' := 'O__(M). - have tiKp: 'O_p(M / Mp') :&: (K / _) = 1. - exact: coprime_TIg (pnat_coprime (pcore_pgroup _ _) (quotient_pgroup _ _)). - suffices sKMp: K / _ \subset 'O_p(M / Mp') by rewrite -(setIidPr sKMp) tiKp. - rewrite -Fitting_eq_pcore ?trivg_pcore_quotient //. - apply: subset_trans (cent_sub_Fitting (quotient_sol _ solM)). - rewrite subsetI quotientS //= (Fitting_eq_pcore (trivg_pcore_quotient _ _)). - rewrite (sameP commG1P trivgP) /= -/Mp' -tiKp subsetI commg_subl commg_subr. - rewrite (subset_trans (quotientS _ sKM)) ?gFnorm //=. - apply: subset_trans (pcore_sub_Hall (quotient_pHall nMp'P sylP)) _. - by rewrite quotient_norms. -have ntR: R :!=: 1 by case: eqP sBR ncycB => // -> /trivgP->; rewrite cyclic1. -have{defMp'} sNPM: 'N(P) \subset M. - have [Mp'1 | ntMp'] := eqVneq 'O_p^'(M) 1. - have nsZLP: 'Z('L(P)) <| M. - by apply: Puig_center_normal Mp'1 => //; apply: mFT_odd. - rewrite -(mmax_normal maxM nsZLP) ?gFnorm_trans //. - apply: contraNneq ntR => /(trivg_center_Puig_pgroup pP)-P1. - by rewrite -subG1 -P1. - rewrite -(mmax_normal maxM (pcore_normal _ _) ntMp') /= -defMp' norms_gen //. - apply/subsetP=> x nPx; rewrite inE sub_conjg; apply/bigcupsP=> K. - rewrite inE -andbA -sub_conjg => /and3P[_ p'K nKP]. - rewrite (bigcup_max (K :^ x)%G) // inE -andbA subsetT pgroupJ p'K /=. - by rewrite -(normP nPx) normJ conjSg. -have sylPG := mmax_sigma_Sylow maxM sylP sNPM. -have{sNPM} [sNRM sylRH]: 'N(R) \subset M /\ p.-Sylow(H) R. - have [defR | ltRP] := eqVproper sRP. - by split; rewrite defR // (pHall_subl _ (subsetT _)) // -defR. - have [| D /setIdP[maxD sND]]:= @mmax_exists _ 'N(R). - by rewrite mFT_norm_proper // (mFT_pgroup_proper pR). - have/implyP := maxHM D; rewrite inE {}maxD /= leqNgt. - rewrite (subset_trans (subset_trans sBR (normG R))) //= implybNN. - have ltRN := nilpotent_proper_norm (pgroup_nil pP) ltRP. - rewrite -(card_Hall sylR) (leq_trans (proper_card ltRN)) /=; last first. - rewrite setIC -(part_pnat_id (pgroupS (subsetIr _ _) pP)) dvdn_leq //. - by rewrite partn_dvd ?cardG_gt0 // cardSg // setISS. - move/eqP=> defD; rewrite defD in sND; split; rewrite // -Sylow_subnorm. - by rewrite (pHall_subl _ _ sylR) ?setIS // subsetI sRH normG. -have sFH_RHp': 'F(H) \subset R * 'O_p^'(H). - case/dprodP: (nilpotent_pcoreC p (Fitting_nil H)) => _ /= <- _ _. - by rewrite p_core_Fitting mulgSS ?(pcore_sub_Hall sylRH) ?pcore_Fitting. -have sFH_M: 'F(H) \subset M by rewrite (subset_trans sFH_RHp') ?mul_subG. -case/(H :=P: M): neHM; have [le3r | ge2r] := ltnP 2 'r('F(H)). - have [D uF_D] := uniq_mmaxP (Fitting_Uniqueness maxH le3r). - by rewrite (eq_uniq_mmax uF_D maxM) // (eq_uniq_mmax uF_D maxH) ?Fitting_sub. -have nHp'R: R \subset 'N('O_p^'(H)) by rewrite (subset_trans sRH) ?gFnorm. -have nsRHp'H: R <*> 'O_p^'(H) <| H. - rewrite sub_der1_normal //= ?join_subG ?sRH ?pcore_sub //. - rewrite norm_joinEl // (subset_trans _ sFH_RHp') //. - by rewrite rank2_der1_sub_Fitting ?mFT_odd // mFT_sol ?mmax_proper. -have sylR_RHp': p.-Sylow(R <*> 'O_p^'(H)) R. - by apply: (pHall_subl _ _ sylRH); rewrite ?joing_subl // normal_sub. -rewrite (mmax_max maxH) // -(Frattini_arg nsRHp'H sylR_RHp') /=. -by rewrite mulG_subG join_subG sRM sHp'M /= setIC subIset ?sNRM. -Qed. - -(* This is B & G, Theorem 9.1(a). *) -Theorem noncyclic_cent1_sub_Uniqueness p M B : - M \in 'M -> B \in 'E_p(M) -> ~~ cyclic B -> - \bigcup_(b in B^#) 'C[b] \subset M -> - B \in 'U. -Proof. -move=> maxM EpB ncycB sCB_M. -apply: (noncyclic_normed_sub_Uniqueness maxM EpB) => //. -apply/bigcupsP=> K; rewrite inE -andbA => /and3P[_ p'K nKB]. -case/pElemP: EpB => _ /and3P[pB cBB _]. -rewrite -(coprime_abelian_gen_cent1 cBB ncycB nKB); last first. - by rewrite coprime_sym (pnat_coprime pB). -rewrite gen_subG (subset_trans _ sCB_M) //. -by apply/bigcupsP=> b Bb; rewrite (bigcup_max b) // subsetIr. -Qed. - -(* This is B & G, Corollary 9.2. *) -Corollary cent_uniq_Uniqueness K L : - L \in 'U -> K \subset 'C(L) -> 'r(K) >= 2 -> K \in 'U. -Proof. -move=> uL; have ntL := uniq_mmax_neq1 uL. -case/uniq_mmaxP: uL => H uL_H cLK; have [maxH sLH] := mem_uniq_mmax uL_H. -case/rank_geP=> B /nElemP[p /pnElemP[sBK abelB /eqP dimB2]]. -have scBH: \bigcup_(b in B^#) 'C[b] \subset H. - apply/bigcupsP=> b /setIdP[]; rewrite inE -cycle_eq1 => ntb Bb. - apply: (sub_uniq_mmax uL_H); last by rewrite /= -cent_cycle mFT_cent_proper. - by rewrite sub_cent1 (subsetP cLK) ?(subsetP sBK). -have EpB: B \in 'E_p(H). - apply/pElemP; split=> //; rewrite -(setD1K (group1 B)) subUset sub1G /=. - apply/subsetP=> b Bb; apply: (subsetP scBH). - by apply/bigcupP; exists b => //; apply/cent1P. -have prK: K \proper G by rewrite (sub_proper_trans cLK) ?mFT_cent_proper. -apply: uniq_mmaxS prK (noncyclic_cent1_sub_Uniqueness _ EpB _ _) => //. -by rewrite (abelem_cyclic abelB) (eqP dimB2). -Qed. - -(* This is B & G, Corollary 9.3. *) -Corollary any_cent_rank3_Uniquness p A B : - abelian A -> p.-group A -> 'r(A) >= 3 -> A \in 'U -> - p.-group B -> ~~ cyclic B -> 'r_p('C(B)) >= 3 -> - B \in 'U. -Proof. -move=> cAA pA rA3 uA pB ncycB /p_rank_geP[C /= Ep3C]. -have [cBC abelC dimC3] := pnElemP Ep3C; have [pC cCC _] := and3P abelC. -have [P /= sylP sCP] := Sylow_superset (subsetT _) pC. -wlog sAP: A pA cAA rA3 uA / A \subset P. - move=> IHA; have [x _] := Sylow_Jsub sylP (subsetT _) pA. - by apply: IHA; rewrite ?pgroupJ ?abelianJ ?rankJ ?uniq_mmaxJ. -have ncycC: ~~ cyclic C by rewrite (abelem_cyclic abelC) dimC3. -have ncycP: ~~ cyclic P := contra (cyclicS sCP) ncycC. -have [D] := ex_odd_normal_p2Elem (pHall_pgroup sylP) (mFT_odd _) ncycP. -case/andP=> sDP nDP /pnElemP[_ abelD dimD2]. -have CADge2: 'r('C_A(D)) >= 2. - move: rA3; rewrite (rank_pgroup pA) => /p_rank_geP[E]. - case/pnElemP=> sEA abelE dimE3; apply: leq_trans (rankS (setSI _ sEA)). - rewrite (rank_abelem (abelemS (subsetIl _ _) abelE)) -(leq_add2r 1) addn1. - rewrite -dimE3 -leq_subLR -logn_div ?cardSg ?divgS ?subsetIl //. - rewrite logn_quotient_cent_abelem ?dimD2 //. - exact: subset_trans (subset_trans sAP nDP). -have CCDge2: 'r('C_C(D)) >= 2. - rewrite (rank_abelem (abelemS (subsetIl _ _) abelC)) -(leq_add2r 1) addn1. - rewrite -dimC3 -leq_subLR -logn_div ?cardSg ?divgS ?subsetIl //. - by rewrite logn_quotient_cent_abelem ?dimD2 //; apply: subset_trans nDP. -rewrite centsC in cBC; apply: cent_uniq_Uniqueness cBC _; last first. - by rewrite ltnNge (rank_pgroup pB) -odd_pgroup_rank1_cyclic ?mFT_odd. -have cCDC: C \subset 'C('C_C(D)) - by rewrite (sub_abelian_cent (abelem_abelian abelC)) ?subsetIl. -apply: cent_uniq_Uniqueness cCDC _; last by rewrite (rank_abelem abelC) dimC3. -apply: cent_uniq_Uniqueness (subsetIr _ _) CCDge2. -have cDCA: D \subset 'C('C_A(D)) by rewrite centsC subsetIr. -apply: cent_uniq_Uniqueness cDCA _; last by rewrite (rank_abelem abelD) dimD2. -by apply: cent_uniq_Uniqueness uA _ CADge2; rewrite subIset // -abelianE cAA. -Qed. - -(* This is B & G, Lemma 9.4. *) -Lemma any_rank3_Fitting_Uniqueness p M P : - M \in 'M -> 'r_p('F(M)) >= 3 -> p.-group P -> 'r(P) >= 3 -> P \in 'U. -Proof. -move=> maxM FMge3 pP; rewrite (rank_pgroup pP) => /p_rank_geP[B]. -case/pnElemP=> sBP abelB dimB3; have [pB cBB _] := and3P abelB. -have CBge3: 'r_p('C(B)) >= 3 by rewrite -dimB3 -(p_rank_abelem abelB) p_rankS. -have ncycB: ~~ cyclic B by rewrite (abelem_cyclic abelB) dimB3. -apply: {P pP}uniq_mmaxS sBP (mFT_pgroup_proper pP) _. -case/orP: (orbN (p.-group 'F(M))) => [pFM | pFM']. - have [P sylP sFP] := Sylow_superset (Fitting_sub _) pFM. - have pP := pHall_pgroup sylP. - have [|A SCN_A]:= rank3_SCN3 pP (mFT_odd _). - by rewrite (leq_trans FMge3) ?p_rankS. - have [_ _ uA] := SCN_Fitting_Uniqueness maxM pFM sylP FMge3 SCN_A. - case/setIdP: SCN_A => SCN_A dimA3; case: (setIdP SCN_A); case/andP=> sAP _ _. - have cAA := SCN_abelian SCN_A; have pA := pgroupS sAP pP. - exact: (any_cent_rank3_Uniquness cAA pA). -have [A0 EpA0 A0ge3] := p_rank_pmaxElem_exists FMge3. -have uA := non_pcore_Fitting_Uniqueness maxM pFM' EpA0 A0ge3. -case/pmaxElemP: EpA0; case/setIdP=> _ abelA0 _. -have [pA0 cA0A0 _] := and3P abelA0; rewrite -rank_pgroup // in A0ge3. -rewrite (any_cent_rank3_Uniquness _ pA0) // (cent_uniq_Uniqueness uA) 1?ltnW //. -by rewrite centsC subsetIr. -Qed. - -(* This is B & G, Lemma 9.5. *) -Lemma SCN_3_Uniqueness p A : A \in 'SCN_3[p] -> A \in 'U. -Proof. -move=> SCN3_A; apply/idPn=> uA'. -have [P] := bigcupP SCN3_A; rewrite inE => sylP /setIdP[SCN_A Age3]. -have [nsAP _] := setIdP SCN_A; have [sAP nAP] := andP nsAP. -have cAA := SCN_abelian SCN_A. -have pP := pHall_pgroup sylP; have pA := pgroupS sAP pP. -have ntA: A :!=: 1 by rewrite -rank_gt0 -(subnKC Age3). -have [p_pr _ [e oA]] := pgroup_pdiv pA ntA. -have{e oA} def_piA: \pi(A) =i (p : nat_pred). - by rewrite /= oA pi_of_exp //; apply: pi_of_prime. -have FmCAp_le2 M: M \in 'M('C(A)) -> 'r_p('F(M)) <= 2. - case/setIdP=> maxM cCAM; rewrite leqNgt; apply: contra uA' => Fge3. - exact: (any_rank3_Fitting_Uniqueness maxM Fge3). -have sNP_mCA M: M \in 'M('C(A)) -> 'N(P) \subset M. - move=> mCA_M; have Fple2 := FmCAp_le2 M mCA_M. - case/setIdP: mCA_M => maxM sCAM; set F := 'F(M) in Fple2. - have sNR_M R: A \subset R -> R \subset P :&: M -> 'N(R) \subset M. - move=> sAR /subsetIP[sRP sRM]. - pose q := if 'r(F) <= 2 then max_pdiv #|M| else s2val (rank_witness 'F(M)). - have nMqR: R \subset 'N('O_q(M)) := subset_trans sRM (gFnorm _ _). - have{nMqR} [Q maxQ sMqQ] := max_normed_exists (pcore_pgroup _ _) nMqR. - have [p'q sNQ_M]: q != p /\ 'N(Q) \subset M. - case/mem_max_normed: maxQ sMqQ; rewrite {}/q. - case: leqP => [Fle2 | ]; last first. - case: rank_witness => q /= q_pr -> Fge3 qQ _ sMqQ; split=> //. - by case: eqP Fge3 => // ->; rewrite ltnNge Fple2. - have Mqge3: 'r('O_q(M)) >= 3. - rewrite (rank_pgroup (pcore_pgroup _ _)) /= -p_core_Fitting. - by rewrite (p_rank_Sylow (nilpotent_pcore_Hall _ (Fitting_nil _))). - have uMq: 'O_q(M)%G \in 'U. - exact: (any_rank3_Fitting_Uniqueness _ Fge3 (pcore_pgroup _ _)). - have uMqM := def_uniq_mmax uMq maxM (pcore_sub _ _). - apply: sub_uniq_mmax (subset_trans sMqQ (normG _)) _ => //. - apply: mFT_norm_proper (mFT_pgroup_proper qQ). - by rewrite -rank_gt0 2?ltnW ?(leq_trans Mqge3) ?rankS. - set q := max_pdiv _ => qQ _ sMqQ. - have sylMq: q.-Sylow(M) 'O_q(M). - by rewrite [pHall _ _ _]rank2_max_pcore_Sylow ?mFT_odd ?mmax_sol. - have defNMq: 'N('O_q(M)) = M. - rewrite (mmax_normal maxM (pcore_normal _ _)) // -rank_gt0. - rewrite (rank_pgroup (pcore_pgroup _ _)) (p_rank_Sylow sylMq). - by rewrite p_rank_gt0 pi_max_pdiv cardG_gt1 mmax_neq1. - have sylMqG: q.-Sylow(G) 'O_q(M). - by rewrite (mmax_sigma_Sylow maxM) ?defNMq. - rewrite (sub_pHall sylMqG qQ) ?subsetT // defNMq; split=> //. - have: 'r_p(G) > 2. - by rewrite (leq_trans Age3) // (rank_pgroup pA) p_rankS ?subsetT. - apply: contraTneq => <-; rewrite -(p_rank_Sylow sylMqG). - rewrite -leqNgt -(rank_pgroup (pcore_pgroup _ _)) /=. - by rewrite -p_core_Fitting (leq_trans _ Fle2) // rankS ?pcore_sub. - have trCRq': [transitive 'O_p^'('C(R)), on |/|*(R; q) | 'JG]. - have cstrA: normed_constrained A. - by apply: SCN_normed_constrained sylP _; rewrite inE SCN_A ltnW. - have pR: p.-group R := pgroupS sRP pP. - have snAR: A <|<| R by rewrite (nilpotent_subnormal (pgroup_nil pR)). - have A'q: q \notin \pi(A) by rewrite def_piA. - rewrite -(eq_pgroup _ def_piA) in pR. - have [|?] := normed_trans_superset cstrA A'q snAR pR. - by rewrite (eq_pcore _ (eq_negn def_piA)) Thompson_transitivity. - by rewrite (eq_pcore _ (eq_negn def_piA)). - apply/subsetP=> x nRx; have maxQx: (Q :^ x)%G \in |/|*(R; q). - by rewrite (actsP (norm_acts_max_norm _ _)). - have [y cRy [defQx]] := atransP2 trCRq' maxQ maxQx. - rewrite -(mulgKV y x) groupMr. - by rewrite (subsetP sNQ_M) // inE conjsgM defQx conjsgK. - apply: subsetP cRy; apply: gFsub_trans. - exact: subset_trans (centS _) sCAM. - have sNA_M: 'N(A) \subset M. - by rewrite sNR_M // subsetI sAP (subset_trans cAA). - by rewrite sNR_M // subsetI subxx (subset_trans nAP). -pose P0 := [~: P, 'N(P)]. -have ntP0: P0 != 1. - apply/eqP=> /commG1P; rewrite centsC -(setIidPr (subsetT 'N(P))) /=. - case/(Burnside_normal_complement sylP)/sdprodP=> _ /= defG nGp'P _. - have prGp': 'O_p^'(G) \proper G. - rewrite properT; apply: contra ntA; move/eqP=> defG'. - rewrite -(setIidPl (subsetT A)) /= -defG'. - by rewrite coprime_TIg // (pnat_coprime pA (pcore_pgroup _ _)). - have ntGp': 'O_p^'(G) != 1. - apply: contraTneq (mFT_pgroup_proper pP); rewrite -{2}defG => ->. - by rewrite mul1g proper_irrefl. - by have:= mFT_norm_proper ntGp' prGp'; rewrite properE gFnorm andbF. -have sP0P: P0 \subset P by rewrite commg_subl. -have pP0: p.-group P0 := pgroupS sP0P pP. -have uNP0_mCA M: M \in 'M('C(A)) -> 'M('N(P0)) = [set M]. - move=> mCA_M; have [maxM sCAM] := setIdP mCA_M. - have sAM := subset_trans cAA sCAM. - pose F := 'F(M); pose D := 'O_p^'(F). - have cDP0: P0 \subset 'C(D). - have sA1A := Ohm_sub 1 A. - have nDA1: 'Ohm_1(A) \subset 'N(D). - by rewrite !gFnorm_trans // gFsub_trans // normsG. - have abelA1: p.-abelem 'Ohm_1(A) by rewrite Ohm1_abelem. - have dimA1ge3: logn p #|'Ohm_1(A)| >= 3. - by rewrite -(rank_abelem abelA1) rank_Ohm1. - have coDA1: coprime #|D| #|'Ohm_1(A)|. - rewrite coprime_sym (coprimeSg sA1A) //. - exact: pnat_coprime pA (pcore_pgroup _ _). - rewrite centsC -[D](coprime_abelian_gen_cent (abelianS sA1A cAA) nDA1) //=. - rewrite gen_subG /= -/D; apply/bigcupsP=> B /and3P[cycqB sBA1 nBA1]. - have abelB := abelemS sBA1 abelA1; have sBA := subset_trans sBA1 sA1A. - have{cycqB} ncycB: ~~ cyclic B. - move: cycqB; rewrite (abelem_cyclic (quotient_abelem _ abelA1)). - rewrite card_quotient // -divgS // logn_div ?cardSg // leq_subLR addn1. - by move/(leq_trans dimA1ge3); rewrite ltnS ltnNge -(abelem_cyclic abelB). - have [x Bx sCxM']: exists2 x, x \in B^# & ~~ ('C[x] \subset M). - suff: ~~ (\bigcup_(x in B^#) 'C[x] \subset M). - case/subsetPn=> y /bigcupP[x Bx cxy] My'. - by exists x; last by apply/subsetPn; exists y. - have EpB: B \in 'E_p(M) by rewrite inE (subset_trans sBA sAM). - apply: contra uA' => sCB_M. - apply: uniq_mmaxS sBA (mFT_pgroup_proper pA) _. - exact: noncyclic_cent1_sub_Uniqueness maxM EpB ncycB sCB_M. - case/setD1P: Bx; rewrite -cycle_eq1 => ntx Bx. - have{ntx} [L /setIdP[maxL /=]] := mmax_exists (mFT_cent_proper ntx). - rewrite cent_cycle => sCxL. - have{sCxM'} neLM : L != M by case: eqP sCxL sCxM' => // -> ->. - have sNP_LM: 'N(P) \subset L :&: M. - rewrite subsetI !sNP_mCA // inE maxL (subset_trans _ sCxL) // -cent_set1. - by rewrite centS // sub1set (subsetP sBA). - have sP0_LM': P0 \subset (L :&: M)^`(1). - exact: subset_trans (commSg _ (normG _)) (dergS 1 sNP_LM). - have DLle2: 'r(D :&: L) <= 2. - apply: contraR neLM; rewrite -ltnNge -in_set1 => /rank_geP[E /nElemP[q]]. - rewrite /= -/D => /pnElemP[/subsetIP[sED sEL] abelE dimE3]. - have sEF: E \subset F := subset_trans sED (pcore_sub _ _). - have Fge3: 'r_q(F) >= 3 by rewrite -dimE3 -p_rank_abelem // p_rankS. - have qE := abelem_pgroup abelE. - have uE: E \in 'U. - apply: any_rank3_Fitting_Uniqueness Fge3 _ _ => //. - by rewrite (rank_pgroup qE) p_rank_abelem ?dimE3. - rewrite -(def_uniq_mmax uE maxM (subset_trans sEF (Fitting_sub _))). - by rewrite inE maxL. - have cDL_P0: P0 \subset 'C(D :&: L). - have nsDM: D <| M by rewrite !gFnormal_trans. - have{nsDM} [sDM nDM] := andP nsDM. - have sDL: D :&: L \subset L :&: M by rewrite setIC setIS. - have nsDL: D :&: L <| L :&: M by rewrite /normal sDL setIC normsIG. - have [s ch_s last_s_DL] := chief_series_exists nsDL. - have solLM := solvableS (subsetIl L M) (mmax_sol maxL). - have solDL := solvableS sDL solLM. - apply: (stable_series_cent (congr_group last_s_DL)) => //; first 1 last. - rewrite coprime_sym (coprimegS (subsetIl _ _)) //. - exact: pnat_coprime (pcore_pgroup _ _). - have{last_s_DL}: last 1%G s \subset D :&: L by rewrite last_s_DL. - rewrite /= -/P0; elim/last_ind: s ch_s => //= s U IHs. - rewrite !rcons_path last_rcons /=; set V := last _ s. - case/andP=> ch_s chUV sUDL; have [maxU _ nU_LM] := and3P chUV. - have{maxU} /andP[/andP[sVU _] nV_LM] := maxgroupp maxU. - have nVU := subset_trans sUDL (subset_trans sDL nV_LM). - rewrite IHs ?(subset_trans sVU) // /stable_factor /normal sVU nVU !andbT. - have nVP0 := subset_trans (subset_trans sP0_LM' (der_sub _ _)) nV_LM. - rewrite commGC -sub_astabQR // (subset_trans sP0_LM') //. - have /is_abelemP[q _ /andP[qUV _]]: is_abelem (U / V). - exact: sol_chief_abelem solLM chUV. - apply: rank2_der1_cent_chief qUV sUDL; rewrite ?mFT_odd //. - exact: leq_trans (p_rank_le_rank _ _) DLle2. - rewrite centsC (subset_trans cDL_P0) ?centS ?setIS //. - by rewrite (subset_trans _ sCxL) // -cent_set1 centS ?sub1set. - case: (ltnP 2 'r(F)) => [| Fle2]. - have [q q_pr -> /= Fq3] := rank_witness [group of F]. - have Mq3: 'r('O_q(M)) >= 3. - rewrite (rank_pgroup (pcore_pgroup _ _)) /= -p_core_Fitting. - by rewrite (p_rank_Sylow (nilpotent_pcore_Hall _ (Fitting_nil _))). - have uMq: 'O_q(M)%G \in 'U. - exact: any_rank3_Fitting_Uniqueness Fq3 (pcore_pgroup _ _) Mq3. - apply: def_uniq_mmaxS (def_uniq_mmax uMq maxM (pcore_sub q _)); last first. - exact: mFT_norm_proper ntP0 (mFT_pgroup_proper pP0). - rewrite cents_norm // centsC (subset_trans cDP0) ?centS //=. - rewrite -p_core_Fitting sub_pcore // => q1; move/eqnP=> ->{q1}. - by apply/eqnP=> def_q; rewrite ltnNge def_q FmCAp_le2 in Fq3. - rewrite (mmax_normal maxM) ?mmax_sup_id //. - have sNP_M := sNP_mCA M mCA_M; have sPM := subset_trans (normG P) sNP_M. - rewrite /normal comm_subG //= -/P0. - have nFP: P \subset 'N(F) by apply: subset_trans (gFnorm _ _). - have <-: F <*> P * 'N_M(P) = M. - apply: Frattini_arg (pHall_subl (joing_subr _ _) (subsetT _) sylP). - rewrite -(quotientGK (Fitting_normal M)) /= norm_joinEr //= -/F. - rewrite -quotientK // cosetpre_normal -sub_abelian_normal ?quotientS //. - by rewrite sub_der1_abelian ?rank2_der1_sub_Fitting ?mFT_odd ?mmax_sol. - case/dprodP: (nilpotent_pcoreC p (Fitting_nil M)) => _ /= defF cDFp _. - rewrite norm_joinEr //= -{}defF -(centC cDFp) -/D p_core_Fitting /= -/F. - rewrite -!mulgA mul_subG //; first by rewrite cents_norm // centsC. - rewrite mulgA [_ * P]mulSGid ?pcore_sub_Hall 1?(pHall_subl _ (subsetT _)) //. - by rewrite mulSGid ?subsetI ?sPM ?normG // subIset // orbC normsRr. -have [M mCA_M] := mmax_exists (mFT_cent_proper ntA). -have [maxM sCAM] := setIdP mCA_M; have sAM := subset_trans cAA sCAM. -have abelA1: p.-abelem 'Ohm_1(A) by rewrite Ohm1_abelem. -have sA1A := Ohm_sub 1 A. -have EpA1: 'Ohm_1(A)%G \in 'E_p(M) by rewrite inE (subset_trans sA1A). -have ncycA1: ~~ cyclic 'Ohm_1(A). - rewrite (abelem_cyclic abelA1) -(rank_abelem abelA1) rank_Ohm1. - by rewrite -(subnKC Age3). -have [x A1x sCxM']: exists2 x, x \in 'Ohm_1(A)^# & ~~ ('C[x] \subset M). - suff: ~~ (\bigcup_(x in 'Ohm_1(A)^#) 'C[x] \subset M). - case/subsetPn=> y /bigcupP[x A1 cxy] My'. - by exists x; last by apply/subsetPn; exists y. - apply: contra uA' => sCA1_M. - apply: uniq_mmaxS sA1A (mFT_pgroup_proper pA) _. - exact: noncyclic_cent1_sub_Uniqueness maxM EpA1 ncycA1 sCA1_M. -case/setD1P: A1x; rewrite -cycle_eq1 => ntx A1x. -have: 'C[x] \proper G by rewrite -cent_cycle mFT_cent_proper. -case/mmax_exists=> L /setIdP[maxL sCxL]. -have mCA_L: L \in 'M('C(A)). - rewrite inE maxL (subset_trans _ sCxL) //= -cent_set1 centS // sub1set. - by rewrite (subsetP sA1A). -case/negP: sCxM'; have/uNP0_mCA := mCA_L. -by rewrite (uNP0_mCA M) // => /set1_inj->. -Qed. - -(* This is B & G, Theorem 9.6, first assertion; note that B & G omit the *) -(* (necessary!) condition K \proper G. *) -Theorem rank3_Uniqueness K : K \proper G -> 'r(K) >= 3 -> K \in 'U. -Proof. -move=> prK /rank_geP[B /nElemP[p /pnElemP[sBK abelB dimB3]]]. -have [pB cBB _] := and3P abelB. -suffices: B \in 'U by apply: uniq_mmaxS. -have [P sylP sBP] := Sylow_superset (subsetT _) pB. -have pP := pHall_pgroup sylP. -have [|A SCN3_A] := rank3_SCN3 pP (mFT_odd _). - by rewrite -dimB3 -(rank_abelem abelB) (rank_pgroup pB) p_rankS. -have [SCN_A Age3] := setIdP SCN3_A. -have: A \in 'SCN_3[p] by apply/bigcupP; exists P; rewrite // inE. -move/SCN_3_Uniqueness=> uA; have cAA := SCN_abelian SCN_A. -case/setIdP: SCN_A; case/andP=> sAP _ _; have pA := pgroupS sAP pP. -apply: any_cent_rank3_Uniquness uA pB _ _ => //. - by rewrite (abelem_cyclic abelB) dimB3. -by rewrite -dimB3 -p_rank_abelem ?p_rankS. -Qed. - -(* This is B & G, Theorem 9.6, second assertion *) -Theorem cent_rank3_Uniqueness K : 'r(K) >= 2 -> 'r('C(K)) >= 3 -> K \in 'U. -Proof. -move=> Kge2 CKge3; have cCK_K: K \subset 'C('C(K)) by rewrite centsC. -apply: cent_uniq_Uniqueness cCK_K _ => //. -apply: rank3_Uniqueness (mFT_cent_proper _) CKge3. -by rewrite -rank_gt0 ltnW. -Qed. - -(* This is B & G, Theorem 9.6, final observation *) -Theorem nonmaxElem2_Uniqueness p A : A \in 'E_p^2(G) :\: 'E*_p(G) -> A \in 'U. -Proof. -case/setDP=> EpA nmaxA; have [_ abelA dimA2]:= pnElemP EpA. -case/setIdP: EpA => EpA _; have [pA _] := andP abelA. -apply: cent_rank3_Uniqueness; first by rewrite -dimA2 -(rank_abelem abelA). -have [E maxE sAE] := pmaxElem_exists EpA. -have [/pElemP[_ abelE _]] := pmaxElemP maxE; have [pE cEE _] := and3P abelE. -have: 'r(E) <= 'r('C(A)) by rewrite rankS // (subset_trans cEE) ?centS. -apply: leq_trans; rewrite (rank_abelem abelE) -dimA2 properG_ltn_log //. -by rewrite properEneq; case: eqP maxE nmaxA => // => /group_inj-> ->. -Qed. - -End Nine. - diff --git a/mathcomp/odd_order/CeCILL-B b/mathcomp/odd_order/CeCILL-B deleted file mode 120000 index 83e22fd..0000000 --- a/mathcomp/odd_order/CeCILL-B +++ /dev/null @@ -1 +0,0 @@ -../../etc/CeCILL-B
\ No newline at end of file diff --git a/mathcomp/odd_order/INSTALL b/mathcomp/odd_order/INSTALL deleted file mode 120000 index 573e04d..0000000 --- a/mathcomp/odd_order/INSTALL +++ /dev/null @@ -1 +0,0 @@ -../../etc/INSTALL.md
\ No newline at end of file diff --git a/mathcomp/odd_order/Make b/mathcomp/odd_order/Make deleted file mode 100644 index a7ba4be..0000000 --- a/mathcomp/odd_order/Make +++ /dev/null @@ -1,36 +0,0 @@ -BGappendixAB.v -BGappendixC.v -BGsection10.v -BGsection11.v -BGsection12.v -BGsection13.v -BGsection14.v -BGsection15.v -BGsection16.v -BGsection1.v -BGsection2.v -BGsection3.v -BGsection4.v -BGsection5.v -BGsection6.v -BGsection7.v -BGsection8.v -BGsection9.v -PFsection10.v -PFsection11.v -PFsection12.v -PFsection13.v -PFsection14.v -PFsection1.v -PFsection2.v -PFsection3.v -PFsection4.v -PFsection5.v -PFsection6.v -PFsection7.v -PFsection8.v -PFsection9.v -stripped_odd_order_theorem.v -wielandt_fixpoint.v - --R . mathcomp.odd_order diff --git a/mathcomp/odd_order/Makefile b/mathcomp/odd_order/Makefile deleted file mode 100644 index 14acb5c..0000000 --- a/mathcomp/odd_order/Makefile +++ /dev/null @@ -1,25 +0,0 @@ -H=@ - -ifeq "$(COQBIN)" "" -COQBIN=$(dir $(shell which coqtop))/ -endif - -COQDEP=$(COQBIN)/coqdep - -OLD_MAKEFLAGS:=$(MAKEFLAGS) -MAKEFLAGS+=-B - -.DEFAULT_GOAL := all - -%: - $(H)[ -e Makefile.coq ] || $(COQBIN)/coq_makefile -f Make -o Makefile.coq - $(H)MAKEFLAGS="$(OLD_MAKEFLAGS)" $(MAKE) --no-print-directory \ - -f Makefile.coq $* \ - COQDEP='$(COQDEP) -c' - -.PHONY: clean -clean: - $(H)MAKEFLAGS="$(OLD_MAKEFLAGS)" $(MAKE) --no-print-directory \ - -f Makefile.coq clean - $(H)rm -f Makefile.coq - diff --git a/mathcomp/odd_order/PFsection1.v b/mathcomp/odd_order/PFsection1.v deleted file mode 100644 index 8e0b539..0000000 --- a/mathcomp/odd_order/PFsection1.v +++ /dev/null @@ -1,762 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div choice. -From mathcomp -Require Import fintype tuple finfun bigop prime ssralg finset fingroup morphism. -From mathcomp -Require Import perm automorphism quotient action zmodp finalg center commutator. -From mathcomp -Require Import poly cyclic pgroup nilpotent matrix mxalgebra mxrepresentation. -From mathcomp -Require Import vector falgebra fieldext ssrnum algC rat algnum galois. -From mathcomp -Require Import classfun character inertia integral_char vcharacter. -From mathcomp -Require ssrint. - -(******************************************************************************) -(* This file covers Peterfalvi, Section 1: Preliminary results. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope GRing.Theory Num.Theory. -Local Open Scope ring_scope. - -Local Notation algCF := [fieldType of algC]. - -Section Main. - -Variable gT : finGroupType. - -(* This is Peterfalvi (1.1). *) -Lemma odd_eq_conj_irr1 (G : {group gT}) t : - odd #|G| -> (('chi[G]_t)^*%CF == 'chi_t) = ('chi_t == 1). -Proof. -rewrite -coprimen2 => oddG; pose A := <[1 : 'Z_2]>. -have Z2P (a : 'Z_2): a = 0 \/ a = 1 by apply/pred2P; case: a => -[|[]]. -pose Ito (t : Iirr G) := [fun a : 'Z_2 => iter a (@conjC_Iirr _ G) t]. -pose Cto (C : {set gT}) := [fun a : 'Z_2 => iter a invg C]. -have IactP: is_action A Ito. - split=> [|i /Z2P[]->] /Z2P[]-> //=; last by rewrite conjC_IirrK. - exact/inv_inj/conjC_IirrK. -have CactP: is_action A Cto. - by split=> [|C /Z2P[]->] /Z2P[]-> //=; [apply: invg_inj | rewrite invgK]. -pose Iact := Action IactP; pose Cact := Action CactP. -have n_cG_A: [acts A, on classes G | Cact]. - rewrite cycle_subG !inE cycle_id; apply/subsetP=> _ /imsetP[x Gx ->]. - by rewrite !inE /= -classVg mem_classes ?groupV. -transitivity (t \in [set 0]); last by rewrite inE irr_eq1. -suffices{t} /eqP->: [set 0] == 'Fix_Iact[1]. - by rewrite !inE sub1set inE -(inj_eq irr_inj) conjC_IirrE. -rewrite eqEcard !(sub1set, inE) conjC_Iirr_eq0 eqxx /=. -rewrite (card_afix_irr_classes (cycle_id _) n_cG_A) => [|i x xy Gx]; last first. - rewrite inE => {xy}/imsetP[y Gy /(canRL invgK)->]. - by rewrite -conjVg cfunJ {y Gy}//= conjC_IirrE cfunE -irr_inv invgK. -have ->: #|[set 0 : Iirr G]| = #|[1 {set gT}]| by rewrite !cards1. -apply/subset_leq_card/subsetP=> _ /setIdP[/imsetP[x Gx ->] /afix1P-DxGV]. -have /imsetP[y Gy DxV]: x^-1%g \in x ^: G by rewrite -DxGV memV_invg class_refl. -have{Gy} cxy: y \in 'C[x]. - suffices cxy2: (y ^+ 2)%g \in 'C[x] by rewrite -(expgK oddG Gy) groupX. - by rewrite cent1C cent1E conjgC conjgM -DxV conjVg -DxV invgK. -rewrite inE classG_eq1 -in_set1 -(expgK oddG Gx) groupX // inE. -by rewrite -eq_invg_mul DxV conjgE -(cent1P cxy) mulKg. -Qed. - -Variables G H : {group gT}. - -(* This is Peterfalvi (1.2). *) -Lemma irr_reg_off_ker_0 t g : g \in G -> - H <| G -> ~~ (H \subset cfker 'chi[G]_t) -> 'C_H[g] = 1%g -> 'chi_t g = 0. -Proof. -pose kerH i := H \subset cfker 'chi[G]_i => Gg nsHG kerH't regHg; apply/eqP. -pose sum_norm2 x := \sum_i `|'chi_i x| ^+ 2. -have norm2_ge0 a: 0 <= `|a| ^+ 2 :> algC by rewrite exprn_ge0 ?normr_ge0. -have{regHg}: sum_norm2 gT G g <= sum_norm2 _ (G / H)%G (coset H g). - rewrite ). - rewrite !second_orthogonality_relation ?mem_quotient // !class_refl ler_nat. - suffices /card_isog->: 'C_G[g] \isog 'C_G[g] / H. - exact/subset_leq_card/quotient_subcent1. - by apply/quotient_isog; rewrite ?subIset 1?normal_norm // setICA regHg setIg1. -rewrite /sum_norm2 (bigID kerH) ?sum_norm_irr_quo //= -ler_subr_addl subrr. -rewrite ler_eqVlt psumr_eq0 ?ler_gtF ?sumr_ge0 // orbF => /allP/(_ t)/implyP. -by rewrite mem_index_enum kerH't expf_eq0 normr_eq0. -Qed. - -(* This is Peterfalvi (1.3)(a). *) -Lemma equiv_restrict_compl A m (Phi : m.-tuple 'CF(H)) (mu : 'CF(G)) d : - H \subset G -> A <| H -> basis_of 'CF(H, A) Phi -> - ({in A, mu =1 \sum_i d i *: 'chi_i} <-> - (forall j : 'I_m, - \sum_i '[Phi`_j, 'chi_i] * (d i)^* = '['Ind[G] Phi`_j, mu])). -Proof. -move=> sHG nsAH BPhi; have [sAH nAH] := andP nsAH. -have APhi (i : 'I_m) : Phi`_i \in 'CF(H, A). - by apply: (basis_mem BPhi _); apply: mem_nth; rewrite size_tuple. -pose D := 'Res[H] mu - \sum_i d i *: 'chi_i. -transitivity (D \in 'CF(H, H :\: A)). - split=> [A'D | /cfun_onP A'D x Ax]. - apply/cfun_onP=> x; rewrite inE negb_and negbK. - case/orP=> [Ax | /cfun0-> //]; rewrite !cfunE -A'D //. - by rewrite cfResE ?subrr ?(subsetP sAH). - have:= A'D x; rewrite !cfunE !inE Ax => /(_ isT)/(canRL (subrK _)). - by rewrite add0r cfResE // ?(subsetP sAH). -have F0 (j : 'I_m) : - (\sum_i '[Phi`_j, 'chi_i] * (d i)^* == '['Ind Phi`_j, mu]) - = ('[Phi`_j, D] == 0). - rewrite raddfB raddf_sum /= Frobenius_reciprocity subr_eq0 eq_sym. - by congr (_ == _); apply: eq_bigr=> i _; rewrite cfdotZr mulrC. -split=> [HH j | HH]. - by apply/eqP; rewrite F0; apply/eqP; apply: cfdot_complement. -have{F0} F1 (j : 'I_m) : '[Phi`_j, D]_H = 0. - by have/eqP := HH j; rewrite F0 => /eqP. -have: (D \in 'CF(H))%VS by rewrite memvf. -rewrite -(cfun_complement nsAH) => /memv_addP[f Cf [g Cg defD]]. -have: '[f, f + g] = 0. - rewrite -defD (coord_basis BPhi Cf) cfdot_suml. - by rewrite big1 // => i _; rewrite cfdotZl F1 mulr0. -rewrite raddfD /= {1}(cfdot_complement Cf Cg) addr0 => /eqP. -by rewrite cfnorm_eq0 defD => /eqP->; rewrite add0r. -Qed. - -(* This is Peterfalvi (1.3)(b). *) -Lemma equiv_restrict_compl_ortho A m (Phi : m.-tuple 'CF(H)) mu_ : - H \subset G -> A <| H -> basis_of 'CF(H, A) Phi -> - (forall i j, '[mu_ i, mu_ j] = (i == j)%:R) -> - (forall j : 'I_m, 'Ind[G] Phi`_j = \sum_i '[Phi`_j, 'chi_i] *: mu_ i) -> - [/\ forall i, {in A, mu_ i =1 'chi_i} - & forall mu, (forall i, '[mu, mu_ i] = 0) -> {in A, forall x, mu x = 0}]. -Proof. -move=> HsG nsAH /equiv_restrict_compl Phi_A Mo IP; split=> [/= i | mu Cmu x Ax]. - have->: 'chi[H]_i = \sum_j (j == i)%:R *: 'chi_j. - rewrite (bigD1 i) //= eqxx scale1r big1 ?addr0 // => j /negPf->. - by rewrite scale0r. - apply/Phi_A=> // j; rewrite IP cfdot_suml. - by apply: eq_bigr=> k _; rewrite cfdotZl rmorph_nat Mo. -transitivity ((\sum_j 0 *: 'chi[H]_j) x); last first. - by rewrite sum_cfunE big1 // => j _; rewrite cfunE mul0r. -move: x Ax; apply/Phi_A=> // j. -rewrite -mulr_suml rmorph0 mulr0 IP cfdot_suml big1 // => k _. -by rewrite cfdotZl [d in _ * d]cfdotC Cmu rmorph0 mulr0. -Qed. - -Let vchar_isometry_base3 f f' : - f \in 'Z[irr G, G^#] -> '[f]_G = 2%:R -> - f' \in 'Z[irr G, G^#] -> '[f']_G = 2%:R -> - '[f, f'] = 1 -> - exists es : _ * bool, let: (i, j, k, epsilon) := es in - [/\ f = (-1) ^+ epsilon *: ('chi_j - 'chi_i), - f' = (-1) ^+ epsilon *: ('chi_j - 'chi_k) - & uniq [:: i; j; k]]. -Proof. -move=> Hf H2f Hf1 H2f1. -have [j [i neq_ij ->]] := vchar_norm2 Hf H2f. -have [j' [k neq_kj' ->]] := vchar_norm2 Hf1 H2f1. -rewrite cfdotBl !cfdotBr !cfdot_irr opprB addrAC !addrA. -do 2!move/(canRL (subrK _)); rewrite -(natrD _ 1) -!natrD => /eqP. -rewrite eqr_nat; have [eq_jj' | neq_jj'] := altP (j =P j'). - rewrite (eq_sym j) -eq_jj' {1}eq_jj' (negbTE neq_ij) (negbTE neq_kj'). - rewrite eqSS (can_eq oddb) => /eqP neq_ik; exists (i, j, k, false). - by rewrite !scaler_sign /= !inE neq_ik orbF neq_ij eq_sym eq_jj' neq_kj'. -case: (i =P k) => // eq_ik; exists (j, i, j', true). -rewrite !scaler_sign !opprB /= !inE eq_sym negb_or neq_ij neq_jj'. -by rewrite eq_ik neq_kj'. -Qed. - -Let vchar_isometry_base4 (eps : bool) i j k n m : - let f1 := 'chi_j - 'chi_i in - let f2 := 'chi_k - 'chi_i in - let f3 := 'chi_n - 'chi_m in - j != k -> '[f3, f1]_G = (-1) ^+ eps -> '[f3, f2] = (-1) ^+ eps -> - if eps then n == i else m == i. -Proof. -move=> /= Hjk; wlog ->: eps n m / eps = false. - case: eps; last exact; move/(_ false m n)=> IH nm_ji nm_ki. - by apply: IH; rewrite // -opprB cfdotNl (nm_ji, nm_ki) opprK. -rewrite !cfdotBl !cfdotBr !cfdot_irr !opprB addrAC addrA. -do 2!move/(canRL (subrK _)); rewrite -(natrD _ 1) -!natrD. -move/(can_inj natCK); case: (m == i) => //. -case: eqP => // ->; case: (j == i) => // _. -rewrite subr0 add0r => /(canRL (subrK _)); rewrite -(natrD _ 1). -by move/(can_inj natCK); rewrite (negbTE Hjk). -Qed. - -(* This is Peterfalvi (1.4). *) -Lemma vchar_isometry_base m L (Chi : m.-tuple 'CF(H)) - (tau : {linear 'CF(H) -> 'CF(G)}) : - (1 < m)%N -> {subset Chi <= irr H} -> free Chi -> - (forall chi, chi \in Chi -> chi 1%g = Chi`_0 1%g) -> - (forall i : 'I_m, (Chi`_i - Chi`_0) \in 'CF(H, L)) -> - {in 'Z[Chi, L], isometry tau, to 'Z[irr G, G^#]} -> - exists2 mu : m.-tuple (Iirr G), - uniq mu - & exists epsilon : bool, forall i : 'I_m, - tau (Chi`_i - Chi`_0) = (-1) ^+ epsilon *: ('chi_(mu`_i) - 'chi_(mu`_0)). -Proof. -case: m Chi => [|[|m]] // Chi _ irrChi Chifree Chi1 ChiCF [iso_tau Ztau]. -rewrite -(tnth_nth 0 _ 0); set chi := tnth Chi. -have chiE i: chi i = Chi`_i by rewrite -tnth_nth. -have inChi i: chi i \in Chi by apply: mem_tnth. -have{irrChi} irrChi i: chi i \in irr H by apply: irrChi. -have eq_chi i j: (chi i == chi j) = (i == j). - by rewrite /chi !(tnth_nth 0) nth_uniq ?size_tuple ?free_uniq. -have dot_chi i j: '[chi i, chi j] = (i == j)%:R. - rewrite -eq_chi; have [/irrP[{i}i ->] /irrP[{j}j ->]] := (irrChi i,irrChi j). - by rewrite cfdot_irr inj_eq //; apply: irr_inj. -pose F i j := chi i - chi j. -have DF i j : F i j = F i 0 - F j 0 by rewrite /F opprB addrA subrK. -have ZF i j: F i j \in 'Z[Chi, L]. - by rewrite zchar_split rpredB ?mem_zchar // DF memvB // /F !chiE. -have htau2 i j: i != j -> '[tau (F i j)] = 2%:R. - rewrite iso_tau // cfnormB -cfdotC !dot_chi !eqxx eq_sym => /negbTE->. - by rewrite -!natrD subr0. -have htau1 i j: j != 0 -> j != i -> i != 0 -> '[tau (F i 0), tau (F j 0)] = 1. - rewrite iso_tau // cfdotBl !cfdotBr opprB !dot_chi !(eq_sym j). - by do 3!move/negbTE->; rewrite !subr0 add0r. -have [m0 | nz_m] := boolP (m == 0%N). - rewrite -2!eqSS eq_sym in m0; move: (htau2 1 0 isT). - case/(vchar_norm2 (Ztau _ (ZF 1 0))) => [k1 [k0 neq_k01 eq_mu]]. - pose mu := @Tuple _ _ [:: k0; k1] m0. - exists mu; first by rewrite /= andbT inE. - exists false => i; rewrite scale1r chiE. - have: (i : nat) \in iota 0 2 by rewrite mem_iota (eqP m0) (valP i). - rewrite !inE; case/pred2P=> ->; first by rewrite !subrr linear0. - by rewrite -eq_mu /F !chiE. -have m_gt2: (2 < m.+2)%N by rewrite !ltnS lt0n. -pose i2 := Ordinal m_gt2. -case: (@vchar_isometry_base3 (tau (F 1 0)) (tau (F i2 0))); auto. -case=> [[[k1 k0] k2] e] []; set d := (-1) ^+ e => eq10 eq20. -rewrite /= !inE => /and3P[/norP[nek10 nek12]]; rewrite eq_sym => nek20 _. -have muP i: - {k | (i == 0) ==> (k == k0) & tau (F i 0) == d *: ('chi_k0 - 'chi_k)}. -- apply: sig2W; have [-> | nei0] := altP (i =P 0). - by exists k0; rewrite ?eqxx // /F !subrr !linear0. - have /(vchar_norm2 (Ztau _ (ZF i 0)))[k [k' nekk' eqFkk']] := htau2 i 0 nei0. - have [-> | neq_i1] := eqVneq i 1; first by exists k1; rewrite // -eq10. - have [-> | neq_i2] := eqVneq i i2; first by exists k2; rewrite // -eq20. - have:= @vchar_isometry_base4 (~~ e) k0 k1 k2 k k' nek12. - have ZdK u v w: '[u, v - w]_G = (-1) ^+ (~~ e) * '[u, d *: (w - v)]. - rewrite cfdotZr rmorph_sign mulrA -signr_addb addNb addbb mulN1r. - by rewrite -cfdotNr opprB. - rewrite -eqFkk' ZdK -eq10 {}ZdK -eq20 !htau1 //; try by rewrite eq_sym. - move/(_ (mulr1 _) (mulr1 _)); rewrite /d eqFkk'. - by case e => /eqP <-; [exists k | exists k']; rewrite ?scaler_sign ?opprB. -pose mu := [tuple of [seq s2val (muP i) | i <- ord_tuple m.+2]]; exists mu. - rewrite map_inj_uniq ?enum_uniq // => i j. - case: (muP i) (muP j) => /= ki _ /eqP eq_i0 [/= kj _ /eqP eq_j0] eq_kij. - apply/eqP; rewrite -eq_chi -subr_eq0 -cfnorm_eq0 -iso_tau ?ZF //. - rewrite -[chi i](subrK (chi 0)) -addrA linearD eq_i0 eq_kij -eq_j0. - by rewrite -linearD -opprB subrr !raddf0. -exists (~~ e) => i; rewrite -addbT signr_addb -/d -scalerA scaleN1r opprB. -rewrite -!tnth_nth -/(F i 0) tnth_map tnth_ord_tuple. -suffices /= ->: mu`_0 = k0 by case: (muP i) => /= k _ /eqP. -rewrite -(tnth_nth 0 _ 0) tnth_map tnth_ord_tuple. -by case: (muP 0) => /= k /(k =P k0). -Qed. - -(* This is Peterfalvi (1.5)(a). *) -Lemma cfResInd_sum_cfclass t : H <| G -> - 'Res[H] ('Ind[G] 'chi_t) - = #|'I_G['chi_t] : H|%:R *: \sum_(xi <- ('chi_t ^: G)%CF) xi. -Proof. -set T := 'I_G['chi_t] => nsHG; have [sHG nHG] := andP nsHG. -apply/cfun_inP=> h Hh; rewrite cfResE ?cfIndE // cfunE sum_cfunE. -apply: (canLR (mulKf (neq0CG H))). -rewrite mulrA -natrM Lagrange ?sub_Inertia //= -/T reindex_cfclass //=. -rewrite mulr_sumr [s in _ = s]big_mkcond /= (reindex_inj invg_inj). -rewrite (partition_big (conjg_Iirr t) xpredT) //=; apply: eq_bigr => i _. -have [[y Gy chi_i] | not_i_t] := cfclassP _ _ _; last first. - apply: big1 => z; rewrite groupV => /andP[Gz /eqP def_i]. - by case: not_i_t; exists z; rewrite // -def_i conjg_IirrE. -rewrite -(card_rcoset _ y) mulr_natl -sumr_const; apply: eq_big => z. - rewrite -(inj_eq irr_inj) conjg_IirrE chi_i mem_rcoset inE groupMr ?groupV //. - apply: andb_id2l => Gz; rewrite eq_sym (cfConjg_eqE _ nsHG) //. - by rewrite mem_rcoset inE groupM ?groupV. -rewrite groupV => /andP[Gz /eqP <-]. -by rewrite conjg_IirrE cfConjgE ?(subsetP nHG). -Qed. - -(* This is Peterfalvi (1.5)(b), main formula. *) -Lemma cfnorm_Ind_irr t : - H <| G -> '['Ind[G] 'chi[H]_t] = #|'I_G['chi_t] : H|%:R. -Proof. -set r := _%:R => HnG; have HsG := normal_sub HnG. -rewrite -Frobenius_reciprocity cfResInd_sum_cfclass //= cfdotZr rmorph_nat -/r. -rewrite reindex_cfclass // cfdot_sumr (bigD1 t) ?cfclass_refl //= cfnorm_irr. -rewrite big1 ?addr0 ?mulr1 // => j /andP[_ /negbTE]. -by rewrite eq_sym cfdot_irr => ->. -Qed. - -(* This is Peterfalvi (1.5)(b), irreducibility remark. *) -Lemma inertia_Ind_irr t : - H <| G -> 'I_G['chi[H]_t] \subset H -> 'Ind[G] 'chi_t \in irr G. -Proof. -rewrite -indexg_eq1 => nsHG /eqP r1. -by rewrite irrEchar cfInd_char ?irr_char //= cfnorm_Ind_irr ?r1. -Qed. - -(* This is Peterfalvi (1.5)(c). *) -Lemma cfclass_Ind_cases t1 t2 : H <| G -> - if 'chi_t2 \in ('chi[H]_t1 ^: G)%CF - then 'Ind[G] 'chi_t1 = 'Ind[G] 'chi_t2 - else '['Ind[G] 'chi_t1, 'Ind[G] 'chi_t2] = 0. -Proof. -move=> nsHG; have [/cfclass_Ind-> // | not_ch1Gt2] := ifPn. -rewrite -Frobenius_reciprocity cfResInd_sum_cfclass // cfdotZr rmorph_nat. -rewrite cfdot_sumr reindex_cfclass // big1 ?mulr0 // => j; rewrite cfdot_irr. -case: eqP => // <- /idPn[]; apply: contra not_ch1Gt2 => /cfclassP[y Gy ->]. -by apply/cfclassP; exists y^-1%g; rewrite ?groupV ?cfConjgK. -Qed. - -(* Useful consequences of (1.5)(c) *) -Lemma not_cfclass_Ind_ortho i j : - H <| G -> ('chi_i \notin 'chi_j ^: G)%CF -> - '['Ind[G, H] 'chi_i, 'Ind[G, H] 'chi_j] = 0. -Proof. by move/(cfclass_Ind_cases i j); rewrite cfclass_sym; case: ifP. Qed. - -Lemma cfclass_Ind_irrP i j : - H <| G -> - reflect ('Ind[G, H] 'chi_i = 'Ind[G, H] 'chi_j) ('chi_i \in 'chi_j ^: G)%CF. -Proof. -move=> nsHG; have [sHG _] := andP nsHG. -case: ifP (cfclass_Ind_cases j i nsHG) => [|_ Oji]; first by left. -right=> eq_chijG; have /negP[]: 'Ind[G] 'chi_i != 0 by apply: Ind_irr_neq0. -by rewrite -cfnorm_eq0 {1}eq_chijG Oji. -Qed. - -Lemma card_imset_Ind_irr (calX : {set Iirr H}) : - H <| G -> {in calX, forall i, 'Ind 'chi_i \in irr G} -> - {in calX & G, forall i y, conjg_Iirr i y \in calX} -> - #|calX| = (#|G : H| * #|[set cfIirr ('Ind[G] 'chi_i) | i in calX]|)%N. -Proof. -move=> nsHG irrIndX sXGX; have [sHG _] := andP nsHG; set f := fun i => cfIirr _. -rewrite -sum1_card (partition_big_imset f) /= mulnC -sum_nat_const. -apply: eq_bigr => _ /imsetP[i Xi ->]; transitivity (size (cfclass 'chi_i G)). - rewrite -sum1_size reindex_cfclass //; apply: eq_bigl => j. - case Xj: (j \in calX). - rewrite -(inj_eq irr_inj) !(cfIirrPE irrIndX) //. - exact/eqP/cfclass_Ind_irrP. - apply/esym/(contraFF _ Xj)=> /cfclassP[y Gy Dj]. - by rewrite -conjg_IirrE in Dj; rewrite (irr_inj Dj) sXGX. -rewrite -(Lagrange_index (Inertia_sub G 'chi_i)) ?sub_Inertia //. -rewrite -size_cfclass ((#|_ : _| =P 1)%N _) ?muln1 // -eqC_nat. -by rewrite -cfnorm_Ind_irr // -(cfIirrPE irrIndX) ?cfnorm_irr. -Qed. - -(* This is Peterfalvi (1.5)(d). *) -Lemma scaled_cfResInd_sum_cfclass t : H <| G -> - let chiG := 'Ind[G] 'chi_t in - (chiG 1%g / '[chiG]) *: 'Res[H] chiG - = #|G : H|%:R *: (\sum_(xi <- ('chi_t ^: G)%CF) xi 1%g *: xi). -Proof. -move=> nsHG chiG; have [sHG _] := andP nsHG. -rewrite cfResInd_sum_cfclass // cfnorm_Ind_irr // scalerA cfInd1 //. -rewrite divfK ?pnatr_eq0 -?lt0n // -scalerA linear_sum !reindex_cfclass //=. -congr (_ *: _); apply: eq_bigr => _ /cfclassP[y _ ->]. -by rewrite cfConjg1. -Qed. - -(* This is Peterfalvi (1.5)(e). *) -Lemma odd_induced_orthogonal t : - H <| G -> odd #|G| -> t != 0 -> - '['Ind[G, H] 'chi_t, ('Ind[G] 'chi_t)^*] = 0. -Proof. -move=> nsHG oddG nz_t; have [sHG _] := andP nsHG. -have:= cfclass_Ind_cases t (conjC_Iirr t) nsHG. -rewrite conjC_IirrE conj_cfInd; case: cfclassP => // [[g Gg id_cht]]. -have oddH: odd #|H| := pgroup.oddSg sHG oddG. -case/eqP: nz_t; apply: irr_inj; rewrite irr0. -apply/eqP; rewrite -odd_eq_conj_irr1 // id_cht; apply/eqP. -have F1: ('chi_t ^ (g ^+ 2))%CF = 'chi_t. - rewrite (cfConjgM _ nsHG) // -id_cht -conj_cfConjg -id_cht. - exact: cfConjCK. -suffices /eqP->: g == ((g ^+ 2) ^+ #|G|./2.+1)%g. - elim: _./2.+1 => [|n IHn]; first exact: cfConjgJ1. - by rewrite expgS (cfConjgM _ nsHG) ?groupX // F1. -rewrite eq_mulVg1 expgS -expgM mul2n -mulgA mulKg -expgS -order_dvdn. -by rewrite -add1n -[1%N](congr1 nat_of_bool oddG) odd_double_half order_dvdG. -Qed. - -(* This is Peterfalvi (1.6)(a). *) -Lemma sub_cfker_Ind_irr A i : - H \subset G -> G \subset 'N(A) -> - (A \subset cfker ('Ind[G, H] 'chi_i)) = (A \subset cfker 'chi_i). -Proof. by move=> sHG nAG; rewrite cfker_Ind_irr ?sub_gcore. Qed. - -(* Some consequences and related results. *) -Lemma sub_cfker_Ind (A : {set gT}) chi : - A \subset H -> H \subset G -> G \subset 'N(A) -> chi \is a character -> - (A \subset cfker ('Ind[G, H] chi)) = (A \subset cfker chi). -Proof. -move=> sAH sHG nAG Nchi; have [-> | nz_chi] := eqVneq chi 0. - by rewrite raddf0 !cfker_cfun0 !(subset_trans sAH). -by rewrite cfker_Ind ?sub_gcore. -Qed. - -Lemma cfInd_irr_eq1 i : - H <| G -> ('Ind[G, H] 'chi_i == 'Ind[G, H] 1) = (i == 0). -Proof. -case/andP=> sHG nHG; apply/eqP/idP=> [chi1 | /eqP->]; last by rewrite irr0. -rewrite -subGcfker -(sub_cfker_Ind_irr _ sHG nHG) chi1 -irr0. -by rewrite sub_cfker_Ind_irr ?cfker_irr0. -Qed. - -Lemma sub_cfker_constt_Res_irr (A : {set gT}) i j : - j \in irr_constt ('Res[H, G] 'chi_i) -> - A \subset H -> H \subset G -> G \subset 'N(A) -> - (A \subset cfker 'chi_j) = (A \subset cfker 'chi_i). -Proof. -move=> iHj sAH sHG nAG; apply/idP/idP=> kerA. - have jGi: i \in irr_constt ('Ind 'chi_j) by rewrite constt_Ind_Res. - rewrite (subset_trans _ (cfker_constt _ jGi)) ?cfInd_char ?irr_char //=. - by rewrite sub_cfker_Ind_irr. -rewrite (subset_trans _ (cfker_constt _ iHj)) ?cfRes_char ?irr_char //=. -by rewrite cfker_Res ?irr_char // subsetI sAH. -Qed. - -Lemma sub_cfker_constt_Ind_irr (A : {set gT}) i j : - i \in irr_constt ('Ind[G, H] 'chi_j) -> - A \subset H -> H \subset G -> G \subset 'N(A) -> - (A \subset cfker 'chi_j) = (A \subset cfker 'chi_i). -Proof. by rewrite constt_Ind_Res; apply: sub_cfker_constt_Res_irr. Qed. - -(* This is a stronger version of Peterfalvi (1.6)(b). *) -Lemma cfIndMod (K : {group gT}) (phi : 'CF(H / K)) : - K \subset H -> H \subset G -> K <| G -> - 'Ind[G] (phi %% K)%CF = ('Ind[G / K] phi %% K)%CF. -Proof. by move=> sKH sHG /andP[_ nKG]; rewrite cfIndMorph ?ker_coset. Qed. - -Lemma cfIndQuo (K : {group gT}) (phi : 'CF(H)) : - K \subset cfker phi -> H \subset G -> K <| G -> - 'Ind[G / K] (phi / K)%CF = ('Ind[G] phi / K)%CF. -Proof. -move=> kerK sHG nsKG; have sKH := subset_trans kerK (cfker_sub phi). -have nsKH := normalS sKH sHG nsKG. -by apply: canRL (cfModK nsKG) _; rewrite -cfIndMod // cfQuoK. -Qed. - -Section IndSumInertia. - -Variable s : Iirr H. - -Let theta := 'chi_s. -Let T := 'I_G[theta]. -Let calA := irr_constt ('Ind[T] theta). -Let calB := irr_constt ('Ind[G] theta). -Let AtoB (t : Iirr T) := Ind_Iirr G t. -Let e_ t := '['Ind theta, 'chi[T]_t]. - -Hypothesis nsHG: H <| G. -(* begin hide *) -Let sHG : H \subset G. Proof. exact: normal_sub. Qed. -Let nHG : G \subset 'N(H). Proof. exact: normal_norm. Qed. -Let nsHT : H <| T. Proof. exact: normal_Inertia. Qed. -Let sHT : H \subset T. Proof. exact: normal_sub. Qed. -Let nHT : T \subset 'N(H). Proof. exact: normal_norm. Qed. -Let sTG : T \subset G. Proof. exact: subsetIl. Qed. -(* end hide *) - -(* This is Peterfalvi (1.7)(a). *) -Lemma cfInd_sum_Inertia : - [/\ {in calA, forall t, 'Ind 'chi_t \in irr G}, - {in calA, forall t, 'chi_(AtoB t) = 'Ind 'chi_t}, - {in calA &, injective AtoB}, - AtoB @: calA =i calB - & 'Ind[G] theta = \sum_(t in calA) e_ t *: 'Ind 'chi_t]. -Proof. -have [AtoBirr AtoBinj defB _ _] := constt_Inertia_bijection s nsHG. -split=> // [i Ai|]; first exact/cfIirrE/AtoBirr. -rewrite -(cfIndInd _ sTG sHT) {1}['Ind theta]cfun_sum_constt linear_sum. -by apply: eq_bigr => i _; rewrite linearZ. -Qed. - -Hypothesis abTbar : abelian (T / H). - -(* This is Peterfalvi (1.7)(b). *) -Lemma cfInd_central_Inertia : - exists2 e, [/\ e \in Cnat, e != 0 & {in calA, forall t, e_ t = e}] - & [/\ 'Ind[G] theta = e *: \sum_(j in calB) 'chi_j, - #|calB|%:R = #|T : H|%:R / e ^+ 2 - & {in calB, forall i, 'chi_i 1%g = #|G : T|%:R * e * theta 1%g}]. -Proof. -have [t1 At1] := constt_cfInd_irr s sHT; pose psi1 := 'chi_t1. -pose e := '['Ind theta, psi1]. -have NthT: 'Ind[T] theta \is a character by rewrite cfInd_char ?irr_char. -have Ne: e \in Cnat by rewrite Cnat_cfdot_char_irr. -have Dpsi1H: 'Res[H] psi1 = e *: theta. - have psi1Hs: s \in irr_constt ('Res psi1) by rewrite -constt_Ind_Res. - rewrite (Clifford_Res_sum_cfclass nsHT psi1Hs) cfclass_invariant ?subsetIr //. - by rewrite big_seq1 cfdot_Res_l cfdotC conj_Cnat. -have linL j: 'chi[T / H]_j \is a linear_char by apply/char_abelianP. -have linLH j: ('chi_j %% H)%CF \is a linear_char := cfMod_lin_char (linL j). -pose LtoT (j : Iirr (T / H)) := mul_mod_Iirr t1 j. -have LtoTE j: 'chi_(LtoT j) = ('chi_j %% H)%CF * psi1. - by rewrite !(mod_IirrE, cfIirrE) // mul_lin_irr ?mem_irr ?cfMod_lin_char. -have psiHG: 'Ind ('Res[H] psi1) = \sum_j 'chi_(LtoT j). - transitivity ((cfReg (T / H) %% H)%CF * psi1); last first. - rewrite cfReg_sum linear_sum /= mulr_suml; apply: eq_bigr => i _. - by rewrite LtoTE // lin_char1 ?scale1r. - apply/cfun_inP=> x Tx; rewrite cfunE cfModE // cfRegE mulrnAl mulrb. - rewrite (sameP eqP (kerP _ (subsetP nHT x Tx))) ker_coset. - case: ifPn => [Hx | H'x]; last by rewrite (cfun_on0 (cfInd_normal _ _)). - rewrite card_quotient // -!(cfResE _ sHT) // cfRes_Ind_invariant ?cfunE //. - by rewrite -subsetIidl (subset_trans _ (sub_inertia_Res _ _)) ?sub_Inertia. -have imLtoT: {subset calA <= codom LtoT}. - move=> t At; apply/codomP/exists_eqP. - have{At}: t \in irr_constt ('Ind ('Res[H] 'chi_t1)). - by rewrite Dpsi1H linearZ irr_consttE cfdotZl mulf_neq0. - apply: contraR; rewrite negb_exists => /forallP imL't. - by rewrite psiHG cfdot_suml big1 // => j _; rewrite cfdot_irr mulrb ifN_eqC. -have De_ t: t \in calA -> e_ t = e. - case/imLtoT/codomP=> j ->; rewrite /e_ LtoTE /e -!cfdot_Res_r rmorphM /=. - by rewrite cfRes_sub_ker ?cfker_mod // mulr_algl lin_char1 ?scale1r. -have{imLtoT} A_1 t: t \in calA -> 'chi_t 1%g = e * theta 1%g. - case/imLtoT/codomP=> j ->; rewrite LtoTE //= cfunE. - by rewrite (lin_char1 (linLH j)) mul1r -(cfRes1 H) Dpsi1H cfunE. -exists e => //; have [_ defAtoB injAtoB imAtoB ->] := cfInd_sum_Inertia. -rewrite -(eq_bigl _ _ imAtoB) -(eq_card imAtoB) big_imset //= scaler_sumr. -split=> [||i]; first by apply: eq_bigr => t2 At2; rewrite De_ ?defAtoB. - apply: (mulIf (irr1_neq0 s)); rewrite mulrAC -cfInd1 // mulr_natl mulrC invfM. - rewrite ['Ind _]cfun_sum_constt sum_cfunE mulr_sumr card_in_imset //. - rewrite -sumr_const; apply: eq_bigr => t At. - by rewrite -mulrA -/(e_ t) De_ // cfunE A_1 ?mulKf. -by rewrite -imAtoB => /imsetP[t At ->]; rewrite defAtoB ?cfInd1 ?A_1 ?mulrA. -Qed. - -(* This is Peterfalvi (1.7)(c). *) -Lemma cfInd_Hall_central_Inertia : - Hall T H -> - [/\ 'Ind[G] theta = \sum_(i in calB) 'chi_i, #|calB| = #|T : H| - & {in calB, forall i, 'chi_i 1%g = #|G : T|%:R * theta 1%g}]. -Proof. -case/andP=> _ hallH; have [e [_ _ De]] := cfInd_central_Inertia. -suffices ->: e = 1. - by case=> -> /eqP; rewrite scale1r expr1n divr1 mulr1 eqC_nat => /eqP. -suffices{De} [t Dtheta]: exists i, 'Res[H, T] 'chi_i = theta. - have e_t_1: e_ t = 1 by rewrite /e_ -cfdot_Res_r Dtheta cfnorm_irr. - by rewrite -(De t) // irr_consttE -/(e_ t) e_t_1 oner_eq0. -have ITtheta: T \subset 'I[theta] := subsetIr _ _. -have solT: solvable (T / H) := abelian_sol abTbar. -have [|t []] := extend_solvable_coprime_irr nsHT solT ITtheta; last by exists t. -rewrite coprime_sym coprime_mull !(coprime_dvdl _ hallH) ?cfDet_order_dvdG //. -by rewrite -dvdC_nat !CdivE truncCK ?Cnat_irr1 // dvd_irr1_cardG. -Qed. - -End IndSumInertia. - -(* This is Peterfalvi (1.8). *) -Lemma irr1_bound_quo (B C D : {group gT}) i : - B <| C -> B \subset cfker 'chi[G]_i -> - B \subset D -> D \subset C -> C \subset G -> (D / B \subset 'Z(C / B))%g -> - 'chi_i 1%g <= #|G : C|%:R * sqrtC #|C : D|%:R. -Proof. -move=> BnC BsK BsD DsC CsG QsZ. -case: (boolP ('Res[C] 'chi_i == 0))=> [HH|]. - have: ('Res[C] 'chi_i) 1%g = 0 by rewrite (eqP HH) cfunE. - by rewrite cfResE // => HH1; case/eqP: (irr1_neq0 i). -have IC := cfRes_char C (irr_char i). -case/neq0_has_constt=> i1 Hi1. -have CIr: i \in irr_constt ('Ind[G] 'chi_i1). - by rewrite inE /= -Frobenius_reciprocity /= cfdotC conjC_eq0. -have BsKi : B \subset cfker 'chi_i1. - suff BsKri: B \subset cfker ('Res[C] 'chi_i). - by apply: (subset_trans BsKri); apply: (cfker_constt _ Hi1). - apply/subsetP=> g GiG. - have F: g \in C by rewrite (subsetP (subset_trans BsD _)). - rewrite cfkerEchar // inE F !cfResE //. - by move: (subsetP BsK _ GiG); rewrite cfkerEirr inE. -pose i2 := quo_Iirr B i1. -have ZsC: 'Z(C / B)%g \subset 'Z('chi_i2)%CF. - by rewrite -(cap_cfcenter_irr (C / B)); apply: bigcap_inf. -have CBsH: C :&: B \subset D. - apply/subsetP=> g; rewrite inE; case/andP=> _ HH. - by apply: (subsetP (BsD)). -have I1B: 'chi_i1 1%g ^+ 2 <= #|C : D|%:R. - case: (irr1_bound i2)=> HH _; move: HH. - have ->: 'chi_i2 1%g = 'chi_i1 1%g. - by rewrite quo_IirrE // -(coset_id (group1 B)) cfQuoE. - move/ler_trans; apply. - rewrite ler_nat // -(index_quotient_eq CBsH) ?normal_norm //. - rewrite -(@leq_pmul2l #|'Z('chi_i2)%CF|) ?cardG_gt0 ?cfcenter_sub //. - rewrite Lagrange ?quotientS ?cfcenter_sub //. - rewrite -(@leq_pmul2l #|(D / B)%g|) ?cardG_gt0 //. - rewrite mulnA mulnAC Lagrange ?quotientS //. - rewrite mulnC leq_pmul2l ?cardG_gt0 // subset_leq_card //. - exact: subset_trans QsZ ZsC. -have IC': 'Ind[G] 'chi_i1 \is a character := cfInd_char G (irr_char i1). -move: (char1_ge_constt IC' CIr); rewrite cfInd1 //= => /ler_trans-> //. -have chi1_1_ge0: 0 <= 'chi_i1 1%g by rewrite ltrW ?irr1_gt0. -rewrite ler_pmul2l ?gt0CiG //. -by rewrite -(@ler_pexpn2r _ 2) -?topredE /= ?sqrtC_ge0 ?ler0n ?sqrtCK. -Qed. - -(* This is Peterfalvi (1.9)(a). *) -Lemma extend_coprime_Qn_aut a b (Qa Qb : fieldExtType rat) w_a w_b - (QaC : {rmorphism Qa -> algC}) (QbC : {rmorphism Qb -> algC}) - (mu : {rmorphism algC -> algC}) : - coprime a b -> - a.-primitive_root w_a /\ <<1; w_a>>%VS = {:Qa}%VS -> - b.-primitive_root w_b /\ <<1; w_b>>%VS = {:Qb}%VS -> - {nu : {rmorphism algC -> algC} | forall x, nu (QaC x) = mu (QaC x) - & forall y, nu (QbC y) = QbC y}. -Proof. -move=> coab [pr_w_a genQa] [pr_w_b genQb]. -have [k co_k_a Dmu]: {k | coprime k a & mu (QaC w_a) = QaC (w_a ^+ k)}. - have prCw: a.-primitive_root (QaC w_a) by rewrite fmorph_primitive_root. - by have [k coka ->] := aut_prim_rootP mu prCw; rewrite -rmorphX; exists k. -pose k1 := chinese a b k 1; have /Qn_aut_exists[nu Dnu]: coprime k1 (a * b). - rewrite coprime_mulr -!(coprime_modl k1) chinese_modl ?chinese_modr //. - by rewrite !coprime_modl co_k_a coprime1n. -exists nu => [x | y]. - have /Fadjoin_polyP[p Qp ->]: x \in <<1; w_a>>%VS by rewrite genQa memvf. - rewrite -!horner_map -!map_poly_comp !map_Qnum_poly // Dmu Dnu -rmorphX /=. - by rewrite -(prim_expr_mod pr_w_a) chinese_modl // prim_expr_mod. - by rewrite exprM (prim_expr_order pr_w_a) expr1n rmorph1. -have /Fadjoin_polyP[p Qp ->]: y \in <<1; w_b>>%VS by rewrite genQb memvf. -rewrite -!horner_map -!map_poly_comp !map_Qnum_poly // Dnu -rmorphX /=. - by rewrite -(prim_expr_mod pr_w_b) chinese_modr // prim_expr_mod. -by rewrite mulnC exprM (prim_expr_order pr_w_b) expr1n rmorph1. -Qed. - -(* This intermediate result in the proof of Peterfalvi (1.9)(b) is used in *) -(* he proof of (3.9)(c). *) -Lemma dvd_restrict_cfAut a (v : {rmorphism algC -> algC}) : - exists2 u : {rmorphism algC -> algC}, - forall gT0 G0 chi x, - chi \in 'Z[irr (@gval gT0 G0)] -> #[x] %| a -> u (chi x) = v (chi x) - & forall chi x, chi \in 'Z[irr G] -> coprime #[x] a -> u (chi x) = chi x. -Proof. -have [-> | a_gt0] := posnP a. - exists v => // chi x Zchi; rewrite /coprime gcdn0 order_eq1 => /eqP->. - by rewrite aut_Cint ?Cint_vchar1. -pose b := (#|G|`_(\pi(a)^'))%N. -have co_a_b: coprime a b := pnat_coprime (pnat_pi a_gt0) (part_pnat _ _). -have [Qa _ [QaC _ [w_a genQa memQa]]] := group_num_field_exists [group of Zp a]. -have [Qb _ [QbC _ [w_b genQb memQb]]] := group_num_field_exists [group of Zp b]. -rewrite !card_Zp ?part_gt0 // in Qa QaC w_a genQa memQa Qb QbC w_b genQb memQb. -have [nu nuQa nuQb] := extend_coprime_Qn_aut QaC QbC v co_a_b genQa genQb. -exists nu => [gt0 G0 chi x Zchi x_dv_a | chi x Zchi co_x_a]. - without loss{Zchi} Nchi: chi / chi \is a character. - move=> IH; case/vcharP: Zchi => [chi1 Nchi1 [chi2 Nchi2 ->]]. - by rewrite !cfunE !rmorphB !IH. - by have [xa <-] := memQa _ _ _ Nchi x x_dv_a; rewrite nuQa. -without loss{Zchi} Nchi: chi / chi \is a character. - move=> IH; case/vcharP: Zchi => [chi1 Nchi1 [chi2 Nchi2 ->]]. - by rewrite !cfunE rmorphB !IH. -have [Gx | /cfun0->] := boolP (x \in G); last by rewrite rmorph0. -have{Gx} x_dv_b: (#[x] %| b)%N. - rewrite coprime_sym coprime_pi' // in co_x_a. - by rewrite -(part_pnat_id co_x_a) partn_dvd ?order_dvdG. -by have [xb <-] := memQb _ _ _ Nchi x x_dv_b; rewrite nuQb. -Qed. - -(* This is Peterfalvi (1.9)(b). *) -(* We have strengthened the statement of this lemma so that it can be used *) -(* rather than reproved for Peterfalvi (3.9). In particular we corrected a *) -(* quantifier inversion in the original statement: the automorphism is *) -(* constructed uniformly for all (virtual) characters. We have also removed *) -(* the spurrious condition that a be a \pi(a) part of #|G| -- the proof works *) -(* for all a, and indeed the first part holds uniformaly for all groups! *) -Lemma make_pi_cfAut a k : - coprime k a -> - exists2 u : {rmorphism algC -> algC}, - forall (gT0 : finGroupType) (G0 : {group gT0}) chi x, - chi \in 'Z[irr G0] -> #[x] %| a -> cfAut u chi x = chi (x ^+ k)%g - & forall chi x, chi \in 'Z[irr G] -> coprime #[x] a -> cfAut u chi x = chi x. -Proof. -move=> co_k_a; have [v Dv] := Qn_aut_exists co_k_a. -have [u Du_a Du_a'] := dvd_restrict_cfAut a v. -exists u => [gt0 G0 | ] chi x Zchi a_x; last by rewrite cfunE Du_a'. -rewrite cfunE {u Du_a'}Du_a //. -without loss{Zchi} Nchi: chi / chi \is a character. - move=> IH; case/vcharP: Zchi => [chi1 Nchi1 [chi2 Nchi2 ->]]. - by rewrite !cfunE rmorphB !IH. -have [sXG0 | G0'x] := boolP (<[x]> \subset G0); last first. - have /(<[x]> =P _) gen_xk: generator <[x]> (x ^+ k). - by rewrite generator_coprime coprime_sym (coprime_dvdr a_x). - by rewrite !cfun0 ?rmorph0 -?cycle_subG -?gen_xk. -rewrite -!(cfResE chi sXG0) ?cycle_id ?mem_cycle //. -rewrite ['Res _]cfun_sum_cfdot !sum_cfunE rmorph_sum; apply: eq_bigr => i _. -have chiX := lin_charX (char_abelianP _ (cycle_abelian x) i) _ (cycle_id x). -rewrite !cfunE rmorphM aut_Cnat ?Cnat_cfdot_char_irr ?cfRes_char //. -by congr (_ * _); rewrite Dv -chiX // -expg_mod_order (eqnP a_x) chiX. -Qed. - -Section ANT. -Import ssrint. - -(* This section covers Peterfalvi (1.10). *) -(* We have simplified the statement somewhat by substituting the global ring *) -(* of algebraic integers for the specific ring Z[eta]. Formally this amounts *) -(* to strengthening (b) and weakening (a) accordingly, but since actually the *) -(* Z[eta] is equal to the ring of integers of Q[eta] (cf. Theorem 6.4 in J.S. *) -(* Milne's course notes on Algebraic Number Theory), the simplified statement *) -(* is actually equivalent to the textbook one. *) -Variable (p : nat) (eps : algC). -Hypothesis (pr_eps : p.-primitive_root eps). -Local Notation e := (1 - eps). - -(* This is Peterfalvi (1.10) (a). *) -Lemma vchar_ker_mod_prim : {in G & G & 'Z[irr G], forall x y (chi : 'CF(G)), - #[x] = p -> y \in 'C[x] -> chi (x * y)%g == chi y %[mod e]}%A. -Proof. -move=> x y chi Gx Gy Zchi ox cxy; pose X := <<[set x; y]>>%G. -have [Xx Xy]: x \in X /\ y \in X by apply/andP; rewrite -!sub1set -join_subG. -have sXG: X \subset G by rewrite join_subG !sub1set Gx. -suffices{chi Zchi} IHiX i: ('chi[X]_i (x * y)%g == 'chi_i y %[mod e])%A. - rewrite -!(cfResE _ sXG) ?groupM //. - have irr_free := (free_uniq (basis_free (irr_basis X))). - have [c Zc ->] := (zchar_expansion irr_free (cfRes_vchar X Zchi)). - rewrite !sum_cfunE /eqAmod -sumrB big_seq rpred_sum // => _ /irrP[i ->]. - by rewrite !cfunE [(_ %| _)%A]eqAmodMl // rpred_Cint. -have lin_chi: 'chi_i \is a linear_char. - apply/char_abelianP; rewrite -[gval X]joing_idl -joing_idr abelianY. - by rewrite !cycle_abelian cycle_subG /= cent_cycle. -rewrite lin_charM // -{2}['chi_i y]mul1r eqAmodMr ?Aint_irr //. -have [|k ->] := (prim_rootP pr_eps) ('chi_i x). - by rewrite -lin_charX // -ox expg_order lin_char1. -rewrite -[_ ^+ k](subrK 1) subrX1 -[_ - 1]opprB mulNr -mulrN mulrC. -rewrite eqAmod_addl_mul // rpredN rpred_sum // => n _. -by rewrite rpredX ?(Aint_prim_root pr_eps). -Qed. - -(* This is Peterfalvi (1.10)(b); the primality condition is only needed here. *) -Lemma int_eqAmod_prime_prim n : - prime p -> n \in Cint -> (n == 0 %[mod e])%A -> (p %| n)%C. -Proof. -move=> p_pr Zn; rewrite /eqAmod unfold_in subr0. -have p_gt0 := prime_gt0 p_pr. -case: ifPn => [_ /eqP->// | nz_e e_dv_n]. -suffices: (n ^+ p.-1 == 0 %[mod p])%A. - rewrite eqAmod0_rat ?rpredX ?rpred_nat 1?rpred_Cint // !dvdC_int ?rpredX //. - by rewrite floorCX // abszX Euclid_dvdX // => /andP[]. -rewrite /eqAmod subr0 unfold_in pnatr_eq0 eqn0Ngt p_gt0 /=. -pose F := \prod_(1 <= i < p) ('X - (eps ^+ i)%:P). -have defF: F = \sum_(i < p) 'X^i. - apply: (mulfI (monic_neq0 (monicXsubC 1))); rewrite -subrX1. - by rewrite -(factor_Xn_sub_1 pr_eps) big_ltn. -have{defF} <-: F.[1] = p :> Algebraics.divisor. - rewrite -[p]card_ord -[rhs in _ = rhs]sumr_const defF horner_sum. - by apply: eq_bigr => i _; rewrite hornerXn expr1n. -rewrite -[p.-1]card_ord {F}horner_prod big_add1 big_mkord -prodfV. -rewrite -prodr_const -big_split rpred_prod //= => k _; rewrite !hornerE. -rewrite -[n](divfK nz_e) -[_ * _ / _]mulrA rpredM {e_dv_n}//. -have p'k: ~~ (p %| k.+1)%N by rewrite gtnNdvd // -{2}(prednK p_gt0) ltnS. -have [r {1}->]: exists r, eps = eps ^+ k.+1 ^+ r. - have [q _ /dvdnP[r Dr]] := Bezoutl p (ltn0Sn k); exists r; apply/esym/eqP. - rewrite -exprM (eq_prim_root_expr pr_eps _ 1) mulnC -Dr addnC gcdnC. - by rewrite -prime_coprime // in p'k; rewrite (eqnP p'k) modnMDl. -rewrite -[1 - _]opprB subrX1 -mulNr opprB mulrC. -rewrite mulKf; last by rewrite subr_eq0 eq_sym -(prim_order_dvd pr_eps). -by apply: rpred_sum => // i _; rewrite !rpredX ?(Aint_prim_root pr_eps). -Qed. - -End ANT. - -End Main. - - diff --git a/mathcomp/odd_order/PFsection10.v b/mathcomp/odd_order/PFsection10.v deleted file mode 100644 index 03d8898..0000000 --- a/mathcomp/odd_order/PFsection10.v +++ /dev/null @@ -1,1230 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div choice. -From mathcomp -Require Import fintype tuple finfun bigop prime ssralg poly finset center. -From mathcomp -Require Import fingroup morphism perm automorphism quotient action finalg zmodp. -From mathcomp -Require Import gfunctor gproduct cyclic commutator gseries nilpotent pgroup. -From mathcomp -Require Import sylow hall abelian maximal frobenius. -From mathcomp -Require Import matrix mxalgebra mxrepresentation mxabelem vector. -From mathcomp -Require Import BGsection1 BGsection3 BGsection7 BGsection15 BGsection16. -From mathcomp -Require Import ssrnum algC classfun character integral_char inertia vcharacter. -From mathcomp -Require Import PFsection1 PFsection2 PFsection3 PFsection4. -From mathcomp -Require Import PFsection5 PFsection6 PFsection7 PFsection8 PFsection9. - -(******************************************************************************) -(* This file covers Peterfalvi, Section 10: Maximal subgroups of Types III, *) -(* IV and V. For defW : W1 \x W2 = W and MtypeP : of_typeP M U defW, and *) -(* setting ptiW := FT_primeTI_hyp MtypeP, mu2_ i j := primeTIirr ptiW i j and *) -(* delta_ j := primeTIsign j, we define here, for M of type III-V: *) -(* FTtype345_TIirr_degree MtypeP == the common degree of the components of *) -(* (locally) d the images of characters of irr W that don't have *) -(* W2 in their kernel by the cyclicTI isometry to M. *) -(* Thus mu2_ i j 1%g = d%:R for all j != 0. *) -(* FTtype345_TIsign MtypeP == the common sign of the images of characters *) -(* (locally) delta of characters of irr W that don't have W2 in *) -(* their kernel by the cyclicTI isometry to M. *) -(* Thus delta_ j = delta for all j != 0. *) -(* FTtype345_ratio MtypeP == the ratio (d - delta) / #|W1|. Even though it *) -(* (locally) n is always a positive integer we take n : algC. *) -(* FTtype345_bridge MtypeP s i j == a virtual character that can be used to *) -(* (locally) alpha_ i j bridge coherence between the mu2_ i j and other *) -(* irreducibles of M; here s should be the index of *) -(* an irreducible character of M induced from M^(1). *) -(* := mu2_ i j - delta *: mu2_ i 0 -n *: 'chi_s. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope GRing.Theory Num.Theory. - -Section Ten. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). -Implicit Types (p q : nat) (x y z : gT). -Implicit Types H K L N P Q R S T U W : {group gT}. - -Local Notation "#1" := (inord 1) (at level 0). - -Section OneMaximal. - -(* These assumptions correspond to Peterfalvi, Hypothesis (10.1). *) -(* We also declare the group U_M, even though it is not used in this section, *) -(* because it is a parameter to the theorems and definitions of PFsection8 *) -(* and PFsection9. *) -Variables M U_M W W1 W2 : {group gT}. -Hypotheses (maxM : M \in 'M) (defW : W1 \x W2 = W). -Hypotheses (MtypeP : of_typeP M U_M defW) (notMtype2: FTtype M != 2). - -Local Notation "` 'M'" := (gval M) (at level 0, only parsing) : group_scope. -Local Notation "` 'W1'" := (gval W1) (at level 0, only parsing) : group_scope. -Local Notation "` 'W2'" := (gval W2) (at level 0, only parsing) : group_scope. -Local Notation "` 'W'" := (gval W) (at level 0, only parsing) : group_scope. -Local Notation V := (cyclicTIset defW). -Local Notation M' := M^`(1)%G. -Local Notation "` 'M''" := `M^`(1) (at level 0) : group_scope. -Local Notation M'' := M^`(2)%G. -Local Notation "` 'M'''" := `M^`(2) (at level 0) : group_scope. - -Let defM : M' ><| W1 = M. Proof. by have [[]] := MtypeP. Qed. -Let nsM''M' : M'' <| M'. Proof. exact: (der_normal 1 M'). Qed. -Let nsM'M : M' <| M. Proof. exact: (der_normal 1 M). Qed. -Let sM'M : M' \subset M. Proof. exact: der_sub. Qed. -Let nsM''M : M'' <| M. Proof. exact: der_normal 2 M. Qed. - -Let notMtype1 : FTtype M != 1%N. Proof. exact: FTtypeP_neq1 MtypeP. Qed. -Let typeMgt2 : FTtype M > 2. -Proof. by move: (FTtype M) (FTtype_range M) notMtype1 notMtype2=> [|[|[]]]. Qed. - -Let defA1 : 'A1(M) = M'^#. Proof. by rewrite /= -FTcore_eq_der1. Qed. -Let defA : 'A(M) = M'^#. Proof. by rewrite FTsupp_eq1 ?defA1. Qed. -Let defA0 : 'A0(M) = M'^# :|: class_support V M. -Proof. by rewrite -defA (FTtypeP_supp0_def _ MtypeP). Qed. -Let defMs : M`_\s :=: M'. Proof. exact: FTcore_type_gt2. Qed. - -Let pddM := FT_prDade_hyp maxM MtypeP. -Let ptiWM : primeTI_hypothesis M M' defW := FT_primeTI_hyp MtypeP. -Let ctiWG : cyclicTI_hypothesis G defW := pddM. -Let ctiWM : cyclicTI_hypothesis M defW := prime_cycTIhyp ptiWM. - -Let ntW1 : W1 :!=: 1. Proof. by have [[]] := MtypeP. Qed. -Let ntW2 : W2 :!=: 1. Proof. by have [_ _ _ []] := MtypeP. Qed. -Let cycW1 : cyclic W1. Proof. by have [[]] := MtypeP. Qed. -Let cycW2 : cyclic W2. Proof. by have [_ _ _ []] := MtypeP. Qed. - -Let w1 := #|W1|. -Let w2 := #|W2|. -Let nirrW1 : #|Iirr W1| = w1. Proof. by rewrite card_Iirr_cyclic. Qed. -Let nirrW2 : #|Iirr W2| = w2. Proof. by rewrite card_Iirr_cyclic. Qed. -Let NirrW1 : Nirr W1 = w1. Proof. by rewrite -nirrW1 card_ord. Qed. -Let NirrW2 : Nirr W2 = w2. Proof. by rewrite -nirrW2 card_ord. Qed. - -Let w1gt2 : w1 > 2. Proof. by rewrite odd_gt2 ?mFT_odd ?cardG_gt1. Qed. -Let w2gt2 : w2 > 2. Proof. by rewrite odd_gt2 ?mFT_odd ?cardG_gt1. Qed. - -Let coM'w1 : coprime #|M'| w1. -Proof. by rewrite (coprime_sdprod_Hall_r defM); have [[]] := MtypeP. Qed. - -(* This is used both in (10.2) and (10.8). *) -Let frobMbar : [Frobenius M / M'' = (M' / M'') ><| (W1 / M'')]. -Proof. -have [[_ hallW1 _ _] _ _ [_ _ _ sW2M'' regM'W1 ] _] := MtypeP. -apply: Frobenius_coprime_quotient => //. -split=> [|w /regM'W1-> //]; apply: (sol_der1_proper (mmax_sol maxM)) => //. -by apply: subG1_contra ntW2; apply: subset_trans sW2M'' (der_sub 1 M'). -Qed. - -Local Open Scope ring_scope. - -Let sigma := (cyclicTIiso ctiWG). -Let w_ i j := (cyclicTIirr defW i j). -Local Notation eta_ i j := (sigma (w_ i j)). - -Local Notation Imu2 := (primeTI_Iirr ptiWM). -Let mu2_ i j := primeTIirr ptiWM i j. -Let mu_ := primeTIred ptiWM. -Local Notation chi_ j := (primeTIres ptiWM j). - -Local Notation Idelta := (primeTI_Isign ptiWM). -Local Notation delta_ j := (primeTIsign ptiWM j). - -Local Notation tau := (FT_Dade0 maxM). -Local Notation "chi ^\tau" := (tau chi). - -Let calS0 := seqIndD M' M M`_\s 1. -Let rmR := FTtypeP_coh_base maxM MtypeP. -Let scohS0 : subcoherent calS0 tau rmR. -Proof. exact: FTtypeP_subcoherent MtypeP. Qed. - -Let calS := seqIndD M' M M' 1. -Let sSS0 : cfConjC_subset calS calS0. -Proof. by apply: seqInd_conjC_subset1; rewrite /= ?defMs. Qed. - -Let mem_calS s : ('Ind 'chi[M']_s \in calS) = (s != 0). -Proof. -rewrite mem_seqInd ?normal1 ?FTcore_normal //=. -by rewrite !inE sub1G subGcfker andbT. -Qed. - -Let calSmu j : j != 0 -> mu_ j \in calS. -Proof. -move=> nz_j; rewrite -[mu_ j]cfInd_prTIres mem_calS -irr_eq1. -by rewrite -(prTIres0 ptiWM) (inj_eq irr_inj) (inj_eq (prTIres_inj _)). -Qed. - -Let tauM' : {subset 'Z[calS, M'^#] <= 'CF(M, 'A0(M))}. -Proof. by rewrite defA0 => phi /zchar_on/(cfun_onS (subsetUl _ _))->. Qed. - -(* This is Peterfalvi (10.2). *) -(* Note that this result is also valid for type II groups. *) -Lemma FTtypeP_ref_irr : - {zeta | [/\ zeta \in irr M, zeta \in calS & zeta 1%g = w1%:R]}. -Proof. -have [_ /has_nonprincipal_irr[s nz_s] _ _ _] := Frobenius_context frobMbar. -exists ('Ind 'chi_s %% M'')%CF; split. -- by rewrite cfMod_irr ?irr_induced_Frobenius_ker ?(FrobeniusWker frobMbar). -- by rewrite -cfIndMod ?normal_sub // -mod_IirrE // mem_calS mod_Iirr_eq0. -rewrite -cfIndMod ?cfInd1 ?normal_sub // -(index_sdprod defM) cfMod1. -by rewrite lin_char1 ?mulr1 //; apply/char_abelianP/sub_der1_abelian. -Qed. - -(* This is Peterfalvi (10.3), first assertion. *) -Lemma FTtype345_core_prime : prime w2. -Proof. -have [S pairMS [xdefW [U StypeP]]] := FTtypeP_pair_witness maxM MtypeP. -have [[_ _ maxS] _] := pairMS; rewrite {1}(negPf notMtype2) /= => Stype2 _ _. -by have [[]] := compl_of_typeII maxS StypeP Stype2. -Qed. -Let w2_pr := FTtype345_core_prime. - -Definition FTtype345_TIirr_degree := truncC (mu2_ 0 #1 1%g). -Definition FTtype345_TIsign := delta_ #1. -Local Notation d := FTtype345_TIirr_degree. -Local Notation delta := FTtype345_TIsign. -Definition FTtype345_ratio := (d%:R - delta) / w1%:R. -Local Notation n := FTtype345_ratio. - -(* This is the remainder of Peterfalvi (10.3). *) -Lemma FTtype345_constants : - [/\ forall i j, j != 0 -> mu2_ i j 1%g = d%:R, - forall j, j != 0 -> delta_ j = delta, - (d > 1)%N - & n \in Cnat]. -Proof. -have nz_j1 : #1 != 0 :> Iirr W2 by rewrite Iirr1_neq0. -have invj j: j != 0 -> mu2_ 0 j 1%g = d%:R /\ delta_ j = delta. - move=> nz_j; have [k co_k_j1 Dj] := cfExp_prime_transitive w2_pr nz_j1 nz_j. - rewrite -(cforder_dprodr defW) -dprod_IirrEr in co_k_j1. - have{co_k_j1} [[u Dj1u] _] := cycTIiso_aut_exists ctiWM co_k_j1. - rewrite dprod_IirrEr -rmorphX -Dj /= -!dprod_IirrEr -!/(w_ _ _) in Dj1u. - rewrite truncCK ?Cnat_irr1 //. - have: delta_ j *: mu2_ 0 j == cfAut u (delta_ #1 *: mu2_ 0 #1). - by rewrite -!(cycTIiso_prTIirr pddM) -/ctiWM -Dj1u. - rewrite raddfZsign /= -prTIirr_aut eq_scaled_irr signr_eq0 /= /mu2_. - by case/andP=> /eqP-> /eqP->; rewrite prTIirr_aut cfunE aut_Cnat ?Cnat_irr1. -have d_gt1: (d > 1)%N. - rewrite ltn_neqAle andbC -eqC_nat -ltC_nat truncCK ?Cnat_irr1 //. - rewrite irr1_gt0 /= eq_sym; apply: contraNneq nz_j1 => mu2_lin. - have: mu2_ 0 #1 \is a linear_char by rewrite qualifE irr_char /= mu2_lin. - by rewrite lin_irr_der1 => /(prTIirr0P ptiWM)[i /irr_inj/prTIirr_inj[_ ->]]. -split=> // [i j /invj[<- _] | _ /invj[//] | ]; first by rewrite prTIirr_1. -have: (d%:R == delta %[mod w1])%C by rewrite truncCK ?Cnat_irr1 ?prTIirr1_mod. -rewrite /eqCmod unfold_in -/n (negPf (neq0CG W1)) CnatEint => ->. -rewrite divr_ge0 ?ler0n // [delta]signrE opprB addrA -natrD subr_ge0 ler1n. -by rewrite -(subnKC d_gt1). -Qed. - -Let o_mu2_irr zeta i j : - zeta \in calS -> zeta \in irr M -> '[mu2_ i j, zeta] = 0. -Proof. -case/seqIndP=> s _ -> irr_sM; rewrite -cfdot_Res_l cfRes_prTIirr cfdot_irr. -rewrite (negPf (contraNneq _ (prTIred_not_irr ptiWM j))) // => Ds. -by rewrite -cfInd_prTIres Ds. -Qed. - -Let ZmuBzeta zeta j : - zeta \in calS -> zeta 1%g = w1%:R -> j != 0 -> - mu_ j - d%:R *: zeta \in 'Z[calS, M'^#]. -Proof. -move=> Szeta zeta1w1 nz_j; have [mu1 _ _ _] := FTtype345_constants. -rewrite -[d%:R](mulKf (neq0CiG M M')) mulrC -(mu1 0 j nz_j). -rewrite -(cfResE _ sM'M) // cfRes_prTIirr -cfInd1 // cfInd_prTIres. -by rewrite (seqInd_sub_lin_vchar _ Szeta) ?calSmu // -(index_sdprod defM). -Qed. - -Let mu0Bzeta_on zeta : - zeta \in calS -> zeta 1%g = w1%:R -> mu_ 0 - zeta \in 'CF(M, 'A(M)). -Proof. -move/seqInd_on=> M'zeta zeta1w1; rewrite [mu_ 0]prTIred0 defA cfun_onD1. -rewrite !cfunE zeta1w1 cfuniE // group1 mulr1 subrr rpredB ?M'zeta //=. -by rewrite rpredZ ?cfuni_on. -Qed. - -(* We need to prove (10.5) - (10.7) for an arbitrary choice of zeta, to allow *) -(* part of the proof of (10.5) to be reused in that of (11.8). *) -Variable zeta : 'CF(M). -Hypotheses (irr_zeta : zeta \in irr M) (Szeta : zeta \in calS). -Hypothesis (zeta1w1 : zeta 1%g = w1%:R). - -Let o_mu2_zeta i j : '[mu2_ i j, zeta] = 0. Proof. exact: o_mu2_irr. Qed. - -Let o_mu_zeta j : '[mu_ j, zeta] = 0. -Proof. by rewrite cfdot_suml big1 // => i _; apply: o_mu2_zeta. Qed. - -Definition FTtype345_bridge i j := mu2_ i j - delta *: mu2_ i 0 - n *: zeta. -Local Notation alpha_ := FTtype345_bridge. - -(* This is the first part of Peterfalvi (10.5), which does not depend on the *) -(* coherence assumption that will ultimately be refuted by (10.8). *) -Lemma supp_FTtype345_bridge i j : j != 0 -> alpha_ i j \in 'CF(M, 'A0(M)). -Proof. -move=> nz_j; have [Dd Ddelta _ _] := FTtype345_constants. -have Dmu2 := prTIirr_id pddM. -have W1a0 x: x \in W1 -> alpha_ i j x = 0. - move=> W1x; rewrite !cfunE; have [-> | ntx] := eqVneq x 1%g. - by rewrite Dd // prTIirr0_1 mulr1 zeta1w1 divfK ?neq0CG ?subrr. - have notM'x: x \notin M'. - apply: contra ntx => M'x; have: x \in M' :&: W1 by apply/setIP. - by rewrite coprime_TIg ?inE. - have /sdprod_context[_ sW1W _ _ tiW21] := dprodWsdC defW. - have abW2: abelian W2 := cyclic_abelian cycW2. - have Wx: x \in W :\: W2. - rewrite inE (contra _ ntx) ?(subsetP sW1W) // => W2x. - by rewrite -in_set1 -set1gE -tiW21 inE W2x. - rewrite !Dmu2 {Wx}// Ddelta // prTIsign0 scale1r !dprod_IirrE cfunE. - rewrite -!(cfResE _ sW1W) ?cfDprodKl_abelian // subrr. - have [s _ ->] := seqIndP Szeta. - by rewrite (cfun_on0 (cfInd_normal _ _)) ?mulr0 ?subrr. -apply/cfun_onP=> x; rewrite !inE defA notMtype1 /= => /norP[notM'x]. -set pi := \pi(M'); have [Mx /= pi_x | /cfun0->//] := boolP (x \in M). -have hallM': pi.-Hall(M) M' by rewrite Hall_pi -?(coprime_sdprod_Hall_l defM). -have hallW1: pi^'.-Hall(M) W1 by rewrite -(compl_pHall _ hallM') sdprod_compl. -have{pi_x} pi'x: pi^'.-elt x. - apply: contraR notM'x => not_pi'x; rewrite !inE (mem_normal_Hall hallM') //. - rewrite not_pi'x andbT negbK in pi_x. - by rewrite (contraNneq _ not_pi'x) // => ->; apply: p_elt1. -have [|y My] := Hall_subJ (mmax_sol maxM) hallW1 _ pi'x; rewrite cycle_subG //. -by case/imsetP=> z Wz ->; rewrite cfunJ ?W1a0. -Qed. -Local Notation alpha_on := supp_FTtype345_bridge. - -Lemma vchar_FTtype345_bridge i j : alpha_ i j \in 'Z[irr M]. -Proof. -have [_ _ _ Nn] := FTtype345_constants. -by rewrite !rpredB ?rpredZsign ?rpredZ_Cnat ?irr_vchar ?mem_zchar. -Qed. -Local Notation Zalpha := vchar_FTtype345_bridge. -Local Hint Resolve Zalpha. - -Lemma vchar_Dade_FTtype345_bridge i j : - j != 0 -> (alpha_ i j)^\tau \in 'Z[irr G]. -Proof. by move=> nz_j; rewrite Dade_vchar // zchar_split Zalpha alpha_on. Qed. -Local Notation Zalpha_tau := vchar_Dade_FTtype345_bridge. - -(* This covers the last paragraph in the proof of (10.5); it's isolated here *) -(* because it is reused in the proof of (10.10) and (11.8). *) - -Lemma norm_FTtype345_bridge i j : - j != 0 -> '[(alpha_ i j)^\tau] = 2%:R + n ^+ 2. -Proof. -move=> nz_j; rewrite Dade_isometry ?alpha_on // cfnormBd ?cfnormZ; last first. - by rewrite cfdotZr cfdotBl cfdotZl !o_mu2_zeta !(mulr0, subr0). -have [_ _ _ /Cnat_ge0 n_ge0] := FTtype345_constants. -rewrite ger0_norm // cfnormBd ?cfnorm_sign ?cfnorm_irr ?irrWnorm ?mulr1 //. -by rewrite cfdotZr (cfdot_prTIirr pddM) (negPf nz_j) andbF ?mulr0. -Qed. -Local Notation norm_alpha := norm_FTtype345_bridge. - -Implicit Type tau : {additive 'CF(M) -> 'CF(G)}. - -(* This exported version is adapted to its use in (11.8). *) -Lemma FTtype345_bridge_coherence calS1 tau1 i j X Y : - coherent_with calS1 M^# tau tau1 -> (alpha_ i j)^\tau = X + Y -> - cfConjC_subset calS1 calS0 -> {subset calS1 <= irr M} -> - j != 0 -> Y \in 'Z[map tau1 calS1] -> '[Y, X] = 0 -> '[Y] = n ^+ 2 -> - X = delta *: (eta_ i j - eta_ i 0). -Proof. -move=> cohS1 Dalpha sS10 irrS1 nz_j S1_Y oYX nY_n2. -have [[_ Ddelta _ Nn] [[Itau1 Ztau1] _]] := (FTtype345_constants, cohS1). -have [|z Zz defY] := zchar_expansion _ S1_Y. - rewrite map_inj_in_uniq; first by case: sS10. - by apply: sub_in2 (Zisometry_inj Itau1); apply: mem_zchar. -have nX_2: '[X] = 2%:R. - apply: (addrI '[Y]); rewrite -cfnormDd // addrC -Dalpha norm_alpha //. - by rewrite addrC nY_n2. -have Z_X: X \in 'Z[irr G]. - rewrite -[X](addrK Y) -Dalpha rpredB ?Zalpha_tau // defY big_map big_seq. - by apply: rpred_sum => psi S1psi; rewrite rpredZ_Cint // Ztau1 ?mem_zchar. -apply: eq_signed_sub_cTIiso => // y Vy; rewrite -[X](addrK Y) -Dalpha -/delta. -rewrite !cfunE !cycTIiso_restrict //; set rhs := delta * _. -rewrite Dade_id ?defA0 //; last by rewrite setUC inE mem_class_support. -have notM'y: y \notin M'. - by have:= subsetP (prDade_supp_disjoint pddM) y Vy; rewrite inE. -have Wy: y \in W :\: W2 by move: Vy; rewrite !inE => /andP[/norP[_ ->]]. -rewrite !cfunE 2?{1}prTIirr_id // prTIsign0 scale1r Ddelta // cfunE -mulrBr. -rewrite -/rhs (cfun_on0 (seqInd_on _ Szeta)) // mulr0 subr0. -rewrite (ortho_cycTIiso_vanish ctiWG) ?subr0 // -/sigma. -apply/orthoPl=> _ /mapP[_ /(cycTIirrP defW)[i1 [j1 ->]] ->]. -rewrite defY cfdot_suml big_map big1_seq //= => psi S1psi. -by rewrite cfdotZl (coherent_ortho_cycTIiso MtypeP sS10) ?irrS1 ?mulr0. -Qed. - -(* This is a specialization of the above, used in (10.5) and (10.10). *) -Let def_tau_alpha calS1 tau1 i j : - coherent_with calS1 M^# tau tau1 -> cfConjC_subset calS1 calS0 -> - j != 0 -> zeta \in calS1 -> '[(alpha_ i j)^\tau, tau1 zeta] = - n -> - (alpha_ i j)^\tau = delta *: (eta_ i j - eta_ i 0) - n *: tau1 zeta. -Proof. -move=> cohS1 [_ sS10 ccS1] nz_j S1zeta alpha_zeta_n. -have [[_ _ _ Nn] [[Itau1 _] _]] := (FTtype345_constants, cohS1). -set Y := - (n *: _); apply: canRL (addrK _) _; set X := _ + _. -have Dalpha: (alpha_ i j)^\tau = X + Y by rewrite addrK. -have nY_n2: '[Y] = n ^+ 2. - by rewrite cfnormN cfnormZ norm_Cnat // Itau1 ?mem_zchar // irrWnorm ?mulr1. -pose S2 := zeta :: zeta^*%CF; pose S2tau1 := map tau1 S2. -have S2_Y: Y \in 'Z[S2tau1] by rewrite rpredN rpredZ_Cnat ?mem_zchar ?mem_head. -have sS21: {subset S2 <= calS1} by apply/allP; rewrite /= ccS1 ?S1zeta. -have cohS2 : coherent_with S2 M^# tau tau1 := subset_coherent_with sS21 cohS1. -have irrS2: {subset S2 <= irr M} by apply/allP; rewrite /= cfAut_irr irr_zeta. -rewrite (FTtype345_bridge_coherence cohS2 Dalpha) //; last first. - rewrite -[X]opprK cfdotNr opprD cfdotDr nY_n2 cfdotNl cfdotNr opprK cfdotZl. - by rewrite cfdotC alpha_zeta_n rmorphN conj_Cnat // mulrN addNr oppr0. -split=> [|_ /sS21/sS10//|]; last first. - by apply/allP; rewrite /= !inE cfConjCK !eqxx orbT. -by rewrite /= inE eq_sym; have [[_ /hasPn-> //]] := scohS0; apply: sS10. -Qed. - -Section NonCoherence. - -(* We will ultimately contradict these assumptions. *) -(* Note that we do not need to export any lemma save the final contradiction. *) -Variable tau1 : {additive 'CF(M) -> 'CF(G)}. -Hypothesis cohS : coherent_with calS M^# tau tau1. - -Local Notation "mu ^\tau1" := (tau1 mu%CF) - (at level 2, format "mu ^\tau1") : ring_scope. - -Let Dtau1 : {in 'Z[calS, M'^#], tau1 =1 tau}. -Proof. by case: cohS => _; apply: sub_in1; apply: zchar_onS; apply: setSD. Qed. - -Let o_zeta_s: '[zeta, zeta^*] = 0. -Proof. by rewrite (seqInd_conjC_ortho _ _ _ Szeta) ?mFT_odd /= ?defMs. Qed. - -Import ssrint rat. - -(* This is the second part of Peterfalvi (10.5). *) -Let tau_alpha i j : j != 0 -> - (alpha_ i j)^\tau = delta *: (eta_ i j - eta_ i 0) - n *: zeta^\tau1. -Proof. -move=> nz_j; set al_ij := alpha_ i j; have [[Itau1 Ztau1] _] := cohS. -have [mu1 Ddelta d_gt1 Nn] := FTtype345_constants. -pose a := '[al_ij^\tau, zeta^\tau1] + n. -have al_ij_zeta_s: '[al_ij^\tau, zeta^*^\tau1] = a. - apply: canRL (addNKr _) _; rewrite addrC -opprB -cfdotBr -raddfB. - have M'dz: zeta - zeta^*%CF \in 'Z[calS, M'^#] by apply: seqInd_sub_aut_zchar. - rewrite Dtau1 // Dade_isometry ?alpha_on ?tauM' //. - rewrite cfdotBr opprB cfdotBl cfdot_conjCr rmorphB linearZ /=. - rewrite -!prTIirr_aut !cfdotBl !cfdotZl !o_mu2_zeta o_zeta_s !mulr0. - by rewrite opprB !(subr0, rmorph0) add0r irrWnorm ?mulr1. -have Zal_ij: al_ij^\tau \in 'Z[irr G] by apply: Zalpha_tau. -have Za: a \in Cint. - by rewrite rpredD ?(Cint_Cnat Nn) ?Cint_cfdot_vchar ?Ztau1 ?(mem_zchar Szeta). -have{al_ij_zeta_s} ub_da2: (d ^ 2)%:R * a ^+ 2 <= (2%:R + n ^+ 2) * w1%:R. - have [k nz_k j'k]: exists2 k, k != 0 & k != j. - have:= w2gt2; rewrite -nirrW2 (cardD1 0) (cardD1 j) !inE nz_j !ltnS lt0n. - by case/pred0Pn=> k /and3P[]; exists k. - have muk_1: mu_ k 1%g = (d * w1)%:R. - by rewrite (prTIred_1 pddM) mu1 // mulrC -natrM. - rewrite natrX -exprMn; have <-: '[al_ij^\tau, (mu_ k)^\tau1] = d%:R * a. - rewrite mulrDr mulr_natl -raddfMn /=; apply: canRL (addNKr _) _. - rewrite addrC -cfdotBr -raddfMn -raddfB -scaler_nat. - rewrite Dtau1 ?Dade_isometry ?alpha_on ?tauM' ?ZmuBzeta // cfdotBr cfdotZr. - rewrite rmorph_nat !cfdotBl !cfdotZl !o_mu2_zeta irrWnorm //. - rewrite !(cfdot_prTIirr_red pddM) cfdotC o_mu_zeta conjC0 !mulr0 mulr1. - by rewrite 2 1?eq_sym // mulr0 -mulrN opprB !subr0 add0r. - have ZSmuk: mu_ k \in 'Z[calS] by rewrite mem_zchar ?calSmu. - have <-: '[al_ij^\tau] * '[(mu_ k)^\tau1] = (2%:R + n ^+ 2) * w1%:R. - by rewrite Itau1 // cfdot_prTIred eqxx mul1n norm_alpha. - by rewrite -Cint_normK ?cfCauchySchwarz // Cint_cfdot_vchar // Ztau1. -suffices a0 : a = 0. - by apply: (def_tau_alpha _ sSS0); rewrite // -sub0r -a0 addrK. -apply: contraTeq (d_gt1) => /(sqr_Cint_ge1 Za) a2_ge1. -suffices: n == 0. - rewrite mulf_eq0 invr_eq0 orbC -implyNb neq0CG /= subr_eq0 => /eqP Dd. - by rewrite -ltC_nat -(normr_nat _ d) Dd normr_sign ltrr. -suffices: n ^+ 2 < n + 1. - have d_dv_M: (d%:R %| #|M|)%C by rewrite -(mu1 0 j) // ?dvd_irr1_cardG. - have{d_dv_M} d_odd: odd d by apply: dvdn_odd (mFT_odd M); rewrite -dvdC_nat. - have: (2 %| n * w1%:R)%C. - rewrite divfK ?neq0CG // -signrN signrE addrA -(natrD _ d 1). - by rewrite rpredB // dvdC_nat dvdn2 ?odd_double // odd_add d_odd. - rewrite -(truncCK Nn) -mulrSr -natrM -natrX ltC_nat (dvdC_nat 2) pnatr_eq0. - rewrite dvdn2 odd_mul mFT_odd; case: (truncC n) => [|[|n1]] // _ /idPn[]. - by rewrite -leqNgt (ltn_exp2l 1). -apply: ltr_le_trans (_ : n * - delta + 1 <= _); last first. - have ->: n + 1 = n * `|- delta| + 1 by rewrite normrN normr_sign mulr1. - rewrite ler_add2r ler_wpmul2l ?Cnat_ge0 ?real_ler_norm //. - by rewrite rpredN ?rpred_sign. -rewrite -(ltr_pmul2r (ltC_nat 0 2)) mulrDl mul1r -[rhs in rhs + _]mulrA. -apply: ler_lt_trans (_ : n ^+ 2 * (w1%:R - 1) < _). - rewrite -(subnKC w1gt2) -(@natrB _ _ 1) // ler_wpmul2l ?leC_nat //. - by rewrite Cnat_ge0 ?rpredX. -rewrite -(ltr_pmul2l (gt0CG W1)) -/w1 2!mulrBr mulr1 mulrCA -exprMn. -rewrite mulrDr ltr_subl_addl addrCA -mulrDr mulrCA mulrA -ltr_subl_addl. -rewrite -mulrBr mulNr opprK divfK ?neq0CG // mulr_natr addrA subrK -subr_sqr. -rewrite sqrr_sign mulrC [_ + 2%:R]addrC (ltr_le_trans _ ub_da2) //. -apply: ltr_le_trans (ler_wpmul2l (ler0n _ _) a2_ge1). -by rewrite mulr1 ltr_subl_addl -mulrS -natrX ltC_nat. -Qed. - -(* This is the first part of Peterfalvi (10.6)(a). *) -Let tau1mu j : j != 0 -> (mu_ j)^\tau1 = delta *: \sum_i eta_ i j. -Proof. -move=> nz_j; have [[[Itau1 _] _] Smu_j] := (cohS, calSmu nz_j). -have eta_mu i: '[delta *: (eta_ i j - eta_ i 0), (mu_ j)^\tau1] = 1. - have Szeta_s: zeta^*%CF \in calS by rewrite cfAut_seqInd. - have o_zeta_s_w k: '[eta_ i k, d%:R *: zeta^*^\tau1] = 0. - have o_S_eta_ := coherent_ortho_cycTIiso MtypeP sSS0 cohS. - by rewrite cfdotZr cfdotC o_S_eta_ ?conjC0 ?mulr0 // cfAut_irr. - pose psi := mu_ j - d%:R *: zeta^*%CF; rewrite (canRL (subrK _) (erefl psi)). - rewrite (raddfD tau1) raddfZnat cfdotDr addrC cfdotZl cfdotBl !{}o_zeta_s_w. - rewrite subr0 mulr0 add0r -(canLR (subrK _) (tau_alpha i nz_j)). - have Zpsi: psi \in 'Z[calS, M'^#]. - by rewrite ZmuBzeta // cfunE zeta1w1 rmorph_nat. - rewrite cfdotDl cfdotZl Itau1 ?(zcharW Zpsi) ?mem_zchar // -cfdotZl Dtau1 //. - rewrite Dade_isometry ?alpha_on ?tauM' {Zpsi}// -cfdotDl cfdotBr cfdotZr. - rewrite subrK !cfdotBl !cfdotZl !cfdot_prTIirr_red eq_sym (negPf nz_j). - by rewrite !o_mu2_irr ?cfAut_irr // !(mulr0, subr0) eqxx. -have [_ Ddel _ _] := FTtype345_constants. -have [[d1 k] Dtau1mu] := FTtypeP_coherent_TIred sSS0 cohS irr_zeta Szeta Smu_j. -case=> [[Dd1 Dk] | [_ Dk _]]; first by rewrite Dtau1mu Dd1 Dk [_ ^+ _]Ddel. -have /esym/eqP/idPn[] := eta_mu 0; rewrite Dtau1mu Dk /= cfdotZl cfdotZr. -rewrite cfdot_sumr big1 ?mulr0 ?oner_eq0 // => i _; rewrite -/sigma -/(w_ i _). -rewrite cfdotBl !(cfdot_cycTIiso pddM) !(eq_sym 0) conjC_Iirr_eq0 -!irr_eq1. -rewrite (eq_sym j) -(inj_eq irr_inj) conjC_IirrE. -by rewrite odd_eq_conj_irr1 ?mFT_odd ?subrr. -Qed. - -(* This is the second part of Peterfalvi (10.6)(a). *) -Let tau1mu0 : (mu_ 0 - zeta)^\tau = \sum_i eta_ i 0 - zeta^\tau1. -Proof. -have [j nz_j] := has_nonprincipal_irr ntW2. -have sum_al: \sum_i alpha_ i j = mu_ j - d%:R *: zeta - delta *: (mu_ 0 - zeta). - rewrite scalerBr opprD addrACA scaler_sumr !sumrB sumr_const; congr (_ + _). - by rewrite -opprD -scalerBl nirrW1 -scaler_nat scalerA mulrC divfK ?neq0CG. -have ->: mu_ 0 - zeta = delta *: (mu_ j - d%:R *: zeta - \sum_i alpha_ i j). - by rewrite sum_al opprD addNKr opprK signrZK. -rewrite linearZ linearB; apply: canLR (signrZK _) _; rewrite -/delta /=. -rewrite linear_sum -Dtau1 ?ZmuBzeta //= raddfB raddfZnat addrAC scalerBr. -rewrite (eq_bigr _ (fun i _ => tau_alpha i nz_j)) sumrB sumr_const nirrW1 opprD. -rewrite -scaler_sumr sumrB scalerBr -tau1mu // opprD !opprK -!addrA addNKr. -congr (_ + _); rewrite -scaler_nat scalerA mulrC divfK ?neq0CG //. -by rewrite addrC -!scaleNr -scalerDl addKr. -Qed. - -(* This is Peterfalvi (10.6)(b). *) -Let zeta_tau1_coprime g : - g \notin 'A~(M) -> coprime #[g] w1 -> `|zeta^\tau1 g| >= 1. -Proof. -move=> notAg co_g_w1; have Amu0zeta := mu0Bzeta_on Szeta zeta1w1. -have mu0_zeta_g: (mu_ 0 - zeta)^\tau g = 0. - have [ | ] := boolP (g \in 'A0~(M)); rewrite -FT_Dade0_supportE; last first. - by apply: cfun_on0; apply: Dade_cfunS. - case/bigcupP=> x A0x xRg; rewrite (DadeE _ A0x) // (cfun_on0 Amu0zeta) //. - apply: contra notAg => Ax; apply/bigcupP; exists x => //. - by rewrite -def_FTsignalizer0. -have{mu0_zeta_g} zeta_g: zeta^\tau1 g = \sum_i eta_ i 0 g. - by apply/esym/eqP; rewrite -subr_eq0 -{2}mu0_zeta_g tau1mu0 !cfunE sum_cfunE. -have Zwg i: eta_ i 0 g \in Cint. - have Lchi: 'chi_i \is a linear_char by apply: irr_cyclic_lin. - rewrite Cint_cycTIiso_coprime // dprod_IirrE irr0 cfDprod_cfun1r. - rewrite (coprime_dvdr _ co_g_w1) // dvdn_cforder. - rewrite -rmorphX cfDprodl_eq1 -dvdn_cforder; apply/dvdn_cforderP=> x W1x. - by rewrite -lin_charX // -expg_mod_order (eqnP (order_dvdG W1x)) lin_char1. -have odd_zeta_g: (zeta^\tau1 g == 1 %[mod 2])%C. - rewrite zeta_g (bigD1 0) //= [w_ 0 0]cycTIirr00 cycTIiso1 cfun1E inE. - pose eW1 := [pred i : Iirr W1 | conjC_Iirr i < i]%N. - rewrite (bigID eW1) (reindex_inj (can_inj (@conjC_IirrK _ _))) /=. - set s1 := \sum_(i | _) _; set s2 := \sum_(i | _) _; suffices ->: s1 = s2. - by rewrite -mulr2n addrC -(mulr_natr _ 2) eqCmod_addl_mul ?rpred_sum. - apply/eq_big=> [i | i _]. - rewrite (canF_eq (@conjC_IirrK _ _)) conjC_Iirr0 conjC_IirrK -leqNgt. - rewrite ltn_neqAle val_eqE -irr_eq1 (eq_sym i) -(inj_eq irr_inj) andbA. - by rewrite aut_IirrE odd_eq_conj_irr1 ?mFT_odd ?andbb. - rewrite -{1}conjC_Iirr0 [w_ _ _]cycTIirr_aut -cfAut_cycTIiso. - by rewrite cfunE conj_Cint ?Zwg. -rewrite norm_Cint_ge1 //; first by rewrite zeta_g rpred_sum. -apply: contraTneq odd_zeta_g => ->. -by rewrite eqCmod_sym /eqCmod subr0 /= (dvdC_nat 2 1). -Qed. - -(* This is Peterfalvi (10.7). *) -Let Frob_der1_type2 S : - S \in 'M -> FTtype S == 2 -> [Frobenius S^`(1) with kernel S`_\F]. -Proof. -move: S => L maxL /eqP Ltype2. -have [S pairMS [xdefW [U StypeP]]] := FTtypeP_pair_witness maxM MtypeP. -have [[_ _ maxS] _] := pairMS; rewrite {1}(negPf notMtype2) /= => Stype2 _. -move/(_ L maxL)/implyP; rewrite Ltype2 /= => /setUP[] /imsetP[x0 _ defL]. - by case/eqP/idPn: Ltype2; rewrite defL FTtypeJ. -pose H := (S`_\F)%G; pose HU := (S^`(1))%G. -suffices{L Ltype2 maxL x0 defL}: [Frobenius HU = H ><| U]. - by rewrite defL derJ FcoreJ FrobeniusJker; apply: FrobeniusWker. -have sHHU: H \subset HU by have [_ [_ _ _ /sdprodW/mulG_sub[]]] := StypeP. -pose calT := seqIndD HU S H 1; pose tauS := FT_Dade0 maxS. -have DcalTs: calT = seqIndD HU S S`_\s 1. - by congr (seqIndD _ _ _ _); apply: val_inj; rewrite /= FTcore_type2. -have notFrobM: ~~ [Frobenius M with kernel M`_\F]. - by apply/existsP=> [[U1 /Frobenius_of_typeF/(typePF_exclusion MtypeP)]]. -have{notFrobM} notSsupportM: ~~ [exists x, FTsupports M (S :^ x)]. - apply: contra notFrobM => /'exists_existsP[x [y /and3P[Ay not_sCyM sCySx]]]. - have [_ [_ /(_ y)uMS] /(_ y)] := FTsupport_facts maxM. - rewrite inE (subsetP (FTsupp_sub0 _)) //= in uMS *. - rewrite -(eq_uniq_mmax (uMS not_sCyM) _ sCySx) ?mmaxJ // FTtypeJ. - by case=> // _ _ _ [_ ->]. -have{notSsupportM} tiA1M_AS: [disjoint 'A1~(M) & 'A~(S)]. - have notMG_S: gval S \notin M :^: G. - by apply: contraL Stype2 => /imsetP[x _ ->]; rewrite FTtypeJ. - by apply: negbNE; have [_ <- _] := FT_Dade_support_disjoint maxM maxS notMG_S. -pose pddS := FT_prDade_hypF maxS StypeP; pose nu := primeTIred pddS. -have{tiA1M_AS} oST phi psi: - phi \in 'Z[calS, M^#] -> psi \in 'Z[calT, S^#] -> '[phi^\tau, tauS psi] = 0. -- rewrite zcharD1_seqInd // -[seqInd _ _]/calS => Sphi. - rewrite zcharD1E => /andP[Tpsi psi1_0]. - rewrite -FT_Dade1E ?defA1 ?(zchar_on Sphi) //. - apply: cfdot_complement (Dade_cfunS _ _) _; rewrite FT_Dade1_supportE setTD. - rewrite -[tauS _]FT_DadeE ?(cfun_onS _ (Dade_cfunS _ _)) ?FT_Dade_supportE //. - by rewrite -disjoints_subset disjoint_sym. - have /subsetD1P[_ /setU1K <-] := FTsupp_sub S; rewrite cfun_onD1 {}psi1_0. - rewrite -Tpsi andbC -zchar_split {psi Tpsi}(zchar_trans_on _ Tpsi) //. - move=> psi Tpsi; rewrite zchar_split mem_zchar //=. - have [s /setDP[_ kerH's] ->] := seqIndP Tpsi. - by rewrite inE in kerH's; rewrite (prDade_Ind_irr_on pddS). -have notStype5: FTtype S != 5 by rewrite (eqP Stype2). -have [|[_ _ _ _ -> //]] := typeP_reducible_core_cases maxS StypeP notStype5. -case=> t []; set lambda := 'chi_t => T0C'lam lam_1 _. -have{T0C'lam} Tlam: lambda \in calT. - by apply: seqIndS T0C'lam; rewrite Iirr_kerDS ?sub1G. -have{lam_1} [r [nz_r Tnu_r nu_r_1]]: - exists r, [/\ r != 0, nu r \in calT & nu r 1%g = lambda 1%g]. -- have [_] := typeP_reducible_core_Ind maxS StypeP notStype5. - set H0 := Ptype_Fcore_kernel _; set nuT := filter _ _; rewrite -/nu. - case/hasP=> nu_r nuTr _ /(_ _ nuTr)/imageP[r nz_r Dr] /(_ _ nuTr)[nu_r1 _ _]. - have{nuTr} Tnu_r := mem_subseq (filter_subseq _ _) nuTr. - by exists r; rewrite -Dr nu_r1 (seqIndS _ Tnu_r) // Iirr_kerDS ?sub1G. -pose T2 := [:: lambda; lambda^*; nu r; (nu r)^*]%CF. -have [rmRS scohT]: exists rmRS, subcoherent calT tauS rmRS. - move: (FTtypeP_coh_base _ _) (FTtypeP_subcoherent maxS StypeP) => RS scohT. - by rewrite DcalTs; exists RS. -have [lam_irr nu_red]: lambda \in irr S /\ nu r \notin irr S. - by rewrite mem_irr prTIred_not_irr. -have [lam'nu lams'nu]: lambda != nu r /\ lambda^*%CF != nu r. - by rewrite -conjC_IirrE !(contraNneq _ nu_red) // => <-; apply: mem_irr. -have [[_ nRT ccT] _ _ _ _] := scohT. -have{ccT} sT2T: {subset T2 <= calT} by apply/allP; rewrite /= ?Tlam ?Tnu_r ?ccT. -have{nRT} uccT2: cfConjC_subset T2 calT. - split; last 1 [by [] | by apply/allP; rewrite /= !inE !cfConjCK !eqxx !orbT]. - rewrite /uniq /T2 !inE !negb_or -!(inv_eq (@cfConjCK _ S)) !cfConjCK. - by rewrite lam'nu lams'nu !(hasPn nRT). -have scohT2 := subset_subcoherent scohT uccT2. -have [tau2 cohT2]: coherent T2 S^# tauS. - apply: (uniform_degree_coherence scohT2); rewrite /= !cfunE nu_r_1 eqxx. - by rewrite conj_Cnat ?Cnat_irr1 ?eqxx. -have [s nz_s] := has_nonprincipal_irr ntW2; have Smu_s := calSmu nz_s. -pose alpha := mu_ s - d%:R *: zeta; pose beta := nu r - lambda. -have Salpha: alpha \in 'Z[calS, M^#] by rewrite zcharD1_seqInd ?ZmuBzeta. -have [T2lam T2nu_r]: lambda \in T2 /\ nu r \in T2 by rewrite !inE !eqxx !orbT. -have Tbeta: beta \in 'Z[T2, S^#]. - by rewrite zcharD1E rpredB ?mem_zchar //= !cfunE nu_r_1 subrr. -have /eqP/idPn[] := oST _ _ Salpha (zchar_subset sT2T Tbeta). -have [[_ <- //] [_ <- //]] := (cohS, cohT2). -rewrite !raddfB raddfZnat /= subr_eq0 !cfdotBl !cfdotZl. -have [|[dr r'] -> _] := FTtypeP_coherent_TIred _ cohT2 lam_irr T2lam T2nu_r. - by rewrite -DcalTs. -set sigS := cyclicTIiso _ => /=. -have etaC i j: sigS (cyclicTIirr xdefW j i) = eta_ i j by apply: cycTIisoC. -rewrite !cfdotZr addrC cfdot_sumr big1 => [|j _]; last first. - by rewrite etaC (coherent_ortho_cycTIiso _ sSS0) ?mem_irr. -rewrite !mulr0 oppr0 add0r rmorph_sign. -have ->: '[zeta^\tau1, tau2 lambda] = 0. - pose X1 := (zeta :: zeta^*)%CF; pose X2 := (lambda :: lambda^*)%CF. - pose Y1 := map tau1 X1; pose Y2 := map tau2 X2; have [_ _ ccS] := sSS0. - have [sX1S sX2T]: {subset X1 <= calS} /\ {subset X2 <= T2}. - by split; apply/allP; rewrite /= ?inE ?eqxx ?orbT // Szeta ccS. - have [/(sub_iso_to (zchar_subset sX1S) sub_refl)[Itau1 Ztau1] Dtau1L] := cohS. - have [/(sub_iso_to (zchar_subset sX2T) sub_refl)[Itau2 Ztau2] Dtau2] := cohT2. - have Z_Y12: {subset Y1 <= 'Z[irr G]} /\ {subset Y2 <= 'Z[irr G]}. - by rewrite /Y1 /Y2; split=> ? /mapP[xi /mem_zchar] => [/Ztau1|/Ztau2] ? ->. - have o1Y12: orthonormal Y1 && orthonormal Y2. - rewrite !map_orthonormal //. - by apply: seqInd_conjC_ortho2 Tlam; rewrite ?gFnormal ?mFT_odd. - by apply: seqInd_conjC_ortho2 Szeta; rewrite ?gFnormal ?mFT_odd ?mem_irr. - apply: orthonormal_vchar_diff_ortho Z_Y12 o1Y12 _; rewrite -2!raddfB. - have SzetaBs: zeta - zeta^*%CF \in 'Z[calS, M^#]. - by rewrite zcharD1_seqInd // seqInd_sub_aut_zchar. - have T2lamBs: lambda - lambda^*%CF \in 'Z[T2, S^#]. - rewrite sub_aut_zchar ?zchar_onG ?mem_zchar ?inE ?eqxx ?orbT //. - by move=> xi /sT2T/seqInd_vcharW. - by rewrite Dtau1L // Dtau2 // !Dade1 oST ?(zchar_subset sT2T) ?eqxx. -have [[ds s'] /= -> _] := FTtypeP_coherent_TIred sSS0 cohS irr_zeta Szeta Smu_s. -rewrite mulr0 subr0 !cfdotZl mulrA -signr_addb !cfdot_suml. -rewrite (bigD1 r') //= cfdot_sumr (bigD1 s') //=. -rewrite etaC cfdot_cycTIiso !eqxx big1 => [|j ne_s'_j]; last first. - by rewrite etaC cfdot_cycTIiso andbC eq_sym (negPf ne_s'_j). -rewrite big1 => [|i ne_i_r']; last first. - rewrite cfdot_sumr big1 // => j _. - by rewrite etaC cfdot_cycTIiso (negPf ne_i_r'). -rewrite !addr0 mulr1 big1 ?mulr0 ?signr_eq0 // => i _. -by rewrite -etaC cfdotC (coherent_ortho_cycTIiso _ _ cohT2) ?conjC0 -?DcalTs. -Qed. - -(* This is the bulk of the proof of Peterfalvi (10.8); however the result *) -(* will be restated below to avoid the quantification on zeta and tau1. *) -Lemma FTtype345_noncoherence_main : False. -Proof. -have [S pairMS [xdefW [U StypeP]]] := FTtypeP_pair_witness maxM MtypeP. -have [[_ _ maxS] _] := pairMS; rewrite {1}(negPf notMtype2) /= => Stype2 _ _. -pose H := (S`_\F)%G; pose HU := (S^`(1))%G. -have [[_ hallW2 _ defS] [_ _ nUW2 defHU] _ [_ _ sW1H _ _] _] := StypeP. -have ntU: U :!=: 1%g by have [[]] := compl_of_typeII maxS StypeP Stype2. -pose G01 := [set g : gT | coprime #[g] w1]. -pose G0 := ~: 'A~(M) :&: G01; pose G1 := ~: 'A~(M) :\: G01. -pose chi := zeta^\tau1; pose ddAM := FT_Dade_hyp maxM; pose rho := invDade ddAM. -have Suzuki: - #|G|%:R^-1 * (\sum_(g in ~: 'A~(M)) `|chi g| ^+ 2 - #|~: 'A~(M)|%:R) - + '[rho chi] - #|'A(M)|%:R / #|M|%:R <= 0. -- pose A_ (_ : 'I_1) := ddAM; pose Atau i := Dade_support (A_ i). - have tiA i j : i != j -> [disjoint Atau i & Atau j] by rewrite !ord1. - have Nchi1: '[chi] = 1 by have [[->]] := cohS; rewrite ?mem_zchar ?irrWnorm. - have:= Dade_cover_inequality tiA Nchi1; rewrite /= !big_ord1 -/rho -addrA. - by congr (_ * _ + _ <= 0); rewrite FT_Dade_supportE setTD. -have{Suzuki} ub_rho: '[rho chi] <= #|'A(M)|%:R / #|M|%:R + #|G1|%:R / #|G|%:R. - rewrite addrC -subr_le0 opprD addrCA (ler_trans _ Suzuki) // -addrA. - rewrite ler_add2r -(cardsID G01 (~: _)) (big_setID G01) -/G0 -/G1 /=. - rewrite mulrC mulrBr ler_subr_addl -mulrBr natrD addrK. - rewrite ler_wpmul2l ?invr_ge0 ?ler0n // -sumr_const ler_paddr //. - by apply: sumr_ge0 => g; rewrite exprn_ge0 ?normr_ge0. - apply: ler_sum => g; rewrite !inE => /andP[notAg] /(zeta_tau1_coprime notAg). - by rewrite expr_ge1 ?normr_ge0. -have lb_M'bar: (w1 * 2 <= #|M' / M''|%g.-1)%N. - suffices ->: w1 = #|W1 / M''|%g. - rewrite muln2 -ltnS prednK ?cardG_gt0 //. - by rewrite (ltn_odd_Frobenius_ker frobMbar) ?quotient_odd ?mFT_odd. - have [_ sW1M _ _ tiM'W1] := sdprod_context defM. - apply/card_isog/quotient_isog; first exact: subset_trans (der_norm 2 M). - by apply/trivgP; rewrite -tiM'W1 setSI ?normal_sub. -have lb_rho: 1 - w1%:R / #|M'|%:R <= '[rho chi]. - have cohS_A: coherent_with calS M^# (Dade ddAM) tau1. - have [Itau1 _] := cohS; split=> // phi; rewrite zcharD1_seqInd // => Sphi. - by rewrite Dtau1 // FT_DadeE // defA (zchar_on Sphi). - rewrite {ub_rho}/rho [w1](index_sdprod defM); rewrite defA in (ddAM) cohS_A *. - have [||_ [_ _ [] //]] := Dade_Ind1_sub_lin cohS_A _ irr_zeta Szeta. - - by apply: seqInd_nontrivial Szeta; rewrite ?mem_irr ?mFT_odd. - - by rewrite -(index_sdprod defM). - rewrite -(index_sdprod defM) ler_pdivl_mulr ?ltr0n // -natrM. - rewrite -leC_nat in lb_M'bar; apply: ler_trans lb_M'bar _. - rewrite ler_subr_addl -mulrS prednK ?cardG_gt0 // leC_nat. - by rewrite dvdn_leq ?dvdn_quotient. -have{lb_rho ub_rho}: - 1 - #|G1|%:R / #|G|%:R - w1%:R^-1 < w1%:R / #|M'|%:R :> algC. -- rewrite -addrA -opprD ltr_subl_addr -ltr_subl_addl. - apply: ler_lt_trans (ler_trans lb_rho ub_rho) _; rewrite addrC ltr_add2l. - rewrite ltr_pdivr_mulr ?gt0CG // mulrC -(sdprod_card defM) natrM. - by rewrite mulfK ?neq0CG // defA ltC_nat (cardsD1 1%g M') group1. -have frobHU: [Frobenius HU with kernel H] by apply: Frob_der1_type2. -have tiH: normedTI H^# G S. - by have [_ _] := FTtypeII_ker_TI maxS Stype2; rewrite FTsupp1_type2. -have sG1_HVG: G1 \subset class_support H^# G :|: class_support V G. - apply/subsetP=> x; rewrite !inE coprime_has_primes ?cardG_gt0 // negbK. - case/andP=> /hasP[p W1p]; rewrite /= mem_primes => /and3P[p_pr _ p_dv_x] _. - have [a x_a a_p] := Cauchy p_pr p_dv_x. - have nta: a != 1%g by rewrite -order_gt1 a_p prime_gt1. - have ntx: x != 1%g by apply: contraTneq x_a => ->; rewrite /= cycle1 inE. - have cxa: a \in 'C[x] by rewrite -cent_cycle (subsetP (cycle_abelian x)). - have hallH: \pi(H).-Hall(G) H by apply: Hall_pi; have [] := FTcore_facts maxS. - have{a_p} p_a: p.-elt a by rewrite /p_elt a_p pnat_id. - have piHp: p \in \pi(H) by rewrite (piSg _ W1p). - have [y _ Hay] := Hall_pJsub hallH piHp (subsetT _) p_a. - do [rewrite -cycleJ cycle_subG; set ay := (a ^ y)%g] in Hay. - rewrite -[x](conjgK y); set xy := (x ^ y)%g. - have caxy: xy \in 'C[ay] by rewrite cent1J memJ_conjg cent1C. - have [ntxy ntay]: xy != 1%g /\ ay != 1%g by rewrite !conjg_eq1. - have Sxy: xy \in S. - have H1ay: ay \in H^# by apply/setD1P. - by rewrite (subsetP (cent1_normedTI tiH H1ay)) ?setTI. - have [HUxy | notHUxy] := boolP (xy \in HU). - rewrite memJ_class_support ?inE ?ntxy //=. - have [_ _ _ regHUH] := Frobenius_kerP frobHU. - by rewrite (subsetP (regHUH ay _)) // inE ?HUxy // inE ntay. - suffices /imset2P[xyz z Vxzy _ ->]: xy \in class_support V S. - by rewrite -conjgM orbC memJ_class_support. - rewrite /V setUC -(FTsupp0_typeP maxS StypeP) !inE Sxy. - rewrite andb_orr andNb (contra (subsetP _ _) notHUxy) /=; last first. - by apply/bigcupsP=> z _; rewrite (eqP Stype2) setDE -setIA subsetIl. - have /Hall_pi hallHU: Hall S HU by rewrite (sdprod_Hall defS). - rewrite (eqP Stype2) -(mem_normal_Hall hallHU) ?gFnormal // notHUxy. - have /mulG_sub[sHHU _] := sdprodW defHU. - rewrite (contra (fun p'xy => pi'_p'group p'xy (piSg sHHU piHp))) //. - by rewrite pgroupE p'natE // cycleJ cardJg p_dv_x. -have ub_G1: #|G1|%:R / #|G|%:R <= #|H|%:R / #|S|%:R + #|V|%:R / #|W|%:R :> algC. - rewrite ler_pdivr_mulr ?ltr0n ?cardG_gt0 // mulrC mulrDr !mulrA. - rewrite ![_ * _ / _]mulrAC -!natf_indexg ?subsetT //= -!natrM -natrD ler_nat. - apply: leq_trans (subset_leq_card sG1_HVG) _. - rewrite cardsU (leq_trans (leq_subr _ _)) //. - have unifJG B C: C \in B :^: G -> #|C| = #|B|. - by case/imsetP=> z _ ->; rewrite cardJg. - have oTI := card_uniform_partition (unifJG _) (partition_class_support _ _). - have{tiH} [ntH tiH /eqP defNH] := and3P tiH. - have [_ _ /and3P[ntV tiV /eqP defNV]] := ctiWG. - rewrite !oTI // !card_conjugates defNH defNV /= leq_add2r ?leq_mul //. - by rewrite subset_leq_card ?subsetDl. -rewrite ler_gtF // addrAC ler_subr_addl -ler_subr_addr (ler_trans ub_G1) //. -rewrite -(sdprod_card defS) -(sdprod_card defHU) addrC. -rewrite -mulnA !natrM invfM mulVKf ?natrG_neq0 // -/w1 -/w2. -have sW12_W: W1 :|: W2 \subset W by rewrite -(dprodWY defW) sub_gen. -rewrite cardsD (setIidPr sW12_W) natrB ?subset_leq_card // mulrBl. -rewrite divff ?natrG_neq0 // -!addrA ler_add2l. -rewrite cardsU -(dprod_card defW) -/w1 -/w2; have [_ _ _ ->] := dprodP defW. -rewrite cards1 natrB ?addn_gt0 ?cardG_gt0 // addnC natrD -addrA mulrDl mulrBl. -rewrite {1}mulnC !natrM !invfM !mulVKf ?natrG_neq0 // opprD -addrA ler_add2l. -rewrite mul1r -{1}[_^-1]mul1r addrC ler_oppr [- _]opprB -!mulrBl. -rewrite -addrA -opprD ler_pdivl_mulr; last by rewrite natrG_gt0. -apply: ler_trans (_ : 1 - (3%:R^-1 + 7%:R^-1) <= _); last first. - rewrite ler_add2l ler_opp2. - rewrite ler_add // lef_pinv ?qualifE ?gt0CG ?ltr0n ?ler_nat //. - have notStype5: FTtype S != 5 by rewrite (eqP Stype2). - have frobUW2 := Ptype_compl_Frobenius maxS StypeP notStype5. - apply: leq_ltn_trans (ltn_odd_Frobenius_ker frobUW2 (mFT_odd _)). - by rewrite (leq_double 3). -apply: ler_trans (_ : 2%:R^-1 <= _); last by rewrite -!CratrE; compute. -rewrite mulrAC ler_pdivr_mulr 1?gt0CG // ler_pdivl_mull ?ltr0n //. -rewrite -!natrM ler_nat mulnA -(Lagrange (normal_sub nsM''M')) mulnC leq_mul //. - by rewrite subset_leq_card //; have [_ _ _ []] := MtypeP. -by rewrite -card_quotient ?normal_norm // mulnC -(prednK (cardG_gt0 _)) leqW. -Qed. - -End NonCoherence. - -(* This is Peterfalvi (10.9). *) -Lemma FTtype345_Dade_bridge0 : - (w1 < w2)%N -> - {chi | [/\ (mu_ 0 - zeta)^\tau = \sum_i eta_ i 0 - chi, - chi \in 'Z[irr G], '[chi] = 1 - & forall i j, '[chi, eta_ i j] = 0]}. -Proof. -move=> w1_lt_w2; set psi := mu_ 0 - zeta; pose Wsig := map sigma (irr W). -have [X wsigX [chi [DpsiG _ o_chiW]]] := orthogonal_split Wsig psi^\tau. -exists (- chi); rewrite opprK rpredN cfnormN. -have o_chi_w i j: '[chi, eta_ i j] = 0. - by rewrite (orthoPl o_chiW) ?map_f ?mem_irr. -have [Isigma Zsigma] := cycTI_Zisometry ctiWG. -have o1Wsig: orthonormal Wsig by rewrite map_orthonormal ?irr_orthonormal. -have [a_ Da defX] := orthonormal_span o1Wsig wsigX. -have{Da} Da i j: a_ (eta_ i j) = '[psi^\tau, eta_ i j]. - by rewrite DpsiG cfdotDl o_chi_w addr0 Da. -have sumX: X = \sum_i \sum_j a_ (eta_ i j) *: eta_ i j. - rewrite pair_bigA defX big_map (big_nth 0) size_tuple big_mkord /=. - rewrite (reindex (dprod_Iirr defW)) /=. - by apply: eq_bigr => [[i j] /= _]; rewrite -tnth_nth. - by exists (inv_dprod_Iirr defW) => ij; rewrite (inv_dprod_IirrK, dprod_IirrK). -have Zpsi: psi \in 'Z[irr M]. - by rewrite rpredB ?irr_vchar ?(mem_zchar irr_zeta) ?char_vchar ?prTIred_char. -have{Zpsi} M'psi: psi \in 'Z[irr M, M'^#]. - by rewrite -defA zchar_split Zpsi mu0Bzeta_on. -have A0psi: psi \in 'CF(M, 'A0(M)). - by apply: cfun_onS (zchar_on M'psi); rewrite defA0 subsetUl. -have a_00: a_ (eta_ 0 0) = 1. - rewrite Da [w_ 0 0](cycTIirr00 defW) [sigma 1]cycTIiso1. - rewrite Dade_reciprocity // => [|x _ y _]; last by rewrite !cfun1E !inE. - rewrite rmorph1 /= -(prTIirr00 ptiWM) -/(mu2_ 0 0) cfdotC. - by rewrite cfdotBr o_mu2_zeta subr0 cfdot_prTIirr_red rmorph1. -have n2psiG: '[psi^\tau] = w1.+1%:R. - rewrite Dade_isometry // cfnormBd ?o_mu_zeta //. - by rewrite cfnorm_prTIred irrWnorm // -/w1 mulrSr. -have psiG_V0 x: x \in V -> psi^\tau x = 0. - move=> Vx; rewrite Dade_id ?defA0; last first. - by rewrite inE orbC mem_class_support. - rewrite (cfun_on0 (zchar_on M'psi)) // -defA. - suffices /setDP[]: x \in 'A0(M) :\: 'A(M) by []. - by rewrite (FTsupp0_typeP maxM MtypeP) // mem_class_support. -have ZpsiG: psi^\tau \in 'Z[irr G]. - by rewrite Dade_vchar // zchar_split (zcharW M'psi). -have n2psiGsum: '[psi^\tau] = \sum_i \sum_j `|a_ (eta_ i j)| ^+ 2 + '[chi]. - rewrite DpsiG addrC cfnormDd; last first. - by rewrite (span_orthogonal o_chiW) ?memv_span1. - rewrite addrC defX cfnorm_sum_orthonormal // big_map pair_bigA; congr (_ + _). - rewrite big_tuple /= (reindex (dprod_Iirr defW)) //. - by exists (inv_dprod_Iirr defW) => ij; rewrite (inv_dprod_IirrK, dprod_IirrK). -have NCpsiG: (cyclicTI_NC ctiWG psi^\tau < 2 * minn w1 w2)%N. - apply: (@leq_ltn_trans w1.+1); last first. - by rewrite /minn w1_lt_w2 mul2n -addnn (leq_add2r w1 2) cardG_gt1. - pose z_a := [pred ij | a_ (eta_ ij.1 ij.2) == 0]. - have ->: cyclicTI_NC ctiWG psi^\tau = #|[predC z_a]|. - by apply: eq_card => ij; rewrite !inE -Da. - rewrite -leC_nat -n2psiG n2psiGsum ler_paddr ?cfnorm_ge0 // pair_bigA. - rewrite (bigID z_a) big1 /= => [|ij /eqP->]; last by rewrite normCK mul0r. - rewrite add0r -sumr_const ler_sum // => [[i j] nz_ij]. - by rewrite expr_ge1 ?norm_Cint_ge1 // Da Cint_cfdot_vchar ?Zsigma ?irr_vchar. -have nz_psiG00: '[psi^\tau, eta_ 0 0] != 0 by rewrite -Da a_00 oner_eq0. -have [a_i|a_j] := small_cycTI_NC psiG_V0 NCpsiG nz_psiG00. - have psiGi: psi^\tau = \sum_i eta_ i 0 + chi. - rewrite DpsiG sumX; congr (_ + _); apply: eq_bigr => i _. - rewrite big_ord_recl /= Da a_i -Da a_00 mul1r scale1r. - by rewrite big1 ?addr0 // => j1 _; rewrite Da a_i mul0r scale0r. - split=> // [||i j]; last by rewrite cfdotNl o_chi_w oppr0. - rewrite -(canLR (addKr _) psiGi) rpredD // rpredN rpred_sum // => j _. - by rewrite Zsigma ?irr_vchar. - apply: (addrI w1%:R); rewrite -mulrSr -n2psiG n2psiGsum; congr (_ + _). - rewrite -nirrW1 // -sumr_const; apply: eq_bigr => i _. - rewrite big_ord_recl /= Da a_i -Da a_00 mul1r normr1. - by rewrite expr1n big1 ?addr0 // => j1 _; rewrite Da a_i normCK !mul0r. -suffices /idPn[]: '[psi^\tau] >= w2%:R. - rewrite odd_geq /= ?uphalf_half mFT_odd //= in w1_lt_w2. - by rewrite n2psiG leC_nat -ltnNge odd_geq ?mFT_odd. -rewrite n2psiGsum exchange_big /= ler_paddr ?cfnorm_ge0 //. -rewrite -nirrW2 -sumr_const; apply: ler_sum => i _. -rewrite big_ord_recl /= Da a_j -Da a_00 mul1r normr1. -by rewrite expr1n big1 ?addr0 // => j1 _; rewrite Da a_j normCK !mul0r. -Qed. - -Local Notation H := M'. -Local Notation "` 'H'" := `M' (at level 0) : group_scope. -Local Notation H' := M''. -Local Notation "` 'H''" := `M'' (at level 0) : group_scope. - -(* This is the bulk of the proof of Peterfalvi, Theorem (10.10); as with *) -(* (10.8), it will be restated below in order to remove dependencies on zeta, *) -(* U_M and W1. *) -Lemma FTtype5_exclusion_main : FTtype M != 5. -Proof. -apply/negP=> Mtype5. -suffices [tau1]: coherent calS M^# tau by case/FTtype345_noncoherence_main. -have [[_ U_M_1] MtypeV] := compl_of_typeV maxM MtypeP Mtype5. -have [_ [_ _ _ defH] _ [_ _ _ sW2H' _] _] := MtypeP. -have{U_M_1 defH} defMF: M`_\F = H by rewrite /= -defH U_M_1 sdprodg1. -have nilH := Fcore_nil M; rewrite defMF -/w1 in MtypeV nilH. -without loss [p [pH not_cHH ubHbar not_w1_dv_p1]]: / exists p : nat, - [/\ p.-group H, ~~ abelian H, #|H : H'| <= 4 * w1 ^ 2 + 1 & ~ w1 %| p.-1]%N. -- have [isoH1 solH] := (quotient1_isog H, nilpotent_sol nilH). - have /non_coherent_chief-IHcoh := subset_subcoherent scohS0 sSS0. - apply: IHcoh (fun coh _ => coh) _ => // [|[[_ ubH] [p [pH ab'H] /negP-dv'p]]]. - split; rewrite ?mFT_odd ?normal1 ?sub1G ?quotient_nil //. - by rewrite joingG1 (FrobeniusWker frobMbar). - apply; exists p; rewrite (isog_abelian isoH1) (isog_pgroup p isoH1) -subn1. - by rewrite /= joingG1 -(index_sdprod defM) in ubH dv'p. -have ntH: H :!=: 1%g by apply: contraNneq not_cHH => ->; apply: abelian1. -have [sH'H nH'H] := andP nsM''M'; have sW2H := subset_trans sW2H' sH'H. -have def_w2: w2 = p by apply/eqP; have:= pgroupS sW2H pH; rewrite pgroupE pnatE. -have piHp q: q \in \pi(H) -> q = p. - by rewrite /= -(part_pnat_id pH) pi_of_part // => /andP[_ /eqnP]. -have [tiHG | [_ /piHp-> []//] | [_ /piHp-> [oH w1_dv_p1 _]]] := MtypeV. - suffices [tau1 [Itau1 Dtau1]]: coherent (seqIndD H M H 1) M^# 'Ind[G]. - exists tau1; split=> // phi Sphi; rewrite {}Dtau1 //. - rewrite zcharD1_seqInd // -subG1 -setD_eq0 -defA in Sphi tiHG ntH. - by have Aphi := zchar_on Sphi; rewrite -FT_DadeE // Dade_Ind. - apply: (@Sibley_coherence _ [set:_] M H W1); first by rewrite mFT_odd. - right; exists W2 => //; exists 'A0(M), W, defW. - by rewrite -defA -{2}(group_inj defMs). -have [p_pr _ _] := pgroup_pdiv pH ntH; rewrite (pcore_pgroup_id pH) in oH. -have{not_cHH} esH: extraspecial H. - by apply: (p3group_extraspecial pH); rewrite // oH pfactorK. -have oH': #|H'| = p. - by rewrite -(card_center_extraspecial pH esH); have [[_ <-]] := esH. -have defW2: W2 :=: H' by apply/eqP; rewrite eqEcard sW2H' oH' -def_w2 /=. -have iH'H: #|H : H'|%g = (p ^ 2)%N by rewrite -divgS // oH oH' mulKn ?prime_gt0. -have w1_gt0: (0 < w1)%N by apply: cardG_gt0. -(* This is step (10.10.1). *) -have{ubHbar} [def_p_w1 w1_lt_w2]: (p = 2 * w1 - 1 /\ w1 < w2)%N. - have /dvdnP[k def_p]: 2 * w1 %| p.+1. - by rewrite Gauss_dvd ?coprime2n ?mFT_odd ?dvdn2 //= -{1}def_w2 mFT_odd. - suffices k1: k = 1%N. - rewrite k1 mul1n in def_p; rewrite -ltn_double -mul2n -def_p -addn1 addnK. - by rewrite -addnS -addnn def_w2 leq_add2l prime_gt1. - have [k0 | k_gt0] := posnP k; first by rewrite k0 in def_p. - apply/eqP; rewrite eqn_leq k_gt0 andbT -ltnS -ltn_double -mul2n. - rewrite -[(2 * k)%N]prednK ?muln_gt0 // ltnS -ltn_sqr 3?leqW //=. - rewrite -subn1 sqrn_sub ?muln_gt0 // expnMn muln1 mulnA ltnS leq_subLR. - rewrite addn1 addnS ltnS -mulnSr leq_pmul2l // -(leq_subLR _ 1). - rewrite (leq_trans (leq_pmulr _ w1_gt0)) // -(leq_pmul2r w1_gt0). - rewrite -mulnA mulnBl mul1n -2!leq_double -!mul2n mulnA mulnBr -!expnMn. - rewrite -(expnMn 2 _ 2) mulnCA -def_p -addn1 leq_subLR sqrnD muln1. - by rewrite (addnC p) mulnDr addnA leq_add2r addn1 addnS -iH'H. -(* This is step (10.10.2). *) -pose S1 := seqIndD H M H H'. -have sS1S: {subset S1 <= calS} by apply: seqIndS; rewrite Iirr_kerDS ?sub1G. -have irrS1: {subset S1 <= irr M}. - move=> _ /seqIndP[s /setDP[kerH' ker'H] ->]; rewrite !inE in kerH' ker'H. - rewrite -(quo_IirrK _ kerH') // mod_IirrE // cfIndMod // cfMod_irr //. - rewrite (irr_induced_Frobenius_ker (FrobeniusWker frobMbar)) //. - by rewrite quo_Iirr_eq0 // -subGcfker. -have S1w1: {in S1, forall xi : 'CF(M), xi 1%g = w1%:R}. - move=> _ /seqIndP[s /setDP[kerH' _] ->]; rewrite !inE in kerH'. - by rewrite cfInd1 // -(index_sdprod defM) lin_char1 ?mulr1 // lin_irr_der1. -have sS10: cfConjC_subset S1 calS0. - by apply: seqInd_conjC_subset1; rewrite /= defMs. -pose S2 := [seq mu_ j | j in predC1 0]. -have szS2: size S2 = p.-1. - by rewrite -def_w2 size_map -cardE cardC1 card_Iirr_abelian ?cyclic_abelian. -have uS2: uniq S2 by apply/dinjectiveP; apply: in2W (prTIred_inj pddM). -have redS2: {subset S2 <= [predC irr M]}. - by move=> _ /imageP[j _ ->]; apply: (prTIred_not_irr pddM). -have sS2S: {subset S2 <= calS} by move=> _ /imageP[j /calSmu Smu_j ->]. -have S1'2: {subset S2 <= [predC S1]}. - by move=> xi /redS2; apply: contra (irrS1 _). -have w1_dv_p21: w1 %| p ^ 2 - 1 by rewrite (subn_sqr p 1) addn1 dvdn_mull. -have [j nz_j] := has_nonprincipal_irr ntW2. -have [Dmu2_1 Ddelta_ lt1d Nn] := FTtype345_constants. -have{lt1d} [defS szS1 Dd Ddel Dn]: - [/\ perm_eq calS (S1 ++ S2), size S1 = (p ^ 2 - 1) %/ w1, - d = p, delta = -1 & n = 2%:R]. -- pose X_ (S0 : seq 'CF(M)) := [set s | 'Ind[M, H] 'chi_s \in S0]. - pose sumX_ cS0 := \sum_(s in X_ cS0) 'chi_s 1%g ^+ 2. - have defX1: X_ S1 = Iirr_kerD H H H'. - by apply/setP=> s; rewrite !inE mem_seqInd // !inE. - have defX: X_ calS = Iirr_kerD H H 1%g. - by apply/setP=> s; rewrite !inE mem_seqInd ?normal1 //= !inE. - have sumX1: sumX_ S1 = (p ^ 2)%:R - 1. - by rewrite /sumX_ defX1 sum_Iirr_kerD_square // iH'H indexgg mul1r. - have ->: size S1 = (p ^ 2 - 1) %/ w1. - apply/eqP; rewrite eqn_div // -eqC_nat mulnC [w1](index_sdprod defM). - rewrite (size_irr_subseq_seqInd _ (subseq_refl S1)) //. - rewrite natrB ?expn_gt0 ?prime_gt0 // -sumr_const -sumX1. - apply/eqP/esym/eq_bigr => s. - by rewrite defX1 !inE -lin_irr_der1 => /and3P[_ _ /eqP->]; rewrite expr1n. - have oX2: #|X_ S2| = p.-1. - by rewrite -(size_red_subseq_seqInd_typeP MtypeP uS2 sS2S). - have sumX2: (p ^ 2 * p.-1)%:R <= sumX_ S2 ?= iff (d == p). - rewrite /sumX_ (eq_bigr (fun _ => d%:R ^+ 2)) => [|s]; last first. - rewrite inE => /imageP[j1 nz_j1 Dj1]; congr (_ ^+ 2). - apply: (mulfI (neq0CiG M H)); rewrite -cfInd1 // -(index_sdprod defM). - by rewrite Dj1 (prTIred_1 pddM) Dmu2_1. - rewrite sumr_const oX2 mulrnA (mono_lerif (ler_pmuln2r _)); last first. - by rewrite -def_w2 -(subnKC w2gt2). - rewrite natrX (mono_in_lerif ler_sqr) ?rpred_nat // eq_sym lerif_nat. - apply/leqif_eq; rewrite dvdn_leq 1?ltnW //. - have: (mu2_ 0 j 1%g %| (p ^ 3)%N)%C. - by rewrite -(cfRes1 H) cfRes_prTIirr -oH dvd_irr1_cardG. - rewrite Dmu2_1 // dvdC_nat => /dvdn_pfactor[//|[_ d1|e _ ->]]. - by rewrite d1 in lt1d. - by rewrite expnS dvdn_mulr. - pose S3 := filter [predC S1 ++ S2] calS. - have sumX3: 0 <= sumX_ S3 ?= iff nilp S3. - rewrite /sumX_; apply/lerifP. - have [-> | ] := altP nilP; first by rewrite big_pred0 // => s; rewrite !inE. - rewrite -lt0n -has_predT => /hasP[xi S3xi _]. - have /seqIndP[s _ Dxi] := mem_subseq (filter_subseq _ _) S3xi. - rewrite (bigD1 s) ?inE -?Dxi //= ltr_spaddl ?sumr_ge0 // => [|s1 _]. - by rewrite exprn_gt0 ?irr1_gt0. - by rewrite ltrW ?exprn_gt0 ?irr1_gt0. - have [_ /esym] := lerif_add sumX2 sumX3. - have /(canLR (addKr _)) <-: sumX_ calS = sumX_ S1 + (sumX_ S2 + sumX_ S3). - rewrite [sumX_ _](big_setID (X_ S1)); congr (_ + _). - by apply: eq_bigl => s; rewrite !inE andb_idl // => /sS1S. - rewrite (big_setID (X_ S2)); congr (_ + _); apply: eq_bigl => s. - by rewrite !inE andb_idl // => S2s; rewrite [~~ _]S1'2 ?sS2S. - by rewrite !inE !mem_filter /= mem_cat orbC negb_or andbA. - rewrite sumX1 /sumX_ defX sum_Iirr_kerD_square ?sub1G ?normal1 // indexgg. - rewrite addr0 mul1r indexg1 oH opprD addrACA addNr addr0 addrC. - rewrite (expnSr p 2) -[p in (_ ^ 2 * p)%:R - _]prednK ?prime_gt0 // mulnSr. - rewrite natrD addrK eqxx => /andP[/eqP Dd /nilP S3nil]. - have uS12: uniq (S1 ++ S2). - by rewrite cat_uniq seqInd_uniq uS2 andbT; apply/hasPn. - rewrite uniq_perm_eq ?seqInd_uniq {uS12}// => [|xi]; last first. - apply/idP/idP; apply: allP xi; last by rewrite all_cat !(introT allP _). - by rewrite -(canLR negbK (has_predC _ _)) has_filter -/S3 S3nil. - have: (w1 %| d%:R - delta)%C. - by rewrite unfold_in pnatr_eq0 eqn0Ngt w1_gt0 rpred_Cnat. - rewrite /n Dd def_p_w1 /delta; case: (Idelta _) => [_|/idPn[] /=]. - by rewrite opprK -(natrD _ _ 1) subnK ?muln_gt0 // natrM mulfK ?neq0CG. - rewrite mul2n -addnn -{1}(subnKC (ltnW w1gt2)) !addSn mulrSr addrK dvdC_nat. - by rewrite add0n dvdn_addl // -(subnKC w1gt2) gtnNdvd // leqW. -have scohS1 := subset_subcoherent scohS0 sS10. -have o1S1: orthonormal S1. - rewrite orthonormalE andbC; have [_ _ -> _ _] := scohS1. - by apply/allP=> xi /irrS1/irrP[t ->]; rewrite /= cfnorm_irr. -have [tau1 cohS1]: coherent S1 M^# tau. - apply: uniform_degree_coherence scohS1 _; apply: all_pred1_constant w1%:R _ _. - by rewrite all_map; apply/allP=> xi /S1w1/= ->. -have [[Itau1 Ztau1] Dtau1] := cohS1. -have o1S1tau: orthonormal (map tau1 S1) by apply: map_orthonormal. -have S1zeta: zeta \in S1. - by have:= Szeta; rewrite (perm_eq_mem defS) mem_cat => /orP[//|/redS2/negP]. -(* This is the main part of step 10.10.3; as the definition of alpha_ remains *) -(* valid we do not need to reprove alpha_on. *) -have Dalpha i (al_ij := alpha_ i j) : - al_ij^\tau = delta *: (eta_ i j - eta_ i 0) - n *: tau1 zeta. -- have [Y S1_Y [X [Dal_ij _ oXY]]] := orthogonal_split (map tau1 S1) al_ij^\tau. - have [a_ Da_ defY] := orthonormal_span o1S1tau S1_Y. - have oXS1 lam : lam \in S1 -> '[X, tau1 lam] = 0. - by move=> S1lam; rewrite (orthoPl oXY) ?map_f. - have{Da_} Da_ lam : lam \in S1 -> a_ (tau1 lam) = '[al_ij^\tau, tau1 lam]. - by move=> S1lam; rewrite Dal_ij cfdotDl oXS1 // addr0 Da_. - pose a := n + a_ (tau1 zeta); have [_ oS1S1] := orthonormalP o1S1. - have Da_z: a_ (tau1 zeta) = - n + a by rewrite addKr. - have Za: a \in Cint. - rewrite rpredD ?Dn ?rpred_nat // Da_ // Cint_cfdot_vchar ?Zalpha_tau //=. - by rewrite Ztau1 ?mem_zchar. - have Da_z' lam: lam \in S1 -> lam != zeta -> a_ (tau1 lam) = a. - move=> S1lam zeta'lam; apply: canRL (subrK _) _. - rewrite !Da_ // -cfdotBr -raddfB. - have S1dlam: lam - zeta \in 'Z[S1, M^#]. - by rewrite zcharD1E rpredB ?mem_zchar //= !cfunE !S1w1 ?subrr. - rewrite Dtau1 // Dade_isometry ?alpha_on ?tauM' //; last first. - by rewrite -zcharD1_seqInd ?(zchar_subset sS1S). - have o_mu2_lam k: '[mu2_ i k, lam] = 0 by rewrite o_mu2_irr ?sS1S ?irrS1. - rewrite !cfdotBl !cfdotZl !cfdotBr !o_mu2_lam !o_mu2_zeta !(subr0, mulr0). - by rewrite irrWnorm ?oS1S1 // eq_sym (negPf zeta'lam) !add0r mulrN1 opprK. - have lb_n2alij: (a - n) ^+ 2 + (size S1 - 1)%:R * a ^+ 2 <= '[al_ij^\tau]. - rewrite Dal_ij cfnormDd; last first. - by rewrite cfdotC (span_orthogonal oXY) ?rmorph0 // memv_span1. - rewrite ler_paddr ?cfnorm_ge0 // defY cfnorm_sum_orthonormal //. - rewrite (big_rem (tau1 zeta)) ?map_f //= ler_eqVlt; apply/predU1P; left. - congr (_ + _). - by rewrite Da_z addrC Cint_normK 1?rpredD // rpredN Dn rpred_nat. - rewrite (eq_big_seq (fun _ => a ^+ 2)) => [|tau1lam]; last first. - rewrite rem_filter ?free_uniq ?orthonormal_free // filter_map. - case/mapP=> lam; rewrite mem_filter /= andbC => /andP[S1lam]. - rewrite (inj_in_eq (Zisometry_inj Itau1)) ?mem_zchar // => zeta'lam ->. - by rewrite Da_z' // Cint_normK. - rewrite big_tnth sumr_const card_ord size_rem ?map_f // size_map. - by rewrite mulr_natl subn1. - have{lb_n2alij} ub_a2: (size S1)%:R * a ^+ 2 <= 2%:R * a * n + 2%:R. - rewrite norm_alpha // addrC sqrrB !addrA ler_add2r in lb_n2alij. - rewrite mulr_natl -mulrSr ler_subl_addl subn1 in lb_n2alij. - by rewrite -mulrA !mulr_natl; case: (S1) => // in S1zeta lb_n2alij *. - have{ub_a2} ub_8a2: 8%:R * a ^+ 2 <= 4%:R * a + 2%:R. - rewrite mulrAC Dn -natrM in ub_a2; apply: ler_trans ub_a2. - rewrite -Cint_normK // ler_wpmul2r ?exprn_ge0 ?normr_ge0 // leC_nat szS1. - rewrite (subn_sqr p 1) def_p_w1 subnK ?muln_gt0 // mulnA mulnK // mulnC. - by rewrite -subnDA -(mulnBr 2 _ 1%N) mulnA (@leq_pmul2l 4 2) ?ltn_subRL. - have Z_4a1: 4%:R * a - 1%:R \in Cint by rewrite rpredB ?rpredM ?rpred_nat. - have{ub_8a2} ub_4a1: `|4%:R * a - 1| < 3%:R. - rewrite -ltr_sqr ?rpred_nat ?qualifE ?normr_ge0 // -natrX Cint_normK //. - rewrite sqrrB1 exprMn -natrX -mulrnAl -mulrnA (natrD _ 8 1) ltr_add2r. - rewrite (natrM _ 2 4) (natrM _ 2 8) -!mulrA -mulrBr ltr_pmul2l ?ltr0n //. - by rewrite ltr_subl_addl (ler_lt_trans ub_8a2) // ltr_add2l ltr_nat. - have{ub_4a1} a0: a = 0. - apply: contraTeq ub_4a1 => a_nz; have:= norm_Cint_ge1 Za a_nz. - rewrite real_ltr_norml ?real_ler_normr ?Creal_Cint //; apply: contraL. - case/andP; rewrite ltr_subl_addr -(natrD _ 3 1) gtr_pmulr ?ltr0n //. - rewrite ltr_oppl opprB -mulrN => /ltr_le_trans/=/(_ _ (leC_nat 3 5)). - by rewrite (natrD _ 1 4) ltr_add2l gtr_pmulr ?ltr0n //; do 2!move/ltr_geF->. - apply: (def_tau_alpha cohS1 sS10 nz_j S1zeta). - by rewrite -Da_ // Da_z a0 addr0. -have o_eta__zeta i j1: '[tau1 zeta, eta_ i j1] = 0. - by rewrite (coherent_ortho_cycTIiso _ sS10 cohS1) ?mem_irr. -(* This is step (10.4), the final one. *) -have Dmu0zeta: (mu_ 0 - zeta)^\tau = \sum_i eta_ i 0 - tau1 zeta. - have A0mu0tau: mu_ 0 - zeta \in 'CF(M, 'A0(M)). - rewrite /'A0(M) defA; apply: (cfun_onS (subsetUl _ _)). - rewrite cfun_onD1 [mu_ 0](prTIred0 pddM) !cfunE zeta1w1 cfuniE // group1. - by rewrite mulr1 subrr rpredB ?rpredZnat ?cfuni_on ?(seqInd_on _ Szeta) /=. - have [chi [Dmu0 Zchi n1chi o_chi_w]] := FTtype345_Dade_bridge0 w1_lt_w2. - have dirr_chi: chi \in dirr G by rewrite dirrE Zchi n1chi /=. - have dirr_zeta: tau1 zeta \in dirr G. - by rewrite dirrE Ztau1 ?Itau1 ?mem_zchar //= irrWnorm. - have: '[(alpha_ 0 j)^\tau, (mu_ 0 - zeta)^\tau] == - delta + n. - rewrite Dade_isometry ?alpha_on // !cfdotBl !cfdotZl !cfdotBr. - rewrite !o_mu2_zeta 2!cfdot_prTIirr_red (negPf nz_j) cfdotC o_mu_zeta. - by rewrite eqxx irrWnorm // conjC0 !(subr0, add0r) mulr1 mulrN1 opprK. - rewrite Dalpha // Dmu0 !{1}(cfdotBl, cfdotZl) !cfdotBr 2!{1}(cfdotC _ chi). - rewrite !o_chi_w conjC0 !cfdot_sumr big1 => [|i]; first last. - by rewrite (cfdot_cycTIiso pddM) (negPf nz_j) andbF. - rewrite (bigD1 0) //= cfdot_cycTIiso big1 => [|i nz_i]; first last. - by rewrite cfdot_cycTIiso eq_sym (negPf nz_i). - rewrite big1 // !subr0 !add0r addr0 mulrN1 mulrN opprK (can_eq (addKr _)). - rewrite {2}Dn -mulr_natl Dn (inj_eq (mulfI _)) ?pnatr_eq0 //. - by rewrite cfdot_dirr_eq1 // => /eqP->. -have [] := uniform_prTIred_coherent pddM nz_j; rewrite -/sigma. -have ->: uniform_prTIred_seq pddM j = S2. - congr (map _ _); apply: eq_enum => k; rewrite !inE -!/(mu_ _). - by rewrite andb_idr // => nz_k; rewrite 2!{1}prTIred_1 2?Dmu2_1. -case=> _ _ ccS2 _ _ [tau2 Dtau2 cohS2]. -have{cohS2} cohS2: coherent_with S2 M^# tau tau2 by apply: cohS2. -have sS20: cfConjC_subset S2 calS0. - by split=> // xi /sS2S Sxi; have [_ ->] := sSS0. -rewrite perm_eq_sym perm_catC in defS; apply: perm_eq_coherent defS _. -suffices: (mu_ j - d%:R *: zeta)^\tau = tau2 (mu_ j) - tau1 (d%:R *: zeta). - apply: (bridge_coherent scohS0 sS20 cohS2 sS10 cohS1) => [phi|]. - by apply: contraL => /S1'2. - rewrite cfunD1E !cfunE zeta1w1 prTIred_1 mulrC Dmu2_1 // subrr. - by rewrite image_f // rpredZnat ?mem_zchar. -have sumA: \sum_i alpha_ i j = mu_ j - delta *: mu_ 0 - (d%:R - delta) *: zeta. - rewrite !sumrB sumr_const /= -scaler_sumr; congr (_ - _ - _). - rewrite card_Iirr_abelian ?cyclic_abelian // -/w1 -scaler_nat. - by rewrite scalerA mulrC divfK ?neq0CG. -rewrite scalerBl opprD opprK addrACA in sumA. -rewrite -{sumA}(canLR (addrK _) sumA) opprD opprK -scalerBr. -rewrite linearD linearZ linear_sum /= Dmu0zeta scalerBr. -rewrite (eq_bigr _ (fun i _ => Dalpha i)) sumrB sumr_const nirrW1. -rewrite -!scaler_sumr sumrB addrAC !addrA scalerBr subrK -addrA -opprD. -rewrite raddfZnat Dtau2 Ddelta_ //; congr (_ - _). -by rewrite addrC -scaler_nat scalerA mulrC divfK ?neq0CG // -scalerDl subrK. -Qed. - -End OneMaximal. - -Implicit Type M : {group gT}. - -(* This is the exported version of Peterfalvi, Theorem (10.8). *) -Theorem FTtype345_noncoherence M (M' := M^`(1)%G) (maxM : M \in 'M) : - (FTtype M > 2)%N -> ~ coherent (seqIndD M' M M' 1) M^# (FT_Dade0 maxM). -Proof. -rewrite ltnNge 2!leq_eqVlt => /norP[notMtype2 /norP[notMtype1 _]] [tau1 cohS]. -have [U W W1 W2 defW MtypeP] := FTtypeP_witness maxM notMtype1. -have [zeta [irr_zeta Szeta zeta1w1]] := FTtypeP_ref_irr maxM MtypeP. -exact: (FTtype345_noncoherence_main MtypeP _ irr_zeta Szeta zeta1w1 cohS). -Qed. - -(* This is the exported version of Peterfalvi, Theorem (10.10). *) -Theorem FTtype5_exclusion M : M \in 'M -> FTtype M != 5. -Proof. -move=> maxM; apply: wlog_neg; rewrite negbK => Mtype5. -have notMtype2: FTtype M != 2 by rewrite (eqP Mtype5). -have [U W W1 W2 defW [[MtypeP _] _]] := FTtypeP 5 maxM Mtype5. -have [zeta [irr_zeta Szeta zeta1w1]] := FTtypeP_ref_irr maxM MtypeP. -exact: (FTtype5_exclusion_main _ MtypeP _ irr_zeta). -Qed. - -(* This the first assertion of Peterfalvi (10.11). *) -Lemma FTtypeP_pair_primes S T W W1 W2 (defW : W1 \x W2 = W) : - typeP_pair S T defW -> prime #|W1| /\ prime #|W2|. -Proof. -move=> pairST; have [[_ maxS maxT] _ _ _ _] := pairST. -have type24 maxM := compl_of_typeII_IV maxM _ (FTtype5_exclusion maxM). -split; first by have [U /type24[]] := typeP_pairW pairST. -have xdefW: W2 \x W1 = W by rewrite dprodC. -by have [U /type24[]] := typeP_pairW (typeP_pair_sym xdefW pairST). -Qed. - -Corollary FTtypeP_primes M U W W1 W2 (defW : W1 \x W2 = W) : - M \in 'M -> of_typeP M U defW -> prime #|W1| /\ prime #|W2|. -Proof. -move=> maxM MtypeP; have [T pairMT _] := FTtypeP_pair_witness maxM MtypeP. -exact: FTtypeP_pair_primes pairMT. -Qed. - -(* This is the remainder of Peterfalvi (10.11). *) -Lemma FTtypeII_prime_facts M U W W1 W2 (defW : W1 \x W2 = W) (maxM : M \in 'M) : - of_typeP M U defW -> FTtype M == 2 -> - let H := M`_\F%G in let HU := M^`(1)%G in - let calS := seqIndD HU M H 1 in let tau := FT_Dade0 maxM in - let p := #|W2| in let q := #|W1| in - [/\ p.-abelem H, (#|H| = p ^ q)%N & coherent calS M^# tau]. -Proof. -move=> MtypeP Mtype2 H HU calS tau p q. -have Mnot5: FTtype M != 5 by rewrite (eqP Mtype2). -have [_ cUU _ _ _] := compl_of_typeII maxM MtypeP Mtype2. -have [q_pr p_pr]: prime q /\ prime p := FTtypeP_primes maxM MtypeP. -have:= typeII_IV_core maxM MtypeP Mnot5; rewrite Mtype2 -/p -/q => [[_ oH]]. -have [] := Ptype_Fcore_kernel_exists maxM MtypeP Mnot5. -have [_ _] := Ptype_Fcore_factor_facts maxM MtypeP Mnot5. -rewrite -/H; set H0 := Ptype_Fcore_kernel _; set Hbar := (H / H0)%G. -rewrite def_Ptype_factor_prime // -/p -/q => oHbar chiefHbar _. -have trivH0: H0 :=: 1%g. - have [/maxgroupp/andP[/andP[sH0H _] nH0M] /andP[sHM _]] := andP chiefHbar. - apply: card1_trivg; rewrite -(setIidPr sH0H) -divg_index. - by rewrite -card_quotient ?(subset_trans sHM) // oHbar -oH divnn cardG_gt0. -have abelHbar: p.-abelem Hbar. - have pHbar: p.-group Hbar by rewrite /pgroup oHbar pnat_exp pnat_id. - by rewrite -is_abelem_pgroup // (sol_chief_abelem _ chiefHbar) ?mmax_sol. -rewrite /= trivH0 -(isog_abelem (quotient1_isog _)) in abelHbar. -have:= Ptype_core_coherence maxM MtypeP Mnot5; rewrite trivH0. -set C := _ MtypeP; have sCU: C \subset U by rewrite [C]unlock subsetIl. -by rewrite (derG1P (abelianS sCU cUU)) [(1 <*> 1)%G]join1G. -Qed. - -End Ten. diff --git a/mathcomp/odd_order/PFsection11.v b/mathcomp/odd_order/PFsection11.v deleted file mode 100644 index 3635618..0000000 --- a/mathcomp/odd_order/PFsection11.v +++ /dev/null @@ -1,1203 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div choice. -From mathcomp -Require Import fintype tuple finfun bigop prime ssralg poly finset center. -From mathcomp -Require Import fingroup morphism perm automorphism quotient action finalg zmodp. -From mathcomp -Require Import gfunctor gproduct cyclic commutator gseries nilpotent pgroup. -From mathcomp -Require Import sylow hall abelian maximal frobenius. -From mathcomp -Require Import matrix mxalgebra mxrepresentation mxabelem vector. -From mathcomp -Require Import BGsection1 BGsection3 BGsection7 BGsection15 BGsection16. -From mathcomp -Require Import ssrnum ssrint algC classfun character inertia vcharacter. -From mathcomp -Require Import PFsection1 PFsection2 PFsection3 PFsection4 PFsection5. -From mathcomp -Require Import PFsection6 PFsection7 PFsection8 PFsection9 PFsection10. - -(******************************************************************************) -(* This file covers Peterfalvi, Section 11: Maximal subgroups of Types *) -(* III and IV. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope GRing.Theory FinRing.Theory Num.Theory. - -Section Eleven. - -(* This is Peterfalvi (11.1). *) -Lemma lbound_expn_odd_prime p q : - odd p -> odd q -> prime p -> prime q -> p != q -> 4 * q ^ 2 + 1 < p ^ q. -Proof. -move=> odd_p odd_q pr_p pr_q p_neq_q. -have{pr_p pr_q} [pgt2 qgt2] : 2 < p /\ 2 < q by rewrite !odd_prime_gt2. -have [qlt5 | qge5 {odd_q qgt2 p_neq_q}] := ltnP q 5. - have /eqP q3: q == 3 by rewrite eqn_leq qgt2 andbT -ltnS -(odd_ltn 5). - apply: leq_trans (_ : 5 ^ q <= p ^ q); first by rewrite q3. - by rewrite leq_exp2r // odd_geq // ltn_neqAle pgt2 eq_sym -q3 p_neq_q. -apply: leq_trans (_ : 3 ^ q <= p ^ q); last by rewrite -(subnKC qge5) leq_exp2r. -elim: q qge5 => // q IHq; rewrite ltnS leq_eqVlt => /predU1P[<- // | qge5]. -rewrite (expnS 3); apply: leq_trans {IHq}(leq_mul (leqnn 3) (IHq qge5)). -rewrite -!addnS mulnDr leq_add // mulnCA leq_mul // !(mul1n, mulSnr). -by rewrite -addn1 sqrnD muln1 -(subnKC qge5) !leq_add ?leq_mul. -Qed. - -Local Open Scope ring_scope. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). -Implicit Types H K L N P Q R S T U V W : {group gT}. - -Variables M U W W1 W2 : {group gT}. -Hypotheses (maxM : M \in 'M) (defW : W1 \x W2 = W) (MtypeP : of_typeP M U defW). -Hypothesis notMtype2 : FTtype M != 2. - -Let notMtype5 : FTtype M != 5. Proof. exact: FTtype5_exclusion. Qed. -Let notMtype1 : FTtype M != 1%N. Proof. exact: FTtypeP_neq1 MtypeP. Qed. -Let Mtype34 : FTtype M \in pred2 3 4. -Proof. -by have:= FTtype_range M; rewrite -mem_iota !inE !orbA orbC 3?[_ == _](negPf _). -Qed. -Let Mtype_gt2 : (FTtype M > 2)%N. Proof. by case/pred2P: Mtype34 => ->. Qed. - -Local Notation H0 := (Ptype_Fcore_kernel MtypeP). -Local Notation "` 'H0'" := (gval H0) (at level 0, only parsing) : group_scope. -Local Notation "` 'M'" := (gval M) (at level 0, only parsing) : group_scope. -Local Notation "` 'U'" := (gval U) (at level 0, only parsing) : group_scope. -Local Notation "` 'W'" := (gval W) (at level 0, only parsing) : group_scope. -Local Notation "` 'W1'" := (gval W1) (at level 0, only parsing) : group_scope. -Local Notation "` 'W2'" := (gval W2) (at level 0, only parsing) : group_scope. -Local Notation H := `M`_\F%G. -Local Notation "` 'H'" := `M`_\F (at level 0) : group_scope. -Local Notation HU := M^`(1)%G. -Local Notation "` 'HU'" := `M^`(1)%g (at level 0) : group_scope. -Local Notation U' := U^`(1)%G. -Local Notation "` 'U''" := `U^`(1)%g (at level 0) : group_scope. -Local Notation C := 'C_U(`H)%G. -Local Notation "` 'C'" := 'C_`U(`H) (at level 0) : group_scope. -Local Notation HC := (`H <*> `C)%G. -Local Notation "` 'HC'" := (`H <*> `C) (at level 0) : group_scope. -Local Notation H0C := (`H0 <*> `C)%G. -Local Notation "` 'H0C'" := (`H0 <*> `C) (at level 0) : group_scope. -Local Notation Hbar := (`H / `H0)%g. - -Local Notation S_ := (seqIndD HU M HU). -Local Notation tau := (FT_Dade0 maxM). -Local Notation R := (FTtypeP_coh_base maxM MtypeP). -Local Notation V := (cyclicTIset defW). - -Let Mtype24 := compl_of_typeII_IV maxM MtypeP notMtype5. - -Let defMs : M`_\s = HU. Proof. exact: FTcore_type_gt2. Qed. -Let defA1 : 'A1(M) = HU^#. Proof. by rewrite /= -defMs. Qed. -Let defA : 'A(M) = HU^#. Proof. by rewrite FTsupp_eq1. Qed. -Let sHU_A0 : HU^# \subset 'A0(M). Proof. by rewrite -defA FTsupp_sub0. Qed. - -Let calS := seqIndD HU M M`_\s 1. -Let scohM : subcoherent calS tau R. Proof. exact: FTtypeP_subcoherent. Qed. -Let scoh1 : subcoherent (S_ 1) tau R. -Proof. by rewrite -{2}(group_inj defMs). Qed. - -Let p := #|W2|. -Let pr_p : prime p. Proof. by have [] := FTtypeP_primes maxM MtypeP. Qed. -Let ntW2 : W2 :!=: 1%g. Proof. by rewrite -cardG_gt1 prime_gt1. Qed. -Let cycW2 : cyclic W2. Proof. exact: prime_cyclic. Qed. -Let def_p : pdiv #|Hbar| = p. Proof. exact: typeIII_IV_core_prime. Qed. - -Let q := #|W1|. -Let pr_q : prime q. Proof. by have [] := FTtypeP_primes maxM MtypeP. Qed. -Let ntW1 : W1 :!=: 1%g. Proof. by rewrite -cardG_gt1 prime_gt1. Qed. -Let cycW1 : cyclic W1. Proof. exact: prime_cyclic. Qed. - -Let defM : HU ><| W1 = M. Proof. by have [[]] := MtypeP. Qed. -Let defHU : H ><| U = HU. Proof. by have [_ []] := MtypeP. Qed. - -Let nsHUM : HU <| M. Proof. exact: gFnormal. Qed. -Let sHUM : HU \subset M. Proof. exact: gFsub. Qed. -Let sHHU : H \subset HU. Proof. by have /mulG_sub[] := sdprodW defHU. Qed. -Let sUHU : U \subset HU. Proof. by have /mulG_sub[] := sdprodW defHU. Qed. -Let sUM : U \subset M. Proof. exact: subset_trans sUHU sHUM. Qed. - -Let coHUq : coprime #|HU| q. -Proof. by rewrite (coprime_sdprod_Hall_r defM); have [[]] := MtypeP. Qed. -Let coUq : coprime #|U| q. Proof. exact: coprimeSg coHUq. Qed. - -Let neq_pq : p != q. -Proof. -apply: contraTneq coHUq => <-; rewrite coprime_sym prime_coprime ?cardSg //. -by rewrite -(typeP_cent_compl MtypeP) subsetIl. -Qed. - -Let solHU : solvable HU. Proof. exact: solvableS sHUM (mmax_sol maxM). Qed. -Let solH : solvable H. Proof. exact: solvableS sHHU solHU. Qed. - -Let ltM''HU : M^`(2)%g \proper HU. -Proof. by rewrite (sol_der1_proper solHU) // -defMs FTcore_neq1. Qed. - -Let frobMtilde : [Frobenius M / M^`(2) = (HU / M^`(2)) ><| (W1 / M^`(2))]. -Proof. -have [[_ _ _ _] _ _ [_ _ _ sW2M'' prHUW1 ] _] := MtypeP. -by rewrite Frobenius_coprime_quotient ?gFnormal //; split=> // _ /prHUW1->. -Qed. - -Let defHC : H \x C = HC. -Proof. -by have [defHC _ _ _] := typeP_context MtypeP; rewrite /= (dprodWY defHC). -Qed. - -Let nC_UW1 : U <*> W1 \subset 'N(C). -Proof. -have /sdprodP[_ _ nHUW1 _] := Ptype_Fcore_sdprod MtypeP. -by rewrite normsI ?norms_cent // join_subG normG; have [_ []] := MtypeP. -Qed. - -Let nsCM : C <| M. -Proof. -rewrite /normal subIset ?sUM //= -{1}(sdprodW (Ptype_Fcore_sdprod MtypeP)). -by rewrite mulG_subG cents_norm // centsC subsetIr. -Qed. - -Let nsCU : C <| U. Proof. exact: normalS (subsetIl _ _) sUM nsCM. Qed. -Let nsHC_M : HC <| M. Proof. by rewrite normalY ?gFnormal. Qed. -Let sHC_HU : HC \subset HU. Proof. by rewrite join_subG sHHU subIset ?sUHU. Qed. -Let nsHC_HU : HC <| HU. Proof. exact: normalS nsHC_M. Qed. - -Let chiefH0 : chief_factor M H0 H. -Proof. by have [] := Ptype_Fcore_kernel_exists maxM MtypeP notMtype5. Qed. - -Let minHbar : minnormal Hbar (M / H0). -Proof. exact: chief_factor_minnormal. Qed. - -Let abelHbar : p.-abelem Hbar. -Proof. -have solHbar : solvable (H / H0) by rewrite quotient_sol. -have [_ _] := minnormal_solvable minHbar (subxx _) solHbar. -by rewrite /is_abelem def_Ptype_factor_prime. -Qed. - -Let sH0H : H0 \subset H. -Proof. by have/andP[/maxgroupp/andP[/proper_sub]]:= chiefH0. Qed. - -Let nH0M: M \subset 'N(H0). -Proof. by have /andP[/maxgroupp/andP[]] := chiefH0. Qed. - -Let nsH0H : H0 <| H. -Proof. by rewrite /normal sH0H gFsub_trans. Qed. - -Let nsH0C_M : H0C <| M. -Proof. by rewrite normalY // /normal ?(subset_trans sH0H) ?gFsub. Qed. - -Let defH0C : H0 \x C = H0C. -Proof. -have /dprodP[_ _ cHC tiHC] := defHC. -by rewrite dprodEY ?(centsS sH0H) //; apply/trivgP; rewrite -tiHC setSI. -Qed. - -(* Group-theoretic consequences of the coherence and non-coherence theorems *) -(* of Sections 5, 9 and 10 for maximal subgroups of type III and IV. *) - -(* This is Peterfalvi (11.3). *) -Lemma FTtype34_noncoherence : ~ coherent (S_ H0C) M^# tau. -Proof. -move=> cohH0C; suff: coherent (S_ 1) M^# tau by apply: FTtype345_noncoherence. -have /mulG_sub[_ sW1M] := sdprodW defM. -have [nsHHU _ _ nHU tiHU] := sdprod_context defHU. -have sHM: H \subset M := gFsub _ _. -have [sCM sH0C_M]: C \subset M /\ H0C \subset M by rewrite !normal_sub. -have nH0_C := subset_trans sCM nH0M. -have sH0C_HC: H0C \subset HC by apply: genS (setSU _ _). -have defF: HC :=: 'F(M) by have [/dprodWY] := typeP_context MtypeP. -have{defF} nilHC: nilpotent (HC / 1) by rewrite defF quotient_nil ?Fitting_nil. -have /bounded_seqIndD_coherence-bounded_coh1 := scoh1. -apply: bounded_coh1 nilHC cohH0C _; rewrite ?sub1G ?normal1 //. -have[_ _ /= oHbar] := Ptype_Fcore_factor_facts maxM MtypeP notMtype5. -rewrite -(index_sdprod defM) -divgS // -(dprod_card defHC) -(dprod_card defH0C). -rewrite divnMr ?cardG_gt0 // divg_normal // oHbar def_p -/q. -by rewrite lbound_expn_odd_prime ?mFT_odd. -Qed. - -(* This is Peterfalvi (11.4). *) -Lemma bounded_proper_coherent H1 : - H1 <| M -> H1 \proper HU -> coherent (S_ H1) M^# tau -> - (#|HU : H1| <= 2 * q * #|U : C| + 1)%N. -Proof. -move=> nsH1_M psH1_M' cohH1; have [nsHHU _ _ _ _] := sdprod_context defHU. -suffices: #|HU : H1|%:R - 1 <= 2%:R * #|M : HC|%:R * sqrtC #|HC : HC|%:R :> algC. - rewrite indexgg sqrtC1 mulr1 -leC_nat natrD -ler_subl_addr -mulnA natrM. - congr (_ <= _ * _%:R); apply/eqP; rewrite -(eqn_pmul2l (cardG_gt0 HC)). - rewrite Lagrange ?normal_sub // mulnCA -(dprod_card defHC) -mulnA mulnC. - by rewrite Lagrange ?subsetIl // (sdprod_card defHU) (sdprod_card defM). -apply/negP/(coherent_seqIndD_bound _ _ scoh1 _ _ _ FTtype34_noncoherence) => //. -suffices /center_idP->: abelian (HC / H0C) by rewrite genS ?setSU. -suffices /isog_abelian<-: Hbar \isog HC / H0C by apply: abelem_abelian abelHbar. -by rewrite /= [`H0C]joingC quotient_sdprodr_isog ?(dprodWsdC defHC). -Qed. - -(* This is Peterfalvi (11.5). *) -Lemma FTtype34_der2 : M^`(2)%g = HC. -Proof. -have [defFM [_ not_cHU] _ _] := typeP_context MtypeP. -have [_ sW1M _ _ tiHU_W1] := sdprod_context defM. -have{defFM} sM''_HC: M^`(2)%g \subset HC. - by rewrite -defHC defFM; have [_ _ []] := MtypeP. -have scohM'': subcoherent (S_ M^`(2)) tau R. - exact/(subset_subcoherent scoh1)/seqInd_conjC_subset1. -have cohM'': coherent (S_ M^`(2)) M^# tau. - apply: uniform_degree_coherence scohM'' _. - apply: all_pred1_constant #|M : HU|%:R _ _; rewrite all_map. - apply/allP=> _ /seqIndP[s /setDP[kerM'' _] ->] /=; rewrite inE in kerM''. - by rewrite cfInd1 ?gFsub // lin_char1 ?mulr1 ?lin_irr_der1. -have ubHC: (#|HC : M^`(2)| < 2 * q + 1)%N. - rewrite -(ltn_pmul2r (indexg_gt0 U C)) mulnDl mul1n. - apply: leq_ltn_trans (_ : 2 * q * #|U : C| + 1 < _)%N; last first. - by rewrite ltn_add2l indexg_gt1 subsetIidl not_cHU //; have [] := Mtype24. - have {1}->: #|U : C| = #|HU : HC| by apply: index_sdprodr (subsetIl _ _). - by rewrite mulnC (Lagrange_index sHC_HU) // bounded_proper_coherent ?gFnormal. -have regHC_W1: semiregular (HC / M^`(2)) (W1 / M^`(2)). - by apply: semiregularS (Frobenius_reg_ker frobMtilde); rewrite quotientS. -suffices /dvdnP[k Dk]: 2 * q %| #|HC : M^`(2)|.-1. - apply: contraTeq ubHC; rewrite -leqNgt eqEsubset sM''_HC -indexg_gt1 addn1. - by rewrite -[#|_:_|]prednK // {}Dk !ltnS muln_gt0 => /andP[/leq_pmull->]. -rewrite Gauss_dvd; last by rewrite coprime2n mFT_odd. -rewrite dvdn2 -subn1 odd_sub // addbT negbK subn1. -rewrite -card_quotient; last by rewrite (subset_trans sHC_HU) // (der_norm 1). -have Dq: q = #|W1 / M^`(2)|%g. - apply/card_isog/quotient_isog; first by rewrite (subset_trans sW1M) ?gFnorm. - by apply/trivgP; rewrite -tiHU_W1 setSI // (der_sub 1). -rewrite quotient_odd ?mFT_odd //= Dq regular_norm_dvd_pred ?quotient_norms //. -by rewrite (subset_trans sW1M) ?normal_norm. -Qed. -Local Notation defM'' := FTtype34_der2. - -(* This is Peterfalvi (11.6). *) -Lemma FTtype34_facts (H' := H^`(1)%g): - [/\ p.-group H, U \subset 'C(H0), H0 :=: H' & C :=: U']. -Proof. -have nilH: nilpotent H := Fcore_nil M. -have /sdprod_context[/andP[_ nHM] sUW1M _ _ _] := Ptype_Fcore_sdprod MtypeP. -have coH_UW1: coprime #|H| #|U <*> W1| := Ptype_Fcore_coprime MtypeP. -have [[_ mulHU _ tiHU] [nHU isomHU]] := (sdprodP defHU, sdprod_isom defHU). -have{sUW1M} cH0U: U \subset 'C(H0). - have frobUW1 := Ptype_compl_Frobenius maxM MtypeP notMtype5. - have nH0_UW1 := subset_trans sUW1M nH0M; have [_ nH0W1] := joing_subP nH0_UW1. - have [coH0_UW1 solH0] := (coprimeSg sH0H coH_UW1, solvableS sH0H solH). - have [_ -> //] := Frobenius_Wielandt_fixpoint frobUW1 nH0_UW1 coH0_UW1 solH0. - have ->: 'C_H0(W1) = H0 :&: 'C_H(W1) by rewrite setIA (setIidPl sH0H). - have nH0C: 'C_H(W1) \subset 'N(H0) by rewrite subIset // normal_norm. - rewrite cardMg_TI // -LagrangeMl -card_quotient {nH0C}//. - rewrite coprime_quotient_cent ?(coprimeSg sHHU) //=. - have [_ -> _] := Ptype_Fcore_factor_facts maxM MtypeP notMtype5. - by rewrite (typeP_cent_core_compl MtypeP) def_p. -have{isomHU} defC: C :=: U'. - have [injHquo defHUb] := isomP isomHU. - apply: (injm_morphim_inj injHquo); rewrite ?subsetIl ?morphim_der ?der_sub //. - rewrite defHUb morphim_restrm -quotientE setIA setIid -quotientMidl /=. - by rewrite (dprodW defHC) -defM'' -quotient_der // -mulHU mul_subG ?normG. -have{coH_UW1} defH0: H0 :=: H'. - pose Hhat := (H / H')%g; pose Uhat := (U / H')%g; pose HUhat := (HU / H')%g. - have nH'H: H \subset 'N(H') by apply: gFnorm. - have nH'U: U \subset 'N(H') by apply: gFnorm_trans. - apply/eqP; rewrite eqEsubset andbC. - rewrite der1_min ?(abelem_abelian abelHbar) ?normal_norm //=. - rewrite -quotient_sub1 /= -/H'; last exact: subset_trans sH0H nH'H. - suffices <-: 'C_Hhat(Uhat) = 1%g. - by rewrite subsetI quotientS //= quotient_cents // centsC. - suffices: ~~ ('C_Hhat(Uhat)^`(1)%g \proper 'C_Hhat(Uhat)). - exact: contraNeq (sol_der1_proper (quotient_sol _ solH) (subsetIl Hhat _)). - have {2}<-: HUhat^`(1)%g :&: 'C_Hhat(Uhat) = 'C_Hhat(Uhat). - rewrite -quotient_der ?[HU^`(1)%g]defM''; last by rewrite -mulHU mul_subG. - by rewrite (setIidPr _) ?subIset // quotientS ?joing_subl. - suffices defHUhat: 'C_Hhat(Uhat) \x ([~: Hhat, Uhat] <*> Uhat) = HUhat. - rewrite -(dprod_modl (der_dprod 1 defHUhat)) ?der_sub //= -/Hhat. - rewrite [rhs in _ \x rhs](trivgP _) ?dprodg1 ?properxx //= -/Hhat. - by have [_ _ _ <-] := dprodP defHUhat; rewrite setIC setIS ?der_sub. - have coHUhat: coprime #|Hhat| #|Uhat|. - by rewrite coprime_morph ?(coprimegS _ coH_UW1) ?joing_subl. - have defHhat: 'C_Hhat(Uhat) \x [~: Hhat, Uhat] = Hhat. - by rewrite dprodC coprime_abelian_cent_dprod ?der_abelian ?quotient_norms. - rewrite /HUhat -(sdprodWY defHU) quotientY //= -(dprodWY defHhat). - have [_ _ cCRhat tiCRhat] := dprodP defHhat. - rewrite dprodEY ?joingA //; first by rewrite join_subG cCRhat centsC subsetIr. - apply/trivgP; rewrite /= joingC norm_joinEl ?commg_normr //= -/Hhat -/Uhat. - rewrite -tiCRhat !(setIAC _ 'C(_)) setSI // subsetI subsetIl /=. - by rewrite -group_modr ?commg_subl ?quotient_norms //= coprime_TIg ?mul1g. -suffices{defC defH0}: p.-group H by []. -pose R := 'O_p^'(H); have hallR: p^'.-Hall(H) R := nilpotent_pcore_Hall _ nilH. -have defRHp: R \x 'O_p(H) = H by rewrite dprodC nilpotent_pcoreC. -suffices R_1: R :=: 1%g by rewrite -defRHp R_1 dprod1g pcore_pgroup. -have /subsetIP[sRH cUR]: R \subset 'C_H(U). - have oH: #|H| = (p ^ q * #|'C_H(U)|)%N. - by have:= typeII_IV_core maxM MtypeP notMtype5 => /=; rewrite ifN => // -[]. - apply/setIidPl/eqP; rewrite eqEcard subsetIl /= (card_Hall hallR) {}oH. - rewrite (card_Hall (setI_normal_Hall _ hallR _)) ?subsetIl ?gFnormal //. - rewrite partnM ?expn_gt0 ?cardG_gt0 //= part_p'nat ?mul1n ?pnatNK //. - by rewrite pnat_exp ?pnat_id. -suffices: ~~ (R^`(1)%g \proper R) by apply: contraNeq (sol_der1_proper solH _). -have /setIidPr {2}<-: R \subset HU^`(1)%g. - by rewrite [HU^`(1)%g]defM'' -(dprodWY defHC) sub_gen ?subsetU ?sRH. -suffices defRHpU: R \x ('O_p(H) <*> U) = HU. - rewrite -(dprod_modl (der_dprod 1 defRHpU)) ?der_sub //= -/R setIC. - rewrite [rhs in _ \x rhs](trivgP _) ?dprodg1 ?properxx //= -/R. - by have /dprodP[_ _ _ <-] := defRHpU; rewrite setIS ?der_sub. -rewrite -(sdprodWY defHU) -[in RHS](dprodWY defRHp) -joingA. -have [_ _ cRHp tiRHp] := dprodP defRHp. -rewrite dprodEY //= -/R; first by rewrite join_subG cRHp centsC. -rewrite joingC norm_joinEl 1?gFnorm_trans //. -by rewrite -(setIidPl sRH) -setIA -group_modr ?gFsub // tiHU mul1g. -Qed. - -Let frobUW1bar : [Frobenius U <*> W1 / C = (U / C) ><| (W1 / C)]. -Proof. -have frobUW1: [Frobenius U <*> W1 = U ><| W1]. - exact: Ptype_compl_Frobenius MtypeP notMtype5. -have [defUW1 ntU _ _ _] := Frobenius_context frobUW1. -have [[_ _ _ defC] regUW1] := (FTtype34_facts, Frobenius_reg_ker frobUW1). -rewrite Frobenius_coprime_quotient // /normal ?subIset ?joing_subl //. -by split=> [|x /regUW1->]; rewrite ?sub1G //= defC (sol_der1_proper solHU). -Qed. - -(* This is Peterfalvi (11.7). *) -(* We have recast the linear algebra arguments in the original text in pure- *) -(* group-theoretic terms: the overhead of the abelem_rV correspondence is not *) -(* justifiable here, as the Ssreflect linear algebra library lacks specific *) -(* support for bilinear forms: we use D y z := [~ coset Q y, coset Q z] as *) -(* our "linear form". D is antisymmetric as D z y = (D y z)^-1, so we only *) -(* show that D is "linear" in z, that is, that D y is a group morphism with *) -(* domain H whose kernel contains H0, when y \in H, and we do not bother to *) -(* factor D to obtain a form over Hbar = H / H0. *) -(* We further rework the argument to support this change in perspective: *) -(* - We remove any reference to linear algebra in the "Galois" (9.7b) case, *) -(* where U acts irreducibly on Hbar: we revert to the proof of the *) -(* original Odd Order paper, using the fact that H / Q is extraspecial. *) -(* - In the "non-Galois" (9.7a) case, we use the W1-conjugation class of a *) -(* generator of H1 as an explicit basis of Hbar, indexed by W1, and we *) -(* use the elements xbar_ w = coset H0 (x_ w) of this basis instead of *) -(* arbitrary y in H_i, as the same argument then justifies extending *) -(* commutativity to all of Hbar. *) -(* - We construct phi as the morphism mapping ubar in Ubar to the n such *) -(* that the action of ubar on H1 is exponentiation by n. We derive a *) -(* morphism phi_ w ubar for the action of Ubar on H1 ^ w, for w in W1, by *) -(* composign with the action QV of W1 on Ubar by inverse conjugation. *) -(* - We exchange the two alternatives in the (9.7a) case; most of proof is *) -(* thus by contradiction with the C_U(Hbar) != u assertion in (9.6), *) -(* first establishing case 9.7a (as 9.7b contradicts q odd), then that D *) -(* is nontrivial for some x_ w1 and x_ w2 (as (H / Q)' = H0 / Q != 1), *) -(* whence (phi_ w1 u)(phi_ w2 u) = 1, whence (phi u)^-1 = phi u and *) -(* phi = 1, i.e., Ubar centralises Wbar. *) -(* Note finally that we simply construct U as a maximal subgroup of H0 normal *) -(* in H, as the nilpotence of H / Q implies that H0 / Q lies in its center. *) -Lemma FTtype34_Fcore_kernel_trivial : - [/\ p.-abelem H, #|H| = (p ^ q)%N & `H0 = 1%g]. -Proof. -have [[_ _ nHU tiHU] [pH cH0U defH' _]] := (sdprodP defHU, FTtype34_facts). -have [/mulG_sub[_ sW1M] nH0H] := (sdprodW defM, normal_norm nsH0H). -have nHW1: W1 \subset 'N(H) := subset_trans sW1M (gFnorm _ M). -have nUW1: W1 \subset 'N(U) by have [_ []] := MtypeP. -pose bar := coset_morphism H0; pose Hbar := (H / H0)%g; pose Ubar := (U / H0)%g. -have [Cbar_neqU _ /= oHbar] := Ptype_Fcore_factor_facts maxM MtypeP notMtype5. -rewrite -/Hbar def_p // -/q in oHbar. -have [nH0U nH0W1] := (subset_trans sUM nH0M, subset_trans sW1M nH0M). -suffices H0_1 : `H0 = 1%g. - have isoHbar: H \isog H / H0 by rewrite H0_1 quotient1_isog. - by rewrite (isog_abelem isoHbar) (card_isog isoHbar). -apply: contraNeq Cbar_neqU => ntH0; rewrite [Ptype_Fcompl_kernel _]unlock. -suffices: Hbar \subset 'C(Ubar). - by rewrite (sameP eqP setIidPl) sub_astabQ nH0U centsC. -have pH0 := pgroupS sH0H pH; have{ntH0} [_ _ [k oH0]] := pgroup_pdiv pH0 ntH0. -have{k oH0} [Q maxQ nsQH]: exists2 Q : {group gT}, maximal Q H0 & Q <| H. - have [Q [sQH0 nsQH oQ]] := normal_pgroup pH nsH0H (leq_pred _). - exists Q => //; apply: p_index_maximal => //. - by rewrite -divgS // oQ oH0 pfactorK //= expnS mulnK ?expn_gt0 ?cardG_gt0. -have nsQH0: Q <| H0 := p_maximal_normal (pgroupS sH0H pH) maxQ. -have [[sQH0 nQH0] nQH] := (andP nsQH0, normal_norm nsQH). -have nQU: U \subset 'N(Q) by rewrite cents_norm ?(centsS sQH0). -pose hat := coset_morphism Q; pose Hhat := (H / Q)%g; pose H0hat := (H0 / Q)%g. -have{maxQ} oH0hat: #|H0hat| = p by rewrite card_quotient ?(p_maximal_index pH0). -have defHhat': Hhat^`(1)%g = H0hat by rewrite -quotient_der -?defH'. -have ntH0hat: H0hat != 1%g by rewrite -cardG_gt1 oH0hat prime_gt1. -have pHhat: p.-group Hhat by apply: quotient_pgroup. -have nsH0Hhat: H0hat <| Hhat by apply: quotient_normal. -have sH0hatZ: H0hat \subset 'Z(Hhat). - by rewrite prime_meetG ?oH0hat // meet_center_nil ?(pgroup_nil pHhat). -have{pHhat} gal'M: ~~ typeP_Galois MtypeP. - have sZHhat: 'Z(Hhat) \subset Hhat := center_sub _. - have nsH0hatZ: H0hat <| 'Z(Hhat) := normalS sH0hatZ sZHhat nsH0Hhat. - have [f injf im_f] := third_isom sQH0 nsQH nsH0H. - have fHhat: f @* (Hhat / H0hat) = Hbar by rewrite im_f. - apply: contra (odd (logn p #|Hhat|)) _ _; last first. - rewrite -(divnK (cardSg (quotientS Q sH0H))) divg_normal // oH0hat. - by rewrite -(card_injm injf) // fHhat oHbar -expnSr pfactorK //= mFT_odd. - rewrite /typeP_Galois acts_irrQ // => /mingroupP[_ minUHbar]. - suffices /(card_extraspecial pHhat)[n _ ->]: extraspecial Hhat. - by rewrite pfactorK //= odd_double. - have abelH: p.-abelem (Hhat / H0hat)%g by rewrite -(injm_abelem injf) ?fHhat. - suffices{abelH} defZHhat: 'Z(Hhat) = H0hat. - do 2?split; rewrite defZHhat ?oH0hat //. - apply/eqP; rewrite eqEsubset (Phi_min pHhat) ?normal_norm //=. - by rewrite (Phi_joing pHhat) defHhat' joing_subl. - apply: contraNeq ntH0hat; rewrite eqEsubset sH0hatZ andbT => not_esHhat. - rewrite -defHhat'; apply/eqP/derG1P/center_idP/(quotient_inj nsH0hatZ)=> //. - apply: (injm_morphim_inj injf); rewrite ?quotientS //= fHhat -/Hhat -/H0hat. - rewrite minUHbar //= -/Hbar -?fHhat 1?morphim_injm_eq1 ?morphimS // -subG1. - rewrite quotient_sub1 ?(normal_norm nsH0hatZ) // not_esHhat -['Z(_)]cosetpreK. - rewrite im_f ?sub_cosetpre_quo // quotient_norms ?norm_quotient_pre //. - by rewrite gFnorm_trans ?quotient_norms. -have [H1 []] := typeP_Galois_Pn maxM notMtype5 gal'M. -rewrite def_p => oH1 nH1Ubar _ /bigdprodWY-defHbar _. -have /cyclicP[xbar defH1]: cyclic H1 by rewrite prime_cyclic ?oH1. -have H1xbar: xbar \in H1 by rewrite defH1 cycle_id. -have sH1_Hbar: H1 \subset Hbar. - by rewrite -[Hbar]defHbar (bigD1 1%g) ?group1 ?conjsg1 ?joing_subl. -have{sH1_Hbar} Hxbar: xbar \in Hbar := subsetP sH1_Hbar xbar H1xbar. -have /morphimP[x nH0x Hx /= Dxbar] := Hxbar. -have{oH1} oxbar: #[xbar] = p by rewrite orderE -defH1. -have memH0: {in H &, forall y z, [~ y, z] \in H0}. - by rewrite defH'; apply: mem_commg. -have [_ /centsP-cHH0hat] := subsetIP sH0hatZ; move/subsetP in nQH. -pose D y z := [~ hat z, hat y]. -have D_H0_1 y z: y \in H -> z \in H0 -> D y z = 1%g. - by move=> Hy H0z; apply/eqP/commgP/cHH0hat; apply: mem_quotient. -have H0_D: {in H &, forall y z, D y z \in H0hat}. - by move=> y z Hy Hz; rewrite -defHhat' mem_commg ?mem_quotient. -have Dsym y z: (D y z)^-1%g = D z y by rewrite invg_comm. -have Dmul y: y \in H -> {in H &, {morph D y: z t / z * t}}%g. - move=> Hy z t Hz Ht; rewrite {1}/D morphM ?nQH // commMgR; congr (_ * _)%g. - by rewrite -{2}morphR ?nQH // -/(D t _) D_H0_1 ?memH0 // mulg1. -pose Dm y Hy : {morphism H >-> coset_of Q} := Morphism (Dmul y Hy). -have{D_H0_1} kerDmH0 y Hy: H0 \subset 'ker (Dm y Hy). - by rewrite subsetI sH0H; apply/subsetP=> z H0z; rewrite !inE /= D_H0_1. -pose x_ w := (x ^ w)%g; pose xbar_ w := (xbar ^ bar w)%g. -move/subsetP in nHW1; move/subsetP in nHU. -have Hx_ w: w \in W1 -> (x_ w \in H) * {in U, forall u, x_ w ^ u \in H}%g. - by move/nHW1=> nHw; split=> [|u /nHU-nHu]; rewrite !memJ_norm. -have Dx: {in H &, forall y z, {in W1, forall w, D (x_ w) y = 1} -> D y z = 1}%g. - move=> y z Hy Hz Dxy1; apply/(kerP (Dm y Hy) Hz); apply: subsetP z Hz. - rewrite -(quotientSGK nH0H) ?kerDmH0 // -defHbar gen_subG. - apply/bigcupsP=> _ /morphimP[w nH0w W1w ->] /=. - rewrite defH1 Dxbar -quotient_cycle -?quotientJ ?quotientS // -cycleJ. - by rewrite cycle_subG !inE /= Hx_ //= -Dsym eq_invg1 Dxy1. -pose ntrivD := [exists w in [predX W1 & W1], #[D (x_ w.1) (x_ w.2)] == p]. -have{ntrivD Dx} /exists_inP[[w1 w2] /andP/=[Ww1 Ww2] /eqP-oDx12]: ntrivD. - apply: contraR ntH0hat => Dx_1; rewrite -defHhat' -subG1 gen_subG. - apply/subsetP=> _ /imset2P[_ _ /morphimP[y ? Hy ->] /morphimP[z ? Hz ->] ->]. - apply/set1P/Dx=> // w2 Ww2; rewrite Dx ?Hx_ // => w1 Ww1. - have abelH0hat: p.-abelem H0hat by apply: prime_abelem. - apply: contraNeq Dx_1 => /(abelem_order_p abelH0hat)oDx12. - by apply/exists_inP; exists (w1, w2); rewrite ?inE ?Ww1 // oDx12 ?H0_D ?Hx_. -have /subsetP-nUW1bar: (W1 / H0)%g \subset 'N(Ubar) := quotient_norms H0 nUW1. -move/subsetP in nH0H; move/subsetP in nH0W1. -pose n (phi : {morphism Ubar >-> {unit 'F_p}}) ubar : nat := val (phi ubar). -have [phi Dphi]: {phi | {in Ubar, forall ub, xbar ^ ub =xbar ^+ n phi ub}}%g. - pose xbar_Autm := invm (injm_Zp_unitm xbar). - have /restrmP[phi [Dphi _ _ _]]: Ubar \subset 'dom (xbar_Autm \o conj_aut H1). - by rewrite -sub_morphim_pre //= im_Zp_unitm -defH1 Aut_conj_aut. - rewrite /n pdiv_id // -oxbar; exists phi => ubar /(subsetP nH1Ubar)Uubar. - transitivity (Zp_unitm (phi ubar) xbar); last by rewrite autE /= -?defH1. - by rewrite Dphi invmK ?im_Zp_unitm -?defH1 ?Aut_aut ?norm_conj_autE. -pose QV ubar w := (ubar ^ (bar w)^-1)%g. -have UbarQV: {in Ubar & W1, forall ubar w, QV ubar w \in Ubar}. - by move=> ub w Uub W1w; rewrite /= memJ_norm ?groupV ?nUW1bar ?mem_quotient. -pose phi_ w ub := phi (QV ub w); pose nphi_ w ub := n phi (QV ub w). -have xbarJ: {in W1 & Ubar, forall w ub, xbar_ w ^ ub = xbar_ w ^+ nphi_ w ub}%g. - by move=> w ubar * /=; rewrite -conjgM conjgCV conjgM Dphi ?UbarQV // conjXg. -have{oDx12} phi_w12 ubar: ubar \in Ubar -> (phi_ w1 ubar * phi_ w2 ubar = 1)%g. - pose n_u := nphi_ ^~ ubar => Uubar; have [u nH0u Uu Dubar] := morphimP Uubar. - suffices: n_u w1 * n_u w2 == 1 %[mod #[D (x_ w1) (x_ w2)]]. - by apply: contraTeq; rewrite oDx12 -!val_Fp_nat // natrM !natr_Zp. - have DXn: {in H & W1, forall y w, D y (x_ w) ^+ n_u w = D y (x_ w ^ u)}%g. - move=> y w Hy W1w; set z := x_ w; have [Hz /(_ u Uu) Hzu] := Hx_ w W1w. - rewrite -(morphX (Dm y Hy)) //; apply/rcoset_kerP; rewrite ?groupX //. - have /subsetP: H0 :* z ^ u \subset 'ker (Dm y Hy) :* z ^ u by rewrite mulSg. - apply; apply/rcoset_kercosetP; rewrite ?groupX ?nH0H //. - by rewrite morphX ?morphJ ?(nH0W1 w) // ?nH0H //= -Dubar -Dxbar xbarJ. - rewrite -eq_expg_mod_order -{1}Dsym expgM expgVn ?(DXn, Dsym) ?Hx_ //. - rewrite /D -!morphR ?nQH ?Hx_ // -conjRg (conjg_fixP _) //. - by apply/commgP/esym/(centsP cH0U); rewrite ?memH0 ?Hx_. -pose wbar := bar (w1 * w2 ^-1)%g; pose W1bar := (W1 / H0)%g. -have W1wbar: wbar \in W1bar by rewrite mem_quotient ?groupM ?groupV. -have{phi_w12} phiJ: {in Ubar, forall ubar, phi (ubar ^ wbar) = (phi ubar)^-1}%g. - move=> ubar Uubar; apply/esym/eqP; rewrite eq_invg_mul. - rewrite [wbar]morphM ?morphV ?nH0W1 ?groupV // -{1}[ubar](conjgK (bar w1)). - by rewrite conjgM phi_w12 // memJ_norm ?nUW1bar ?mem_quotient. -have coW1bar2: coprime #|W1bar| 2 by rewrite coprimen2 quotient_odd ?mFT_odd. -have coUbar2: coprime #|Ubar| 2 by rewrite coprimen2 quotient_odd ?mFT_odd. -have{wbar phiJ W1wbar} phiV: {in Ubar, forall ubar, phi ubar = (phi ubar)^-1}%g. - move=> ubar Uubar; rewrite /= -phiJ // -(expgK coW1bar2 W1wbar) -expgM mul2n. - elim: (expg_invn _ _) => [|k IHk]; first by rewrite conjg1. - by do 2!rewrite expgSr conjgM phiJ ?memJ_norm ?nUW1bar ?groupX // ?invgK. -rewrite -[Hbar]defHbar gen_subG defH1; apply/bigcupsP=> _ /morphimP[w _ Ww ->]. -rewrite -cycleJ cycle_subG -/(xbar_ _); apply/centP=> ubar Uubar; apply/commgP. -apply/conjg_fixP; rewrite xbarJ // /nphi_ -[QV _ w](expgK coUbar2) ?UbarQV //. -by rewrite /n !morphX ?groupX 1?expgS 1?{1}phiV ?UbarQV // mulVg expg1n. -Qed. - -Let defU' : C :=: U'. Proof. by have [] := FTtype34_facts. Qed. -Let H0_1 : H0 :=: 1%g. Proof. by have [] := FTtype34_Fcore_kernel_trivial. Qed. - -Lemma Ptype_Fcompl_kernel_cent : Ptype_Fcompl_kernel MtypeP :=: C. -Proof. -rewrite [Ptype_Fcompl_kernel MtypeP]unlock /= (group_inj H0_1). -by rewrite astabQ -morphpreIim -injm_cent ?injmK ?ker_coset ?norms1. -Qed. -Local Notation defC := Ptype_Fcompl_kernel_cent. - -(* Character theory proper. *) - -Let pddM := FT_prDade_hyp maxM MtypeP. -Let ptiWM : primeTI_hypothesis M HU defW := FT_primeTI_hyp MtypeP. -Let ctiWG : cyclicTI_hypothesis G defW := pddM. -Let ctiWM : cyclicTI_hypothesis M defW := prime_cycTIhyp ptiWM. - -Local Notation sigma := (cyclicTIiso ctiWG). -Local Notation w_ i j := (cyclicTIirr defW i j). -Local Notation eta_ i j := (sigma (w_ i j)). -Local Notation mu_ := (primeTIred ptiWM). -Local Notation Idelta := (primeTI_Isign ptiWM). -Local Notation delta_ j := (primeTIsign ptiWM j). -Local Notation d := (FTtype345_TIirr_degree MtypeP). -Local Notation n := (FTtype345_ratio MtypeP). -Local Notation delta := (FTtype345_TIsign MtypeP). - -Implicit Types zeta xi lambda : 'CF(M). - -Let u := #|U / C|%g. -Let mu2_ i j := primeTIirr ptiWM i j. -Let etaW := map sigma (irr W). -Let eq_proj_eta (alpha gamma : 'CF(G)) := orthogonal (alpha - gamma) etaW. -Let eta_col j := \sum_i eta_ i j. -Let bridge0 zeta := mu_ 0 - zeta. - -Let proj_col_eta j0 i j : '[eta_col j0, eta_ i j] = (j == j0)%:R. -Proof. -rewrite cfdot_suml (bigD1 i) //= cfdot_cycTIiso eqxx eq_sym. -by rewrite big1 ?addr0 // => k /negPf-i'k; rewrite cfdot_cycTIiso i'k. -Qed. - -Let nirrW1 : #|Iirr W1| = q. Proof. by rewrite card_Iirr_cyclic. Qed. -Let NirrW1 : Nirr W1 = q. Proof. by rewrite -nirrW1 card_ord. Qed. - -Let nirrW2 : #|Iirr W2| = p. Proof. by rewrite card_Iirr_cyclic. Qed. -Let NirrW2 : Nirr W2 = p. Proof. by rewrite -nirrW2 card_ord. Qed. - -Let calT := seqIndT HU M. -Let S1 := S_ HC. -Let S2 := seqIndD HU M HC C. - -Let sS10 : cfConjC_subset S1 calS. -Proof. by apply: seqInd_conjC_subset1; rewrite /= ?defMs. Qed. - -Let sS20 : cfConjC_subset S2 calS. -Proof. by apply: seqInd_conjC_subset1; rewrite /= ?defMs. Qed. - -Let scohS1 : subcoherent S1 tau R. Proof. exact: subset_subcoherent sS10. Qed. -Let scohS2 : subcoherent S2 tau R. Proof. exact: subset_subcoherent sS20. Qed. - -Let S1_1 : {in S1, forall zeta, zeta 1%g = q%:R}. -Proof. -move=> _ /seqIndP[s /setDP[kerM'' _] ->]; rewrite !inE -defM'' in kerM''. -by rewrite cfInd1 ?gFsub // -(index_sdprod defM) lin_char1 ?mulr1 ?lin_irr_der1. -Qed. - -Let cohS1 : coherent S1 M^# tau. -Proof. -apply: uniform_degree_coherence scohS1 _. -by apply/(@all_pred1_constant _ q%:R)/allP=> _ /=/mapP[zeta /S1_1<- ->]. -Qed. - -Let irrS1 : {subset S1 <= irr M}. -Proof. -move=> _ /seqIndP[s /setDP[kerHC kerHU] ->]; rewrite !inE in kerHC kerHU. -rewrite -(quo_IirrK _ kerHC) // mod_IirrE // cfIndMod // cfMod_irr //. -have /irr_induced_Frobenius_ker := FrobeniusWker frobMtilde; rewrite defM''. -by apply; rewrite quo_Iirr_eq0 // -subGcfker. -Qed. - -Let o1S1 : orthonormal S1. -Proof. exact: sub_orthonormal (seqInd_uniq _ _) (irr_orthonormal _). Qed. - -Let cfdotS1 : {in S1 &, forall zeta xi, '[zeta, xi] = (zeta == xi)%:R}. -Proof. by case/orthonormalP: o1S1. Qed. - -Let omu2S1 i j : {in S1, forall zeta, '[mu2_ i j, zeta] = 0}. -Proof. -move=> zeta S1zeta; have [s _ Dzeta] := seqIndP S1zeta. -rewrite Dzeta -cfdot_Res_l cfRes_prTIirr cfdot_irr mulrb ifN_eq //. -apply: contraNneq (prTIred_not_irr ptiWM j) => Ds. -by rewrite -cfInd_prTIres Ds -Dzeta irrS1. -Qed. - -Let Tmu j : mu_ j \in calT. Proof. by rewrite -cfInd_prTIres mem_seqIndT. Qed. - -Let omuS1 j : {in S1, forall zeta, '[mu_ j, zeta] = 0}. -Proof. -by move=> zeta S1zeta /=; rewrite cfdot_suml big1 // => i _; apply: omu2S1. -Qed. - -Let Zbridge0 : {in S1, forall zeta, bridge0 zeta \in 'Z[irr M, HU^#]}. -Proof. -have mu0_1: mu_ 0 1%g = q%:R by rewrite prTIred_1 prTIirr0_1 mulr1. -move=> zeta S1zeta; rewrite /= zcharD1 !cfunE subr_eq0 mu0_1 S1_1 // eqxx. -by rewrite rpredB ?(seqInd_vchar _ (Tmu 0)) ?(seqInd_vchar _ S1zeta). -Qed. - -Let A0bridge0 : {in S1, forall zeta, bridge0 zeta \in 'CF(M, 'A0(M))}. -Proof. by move=> zeta /Zbridge0/zchar_on/cfun_onS->. Qed. - -Let sS1S2' : {subset S1 <= [predC S2]}. -Proof. -by move=> _ /seqIndP[s /setDP[kHCs _] ->]; rewrite !inE mem_seqInd // inE kHCs. -Qed. - -Let defS2: S2 = seqIndD HU M H H0C. -Proof. by rewrite /S2 H0_1 -!joinGE join1G joinGC seqIndDY. Qed. - -Let cohS2: coherent S2 M^# tau. -Proof. -apply: subset_coherent (Ptype_core_coherence maxM MtypeP notMtype5). -by rewrite defC defS2; apply: seqIndS; rewrite Iirr_kerDS ?genS ?setUS ?der_sub. -Qed. - -Let Smu := [seq mu_ j | j in predC1 0]. -Let Sred := filter [predC irr M] (seqIndD HU M H H0). - -Let memSred : Sred =i Smu. -Proof. -have [szSred _ memSred _] := typeP_reducible_core_Ind maxM MtypeP notMtype5. -have uSred: uniq Sred by apply: filter_uniq (seqInd_uniq _ _). -suffices{uSred}: (size Smu <= size Sred)%N by case/leq_size_perm. -by rewrite szSred def_p size_map -cardE cardC1 nirrW2. -Qed. - -Let mu_1 j : j != 0 -> mu_ j 1%g = (q * u)%:R. -Proof. -move=> nzj; have Smuj: mu_ j \in Sred by rewrite memSred image_f. -have [_ _ _ /(_ _ Smuj)[]] := typeP_reducible_core_Ind maxM MtypeP notMtype5. -by rewrite defC. -Qed. - -Let memS2red : [predD S2 & irr M] =i Smu. -Proof. -move=> xi; rewrite defS2 -memSred mem_filter; apply: andb_id2l => /= red_xi. -apply/idP/idP=> [|Sxi]; first by apply: seqIndS; rewrite Iirr_kerDS ?joing_subl. -have [_ _ _ /(_ xi)] := typeP_reducible_core_Ind maxM MtypeP notMtype5. -by rewrite defC mem_filter /= red_xi; case. -Qed. - -Let i1 : Iirr W1 := inord 1. -Let nz_i1 : i1 != 0. Proof. by rewrite Iirr1_neq0. Qed. -Let j1 : Iirr W2 := inord 1. -Let nz_j1 : j1 != 0. Proof. by rewrite Iirr1_neq0. Qed. - -(* This is Peterfalvi (11.8). *) -(* We have rearranged the argument somewhat: *) -(* - Step (11.8.4) was out of sequence as it involves changing the definition *) -(* of tau2, which requires showing that (11.8.2-3) are preserved by this *) -(* change; since (11.8.4) does not use (11.8.2-3) we avoid this by proving *) -(* (11.8.4) first. *) -(* - The first part of step (11.8.3) is the last fact that needs to be proved *) -(* for an arbitrary j != 0; (11.8.1, 5-6) can all use the same fixed j != 0 *) -(* (we take j = 1), provided (11.8.3) is proved before (11.8.2), which it *) -(* doe not use. *) -(* - Steps (11.8.2) and (11.8.5) are really as combination, to provide an *) -(* expression for tau (alpha i j) for an arbitrary i. We merge their proofs *) -(* so we can use a fixed i for the whole combined step and hide some *) -(* intermediate technical facts. *) -(* - We also reorganise the contents of the superstep, proving most of *) -(* (11.8.5) between the first and last two parts of (11.8.2); this *) -(* simplifies the latter because a is then known to be even, so we can show *) -(* directly that a is 0 or 2, and then that X = eta i j - eta i 0. *) -Lemma FTtype34_not_ortho_cycTIiso zeta : - zeta \in S1 -> ~~ eq_proj_eta (tau (bridge0 zeta)) (eta_col 0). -Proof. -move=> S1zeta; set psi := tau _; apply/negP=> proj_psi_eta. -have irr_zeta: zeta \in irr M := irrS1 S1zeta. -have Szeta: zeta \in S_ 1 by apply: seqInd_sub S1zeta. -have Zzeta_S1: {in S1, forall xi, zeta - xi \in 'Z[S1, M^#]}. - by move=> * /=; rewrite zcharD1E rpredB ?mem_zchar //= !cfunE !S1_1 ?subrr. -have n1S1: {in S1, forall xi, '[xi] = 1} by move=> xi /irrS1/irrWnorm. -have Z_S1: {in S1, forall xi, xi \in 'Z[S1]} by apply: mem_zchar. -have [p_gt0 q_gt0 u_gt0]: [/\ p > 0, q > 0 & u > 0]%N by rewrite !cardG_gt0. -have q_gt2: (q > 2)%N by rewrite odd_prime_gt2 ?mFT_odd. -have mu2_1 i j: j != 0 -> mu2_ i j 1%g = d%:R. - by have [/(_ i j)] := FTtype345_constants maxM MtypeP notMtype2. -(* This is (11.8.1). *) -have [Dd delta1 Dn]: [/\ d = u, delta = 1 & n = (size S1)%:R]. - have size_S1 : (size S1 * q = u - 1)%N. - rewrite mulnC [q](index_sdprod defM). - rewrite (size_irr_subseq_seqInd _ (subseq_refl _)) //. - transitivity #|[set mod_Iirr t | t : Iirr (HU / HC) in predC1 0]|. - apply/eq_card=> s; rewrite inE mem_seqInd // !inE subGcfker. - apply/andP/imsetP=> [[nzs kHCs] | [t nzt ->]]. - by exists (quo_Iirr HC s); rewrite ?quo_IirrK // inE quo_Iirr_eq0. - by rewrite mod_Iirr_eq0 // mod_IirrE // cfker_mod. - rewrite card_imset; last exact: can_inj (mod_IirrK _). - have isoUC: U / C \isog HU / HC by apply: quotient_sdprodr_isog. - rewrite subn1 cardC1 card_Iirr_abelian -?(card_isog isoUC) //. - by rewrite -(isog_abelian isoUC) defU' der_abelian. - have Dd: d = u. - apply/eqP; rewrite -(eqn_pmul2l q_gt0) -eqC_nat -(mu_1 nz_j1). - by rewrite natrM prTIred_1 mu2_1. - suffices delta1: delta = 1. - by rewrite /n Dd delta1 -(@natrB _ _ 1) // -size_S1 natrM mulfK ?neq0CG. - have: (delta == 1 %[mod q])%C. - rewrite -(eqCmod_transl _ (prTIirr1_mod ptiWM 0 j1)) mu2_1 // -/q Dd. - by rewrite /eqCmod -(@natrB _ u 1) // dvdC_nat -size_S1 dvdn_mull. - rewrite -[1]subr0 [delta]signrE -/ptiWM eqCmodDl eqCmodN opprK. - by rewrite eqCmod0_nat; case: (Idelta j1); first rewrite gtnNdvd. -have deltaZ gamma: delta *: gamma = gamma by rewrite delta1 scale1r. -have [tau1 coh_tau1] := cohS1; pose zeta1 := tau1 zeta. -(* This is (11.8.4). *) -without loss Dpsi: tau1 coh_tau1 @zeta1 / psi = eta_col 0 - zeta1. - move=> IHtau1; have [[Itau1 Ztau1] Dtau1] := coh_tau1. - have tau1_dirr: {in S1, forall xi, tau1 xi \in dirr G}. - by move=> xi S1xi; rewrite /= dirrE Ztau1 ?Itau1 ?mem_zchar //= n1S1. - pose chi : 'CF(G) := eta_col 0 - psi. - have Dpsi: psi = eta_col 0 - chi by rewrite opprD opprK addNKr. - have chi'zeta1: chi <> zeta1. - by move=> Dchi; case: (IHtau1 tau1); rewrite -/zeta1 -?Dchi. - have dirr_chi: chi \in dirr G. - apply: dirr_norm1. - rewrite rpredB ?rpred_sum // => [i _|]; first exact: cycTIiso_vchar. - rewrite Dade_vchar // zchar_split A0bridge0 //. - by rewrite rpredB ?char_vchar ?prTIred_char ?irrWchar. - apply: (addrI q%:R); transitivity '[psi]; last first. - rewrite Dade_isometry ?A0bridge0 // (cfnormBd (omuS1 _ _)) //. - by rewrite cfnorm_prTIred n1S1. - rewrite Dpsi [RHS]cfnormDd; last first. - rewrite opprB cfdotC cfdot_sumr big1 ?conjC0 // => i _. - by rewrite (orthoPl proj_psi_eta) ?map_f ?mem_irr. - rewrite cfnormN -nirrW1 -sumr_const cfdot_sumr. - by congr (_ + _); apply: eq_bigr => i _; rewrite proj_col_eta. - have Dchi: {in S1, forall xi, xi != zeta -> chi = - tau1 xi}. - move=> xi S1xi /negPf-zeta'xi; have irr_xi := irrS1 S1xi. - suffices: '[zeta1 - tau1 xi, chi] = 1. - by case/cfdot_add_dirr_eq1; rewrite ?rpredN ?tau1_dirr. - rewrite /= cfdotBr cfdot_sumr big1 => [|i _]; last first. - have oS1eta := coherent_ortho_cycTIiso MtypeP sS10 coh_tau1. - by rewrite cfdotBl !oS1eta ?irrS1 ?subrr. - rewrite -raddfB Dtau1 ?Zzeta_S1 // Dade_isometry ?A0bridge0 //; last first. - exact: cfun_onS sHU_A0 (zcharD1_seqInd_on _ (Zzeta_S1 xi S1xi)). - rewrite cfdotBr cfdotC cfdotBr 2?omuS1 // subrr conjC0 !sub0r opprK. - by rewrite cfdotBl n1S1 // cfdotS1 // zeta'xi subr0. - have S1zetaC: zeta^*%CF \in S1 by rewrite cfAut_seqInd. - have Dchi_zetaC: chi = - tau1 zeta^*%CF. - by rewrite -Dchi ?(seqInd_conjC_neq _ _ _ S1zeta) ?mFT_odd. - suffices S1le2: (size S1 <= size [:: zeta; zeta^*%CF])%N. - case: (IHtau1 (dual_iso tau1)); last by rewrite /= -Dchi_zetaC. - exact: dual_coherence scohS1 coh_tau1 S1le2. - rewrite uniq_leq_size ?seqInd_uniq // => xi S1xi. - rewrite !inE -implyNb; apply/implyP=> zeta'xi; apply/eqP. - apply: (Zisometry_inj Itau1); rewrite ?mem_zchar ?cfAut_seqInd //. - by apply: oppr_inj; rewrite -Dchi. -have [[Itau1 Ztau1] Dtau1] := coh_tau1. -have tau1_dirr: {in S1, forall xi, tau1 xi \in dirr G}. - by move=> xi S1xi; rewrite /= dirrE Ztau1 ?Itau1 ?mem_zchar //= n1S1. -have oS1eta i j: {in S1, forall xi, '[tau1 xi, eta_ i j] = 0}. - by move=> xi S1xi /=; rewrite (coherent_ortho_cycTIiso _ _ coh_tau1) ?irrS1. -pose alpha_ := FTtype345_bridge MtypeP zeta. -have A0alpha i j : j != 0 -> alpha_ i j \in 'CF(M, 'A0(M)). - by move/supp_FTtype345_bridge->; rewrite ?S1_1. -have alpha_S1 i j: {in S1, forall xi, '[alpha_ i j, xi] = n *- (xi == zeta)}. - move=> xi S1xi; rewrite /= !cfdotBl !cfdotZl !omu2S1 // mulr0 subrr add0r. - by rewrite cfdotS1 // eq_sym mulr_natr. -pose beta_ i j := tau (alpha_ i j) - (eta_ i j - eta_ i 0) + n *: zeta1. -pose beta := beta_ 0 j1. -(* This is the first part of (11.8.3). *) -have betaE i j: j != 0 -> beta_ i j = beta. - move=> nz_j; transitivity (beta_ i j1); congr (_ + _); apply/eqP. - rewrite eq_sym -subr_eq0 [rhs in _ + rhs]opprD addrACA -opprD subr_eq0. - rewrite -linearB /= !opprB !addrA !subrK -!/(mu2_ i _). - by rewrite [Dade pddM _]prDade_sub_TIirr ?mu2_1 //= deltaZ. - rewrite -subr_eq0 !opprD addrACA -3!opprD opprK subr_eq0 addrACA addrA. - rewrite -(prDade_sub2_TIirr pddM) -!/(mu2_ _ _) !deltaZ -linearB /=. - by rewrite opprB addrA subrK !deltaZ opprD opprK addrACA addrA. -pose j := j1. (* The remainder of the proof only uses j = 1. *) -(* This is the second part of (11.8.3). *) -have Rbeta: cfReal beta. - rewrite /cfReal eq_sym -subr_eq0 rmorphD !rmorphB /= opprB 2!opprD opprB -/j. - rewrite 2![(eta_ 0 _)^*%CF]cfAut_cycTIiso -!cycTIirr_aut !aut_Iirr0 -Dade_aut. - set k := aut_Iirr conjC j; rewrite -(betaE 0 k) ?aut_Iirr_eq0 // addrACA. - rewrite addrC addr_eq0 addrCA subrK opprD opprK Dn raddfZnat -!raddfB /= -Dn. - apply/eqP; rewrite (cfConjC_Dade_coherent coh_tau1) ?mFT_odd // -raddfB. - rewrite Dtau1 ?Zzeta_S1 ?cfAut_seqInd //= -linearZ scalerBr; congr (tau _). - rewrite opprD !rmorphB !deltaZ /= -!prTIirr_aut !aut_Iirr0 addrACA subrr. - by rewrite add0r opprK addrC Dn -raddfZnat. -(* This is the consequence of Peterfalvi (11.8.2) and (11.8.5). *) -have tau_alpha i: tau (alpha_ i j) = eta_ i j - eta_ i 0 - n *: zeta1. - set phi := tau (alpha_ i j); pose sum_tau1 := \sum_(xi <- S1) tau1 xi. - have A0alpha_j k: alpha_ k j \in 'CF(M, 'A0(M)) by apply: A0alpha. - have Zphi: phi \in 'Z[irr G]. - by rewrite Dade_vchar // zchar_split vchar_FTtype345_bridge /=. - have [Y S1_Y [X [Dphi oYX oXS1]]] := orthogonal_split (map tau1 S1) phi. - (* This is the first part of 11.8.2 *) - have [a Za defY]: exists2 a, a \in Cint & Y = a *: sum_tau1 - n *: zeta1. - have [a_ Da defY] := orthonormal_span (map_orthonormal Itau1 o1S1) S1_Y. - have{Da} Da: {in S1, forall xi, a_ (tau1 xi) = '[phi, tau1 xi]}. - by move=> xi Sxi; rewrite Da Dphi cfdotDl (orthoPl oXS1) ?map_f ?addr0. - exists (a_ (tau1 zeta) + n). - by rewrite Dn rpredD ?rpred_nat // Da // Cint_cfdot_vchar ?Ztau1 ?Z_S1. - rewrite defY big_map scaler_sumr !(bigD1_seq _ S1zeta) ?seqInd_uniq //=. - rewrite addrAC scalerDl addrK !(big_seq_cond (predC1 _)) /=; congr (_ + _). - apply: eq_bigr => xi /andP[S1xi zeta'xi]; congr (_ *: _); rewrite !Da //. - apply: canRL (addNKr _) _; rewrite addrC -opprB -!raddfB Dtau1 ?Zzeta_S1//=. - rewrite Dade_isometry //; last first. - exact: cfun_onS (zcharD1_seqInd_on _ (Zzeta_S1 _ S1xi)). - by rewrite cfdotBr !alpha_S1 // !mulrb eqxx ifN_eq // !(addr0, opprK). - have psi_phi: '[psi, phi] = -1 + n. (* This is part of (11.8.5). *) - rewrite cfdotC Dade_isometry ?A0bridge0 //. - rewrite cfdotBr !cfdotBl deltaZ !cfdotZl n1S1 // mulr1. - rewrite !cfdot_prTIirr_red (negPf nz_j1) eqxx !omu2S1 //= cfdotC omuS1 //. - by rewrite conjC0 mulr0 opprB !subr0 add0r rmorphD rmorphN Dn !rmorph_nat. - have{psi_phi} col0_beta: '[eta_col 0, beta] = a. (* Also part of (11.8.5). *) - apply/(addIr (-1 + n))/(canRL (addNKr _)). - rewrite addrCA addrA addrACA -{}psi_phi Dpsi cfdotBl; congr (_ + _). - rewrite -(betaE i j) // cfdotDr !cfdotBr -/phi cfdotZr -!addrA. - apply/(canLR (addNKr _)); rewrite addNr !cfdot_suml. - rewrite big1 ?add0r ?opprK => [|k _]; last first. - by rewrite cfdot_cycTIiso andbC eq_sym (negPf nz_j1). - rewrite addrCA big1 ?mulr0 ?add0r => [|k _]; last first. - by rewrite cfdotC oS1eta ?conjC0. - rewrite addrC (bigD1 i) // cfnorm_cycTIiso /= addKr big1 // => k i'k. - by rewrite cfdot_cycTIiso (negPf i'k). - rewrite cfdotC Dphi cfdotDl (orthoPl oXS1) ?map_f // addr0. - rewrite defY cfdotBl scaler_sumr cfproj_sum_orthonormal //. - rewrite cfdotZl Itau1 ?mem_zchar ?n1S1 // mulr1 rmorphB opprD opprK. - by rewrite Dn rmorph_nat conj_Cint. - have a_even: (2 %| a)%C. (* Third internal part of (11.8.5). *) - have Zbeta: beta \in 'Z[irr G]. - rewrite -{1}(betaE i j) // rpredD ?rpredB ?Zphi ?cycTIiso_vchar //. - by rewrite Dn rpredZnat // Ztau1 ?mem_zchar. - rewrite -col0_beta cfdot_real_vchar_even ?mFT_odd //; first 1 last. - split; first by apply/rpred_sum=> k _; apply: cycTIiso_vchar. - apply/eqP; rewrite [RHS](reindex_inj (can_inj (@conjC_IirrK _ _))) /=. - rewrite rmorph_sum; apply/eq_bigr=> k _ /=. - by rewrite cfAut_cycTIiso -cycTIirr_aut aut_Iirr0. - have eta00: eta_ 0 0 = 1 by rewrite cycTIirr00 cycTIiso1. - rewrite orbC cfdotDl 2!cfdotBl cfdotZl -eta00 oS1eta // mulr0 addr0. - rewrite opprB addrC 2!{1}cfdot_cycTIiso (negPf nz_j1) subr0 /= eta00. - rewrite Dade_reciprocity // => [|x _ y _]; last by rewrite !cfun1E !inE. - rewrite cfRes_cfun1 !cfdotBl deltaZ !cfdotZl -!/(mu2_ 0 _). - rewrite -(prTIirr00 ptiWM) !cfdot_prTIirr cfdotC omu2S1 // conjC0 mulr0. - by rewrite (negPf nz_j1) add0r subr0 subrr rpred0. - have nY: '[Y] = n * a * (a - 2%:R) + n ^+ 2. (* Resuming step (11.8.2). *) - rewrite defY cfnormD cfnormN !cfnormZ cfdotNr cfdotZr. - rewrite cfnorm_map_orthonormal // -Dn Itau1 ?mem_zchar ?n1S1 // mulr1. - rewrite scaler_sumr cfproj_sum_orthonormal // rmorphN addrAC. - rewrite Dn rmorphM !Cint_normK ?rpred_nat // !rmorph_nat conj_Cint // -Dn. - by rewrite -mulr2n mulrC mulrA -mulr_natr mulNr -mulrBr. - have{a_even} Da: (a == 0) || (a == 2%:R). (* Second part of (11.8.2). *) - suffices (b := a - 1): b ^+ 2 == 1. - by rewrite -!(can_eq (subrK 1) a) add0r addrK orbC -eqf_sqr expr1n. - have S1gt0: (0 < size S1)%N by case: (S1) S1zeta. - have: n * b ^+ 2 <= n *+ 3. - have: 2%:R + n <= n *+ 3 by rewrite addrC ler_add2l ler_muln2r Dn ler1n. - apply: ler_trans; rewrite sqrrB1 -mulr_natr -mulrBr mulrDr mulrA mulr1. - rewrite ler_add2r -(ler_add2r (n ^+ 2 + '[X])) !addrA -nY -cfnormDd //. - by rewrite -Dphi norm_FTtype345_bridge ?S1_1 // ler_addl cfnorm_ge0. - have Zb: b \in Cint by rewrite rpredB ?rpred1 ?Za. - have nz_b: b != 0 by rewrite subr_eq0 (memPn _ a a_even) ?(dvdC_nat 2 1). - rewrite eqr_le sqr_Cint_ge1 {nz_b}//= andbT -Cint_normK // Dn -mulrnA. - have /CnatP[m ->] := Cnat_norm_Cint Zb; rewrite -natrX -natrM leC_nat. - by rewrite leq_pmul2l // lern1 -ltnS (ltn_sqr m 2) (leq_sqr m 1). - have{nY Da} defX: X = eta_ i j - eta_ i 0. (* Last part of (11.8.2). *) - have{nY Da} /eqP-nY: '[Y] == n ^+ 2. - by rewrite -subr_eq0 nY addrK -mulrA !mulf_eq0 !subr_eq0 Da orbT. - have coh_zeta_phi := FTtype345_bridge_coherence _ _ Szeta _ coh_tau1. - have:= Dphi; rewrite addrC => /coh_zeta_phi->; rewrite ?S1_1 ?deltaZ //. - rewrite defY scaler_sumr big_seq rpredB ?rpred_sum // => [xi Sxi|]. - by rewrite rpredZ_Cint ?mem_zchar ?map_f. - by rewrite Dn rpredZnat ?mem_zchar ?map_f. - have{col0_beta} a0: a = 0. (* This is the conclusion of (11.8.5). *) - rewrite cfdot_suml big1 // in col0_beta => k _. - rewrite -(betaE i j) // /beta_ -/phi Dphi -defX addrK defY subrK. - rewrite cfdotZr cfdot_sumr big1_seq ?mulr0 // => xi S1xi. - by rewrite cfdotC oS1eta ?conjC0. - by rewrite Dphi defY defX a0 ?inE ?eqxx // scale0r sub0r addrC. -(* This is step (11.8.6). *) -pose theta := mu_ j - d%:R *: zeta. -have /andP/=[red_muj S2muj]: mu_ j \in [predD S2 & irr M]. - by rewrite memS2red image_f. -have HUtheta: theta \in 'CF(M, HU^#). - rewrite cfun_onD1 !cfunE mu_1 ?S1_1 // Dd mulrC natrM subrr eqxx. - by rewrite rpredB ?rpredZ ?(seqInd_on _ S1zeta) ?(seqInd_on _ S2muj). -have Dtheta: theta = mu_ 0 - zeta + \sum_i alpha_ i j. - rewrite !sumrB -scaler_sumr delta1 scale1r. - rewrite [X in _ = X]addrC -!addrA -/(mu_ 0); congr (_ + _). - rewrite [X in _ = _ + X]addrC !addrA addNr add0r -opprD; congr (- _). - rewrite sumr_const nirrW1 -scaler_nat scalerA mulrC. - by rewrite divfK ?neq0CG // delta1 addrC scalerBl scale1r subrK. -have tau_theta: tau theta = eta_col j - d%:R *: zeta1. - pose psi1 i := eta_ i j1 - eta_ i 0 - n *: zeta1. - have Dpsi1 i: tau (alpha_ i j) = psi1 i by apply: tau_alpha. - rewrite Dtheta [tau _]raddfD raddf_sum (eq_bigr psi1) //= {Dpsi1}/psi1 -/psi. - rewrite Dpsi !sumrB [X in X = _]addrC -!addrA; congr (_ + _). - rewrite -opprB -opprD -opprB -/(eta_col 0) addrA addrK; congr (- _). - rewrite sumr_const nirrW1 -scaler_nat scalerA mulrC. - by rewrite divfK ?neq0CG // delta1 scalerBl scale1r subrK. -have [tau2 coh_tau2] := cohS2. -without loss tau2muj: tau2 coh_tau2 / tau2 (mu_ j) = eta_col j; last first. - case: FTtype34_noncoherence; rewrite H0_1 -joinGE join1G. - have uS12: uniq (S2 ++ S1). - by rewrite cat_uniq ?seqInd_uniq ?andbT //=; apply/hasPn. - have /perm_eq_coherent: perm_eq (S2 ++ S1) (S_ C); last apply. - apply: uniq_perm_eq; rewrite ?seqInd_uniq // => xi; rewrite mem_cat. - apply/idP/idP=> [/orP | /seqIndP[i /setDP[kCi k'HUi] ->]]. - by case; apply/seqIndS/Iirr_kerDS; rewrite ?joing_subr. - by rewrite !mem_seqInd // inE orbC inE kCi k'HUi andbT orbN. - move: tau_theta; rewrite -tau2muj // -raddfZnat. - apply: (bridge_coherent scohM) sS20 coh_tau2 sS10 coh_tau1 sS1S2' _. - by rewrite (cfun_onS _ HUtheta) ?setSD // rpredZnat ?Z_S1. -move=> IHtau2; apply: (IHtau2 tau2 coh_tau2); have [IZtau2 Dtau2] := coh_tau2. -have{IHtau2} /hasP[xi S2xi /=irr_xi]: has [mem irr M] S2. - apply/hasPn=> redS2 {tau2 coh_tau2 IZtau2 Dtau2}. - have muS2: {subset S2 <= Smu} by move=> xi S2xi; rewrite -memS2red !inE redS2. - have [_ [tau2 tau2mu coh_tau2]] := uniform_prTIred_coherent pddM nz_j1. - have S2uniform: {subset S2 <= uniform_prTIred_seq pddM j}. - move=> _ /muS2/imageP[k nz_k ->]; apply: image_f. - by rewrite !inE [_ != 0]nz_k /= !mu_1. - apply: (IHtau2 tau2); first exact: subset_coherent_with coh_tau2. - have [_ /(_ _ nz_j1) Ez _ _] := FTtype345_constants maxM MtypeP notMtype2. - by have:= tau2mu j; rewrite Ez -/delta delta1 scale1r. -suffices: '[tau2 (mu_ j), eta_col j] != 0. - have:= FTtypeP_coherent_TIred sS20 coh_tau2 irr_xi S2xi S2muj. - case=> _ -> [[-> ->] | [-> -> _] /eqP[]]; first by rewrite deltaZ. - rewrite -[cyclicTIiso _]/sigma cfdot_sumr big1 ?mulr0 // => i _. - rewrite cfdotZl proj_col_eta -(inj_eq irr_inj) conjC_IirrE eq_sym. - by rewrite odd_eq_conj_irr1 ?mFT_odd // irr_eq1 (negPf nz_j1) mulr0. -pose gamma := xi 1%g *: mu_ j - mu_ j 1%g *: xi. -have: '[tau2 gamma, tau theta] != 0. - have [Txi Tzeta] := (seqInd_subT S2xi, seqInd_subT S1zeta). - have S2gamma: gamma \in 'Z[S2, HU^#] by apply: sub_seqInd_zchar. - rewrite Dtau2 ?zcharD1_seqInd //; move/zchar_on in S2gamma. - rewrite Dade_isometry ?(cfun_onS sHU_A0) // cfdotBr cfdotZr !cfdotBl !cfdotZl. - rewrite cfnorm_prTIred omuS1 // (seqInd_ortho _ _ S2muj) ?(memPn red_muj) //. - rewrite (seqInd_ortho _ Txi) ?(memPn (sS1S2' _)) // !(mulr0, subr0) mulf_eq0. - by rewrite char1_eq0 ?irrWchar // -cfnorm_eq0 irrWnorm ?oner_eq0 ?neq0CG. -apply: contraNneq => o_muj_etaj; rewrite {}tau_theta !{gamma}raddfB subr_eq0 /=. -have /CnatP[xi1 ->]: xi 1%g \in Cnat by rewrite Cnat_char1 ?irrWchar. -rewrite mu_1 // cfdotZr !cfdotBl !raddfZnat !cfdotZl {}o_muj_etaj cfdot_sumr. -have /orthogonalP oS2_S1: orthogonal (map tau2 S2) (map tau1 S1). - exact: (coherent_ortho scohM) sS20 coh_tau2 sS10 coh_tau1 sS1S2'. -rewrite !oS2_S1 ?map_f // big1 ?(mulr0, subr0) // => k _. -exact: (coherent_ortho_cycTIiso _ _ coh_tau2). -Qed. - -(* This is Peterfalvi (11.9). *) -(* Note that in the proof of part (a), the text improperly suggests using *) -(* (5.3.b) to show then tau (zeta - zeta^alpha) is orthogonal to the eta i j. *) -(* Since alpha might not be conjugation, this is not obvious. Indeed the best *) -(* way to derive this is to use (5.5) together with the coherence of S(HC). *) -(* In part (c) we start by reducing the proof to q <= p - 1; we also don't *) -(* compute [tau (mu0 - zeta), tau2 lambda] = [chi, tau2 lambda] since this *) -(* is not needed to prove than u = a: one only needs to show that the *) -(* the left-hand side is an integer, which is in fact required to show that *) -(* the right-hand is an integer. *) -Lemma FTtype34_structure (eta0row := \sum_j eta_ 0 j) : - [/\ (*a*) {in S1, forall zeta, eq_proj_eta (tau (bridge0 zeta)) eta0row}, - (*b*) (p < q)%N - & (*c*) FTtype M == 3 /\ typeP_Galois MtypeP]. -Proof. -have sum_etaW F: \sum_(eta <- etaW) F eta = \sum_i \sum_j F (eta_ i j). - rewrite big_map big_tuple (reindex (dprod_Iirr defW)) /=. - by rewrite pair_bigA; apply: eq_bigr => -[i j]. - by exists (inv_dprod_Iirr defW) => ij; rewrite ?dprod_IirrK ?inv_dprod_IirrK. -have bridgeS1: {in S1, forall zeta, eq_proj_eta (tau (bridge0 zeta)) eta0row}. - move=> zeta S1zeta; set phi := bridge0 zeta; have irr_zeta := irrS1 S1zeta. - have [X etaX [chi [Dchi oXchi o_chi_eta]]] := orthogonal_split etaW (tau phi). - have [Isigma Zsigma] := cycTI_Zisometry ctiWG. - have{o_chi_eta} o_chi_eta i j: '[chi, eta_ i j] = 0. - by rewrite (orthoPl o_chi_eta) ?map_f ?mem_irr. - have o1etaW: orthonormal etaW by rewrite map_orthonormal ?irr_orthonormal. - have [a Da defX] := orthonormal_span o1etaW etaX; pose a_ := a (eta_ _ _). - have{Da} Da i j: a_ i j = '[tau phi, eta_ i j]. - by rewrite Dchi cfdotDl o_chi_eta addr0 /a_ Da. - have Zphi: phi \in 'Z[irr M, HU^#] by apply: Zbridge0. - have A0phi: phi \in 'CF(M, 'A0(M)) by apply: A0bridge0. - have a00_1 : a_ 0 0 = 1. - rewrite Da cycTIirr00 [sigma 1]cycTIiso1. - rewrite Dade_reciprocity // => [|x _ y _]; last by rewrite !cfun1E !inE. - rewrite rmorph1 /= -(prTIirr00 ptiWM) -/(mu2_ 0 0) cfdotC. - by rewrite cfdotBr cfdot_prTIirr_red omu2S1 // subr0 rmorph1. - have aut_phi nu: cfAut nu (tau phi) = tau phi + tau (zeta - cfAut nu zeta). - rewrite -Dade_aut !rmorphB !raddfB /= !addrA subrK. - by rewrite -prTIred_aut aut_Iirr0. - have Za i j: a_ i j \in Cint. - rewrite Da Cint_cfdot_vchar ?cycTIiso_vchar //. - by rewrite Dade_vchar ?(zchar_onS sHU_A0). - have [tau1 coh_tau1] := cohS1; have [_ Dtau1] := coh_tau1. - have o_tau1_eta := coherent_ortho_cycTIiso MtypeP sS10 coh_tau1. - have a_aut nu i j: a (cfAut nu (eta_ i j)) = a_ i j. - symmetry; transitivity '[cfAut nu (tau phi), cfAut nu (eta_ i j)]. - by rewrite cfdot_aut_vchar ?cycTIiso_vchar // -Da aut_Cint. - rewrite aut_phi cfAut_cycTIiso -cycTIirr_aut [a _]Da cfdotDl addrC. - rewrite -Dtau1 ?zcharD1_seqInd ?seqInd_sub_aut_zchar // raddfB cfdotBl. - by rewrite !o_tau1_eta ?cfAut_seqInd ?cfAut_irr // subr0 add0r. - pose a10 := a_ i1 0; pose a01 := a_ 0 j1; pose a11 := a_ i1 j1. - have Da10 i: i != 0 -> a_ i 0 = a10. - case/(cfExp_prime_transitive pr_q nz_i1) => k co_k_wi1 Dwi. - rewrite -(cforder_dprodl defW) -dprod_IirrEl in co_k_wi1. - have [[nu eta10nu] _] := cycTIiso_aut_exists ctiWG co_k_wi1. - by rewrite /a_ dprod_IirrEl Dwi rmorphX /= -dprod_IirrEl eta10nu a_aut. - have Da01 j: j != 0 -> a_ 0 j = a01. - case/(cfExp_prime_transitive pr_p nz_j1) => k co_k_wj1 Dwj. - rewrite -(cforder_dprodr defW) -dprod_IirrEr in co_k_wj1. - have [[nu eta01nu] _] := cycTIiso_aut_exists ctiWG co_k_wj1. - by rewrite /a_ dprod_IirrEr Dwj rmorphX /= -dprod_IirrEr eta01nu a_aut. - have DaB1 i j: a_ i j = a_ i 0 + a_ 0 j - a_ 0 0. - apply: (canRL (addrK _)); rewrite !Da cycTIiso_cfdot_exchange // => x Vx. - have /setDP[A0x A'x]: x \in 'A0(M) :\: 'A(M). - by rewrite (FTsupp0_typeP maxM MtypeP) // mem_class_support. - by rewrite Dade_id // (cfun_on0 (zchar_on Zphi)) // -defA. - pose p1 : algC := p.-1%:R; pose q1 : algC := q.-1%:R. - have normX: '[X] = 1 + q1 * a10 ^+ 2 + p1 * a01 ^+ 2 + p1 * q1 * a11 ^+ 2. - transitivity (\sum_i \sum_j a_ i j ^+ 2). - rewrite defX cfnorm_sum_orthonormal // sum_etaW. - by apply/eq_bigr=> i _; apply/eq_bigr=> j _; rewrite Cint_normK ?Za. - rewrite -addrA addrACA (bigD1 0) //= (bigD1 0) //= a00_1 expr1n. - rewrite -natrM !mulr_natl mulrnA -mulrnDl. - rewrite -nirrW1 -nirrW2 -!(cardC1 0) -!sumr_const. - congr (1 + _ + _); first by apply: eq_bigr => j /Da01->. - apply: eq_bigr => i /Da10-Dai0; rewrite (bigD1 0) //= Dai0; congr (_ + _). - by apply: eq_bigr => j /Da01-Da0j; rewrite DaB1 Dai0 Da0j -DaB1. - have normX_le_q: '[X] <= q%:R. - rewrite -(ler_add2r '[chi]) -cfnormDd // -Dchi -ler_subl_addl. - have ->: '[tau phi] - q%:R = 1. - rewrite Dade_isometry ?A0bridge0 // cfnormBd; last by rewrite omuS1. - by rewrite cfnorm_prTIred cfdotS1 // eqxx addrC addKr. - suffices: '[chi] != 0. - suffices /CnatP[nchi ->]: '[chi] \in Cnat by rewrite ler1n lt0n -eqC_nat. - rewrite Cnat_cfnorm_vchar // -(canLR (addKr _) Dchi) defX addrC rpredB //. - by rewrite Dade_vchar // (zchar_onS (FTsupp_sub0 M)) ?defA. - rewrite big_map big_seq rpred_sum // => _ /(cycTIirrP defW)[i [j ->]]. - by rewrite rpredZ_Cint ?Za ?cycTIiso_vchar. - pose theta := zeta - zeta^*%CF. - have Ztheta: theta \in 'Z[S1, HU^#] by apply: seqInd_sub_aut_zchar. - have: '[tau phi, tau theta] != 0. - rewrite Dade_isometry //; last by rewrite (cfun_onS _ (zchar_on Ztheta)). - rewrite cfdotBl !cfdotBr ?omuS1 ?cfAut_seqInd // subr0 add0r oppr_eq0. - rewrite irrWnorm // (seqInd_conjC_ortho _ _ _ S1zeta) ?mFT_odd //. - by rewrite subr0 oner_eq0. - rewrite cfnorm_eq0 Dchi; apply: contraNneq => ->; rewrite addr0 defX. - rewrite -Dtau1 ?zcharD1_seqInd //. - rewrite cfdot_suml big_map big1_seq // => _ /(cycTIirrP defW)[i [j ->]]. - apply/eqP; rewrite cfdotC fmorph_eq0 cfdotZr raddfB cfdotBl. - by rewrite !o_tau1_eta ?cfAut_seqInd ?cfAut_irr // subrr mulr0. - have a2_ge0 i j: 0 <= a_ i j ^+ 2 by rewrite -realEsqr Creal_Cint. - have a11_0: a11 = 0. - have: ('[X] < (2 * q.-1)%:R). - rewrite (ler_lt_trans normX_le_q) // ltC_nat -subn1 mulnBr ltn_subRL. - by rewrite !mul2n -!addnn ltn_add2r odd_prime_gt2 ?mFT_odd. - apply: contraTeq => nz_a11; rewrite ler_gtF // normX ler_paddl //. - by rewrite !mulr_natl ?addr_ge0 ?ler01 ?mulrn_wge0 ?a2_ge0. - rewrite -mulr_natl -natrM ?ler_pmul ?natr_ge0 ?sqr_Cint_ge1 ?Za //. - by rewrite leC_nat leq_mul // -subn1 ltn_subRL odd_prime_gt2 ?mFT_odd. - rewrite a11_0 expr0n /= mulr0 addr0 in normX. - have a10_a01: a10 + a01 = 1. - by apply/eqP; rewrite -subr_eq0 -a00_1 -DaB1 -/a11 a11_0. - have{o_chi_eta} o_chi_eta: orthogonal chi etaW. - by apply/orthoPl=> _ /mapP[_ /(cycTIirrP defW)[i [j ->]] ->]. - have a10_0: a10 = 0. - apply: contraNeq (FTtype34_not_ortho_cycTIiso S1zeta) => nz_a10. - have a01_0: a01 = 0. - apply: contraTeq normX_le_q => nz_a01; rewrite normX ltr_geF //. - rewrite ltr_spaddr 1?mulr_gt0 ?ltr0n -?subn1 ?subn_gt0 ?prime_gt1 //. - by rewrite ltr_def sqrf_eq0 nz_a01 a2_ge0. - rewrite -ler_subl_addl -(natrB _ (prime_gt0 pr_q)) subn1 -mulr_natl. - by rewrite ler_wpmul2l ?ler0n // sqr_Cint_ge1 ?Za. - suffices <-: X = eta_col 0 by rewrite Dchi /eq_proj_eta addrC addKr. - rewrite defX sum_etaW exchange_big (bigD1 0) //= addrC. - rewrite big1 ?add0r => [|j nz_j]; first apply: eq_bigr => i _; last first. - rewrite (bigD1 0) // [a _]Da01 //= a01_0 scale0r add0r big1 // => i nz_i. - by rewrite [a _]DaB1 Da10 // Da01 // a10_a01 a00_1 subrr scale0r. - have [-> | nz_i] := eqVneq i 0; first by rewrite [a _]a00_1 scale1r. - by rewrite [a _]Da10 // (canRL (addrK _) a10_a01) a01_0 subr0 scale1r. - suffices <-: X = eta0row by rewrite Dchi /eq_proj_eta addrC addKr. - rewrite defX sum_etaW (bigD1 0) //= addrC. - rewrite big1 ?add0r => [|i nz_i]; first apply: eq_bigr => j _; last first. - rewrite (bigD1 0) // [a _]Da10 //= a10_0 scale0r add0r big1 // => j nz_j. - by rewrite [a _]DaB1 Da10 // Da01 // a10_a01 a00_1 subrr scale0r. - have [-> | nz_j] := eqVneq j 0; first by rewrite [a _]a00_1 scale1r. - by rewrite [a _]Da01 // (canRL (addKr _) a10_a01) a10_0 oppr0 add0r scale1r. -have [zeta [irr_zeta Szeta zeta1]] := FTtypeP_ref_irr maxM MtypeP. -have{zeta1} [S1zeta zeta1]: zeta \in S1 /\ zeta 1%g = q%:R. - split=> //; have [k nz_k Dzeta] := seqIndC1P Szeta. - rewrite Dzeta mem_seqInd // !inE subGcfker nz_k -defM'' lin_char_der1 //. - rewrite -mulr_natl Dzeta cfInd1 //= -(index_sdprod defM) in zeta1. - by apply/andP; rewrite irr_char -(mulfI _ zeta1) ?neq0CG. -have{Szeta} ltpq: (p < q)%N. - rewrite ltn_neqAle neq_pq leqNgt /=. - apply: contra (FTtype34_not_ortho_cycTIiso S1zeta) => ltqp. - case/(FTtype345_Dade_bridge0 _ MtypeP): Szeta => // chi [-> _ _ o_chi_eta]. - rewrite /eq_proj_eta addrC addKr (orthogonal_oppl chi). - by apply/orthoPl=> _ /mapP[_ /(cycTIirrP defW)[i [j ->]] ->]. -suffices galM: typeP_Galois MtypeP. - have [_ [_ _ _ [/= cycUbar _ _]]] := typeP_Galois_P maxM notMtype5 galM. - have{cycUbar} cycUbar: cyclic (U / U') by rewrite -defU' -defC. - have nilU: nilpotent U by have [_ []] := MtypeP. - case/orP: Mtype34 => // /(compl_of_typeIV maxM MtypeP)[_ /negP[]]. - exact/cyclic_abelian/cyclic_nilpotent_quo_der1_cyclic. -apply: contraLR ltpq => gal'M; rewrite -leqNgt (leq_trans _ (leq_pred _)) //. -have [_ _ _] := typeP_nonGalois_characters maxM notMtype5 gal'M. -case: (_ gal'M) => H1 /= [_ _ nH1U _ []]; set a := #|U : _| => a_gt1. -rewrite def_p -/q -defU' -defS2 => a_dv_p1 cycUhat _. -set irr_qa := [pred lambda in irr M | lambda 1%g == (q * a)%:R] => S2_qa. -have{S2_qa}/hasP[lambda S2lambda /andP[irr_lambda /eqP-lambda1]]: has irr_qa S2. - have [a2_dv_pu] := S2_qa; rewrite has_count; apply: leq_trans. - rewrite -(@ltn_pmul2r (a ^ 2 * #|C|)); last first. - by rewrite !muln_gt0 (ltnW a_gt1) cardG_gt0. - by rewrite mul0n divnK // muln_gt0 cardG_gt0 -subn1 subn_gt0 prime_gt1. -have{nH1U cycUhat} a_dv_u: a %| u. - rewrite /u card_quotient ?normal_norm // indexgS // defU'. - rewrite der1_min ?cyclic_abelian // normsI ?normG //. - by rewrite (subset_trans nH1U) // astab_norm. -pose j := j1; pose psi := mu_ j - (u %/ a)%:R *: lambda. -have /andP/=[red_muj S2muj]: mu_ j \in [predD S2 & irr M]. - by rewrite memS2red image_f. -have S2psi: psi \in 'Z[S2, M^#]. - rewrite zcharD1E rpredB ?rpredZnat ?mem_zchar //=. - by rewrite !cfunE mu_1 // lambda1 -natrM mulnCA divnK ?subrr. -pose phi := tau (mu_ 0 - zeta). -have o_phi_psi: '[phi, tau psi] = 0. - have Apsi: psi \in 'CF(M, 'A(M)) by rewrite defA (zcharD1_seqInd_on _ S2psi). - have [Tzeta Tlambda] := (seqInd_subT S1zeta, seqInd_subT S2lambda). - rewrite Dade_isometry ?A0bridge0 ?(cfun_onS (FTsupp_sub0 M)) //. - rewrite cfdotBl !cfdotBr !cfdotZr cfdot_prTIred eq_sym (negPf nz_j1) add0r. - rewrite !(seqInd_ortho _ Tzeta) ?Tmu ?(memPnC (sS1S2' S1zeta)) // add0r. - rewrite (seqInd_ortho _ (Tmu 0)) ?(memPnC (prTIred_not_irr _ _)) // !mulr0. - by rewrite subrr. -have [tau2 coh_tau2] := cohS2; have [[_ Ztau2] Dtau2] := coh_tau2. -have ua_1: (u %/ a)%:R * `|'[phi, tau2 lambda]| == 1. - rewrite -normr_nat -normrM mulr_natl -!raddfMn -[_ *+ _](subrK (mu_ j)) /=. - rewrite -opprB addrC raddfB cfdotBr -scaler_nat (Dtau2 _ S2psi) o_phi_psi. - case: (FTtypeP_coherent_TIred _ coh_tau2 _ S2lambda S2muj) => // -[b k] -> _. - rewrite -/(eta_col k) cfdotZr rmorph_sign subr0 normrMsign. - rewrite -[phi](subrK eta0row) cfdotDl cfdot_sumr big1 => [|j' _]; last first. - by rewrite (orthoPl (bridgeS1 _ _)) ?map_f ?mem_irr. - rewrite add0r cfdotC norm_conjC cfdot_sumr (bigD1 k) //= proj_col_eta eqxx. - by rewrite big1 ?addr0 ?normr1 // => i k'i; rewrite proj_col_eta (negPf k'i). -have Du: u = a. - apply/eqP; rewrite -[a]mul1n eqn_mul ?(ltnW a_gt1) // -eqC_nat. - move: ua_1; rewrite Cnat_mul_eq1 ?rpred_nat //; first by case/andP. - rewrite Cnat_norm_Cint ?Cint_cfdot_vchar //; last by rewrite Ztau2 ?mem_zchar. - rewrite Dade_vchar // zchar_split A0bridge0 //. - by rewrite rpredB ?char_vchar ?prTIred_char ?irrWchar. -have lequ: (q <= u)%N. - have u1_gt0: (0 < u.-1)%N by rewrite -subn1 subn_gt0 Du. - rewrite (leq_trans _ (leq_pred u)) // dvdn_leq //. - suffices ->: q = #|W1 / C|%g by apply: Frobenius_dvd_ker1 frobUW1bar. - apply/card_isog/quotient_isog; first by have [] := joing_subP nC_UW1. - by rewrite setIAC (coprime_TIg coUq) setI1g. -by rewrite (leq_trans lequ) // Du dvdn_leq // -subn1 subn_gt0 prime_gt1. -Qed. - -End Eleven. diff --git a/mathcomp/odd_order/PFsection12.v b/mathcomp/odd_order/PFsection12.v deleted file mode 100644 index f605c0f..0000000 --- a/mathcomp/odd_order/PFsection12.v +++ /dev/null @@ -1,1373 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div choice. -From mathcomp -Require Import fintype tuple finfun bigop prime ssralg finset center. -From mathcomp -Require Import fingroup morphism perm automorphism quotient action finalg zmodp. -From mathcomp -Require Import gfunctor gproduct cyclic commutator gseries nilpotent pgroup. -From mathcomp -Require Import sylow hall abelian maximal frobenius. -From mathcomp -Require Import matrix mxalgebra mxpoly mxrepresentation mxabelem vector. -From mathcomp -Require Import falgebra fieldext finfield. -From mathcomp -Require Import BGsection1 BGsection2 BGsection3 BGsection4 BGsection7. -From mathcomp -Require Import BGsection14 BGsection15 BGsection16. -From mathcomp -Require Import ssrnum ssrint algC cyclotomic algnum. -From mathcomp -Require Import classfun character inertia vcharacter. -From mathcomp -Require Import PFsection1 PFsection2 PFsection3 PFsection4 PFsection5. -From mathcomp -Require Import PFsection6 PFsection7 PFsection8 PFsection9 PFsection10. -From mathcomp -Require Import PFsection11. - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope GRing.Theory FinRing.Theory Num.Theory. -Local Open Scope ring_scope. - -Section PFTwelve. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). -Implicit Types (p q : nat) (x y z : gT). -Implicit Types H K L M N P Q R S T U V W : {group gT}. - -Section Twelve2. - -(* Hypothesis 12.1 *) -Variable L : {group gT}. - -Hypotheses (maxL : L \in 'M) (Ltype1 : FTtype L == 1%N). - -Local Notation "` 'L'" := (gval L) (at level 0, only parsing) : group_scope. -Local Notation H := `L`_\F%G. -Local Notation "` 'H'" := `L`_\F (at level 0) : group_scope. - -Let nsHL : H <| L. Proof. exact: gFnormal. Qed. -Let calS := seqIndD H L H 1%G. -Let tau := FT_Dade maxL. -Let S_ (chi : 'CF(L)) := [set i in irr_constt chi]. -Let calX : {set Iirr L} := Iirr_kerD L H 1%g. -Let calI := [seq 'chi_i | i in calX]. - -(* This does not actually use the Ltype1 assumption. *) -Lemma FTtype1_ref_irr : exists2 phi, phi \in calS & phi 1%g = #|L : H|%:R. -Proof. -have solH: solvable H := nilpotent_sol (Fcore_nil L). -by apply: exists_linInd; rewrite ?normal1 // proper1G mmax_Fcore_neq1. -Qed. - -Let mem_calI i : i \in calX -> 'chi_i \in calI. -Proof. by move=> i_Iirr; apply/imageP; exists i. Qed. - -Lemma FTtype1_irrP i : - reflect (exists2 chi, chi \in calS & i \in S_ chi) (i \in calX). -Proof. -have [sHL nHL] := andP nsHL; rewrite !inE sub1G andbT. -apply/(iffP idP) => [kerH'i | [_ /seqIndC1P[t nz_t ->]]]; last first. - by rewrite inE => /sub_cfker_constt_Ind_irr <-; rewrite ?subGcfker. -have [t] := constt_cfRes_irr H i; rewrite -constt_Ind_Res => tLi. -rewrite -(sub_cfker_constt_Ind_irr tLi) // in kerH'i. -suffices: 'Ind 'chi_t \in calS by exists ('Ind 'chi_t); rewrite // inE. -by rewrite mem_seqInd ?normal1 // !inE sub1G kerH'i. -Qed. - -Lemma FTtype1_irr_partition : - partition [set Si in [seq S_ chi | chi <- calS]] calX. -Proof. -apply/and3P; split; last 1 first. -- rewrite inE; apply/mapP=> [[chi Schi /esym/setP S_0]]. - have /eqP[] := seqInd_neq0 nsHL Schi. - rewrite [chi]cfun_sum_constt big1 // => i chi_i. - by have:= S_0 i; rewrite inE chi_i inE. -- apply/eqP/setP=> i; apply/bigcupP/FTtype1_irrP=> [[S_chi] | [chi Schi Si]]. - by rewrite inE => /mapP[chi Schi ->]; exists chi. - by exists (S_ chi); rewrite // inE map_f. -apply/trivIsetP=> S_chi1 S_chi2. -rewrite !inE => /mapP[chi1 Schi1 ->] /mapP[chi2 Schi2 ->] {S_chi1 S_chi2}chi2'1. -apply/pred0P=> i; rewrite /= !inE; apply/andP=> [[chi1_i chi2_i]]. -suffices: '['chi_i] == 0 by rewrite cfnorm_irr oner_eq0. -rewrite (constt_ortho_char (seqInd_char Schi1) (seqInd_char Schi2)) //. -by rewrite (seqInd_ortho _ Schi1 Schi2) // (contraNneq _ chi2'1) // => ->. -Qed. - -(* This is Peterfalvi (12.2)(a), first part *) -Lemma FTtype1_seqInd_facts chi : - chi \in calS -> - [/\ chi = \sum_(i in S_ chi) 'chi_i, - constant [seq 'chi_i 1%g | i in S_ chi] - & {in S_ chi, forall i, 'chi_i \in 'CF(L, 1%g |: 'A(L))}]. -Proof. -move=> calS_chi; have [t nz_t Dchi] := seqIndC1P calS_chi. -pose T := 'I_L['chi_t]%g. -have sTL: T \subset L by apply: Inertia_sub. -have sHT: H \subset T by apply/sub_Inertia/gFsub. -have sHL: H \subset L by apply: normal_sub. -have hallH: Hall T H := pHall_Hall (pHall_subl sHT sTL (Fcore_Hall L)). -have [U [LtypeF _]] := FTtypeP _ maxL Ltype1. -have [[_ _ sdHU] [U1 inertU1] _] := LtypeF. -have defT: H ><| 'I_U['chi_t] = T := sdprod_modl sdHU (sub_inertia 'chi_t). -have abTbar : abelian (T / H). - have [_ _ /(_ _ _ inertU1 nz_t)sItU1] := typeF_context LtypeF. - by rewrite -(isog_abelian (sdprod_isog defT)) (abelianS sItU1); case: inertU1. -have [DtL _ X_1] := cfInd_Hall_central_Inertia nsHL abTbar hallH. -have Dchi_sum : chi = \sum_(i in S_ chi) 'chi_i. - by rewrite {1}Dchi DtL -Dchi; apply: eq_bigl => i; rewrite !inE. -have lichi : constant [seq 'chi_i 1%g | i in S_ chi]. - pose c := #|L : T|%:R * 'chi_t 1%g; apply: (@all_pred1_constant _ c). - by apply/allP=> _ /imageP[s tLs ->] /=; rewrite inE Dchi in tLs; rewrite X_1. -split=> // j Schi_j /=; apply/cfun_onP=> y A'y. -have [Ly | /cfun0->//] := boolP (y \in L). -have CHy1: 'C_H[y] = 1%g. - apply: contraNeq A'y => /trivgPn[z /setIP[Hz cyz] ntz]. - rewrite !inE -implyNb; apply/implyP=> nty; apply/bigcupP. - rewrite FTsupp1_type1 Ltype1 //=; exists z; first by rewrite !inE ntz. - by rewrite 3!inE nty Ly cent1C. -have: j \in calX by apply/FTtype1_irrP; exists chi. -by rewrite !inE => /andP[/irr_reg_off_ker_0->]. -Qed. - -(* This is Peterfalvi (12.2)(a), second part. *) -Lemma FTtype1_irr_isometry : - {in 'Z[calI, L^#], isometry tau, to 'Z[irr G, G^#]}. -Proof. -apply: (sub_iso_to _ _ (Dade_Zisometry _)) => // phi. -rewrite zcharD1E => /andP[S_phi phi1_0]. -have /subsetD1P[_ /setU1K <-] := FTsupp_sub L; rewrite zcharD1 {}phi1_0 andbT. -apply: zchar_trans_on phi S_phi => _ /imageP[i /FTtype1_irrP[j calSj Sj_i] ->]. -by rewrite zchar_split irr_vchar; have [_ _ ->] := FTtype1_seqInd_facts calSj. -Qed. - -Lemma FTtype1_irr_subcoherent : - {R : 'CF(L) -> seq 'CF(G) | subcoherent calI tau R}. -Proof. -apply: irr_subcoherent; last exact: FTtype1_irr_isometry. - have UcalI: uniq calI by apply/dinjectiveP; apply: in2W irr_inj. - split=> // _ /imageP[i Ii ->]; rewrite !inE in Ii; first exact: mem_irr. - by apply/imageP; exists (conjC_Iirr i); rewrite ?inE conjC_IirrE ?cfker_aut. -apply/hasPn=> psi; case/imageP => i; rewrite !inE => /andP[kerH'i _] ->. -rewrite /cfReal odd_eq_conj_irr1 ?mFT_odd // irr_eq1 -subGcfker. -by apply: contra kerH'i; apply: gFsub_trans. -Qed. -Local Notation R1gen := FTtype1_irr_subcoherent. - -(* This is Peterfalvi (12.2)(b). *) -Lemma FTtype1_subcoherent (R1 := sval R1gen) : - {R : 'CF(L) -> seq 'CF(G) | - [/\ subcoherent calS tau R, - {in Iirr_kerD L H 1%G, forall i (phi := 'chi_i), - [/\ orthonormal (R1 phi), - size (R1 phi) = 2 - & tau (phi - phi^*%CF) = \sum_(mu <- R1 phi) mu]} - & forall chi, R chi = flatten [seq R1 'chi_i | i in S_ chi]]}. -Proof. -have nrS: ~~ has cfReal calS by apply: seqInd_notReal; rewrite ?mFT_odd. -have U_S: uniq calS by apply: seqInd_uniq. -have ccS: cfConjC_closed calS by apply: cfAut_seqInd. -have conjCS: cfConjC_subset calS (seqIndD H L H 1) by split. -case: R1gen @R1 => /= R1 subc1. -have [[chi_char nrI ccI] tau_iso oI h1 hortho] := subc1. -pose R chi := flatten [seq R1 'chi_i | i in S_ chi]. -have memI phi i: phi \in calS -> i \in S_ phi -> 'chi_i \in calI. - by move=> Sphi Sphi_i; apply/image_f/FTtype1_irrP; exists phi. -have aux phi psi i j mu nu: - phi \in calS -> psi \in calS -> i \in S_ phi -> j \in S_ psi -> - mu \in R1 'chi_i -> nu \in R1 'chi_j -> - orthogonal 'chi_i ('chi_j :: ('chi_j)^*%CF) -> '[mu, nu] = 0. -- move=> Sphi Spsi Sphi_i Spsi_j R1i_mu R1i_nu o_ij. - apply: orthogonalP R1i_mu R1i_nu. - by apply: hortho o_ij; [apply: memI Spsi Spsi_j | apply: memI Sphi Sphi_i]. -exists R; split => //= => [| i Ii]; last first. - have mem_i := mem_calI Ii; have{h1} [Zirr oR1 tau_im] := h1 _ mem_i. - split=> //; apply/eqP; rewrite -eqC_nat -cfnorm_orthonormal // -{}tau_im. - have ?: 'chi_i - ('chi_i)^*%CF \in 'Z[calI, L^#]. - have hchi : 'chi_i \in 'Z[calI, L] by rewrite mem_zchar_on // cfun_onG. - rewrite sub_aut_zchar ?cfAut_zchar // => _ /mapP[j _ ->]. - exact: irr_vchar. - have [-> // _] := tau_iso; rewrite cfnormBd ?cfnorm_conjC ?cfnorm_irr //. - by have [_ ->] := pairwise_orthogonalP oI; rewrite ?ccI // eq_sym (hasPn nrI). -have calS_portho : pairwise_orthogonal calS by apply: seqInd_orthogonal. -have calS_char : {subset calS <= character} by apply: seqInd_char. -have calS_chi_ortho : - {in calS &, forall phi psi i j, - i \in irr_constt phi -> j \in irr_constt psi -> - '[phi, psi] = 0 -> '['chi_i, 'chi_j] = 0}. -- by move=> phi psi Sphi Spsi /= i j; apply: constt_ortho_char; apply/calS_char. -have ZisoS_tau: {in 'Z[calS, L^#], isometry tau, to 'Z[irr G, G^#]}. - apply: (sub_iso_to _ _ (Dade_Zisometry _)) => // phi. - have /subsetD1P[_ /setU1K <-] := FTsupp_sub L. - rewrite zcharD1E zcharD1 => /andP[S_phi ->]; rewrite andbT. - apply: zchar_trans_on phi S_phi => psi calS_psi. - have [Dpsi _ hCF] := FTtype1_seqInd_facts calS_psi. - by rewrite zchar_split (seqInd_vcharW calS_psi) /= Dpsi rpred_sum. -split=> {ZisoS_tau}//= [phi calS_phi | phi psi calS_phi calS_psi]. - rewrite /R /[seq _ | i in _]; set e := enum _; have: uniq e := enum_uniq _. - have: all (mem (S_ phi)) e by apply/allP=> i; rewrite mem_enum. - have ->: phi - phi^*%CF = \sum_(i <- e) ('chi_i - ('chi_i)^*%CF). - rewrite big_filter sumrB -rmorph_sum. - by have [<-] := FTtype1_seqInd_facts calS_phi. - elim: e => /= [_ _ | i e IHe /andP[Si Se] /andP[e'i Ue]]. - by rewrite !big_nil /tau linear0. - rewrite big_cons [tau _]linearD big_cat /= -/tau orthonormal_cat. - have{IHe Ue} [/allP Ze -> ->] := IHe Se Ue. - have{h1} /h1[/allP Z_R1i -> -> /=] := memI _ _ calS_phi Si. - split=> //; first by apply/allP; rewrite all_cat Z_R1i. - apply/orthogonalP=> mu nu R1i_mu /flatten_mapP[j e_j R1j_nu]. - have /= Sj := allP Se j e_j; apply: (aux phi phi i j) => //. - rewrite /orthogonal /= !andbT !cfdot_irr mulrb ifN_eqC ?(memPn e'i) ?eqxx //=. - rewrite !inE in Si Sj; rewrite -conjC_IirrE; set k := conjC_Iirr j. - rewrite (calS_chi_ortho phi phi^*%CF) ?calS_char ?ccS //. - by rewrite irr_consttE conjC_IirrE cfdot_conjC fmorph_eq0. - by rewrite (seqInd_conjC_ortho _ _ _ calS_phi) ?mFT_odd. -case/andP=> /and3P[/eqP opsi_phi /eqP opsi_phiC _] _; apply/orthogonalP. -move=> nu mu /flatten_imageP[j Spsi_j R1j_nu] /flatten_imageP[i Sphi_i R1i_mu]. -apply: (aux psi phi j i) => //; rewrite /orthogonal /= !andbT -conjC_IirrE. -rewrite !inE in Sphi_i Spsi_j; rewrite (calS_chi_ortho psi phi) ?calS_char //. -rewrite (calS_chi_ortho psi phi^*%CF) ?calS_char ?ccS ?eqxx //. -by rewrite irr_consttE conjC_IirrE cfdot_conjC fmorph_eq0. -Qed. - -End Twelve2. - -Local Notation R1gen := FTtype1_irr_subcoherent. -Local Notation Rgen := FTtype1_subcoherent. - -(* This is Peterfalvi (12.3) *) -Lemma FTtype1_seqInd_ortho L1 L2 (maxL1 : L1 \in 'M) (maxL2 : L2 \in 'M) - (L1type1 : FTtype L1 == 1%N) (L2type1 : FTtype L2 == 1%N) - (H1 := L1`_\F%G) (H2 := L2`_\F%G) - (calS1 := seqIndD H1 L1 H1 1) (calS2 := seqIndD H2 L2 H2 1) - (R1 := sval (Rgen maxL1 L1type1)) (R2 := sval (Rgen maxL2 L2type1)) : - gval L2 \notin L1 :^: G -> - {in calS1 & calS2, forall chi1 chi2, orthogonal (R1 chi1) (R2 chi2)}. -Proof. -move=> notL1G_L2; without loss{notL1G_L2} disjointA1A: - L1 L2 maxL1 maxL2 L1type1 L2type1 @H1 @H2 @calS1 @calS2 @R1 @R2 / - [disjoint 'A1~(L2) & 'A~(L1)]. -- move=> IH_L; have [_ _] := FT_Dade_support_disjoint maxL1 maxL2 notL1G_L2. - by case=> /IH_L-oS12 chi1 chi2 *; first rewrite orthogonal_sym; apply: oS12. -case: (Rgen _ _) @R1 => /= R1; set R1' := sval _ => [[subcoh1 hR1' defR1]]. -case: (Rgen _ _) @R2 => /= R2; set R2' := sval _ => [[subcoh2 hR2' defR2]]. -pose tau1 := FT_Dade maxL1; pose tau2 := FT_Dade maxL2. -move=> chi1 chi2 calS1_chi1 calS2_chi2. -have [_ _ _ /(_ chi1 calS1_chi1)[Z_R1 o1R1 dtau1_chi1] _] := subcoh1. -have{o1R1} [uR1 oR1] := orthonormalP o1R1. -apply/orthogonalP=> a b R1a R2b; pose psi2 := tau2 (chi2 - chi2^*%CF). -have Z1a: a \in dirr G by rewrite dirrE Z_R1 //= oR1 ?eqxx. -suffices{b R2b}: '[a, psi2] == 0. - apply: contraTeq => nz_ab; rewrite /psi2 /tau2. - have [_ _ _ /(_ chi2 calS2_chi2)[Z_R2 o1R2 ->] _] := subcoh2. - suffices [e ->]: {e | a = if e then - b else b}. - rewrite -scaler_sign cfdotC cfdotZr -cfdotZl scaler_sumr. - by rewrite cfproj_sum_orthonormal // conjCK signr_eq0. - have [_ oR2] := orthonormalP o1R2. - have Z1b: b \in dirr G by rewrite dirrE Z_R2 //= oR2 ?eqxx. - move/eqP: nz_ab; rewrite cfdot_dirr //. - by do 2?[case: eqP => [-> | _]]; [exists true | exists false | ]. -have [chi1D _ Achi1] := FTtype1_seqInd_facts maxL1 L1type1 calS1_chi1. -pose S_chi1 := [set i0 in irr_constt chi1]. -pose bchi i := 'chi[_ : {set gT}]_i - ('chi_i)^*%CF. -have [t S_chi1t et]: exists2 t, t \in S_chi1 & tau1 (bchi _ t) = a - a^*%CF. - suffices: ~~ [forall i in S_chi1, '[tau1 (bchi L1 i), a] <= 0]. - rewrite negb_forall_in => /exists_inP[i Si tau1i_a]; exists i => //. - case/dIrrP: Z1a tau1i_a => ia ->. - have [k ->]: exists k, tau1 (bchi _ i) = bchi G k. - exact: Dade_irr_sub_conjC (mem_irr _) (Achi1 i Si). - have {1}->: bchi G k = dchi (false, k) + dchi (true, conjC_Iirr k). - by rewrite /dchi !scaler_sign conjC_IirrE. - rewrite cfdotDl !cfdot_dchi addrACA -opprD subr_le0 -!natrD leC_nat. - do 2?case: (_ =P ia) => [<-|] _ //; first by rewrite /dchi scale1r. - by rewrite /dchi scaleN1r conjC_IirrE rmorphN /= cfConjCK opprK addrC. - have: '[tau1 (chi1 - chi1^*%CF), a] == 1. - rewrite /tau1 dtau1_chi1 (bigD1_seq a) //= cfdotDl cfdot_suml oR1 // eqxx. - by rewrite big1_seq ?addr0 // => xi /andP[/negPf a'xi ?]; rewrite oR1 ?a'xi. - apply: contraL => /forall_inP tau1a_le0. - rewrite (ltr_eqF (ler_lt_trans _ ltr01)) // chi1D rmorph_sum /= -/S_chi1. - rewrite -sumrB [tau1 _]linear_sum /= -/tau1 cfdot_suml. - by rewrite -oppr_ge0 -sumrN sumr_ge0 // => i /tau1a_le0; rewrite oppr_ge0. -clear Achi1 dtau1_chi1 uR1 defR1. -suffices: '[a, psi2] == - '[a, psi2] by rewrite -addr_eq0 (mulrn_eq0 _ 2). -have A1bchi2: chi2 - (chi2^*)%CF \in 'Z[calS2, 'A1(L2)]. - by rewrite FTsupp1_type1 // seqInd_sub_aut_zchar ?gFnormal. -have{t S_chi1t et} /eqP{2}->: '[a, psi2] == '[a^*%CF, psi2]. - move/zchar_on in A1bchi2; rewrite -subr_eq0 -cfdotBl. - rewrite [psi2]FT_DadeE ?(cfun_onS (FTsupp1_sub _)) // -FT_Dade1E // -et. - rewrite (cfdot_complement (Dade_cfunS _ _)) ?(cfun_onS _ (Dade_cfunS _ _)) //. - by rewrite FT_Dade_supportE FT_Dade1_supportE setTD -disjoints_subset. -rewrite -2!raddfN opprB /= cfdot_conjCl -Dade_conjC rmorphB /= cfConjCK -/tau2. -rewrite conj_Cint ?Cint_cfdot_vchar ?(Z_R1 a) // Dade_vchar //. -rewrite (zchar_onS (FTsupp1_sub _)) // (zchar_sub_irr _ A1bchi2) //. -exact: seqInd_vcharW. -Qed. - -Section Twelve_4_to_6. - -Variable L : {group gT}. -Hypothesis maxL : L \in 'M . - -Local Notation "` 'L'" := (gval L) (at level 0, only parsing) : group_scope. -Local Notation H := `L`_\F%G. -Local Notation "` 'H'" := `L`_\F (at level 0) : group_scope. -Local Notation H' := H^`(1)%G. -Local Notation "` 'H''" := `H^`(1) (at level 0) : group_scope. - -Let calS := seqIndD H L H 1%G. -Let tau := FT_Dade maxL. -Let rho := invDade (FT_DadeF_hyp maxL). - -Section Twelve_4_5. - -Hypothesis Ltype1 : FTtype L == 1%N. - -Let R := sval (Rgen maxL Ltype1). -Let S_ (chi : 'CF(L)) := [set i in irr_constt chi]. - -(* This is Peterfalvi (12.4). *) -Lemma FTtype1_ortho_constant (psi : 'CF(G)) x : - {in calS, forall phi, orthogonal psi (R phi)} -> x \in L :\: H -> - {in x *: H, forall y, psi y = psi x}%g. -Proof. -move=> opsiR /setDP[Lx H'x]; pose Rpsi := 'Res[L] psi. -have nsHL: H <| L := gFnormal _ _; have [sHL _] := andP nsHL. -have [U [[[_ _ sdHU] [U1 inertU1] _] _]] := FTtypeP 1 maxL Ltype1. -have /= [_ _ TIsub]:= FTtypeI_II_facts maxL Ltype1 sdHU. -pose ddL := FT_Dade_hyp maxL. -have A1Hdef : 'A1(L) = H^# by apply: FTsupp1_type1. -have dot_irr xi j : xi \in calS -> j \in S_ xi -> '['chi_j, xi] = 1. - move=> xi_calS Sj. - have -> : xi = \sum_(i <- enum (S_ xi)) 'chi_i. - by rewrite big_filter; have [] := FTtype1_seqInd_facts maxL Ltype1 xi_calS. - rewrite (bigD1_seq j) ?mem_enum ?enum_uniq //= cfdotDr cfdot_sumr cfnorm_irr. - by rewrite big1 ?addr0 // => k i'k; rewrite cfdot_irr eq_sym (negPf i'k). -have {dot_irr} supp12B y xi j1 j2 : xi \in calS -> j1 \in S_ xi -> - j2 \in S_ xi -> y \notin ('A(L) :\: H^#) -> ('chi_j1 - 'chi_j2) y = 0. -- move=> calS_xi Sj1 Sj2 yADHn. - have [xiD xi_cst sup_xi] := FTtype1_seqInd_facts maxL Ltype1 calS_xi. - have [Hy | H'y] := boolP (y \in H); last first. - suffices /cfun_on0->: y \notin 1%g |: 'A(L) by rewrite ?rpredB ?sup_xi. - by rewrite !inE negb_or negb_and (group1_contra H'y) ?H'y in yADHn *. - have [s _ xiIndD] := seqIndP calS_xi. - pose sum_sL := \sum_(xi_z <- ('chi_s ^: L)%CF) xi_z. - suffices Dxi: {in S_ xi, forall i, 'chi_i y = sum_sL y}. - by rewrite !cfunE !Dxi ?subrr. - move=> k Sk; pose phiH := 'Res[H] 'chi_k. - transitivity (phiH y); first by rewrite cfResE ?normal_sub. - have phiH_s_1: '[phiH, 'chi_s] = 1 by rewrite cfdot_Res_l -xiIndD dot_irr. - have phiH_s: s \in irr_constt phiH by rewrite irr_consttE phiH_s_1 oner_eq0. - by rewrite [phiH](Clifford_Res_sum_cfclass _ phiH_s) // phiH_s_1 scale1r. -have {supp12B} oResD xi i1 i2 : xi \in calS -> i1 \in S_ xi -> i2 \in S_ xi -> - '['Res[L] psi, 'chi_i1 - 'chi_i2] = 0. -- move=> calS_xi Si1 Si2; rewrite cfdotC Frobenius_reciprocity -cfdotC. - case: (altP (i1 =P i2))=> [-> | d12]; first by rewrite subrr linear0 cfdot0r. - have {supp12B} supp12B y: y \notin 'A(L) :\: H^# -> ('chi_i1 - 'chi_i2) y = 0. - exact: (supp12B _ xi _ _ calS_xi). - case: (FTtype1_seqInd_facts maxL Ltype1 calS_xi) => _ cst1 supA. - move/(_ _ Si1): (supA) => /cfun_onP s1; case/(constantP 0): (cst1) => [n]. - move/all_pred1P /allP => nseqD; move/(_ _ Si2): (supA) => /cfun_onP s2. - have nchi11: 'chi_i1 1%g = n by apply/eqP/nseqD/image_f. - have{nseqD} nchi12: 'chi_i2 1%g = n by apply/eqP/nseqD/image_f. - have i12_1: 'chi_i1 1%g == 'chi_i2 1%g by rewrite nchi11 nchi12. - have sH1A: H^# \subset 'A(L) by rewrite Fcore_sub_FTsupp. - have nzAH: 'A(L) :\: H^# != set0. - apply: contra d12 => /eqP tADH; apply/eqP; apply: irr_inj; apply/cfunP=> w. - apply/eqP; rewrite -subr_eq0; have := supp12B w; rewrite !cfunE => -> //. - by rewrite tADH in_set0. - have{nzAH} tiH: normedTI ('A(L) :\: H^#) G L by rewrite -A1Hdef TIsub ?A1Hdef. - have{supp12B} supp12B : 'chi_i1 - 'chi_i2 \in 'CF(L, 'A(L) :\: H^#). - by apply/cfun_onP; apply: supp12B. - have [_ /subsetIP[_ nAHL] _] := normedTI_P tiH. - pose tau1 := restr_Dade ddL (subsetDl _ _) nAHL. - have tauInd: {in 'CF(L, 'A(L) :\: H^#), tau1 =1 'Ind} := Dade_Ind _ tiH. - rewrite -{}tauInd // [tau1 _]restr_DadeE {tau1 nAHL}//. - suffices Rtau12: Dade ddL ('chi_i1 - 'chi_i2) \in 'Z[R xi]. - by rewrite (span_orthogonal (opsiR xi _)) ?memv_span1 ?(zchar_span Rtau12). - case: (Rgen _ _) @R => rR [scohS]; case: (R1gen _ _) => /= R1 scohI ? DrR. - rewrite -/calS in scohS; set calI := image _ _ in scohI. - have [Ii1 Ii2]: 'chi_i1 \in calI /\ 'chi_i2 \in calI. - by split; apply/image_f/FTtype1_irrP; exists xi. - have [calI2 [I2i1 I2i2 sI2I] []] := pair_degree_coherence scohI Ii1 Ii2 i12_1. - move=> tau2 cohI2; have [_ <-] := cohI2; last first. - by rewrite zcharD1E rpredB ?mem_zchar // 2!cfunE subr_eq0. - suffices R_I2 j: j \in S_ xi -> 'chi_j \in calI2 -> tau2 'chi_j \in 'Z[rR xi]. - by rewrite raddfB rpredB ?R_I2. - move=> Sj /(mem_coherent_sum_subseq scohI sI2I cohI2)[e R1e ->]. - rewrite DrR big_seq rpred_sum // => phi /(mem_subseq R1e) R1phi. - by apply/mem_zchar/flatten_imageP; exists j. -suffices ResL: {in x *: H, forall y, Rpsi y = Rpsi x}%g. - move=> w xHw; case/lcosetP: xHw (ResL w xHw) => h Hh -> {w}. - by rewrite !cfResE ?subsetT ?groupM // ?(subsetP sHL). -move=> _ /lcosetP[h Hh ->] /=; rewrite (cfun_sum_cfdot Rpsi). -pose calX := Iirr_kerD L H 1%g; rewrite (bigID (mem calX) xpredT) /= !cfunE. -set sumX := \sum_(i in _) _; suffices HsumX: sumX \in 'CF(L, H). - rewrite !(cfun_on0 HsumX) ?groupMr // !sum_cfunE. - rewrite !add0r; apply: eq_bigr => i; rewrite !inE sub1G andbT negbK => kerHi. - by rewrite !cfunE cfkerMr ?(subsetP kerHi). -rewrite [sumX](set_partition_big _ (FTtype1_irr_partition L)) /=. -apply: rpred_sum => A; rewrite inE => /mapP[xi calS_xi defA]. -have [-> | [j Achij]] := set_0Vmem A; first by rewrite big_set0 rpred0. -suffices ->: \sum_(i in A) '[Rpsi, 'chi_i] *: 'chi_i = '[Rpsi, 'chi_j] *: xi. - by rewrite rpredZ // (seqInd_on _ calS_xi). -have [-> _ _] := FTtype1_seqInd_facts maxL Ltype1 calS_xi; rewrite -defA. -rewrite scaler_sumr; apply: eq_bigr => i Ai; congr (_ *: _); apply/eqP. -by rewrite -subr_eq0 -cfdotBr (oResD xi) /S_ -?defA. -Qed. - -(* This is Peterfalvi (12.5) *) -Lemma FtypeI_invDade_ortho_constant (psi : 'CF(G)) : - {in calS, forall phi, orthogonal psi (R phi)} -> - {in H :\: H' &, forall x y, rho psi x = rho psi y}. -Proof. -have [nsH'H nsHL]: H' <| H /\ H <| L by rewrite !gFnormal. -have [[sH'H _] [sHL _]] := (andP nsH'H, andP nsHL). -case: (Rgen _ _) @R => /= rR [scohS _ _] opsiR; set rpsi := rho psi. -have{rR scohS opsiR} o_rpsi_S xi1 xi2: - xi1 \in calS -> xi2 \in calS -> xi1 1%g = xi2 1%g -> '[rpsi, xi1 - xi2] = 0. -- move=> Sxi1 Sxi2 /eqP deg12. - have [calS2 [S2xi1 S2xi2]] := pair_degree_coherence scohS Sxi1 Sxi2 deg12. - move=> ccsS2S [tau2 cohS2]; have [[_ Dtau2] [_ sS2S _]] := (cohS2, ccsS2S). - have{deg12} L1xi12: (xi1 - xi2) 1%g == 0 by rewrite !cfunE subr_eq0. - have{ccsS2S cohS2} tau2E := mem_coherent_sum_subseq scohS ccsS2S cohS2. - have o_psi_tau2 xi: xi \in calS2 -> '[psi, tau2 xi] = 0. - move=> S2xi; have [e /mem_subseq Re ->] := tau2E xi S2xi. - by rewrite cfdot_sumr big1_seq // => _ /Re/orthoPl->; rewrite ?opsiR ?sS2S. - have A1xi12: xi1 - xi2 \in 'CF(L, H^#). - by rewrite (@zchar_on _ _ calS) ?zcharD1 ?rpredB ?seqInd_zchar. - rewrite cfdotC -invDade_reciprocity // -cfdotC. - rewrite FT_DadeF_E -?FT_DadeE ?(cfun_onS (Fcore_sub_FTsupp maxL)) //. - rewrite -Dtau2; last by rewrite zcharD1E rpredB ?mem_zchar. - by rewrite !raddfB /= !o_psi_tau2 ?subrr. -pose P_ i : {set Iirr H} := [set j in irr_constt ('Ind[H, H'] 'chi_i)]. -pose P : {set {set Iirr H}} := [set P_ i | i : Iirr H']. -have tiP: trivIset P. - apply/trivIsetP=> _ _ /imsetP[i1 _ ->] /imsetP[i2 _ ->] chi2'1. - apply/pred0P=> j; rewrite !inE; apply: contraNF chi2'1 => /andP[i1Hj i2Hj]. - case: ifP (cfclass_Ind_cases i1 i2 nsH'H) => _; first by rewrite /P_ => ->. - have NiH i: 'Ind[H,H'] 'chi_i \is a character by rewrite cfInd_char ?irr_char. - case/(constt_ortho_char (NiH i1) (NiH i2) i1Hj i2Hj)/eqP/idPn. - by rewrite cfnorm_irr oner_eq0. -have coverP: cover P =i predT. - move=> j; apply/bigcupP; have [i jH'i] := constt_cfRes_irr H' j. - by exists (P_ i); [apply: mem_imset | rewrite inE constt_Ind_Res]. -have /(all_sig_cond 0)[lambda lambdaP] A: A \in P -> {i | A = P_ i}. - by case/imsetP/sig2_eqW=> i; exists i. -pose theta A : Iirr H := odflt 0 [pick j in A :\ 0]; pose psiH := 'Res[H] rpsi. -pose a_ A := '[psiH, 'chi_(theta A)] / '['Ind 'chi_(lambda A), 'chi_(theta A)]. -pose a := '[psiH, 1 - 'chi_(theta (pblock P 0))]. -suffices Da: {in H :\: H', rpsi =1 (fun=> a)} by move=> /= *; rewrite !Da. -suffices DpsiH: psiH = \sum_(A in P) a_ A *: 'Ind 'chi_(lambda A) + a%:A. - move=> x /setDP[Hx notH'x]; transitivity (psiH x); first by rewrite cfResE. - rewrite DpsiH !cfunE sum_cfunE cfun1E Hx mulr1 big1 ?add0r // => A _. - by rewrite cfunE (cfun_onP (cfInd_normal _ _)) ?mulr0. -apply: canRL (subrK _) _; rewrite [_ - _]cfun_sum_cfdot. -rewrite -(eq_bigl _ _ coverP) big_trivIset //=; apply: eq_bigr => A P_A. -rewrite {}/a_; set i := lambda A; set k := theta A; pose Ii := 'I_H['chi_i]%G. -have /cfInd_central_Inertia[//|e _ [DiH _ DiH_1]]: abelian (Ii / H'). - by rewrite (abelianS _ (der_abelian 0 H)) ?quotientS ?subsetIl. -have defA: A = P_ i := lambdaP A P_A. -have Ak: k \in A; last 1 [have iHk := Ak; rewrite defA inE in Ak]. - have [j iHj] := constt_cfInd_irr i sH'H. - rewrite {}/k /theta; case: pickP => [k /setDP[]//| /(_ j)/=]. - by rewrite defA !in_set iHj andbT => /negbFE/eqP <-. -have{DiH} DiH: 'Ind 'chi_i = e *: \sum_(j in A) 'chi_j. - by congr (_ = _ *: _): DiH; apply: eq_bigl => j; rewrite [in RHS]defA !inE. -rewrite {2}DiH; have{DiH} ->: e = '['Ind 'chi_i, 'chi_k]. - rewrite DiH cfdotZl cfdot_suml (bigD1 k) //= cfnorm_irr big1 ?addr0 ?mulr1 //. - by move=> j /andP[_ k'j]; rewrite cfdot_irr (negPf k'j). -rewrite scalerA scaler_sumr divfK //; apply: eq_bigr => j Aj; congr (_ *: _). -rewrite cfdotBl cfdotZl -irr0 cfdot_irr mulr_natr mulrb eq_sym. -apply/(canLR (addrK _))/(canRL (addNKr _)); rewrite addrC -cfdotBr. -have [j0 | nzj] := altP eqP; first by rewrite j0 irr0 /a -j0 (def_pblock _ P_A). -have iHj := Aj; rewrite defA inE in iHj; rewrite cfdot_Res_l linearB /=. -do [rewrite o_rpsi_S ?cfInd1 ?DiH_1 //=; apply/seqIndC1P]; first by exists j. -by exists k; rewrite // /k /theta; case: pickP => [? | /(_ j)] /setD1P[]. -Qed. - -End Twelve_4_5. - -Hypothesis frobL : [Frobenius L with kernel H]. - -Lemma FT_Frobenius_type1 : FTtype L == 1%N. -Proof. -have [E /Frobenius_of_typeF LtypeF] := existsP frobL. -by apply/idPn=> /FTtypeP_witness[]// _ _ _ _ _ /typePF_exclusion/(_ E). -Qed. -Let Ltype1 := FT_Frobenius_type1. - -Lemma FTsupp_Frobenius : 'A(L) = H^#. -Proof. -apply/eqP; rewrite eqEsubset Fcore_sub_FTsupp // andbT. -apply/bigcupsP=> y; rewrite Ltype1 FTsupp1_type1 //= => H1y. -by rewrite setSD //; have [_ _ _ ->] := Frobenius_kerP frobL. -Qed. - -(* This is Peterfalvi (12.6). *) -Lemma FT_Frobenius_coherence : {subset calS <= irr L} /\ coherent calS L^# tau. -Proof. -have irrS: {subset calS <= irr L}. - by move=> _ /seqIndC1P[s nz_s ->]; apply: irr_induced_Frobenius_ker. -split=> //; have [U [MtypeF MtypeI]] := FTtypeP 1 maxL Ltype1. -have [[ntH ntU defL] _ _] := MtypeF; have nsHL: H <| L := gFnormal _ L. -have nilH: nilpotent H := Fcore_nil L; have solH := nilpotent_sol nilH. -have frobHU: [Frobenius L = H ><| U] := set_Frobenius_compl defL frobL. -have [R [scohS _ _]] := Rgen maxL Ltype1; rewrite -/calS -/tau in scohS. -have [tiH | [cHH _] | [expUdvH1 _]] := MtypeI. -- have /Sibley_coherence := And3 (mFT_odd L) nilH tiH. - case/(_ U)=> [|tau1 [IZtau1 Dtau1]]; first by left. - exists tau1; split=> // chi Schi; rewrite Dtau1 //. - by rewrite /tau Dade_Ind ?FTsupp_Frobenius ?(zcharD1_seqInd_on _ Schi). -- apply/(uniform_degree_coherence scohS)/(@all_pred1_constant _ #|L : H|%:R). - apply/allP=> _ /mapP[_ /seqIndP[s _ ->] ->] /=. - by rewrite cfInd1 ?gFsub // lin_char1 ?mulr1 //; apply/char_abelianP. -apply: (non_coherent_chief _ _ scohS) id _ => // [|[_ [p [pH _] /negP[]]]]. - split; rewrite ?mFT_odd ?normal1 ?sub1G ?quotient_nil //= joingG1. - apply/existsP; exists (U / H')%G. - by rewrite Frobenius_proper_quotient ?(sol_der1_proper solH) ?gFnormal_trans. -rewrite subn1 -(index_sdprod defL) -(isog_pgroup p (quotient1_isog H)) in pH *. -have /expUdvH1: p \in \pi(H) by rewrite -p_part_gt1 part_pnat_id ?cardG_gt1. -by have [-> //] := typeF_context MtypeF; split; rewrite ?(sdprodWY defL). -Qed. - -End Twelve_4_to_6. - -Section Twelve_8_to_16. - -Variable p : nat. - -(* Equivalent reformultaion of Hypothesis (12.8), avoiding quotients. *) -Hypothesis IHp : - forall q M, (q < p)%N -> M \in 'M -> FTtype M == 1%N -> ('r_q(M) > 1)%N -> - q \in \pi(M`_\F). - -Variables M P0 : {group gT}. - -Let K := M`_\F%G. -Let K' := K^`(1)%G. -Let nsKM : K <| M. Proof. exact: gFnormal. Qed. - -Hypothesis maxM : M \in 'M. -Hypothesis Mtype1 : FTtype M == 1%N. -Hypothesis prankM : ('r_p(M) > 1)%N. -Hypothesis p'K : p^'.-group K. - -Hypothesis sylP0 : p.-Sylow(M) P0. - -(* This is Peterfalvi (12.9). *) -Lemma non_Frobenius_FTtype1_witness : - [/\ abelian P0, 'r_p(P0) = 2 - & exists2 L, L \in 'M /\ P0 \subset L`_\s - & exists2 x, x \in 'Ohm_1(P0)^# - & [/\ ~~ ('C_K[x] \subset K'), 'N(<[x]>) \subset M & ~~ ('C[x] \subset L)]]. -Proof. -have ntK: K :!=: 1%g := mmax_Fcore_neq1 maxM; have [sP0M pP0 _] := and3P sylP0. -have hallK: \pi(K).-Hall(M) K := Fcore_Hall M. -have K'p: p \notin \pi(K) by rewrite -p'groupEpi. -have K'P0: \pi(K)^'.-group P0 by rewrite (pi_pgroup pP0). -have [U hallU sP0U] := Hall_superset (mmax_sol maxM) sP0M K'P0. -have sylP0_U: p.-Sylow(U) P0 := pHall_subl sP0U (pHall_sub hallU) sylP0. -have{hallU} defM: K ><| U = M by apply/(sdprod_normal_p'HallP nsKM hallU). -have{K'P0} coKP0: coprime #|K| #|P0| by rewrite coprime_pi'. -have [/(_ _ _ sylP0_U)[abP0 rankP0] uCK _] := FTtypeI_II_facts maxM Mtype1 defM. -have{rankP0} /eqP prankP0: 'r_p(P0) == 2. - by rewrite eqn_leq -{1}rank_pgroup // rankP0 (p_rank_Sylow sylP0). -have piP0p: p \in \pi(P0) by rewrite -p_rank_gt0 prankP0. -have [L maxL sP0Ls]: exists2 L, L \in 'M & P0 \subset L`_\s. - have [DpiG _ _ _] := FT_Dade_support_partition gT. - have:= piSg (subsetT P0) piP0p; rewrite DpiG => /exists_inP[L maxL piLs_p]. - have [_ /Hall_pi hallLs _] := FTcore_facts maxL. - have [P sylP] := Sylow_exists p L`_\s; have [sPLs _] := andP sylP. - have sylP_G: p.-Sylow(G) P := subHall_Sylow hallLs piLs_p sylP. - have [y _ sP0_Py] := Sylow_subJ sylP_G (subsetT P0) pP0. - by exists (L :^ y)%G; rewrite ?mmaxJ // FTcoreJ (subset_trans sP0_Py) ?conjSg. -split=> //; exists L => //; set P1 := 'Ohm_1(P0). -have abelP1: p.-abelem P1 := Ohm1_abelem pP0 abP0. -have [pP1 abP1 _] := and3P abelP1. -have sP10: P1 \subset P0 := Ohm_sub 1 P0; have sP1M := subset_trans sP10 sP0M. -have nKP1: P1 \subset 'N(K) by rewrite (subset_trans sP1M) ?gFnorm. -have nK'P1: P1 \subset 'N(K') by apply: gFnorm_trans. -have{coKP0} coKP1: coprime #|K| #|P1| := coprimegS sP10 coKP0. -have solK: solvable K := nilpotent_sol (Fcore_nil M). -have isoP1: P1 \isog P1 / K'. - by rewrite quotient_isog // coprime_TIg ?(coprimeSg (der_sub 1 K)). -have{ntK} ntKK': (K / K' != 1)%g. - by rewrite -subG1 quotient_sub1 ?gFnorm ?proper_subn ?(sol_der1_proper solK). -have defKK': (<<\bigcup_(xbar in (P1 / K')^#) 'C_(K / K')[xbar]>> = K / K')%g. - rewrite coprime_abelian_gen_cent1 ?coprime_morph ?quotient_norms //. - by rewrite quotient_abelian. - rewrite -(isog_cyclic isoP1) (abelem_cyclic abelP1). - by rewrite -(p_rank_abelem abelP1) p_rank_Ohm1 prankP0. -have [xb P1xb ntCKxb]: {xb | xb \in (P1 / K')^# & 'C_(K / K')[xb] != 1}%g. - apply/sig2W/exists_inP; rewrite -negb_forall_in. - apply: contra ntKK' => /eqfun_inP regKP1bar. - by rewrite -subG1 /= -defKK' gen_subG; apply/bigcupsP=> xb /regKP1bar->. -have [ntxb /morphimP[x nK'x P1x Dxb]] := setD1P P1xb. -have ntx: x != 1%g by apply: contraNneq ntxb => x1; rewrite Dxb x1 morph1. -have ntCKx: ~~ ('C_K[x] \subset K'). - rewrite -quotient_sub1 ?subIset ?gFnorm // -cent_cycle subG1 /=. - have sXP1: <[x]> \subset P1 by rewrite cycle_subG. - rewrite coprime_quotient_cent ?(coprimegS sXP1) ?(subset_trans sXP1) ?gFsub//. - by rewrite quotient_cycle ?(subsetP nK'P1) // -Dxb cent_cycle. -have{uCK} UCx: 'M('C[x]) = [set M]. - rewrite -cent_set1 uCK -?card_gt0 ?cards1 // ?sub1set ?cent_set1. - by rewrite !inE ntx (subsetP sP0U) ?(subsetP sP10). - by apply: contraNneq ntCKx => ->; rewrite sub1G. -exists x; [by rewrite !inE ntx | split=> //]. - rewrite (sub_uniq_mmax UCx) /= -?cent_cycle ?cent_sub //. - rewrite mFT_norm_proper ?cycle_eq1 //. - by rewrite mFT_sol_proper abelian_sol ?cycle_abelian. -apply: contraL (leqW (p_rankS p sP0Ls)) => /(eq_uniq_mmax UCx)-> //. -by rewrite prankP0 FTcore_type1 //= ltnS p_rank_gt0. -Qed. - -Variables (L : {group gT}) (x : gT). -Hypotheses (abP0 : abelian P0) (prankP0 : 'r_p(P0) = 2). -Hypotheses (maxL : L \in 'M) (sP0_Ls : P0 \subset L`_\s). -Hypotheses (P0_1s_x : x \in 'Ohm_1(P0)^#) (not_sCxK' : ~~ ('C_K[x] \subset K')). -Hypotheses (sNxM : 'N(<[x]>) \subset M) (not_sCxL : ~~ ('C[x] \subset L)). - -Let H := L`_\F%G. -Local Notation "` 'H'" := (gval L)`_\F (at level 0, format "` 'H'"). -Let nsHL : H <| L. Proof. exact: gFnormal. Qed. - -(* This is Peterfalvi (12.10). *) -Let frobL : [Frobenius L with kernel H]. -Proof. -have [sP0M pP0 _] := and3P sylP0. -have [ntx /(subsetP (Ohm_sub 1 _))P0x] := setD1P P0_1s_x. -have [Ltype1 | notLtype1] := boolP (FTtype L == 1)%N; last first. - have [U W W1 W2 defW LtypeP] := FTtypeP_witness maxL notLtype1. - suffices sP0H: P0 \subset H. - have [Hx notLtype5] := (subsetP sP0H x P0x, FTtype5_exclusion maxL). - have [_ _ _ tiFL] := compl_of_typeII_IV maxL LtypeP notLtype5. - have Fx: x \in 'F(L)^# by rewrite !inE ntx (subsetP (Fcore_sub_Fitting L)). - by have /idPn[] := cent1_normedTI tiFL Fx; rewrite setTI. - have [/=/FTcore_type2<- // | notLtype2] := boolP (FTtype L == 2). - have [_ _ [Ltype3 galL]] := FTtype34_structure maxL LtypeP notLtype2. - have cycU: cyclic U. - suffices regHU: Ptype_Fcompl_kernel LtypeP :=: 1%g. - rewrite (isog_cyclic (quotient1_isog U)) -regHU. - by have [|_ _ [//]] := typeP_Galois_P maxL _ galL; rewrite (eqP Ltype3). - rewrite /Ptype_Fcompl_kernel unlock /= astabQ /=. - have [_ _ ->] := FTtype34_Fcore_kernel_trivial maxL LtypeP notLtype2. - rewrite -morphpreIim -injm_cent ?injmK ?ker_coset ?norms1 //. - have [_ _ _ ->] := FTtype34_facts maxL LtypeP notLtype2. - by apply/derG1P; have [] := compl_of_typeIII maxL LtypeP Ltype3. - have sP0L': P0 \subset L^`(1) by rewrite -FTcore_type_gt2 ?(eqP Ltype3). - have [_ [_ _ _ defL'] _ _ _] := LtypeP. - have [nsHL' _ /mulG_sub[sHL' _] _ _] := sdprod_context defL'. - have hallH := pHall_subl sHL' (der_sub 1 L) (Fcore_Hall L). - have hallU: \pi(H)^'.-Hall(L^`(1)) U. - by rewrite -(compl_pHall U hallH) sdprod_compl. - rewrite (sub_normal_Hall hallH) // (pi_pgroup pP0) //. - have: ~~ cyclic P0; last apply: contraR => piK'p. - by rewrite abelian_rank1_cyclic // (rank_pgroup pP0) prankP0. - by have [|y _ /cyclicS->] := Hall_psubJ hallU piK'p _ pP0; rewrite ?cyclicJ. -have sP0H: P0 \subset H by rewrite /= -FTcore_type1. -have [U [LtypeF /= LtypeI]] := FTtypeP 1 maxL Ltype1. -have [[_ _ defL] _ _] := LtypeF; have [/=_ sUL _ nHU _] := sdprod_context defL. -have not_tiH: ~ normedTI H^# G L. - have H1x: x \in H^# by rewrite !inE ntx (subsetP sP0H). - by case/cent1_normedTI/(_ x H1x)/idPn; rewrite setTI. -apply/existsP; exists U; have [_ -> _] := typeF_context LtypeF. -apply/forall_inP=> Q /SylowP[q pr_q sylQ]; have [sQU qQ _] := and3P sylQ. -rewrite (odd_pgroup_rank1_cyclic qQ) ?mFT_odd //. -apply: wlog_neg; rewrite -ltnNge => /ltnW; rewrite p_rank_gt0 => piQq. -have hallU: \pi(H)^'.-Hall(L) U. - by rewrite -(compl_pHall U (Fcore_Hall L)) sdprod_compl. -have H'q := pnatPpi (pHall_pgroup hallU) (piSg sQU piQq). -rewrite leqNgt; apply: contra (H'q) => qrankQ; apply: IHp => //; last first. - by rewrite (leq_trans qrankQ) ?p_rankS ?(subset_trans sQU). -have piHp: p \in \pi(H) by rewrite (piSg sP0H) // -p_rank_gt0 prankP0. -have pr_p: prime p by have:= piHp; rewrite mem_primes => /andP[]. -have piUq: q \in \pi(exponent U) by rewrite pi_of_exponent (piSg sQU). -have [odd_p odd_q]: odd p /\ odd q. - rewrite !odd_2'nat !pnatE //. - by rewrite (pnatPpi _ piHp) ?(pnatPpi _ piQq) -?odd_2'nat ?mFT_odd. -have pgt2 := odd_prime_gt2 odd_p pr_p. -suffices [b dv_q_bp]: exists b : bool, q %| (b.*2 + p).-1. - rewrite -ltn_double (@leq_ltn_trans (p + b.*2).-1) //; last first. - by rewrite -!addnn -(subnKC pgt2) prednK // leq_add2l; case: (b). - rewrite -(subnKC pgt2) dvdn_leq // -mul2n Gauss_dvd ?coprime2n // -{1}subn1. - by rewrite dvdn2 odd_sub // subnKC // odd_add odd_p odd_double addnC. -have [// | [cHH rankH] | [/(_ p piHp)Udvp1 _]] := LtypeI; last first. - exists false; apply: dvdn_trans Udvp1. - by have:= piUq; rewrite mem_primes => /and3P[]. -suffices: q %| p ^ 2 - 1 ^ 2. - rewrite subn_sqr addn1 subn1 Euclid_dvdM //. - by case/orP; [exists false | exists true]. -pose P := 'O_p(H); pose P1 := 'Ohm_1(P). -have sylP: p.-Sylow(H) P := nilpotent_pcore_Hall p (Fcore_nil L). -have [sPH pP _] := and3P sylP; have sP1H: P1 \subset H by rewrite 2?gFsub_trans. -have abelP1: p.-abelem P1 by rewrite Ohm1_abelem ?(abelianS sPH). -have prankP1: 'r_p(P1) = 2. - apply/anti_leq; rewrite p_rank_Ohm1 (p_rank_Sylow sylP). - by rewrite -[in (_ <= 2)%N]rankH p_rank_le_rank -prankP0 p_rankS. -have ntP1: P1 != 1%g by rewrite -rank_gt0 ltnW // -prankP1 p_rank_le_rank. -have [_ _ [U0 [sU0U expU0 frobHU0]]] := LtypeF. -have nP1U0: U0 \subset 'N(P1) by rewrite (subset_trans sU0U) 2?gFnorm_trans. -rewrite subn1 -prankP1 p_rank_abelem -?card_pgroup //= -/P1 ?abelem_pgroup //. -have frobP1U0 := Frobenius_subl ntP1 sP1H nP1U0 frobHU0. -apply: dvdn_trans (Frobenius_dvd_ker1 frobP1U0). -by do [rewrite -expU0 pi_of_exponent mem_primes => /and3P[] //] in piUq. -Qed. - -Let Ltype1 : FTtype L == 1%N. Proof. exact: FT_Frobenius_type1 frobL. Qed. -Let defAL : 'A(L) = H^#. Proof. exact: FTsupp_Frobenius frobL. Qed. -Let sP0H : P0 \subset H. Proof. by rewrite /= -FTcore_type1. Qed. - -(* This is the first part of Peterfalvi (12.11). *) -Let defM : K ><| (M :&: L) = M. -Proof. -have [ntx /(subsetP (Ohm_sub 1 _))P0x] := setD1P P0_1s_x. -have Dx: x \in [set y in 'A0(L) | ~~ ('C[y] \subset L)]. - by rewrite inE FTsupp0_type1 // defAL !inE ntx (subsetP sP0H). -have [_ [_ /(_ x Dx)uCx] /(_ x Dx)[[defM _] _ _ _]] := FTsupport_facts maxL. -rewrite /K /= setIC (eq_uniq_mmax uCx maxM) //= -cent_cycle. -exact: subset_trans (cent_sub <[x]>) sNxM. -Qed. - -(* This is the second part of Peterfalvi (12.11). *) -Let sML_H : M :&: L \subset H. -Proof. -have [sP0M pP0 _] := and3P sylP0. -rewrite (sub_normal_Hall (Fcore_Hall L)) ?subsetIr //. -apply/pgroupP=> q pr_q /Cauchy[]// z /setIP[Mz Lz] oz; pose A := <[z]>%G. -have z_gt1: (#[z] > 1)%N by rewrite oz prime_gt1. -have sylP0_HM: p.-Sylow(H :&: M) P0. - by rewrite (pHall_subl _ _ sylP0) ?subsetIr // subsetI sP0H. -have nP0A: A \subset 'N(P0). - have sylHp: p.-Sylow(H) 'O_p(H) := nilpotent_pcore_Hall p (Fcore_nil L). - have sP0Hp: P0 \subset 'O_p(H) by rewrite sub_Hall_pcore. - have <-: 'O_p(H) :&: M = P0. - rewrite [_ :&: _](sub_pHall sylP0_HM) ?setSI ?pcore_sub //. - by rewrite (pgroupS (subsetIl _ _)) ?pcore_pgroup. - by rewrite subsetI sP0Hp. - by rewrite normsI ?gFnorm_trans ?normsG // cycle_subG. -apply: wlog_neg => piH'q. -have coHQ: coprime #|H| #|A| by rewrite -orderE coprime_pi' // oz pnatE. -have frobP0A: [Frobenius P0 <*> A = P0 ><| A]. - have defHA: H ><| A = H <*> A. - by rewrite sdprodEY ?coprime_TIg // cycle_subG (subsetP (gFnorm _ _)). - have ltH_HA: H \proper H <*> A. - by rewrite /proper joing_subl -indexg_gt1 -(index_sdprod defHA). - have: [Frobenius H <*> A = H ><| A]. - apply: set_Frobenius_compl defHA _. - by apply: Frobenius_kerS frobL; rewrite // join_subG gFsub cycle_subG. - by apply: Frobenius_subl => //; rewrite -rank_gt0 (rank_pgroup pP0) prankP0. -have sP0A_M: P0 <*> A \subset M by rewrite join_subG sP0M cycle_subG. -have nKP0a: P0 <*> A \subset 'N(K) := subset_trans sP0A_M (gFnorm _ _). -have solK: solvable K := nilpotent_sol (Fcore_nil M). -have [_ [/(compl_of_typeF defM) MtypeF _]] := FTtypeP 1 maxM Mtype1. -have nreg_KA: 'C_K(A) != 1%g. - have [Kq | K'q] := boolP (q \in \pi(K)). - apply/trivgPn; exists z; rewrite -?order_gt1 //= cent_cycle inE cent1id. - by rewrite andbT (mem_normal_Hall (Fcore_Hall M)) // /p_elt oz pnatE. - have [defP0A ntP0 _ _ _] := Frobenius_context frobP0A. - have coK_P0A: coprime #|K| #|P0 <*> A|. - rewrite -(sdprod_card defP0A) coprime_mulr (p'nat_coprime p'K) //=. - by rewrite -orderE coprime_pi' // oz pnatE. - have: ~~ (P0 \subset 'C(K)); last apply: contraNneq. - have [[ntK _ _] _ [U0 [sU0ML expU0 frobKU0]]] := MtypeF. - have [P1 /pnElemP[sP1U0 abelP1 dimP1]] := p_rank_witness p U0. - have ntP1: P1 :!=: 1%g. - rewrite -rank_gt0 (rank_abelem abelP1) dimP1 p_rank_gt0 -pi_of_exponent. - rewrite expU0 pi_of_exponent (piSg (setIS M (Fcore_sub L))) //=. - by rewrite setIC -p_rank_gt0 -(p_rank_Sylow sylP0_HM) prankP0. - have frobKP1: [Frobenius K <*> P1 = K ><| P1]. - exact: Frobenius_subr ntP1 sP1U0 frobKU0. - have sP1M: P1 \subset M. - by rewrite (subset_trans (subset_trans sP1U0 sU0ML)) ?subsetIl. - have [y My sP1yP0] := Sylow_Jsub sylP0 sP1M (abelem_pgroup abelP1). - apply: contra ntK => cP0K; rewrite -(Frobenius_trivg_cent frobKP1). - rewrite (setIidPl _) // -(conjSg _ _ y) (normsP _ y My) ?gFnorm //. - by rewrite -centJ centsC (subset_trans sP1yP0). - by have [] := Frobenius_Wielandt_fixpoint frobP0A nKP0a coK_P0A solK. -have [_ [U1 [_ abU1 sCK_U1]] _] := MtypeF. -have [ntx /(subsetP (Ohm_sub 1 _))P0x] := setD1P P0_1s_x. -have cAx: A \subset 'C[x]. - rewrite -cent_set1 (sub_abelian_cent2 abU1) //. - have [y /setIP[Ky cAy] nty] := trivgPn _ nreg_KA. - apply: subset_trans (sCK_U1 y _); last by rewrite !inE nty. - by rewrite subsetI sub_cent1 cAy cycle_subG !inE Mz Lz. - have [y /setIP[Ky cxy] notK'y] := subsetPn not_sCxK'. - apply: subset_trans (sCK_U1 y _); last by rewrite !inE (group1_contra notK'y). - rewrite sub1set inE cent1C cxy (subsetP _ x P0x) //. - by rewrite subsetI sP0M (subset_trans sP0H) ?gFsub. -have [_ _ _ regHL] := Frobenius_kerP frobL. -rewrite (piSg (regHL x _)) //; first by rewrite !inE ntx (subsetP sP0H). -by rewrite mem_primes pr_q cardG_gt0 -oz cardSg // subsetI cycle_subG Lz. -Qed. - -Let E := sval (sigW (existsP frobL)). -Let e := #|E|. - -Let defL : H ><| E = L. -Proof. by rewrite /E; case: (sigW _) => E0 /=/Frobenius_context[]. Qed. - -Let Ecyclic_le_p : cyclic E /\ (e %| p.-1) || (e %| p.+1). -Proof. -pose P := 'O_p(H)%G; pose T := 'Ohm_1('Z(P))%G. -have sylP: p.-Sylow(H) P := nilpotent_pcore_Hall p (Fcore_nil L). -have [[sPH pP _] [sP0M pP0 _]] := (and3P sylP, and3P sylP0). -have sP0P: P0 \subset P by rewrite (sub_normal_Hall sylP) ?pcore_normal. -have defP0: P :&: M = P0. - rewrite [P :&: M](sub_pHall sylP0 (pgroupS _ pP)) ?subsetIl ?subsetIr //. - by rewrite subsetI sP0P. -have [ntx P01x] := setD1P P0_1s_x; have P0x := subsetP (Ohm_sub 1 P0) x P01x. -have sZP0: 'Z(P) \subset P0. - apply: subset_trans (_ : 'C_P[x] \subset P0). - by rewrite -cent_set1 setIS ?centS // sub1set (subsetP sP0P). - by rewrite -defP0 setIS // (subset_trans _ sNxM) // cents_norm ?cent_cycle. -have ntT: T :!=: 1%g. - rewrite Ohm1_eq1 center_nil_eq1 ?(pgroup_nil pP) //. - by apply/trivgPn; exists x; rewrite ?(subsetP sP0P). -have [_ sEL _ nHE tiHE] := sdprod_context defL. -have{ntT} [V minV sVT]: {V : {group gT} | minnormal V E & V \subset T}. - by apply: mingroup_exists; rewrite ntT 3?gFnorm_trans. -have abelT: p.-abelem T by rewrite Ohm1_abelem ?center_abelian ?(pgroupS sZP0). -have sTP0: T \subset P0 by apply: gFsub_trans. -have rankT: ('r_p(T) <= 2)%N by rewrite -prankP0 p_rankS. -have [abelV /andP[ntV nVE]] := (abelemS sVT abelT, mingroupp minV). -have pV := abelem_pgroup abelV; have [pr_p _ [n oV]] := pgroup_pdiv pV ntV. -have frobHE: [Frobenius L = H ><| E] by rewrite /E; case: (sigW _). -have: ('r_p(V) <= 2)%N by rewrite (leq_trans (p_rankS p sVT)). -rewrite (p_rank_abelem abelV) // oV pfactorK // ltnS leq_eqVlt ltnS leqn0 orbC. -have sVH: V \subset H by rewrite (subset_trans sVT) 3?gFsub_trans. -have regVE: 'C_E(V) = 1%g. - exact: cent_semiregular (Frobenius_reg_compl frobHE) sVH ntV. -case/pred2P=> dimV; rewrite {n}dimV in oV. - pose f := [morphism of restrm nVE (conj_aut V)]. - have injf: 'injm f by rewrite ker_restrm ker_conj_aut regVE. - rewrite /e -(injm_cyclic injf) // -(card_injm injf) //. - have AutE: f @* E \subset Aut V by rewrite im_restrm Aut_conj_aut. - rewrite (cyclicS AutE) ?Aut_prime_cyclic ?oV // (dvdn_trans (cardSg AutE)) //. - by rewrite card_Aut_cyclic ?prime_cyclic ?oV // totient_pfactor ?muln1. -have defV: V :=: 'Ohm_1(P0). - apply/eqP; rewrite eqEcard (subset_trans sVT) ?OhmS //= oV -prankP0. - by rewrite p_rank_abelian // -card_pgroup ?(pgroupS (Ohm_sub 1 _)). -pose rE := abelem_repr abelV ntV nVE. -have ffulE: mx_faithful rE by apply: abelem_mx_faithful. -have p'E: [char 'F_p]^'.-group E. - rewrite (eq_p'group _ (charf_eq (char_Fp pr_p))) (coprime_p'group _ pV) //. - by rewrite coprime_sym (coprimeSg sVH) ?(Frobenius_coprime frobHE). -have dimV: 'dim V = 2 by rewrite (dim_abelemE abelV) // oV pfactorK. -have cEE: abelian E. - by rewrite dimV in (rE) ffulE; apply: charf'_GL2_abelian (mFT_odd E) ffulE _. -have Enonscalar y: y \in E -> y != 1%g -> ~~ is_scalar_mx (rE y). - move=> Ey; apply: contra => /is_scalar_mxP[a rEy]; simpl in a. - have nXy: y \in 'N(<[x]>). - rewrite !inE -cycleJ cycle_subG; apply/cycleP; exists a. - have [Vx nVy]: x \in V /\ y \in 'N(V) by rewrite (subsetP nVE) ?defV. - apply: (@abelem_rV_inj p _ V); rewrite ?groupX ?memJ_norm ?morphX //=. - by rewrite zmodXgE -scaler_nat natr_Zp -mul_mx_scalar -rEy -abelem_rV_J. - rewrite -in_set1 -set1gE -tiHE inE (subsetP sML_H) //. - by rewrite inE (subsetP sEL) // (subsetP sNxM). -have /trivgPn[y nty Ey]: E != 1%G by have [] := Frobenius_context frobHE. -have cErEy: centgmx rE (rE y). - by apply/centgmxP=> z Ez; rewrite -!repr_mxM // (centsP cEE). -have irrE: mx_irreducible rE by apply/abelem_mx_irrP. -have charFp2: p \in [char MatrixGenField.gen_finFieldType irrE cErEy]. - apply: (rmorph_char (MatrixGenField.gen_rmorphism irrE cErEy)). - exact: char_Fp. -pose Fp2 := primeChar_finFieldType charFp2. -pose n1 := MatrixGenField.gen_dim (rE y). -pose rEp2 : mx_representation Fp2 E n1 := MatrixGenField.gen_repr irrE cErEy. -have n1_gt0: (0 < n1)%N := MatrixGenField.gen_dim_gt0 irrE cErEy. -have n1_eq1: n1 = 1%N. - pose d := degree_mxminpoly (rE y). - have dgt0: (0 < d)%N := mxminpoly_nonconstant _. - apply/eqP; rewrite eqn_leq n1_gt0 andbT -(leq_pmul2r dgt0). - rewrite (MatrixGenField.gen_dim_factor irrE cErEy) mul1n dimV. - by rewrite ltnNge mxminpoly_linear_is_scalar Enonscalar. -have oFp2: #|Fp2| = (p ^ 2)%N. - rewrite card_sub card_matrix card_Fp // -{1}n1_eq1. - by rewrite (MatrixGenField.gen_dim_factor irrE cErEy) dimV. -have [f rfK fK]: bijective (@scalar_mx Fp2 n1). - rewrite n1_eq1. - by exists (fun A : 'M_1 => A 0 0) => ?; rewrite ?mxE -?mx11_scalar. -pose g z : {unit Fp2} := insubd (1%g : {unit Fp2}) (f (rEp2 z)). -have val_g z : z \in E -> (val (g z))%:M = rEp2 z. - move=> Ez; rewrite insubdK ?fK //; have:= repr_mx_unit rEp2 Ez. - by rewrite -{1}[rEp2 z]fK unitmxE det_scalar !unitfE expf_eq0 n1_gt0. -have ffulEp2: mx_faithful rEp2 by rewrite MatrixGenField.gen_mx_faithful. -have gM: {in E &, {morph g: z1 z2 / z1 * z2}}%g. - move=> z1 z2 Ez1 Ez2 /=; apply/val_inj/(can_inj rfK). - rewrite {1}(val_g _ (groupM Ez1 Ez2)) scalar_mxM. - by rewrite {1}(val_g _ Ez1) (val_g _ Ez2) repr_mxM. -have inj_g: 'injm (Morphism gM). - apply/injmP=> z1 z2 Ez1 Ez2 /(congr1 (@scalar_mx _ n1 \o val)). - by rewrite /= {1}(val_g _ Ez1) (val_g _ Ez2); apply: mx_faithful_inj. -split; first by rewrite -(injm_cyclic inj_g) ?field_unit_group_cyclic. -have: e %| #|[set: {unit Fp2}]|. - by rewrite /e -(card_injm inj_g) ?cardSg ?subsetT. -rewrite card_finField_unit oFp2 -!subn1 (subn_sqr p 1) addn1. -rewrite orbC Gauss_dvdr; first by move->. -rewrite coprime_sym coprime_has_primes ?subn_gt0 ?prime_gt1 ?cardG_gt0 //. -apply/hasPn=> r; rewrite /= !mem_primes subn_gt0 prime_gt1 ?cardG_gt0 //=. -case/andP=> pr_r /Cauchy[//|z Ez oz]; rewrite pr_r /= subn1. -apply: contra (Enonscalar z Ez _); last by rewrite -order_gt1 oz prime_gt1. -rewrite -oz -(order_injm inj_g) // order_dvdn -val_eqE => /eqP gz_p1_eq1. -have /vlineP[a Dgz]: val (g z) \in 1%VS. - rewrite Fermat's_little_theorem dimv1 card_Fp //=. - by rewrite -[(p ^ 1)%N]prednK ?prime_gt0 // exprS -val_unitX gz_p1_eq1 mulr1. -apply/is_scalar_mxP; exists a; apply/row_matrixP=> i. -apply: (can_inj ((MatrixGenField.in_genK irrE cErEy) _)). -rewrite !rowE mul_mx_scalar MatrixGenField.in_genZ MatrixGenField.in_genJ //. -rewrite -val_g // Dgz mul_mx_scalar; congr (_ *: _). -rewrite -(natr_Zp a) scaler_nat. -by rewrite -(rmorph_nat (MatrixGenField.gen_rmorphism irrE cErEy)). -Qed. - -Let calS := seqIndD H L H 1. -Notation tauL := (FT_Dade maxL). -Notation tauL_H := (FT_DadeF maxL). -Notation rhoL := (invDade (FT_DadeF_hyp maxL)). - -Section Twelve_13_to_16. - -Variables (tau1 : {additive 'CF(L) -> 'CF(G)}) (chi : 'CF(L)). -Hypothesis cohS : coherent_with calS L^# tauL tau1. -Hypotheses (Schi : chi \in calS) (chi1 : chi 1%g = e%:R). -Let psi := tau1 chi. - -Let cohS_H : coherent_with calS L^# tauL_H tau1. -Proof. -have [? Dtau] := cohS; split=> // xi Sxi; have /zcharD1_seqInd_on Hxi := Sxi. -by rewrite Dtau // FT_DadeF_E ?FT_DadeE ?(cfun_onS (Fcore_sub_FTsupp _)) ?Hxi. -Qed. - -(* This is Peterfalvi (12.14). *) -Let rhoL_psi : {in K, forall g, psi (x * g)%g = chi x} /\ rhoL psi x = chi x. -Proof. -have not_LGM: gval M \notin L :^: G. - apply: contraL p'K => /= /imsetP[z _ ->]; rewrite FcoreJ pgroupJ. - by rewrite p'groupEpi (piSg sP0H) // -p_rank_gt0 prankP0. -pose rmR := sval (Rgen maxL Ltype1). -have Zpsi: psi \in 'Z[rmR chi]. - case: (Rgen _ _) @rmR => /= rmR []; rewrite -/calS => scohS _ _. - have sSS: cfConjC_subset calS calS by apply: seqInd_conjC_subset1. - have [B /mem_subseq sBR Dpsi] := mem_coherent_sum_subseq scohS sSS cohS Schi. - by rewrite [psi]Dpsi big_seq rpred_sum // => xi /sBR/mem_zchar->. -have [ntx /(subsetP (Ohm_sub 1 P0))P0x] := setD1P P0_1s_x. -have Mx: x \in M by rewrite (subsetP sNxM) // -cycle_subG normG. -have psi_xK: {in K, forall g, psi (x * g)%g = psi x}. - move=> g Kg; have{Kg}: (x * g \in x *: K)%g by rewrite mem_lcoset mulKg. - apply: FTtype1_ortho_constant => [phi calMphi|]. - apply/orthoPl=> nu /memv_span; apply: {nu}span_orthogonal (zchar_span Zpsi). - exact: FTtype1_seqInd_ortho. - rewrite inE -/K (contra _ ntx) // => Kx. - rewrite -(consttC p x) !(constt1P _) ?mulg1 ?(mem_p_elt p'K) //. - by rewrite p_eltNK (mem_p_elt (pHall_pgroup sylP0)). -have H1x: x \in H^# by rewrite !inE ntx (subsetP sP0H). -have rhoL_psi_x: rhoL psi x = psi x. - rewrite cfunElock mulrb def_FTsignalizerF H1x //=. - apply: canLR (mulKf (neq0CG _)) _; rewrite mulr_natl -sumr_const /=. - apply: eq_bigr => g; rewrite /'R_L (negPf not_sCxL) /= setIC => /setIP[cxz]. - have Dx: x \in [set y in 'A0(L) | ~~ ('C[y] \subset L)]. - by rewrite inE (subsetP (Fcore_sub_FTsupp0 _)). - have [_ [_ /(_ x Dx)defNx] _] := FTsupport_facts maxL. - rewrite (cent1P cxz) -(eq_uniq_mmax defNx maxM) => [/psi_xK//|]. - by rewrite /= -cent_cycle (subset_trans (cent_sub _)). -suffices <-: rhoL psi x = chi x by split=> // g /psi_xK->. -have irrS: {subset calS <= irr L} by have [] := FT_Frobenius_coherence maxL. -have irr_chi := irrS _ Schi. -have Sgt1: (1 < size calS)%N by apply: seqInd_nontrivial Schi; rewrite ?mFT_odd. -have De: #|L : H| = e by rewrite -(index_sdprod defL). -have [] := Dade_Ind1_sub_lin cohS_H Sgt1 irr_chi Schi; rewrite ?De //. -rewrite -/tauL_H -/calS -/psi /=; set alpha := 'Ind 1 - chi. -case=> o_tau_1 tau_alpha_1 _ [Gamma [o_tau1_Ga _ [a Za tau_alpha] _] _]. -have [[Itau1 _] Dtau1] := cohS_H. -have o1calS: orthonormal calS. - by rewrite (sub_orthonormal irrS) ?seqInd_uniq ?irr_orthonormal. -have norm_alpha: '[tauL_H alpha] = e%:R + 1. - rewrite Dade_isometry ?(cfInd1_sub_lin_on _ Schi) ?De //. - rewrite cfnormBd; last by rewrite cfdotC (seqInd_ortho_Ind1 _ _ Schi) ?conjC0. - by rewrite cfnorm_Ind_cfun1 // De irrWnorm. -pose h := #|H|; have ub_a: a ^+ 2 * ((h%:R - 1) / e%:R) - 2%:R * a <= e%:R - 1. - rewrite -[h%:R - 1](mulKf (neq0CiG L H)) -sum_seqIndC1_square // De -/calS. - rewrite -[lhs in lhs - 1](addrK 1) -norm_alpha -[tauL_H _](subrK 1). - rewrite cfnormDd; last by rewrite cfdotBl tau_alpha_1 cfnorm1 subrr. - rewrite cfnorm1 addrK [in '[_]]addrC {}tau_alpha -!addrA addKr addrCA addrA. - rewrite ler_subr_addr cfnormDd ?ler_paddr ?cfnorm_ge0 //; last first. - rewrite cfdotBl cfdotZl cfdot_suml (orthoPr o_tau1_Ga) ?map_f // subr0. - rewrite big1_seq ?mulr0 // => xi Sxi; rewrite cfdotZl. - by rewrite (orthoPr o_tau1_Ga) ?map_f ?mulr0. - rewrite cfnormB cfnormZ Cint_normK // cfdotZl cfproj_sum_orthonormal //. - rewrite cfnorm_sum_orthonormal // Itau1 ?mem_zchar // irrWnorm ?irrS // divr1. - rewrite chi1 divff ?neq0CG // mulr1 conj_Cint // addrAC mulr_natl. - rewrite !ler_add2r !(mulr_suml, mulr_sumr) !big_seq ler_sum // => xi Sxi. - rewrite irrWnorm ?irrS // !divr1 (mulrAC _^-1) -expr2 -!exprMn (mulrC _^-1). - by rewrite normf_div normr_nat norm_Cnat // (Cnat_seqInd1 Sxi). -have [pr_p p_dv_M]: prime p /\ p %| #|M|. - have: p \in \pi(M) by rewrite -p_rank_gt0 ltnW. - by rewrite mem_primes => /and3P[]. -have odd_p: odd p by rewrite (dvdn_odd p_dv_M) ?mFT_odd. -have pgt2: (2 < p)%N := odd_prime_gt2 odd_p pr_p. -have ub_e: e%:R <= (p%:R + 1) / 2%:R :> algC. - rewrite ler_pdivl_mulr ?ltr0n // -natrM -mulrSr leC_nat muln2. - have [b e_dv_pb]: exists b : bool, e %| (b.*2 + p).-1. - by have [_ /orP[]] := Ecyclic_le_p; [exists false | exists true]. - rewrite -ltnS (@leq_trans (b.*2 + p)) //; last first. - by rewrite (leq_add2r p _ 2) (leq_double _ 1) leq_b1. - rewrite dvdn_double_ltn ?mFT_odd //; first by rewrite odd_add odd_double. - by rewrite -(subnKC pgt2) !addnS. -have lb_h: p%:R ^+ 2 <= h%:R :> algC. - rewrite -natrX leC_nat dvdn_leq ?pfactor_dvdn ?cardG_gt0 //. - by rewrite -prankP0 (leq_trans (p_rankS p sP0H)) ?p_rank_le_logn. -have{ub_a ub_e} ub_a: p.-1.*2%:R * a ^+ 2 - 2%:R * a <= p.-1%:R / 2%:R :> algC. - apply: ler_trans (ler_trans ub_a _); last first. - rewrite -subn1 -subSS natrB ?ltnS ?prime_gt0 // mulrSr mulrBl. - by rewrite divff ?pnatr_eq0 ?ler_add2r. - rewrite ler_add2r mulrC -Cint_normK // -!mulrA !ler_wpmul2l ?normr_ge0 //. - rewrite ler_pdivl_mulr ?gt0CG // ler_subr_addr (ler_trans _ lb_h) //. - rewrite -muln2 natrM -mulrA -ler_subr_addr subr_sqr_1. - rewrite -(natrB _ (prime_gt0 pr_p)) subn1 ler_wpmul2l ?ler0n //. - by rewrite mulrC -ler_pdivl_mulr ?ltr0n. -have a0: a = 0. - apply: contraTeq ub_a => nz_a; rewrite ltr_geF // ltr_pdivr_mulr ?ltr0n //. - rewrite mulrC -{1}mulr_natl -muln2 natrM -mulrA mulrBr mulrCA ltr_subr_addl. - rewrite -ltr_subr_addr -mulrBr mulr_natl mulrA -expr2 -exprMn. - apply: ltr_le_trans (_ : 2%:R * ((a *+ 2) ^+ 2 - 1) <= _); last first. - rewrite (mulr_natl a 2) ler_wpmul2r // ?subr_ge0. - by rewrite sqr_Cint_ge1 ?rpredMn // mulrn_eq0. - by rewrite leC_nat -subn1 ltn_subRL. - rewrite -(@ltr_pmul2l _ 2%:R) ?ltr0n // !mulrA -expr2 mulrBr -exprMn mulr1. - rewrite -natrX 2!mulrnAr -[in rhs in _ < rhs]mulrnAl -mulrnA. - rewrite ltr_subr_addl -ltr_subr_addr -(ltr_add2r 1) -mulrSr -sqrrB1. - rewrite -Cint_normK ?rpredB ?rpredM ?rpred_nat ?rpred1 //. - rewrite (@ltr_le_trans _ (3 ^ 2)%:R) ?ltC_nat // natrX. - rewrite ler_sqr ?qualifE ?ler0n ?normr_ge0 //. - rewrite (ler_trans _ (ler_sub_dist _ _)) // normr1 normrM normr_nat. - by rewrite ler_subr_addl -mulrS mulr_natl ler_pmuln2r ?norm_Cint_ge1. -pose chi0 := 'Ind[L, H] 1. -have defS1: perm_eq (seqIndT H L) (chi0 :: calS). - by rewrite [calS]seqIndC1_rem // perm_to_rem ?seqIndT_Ind1. -have [c _ -> // _] := invDade_seqInd_sum (FT_DadeF_hyp maxL) psi defS1. -have psi_alpha_1: '[psi, tauL_H alpha] = -1. - rewrite tau_alpha a0 scale0r addr0 addrC addrA cfdotBr cfdotDr. - rewrite (orthoPr o_tau_1) ?(orthoPr o_tau1_Ga) ?map_f // !add0r. - by rewrite Itau1 ?mem_zchar ?map_f // irrWnorm ?irrS. -rewrite (bigD1_seq chi) ?seqInd_uniq //= big1_seq => [|xi /andP[chi'xi Sxi]]. - rewrite addr0 -cfdotC chi1 cfInd1 ?gFsub // cfun11 mulr1 De divff ?neq0CG //. - rewrite scale1r -opprB linearN cfdotNr psi_alpha_1 opprK. - by rewrite irrWnorm ?irrS // divr1 mul1r. -rewrite -cfdotC cfInd1 ?gFsub // cfun11 mulr1. -rewrite /chi0 -(canLR (subrK _) (erefl alpha)) scalerDr opprD addrCA -scaleNr. -rewrite linearD linearZ /= cfdotDr cfdotZr psi_alpha_1 mulrN1 rmorphN opprK. -rewrite -/tauL_H -Dtau1 ?zcharD1_seqInd ?(seqInd_sub_lin_vchar _ Schi) ?De //. -have [_ ooS] := orthonormalP o1calS. -rewrite raddfB cfdotBr Itau1 ?mem_zchar // ooS // mulrb ifN_eqC // add0r. -rewrite -De raddfZ_Cnat ?(dvd_index_seqInd1 _ Sxi) // De cfdotZr. -by rewrite Itau1 ?mem_zchar ?ooS // eqxx mulr1 subrr !mul0r. -Qed. - -Let rhoM := invDade (FT_DadeF_hyp maxM). - -Let rhoM_psi : - [/\ {in K^#, rhoM psi =1 psi}, - {in K :\: K' &, forall g1 g2, psi g1 = psi g2} - & {in K :\: K', forall g, psi g \in Cint}]. -Proof. -have pr_p: prime p. - by have:= ltnW prankM; rewrite p_rank_gt0 mem_primes => /andP[]. -have [sP0M pP0 _] := and3P sylP0; have abelP01 := Ohm1_abelem pP0 abP0. -have not_frobM: ~~ [Frobenius M with kernel K]. - apply: contraL prankM => /(set_Frobenius_compl defM)frobM. - rewrite -leqNgt -(p_rank_Sylow sylP0) -p_rank_Ohm1 p_rank_abelem //. - rewrite -abelem_cyclic // (cyclicS (Ohm_sub _ _)) //. - have sP0ML: P0 \subset M :&: L. - by rewrite subsetI sP0M (subset_trans sP0H) ?gFsub. - rewrite nil_Zgroup_cyclic ?(pgroup_nil pP0) // (ZgroupS sP0ML) //. - have [U [MtypeF _]] := FTtypeP 1 maxM Mtype1. - by have{MtypeF} /typeF_context[_ <- _] := compl_of_typeF defM MtypeF. -pose rmR := sval (Rgen maxL Ltype1). -have Zpsi: psi \in 'Z[rmR chi]. - case: (Rgen _ _) @rmR => /= rmR []; rewrite -/calS => scohS _ _. - have sSS: cfConjC_subset calS calS by apply: seqInd_conjC_subset1. - have [B /mem_subseq sBR Dpsi] := mem_coherent_sum_subseq scohS sSS cohS Schi. - by rewrite [psi]Dpsi big_seq rpred_sum // => xi /sBR/mem_zchar->. -have part1: {in K^#, rhoM psi =1 psi}. - move=> g K1g; rewrite /= cfunElock mulrb def_FTsignalizerF K1g //= /'R_M. - have [_ | sCg'M] := ifPn; first by rewrite cards1 big_set1 invr1 mul1r mul1g. - have Dg: g \in [set z in 'A0(M) | ~~ ('C[z] \subset M)]. - by rewrite inE (subsetP (Fcore_sub_FTsupp0 _)). - have [_ [_ /(_ g Dg)maxN] /(_ g Dg)[_ _ ANg Ntype12]] := FTsupport_facts maxM. - have{maxN} [maxN sCgN] := mem_uniq_mmax maxN. - have{Ntype12} Ntype1: FTtype 'N[g] == 1%N. - have [] := Ntype12; rewrite -(mem_iota 1 2) !inE => /orP[// | Ntype2] frobM. - by have /negP[] := not_frobM; apply/frobM/Ntype2. - have not_frobN: ~~ [Frobenius 'N[g] with kernel 'N[g]`_\F]. - apply/Frobenius_kerP=> [[_ _ _ regFN]]. - have [/bigcupP[y]] := setDP ANg; rewrite FTsupp1_type1 Ntype1 //. - by move=> /regFN sCyF /setD1P[ntg cNy_g]; rewrite 2!inE ntg (subsetP sCyF). - have LG'N: gval 'N[g] \notin L :^: G. - by apply: contra not_frobN => /imsetP[y _ ->]; rewrite FcoreJ FrobeniusJker. - suff /(eq_bigr _)->: {in 'C_('N[g]`_\F)[g], forall z, psi (z * g)%g = psi g}. - by rewrite sumr_const -[psi g *+ _]mulr_natl mulKf ?neq0CG. - move=> z /setIP[Fz /cent1P cgz]. - have{Fz cgz}: (z * g \in g *: 'N[g]`_\F)%g by rewrite cgz mem_lcoset mulKg. - apply: FTtype1_ortho_constant => [phi calMphi|]. - apply/orthoPl=> nu /memv_span; apply: span_orthogonal (zchar_span Zpsi). - exact: FTtype1_seqInd_ortho. - have [/(subsetP (FTsupp_sub _))/setD1P[ntg Ng]] := setDP ANg. - by rewrite FTsupp1_type1 //= !inE ntg Ng andbT. -have part2: {in K :\: K' &, forall g1 g2, psi g1 = psi g2}. - have /subsetP sK1_K: K :\: K' \subset K^# by rewrite setDS ?sub1G. - have LG'M: gval M \notin L :^: G. - apply: contra not_frobM => /imsetP[y _ /= ->]. - by rewrite FcoreJ FrobeniusJker. - move=> g1 g2 Kg1 Kg2; rewrite /= -!part1 ?sK1_K //. - apply: FtypeI_invDade_ortho_constant => // phi calMphi. - apply/orthoPl=> nu /memv_span; apply: span_orthogonal (zchar_span Zpsi). - exact: FTtype1_seqInd_ortho. -split=> // g KK'g; pose nKK' : algC := #|K :\: K'|%:R. -pose nK : algC := #|K|%:R; pose nK' : algC := #|K'|%:R. -have nzKK': nKK' != 0 by rewrite pnatr_eq0 cards_eq0; apply/set0Pn; exists g. -have Dpsi_g: nK * '['Res[K] psi, 1] = nK' * '['Res[K'] psi, 1] + nKK' * psi g. - rewrite !mulVKf ?neq0CG // (big_setID K') (setIidPr (gFsub _ _)) /=. - rewrite mulr_natl -sumr_const; congr (_ + _); apply: eq_bigr => z K'z. - by rewrite !cfun1E !cfResE ?subsetT ?(subsetP (der_sub 1 K)) ?K'z. - have [Kz _] := setDP K'z; rewrite cfun1E Kz conjC1 mulr1 cfResE ?subsetT //. - exact: part2. -have{Zpsi} Zpsi: psi \in 'Z[irr G] by have [[_ ->//]] := cohS; apply: mem_zchar. -have Qpsi1 R: '['Res[R] psi, 1] \in Crat. - by rewrite rpred_Cint ?Cint_cfdot_vchar ?rpred1 ?cfRes_vchar. -apply: Cint_rat_Aint (Aint_vchar g Zpsi). -rewrite -[psi g](mulKf nzKK') -(canLR (addKr _) Dpsi_g) addrC mulrC. -by rewrite rpred_div ?rpredB 1?rpredM ?rpred_nat ?Qpsi1. -Qed. - -(* This is the main part of Peterfalvi (12.16). *) -Lemma FTtype1_nonFrobenius_witness_contradiction : False. -Proof. -have pr_p: prime p. - by have:= ltnW prankM; rewrite p_rank_gt0 mem_primes => /andP[]. -have [sP0M pP0 _] := and3P sylP0; have abelP01 := Ohm1_abelem pP0 abP0. -have [ntx P01x] := setD1P P0_1s_x. -have ox: #[x] = p := abelem_order_p abelP01 P01x ntx. -have odd_p: odd p by rewrite -ox mFT_odd. -have pgt2 := odd_prime_gt2 odd_p pr_p. -have Zpsi: psi \in 'Z[irr G] by have [[_ ->//]] := cohS; apply: mem_zchar. -have lb_psiM: '[rhoM psi] >= #|K :\: K'|%:R / #|M|%:R * e.-1%:R ^+ 2. - have [g /setIP[Kg cxg] notK'g] := subsetPn not_sCxK'. - have KK'g: g \in K :\: K' by rewrite !inE notK'g. - have [rhoMid /(_ _ g _ KK'g)psiKK'_id /(_ g KK'g)Zpsig] := rhoM_psi. - rewrite -mulrA mulrCA ler_pmul2l ?invr_gt0 ?gt0CG // mulr_natl. - rewrite (big_setID (K :\: K')) (setIidPr _) ?subDset ?subsetU ?gFsub ?orbT //. - rewrite ler_paddr ?sumr_ge0 // => [z _|]; first exact: mul_conjC_ge0. - rewrite -sumr_const ler_sum // => z KK'z. - rewrite {}rhoMid ?(subsetP _ z KK'z) ?setDS ?sub1G // {}psiKK'_id {z KK'z}//. - rewrite -normCK ler_sqr ?qualifE ?ler0n ?normr_ge0 //. - have [eps prim_eps] := C_prim_root_exists (prime_gt0 pr_p). - have psi_xg: (psi (x * g)%g == e%:R %[mod 1 - eps])%A. - have [-> // _] := rhoL_psi; rewrite -[x]mulg1 -chi1. - rewrite (vchar_ker_mod_prim prim_eps) ?group1 ?(seqInd_vcharW Schi) //. - by rewrite (subsetP _ _ P01x) // gFsub_trans ?(subset_trans sP0H) ?gFsub. - have{psi_xg} /dvdCP[a Za /(canRL (subrK _))->]: (p %| psi g - e%:R)%C. - rewrite (int_eqAmod_prime_prim prim_eps) ?rpredB ?rpred_nat // eqAmod0. - apply: eqAmod_trans psi_xg; rewrite eqAmod_sym. - by rewrite (vchar_ker_mod_prim prim_eps) ?in_setT. - have [-> | nz_a] := eqVneq a 0. - by rewrite mul0r add0r normr_nat leC_nat leq_pred. - rewrite -[e%:R]opprK (ler_trans _ (ler_sub_dist _ _)) // normrN normrM. - rewrite ler_subr_addl !normr_nat -natrD. - apply: ler_trans (_ : 1 * p%:R <= _); last first. - by rewrite ler_wpmul2r ?ler0n ?norm_Cint_ge1. - rewrite mul1r leC_nat -subn1 addnBA ?cardG_gt0 // leq_subLR addnn -ltnS. - have [b e_dv_pb]: exists b : bool, e %| (b.*2 + p).-1. - by have [_ /orP[]] := Ecyclic_le_p; [exists false | exists true]. - apply: (@leq_trans (b.*2 + p)); last first. - by rewrite (leq_add2r p _ 2) (leq_double b 1) leq_b1. - rewrite dvdn_double_ltn ?odd_add ?mFT_odd ?odd_double //. - by rewrite addnC -(subnKC pgt2). -have irrS: {subset calS <= irr L} by have [] := FT_Frobenius_coherence maxL. -have lb_psiL: '[rhoL psi] >= 1 - e%:R / #|H|%:R. - have irr_chi := irrS _ Schi. - have Sgt1: (1 < size calS)%N by apply: seqInd_nontrivial (mFT_odd L) _ Schi. - have De: #|L : H| = e by rewrite -(index_sdprod defL). - have [|_] := Dade_Ind1_sub_lin cohS_H Sgt1 irr_chi Schi; rewrite De //=. - by rewrite -De odd_Frobenius_index_ler ?mFT_odd // => -[_ _ []//]. -have tiA1_LM: [disjoint 'A1~(L) & 'A1~(M)]. - apply: FT_Dade1_support_disjoint => //. - apply: contraL p'K => /= /imsetP[z _ ->]; rewrite FcoreJ pgroupJ. - by rewrite p'groupEpi (piSg sP0H) // -p_rank_gt0 prankP0. -have{tiA1_LM} ub_rhoML: '[rhoM psi] + '[rhoL psi] < 1. - have [[Itau1 Ztau1] _] := cohS. - have n1psi: '[psi] = 1 by rewrite Itau1 ?mem_zchar ?irrWnorm ?irrS. - rewrite -n1psi (cfnormE (cfun_onG psi)) (big_setD1 1%g) ?group1 //=. - rewrite mulrDr ltr_spaddl 1?mulr_gt0 ?invr_gt0 ?gt0CG ?exprn_gt0 //. - have /dirrP[s [i ->]]: psi \in dirr G. - by rewrite dirrE Ztau1 ?mem_zchar ?n1psi /=. - by rewrite cfunE normrMsign normr_gt0 irr1_neq0. - rewrite (big_setID 'A1~(M)) mulrDr ler_add //=. - rewrite FTsupp1_type1 // -FT_DadeF_supportE. - by rewrite (setIidPr _) ?Dade_support_subD1 ?leC_cfnorm_invDade_support. - rewrite (big_setID 'A1~(L)) mulrDr ler_paddr //=. - rewrite mulr_ge0 ?invr_ge0 ?ler0n ?sumr_ge0 // => z _. - by rewrite exprn_ge0 ?normr_ge0. - rewrite (setIidPr _); last first. - by rewrite subsetD tiA1_LM -FT_Dade1_supportE Dade_support_subD1. - by rewrite FTsupp1_type1 // -FT_DadeF_supportE leC_cfnorm_invDade_support. -have ubM: (#|M| <= #|K| * #|H|)%N. - by rewrite -(sdprod_card defM) leq_mul // subset_leq_card. -have{lb_psiM lb_psiL ub_rhoML ubM} ubK: (#|K / K'|%g < 4)%N. - rewrite card_quotient ?gFnorm -?ltC_nat //. - rewrite -ltf_pinv ?qualifE ?gt0CiG ?ltr0n // natf_indexg ?gFsub //. - rewrite invfM invrK mulrC -(subrK #|K|%:R #|K'|%:R) mulrDl divff ?neq0CG //. - rewrite -opprB mulNr addrC ltr_subr_addl -ltr_subr_addr. - have /Frobenius_context[_ _ ntE _ _] := set_Frobenius_compl defL frobL. - have egt2: (2 < e)%N by rewrite odd_geq ?mFT_odd ?cardG_gt1. - have e1_gt0: 0 < e.-1%:R :> algC by rewrite ltr0n -(subnKC egt2). - apply: ltr_le_trans (_ : e%:R / e.-1%:R ^+ 2 <= _). - rewrite ltr_pdivl_mulr ?exprn_gt0 //. - rewrite -(@ltr_pmul2r _ #|H|%:R^-1) ?invr_gt0 ?gt0CG // mulrAC. - rewrite -(ltr_add2r 1) -ltr_subl_addl -addrA. - apply: ler_lt_trans ub_rhoML; rewrite ler_add //. - apply: ler_trans lb_psiM; rewrite -natrX ler_wpmul2r ?ler0n //. - rewrite cardsD (setIidPr _) ?gFsub // -natrB ?subset_leq_card ?gFsub //. - rewrite -mulrA ler_wpmul2l ?ler0n //. - rewrite ler_pdivr_mulr ?gt0CG // ler_pdivl_mull ?gt0CG //. - by rewrite ler_pdivr_mulr ?gt0CG // mulrC -natrM leC_nat. - rewrite -(ler_pmul2l (gt0CG E)) -/e mulrA -expr2 invfM -exprMn. - apply: ler_trans (_ : (1 + 2%:R^-1) ^+ 2 <= _). - rewrite ler_sqr ?rpred_div ?rpredD ?rpred1 ?rpredV ?rpred_nat //. - rewrite -{1}(ltn_predK egt2) mulrSr mulrDl divff ?gtr_eqF // ler_add2l. - rewrite ler_pdivr_mulr // ler_pdivl_mull ?ltr0n //. - by rewrite mulr1 leC_nat -(subnKC egt2). - rewrite -(@ler_pmul2r _ (2 ^ 2)%:R) ?ltr0n // {1}natrX -exprMn -mulrA. - rewrite mulrDl mulrBl !mul1r !mulVf ?pnatr_eq0 // (mulrSr _ 3) addrK. - by rewrite -mulrSr ler_wpmul2r ?ler0n ?ler_nat. -have [U [MtypeF _]] := FTtypeP 1 maxM Mtype1. -have{U MtypeF} [_ _ [U0 [sU0ML expU0 frobU0]]] := compl_of_typeF defM MtypeF. -have [/sdprodP[_ _ nKU0 tiKU0] ntK _ _ _] := Frobenius_context frobU0. -have nK'U0: U0 \subset 'N(K') by apply: gFnorm_trans. -have frobU0K': [Frobenius K <*> U0 / K' = (K / K') ><| (U0 / K')]%g. - have solK: solvable K by rewrite ?nilpotent_sol ?Fcore_nil. - rewrite Frobenius_proper_quotient ?(sol_der1_proper solK) // /(_ <| _). - by rewrite (subset_trans (der_sub 1 _)) ?joing_subl // join_subG gFnorm. -have isoU0: U0 \isog U0 / K'. - by rewrite quotient_isog //; apply/trivgP; rewrite -tiKU0 setSI ?gFsub. -have piU0p: p \in \pi(U0 / K')%g. - rewrite /= -(card_isog isoU0) -pi_of_exponent expU0 pi_of_exponent. - rewrite mem_primes pr_p cardG_gt0 /= -ox order_dvdG // (subsetP _ _ P01x) //. - by rewrite gFsub_trans // subsetI sP0M (subset_trans sP0H) ?gFsub. -have /(Cauchy pr_p)[z U0z oz]: p %| #|U0 / K'|%g. - by do [rewrite mem_primes => /and3P[]//] in piU0p. -have frobKz: [Frobenius (K / K') <*> <[z]> = (K / K') ><| <[z]>]%g. - rewrite (Frobenius_subr _ _ frobU0K') ?cycle_subG //. - by rewrite cycle_eq1 -order_gt1 oz ltnW. -have: p %| #|K / K'|%g.-1 by rewrite -oz (Frobenius_dvd_ker1 frobKz) //. -have [_ ntKK' _ _ _] := Frobenius_context frobKz. -rewrite -subn1 gtnNdvd ?subn_gt0 ?cardG_gt1 // subn1 prednK ?cardG_gt0 //. -by rewrite -ltnS (leq_trans ubK). -Qed. - -End Twelve_13_to_16. - -Lemma FTtype1_nonFrobenius_contradiction : False. -Proof. -have [_ [tau1 cohS]] := FT_Frobenius_coherence maxL frobL. -have [chi] := FTtype1_ref_irr maxL; rewrite -(index_sdprod defL). -exact: FTtype1_nonFrobenius_witness_contradiction cohS. -Qed. - -End Twelve_8_to_16. - -(* This is Peterfalvi, Theorem (12.7). *) -Theorem FTtype1_Frobenius M : - M \in 'M -> FTtype M == 1%N -> [Frobenius M with kernel M`_\F]. -Proof. -set K := M`_\F => maxM Mtype1; have [U [MtypeF _]] := FTtypeP 1 maxM Mtype1. -have hallU: \pi(K)^'.-Hall(M) U. - by rewrite -(compl_pHall U (Fcore_Hall M)) sdprod_compl; have [[]] := MtypeF. -apply: FrobeniusWker (U) _ _; have{MtypeF} [_ -> _] := typeF_context MtypeF. -apply/forall_inP=> P /SylowP[p _ sylP]. -rewrite (odd_pgroup_rank1_cyclic (pHall_pgroup sylP)) ?mFT_odd // leqNgt. -apply/negP=> prankP. -have piUp: p \in \pi(U) by rewrite -p_rank_gt0 -(p_rank_Sylow sylP) ltnW. -have{piUp} K'p: p \in \pi(K)^' := pnatPpi (pHall_pgroup hallU) piUp. -have{U hallU sylP} sylP: p.-Sylow(M) P := subHall_Sylow hallU K'p sylP. -have{P sylP prankP} prankM: (1 < 'r_p(M))%N by rewrite -(p_rank_Sylow sylP). -case/negP: K'p => /=; move: {2}p.+1 (ltnSn p) => n ltpn. -elim: n => // n IHn in p M @K ltpn maxM Mtype1 prankM *. -move: ltpn; rewrite ltnS leq_eqVlt => /predU1P[Dp | /IHn-> //]. -apply/idPn=> p'K; rewrite -p'groupEpi /= -/K -{n}Dp in p'K IHn. -have [P sylP] := Sylow_exists p M. -case/non_Frobenius_FTtype1_witness: (sylP) => // cPP prankP [L [maxL sPLs]]. -by case=> x P1s_x []; apply: (FTtype1_nonFrobenius_contradiction IHn) P1s_x. -Qed. - -(* This is Peterfalvi, Theorem (12.17). *) -Theorem not_all_FTtype1 : ~~ all_FTtype1 gT. -Proof. -apply/negP=> allT1; pose k := #|'M^G|. -have [partGpi coA1 _ [injA1 /(_ allT1)partG _]] := FT_Dade_support_partition gT. -move/forall_inP in allT1. -have [/subsetP maxMG _ injMG exMG] := mmax_transversalP gT. -have{partGpi exMG} kge2: (k >= 2)%N. - have [L MG_L]: exists L, L \in 'M^G. - by have [L maxL] := any_mmax gT; have [x] := exMG L maxL; exists (L :^ x)%G. - have maxL := maxMG L MG_L; have Ltype1 := allT1 L maxL. - have /Frobenius_kerP[_ ltHL nsHL _] := FTtype1_Frobenius maxL Ltype1. - rewrite ltnNge; apply: contra (proper_subn ltHL) => leK1. - rewrite (sub_normal_Hall (Fcore_Hall L)) // (pgroupS (subsetT L)) //=. - apply: sub_pgroup (pgroup_pi _) => p; rewrite partGpi => /exists_inP[M maxM]. - have /eqP defMG: [set L] == 'M^G by rewrite eqEcard sub1set MG_L cards1. - have [x] := exMG M maxM; rewrite -defMG => /set1P/(canRL (actK 'JG _))-> /=. - by rewrite FTcoreJ cardJg FTcore_type1. -pose L (i : 'I_k) : {group gT} := enum_val i; pose H i := (L i)`_\F%G. -have MG_L i: L i \in 'M^G by apply: enum_valP. -have maxL i: L i \in 'M by apply: maxMG. -have defH i: (L i)`_\s = H i by rewrite FTcore_type1 ?allT1. -pose frobL_P i E := [Frobenius L i = H i ><| gval E]. -have /fin_all_exists[E frobHE] i: exists E, frobL_P i E. - by apply/existsP/FTtype1_Frobenius; rewrite ?allT1. -have frobL i: [/\ L i \subset G, solvable (L i) & frobL_P i (E i)]. - by rewrite subsetT mmax_sol. -have{coA1} coH_ i j: i != j -> coprime #|H i| #|H j|. - move=> j'i; rewrite -!defH coA1 //; apply: contra j'i => /imsetP[x Gx defLj]. - apply/eqP/enum_val_inj; rewrite -/(L i) -/(L j); apply: injMG => //. - by rewrite defLj; apply/esym/orbit_act. -have tiH i: normedTI (H i)^# G (L i). - have ntA: (H i)^# != set0 by rewrite setD_eq0 subG1 mmax_Fcore_neq1. - apply/normedTI_memJ_P=> //=; rewrite subsetT; split=> // x z H1x Gz. - apply/idP/idP=> [H1xz | Lz]; last first. - by rewrite memJ_norm // (subsetP _ z Lz) // normD1 gFnorm. - have /subsetP sH1A0: (H i)^# \subset 'A0(L i) by apply: Fcore_sub_FTsupp0. - have [/(sub_in2 sH1A0)wccH1 [_ maxN] Nfacts] := FTsupport_facts (maxL i). - suffices{z Gz H1xz wccH1} sCxLi: 'C[x] \subset L i. - have /imsetP[y Ly defxz] := wccH1 _ _ H1x H1xz (mem_imset _ Gz). - rewrite -[z](mulgKV y) groupMr // (subsetP sCxLi) // !inE conjg_set1. - by rewrite conjgM defxz conjgK. - apply/idPn=> not_sCxM; pose D := [set y in 'A0(L i) | ~~ ('C[y] \subset L i)]. - have Dx: x \in D by rewrite inE sH1A0. - have{maxN} /mem_uniq_mmax[maxN sCxN] := maxN x Dx. - have Ntype1 := allT1 _ maxN. - have [_ _ /setDP[/bigcupP[y NFy /setD1P[ntx cxy]] /negP[]]] := Nfacts x Dx. - rewrite FTsupp1_type1 Ntype1 // in NFy cxy *. - have /Frobenius_kerP[_ _ _ regFN] := FTtype1_Frobenius maxN Ntype1. - by rewrite 2!inE ntx (subsetP (regFN y NFy)). -have /negP[] := no_coherent_Frobenius_partition (mFT_odd _) kge2 frobL tiH coH_. -rewrite eqEsubset sub1set !inE andbT; apply/andP; split; last first. - apply/bigcupP=> [[i _ /imset2P[x y /setD1P[ntx _] _ Dxy]]]. - by rewrite -(conjg_eq1 x y) -Dxy eqxx in ntx. -rewrite subDset setUC -subDset -(cover_partition partG). -apply/bigcupsP=> _ /imsetP[Li MG_Li ->]; pose i := enum_rank_in MG_Li Li. -rewrite (bigcup_max i) //=; have ->: Li = L i by rewrite /L enum_rankK_in. -rewrite -FT_Dade1_supportE //; apply/bigcupsP=> x A1x; apply: imset2S => //. -move: (FT_Dade1_hyp _) (tiH i); rewrite -defH => _ /Dade_normedTI_P[_ -> //]. -by rewrite mul1g sub1set -/(H i) -defH. -Qed. - -End PFTwelve. diff --git a/mathcomp/odd_order/PFsection13.v b/mathcomp/odd_order/PFsection13.v deleted file mode 100644 index 339df0f..0000000 --- a/mathcomp/odd_order/PFsection13.v +++ /dev/null @@ -1,2199 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div choice. -From mathcomp -Require Import fintype tuple finfun bigop prime binomial ssralg poly finset. -From mathcomp -Require Import fingroup morphism perm automorphism quotient action finalg zmodp. -From mathcomp -Require Import gfunctor gproduct center cyclic commutator gseries nilpotent. -From mathcomp -Require Import pgroup sylow hall abelian maximal frobenius. -From mathcomp -Require Import matrix mxalgebra mxrepresentation mxabelem vector. -From mathcomp -Require Import BGsection1 BGsection3 BGsection7. -From mathcomp -Require Import BGsection14 BGsection15 BGsection16. -From mathcomp -Require Import ssrnum rat algC cyclotomic algnum. -From mathcomp -Require Import classfun character integral_char inertia vcharacter. -From mathcomp -Require Import PFsection1 PFsection2 PFsection3 PFsection4. -From mathcomp -Require Import PFsection5 PFsection6 PFsection7 PFsection8 PFsection9. -From mathcomp -Require Import PFsection10 PFsection11 PFsection12. - -(******************************************************************************) -(* This file covers Peterfalvi, Section 13: The Subgroups S and T. *) -(* The following definitions will be used in PFsection14: *) -(* FTtypeP_bridge StypeP j == a virtual character of S that mixes characters *) -(* (locally) beta_ j, betaS that do and do not contain P = S`_\F in their *) -(* kernels, for StypeP : of_typeP S U defW. *) -(* := 'Ind[S, P <*> W1] 1 - mu2_ 0 j. *) -(* FTtypeP_bridge_gap StypeP == the difference between the image of beta_ j *) -(* (locally) Gamma, GammaS under the Dade isometry for S, and its natural *) -(* value, 1 - eta_ 0 j (this does not actually *) -(* depend on j != 0). *) -(* The following definitions are only used locally across sections: *) -(* #1 == the irreducible index 1 (i.e., inord 1). *) -(* irr_Ind_Fittinq S chi <=> chi is an irreducible character of S induced *) -(* (locally) irrIndH from an irreducible character of 'F(S) (which *) -(* will be linear here, as 'F(S) is abelian). *) -(* typeP_TIred_coherent StypeP tau1 <=> tau1 maps the reducible induced *) -(* characters mu_ j of a type P group S, which are *) -(* the image under the cyclic TI isometry to S of *) -(* row sums of irreducibles of W = W1 x W2, to *) -(* the image of that sum under the cyclic TI *) -(* isometry to G (except maybe for a sign change *) -(* if p = #|W2| = 3). *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope GRing.Theory FinRing.Theory Num.Theory. - -Section Thirteen. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). -Implicit Types (p q : nat) (x y z : gT). -Implicit Types H K L N P Q R S T U W : {group gT}. - -Definition irr_Ind_Fitting S := [predI irr S & seqIndT 'F(S) S]. - -Local Notation irrIndH := (irr_Ind_Fitting _). -Local Notation "#1" := (inord 1) (at level 0). - -Section Thirteen_2_3_5_to_9. - -(* These assumptions correspond to the part of Peterfalvi, Hypothesis (13.1) *) -(* that is used to prove (13.2-3) and (13.5-9). Because of the shortcomings *) -(* of Coq's Section and Module features we will need to repeat most of these *) -(* assumptions twice down this file to exploit the symmetry between S and T. *) -(* We anticipate the use of the letter 'H' to designate the Fitting group *) -(* of S, which Peterfalvi does only locally in (13.5-9), in order not to *) -(* conflict with (13.17-19), where H denotes the F-core of a Frobenius group. *) -(* This is not a problem for us, since these lemmas will only appear in the *) -(* last section of this file, and we will have no use for H at that point *) -(* since we will have shown in (13.12) that H coincides with P = S`_\F. *) - -Variables S U W W1 W2 : {group gT}. -Hypotheses (maxS : S \in 'M) (defW : W1 \x W2 = W). -Hypotheses (StypeP : of_typeP S U defW). - -Local Notation "` 'W1'" := (gval W1) (at level 0, only parsing) : group_scope. -Local Notation "` 'W2'" := (gval W2) (at level 0, only parsing) : group_scope. -Local Notation "` 'W'" := (gval W) (at level 0, only parsing) : group_scope. -Local Notation V := (cyclicTIset defW). - -Local Notation "` 'S'" := (gval S) (at level 0, only parsing) : group_scope. -Local Notation P := `S`_\F%G. -Local Notation "` 'P'" := `S`_\F (at level 0) : group_scope. -Local Notation PU := S^`(1)%G. -Local Notation "` 'PU'" := `S^`(1) (at level 0) : group_scope. -Local Notation "` 'U'" := (gval U) (at level 0, only parsing) : group_scope. -Local Notation C := 'C_U(`P)%G. -Local Notation "` 'C'" := 'C_`U(`P) (at level 0) : group_scope. -Local Notation H := 'F(S)%G. -Local Notation "` 'H'" := 'F(`S) (at level 0) : group_scope. - -Let defS : PU ><| W1 = S. Proof. by have [[]] := StypeP. Qed. -Let defPU : P ><| U = PU. Proof. by have [_ []] := StypeP. Qed. -Let defH : P \x C = H. Proof. by have [] := typeP_context StypeP. Qed. - -Let notStype1 : FTtype S != 1%N. Proof. exact: FTtypeP_neq1 StypeP. Qed. -Let notStype5 : FTtype S != 5%N. Proof. exact: FTtype5_exclusion maxS. Qed. - -Let pddS := FT_prDade_hypF maxS StypeP. -Let ptiWS : primeTI_hypothesis S PU defW := FT_primeTI_hyp StypeP. -Let ctiWG : cyclicTI_hypothesis G defW := pddS. - -Let ntW1 : W1 :!=: 1. Proof. by have [[]] := StypeP. Qed. -Let ntW2 : W2 :!=: 1. Proof. by have [_ _ _ []] := StypeP. Qed. -Let cycW1 : cyclic W1. Proof. by have [[]] := StypeP. Qed. -Let cycW2 : cyclic W2. Proof. by have [_ _ _ []] := StypeP. Qed. - -Let p := #|W2|. -Let q := #|W1|. -Let c := #|C|. -Let u := #|U : C|. - -Let oU : #|U| = (u * c)%N. Proof. by rewrite mulnC Lagrange ?subsetIl. Qed. - -Let pr_p : prime p. Proof. by have [] := FTtypeP_primes maxS StypeP. Qed. -Let pr_q : prime q. Proof. by have [] := FTtypeP_primes maxS StypeP. Qed. - -Let qgt2 : q > 2. Proof. by rewrite odd_gt2 ?mFT_odd ?cardG_gt1. Qed. -Let pgt2 : p > 2. Proof. by rewrite odd_gt2 ?mFT_odd ?cardG_gt1. Qed. - -Let coPUq : coprime #|PU| q. -Proof. by rewrite (coprime_sdprod_Hall_r defS); have [[]] := StypeP. Qed. - -Let nirrW1 : #|Iirr W1| = q. Proof. by rewrite card_Iirr_cyclic. Qed. -Let nirrW2 : #|Iirr W2| = p. Proof. by rewrite card_Iirr_cyclic. Qed. -Let NirrW1 : Nirr W1 = q. Proof. by rewrite -nirrW1 card_ord. Qed. -Let NirrW2 : Nirr W2 = p. Proof. by rewrite -nirrW2 card_ord. Qed. - -Local Open Scope ring_scope. - -Let sigma := (cyclicTIiso ctiWG). -Let w_ i j := (cyclicTIirr defW i j). -Local Notation eta_ i j := (sigma (w_ i j)). - -Local Notation Imu2 := (primeTI_Iirr ptiWS). -Let mu2_ i j := primeTIirr ptiWS i j. -Let mu_ := primeTIred ptiWS. -Local Notation chi_ j := (primeTIres ptiWS j). - -Local Notation Idelta := (primeTI_Isign ptiWS). -Local Notation delta_ j := (primeTIsign ptiWS j). - -Local Notation tau := (FT_Dade0 maxS). -Local Notation "chi ^\tau" := (tau chi). - -Let calS0 := seqIndD PU S S`_\s 1. -Let rmR := FTtypeP_coh_base maxS StypeP. -Let scohS0 : subcoherent calS0 tau rmR. -Proof. exact: FTtypeP_subcoherent StypeP. Qed. - -Let calS := seqIndD PU S P 1. -Let sSS0 : cfConjC_subset calS calS0. -Proof. exact/seqInd_conjC_subset1/Fcore_sub_FTcore. Qed. - -Local Notation type34ker1 := (FTtype34_Fcore_kernel_trivial maxS StypeP). -Local Notation type34facts := (FTtype34_structure maxS StypeP). -Local Notation type2facts := (FTtypeII_prime_facts maxS StypeP). -Local Notation compl2facts := (compl_of_typeII maxS StypeP). -Local Notation compl3facts := (compl_of_typeIII maxS StypeP). - -Local Notation H0 := (Ptype_Fcore_kernel StypeP). - -Lemma Ptype_factor_prime : pdiv #|P / H0|%g = p. -Proof. exact: def_Ptype_factor_prime. Qed. -Local Notation pHbar_p := Ptype_factor_prime. - -Lemma Ptype_Fcore_kernel_trivial : H0 :=: 1%g. -Proof. -have [/type2facts[_ oP _]| /type34ker1[]//] := boolP (FTtype S == 2). -have [/and3P[]] := Ptype_Fcore_kernel_exists maxS StypeP notStype5. -case/maxgroupp/andP=> /proper_sub-sH0P nH0S /subset_trans/(_ nH0S)nH0P _ _. -apply: card1_trivg; rewrite -(divg_indexS sH0P) -card_quotient //. -have [_ _ ->] := Ptype_Fcore_factor_facts maxS StypeP notStype5. -by rewrite pHbar_p -{}oP divnn ?cardG_gt0. -Qed. -Local Notation H0_1 := Ptype_Fcore_kernel_trivial. - -Lemma Ptype_Fcompl_kernel_cent : Ptype_Fcompl_kernel StypeP :=: C. -Proof. -rewrite [Ptype_Fcompl_kernel StypeP]unlock /= (group_inj H0_1). -by rewrite astabQ -morphpreIim -injm_cent ?injmK ?ker_coset ?norms1. -Qed. -Local Notation CHbar_C := Ptype_Fcompl_kernel_cent. - -(* This is Peterfalvi (13.2). *) -Lemma FTtypeP_facts : - [/\ (*a*) [/\ pred2 2 3 (FTtype S), q < p -> FTtype S == 2, - [Frobenius U <*> W1 = U ><| W1] & abelian U], - (*b*) p.-abelem P /\ #|P| = p ^ q, - (*c*) u <= (p ^ q).-1 %/ p.-1, - (*d*) coherent calS S^# tau - & (*e*) normedTI 'A0(S) G S /\ {in 'CF(S, 'A0(S)), tau =1 'Ind}]%N. -Proof. -have type23: pred2 2 3 (FTtype S). - by rewrite /= -implyNb; apply/implyP=> /type34facts[_ _ [->]]. -have [_ ntU _ tiFS] := compl_of_typeII_IV maxS StypeP notStype5. -have [_ /mulG_sub[_ sUPU] nPU tiPU] := sdprodP defPU. -have cUU: abelian U by case/orP: type23 => [/compl2facts | /compl3facts] [_ ->]. -split. -- split=> //; last exact: Ptype_compl_Frobenius StypeP _. - by rewrite ltnNge; apply: contraR => /type34facts[_ /ltnW]. -- by have [/type2facts[] | /type34ker1[]] := boolP (FTtype S == 2). -- have ->: u = #|U / C|%g by rewrite card_quotient ?normsI ?normG ?norms_cent. - have p1gt0: (0 < p.-1)%N by rewrite -(subnKC pgt2). - have [/typeP_Galois_P[]| /typeP_Galois_Pn[]]// := boolP (typeP_Galois StypeP). - move=> _ _ [_ _]; rewrite pHbar_p CHbar_C // -/u -/q; apply: dvdn_leq. - by rewrite divn_gt0 // -!subn1 leq_sub2r // (leq_exp2l 1) ltnW // ltnW. - rewrite -/q CHbar_C pHbar_p => H1 [_ _ _ _ [agt1 a_dv_p1 _ [V /card_isog->]]]. - apply: leq_trans (_ : p.-1 ^ q.-1 <= _)%N; last first. - have ltp1q: (p.-1 ^ q < p ^ q)%N by rewrite ltn_exp2r ?prednK // 2?ltnW. - by rewrite leq_divRL // -expnSr (ltn_predK qgt2) -ltnS (ltn_predK ltp1q). - rewrite dvdn_leq ?expn_gt0 ?p1gt0 // (dvdn_trans (cardSg (subsetT V))) //. - by rewrite cardsT card_matrix mul1n dvdn_exp2r //= card_ord Zp_cast. -- have:= Ptype_core_coherence maxS StypeP notStype5; rewrite H0_1 CHbar_C. - by rewrite (derG1P (abelianS _ cUU)) ?subsetIl ?(group_inj (joing1G _)). -have ntA0: 'A0(S) != set0 := FTsupp0_neq0 maxS. -suffices tiA0: normedTI 'A0(S) G S by split=> //; apply: Dade_Ind. -apply/normedTI_memJ_P=> //; rewrite subsetT; split=> // x g A0x Gg. -apply/idP/idP=> [A0xg | /(subsetP (FTsupp0_norm S))/memJ_norm->//]. -apply/idPn=> S'g; have Dx: x \in [set y in 'A0(S) | ~~ ('C[y] \subset S)]. - rewrite inE A0x; have [_ _ [_ _ _ wccA0 _] _] := pddS. - have /imsetP[y Sy Dxy]: x ^ g \in x ^: S by rewrite wccA0 // mem_orbit. - apply/subsetPn; exists (g * y^-1)%g; last by rewrite groupMr ?groupV. - by rewrite !inE conjg_set1 conjgM Dxy conjgK. -have [_ [_ /(_ x Dx) defL] /(_ x Dx)[_ _]] := FTsupport_facts maxS. -have{defL} [maxL _] := mem_uniq_mmax defL; set L := 'N[x] in maxL *. -rewrite -mem_iota !inE => ALx [/orP[Ltype1 _ | Ltype2]]; last first. - by case/(_ _)/existsP=> // ? /Frobenius_of_typeF/(typePF_exclusion StypeP). -have /Frobenius_kerP[_ _ _ regLF_L] := FTtype1_Frobenius maxL Ltype1. -case/andP: ALx => A1'x /bigcupP[z A1z /setD1P[ntx cLz_z]]; case/negP: A1'x. -rewrite ntx /'A1(L) -(Fcore_eq_FTcore _ _) ?(eqP Ltype1) //= in cLz_z A1z *. -exact: subsetP (regLF_L z A1z) _ cLz_z. -Qed. - -Lemma FTseqInd_TIred j : j != 0 -> mu_ j \in calS. -Proof. -move=> nz_j; rewrite -[mu_ j]cfInd_prTIres mem_seqInd ?gFnormal ?normal1 //=. -by rewrite !inE sub1G (cfker_prTIres pddS). -Qed. - -Lemma FTtypeP_Fitting_abelian : abelian H. -Proof. -rewrite -(dprodW defH) abelianM subsetIr. -have [[_ _ _ cUU] [/abelem_abelian-> _] _ _ _] := FTtypeP_facts. -by rewrite (abelianS _ cUU) ?subsetIl. -Qed. -Hint Resolve FTtypeP_Fitting_abelian. - -Local Notation calH := (seqIndT H S). - -Lemma FTtypeP_Ind_Fitting_1 lambda : lambda \in calH -> lambda 1%g = (u * q)%:R. -Proof. -case/seqIndP=> i _ ->; rewrite cfInd1 -?divgS ?gFsub //; set theta := 'chi_i. -have Ltheta: theta \is a linear_char by apply/char_abelianP. -rewrite -(sdprod_card defS) -(sdprod_card defPU) -/q -(dprod_card defH) oU. -by rewrite -mulnA divnMl // mulnAC mulnK ?cardG_gt0 // lin_char1 ?mulr1. -Qed. -Local Notation calHuq := FTtypeP_Ind_Fitting_1. - -(* This is Peterfalvi (13.3)(a). *) -Lemma FTprTIred_Ind_Fitting j : j != 0 -> mu_ j \in calH. -Proof. -move=> nz_j; have [//|_ _ _] := typeP_reducible_core_Ind maxS StypeP. -rewrite (group_inj H0_1) CHbar_C -/q /= (dprodWY defH) -/calS => /(_ (mu_ j)). -case=> [|_ _ [_ /lin_char_irr/irrP[r ->] ->]]; last exact: mem_seqIndT. -by rewrite mem_filter /= prTIred_not_irr FTseqInd_TIred. -Qed. -Local Notation Hmu := FTprTIred_Ind_Fitting. - -Lemma FTprTIred1 j : j != 0 -> mu_ j 1%g = (u * q)%:R. -Proof. by move/Hmu/calHuq. Qed. -Local Notation mu1uq := FTprTIred1. - -(* This is the first assertion of Peterfalvi (13.3)(c). *) -Lemma FTprTIsign j : delta_ j = 1. -Proof. -have [[_ _ frobUW1 cUU] _ _ cohS _] := FTtypeP_facts. -have [-> | nz_j] := eqVneq j 0; first exact: prTIsign0. -suffices: (1 == delta_ j %[mod q])%C. - rewrite signrE /eqCmod addrC opprB subrK dvdC_nat. - by case: (Idelta j); rewrite ?subr0 // gtnNdvd. -apply: eqCmod_trans (prTIirr1_mod ptiWS 0 j); rewrite -/(mu2_ 0 j) -/q. -have ->: mu2_ 0 j 1%g = u%:R. - by apply: (mulfI (neq0CG W1)); rewrite -prTIred_1 -/mu_ mu1uq // mulnC natrM. -rewrite eqCmod_sym /eqCmod -(@natrB _ u 1) ?indexg_gt0 // subn1 dvdC_nat. -have nC_UW1: U <*> W1 \subset 'N(C). - have /sdprodP[_ _ nPUW1 _] := Ptype_Fcore_sdprod StypeP. - by rewrite normsI ?norms_cent // join_subG normG; have [_ []] := StypeP. -have coUq: coprime #|U| q by have /sdprod_context[_ /coprimeSg->] := defPU. -have /Frobenius_dvd_ker1: [Frobenius U <*> W1 / C = (U / C) ><| (W1 / C)]. - have [defUW1 _ _ _ _] := Frobenius_context frobUW1. - rewrite Frobenius_coprime_quotient // /normal ?subIset ?joing_subl //. - split=> [|x /(Frobenius_reg_ker frobUW1)->]; last exact: sub1G. - rewrite properEneq subsetIl -CHbar_C andbT. - by have [] := Ptype_Fcore_factor_facts maxS StypeP notStype5. -have [nCU nCW1] := joing_subP nC_UW1; rewrite !card_quotient // -/u. -by rewrite -indexgI setIC setIAC (coprime_TIg coUq) setI1g indexg1. -Qed. -Local Notation delta1 := FTprTIsign. - -(* This is Peterfalvi (13.3)(b). *) -Lemma FTtypeP_no_Ind_Fitting_facts : - ~~ has irrIndH calS -> - [/\ typeP_Galois StypeP, `C = 1%g & u = (p ^ q).-1 %/ p.-1]. -Proof. -move=> noIndH; have [[_ _ _ cUU] _ _ _ _] := FTtypeP_facts. -have [[t []] | [->]] := typeP_reducible_core_cases maxS StypeP notStype5. - rewrite CHbar_C H0_1 (derG1P (abelianS _ cUU)) ?subsetIl //=. - rewrite (group_inj (joing1G 1)) -/calS /= (dprodWY defH) => calSt _. - case=> _ /lin_char_irr/irrP[r ->] Dt; case/hasP: noIndH. - by exists 'chi_t; rewrite //= mem_irr; apply/seqIndP; exists r; rewrite ?inE. -rewrite /= pHbar_p H0_1 oU /c => frobPU _ <- _ /=. -suffices /eqP->: C :==: 1%g by rewrite cards1 muln1. -suffices: 'C_(U / 1)(P / 1) == 1%g. - by rewrite -injm_subcent ?morphim_injm_eq1 ?norms1 ?ker_coset. -have [_ ntP _ _ _] := Frobenius_context frobPU. -by rewrite (cent_semiregular (Frobenius_reg_compl frobPU)). -Qed. - -(* Helper function for (13.3)(c). *) -Let signW2 (b : bool) := iter b (@conjC_Iirr _ W2). - -Let signW2K b : involutive (signW2 b). -Proof. by case: b => //; apply: conjC_IirrK. Qed. - -Let signW2_eq0 b : {mono signW2 b: j / j == 0}. -Proof. by case: b => //; apply: conjC_Iirr_eq0. Qed. - -(* This is a reformulation of the definition condition part of (13.3)(c) that *) -(* better fits its actual use in (13.7), (13.8) and (13.9) (note however that *) -(* the p = 3 part will in fact not be used). *) -Definition typeP_TIred_coherent tau1 := - exists2 b : bool, b -> p = 3 - & forall j, j != 0 -> tau1 (mu_ j) = (-1) ^+ b *: \sum_i eta_ i (signW2 b j). - -(* This is the main part of Peterfalvi (13.3)(c), using the definition above. *) -(* Note that the text glosses over the quantifier inversion in the second use *) -(* of (5.8) in the p = 3 case. We must rule out tau1 (mu_ k) = - tau1 (mu_ j) *) -(* by using the isometry property of tau1 (alternatively, we could use (4.8) *) -(* to compute tau1 (mu_ k) = tau (mu_ k - mu_ j) + tau1 (mu_ j) directly). *) -Lemma FTtypeP_coherence : - exists2 tau1 : {additive 'CF(S) -> 'CF(G)}, - coherent_with calS S^# tau tau1 & typeP_TIred_coherent tau1. -Proof. -have [redS|] := altP (@allP _ [predC irr S] calS). - have [k nz_k] := has_nonprincipal_irr ntW2. - have [_ [tau1 Dtau1]] := uniform_prTIred_coherent pddS nz_k. - set calT := uniform_prTIred_seq pddS k => cohT. - exists tau1; last by exists false => // j _; rewrite /= Dtau1 delta1. - apply: subset_coherent_with cohT => xi Sxi. - have [_ _ /(_ xi)] := typeP_reducible_core_Ind maxS StypeP notStype5. - rewrite (group_inj H0_1) mem_filter redS // => /(_ Sxi)/imageP[j nz_j ->] _. - by rewrite image_f // inE -/mu_ [~~ _]nz_j /= !mu1uq. -rewrite all_predC negbK => /hasP[xi Sxi irr_xi]. -have [_ _ _ [tau1 cohS] _] := FTtypeP_facts; exists tau1 => //. -have [|] := boolP [forall (j | j != 0), tau1 (mu_ j) == \sum_i eta_ i j]. - by move/eqfun_inP=> Dtau1; exists false => // j /Dtau1; rewrite scale1r. -rewrite negb_forall_in => /exists_inP[j nz_j /eqP tau1muj_neq_etaj]. -have:= FTtypeP_coherent_TIred sSS0 cohS irr_xi Sxi (FTseqInd_TIred _). -rewrite -/mu_ -/sigma -/ptiWS => tau1mu; have [dk tau1muj Ddk] := tau1mu j nz_j. -case: Ddk tau1muj => [][-> ->]{dk}; rewrite ?signrN delta1 ?scaleNr scale1r //. -set k := conjC_Iirr j => Dmu tau1muj. -have{Dmu} defIW2 l: l != 0 -> pred2 j k l. - by move=> nz_l; rewrite Dmu ?FTseqInd_TIred ?mu1uq. -have [nz_k j'k]: k != 0 /\ k != j. - rewrite conjC_Iirr_eq0 nz_j -(inj_eq irr_inj) conjC_IirrE. - by rewrite odd_eq_conj_irr1 ?mFT_odd ?irr_eq1. -have /eqP p3: p == 3. - rewrite -nirrW2 (cardD1 0) (cardD1 j) (cardD1 k) !inE nz_j nz_k j'k !eqSS. - by apply/pred0Pn=> [[l /and4P[k'l j'l /defIW2/norP[]]]]. -exists true => // _ /defIW2/pred2P[]->; first by rewrite scaler_sign. -have [[[Itau1 _] _] [d t1muk Dd]] := (cohS, tau1mu k nz_k); move: Dd t1muk. -case=> [][-> ->] => [|_]; rewrite ?signrN delta1 // scale1r. -case/(congr1 (cfdotr (tau1 (mu_ j)) \o -%R))/eqP/idPn => /=. -rewrite -tau1muj cfdotNl eq_sym !Itau1 ?mem_zchar ?FTseqInd_TIred //. -by rewrite !cfdot_prTIred (negPf j'k) eqxx mul1n oppr0 neq0CG. -Qed. - -(* We skip over (13.4), whose proof uses (13.2) and (13.3) for both groups of *) -(* a type P pair. *) - -Let calS1 := seqIndD H S P 1. - -(* Some facts about calS1 used implicitly throughout (13.5-8). *) -Let S1mu j : j != 0 -> mu_ j \in calS1. -Proof. -move=> nz_j; have /seqIndP[s _ Ds] := Hmu nz_j. -rewrite Ds mem_seqInd ?gFnormal ?normal1 // !inE sub1G andbT. -rewrite -(sub_cfker_Ind_irr s (gFsub _ _) (gFnorm _ _)) -Ds /=. -rewrite -[mu_ j](cfInd_prTIres (FT_prDade_hypF maxS StypeP)). -by rewrite sub_cfker_Ind_irr ?cfker_prTIres ?gFsub ?gFnorm. -Qed. - -Let calSirr := [seq phi <- calS | phi \in irr S]. -Let S1cases zeta : - zeta \in calS1 -> {j | j != 0 & zeta = mu_ j} + (zeta \in 'Z[calSirr]). -Proof. -move=> S1zeta; have /sig2_eqW[t /setDP[_ kerP't] Dzeta] := seqIndP S1zeta. -rewrite inE in kerP't; have /mulG_sub[sPH _] := dprodW defH. -have [/andP[sPPU nPPU] sUPU _ _ _] := sdprod_context defPU. -have sHPU: H \subset PU by rewrite /= -(dprodWC defH) mulG_subG subIset ?sUPU. -have [/eqfunP mu'zeta|] := boolP [forall j, '['Ind 'chi_t, chi_ j] == 0]. - right; rewrite Dzeta -(cfIndInd _ _ sHPU) ?gFsub //. - rewrite ['Ind 'chi_t]cfun_sum_constt linear_sum /= rpred_sum // => s tPUs. - rewrite linearZ rpredZ_Cnat ?Cnat_cfdot_char ?cfInd_char ?irr_char //=. - have [[j Ds] | [irr_zeta _]] := prTIres_irr_cases ptiWS s. - by case/eqP: tPUs; rewrite Ds mu'zeta. - rewrite mem_zchar // mem_filter irr_zeta mem_seqInd ?gFnormal ?normal1 //=. - by rewrite !inE sub1G andbT -(sub_cfker_constt_Ind_irr tPUs). -rewrite negb_forall => /existsP/sigW[j]. -rewrite -irr_consttE constt_Ind_Res => jHt. -have nz_j: j != 0; last do [left; exists j => //]. - apply: contraTneq jHt => ->; rewrite prTIres0 rmorph1 -irr0 constt_irr. - by apply: contraNneq kerP't => ->; rewrite irr0 cfker_cfun1. -have /pairwise_orthogonalP[_ ooS1]: pairwise_orthogonal calS1. - by rewrite seqInd_orthogonal ?gFnormal. -rewrite -(cfRes_prTIirr _ 0) cfResRes ?gFsub //= in jHt. -have muj_mu0j: Imu2 (0, j) \in irr_constt (mu_ j). - by rewrite irr_consttE cfdotC cfdot_prTIirr_red eqxx conjC1 oner_eq0. -apply: contraNeq (constt_Res_trans (prTIred_char _ _) muj_mu0j jHt). -by rewrite cfdot_Res_l /= -Dzeta eq_sym => /ooS1-> //; rewrite S1mu. -Qed. - -Let sS1S : {subset calS1 <= 'Z[calS]}. -Proof. -move=> zeta /S1cases[[j nz_j ->]|]; first by rewrite mem_zchar ?FTseqInd_TIred. -by apply: zchar_subset; apply: mem_subseq (filter_subseq _ _). -Qed. - -(* This is Peterfalvi (13.5). *) -(* We have adapted the statement to its actual use by replacing the Dade *) -(* (partial) isometry by a (total) coherent isometry, and strengthening the *) -(* orthogonality condition. This simplifies the assumptions as zeta0 is no *) -(* longer needed. Note that this lemma is only used to establish various *) -(* inequalities (13.6-8) that contribute to (13.10), so it does not need to *) -(* be exported from this section. *) -Let calS1_split1 (tau1 : {additive _}) zeta1 chi : - coherent_with calS S^# tau tau1 -> zeta1 \in calS1 -> chi \in 'Z[irr G] -> - {in calS1, forall zeta, zeta != zeta1 -> '[tau1 zeta, chi] = 0} -> - let a := '[tau1 zeta1, chi] in - exists2 alpha, - alpha \in 'Z[irr H] /\ {subset irr_constt alpha <= Iirr_ker H P} & - [/\ (*a*) {in H^#, forall x, chi x = a / '[zeta1] * zeta1 x + alpha x}, - (*b*) - \sum_(x in H^#) `|chi x| ^+ 2 = - a ^+ 2 / '[zeta1] * (#|S|%:R - zeta1 1%g ^+ 2 / '[zeta1]) - - 2%:R * a * (zeta1 1%g * alpha 1%g / '[zeta1]) - + (\sum_(x in H^#) `|alpha x| ^+ 2) - & (*c*) - \sum_(x in H^#) `|alpha x| ^+ 2 >= #|P|.-1%:R * alpha 1%g ^+ 2]. -Proof. -case=> _ Dtau1 S1zeta1 Zchi o_tau1S_chi a. -have sW2P: W2 \subset P by have [_ _ _ []] := StypeP. -have /mulG_sub[sPH _] := dprodW defH. -have ntH: H :!=: 1%g by apply: subG1_contra ntW2; apply: subset_trans sPH. -have sH1S: H^# \subset G^# by rewrite setSD ?subsetT. -have[nsHS nsPS ns1S]: [/\ H <| S, P <| S & 1 <| S] by rewrite !gFnormal normal1. -have [[sHS nHS] [sPS nPS]] := (andP nsHS, andP nsPS). -have tiH: normedTI H^# G S by have [] := compl_of_typeII_IV maxS StypeP. -have ddH := normedTI_Dade tiH sH1S; have [_ ddH_1] := Dade_normedTI_P ddH tiH. -pose tauH := Dade ddH. -have DtauH: {in 'CF(S, H^#), tauH =1 'Ind} := Dade_Ind ddH tiH. -have sS1H: {subset calS1 <= calH} by apply: seqInd_subT. -pose zeta0 := zeta1^*%CF. -have S1zeta0: zeta0 \in calS1 by rewrite cfAut_seqInd. -have zeta1'0: zeta0 != zeta1. - by rewrite (hasPn (seqInd_notReal _ _ _ _) _ S1zeta1) ?gFnormal ?mFT_odd. -have Hzeta0 := sS1H _ S1zeta0. -have dH_1 zeta: zeta \in calH -> (zeta - zeta0) 1%g == 0. - by move=> Tzeta; rewrite 2!cfunE !calHuq // subrr eqxx. -have H1dzeta zeta: zeta \in calH -> zeta - zeta0 \in 'CF(S, H^#). - have HonH: {subset calH <= 'CF(S, H)} by apply: seqInd_on. - by move=> Hzeta; rewrite cfun_onD1 rpredB ?HonH ?dH_1. -pose calH1 := rem zeta1 (rem zeta0 (filter [mem calS1] calH)). -pose calH2 := filter [predC calS1] calH. -have DcalH: perm_eq calH (zeta0 :: zeta1 :: calH1 ++ calH2). - rewrite -(perm_filterC [mem calS1]) -!cat_cons perm_cat2r. - rewrite (perm_eqlP (@perm_to_rem _ zeta0 _ _)) ?mem_filter /= ?S1zeta0 //. - rewrite perm_cons perm_to_rem // mem_rem_uniq ?filter_uniq ?seqInd_uniq //. - by rewrite !inE mem_filter /= eq_sym zeta1'0 S1zeta1 sS1H. -have{DcalH} [a_ _ Dchi _] := invDade_seqInd_sum ddH chi DcalH. -have Da_ zeta: zeta \in calH -> a_ zeta = '['Ind (zeta - zeta0), chi]. - move=> Tzeta; rewrite /a_ !calHuq // divff ?scale1r; last first. - by rewrite pnatr_eq0 -lt0n muln_gt0 indexg_gt0 cardG_gt0. - by rewrite [Dade _ _]DtauH ?H1dzeta. -have Za_ zeta: zeta \in calH -> a_ zeta \in Cint. - move=> Hzeta; rewrite Da_ // Cint_cfdot_vchar ?cfInd_vchar //. - by rewrite rpredB ?char_vchar ?(seqInd_char Hzeta) ?(seqInd_char Hzeta0). -have{Da_} Da_ zeta: zeta \in calS1 -> a_ zeta = '[tau1 zeta, chi]. - move=> S1zeta; have Hzeta := sS1H _ S1zeta. - rewrite Da_ //; have [_ _ _ _ [_ <-]] := FTtypeP_facts. - rewrite -Dtau1; last by rewrite zcharD1E rpredB ?sS1S ?dH_1. - by rewrite raddfB cfdotBl (o_tau1S_chi zeta0) ?subr0. - by rewrite (cfun_onS (Fitting_sub_FTsupp0 maxS)) ?H1dzeta. -pose alpha := 'Res[H] (\sum_(zeta <- calH2) (a_ zeta)^* / '[zeta] *: zeta). -have{Dchi} Dchi: {in H^#, forall x, chi x = a / '[zeta1] * zeta1 x + alpha x}. - move=> x H1x; have [_ Hx] := setD1P H1x. - transitivity (invDade ddH chi x). - by rewrite cfunElock ddH_1 // big_set1 H1x mul1g cards1 invr1 mul1r. - rewrite cfResE ?gFsub ?Dchi // big_cons conj_Cint ?Za_ ?Da_ ?sS1H //= -/a. - congr (_ + _); rewrite big_cat /= sum_cfunE big1_seq ?add0r //= => [|zeta]. - by apply: eq_bigr => zeta; rewrite cfunE. - rewrite ?(mem_rem_uniq, inE) ?rem_uniq ?filter_uniq ?seqInd_uniq //=. - rewrite mem_filter => /and4P[/= zeta1'z _ S1zeta _]. - by rewrite Da_ ?o_tau1S_chi // conjC0 !mul0r. -have kerHalpha: {subset irr_constt alpha <= Iirr_ker H P}. - move=> s; apply: contraR => kerP's; rewrite [alpha]rmorph_sum cfdot_suml. - rewrite big1_seq // => psi; rewrite mem_filter /= andbC => /andP[]. - case/seqIndP=> r _ ->; rewrite mem_seqInd // !inE sub1G andbT negbK => kerPr. - rewrite cfdot_Res_l cfdotZl mulrC cfdot_sum_irr big1 ?mul0r // => t _. - apply: contraNeq kerP's; rewrite mulf_eq0 fmorph_eq0 inE => /norP[rSt sSt]. - by rewrite (sub_cfker_constt_Ind_irr sSt) -?(sub_cfker_constt_Ind_irr rSt). -have Zalpha: alpha \in 'Z[irr H]. - rewrite [alpha]rmorph_sum big_seq rpred_sum // => zeta; rewrite mem_filter /=. - case/andP=> S1'zeta Tzeta; rewrite linearZ /= -scalerA. - rewrite rpredZ_Cint ?conj_Cint ?Za_ //; have [s _ ->] := seqIndP Tzeta. - rewrite cfResInd_sum_cfclass ?reindex_cfclass -?cfnorm_Ind_irr //=. - rewrite scalerK ?cfnorm_eq0 ?cfInd_eq0 ?irr_neq0 ?irr_char ?gFsub //. - by apply: rpred_sum => i _; apply: irr_vchar. -have{Da_ Za_} Za: a \in Cint by rewrite -[a]Da_ ?Za_ ?sS1H. -exists alpha => //; split=> //. - set a1 := a / _ in Dchi; pose phi := a1 *: 'Res zeta1 + alpha. - transitivity (#|H|%:R * '[phi] - `|phi 1%g| ^+ 2). - rewrite (cfnormE (cfun_onG phi)) mulVKf ?neq0CG // addrC. - rewrite (big_setD1 _ (group1 H)) addKr; apply: eq_bigr => x H1x. - by have [_ Hx] := setD1P H1x; rewrite !cfunE cfResE // Dchi. - have Qa1: a1 \in Creal. - apply: rpred_div; first by rewrite rpred_Cint. - by rewrite rpred_Cnat // Cnat_cfdot_char ?(seqInd_char S1zeta1). - rewrite cfnormDd; last first. - rewrite [alpha]cfun_sum_constt cfdotZl cfdot_sumr big1 ?mulr0 // => s. - move/kerHalpha; rewrite inE cfdotZr mulrC cfdot_Res_l => kerPs. - have [r kerP'r ->] := seqIndP S1zeta1; rewrite cfdot_sum_irr big1 ?mul0r //. - move=> t _; apply: contraTeq kerP'r; rewrite !inE sub1G andbT negbK. - rewrite mulf_eq0 fmorph_eq0 => /norP[]; rewrite -!irr_consttE. - by move=> /sub_cfker_constt_Ind_irr-> // /sub_cfker_constt_Ind_irr <-. - rewrite cfnormZ 2!cfunE cfRes1 2?real_normK //; last first. - rewrite rpredD 1?rpredM // Creal_Cint ?Cint_vchar1 // ?char_vchar //. - by rewrite (seqInd_char S1zeta1). - rewrite mulrDr mulrCA sqrrD opprD addrACA; congr (_ + _); last first. - rewrite (cfnormE (cfun_onG _)) mulVKf ?neq0CG //. - by rewrite (big_setD1 1%g) // Cint_normK ?Cint_vchar1 // addrC addKr. - rewrite opprD addrA; congr (_ - _); last first. - rewrite -[_ * a * _]mulrA -mulr_natl; congr (_ * _). - by rewrite -[a1 * _]mulrA -(mulrA a); congr (_ * _); rewrite -mulrA mulrC. - rewrite mulrBr; congr (_ - _); last first. - by rewrite mulrACA -expr2 -!exprMn mulrAC. - rewrite -mulrA exprMn -mulrA; congr (_ * _); rewrite expr2 -mulrA. - congr (_ * _); apply: canLR (mulKf (cfnorm_seqInd_neq0 nsHS S1zeta1)) _. - rewrite (cfnormE (cfun_onG _)) mulVKf ?neq0CG // mulrC. - rewrite (cfnormE (seqInd_on nsHS S1zeta1)) mulVKf ?neq0CG //. - by apply: eq_bigr => x Hx; rewrite cfResE. -rewrite -subn1 natrB // -Cint_normK ?Cint_vchar1 // mulrBl mul1r ler_subl_addl. -apply: ler_trans (_ : \sum_(x in H) `|alpha x| ^+ 2 <= _); last first. - by rewrite (big_setD1 1%g). -rewrite (big_setID P) /= (setIidPr sPH) ler_paddr ?sumr_ge0 // => [x _|]. - by rewrite mulr_ge0 ?normr_ge0. -rewrite mulr_natl -sumr_const ler_sum // => y Py. -suffices ->: alpha y = alpha 1%g by apply: lerr. -rewrite [alpha]cfun_sum_constt !sum_cfunE; apply: eq_bigr => i. -by rewrite !cfunE => /kerHalpha; rewrite inE => /subsetP/(_ y Py)/cfker1->. -Qed. - -Local Notation eta10 := (eta_ #1 0). -Local Notation eta01 := (eta_ 0 #1). - -Let o_tau1_eta (tau1 : {additive _}) i j: - coherent_with calS S^# tau tau1 -> - {in 'Z[calSirr], forall zeta, '[tau1 zeta, eta_ i j] = 0}. -Proof. -move=> cohS _ /zchar_expansion[|z Zz ->]. - by rewrite filter_uniq ?seqInd_uniq. -rewrite raddf_sum cfdot_suml big1_seq //= => phi; rewrite mem_filter. -case/andP=> irr_phi /(coherent_ortho_cycTIiso StypeP sSS0 cohS) o_phi_eta. -by rewrite raddfZ_Cint {Zz}//= cfdotZl o_phi_eta ?mulr0. -Qed. - -Let P1_int2_lb b : b \in Cint -> 2%:R * u%:R * b <= #|P|.-1%:R * b ^+ 2. -Proof. -move=> Zb; rewrite -natrM; apply: ler_trans (_ : (2 * u)%:R * b ^+ 2 <= _). - by rewrite ler_wpmul2l ?ler0n ?Cint_ler_sqr. -rewrite ler_wpmul2r -?realEsqr ?Creal_Cint // leC_nat mulnC -leq_divRL //. -have [_ [_ ->] /leq_trans-> //] := FTtypeP_facts. -by rewrite leq_div2l // -subn1 ltn_subRL. -Qed. - -(* This is Peterfalvi (13.6). *) -Lemma FTtypeP_sum_Ind_Fitting_lb (tau1 : {additive _}) lambda : - coherent_with calS S^# tau tau1 -> lambda \in irrIndH -> lambda \in calS -> - \sum_(x in H^#) `|tau1 lambda x| ^+ 2 >= #|S|%:R - lambda 1%g ^+ 2. -Proof. -move=> cohS /andP[Ilam Hlam] Slam; have [[Itau1 Ztau1] _] := cohS. -have Zlam1: tau1 lambda \in 'Z[irr G] by rewrite Ztau1 ?mem_zchar. -have S1lam: lambda \in calS1. - have [[s kerP's Ds] [r _ Dr]] := (seqIndP Slam, seqIndP Hlam). - rewrite Dr mem_seqInd ?gFnormal ?normal1 // !inE !sub1G !andbT in kerP's *. - rewrite -(sub_cfker_Ind_irr r (gFsub _ _) (gFnorm _ _)) /= -Dr. - by rewrite Ds sub_cfker_Ind_irr ?gFsub ?gFnorm. -have [|alpha [Zalpha kerPalpha]] := calS1_split1 cohS S1lam Zlam1. - move=> zeta S1zeta lam'zeta; rewrite Itau1 ?sS1S //. - suffices: pairwise_orthogonal calS1 by case/pairwise_orthogonalP=> _ ->. - by rewrite seqInd_orthogonal ?gFnormal. -rewrite Itau1 ?mem_zchar // irrWnorm // expr1n !divr1 mul1r => [[Dlam ->]]. -rewrite mulr1 -ler_subl_addl addrC opprB subrK calHuq //; apply: ler_trans. -have [[x W2x ntx] [y W1y nty]] := (trivgPn _ ntW2, trivgPn _ ntW1). -have [_ _ _ [_ _ sW2P _ _] _] := StypeP; have Px := subsetP sW2P x W2x. -have [eps pr_eps] := C_prim_root_exists (prime_gt0 pr_q). -have{y W1y W2x nty} lamAmod: (tau1 lambda x == lambda x %[mod 1 - eps])%A. - have [_ /mulG_sub[_ sW1S] _ tiPUW1] := sdprodP defS. - have [_ /mulG_sub[sW1W sW2W] cW12 _] := dprodP defW. - have /mulG_sub[sPPU _] := sdprodW defPU. - have [o_y cxy]: #[y] = q /\ x \in 'C[y]. - split; last by apply/cent1P; red; rewrite (centsP cW12). - by apply: nt_prime_order => //; apply/eqP; rewrite -order_dvdn order_dvdG. - have lam1yx: (tau1 lambda (y * x)%g == tau1 lambda x %[mod 1 - eps])%A. - by rewrite (vchar_ker_mod_prim pr_eps) ?in_setT. - have [Sx Sy] := (subsetP (gFsub _ _) x Px, subsetP sW1S y W1y). - have PUx := subsetP sPPU x Px. - have lam_yx: (lambda (y * x)%g == lambda x %[mod 1 - eps])%A. - by rewrite (vchar_ker_mod_prim pr_eps) ?char_vchar ?(seqInd_char Slam). - apply: eqAmod_trans lam_yx; rewrite eqAmod_sym; apply: eqAmod_trans lam1yx. - have PUlam: lambda \in 'CF(S, PU) by rewrite (seqInd_on _ Slam) ?gFnormal. - have PU'yx: (y * x)%g \notin PU. - by rewrite groupMr //= -[y \in PU]andbT -W1y -in_setI tiPUW1 !inE. - rewrite (cfun_on0 PUlam PU'yx) (ortho_cycTIiso_vanish pddS) //. - apply/orthoPl=> _ /mapP[_ /(cycTIirrP defW)[i [j ->]] ->]. - by rewrite (coherent_ortho_cycTIiso StypeP sSS0). - rewrite !inE (groupMl x (subsetP sW1W y _)) // (subsetP sW2W) // andbT. - rewrite groupMl // -[x \in _]andTb -PUx -in_setI tiPUW1 !inE negb_or ntx /=. - by rewrite (contra _ PU'yx) // => /(subsetP sW2P)/(subsetP sPPU). -have{x ntx Px lamAmod} alphaAmod: (alpha 1%g == 0 %[mod 1 - eps])%A. - have Hx: x \in H by have/mulG_sub[/subsetP->] := dprodW defH. - have:= lamAmod; rewrite -[lambda x]addr0 Dlam ?inE ?ntx // mul1r eqAmodDl. - rewrite cfker1 // [alpha]cfun_sum_constt (subsetP (cfker_sum _ _ _)) //. - rewrite !inE Hx (subsetP _ x Px) //; apply/bigcapsP=> i /kerPalpha. - by rewrite !inE => /subset_trans-> //; apply: cfker_scale. -have /dvdCP[b Zb ->]: (q %| alpha 1%g)%C. - by rewrite (int_eqAmod_prime_prim pr_eps) // Cint_vchar1. -rewrite natrM mulrACA exprMn !mulrA 2?ler_pmul2r ?gt0CG //. -by rewrite -[_ * b * b]mulrA P1_int2_lb. -Qed. - -(* This is Peterfalvi (13.7). *) -Lemma FTtypeP_sum_cycTIiso10_lb : \sum_(x in H^#) `|eta10 x| ^+ 2 >= #|H^#|%:R. -Proof. -pose mu1 := mu_ #1; have S1mu1: mu1 \in calS1 by rewrite S1mu ?Iirr1_neq0. -have Zeta10: eta10 \in 'Z[irr G] by rewrite cycTIiso_vchar. -have [tau1 cohS [b _ Dtau1]] := FTtypeP_coherence. -have{b Dtau1} oS1eta10: {in calS1, forall zeta, '[tau1 zeta, eta10] = 0}. - move=> zeta /S1cases[[j nz_j ->] | /o_tau1_eta-> //]. - rewrite Dtau1 // cfdotZl cfdot_suml big1 ?mulr0 // => i _. - by rewrite cfdot_cycTIiso signW2_eq0 (negPf nz_j) andbF. -have [_ /oS1eta10//|alpha [Zalpha kerPalpha]] := calS1_split1 cohS S1mu1 Zeta10. -rewrite {}oS1eta10 // expr0n mulr0 !mul0r subrr add0r => [[Deta10 -> ub_alpha]]. -have{Deta10} Deta10: {in H^#, eta10 =1 alpha}. - by move=> x /Deta10; rewrite !mul0r add0r. -set a1_2 := alpha 1%g ^+ 2 in ub_alpha. -have Dsum_alpha: \sum_(x in H^#) `|alpha x| ^+ 2 = #|H|%:R * '[alpha] - a1_2. - rewrite (cfnormE (cfun_onG _)) mulVKf ?neq0CG // (big_setD1 _ (group1 H)) /=. - by rewrite addrC Cint_normK ?addKr ?Cint_vchar1. -have [/mulG_sub[sPH _] [_ _ _ [_ _ sW2P _ _] _]] := (dprodW defH, StypeP). -have nz_alpha: alpha != 0. - have [[x W2x ntx] [y W1y nty]] := (trivgPn _ ntW2, trivgPn _ ntW1). - have [eps pr_eps] := C_prim_root_exists (prime_gt0 pr_q). - have [_ mulW12 cW12 tiW12] := dprodP defW. - have [sW1W sW2W] := mulG_sub mulW12. - have [o_y cxy]: #[y] = q /\ x \in 'C[y]. - split; last by apply/cent1P; red; rewrite (centsP cW12). - by apply: nt_prime_order => //; apply/eqP; rewrite -order_dvdn order_dvdG. - have eta10x: (eta10 x == eta10 (y * x)%g %[mod 1 - eps])%A. - by rewrite eqAmod_sym (vchar_ker_mod_prim pr_eps) ?in_setT. - have eta10xy: (eta10 (y * x)%g == 1 %[mod 1 - eps])%A. - rewrite cycTIiso_restrict; last first. - rewrite !inE -mulW12 mem_mulg // andbT groupMl ?groupMr // -[_ || _]andTb. - by rewrite andb_orr -{1}W2x -W1y andbC -!in_setI tiW12 !inE (negPf ntx). - have {2}<-: w_ #1 0 x = 1. - rewrite -[x]mul1g /w_ dprod_IirrE cfDprodE // irr0 cfun1E W2x mulr1. - by rewrite lin_char1 ?irr_cyclic_lin. - rewrite (vchar_ker_mod_prim pr_eps) ?(subsetP sW1W y) ?(subsetP sW2W) //. - by rewrite irr_vchar. - have: (alpha x == 1 %[mod 1 - eps])%A. - rewrite -Deta10; last by rewrite !inE ntx (subsetP sPH) ?(subsetP sW2P). - exact: eqAmod_trans eta10x eta10xy. - apply: contraTneq => ->; rewrite cfunE eqAmod_sym. - apply/negP=> /(int_eqAmod_prime_prim pr_eps pr_q (rpred1 _))/idPn[]. - by rewrite (dvdC_nat q 1) -(subnKC qgt2). -apply: wlog_neg => suma_lt_H. -suffices{ub_alpha} lb_a1_2: a1_2 >= #|H^#|%:R. - have Pgt2: (2 < #|P|)%N by apply: leq_trans (subset_leq_card sW2P). - apply: ler_trans (ler_trans lb_a1_2 _) ub_alpha. - rewrite ler_pmull ?(ltr_le_trans _ lb_a1_2) ?ler1n ?ltr0n //. - by rewrite -(subnKC Pgt2). - have:= leq_trans (ltnW Pgt2) (subset_leq_card sPH). - by rewrite (cardsD1 1%g) group1. -have /CnatP[n Dn]: '[alpha] \in Cnat by rewrite Cnat_cfnorm_vchar. -have /CnatP[m Dm]: a1_2 \in Cnat by rewrite Cnat_exp_even ?Cint_vchar1. -rewrite Dm leC_nat leqNgt; apply: contra suma_lt_H => a1_2_lt_H. -rewrite {1}Dsum_alpha Dn Dm -natrM ler_subr_addl (cardsD1 1%g H) group1 /=. -case Dn1: n => [|[|n1]]; first by rewrite -cfnorm_eq0 Dn Dn1 eqxx in nz_alpha. - have /dirrP[b [i Dalpha]]: alpha \in dirr H by rewrite dirrE Zalpha Dn Dn1 /=. - rewrite -Dm /a1_2 Dalpha cfunE exprMn sqrr_sign mul1r muln1 mulrS ler_add2r. - by rewrite lin_char1 ?expr1n //; apply/char_abelianP. -rewrite -natrD leC_nat -add2n mulnDr (addnC 1%N) mulnDl -addnA. -by apply: leq_trans (leq_addr _ _); rewrite muln2 -addnn leq_add2r ltnW. -Qed. - -(* This is Peterfalvi (13.8). *) -(* We have filled a logical gap in the textbook, which quotes (13.3.c) to get *) -(* a j such that eta_01 is a component of mu_j^tau1, then asserts that the *) -(* (orthogonality) assumptions of (13.5) have been checked, apparently *) -(* implying that because for zeta in calS1 \ mu_j, zeta^tau1 is orthogonal to *) -(* mu_j^tau1, as per the proof of (13.6), zeta^tau1 must be orthogonal to *) -(* eta_01. This is wrong, because zeta^tau1, mu_j^tau1 and eta_01 are not *) -(* characters, but virtual characters. We need to use a more careful line of *) -(* reasoning, using the more precise characterization of calS1 in the lemma *) -(* S1cases above (which does use the orthogonal-constituent argument, but *) -(* for chi_j and Res_H zeta), and the decomposition given in (13.3.c) for all *) -(* the mu_k. *) -Lemma FTtypeP_sum_cycTIiso01_lb : - \sum_(x in H^#) `|eta01 x| ^+ 2 >= #|PU|%:R - (u ^ 2)%:R. -Proof. -have [tau1 cohS [b _ Dtau1]] := FTtypeP_coherence. -have Zeta01: eta01 \in 'Z[irr G] by rewrite cycTIiso_vchar. -pose j1 := signW2 b #1; pose d : algC := (-1) ^+ b; pose mu1 := mu_ j1. -have nzj1: j1 != 0 by [rewrite signW2_eq0 ?Iirr1_neq0]; have S1mu1 := S1mu nzj1. -have o_mu_eta01 j: j != 0 -> '[tau1 (mu_ j), eta01] = d *+ (j == j1). - move/Dtau1->; rewrite -/d cfdotZl cfdot_suml big_ord_recl /=. - rewrite cfdot_cycTIiso andTb (inv_eq (signW2K b)). - by rewrite big1 ?addr0 ?mulr_natr // => i _; rewrite cfdot_cycTIiso. -have [zeta | alpha [Zalpha kerPalpha [_]]] := calS1_split1 cohS S1mu1 Zeta01. - case/S1cases=> [[j nz_j ->] | /o_tau1_eta-> //]. - by rewrite o_mu_eta01 // (inj_eq (prTIred_inj _)) => /negPf->. -rewrite o_mu_eta01 // eqxx mulrb => -> lb_alpha. -rewrite -ler_subl_addl cfnorm_prTIred -/q mulrAC sqrr_sign mul1r. -rewrite mu1uq // natrM exprMn (mulrAC _ q%:R) (mulrA _ q%:R) !mulfK ?neq0CG //. -rewrite natrX -(sdprod_card defS) natrM -mulrBl mulfK ?neq0CG //. -rewrite addrC opprB subrK mulrACA; apply: ler_trans lb_alpha. -apply: ler_trans (P1_int2_lb _) _; first by rewrite rpredMsign Cint_vchar1. -by rewrite exprMn sqrr_sign mul1r lerr. -Qed. - -(* These are the assumptions for (13.9); K will be set to 'F(T) in the only *) -(* application of this lemma, in the proof of (13.10). *) - -Variable K : {group gT}. -Let G0 := ~: (class_support H G :|: class_support K G). - -Variables (tau1 : {additive 'CF(S) -> 'CF(G)}) (lambda : 'CF(S)). - -Hypothesis cohS : coherent_with calS S^# tau tau1. -Hypothesis cohSmu : typeP_TIred_coherent tau1. - -Hypotheses (Slam : lambda \in calS) (irrHlam : irrIndH lambda). - -(* This is Peterfalvi (13.9)(a). *) -(* As this part is only used to establish (13.9.b) it can be Section-local. *) -Let cover_G0 : {in G0, forall x, tau1 lambda x != 0 \/ eta_ #1 0 x != 0}. -Proof. -have [[b _ Dtau1_mu] [/= Ilam Hlam]] := (cohSmu, andP irrHlam). -pose sum_eta1 := (-1) ^+ b *: \sum_i eta_ i #1. -have{Dtau1_mu} [j nz_j tau1muj]: exists2 j, j != 0 & tau1 (mu_ j) = sum_eta1. - pose j := signW2 b #1; have nz: j != 0 by rewrite signW2_eq0 Iirr1_neq0. - by exists j; rewrite // Dtau1_mu // signW2K. -move=> x; rewrite !inE => /norP[H'x _]. -have{tau1muj} ->: tau1 lambda x = sum_eta1 x. - rewrite -[lambda](subrK (mu_ j)) raddfD cfunE tau1muj. - rewrite [tau1 _ x](cfun_on0 _ H'x) ?add0r {x H'x}//=. - have Hmuj: mu_ j \in calH := Hmu nz_j. - have dmu1: (lambda - mu_ j) 1%g == 0 by rewrite !cfunE !calHuq ?subrr. - have H1dmu: lambda - mu_ j \in 'CF(S, H^#). - by rewrite cfun_onD1 rpredB ?((seqInd_on (gFnormal _ _)) setT). - have [_ ->] := cohS; last first. - by rewrite zcharD1E ?rpredB ?mem_zchar ?FTseqInd_TIred /=. - have A0dmu := cfun_onS (Fitting_sub_FTsupp0 maxS) H1dmu. - have [_ _ _ _ [_ -> //]] := FTtypeP_facts. - by rewrite cfInd_on ?subsetT // (cfun_onS _ H1dmu) ?imset2Sl ?subsetDl. -apply/nandP/andP=> [[/eqP sum_eta1x_0 /eqP eta1x_0]]. -have cycW: cyclic W by have [] := ctiWG. -have W'x: x \notin class_support (cyclicTIset defW) G. - apply: contra_eqN eta1x_0 => /imset2P[{x H'x sum_eta1x_0}x g Wx Gg ->]. - rewrite cfunJ {g Gg}// cycTIiso_restrict //. - by rewrite lin_char_neq0 ?irr_cyclic_lin //; case/setDP: Wx. -have nz_i1 : #1 != 0 :> Iirr W1 by rewrite Iirr1_neq0. -have eta_x_0 i: i != 0 -> eta_ i 0 x = 0. - rewrite /w_ dprod_IirrEl => /(cfExp_prime_transitive pr_q nz_i1)[k co_k_p ->]. - have: coprime k #[w_ #1 0]%CF by rewrite /w_ dprod_IirrEl cforder_sdprod. - rewrite rmorphX /= -dprod_IirrEl => /(cycTIiso_aut_exists ctiWG)[[uu ->] _]. - by rewrite cfunE /= -/sigma eta1x_0 rmorph0. -have eta_i1 i: i != 0 -> eta_ i #1 x = eta_ 0 #1 x - 1. - move=> nz_i; apply/eqP; pose alpha := cfCyclicTIset defW i #1. - have Walpha: alpha \in 'CF(W, cyclicTIset defW). - by rewrite (cfCycTI_on ctiWG) ?Iirr1_neq0. - have: sigma alpha x == 0. - by rewrite cycTIiso_Ind // (cfun_on0 _ W'x) ?cfInd_on ?subsetT. - rewrite [alpha]cfCycTI_E linearD !linearB /= !cfunE cycTIiso1 cfun1E inE. - by rewrite {1}eta_x_0 //= subr0 addrC addr_eq0 opprB. -have eta11x: eta_ #1 #1 x = - (q%:R)^-1. - rewrite -mulN1r; apply: canRL (mulfK (neq0CG W1)) _. - transitivity ((-1) ^+ b * sum_eta1 x - 1); last first. - by rewrite sum_eta1x_0 mulr0 add0r. - rewrite cfunE signrMK mulr_natr -/q -nirrW1 -sumr_const sum_cfunE. - by rewrite !(bigD1 0 isT) /= addrAC eta_i1 // (eq_bigr _ eta_i1). -have: - eta_ #1 #1 x \in Cint. - rewrite rpredN Cint_rat_Aint ?Aint_vchar ?cycTIiso_vchar //. - by rewrite eta11x rpredN rpredV rpred_nat. -case/norm_Cint_ge1/implyP/idPn; rewrite eta11x opprK invr_eq0 neq0CG /=. -by rewrite normfV normr_nat invf_ge1 ?gt0CG // lern1 -ltnNge ltnW. -Qed. - -(* This is Peterfalvi (13.9)(b). *) -Lemma FTtypeP_sum_nonFitting_lb : - \sum_(x in G0) (`|tau1 lambda x| ^+ 2 + `|eta_ #1 0 x| ^+ 2) >= #|G0|%:R. -Proof. -pose A (xi : 'CF(G)) := [set x in G0 | xi x != 0]. -suffices A_ub xi: xi \in dirr G -> #|A xi|%:R <= \sum_(x in G0) `|xi x| ^+ 2. - apply: ler_trans (_ : (#|A (tau1 lambda)| + #|A (eta_ #1 0)|)%:R <= _). - rewrite leC_nat -cardsUI /A !setIdE -setIUr (leq_trans _ (leq_addr _ _)) //. - rewrite subset_leq_card // subsetIidl. - by apply/subsetP=> x /cover_G0/orP; rewrite !inE. - rewrite natrD big_split ler_add ?A_ub ?cycTIiso_dirr //. - have [[[Itau1 Ztau1] _] [Ilam _]] := (cohS, andP irrHlam). - by rewrite dirrE Ztau1 ?Itau1 ?mem_zchar //= irrWnorm. -case/dirrP=> d [t Dxi]; rewrite (big_setID [set x | xi x != 0]) /= addrC. -rewrite -setIdE -/(A _) big1 ?add0r => [|x]; last first. - by rewrite !inE negbK => /andP[/eqP-> _]; rewrite normr0 expr0n. -rewrite -sum1_card !(partition_big_imset (@cycle _)) /= natr_sum. -apply: ler_sum => _ /imsetP[x Ax ->]. -pose B := [pred y | generator <[x]> y]; pose phi := 'Res[<[x]>] 'chi_t. -have defA: [pred y in A xi | <[y]> == <[x]>] =i B. - move=> y; rewrite inE /= eq_sym andb_idl // !inE => eq_xy. - have LGxy L (LG := class_support L G): x \notin LG -> y \notin LG. - rewrite /LG class_supportEr; apply: contra => /bigcupP[g Gg Lg_y]. - apply/bigcupP; exists g => //; move: Lg_y. - by rewrite -!cycle_subG (eqP eq_xy). - move: Ax; rewrite !inE !negb_or -andbA => /and3P[/LGxy-> /LGxy->]. - apply: contraNneq => chi_y_0. - have [k co_k_y ->]: exists2 k, coprime k #[y] & x = (y ^+ k)%g. - have Yx: generator <[y]> x by rewrite [generator _ _]eq_sym. - have /cycleP[k Dx] := cycle_generator Yx; exists k => //. - by rewrite coprime_sym -generator_coprime -Dx. - have Zxi: xi \in 'Z[irr G] by rewrite Dxi rpredZsign irr_vchar. - have [uu <- // _] := make_pi_cfAut [group of G] co_k_y. - by rewrite cfunE chi_y_0 rmorph0. -have resB: {in B, forall y, `|xi y| ^+ 2 = `|phi y| ^+ 2}. - move=> y /cycle_generator Xy. - by rewrite Dxi cfunE normrMsign cfResE ?subsetT. -rewrite !(eq_bigl _ _ defA) sum1_card (eq_bigr _ resB). -apply: sum_norm2_char_generators => [|y By]. - by rewrite cfRes_char ?irr_char. -rewrite -normr_eq0 -sqrf_eq0 -resB // sqrf_eq0 normr_eq0. -by move: By; rewrite -defA !inE -andbA => /and3P[]. -Qed. - -End Thirteen_2_3_5_to_9. - -Section Thirteen_4_10_to_16. - -(* These assumptions correspond to Peterfalvi, Hypothesis (13.1), most of *) -(* which gets used to prove (13.4) and (13.9-13). *) - -Variables S U W W1 W2 : {group gT}. -Hypotheses (maxS : S \in 'M) (defW : W1 \x W2 = W). -Hypotheses (StypeP : of_typeP S U defW). - -Local Notation "` 'W1'" := (gval W1) (at level 0, only parsing) : group_scope. -Local Notation "` 'W2'" := (gval W2) (at level 0, only parsing) : group_scope. -Local Notation "` 'W'" := (gval W) (at level 0, only parsing) : group_scope. -Local Notation V := (cyclicTIset defW). - -Local Notation "` 'S'" := (gval S) (at level 0, only parsing) : group_scope. -Local Notation P := `S`_\F%G. -Local Notation "` 'P'" := `S`_\F (at level 0) : group_scope. -Local Notation PU := S^`(1)%G. -Local Notation "` 'PU'" := `S^`(1) (at level 0) : group_scope. -Local Notation "` 'U'" := (gval U) (at level 0, only parsing) : group_scope. -Local Notation C := 'C_U(`P)%G. -Local Notation "` 'C'" := 'C_`U(`P) (at level 0) : group_scope. -Local Notation H := 'F(S)%G. -Local Notation "` 'H'" := 'F(`S) (at level 0) : group_scope. - -Let defS : PU ><| W1 = S. Proof. by have [[]] := StypeP. Qed. -Let defPU : P ><| U = PU. Proof. by have [_ []] := StypeP. Qed. -Let defH : P \x C = H. Proof. by have [] := typeP_context StypeP. Qed. - -Let notStype1 : FTtype S != 1%N. Proof. exact: FTtypeP_neq1 StypeP. Qed. -Let notStype5 : FTtype S != 5%N. Proof. exact: FTtype5_exclusion maxS. Qed. - -Let pddS := FT_prDade_hypF maxS StypeP. -Let ptiWS : primeTI_hypothesis S PU defW := FT_primeTI_hyp StypeP. -Let ctiWG : cyclicTI_hypothesis G defW := pddS. -Local Notation Sfacts := (FTtypeP_facts maxS StypeP). - -Let ntW1 : W1 :!=: 1. Proof. by have [[]] := StypeP. Qed. -Let ntW2 : W2 :!=: 1. Proof. by have [_ _ _ []] := StypeP. Qed. -Let cycW1 : cyclic W1. Proof. by have [[]] := StypeP. Qed. -Let cycW2 : cyclic W2. Proof. by have [_ _ _ []] := StypeP. Qed. - -Let p := #|W2|. -Let q := #|W1|. - -Let pr_p : prime p. Proof. by have [] := FTtypeP_primes maxS StypeP. Qed. -Let pr_q : prime q. Proof. by have [] := FTtypeP_primes maxS StypeP. Qed. - -Let qgt2 : q > 2. Proof. by rewrite odd_gt2 ?mFT_odd ?cardG_gt1. Qed. -Let pgt2 : p > 2. Proof. by rewrite odd_gt2 ?mFT_odd ?cardG_gt1. Qed. - -Let coPUq : coprime #|PU| q. -Proof. by rewrite (coprime_sdprod_Hall_r defS); have [[]] := StypeP. Qed. - -Let sW2P: W2 \subset P. Proof. by have [_ _ _ []] := StypeP. Qed. - -Let p'q : q != p. -Proof. -by rewrite -dvdn_prime2 -?prime_coprime -?(cyclic_dprod defW) //; case: ctiWG. -Qed. - -Let nirrW1 : #|Iirr W1| = q. Proof. by rewrite card_Iirr_cyclic. Qed. -Let nirrW2 : #|Iirr W2| = p. Proof. by rewrite card_Iirr_cyclic. Qed. -Let NirrW1 : Nirr W1 = q. Proof. by rewrite -nirrW1 card_ord. Qed. -Let NirrW2 : Nirr W2 = p. Proof. by rewrite -nirrW2 card_ord. Qed. - -Local Open Scope ring_scope. - -Let sigma := (cyclicTIiso ctiWG). -Let w_ i j := (cyclicTIirr defW i j). -Local Notation eta_ i j := (sigma (w_ i j)). - -Let mu_ := primeTIred ptiWS. -Local Notation tau := (FT_Dade0 maxS). - -Let calS0 := seqIndD PU S S`_\s 1. -Let rmR := FTtypeP_coh_base maxS StypeP. -Let scohS0 : subcoherent calS0 tau rmR. -Proof. exact: FTtypeP_subcoherent StypeP. Qed. - -Let calS := seqIndD PU S P 1. -Let sSS0 : cfConjC_subset calS calS0. -Proof. exact/seqInd_conjC_subset1/Fcore_sub_FTcore. Qed. - -Local Notation calH := (seqIndT H S). -Local Notation calHuq := (FTtypeP_Ind_Fitting_1 maxS StypeP). - -Section Thirteen_10_to_13_15. - -(* This section factors the assumption that S contains an irreducible induced *) -(* from a linear character of H. It does not actually export (13.4) and *) -(* and (4.11) but instead uses them to carry out the bulk of the proofs of *) -(* (4.12), (4.13) and (4.15). The combinatorial bound m is also local to this *) -(* Section, but (4.10) has to be exported from an inner Section that factors *) -(* facts about T, the typeP pair associate of S. *) -(* Note that u and c are bound locally to this section; we will set u = #|U| *) -(* after this section. *) - -Variable lambda : 'CF(S). -Hypotheses (Slam : lambda \in calS) (irrHlam : irrIndH lambda). -Let Hlam : lambda \in calH. Proof. by have [] := andP irrHlam. Qed. -Let Ilam : lambda \in irr S. Proof. by have [] := andP irrHlam. Qed. - -Let c := #|C|. -Let u := #|U : C|. -Let oU : #|U| = (u * c)%N. Proof. by rewrite mulnC Lagrange ?subsetIl. Qed. - -Let m : algC := 1 - q.-1%:R^-1 - q.-1%:R / (q ^ p)%:R + (q.-1 * q ^ p)%:R^-1. - -Section Thirteen_4_10. - -(* This Section factors assumptions and facts about T, including Lemma (13.4) *) -(* is local to this Section. *) - -Variables T V : {group gT}. -Hypotheses (maxT : T \in 'M) (xdefW : W2 \x W1 = W). -Hypothesis TtypeP : of_typeP T V xdefW. - -Local Notation Q := (gval T)`_\F. -Local Notation D := 'C_(gval V)(Q). -Local Notation K := 'F(gval T). -Let v := #|V : D|. - -Local Notation calT := (seqIndD T^`(1) T (gval T)`_\F 1). - -(* This part of the proof of (13.4) is reused in (13.10). *) -Let tiHK: class_support H^# G :&: class_support K^# G = set0. -Proof. -apply/eqP/set0Pn => [[_ /setIP[/imset2P[x g1 H1x _ ->] /imset2P[xg g2]]]]. -pose g := (g2 * g1^-1)%g => /setD1P[_ Kxg] _ Dxg. -have{Kxg Dxg} Kgx: x \in K :^ g by rewrite conjsgM mem_conjgV Dxg memJ_conjg. -have{Kgx} cxQg: Q :^ g \subset 'C[x]. - rewrite sub_cent1 (subsetP _ _ Kgx) // centJ conjSg centsC. - have [/dprodW/mulG_sub[/subset_trans-> //=]] := typeP_context TtypeP. - exact: FTtypeP_Fitting_abelian TtypeP. -have{cxQg} sQgS: Q :^ g \subset S. - have sH1A0 := subset_trans (Fitting_sub_FTsupp maxS) (FTsupp_sub0 S). - have{sH1A0} A0x: x \in 'A0(S) := subsetP sH1A0 x H1x. - have [_ _ _ _ [tiA0 _]] := Sfacts. - by have:= cent1_normedTI tiA0 A0x; rewrite setTI; apply: subset_trans. -have /pHallP[_ eq_Sq_q]: q.-Hall(S) W1. - have qW1: q.-group W1 by rewrite /pgroup pnat_id. - have [|//] := coprime_mulGp_Hall (sdprodW defS) _ qW1. - by rewrite /pgroup p'natE // -prime_coprime // coprime_sym. -have:= partn_dvd q (cardG_gt0 _) (cardSg sQgS). -rewrite cardJg /= -eq_Sq_q => /(dvdn_leq_log q (cardG_gt0 _))/idPn[]. -have [_ [_ ->] _ _ _] := FTtypeP_facts maxT TtypeP. -by rewrite -ltnNge p_part !pfactorK // logn_prime // eqxx ltnW. -Qed. - -(* This is Peterfalvi (13.4). *) -Let T_Galois : [/\ typeP_Galois TtypeP, D = 1%g & v = (q ^ p).-1 %/ q.-1]. -Proof. -apply: FTtypeP_no_Ind_Fitting_facts => //; apply/hasPn=> theta Ttheta. -apply/andP=> [[/= irr_theta Ktheta]]; set calK := seqIndT _ T in Ktheta. -have [tau1S cohS [bS _ Dtau1Smu]] := FTtypeP_coherence maxS StypeP. -have [tau1T cohT [bT _ Dtau1Tnu]] := FTtypeP_coherence maxT TtypeP. -have [[[Itau1S Ztau1S] Dtau1S] [[Itau1T Ztau1T] Dtau1T]] := (cohS, cohT). -have onF0 := cfun_onS (Fitting_sub_FTsupp0 _). -pose HG := class_support H^# G; pose KG := class_support K^# G. -have Hdlambda xi: - xi \in calH -> xi \in calS -> tau1S (lambda - xi) \in 'CF(G, HG). -- move=> Hxi Sxi; have H1dxi: lambda - xi \in 'CF(S, H^#). - rewrite cfun_onD1 rpredB ?((seqInd_on (gFnormal _ _)) setT) //=. - by rewrite !cfunE !calHuq ?subrr. - rewrite Dtau1S ?zcharD1E ?rpredB ?mem_zchar ?(cfun_on0 H1dxi) ?inE ?eqxx //=. - by have [_ _ _ _ [_ ->]] := Sfacts; rewrite ?onF0 // cfInd_on ?subsetT. -have Kdtheta xi: - xi \in calK -> xi \in calT -> tau1T (theta - xi) \in 'CF(G, KG). -- move=> Kxi Txi; have K1dxi: theta - xi \in 'CF(T, K^#). - rewrite cfun_onD1 rpredB ?((seqInd_on (gFnormal _ _)) setT) //=. - by rewrite !cfunE !(FTtypeP_Ind_Fitting_1 _ TtypeP) ?subrr. - rewrite Dtau1T ?zcharD1E ?rpredB ?mem_zchar ?(cfun_on0 K1dxi) ?inE ?eqxx //=. - have [_ _ _ _ [_ ->]] := FTtypeP_facts maxT TtypeP; last exact: onF0. - by rewrite cfInd_on ?subsetT. -have oHK alpha beta: - alpha \in 'CF(G, HG) -> beta \in 'CF(G, KG) -> '[alpha, beta] = 0. -- by move=> Halpha Kbeta; rewrite (cfdotElr Halpha Kbeta) tiHK big_set0 mulr0. -have o_lambda_theta: '[tau1S lambda, tau1T theta] = 0. - pose S1 := lambda :: lambda^*%CF; pose T1 := theta :: theta^*%CF. - have sS1S: {subset S1 <= calS} by apply/allP; rewrite /= Slam cfAut_seqInd. - have sT1T: {subset T1 <= calT} by apply/allP; rewrite /= Ttheta cfAut_seqInd. - have ooS1: orthonormal (map tau1S S1). - rewrite map_orthonormal //; first exact: (sub_in2 (zchar_subset sS1S)). - apply: seqInd_conjC_ortho2 Slam; rewrite ?gFnormal ?mFT_odd //. - by have /mulG_sub[] := sdprodW defPU. - have ooT1: orthonormal (map tau1T T1). - rewrite map_orthonormal //; first exact: (sub_in2 (zchar_subset sT1T)). - apply: seqInd_conjC_ortho2 Ttheta; rewrite ?gFnormal ?mFT_odd //. - by have [_ [_ _ _ /sdprodW/mulG_sub[]]] := TtypeP. - have /andP/orthonormal_vchar_diff_ortho := conj ooS1 ooT1; apply. - by split; apply/allP; rewrite /= ?Ztau1S ?Ztau1T ?mem_zchar ?cfAut_seqInd. - have on1'G M beta: beta \in 'CF(G, class_support M^# G) -> beta 1%g = 0. - move/cfun_on0->; rewrite // class_supportEr -cover_imset -class_supportD1. - by rewrite !inE eqxx. - rewrite -!raddfB; set alpha := tau1S _; set beta := tau1T _. - have [Halpha Kbeta]: alpha \in 'CF(G, HG) /\ beta \in 'CF(G, KG). - by rewrite Hdlambda ?Kdtheta ?cfAut_seqInd ?cfAut_seqIndT. - by rewrite oHK // {1}(on1'G _ _ Halpha) (on1'G _ _ Kbeta) !eqxx. -pose ptiWT := FT_primeTI_hyp TtypeP; pose nu_ := primeTIred ptiWT. -have etaC := cycTIisoC (FT_cyclicTI_hyp StypeP) (FT_cyclicTI_hyp TtypeP). -have /idPn[]: '[tau1S (lambda - mu_ #1), tau1T (theta - nu_ #1)] == 0. - rewrite oHK //. - by rewrite Hdlambda ?FTseqInd_TIred ?FTprTIred_Ind_Fitting ?Iirr1_neq0. - by rewrite Kdtheta ?FTseqInd_TIred ?FTprTIred_Ind_Fitting ?Iirr1_neq0. -rewrite !raddfB /= !cfdotBl o_lambda_theta Dtau1Smu ?Dtau1Tnu ?Iirr1_neq0 //. -rewrite !cfdotZl !cfdotZr rmorph_sign !cfdot_suml big1 => [|i _]; last first. - rewrite cfdotC etaC (coherent_ortho_cycTIiso TtypeP _ cohT) ?conjC0 //. - by apply: seqInd_conjC_subset1; apply: Fcore_sub_FTcore. -rewrite cfdot_sumr big1 ?mulr0 ?subr0 ?add0r ?opprK => [|j _]; last first. - by rewrite -etaC (coherent_ortho_cycTIiso StypeP _ cohS). -set i1 := iter bT _ #1; set j1 := iter bS _ #1. -rewrite !mulf_eq0 !signr_eq0 (bigD1 i1) //= addrC big1 => [|i i1'i]; last first. - rewrite etaC cfdot_sumr big1 // => j _; rewrite cfdot_cycTIiso. - by rewrite (negPf i1'i) andbF. -rewrite etaC cfdot_sumr (bigD1 j1) //= cfdot_cycTIiso !eqxx addrCA. -rewrite big1 ?addr0 ?oner_eq0 // => j j1'j; rewrite cfdot_cycTIiso. -by rewrite eq_sym (negPf j1'j). -Qed. - -(* This is Peterfalvi (13.10). *) -Lemma FTtypeP_compl_ker_ratio_lb : m * (p ^ q.-1)%:R / q%:R < u%:R / c%:R. -Proof. -have [tau1 cohS cohSmu] := FTtypeP_coherence maxS StypeP. -pose lam1 := tau1 lambda; pose eta10 := eta_ #1 0. -pose H1G := class_support H^# G; pose K1G := class_support K^# G. -pose G0 := ~: (class_support H G :|: class_support K G). -pose invJ (f : gT -> algC) := forall y x, f (x ^ y) = f x. -pose nm2 (chi : 'CF(G)) x := `|chi x| ^+ 2; pose g : algC := #|G|%:R. -have injJnm2 chi: invJ (nm2 chi) by move=> y x; rewrite /nm2 cfunJ ?inE. -have nm2_dirr chi: chi \in dirr G -> g^-1 <= nm2 chi 1%g / g. - case/dIrrP=> d ->; rewrite -{1}[g^-1]mul1r ler_pmul2r ?invr_gt0 ?gt0CG //. - rewrite expr_ge1 ?normr_ge0 // cfunE normrMsign. - by rewrite irr1_degree normr_nat ler1n irr_degree_gt0. -pose mean (F M : {set gT}) (f : gT -> algC) := (\sum_(x in F) f x) / #|M|%:R. -have meanTI M (F := 'F(gval M)^#) (FG := class_support F G) f: - M \in 'M -> normedTI F G M -> invJ f -> mean FG G f = mean F M f. -- move=> maxM /and3P[ntF tiF /eqP defN] fJ; apply: canLR (mulfK (neq0CG _)) _. - rewrite (set_partition_big _ (partition_class_support ntF tiF)) /=. - rewrite mulrAC -mulrA -natf_indexg ?subsetT //=. - have ->: #|G : M| = #|F :^: G| by rewrite card_conjugates defN. - rewrite mulr_natr -sumr_const; apply: eq_bigr => _ /imsetP[y _ ->]. - by rewrite (big_imset _ (in2W (conjg_inj _))) (eq_bigr _ (in1W (fJ y))). -have{meanTI} meanG f : - invJ f -> mean G G f = f 1%g / g + mean H^# S f + mean K^# T f + mean G0 G f. -- have type24 maxM := compl_of_typeII_IV maxM _ (FTtype5_exclusion maxM). - have tiH: normedTI H^# G S by have/type24[] := StypeP. - have{type24} tiK: normedTI K^# G T by have/type24[] := TtypeP. - move=> fJ; rewrite -!meanTI // {1}/mean (big_setD1 1%g) // (big_setID H1G) /=. - rewrite [in rhs in _ + (_ + rhs)](big_setID K1G) /= -/g -!mulrDl !addrA. - congr ((_ + _ + _ + _) / g); rewrite ?(setIidPr _) // /H1G /K1G. - + by rewrite class_supportEr -cover_imset -class_supportD1 setSD ?subsetT. - + rewrite subsetD -setI_eq0 setIC tiHK eqxx andbT. - by rewrite class_supportEr -cover_imset -class_supportD1 setSD ?subsetT. - rewrite !class_supportEr -!cover_imset -!class_supportD1. - apply: eq_bigl => x; rewrite !inE andbT -!negb_or orbCA orbA orbC. - by case: (x =P 1%g) => //= ->; rewrite mem_class_support ?group1. -have lam1_ub: mean G0 G (nm2 lam1) <= lambda 1%g ^+ 2 / #|S|%:R - g^-1. - have [[Itau1 Ztau1] _] := cohS. - have{Itau1} n1lam1: '[lam1] = 1 by rewrite Itau1 ?mem_zchar ?irrWnorm. - have{Ztau1} Zlam1: lam1 \in 'Z[irr G] by rewrite Ztau1 ?mem_zchar. - rewrite -ler_opp2 opprB -(ler_add2l '[lam1]) {1}n1lam1 addrCA. - rewrite (cfnormE (cfun_onG _)) (mulrC g^-1) [_ / g](meanG (nm2 _)) // addrK. - rewrite -addrA ler_add ?nm2_dirr //; first by rewrite dirrE Zlam1 n1lam1 /=. - rewrite ler_paddr ?divr_ge0 ?ler0n //. - by apply: sumr_ge0 => x _; rewrite exprn_ge0 ?normr_ge0. - rewrite ler_pdivl_mulr ?gt0CG // mulrBl mul1r divfK ?neq0CG //. - by rewrite (FTtypeP_sum_Ind_Fitting_lb StypeP). -pose ub_lam1 : algC := (#|T^`(1)%g|%:R - (v ^ 2)%:R - #|Q|.-1%:R) / #|T|%:R. -have [_ D_1 Dv] := T_Galois. -have defK : K = Q by have [<-] := typeP_context TtypeP; rewrite D_1 dprodg1. -have eta10_ub: mean G0 G (nm2 (eta_ #1 0)) <= #|G0|%:R / g - ub_lam1. - rewrite -ler_opp2 opprB -(ler_add2l '[eta_ #1 0]) {2}(cfnormE (cfun_onG _)). - rewrite (mulrC g^-1) [_ / g in rhs in _ <= rhs](meanG (nm2 _)) // addrK. - have ->: '[eta_ #1 0] = mean G G (fun _ => 1). - by rewrite /mean sumr_const cfdot_cycTIiso eqxx divff ?neq0CG. - rewrite meanG // [in lhs in lhs <= _]/mean !sumr_const addrACA subrr addr0. - rewrite [lhs in lhs <= _]addrAC -addrA -mulrDl (cardsD1 1%g Q) group1 -defK. - rewrite mul1r subrK ?ler_add ?ler_pmul2r ?invr_gt0 ?gt0CG //. - - by rewrite nm2_dirr ?cycTIiso_dirr. - - exact: (FTtypeP_sum_cycTIiso10_lb _ StypeP). - congr (_ <= _): (FTtypeP_sum_cycTIiso01_lb maxT TtypeP). - by apply: eq_bigr => x _; congr (nm2 _ x); apply: cycTIisoC. -have: ub_lam1 < lambda 1%g ^+ 2 / #|S|%:R. - rewrite -[_ / _](subrK g^-1) ltr_spaddr ?invr_gt0 ?gt0CG //. - rewrite -(ler_add2r (#|G0|%:R / g)) -ler_subr_addl -addrA. - apply: ler_trans (ler_add lam1_ub eta10_ub). - rewrite -mulrDl -big_split /= ler_pmul2r ?invr_gt0 ?gt0CG //. - exact: FTtypeP_sum_nonFitting_lb. -rewrite calHuq // -/u -(sdprod_card defS) -/q -(sdprod_card defPU) oU mulnC. -rewrite mulnCA mulnAC !natrM !invfM expr2 !mulrA !mulfK ?neq0CG ?neq0CiG //. -rewrite mulrAC ltr_pdivl_mulr ?ltr_pdivr_mulr ?gt0CG //. -congr (_ < _); last by rewrite -mulrA mulrC. -have [_ [_ ->] _ _ _] := Sfacts; rewrite -/p -/q. -rewrite -{1}(ltn_predK qgt2) expnS natrM mulrA; congr (_ * _). -have /sdprod_card oT: T^`(1) ><| W2 = T by have [[]] := TtypeP. -rewrite /ub_lam1 -{}oT natrM invfM mulrA divfK ?mulrBl ?divff ?neq0CG //. -have /sdprod_card <-: Q ><| V = T^`(1)%g by have [_ []] := TtypeP. -have ->: #|V| = v by rewrite /v D_1 indexg1. -rewrite mulnC !natrM invfM mulrA mulfK ?neq0CiG //. -have [_ [_ oQ] _ _ _] := FTtypeP_facts maxT TtypeP; rewrite -/p -/q /= in oQ. -rewrite Dv natf_div ?dvdn_pred_predX // oQ. -rewrite invfM invrK -mulrA -subn1 mulVKf ?gtr_eqF ?ltr0n //; last first. - by rewrite subn_gt0 -(exp1n p) ltn_exp2r ltnW // ltnW. -rewrite -oQ natrB ?cardG_gt0 // !mulrBl mul1r mulrC mulKf ?neq0CG // -invfM. -by rewrite -natrM oQ opprD opprK addrA addrAC. -Qed. - -End Thirteen_4_10. - -(* This is (13.10) without the dependency on T. *) -Let gen_lb_uc : m * (p ^ q.-1)%:R / q%:R < u%:R / c%:R. -Proof. -have [T pairST [xdefW [V TtypeP]]] := FTtypeP_pair_witness maxS StypeP. -by apply: FTtypeP_compl_ker_ratio_lb TtypeP; have [[]] := pairST. -Qed. - -Import ssrint. -(* This is Peterfalvi (13.11). *) -Let lb_m_cases : - [/\ (*a*) (q >= 7)%N -> m > 8%:R / 10%:R, - (*b*) (q >= 5)%N -> m > 7%:R / 10%:R - & (*c*) q = 3 -> - m > 49%:R / 100 %:R /\ u%:R / c%:R > (p ^ 2).-1%:R / 6%:R :> algC]. -Proof. -pose mkrat b d := fracq (b, d%:Z). -pose test r b d := 1 - mkrat 1 r.-1 - mkrat 1 (r ^ 2)%N > mkrat b%:Z d. -have lb_m r b d: test r.+2 b d -> (q >= r.+2)%N -> m > b%:R / d%:R. - rewrite /test /mkrat !fracqE !CratrE /= => ub_bd le_r_q. - apply: ltr_le_trans ub_bd _; rewrite ler_paddr ?invr_ge0 ?ler0n //. - rewrite -!addrA ler_add2l -!opprD ler_opp2 ler_add //. - rewrite mul1r lef_pinv ?qualifE ?ltr0n //; last by rewrite -(subnKC qgt2). - by rewrite leC_nat -ltnS (ltn_predK qgt2). - rewrite -(ltn_predK pgt2) expnSr natrM invfM mulrA. - rewrite ler_pdivr_mulr ?gt0CG // mulrAC mul1r -subn1. - rewrite ler_pmul ?invr_ge0 ?ler0n ?leC_nat ?leq_subr //. - rewrite lef_pinv ?qualifE ?ltr0n ?leC_nat ?expn_gt0 ?(prime_gt0 pr_q) //. - apply: leq_trans (_ : q ^ 2 <= _)%N; first by rewrite leq_exp2r. - by rewrite -(subnKC qgt2) leq_pexp2l // -subn1 ltn_subRL. -split=> [||q3]; try by apply: lb_m; compute. -pose d r : algC := (3 ^ r.-1)%:R^-1; pose f r := (r ^ 2)%:R * d r. -have Dm: m = (1 - d p) / 2%:R. - rewrite mulrBl mul1r -mulrN mulrC /m q3 /= addrAC -addrA natrM invfM -mulrBl. - rewrite -{1}(ltn_predK pgt2) expnS natrM invfM mulrA. - by congr (_ + _ / _); apply/eqP; rewrite -!CratrE; compute. -split; last apply: ler_lt_trans gen_lb_uc. - apply: ltr_le_trans (_ : (1 - d 5) / 2%:R <= _). - by rewrite /d -!CratrE; compute. - rewrite Dm ler_pmul2r ?invr_gt0 ?ltr0n // ler_add2l ler_opp2. - rewrite lef_pinv ?qualifE ?ltr0n ?expn_gt0 // leC_nat leq_pexp2l //=. - by rewrite -subn1 ltn_subRL odd_geq ?mFT_odd //= ltn_neqAle pgt2 andbT -q3. -rewrite -mulrA mulrCA Dm -mulrA -invfM -natrM mulrA q3 mulrBr mulr1. -rewrite ler_pmul2r ?invr_gt0 ?ltr0n //= -subn1 natrB ?expn_gt0 ?prime_gt0 //. -rewrite ler_add2l ler_opp2 -/(f p) -(subnKC pgt2). -elim: (p - 3)%N => [|r]; first by rewrite /f /d -!CratrE; compute. -apply: ler_trans; rewrite addnS /f /d; set x := (3 + r)%N. -rewrite ler_pdivr_mulr ?ltr0n ?expn_gt0 // mulrAC (expnS 3) (natrM _ 3). -rewrite mulrA mulfK ?gtr_eqF ?ltr0n ?expn_gt0 //. -rewrite -ler_pdivr_mull ?ltr0n // !natrX -exprVn -exprMn. -rewrite mulrS mulrDr mulr1 mulVf ?pnatr_eq0 //. -apply: ler_trans (_ : (3%:R^-1 + 1) ^+ 2 <= _); last by rewrite -!CratrE. -rewrite ler_sqr ?rpredD ?rpred1 ?rpredV ?rpred_nat // ler_add2r. -by rewrite lef_pinv ?qualifE ?ltr0n ?leC_nat. -Qed. - -(* This corollary of (13.11) is used in both (13.12) and (13.15). *) -Let small_m_q3 : m < (q * p)%:R / (q.*2.+1 * p.-1)%:R -> q = 3 /\ (p >= 5)%N. -Proof. -move=> ub_m; have [lb7_m lb5_m _] := lb_m_cases. -have [p3 | p_neq3] := eqVneq p 3. - have ub7_m: ~~ (8%:R / 10%:R < m). - rewrite ltr_gtF // (ltr_le_trans ub_m) // p3 /=. - apply: ler_trans (_ : 3%:R / 4%:R <= _); last first. - by rewrite -!CratrE; compute. - rewrite ler_pdivl_mulr ?ltr0n // mulrAC ler_pdivr_mulr ?ltr0n ?muln_gt0 //. - by rewrite -!natrM leC_nat mulnCA mulSn -muln2 -!mulnA leq_addl. - have{ub7_m} q5: q = 5. - apply: contraNeq ub7_m; rewrite neq_ltn odd_ltn ?mFT_odd //= ltnS leqNgt. - by rewrite ltn_neqAle qgt2 -{1}p3 eq_sym p'q -(odd_geq 7) ?mFT_odd. - have /implyP := ltr_trans (lb5_m _) ub_m. - by rewrite q5 p3 -!CratrE; compute. -have pge5: (5 <= p)%N by rewrite odd_geq ?mFT_odd // ltn_neqAle eq_sym p_neq3. -have ub5_m: ~~ (7%:R / 10%:R < m). - rewrite ltr_gtF // (ltr_le_trans ub_m) //. - apply: ler_trans (_ : 2%:R^-1 * (1 + 4%:R^-1) <= _); last first. - by rewrite -!CratrE; compute. - rewrite !natrM invfM mulrACA ler_pmul ?divr_ge0 ?ler0n //. - rewrite ler_pdivr_mulr ?ler_pdivl_mull ?ltr0n // -natrM mul2n leC_nat. - by rewrite ltnW. - rewrite -(subnKC pge5) [_%:R]mulrSr mulrDl divff ?pnatr_eq0 // ler_add2l. - by rewrite mul1r lef_pinv ?qualifE ?ltr0n // leC_nat. -split=> //; apply: contraNeq ub5_m. -by rewrite neq_ltn ltnNge qgt2 -(odd_geq 5) ?mFT_odd. -Qed. - -(* A more usable form for (13.10). *) -Let gen_ub_m : m < (q * u)%:R / (c * p ^ q.-1)%:R. -Proof. -rewrite !natrM invfM mulrA ltr_pdivl_mulr ?ltr0n ?expn_gt0 ?cardG_gt0 //. -by rewrite -mulrA -ltr_pdivr_mull ?gt0CG // mulrC. -Qed. - -(* This is the bulk of the proof of Peterfalvi (13.12). *) -Lemma FTtypeP_Ind_Fitting_reg_Fcore : c = 1%N. -Proof. -apply/eqP/wlog_neg; rewrite eqn_leq cardG_gt0 andbT -ltnNge => c_gt1. -have ub_m: m < (q * (p ^ q).-1)%:R / (c * p ^ q.-1 * p.-1)%:R. - rewrite 2!natrM invfM mulrACA mulrAC -natf_div ?dvdn_pred_predX // -natrM. - rewrite (ltr_le_trans gen_ub_m) // ler_pmul ?invr_ge0 ?ler0n // leC_nat. - by rewrite leq_mul //; case: Sfacts. -have regCW1: semiregular C W1. - have [[_ _ /Frobenius_reg_ker regUW1 _] _ _ _] := FTtypeP_facts maxS StypeP. - by move=> _ y /regUW1 regUx; rewrite setIAC regUx setI1g. -have{regCW1} dv_2q_c1: q.*2 %| c.-1. - rewrite -(subnKC c_gt1) -mul2n Gauss_dvd ?coprime2n ?dvdn2 ?mFT_odd //=. - rewrite odd_sub ?mFT_odd -?subSn // subn2 regular_norm_dvd_pred //. - have /mulG_sub[_ sW1S] := sdprodW defS. - apply: normsI; first by have [_ []] := StypeP. - by rewrite (subset_trans sW1S) ?norms_cent ?gFnorm. -have [q3 pge5]: q = 3 /\ (p >= 5)%N. - apply: small_m_q3; apply: (ltr_le_trans ub_m). - rewrite !natrM -!mulrA ler_pmul2l ?gt0CG //. - rewrite !invfM !mulrA -(subnKC pgt2) ler_pmul2r ?invr_gt0 ?ltr0n //. - rewrite ler_pdivr_mulr ?ltr0n ?expn_gt0 // mulrAC -natrM -expnS. - rewrite prednK ?cardG_gt0 // ler_pmul ?invr_ge0 ?ler0n ?leC_nat ?leq_pred //. - rewrite lef_pinv ?qualifE ?gt0CG ?ltr0n // leC_nat. - by rewrite -(subnKC c_gt1) ltnS dvdn_leq //= -subSn ?subn2. -have [_ _ [//|lb_m lb_uc]] := lb_m_cases. -pose sum3 r : algC := (r.+1 ^ 2)%:R^-1 + r.+1%:R^-1 + 1. -have [b Dc1] := dvdnP dv_2q_c1; rewrite q3 in Dc1. -have [b0 | b_gt0] := posnP b; first by rewrite b0 -(subnKC c_gt1) in Dc1. -have ub3_m r a: (r < p)%N -> (a <= b)%N -> m < 3%:R / (a * 6).+1%:R * sum3 r. - move=> lb_p lb_b; apply: ltr_le_trans ub_m _. - rewrite !natrM !invfM mulrACA -!mulrA q3 ler_pmul2l ?ltr0n //. - rewrite -(ltn_predK c_gt1) Dc1 ler_pmul ?mulr_ge0 ?invr_ge0 ?ler0n //. - by rewrite lef_pinv ?qualifE ?ltr0n // leC_nat ltnS leq_mul. - rewrite predn_exp mulnC natrM 2!big_ord_recl big_ord1 /= /bump /= expn1. - rewrite -(subnKC (ltnW pgt2)) add2n in lb_p *. - rewrite mulfK ?pnatr_eq0 // addnA 2!natrD 2!mulrDr mulr1 {-1}natrM invfM. - rewrite mulrA divfK ?mulVf ?pnatr_eq0 // ler_add2r. - by rewrite ler_add ?lef_pinv ?qualifE ?ltr0n ?leC_nat ?leq_sqr. -have beq1: b = 1%N. - apply: contraTeq lb_m; rewrite neq_ltn ltnNge b_gt0 => /(ub3_m 4) ub41. - by rewrite ltr_gtF // (ltr_trans (ub41 _)) // /sum3 -!CratrE; compute. -have c7: c = 7 by rewrite -(ltn_predK c_gt1) Dc1 beq1. -have plt11: (p < 11)%N. - rewrite ltnNge; apply: contraL lb_m => /ub3_m/(_ b_gt0) ub100. - by rewrite ltr_gtF // (ltr_trans ub100) // /sum3 -!CratrE; compute. -have{plt11} p5: p = 5. - suffices: p \in [seq r <- iota q.+1 7 | prime r & coprime r c]. - by rewrite c7 q3 inE => /eqP. - rewrite mem_filter mem_iota ltn_neqAle p'q q3 pgt2 pr_p (coprimeSg sW2P) //. - by rewrite (coprimegS _ (Ptype_Fcore_coprime StypeP)) ?subIset ?joing_subl. -have [galS | gal'S] := boolP (typeP_Galois StypeP); last first. - have [H1 [_ _ _ _ []]] := typeP_Galois_Pn maxS notStype5 gal'S. - case/pdivP=> r pr_r r_dv_a /(dvdn_trans r_dv_a)/idPn[]. - rewrite Ptype_factor_prime // -/p p5 (Euclid_dvdM 2 2) // gtnNdvd //. - rewrite odd_prime_gt2 ?(dvdn_odd (dvdn_trans r_dv_a (dvdn_indexg _ _))) //. - by rewrite mFT_odd. -have{galS} u_dv_31: u %| 31. - have [_ _ [_ _]] := typeP_Galois_P maxS notStype5 galS. - rewrite Ptype_factor_prime ?Ptype_Fcompl_kernel_cent // -/p -/q p5 q3. - rewrite card_quotient // normsI ?normG ?norms_cent //. - by have [] := sdprodP defPU. -have hallH: Hall S H. - rewrite /Hall -divgS ?gFsub //= -(sdprod_card defS) -(sdprod_card defPU). - rewrite -(dprod_card defH) -mulnA divnMl ?cardG_gt0 // -/c oU mulnAC c7. - have [_ [_ ->] _ _ _] := FTtypeP_facts maxS StypeP. - by rewrite mulnK // -/q -/p q3 p5 coprime_mulr (coprime_dvdr u_dv_31). -rewrite -(leq_pmul2l (cardG_gt0 P)) muln1 (dprod_card defH) subset_leq_card //. -by rewrite (Fcore_max (Hall_pi hallH)) ?gFnormal ?Fitting_nil. -Qed. -Local Notation c1 := FTtypeP_Ind_Fitting_reg_Fcore. - -(* This is the main part of the proof of Peterfalvi (13.13). *) -Lemma FTtypeP_Ind_Fitting_nonGalois_facts : - ~~ typeP_Galois StypeP -> q = 3 /\ #|U| = (p.-1./2 ^ 2)%N. -Proof. -have even_p1: 2 %| p.-1 by rewrite -subn1 -subSS dvdn_sub ?dvdn2 //= mFT_odd. -move=> gal'S; have{gal'S} u_dv_p2q: u %| p.-1./2 ^ q.-1. - have [H1 [_ _ _ _ []]] := typeP_Galois_Pn maxS notStype5 gal'S. - rewrite Ptype_factor_prime ?Ptype_Fcompl_kernel_cent // -/p -/q. - set a := #|U : _| => a_gt1 a_dv_p1 _ [Uhat isoUhat]. - have a_odd: odd a by rewrite (dvdn_odd (dvdn_indexg _ _)) ?mFT_odd. - have [_ _ nPU _] := sdprodP defPU. - rewrite /u -card_quotient ?normsI ?normG ?norms_cent // (card_isog isoUhat). - apply: dvdn_trans (cardSg (subsetT _)) _; rewrite cardsT card_matrix mul1n. - rewrite card_ord Zp_cast ?dvdn_exp2r // -(@Gauss_dvdl a _ 2) ?coprimen2 //. - by rewrite -divn2 divnK. -have [_ lb5_m lb3_m] := lb_m_cases. -pose f r : algC := r%:R / (2 ^ r.-1)%:R. -have ub_m: m < f q. - apply: ltr_le_trans gen_ub_m _; rewrite c1 mul1n. - rewrite natrM ler_pdivr_mulr ?ltr0n ?expn_gt0 ?cardG_gt0 // -mulrA. - rewrite ler_wpmul2l ?ler0n // mulrC !natrX -expr_div_n. - apply: ler_trans (_ : (p.-1 %/ 2)%:R ^+ q.-1 <= _). - by rewrite -natrX leC_nat divn2 dvdn_leq // expn_gt0 -(subnKC pgt2). - rewrite -(subnKC qgt2) ler_pexpn2r ?rpred_div ?rpred_nat // natf_div //. - by rewrite ler_wpmul2r ?invr_ge0 ?ler0n // leC_nat leq_pred. -have{ub_m} q3: q = 3. - apply: contraTeq ub_m; rewrite neq_ltn ltnNge qgt2 -(odd_geq 5) ?mFT_odd //=. - move=> qge5; rewrite ltr_gtF // -(subnKC qge5). - elim: (q - 5)%N => [|r]; last apply: ler_lt_trans. - by apply: ltr_trans (lb5_m qge5); rewrite /f -!CratrE; compute. - rewrite addnS ler_pdivr_mulr ?ltr0n ?expn_gt0 // natrM mulrACA mulrA. - by rewrite divfK ?pnatr_eq0 ?expn_eq0 // mulr_natr mulrS ler_add2r ler1n. -have [[]] := dvdnP u_dv_p2q; rewrite q3; first by rewrite -(subnKC pgt2). -case=> [|b] Du; first by rewrite oU c1 Du muln1 mul1n. -have [_ /idPn[]] := lb3_m q3; rewrite c1 divr1 ler_gtF //. -apply: ler_trans (_ : (p.-1 ^ 2)%:R / 8%:R <= _). - rewrite (natrX _ 2 3) exprSr invfM mulrA natrX -expr_div_n -natf_div // divn2. - by rewrite -natrX Du ler_pdivl_mulr ?ltr0n // mulrC -natrM leC_nat leq_mul. -rewrite -!subn1 (subn_sqr p 1) !natrM -!mulrA ler_wpmul2l ?ler0n //. -rewrite ler_pdivr_mulr 1?mulrAC ?ler_pdivl_mulr ?ltr0n // -!natrM leC_nat. -rewrite (mulnA _ 3 2) (mulnA _ 4 2) leq_mul // mulnBl mulnDl leq_subLR. -by rewrite addnCA (mulnSr p 3) -addnA leq_addr. -Qed. - -(* This is the bulk of the proof of Peterfalvi (13.15). *) -(* We improve slightly on the end of the argument by maing better use of the *) -(* bound on u to get p = 5 directly. *) -Lemma FTtypeP_Ind_Fitting_Galois_ub b : - (p ^ q).-1 %/ p.-1 = (b * u)%N -> (b <= q.*2)%N. -Proof. -move=> Dbu; have: U :!=: 1%g by have [[_ _ /Frobenius_context[]]] := Sfacts. -rewrite trivg_card1 oU c1 muln1 leqNgt; apply: contra => bgt2q. -have [|q3 pge5] := small_m_q3. - apply: ltr_le_trans gen_ub_m _; rewrite c1 mul1n !natrM -!mulrA. - rewrite ler_wpmul2l ?ler0n // ler_pdivr_mulr ?ltr0n ?expn_gt0 ?cardG_gt0 //. - rewrite mulrAC invfM -natrM -expnS prednK ?cardG_gt0 // mulrCA. - rewrite ler_pdivl_mull ?ltr0n // -natrM. - apply: ler_trans (_ : (b * u)%:R <= _); first by rewrite leC_nat leq_mul. - rewrite -Dbu natf_div ?dvdn_pred_predX // ler_wpmul2r ?invr_ge0 ?ler0n //. - by rewrite leC_nat leq_pred. -have ub_p: ((p - 3) ^ 2 < 4 ^ 2)%N. - have [_ _ [] // _] := lb_m_cases; rewrite c1 divr1 ltr_pdivr_mulr ?ltr0n //. - rewrite -natrM ltC_nat prednK ?expn_gt0 ?cardG_gt0 // => /(leq_mul bgt2q). - rewrite mulnC mulnA -Dbu q3 predn_exp mulKn; last by rewrite -(subnKC pgt2). - rewrite 2!big_ord_recl big_ord1 /= /bump /= !mulnDl expn0 expn1. - rewrite addnA mulnS leq_add2r -(leq_add2r 9) (mulnCA p 2 3) -addnA addnCA. - by rewrite -leq_subLR -(sqrn_sub pgt2). -have{ub_p pge5} p5: p = 5. - apply/eqP; rewrite eqn_leq pge5 andbT. - by rewrite ltn_sqr ltnS leq_subLR -ltnS odd_ltn ?mFT_odd in ub_p. -have bgt1: (1 < b)%N by rewrite -(subnKC bgt2q) q3. -rewrite -(eqn_pmul2l (ltnW bgt1)) muln1 eq_sym. -by apply/eqP/prime_nt_dvdP; rewrite ?dvdn_mulr ?gtn_eqF // -Dbu q3 p5. -Qed. - -End Thirteen_10_to_13_15. - -(* This is Peterfalvi (13.12). *) -Lemma FTtypeP_reg_Fcore : C :=: 1%g. -Proof. -have [] := boolP (has irrIndH calS); last first. - by case/(FTtypeP_no_Ind_Fitting_facts maxS StypeP). -by case/hasP=> lambda Slam /FTtypeP_Ind_Fitting_reg_Fcore/card1_trivg->. -Qed. - -Lemma Ptype_Fcompl_kernel_trivial : Ptype_Fcompl_kernel StypeP :=: 1%g. -Proof. by rewrite Ptype_Fcompl_kernel_cent ?FTtypeP_reg_Fcore. Qed. - -(* Since C is trivial, from here on u will denote #|U|. *) -Let u := #|U|. -Let ustar := (p ^ q).-1 %/ p.-1. - -(* This is Peterfalvi (13.13). *) -Lemma FTtypeP_nonGalois_facts : - ~~ typeP_Galois StypeP -> q = 3 /\ u = (p.-1./2 ^ 2)%N. -Proof. -move=> gal'S; have: has irrIndH calS. - by apply: contraR gal'S => /(FTtypeP_no_Ind_Fitting_facts maxS StypeP)[]. -by case/hasP=> lambda Slam /FTtypeP_Ind_Fitting_nonGalois_facts; apply. -Qed. - -Import FinRing.Theory. - -(* This is Peterfalvi (13.14). *) -Lemma FTtypeP_primes_mod_cases : - [/\ odd ustar, - p == 1 %[mod q] -> q %| ustar - & p != 1 %[mod q] -> - [/\ coprime ustar p.-1, ustar == 1 %[mod q] - & forall b, b %| ustar -> b == 1 %[mod q]]]. -Proof. -have ustar_mod r: p = 1 %[mod r] -> ustar = q %[mod r]. - move=> pr1; rewrite -[q]card_ord -sum1_card /ustar predn_exp //. - rewrite -(subnKC pgt2) mulKn // subnKC //. - elim/big_rec2: _ => // i s1 s2 _ eq_s12. - by rewrite -modnDm -modnXm pr1 eq_s12 modnXm modnDm exp1n. -have ustar_odd: odd ustar. - by apply: (can_inj oddb); rewrite -modn2 ustar_mod ?modn2 ?mFT_odd. -split=> // [p1_q|p'1_q]; first by rewrite /dvdn ustar_mod ?modnn //; apply/eqP. -have ustar_gt0: (ustar > 0)%N by rewrite odd_geq. -have [p1_gt0 p_gt0]: (p.-1 > 0 /\ p > 0)%N by rewrite -(subnKC pgt2). -have co_ustar_p1: coprime ustar p.-1. - rewrite coprime_pi' //; apply/pnatP=> //= r pr_r. - rewrite inE -subn1 -eqn_mod_dvd //= mem_primes pr_r ustar_gt0 => /eqP rp1. - rewrite /dvdn ustar_mod // [_ == _]dvdn_prime2 //. - by apply: contraNneq p'1_q => <-; apply/eqP. -suffices ustar_mod_q b: b %| ustar -> b == 1 %[mod q]. - by split; rewrite // ustar_mod_q. -move=> b_dv_ustar; have b_gt0 := dvdn_gt0 ustar_gt0 b_dv_ustar. -rewrite (prod_prime_decomp b_gt0) prime_decompE big_map /= big_seq. -elim/big_rec: _ => // r s /(pi_of_dvd b_dv_ustar ustar_gt0). -rewrite mem_primes -modnMml -modnXm => /and3P[pr_r _ r_dv_ustar]. -suffices{s} ->: r = 1 %[mod q] by rewrite modnXm modnMml exp1n mul1n. -apply/eqP; rewrite eqn_mod_dvd ?prime_gt0 // subn1. -have ->: r.-1 = #|[set: {unit 'F_r}]|. - rewrite card_units_Zp ?prime_gt0 ?pdiv_id //. - by rewrite -[r]expn1 totient_pfactor ?muln1. -have pq_r: p%:R ^+ q == 1 :> 'F_r. - rewrite -subr_eq0 -natrX -(@natrB _ _ 1) ?expn_gt0 ?cardG_gt0 // subn1. - rewrite -(divnK (dvdn_pred_predX p q)) -Fp_nat_mod //. - by rewrite -modnMml (eqnP r_dv_ustar) mod0n. -have Up_r: (p%:R : 'F_r) \is a GRing.unit. - by rewrite -(unitrX_pos _ (prime_gt0 pr_q)) (eqP pq_r) unitr1. -congr (_ %| _): (order_dvdG (in_setT (FinRing.unit 'F_r Up_r))). -apply/prime_nt_dvdP=> //; last by rewrite order_dvdn -val_eqE val_unitX. -rewrite -dvdn1 order_dvdn -val_eqE /= -subr_eq0 -val_eqE -(@natrB _ p 1) //=. -rewrite subn1 val_Fp_nat //; apply: contraFN (esym (mem_primes r 1)). -by rewrite pr_r /= -(eqnP co_ustar_p1) dvdn_gcd r_dv_ustar. -Qed. - -(* This is Peterfalvi (13.15). *) -Lemma card_FTtypeP_Galois_compl : - typeP_Galois StypeP -> u = (if p == 1 %[mod q] then ustar %/ q else ustar). -Proof. -case/typeP_Galois_P=> //= _ _ [_ _ /dvdnP[b]]; rewrite Ptype_factor_prime //. -rewrite -/ustar Ptype_Fcompl_kernel_trivial -(card_isog (quotient1_isog _)) -/u. -move=> Dbu; have ub_b: (b <= q.*2)%N. - have [[lambda Slam irrHlam]| ] := altP (@hasP _ irrIndH calS). - apply: (FTtypeP_Ind_Fitting_Galois_ub Slam irrHlam). - by rewrite FTtypeP_reg_Fcore indexg1. - case/(FTtypeP_no_Ind_Fitting_facts maxS StypeP) => _ /= ->. - rewrite indexg1 -/ustar -(leq_pmul2r (cardG_gt0 U)) -/u => Du. - by rewrite -Dbu -Du -(subnKC qgt2) leq_pmull. -have [ustar_odd p1_q p'1_q] := FTtypeP_primes_mod_cases. -have b_odd: odd b by rewrite Dbu odd_mul mFT_odd andbT in ustar_odd. -case: ifPn => [/p1_q q_dv_ustar | /p'1_q[_ _ /(_ b)]]. - have /dvdnP[c Db]: q %| b. - rewrite Dbu Gauss_dvdl // coprime_sym in q_dv_ustar. - by apply: coprimeSg coPUq; have /mulG_sub[_ sUPU] := sdprodW defPU. - have c_odd: odd c by rewrite Db odd_mul mFT_odd andbT in b_odd. - suffices /eqP c1: c == 1%N by rewrite Dbu Db c1 mul1n mulKn ?prime_gt0. - rewrite eqn_leq odd_gt0 // andbT -ltnS -(odd_ltn 3) // ltnS. - by rewrite -(leq_pmul2r (ltnW (ltnW qgt2))) -Db mul2n. -have Db: b = (b - 1).+1 by rewrite subn1 prednK ?odd_gt0. -rewrite Dbu dvdn_mulr // eqn_mod_dvd Db // -Db => /(_ isT)/dvdnP[c Db1]. -have c_even: ~~ odd c by rewrite Db Db1 /= odd_mul mFT_odd andbT in b_odd. -suffices /eqP->: b == 1%N by rewrite mul1n. -have:= ub_b; rewrite Db Db1 -mul2n ltn_pmul2r ?cardG_gt0 //. -by rewrite -ltnS odd_ltn //= !ltnS leqn0 => /eqP->. -Qed. - -(* This is Peterfalvi (13.16). *) -(* We have transposed T and Q here so that the lemma does not require *) -(* assumptions on the associate group. *) -Lemma FTtypeP_norm_cent_compl : P ><| W1 = 'N(W2) /\ P ><| W1 = 'C(W2). -Proof. -have [/mulG_sub[_ sW1S] /mulG_sub[sPPU sUPU]] := (sdprodW defS, sdprodW defPU). -have nPW1: W1 \subset 'N(P) by rewrite (subset_trans sW1S) ?gFnorm. -have [[_ _ frobUW1 cUU] [abelP _] _ _ _] := Sfacts. -have [pP cPP _] := and3P abelP; have [_ _ cW12 tiW12] := dprodP defW. -have cW2P: P \subset 'C(W2) by rewrite sub_abelian_cent. -suffices sNPW2: 'N(W2) \subset P <*> W1. - have cW2PW1: P <*> W1 \subset 'C(W2) by rewrite join_subG cW2P centsC. - rewrite sdprodEY ?coprime_TIg ?(coprimeSg sPPU) //. - split; apply/eqP; rewrite eqEsubset ?(subset_trans cW2PW1) ?cent_sub //. - by rewrite (subset_trans (cent_sub _)). -have tiP: normedTI P^# G S. - have [_ _ _] := compl_of_typeII_IV maxS StypeP notStype5. - by rewrite -defH FTtypeP_reg_Fcore dprodg1. -have ->: 'N(W2) = 'N_S(W2). - apply/esym/setIidPr/subsetP=> y nW2y; have [x W2x ntx] := trivgPn _ ntW2. - have [_ _ tiP_J] := normedTI_memJ_P tiP. - by rewrite -(tiP_J x) ?inE ?conjg_eq1 // ntx (subsetP sW2P) ?memJ_norm. -rewrite -{1}(sdprodW defS) setIC -group_modr ?cents_norm 1?centsC //=. -rewrite mulG_subG joing_subr /= -(sdprodW defPU) setIC. -rewrite -group_modl ?cents_norm //= mulG_subG joing_subl /= andbT. -set K := 'N_U(W2); have sKPU: K \subset PU by rewrite subIset ?sUPU. -have{sKPU} nPKW1: K <*> W1 \subset 'N(P). - by rewrite gFnorm_trans ?normsG // -(sdprodWY defS) genS ?setSU. -have nW2KW1: K <*> W1 \subset 'N(W2). - by rewrite join_subG subsetIr cents_norm // centsC. -have coPKW1: coprime #|P| #|K <*> W1|. - by rewrite (coprimegS _ (Ptype_Fcore_coprime StypeP)) ?genS ?setSU ?subsetIl. -have p'KW1: p^'.-group (K <*> W1). - by rewrite /pgroup p'natE // -prime_coprime ?(coprimeSg sW2P). -have [Q1 defP nQ1KW1] := Maschke_abelem abelP p'KW1 sW2P nPKW1 nW2KW1. -have [-> | ntK] := eqVneq K 1%g; first by rewrite sub1G. -have frobKW1: [Frobenius K <*> W1 = K ><| W1]. - apply: Frobenius_subl frobUW1; rewrite ?subsetIl //. - rewrite normsI ?norms_norm //; first by have [_ []] := StypeP. - by rewrite cents_norm // centsC. -have regQ1W1: 'C_Q1(W1) = 1%g. - have [_ /mulG_sub[_ /setIidPl defQ1] _ tiW2Q1] := dprodP defP. - by rewrite -defQ1 -setIA (typeP_cent_core_compl StypeP) setIC. -have cQ1K: K \subset 'C(Q1). - have /mulG_sub[_ sQ1P] := dprodW defP; have coQ1KW1 := coprimeSg sQ1P coPKW1. - have solQ1 := solvableS sQ1P (abelian_sol cPP). - by have [_ ->] := Frobenius_Wielandt_fixpoint frobKW1 nQ1KW1 coQ1KW1 solQ1. -have /subsetIP[_ cW1K]: K \subset 'C_(K <*> W1)(W2). - have cCW1: W1 \subset 'C_(K <*> W1)(W2) by rewrite subsetI joing_subr centsC. - apply: contraR ntW1 => /(Frobenius_normal_proper_ker frobKW1) ltCK. - rewrite -subG1; have [/eqP/sdprodP[_ _ _ <-] _] := andP frobKW1. - rewrite subsetIidr (subset_trans cCW1) // proper_sub //. - rewrite ltCK //; last by rewrite norm_normalI ?norms_cent. - by rewrite (solvableS _ (abelian_sol cUU)) ?subsetIl. -case/negP: ntK; rewrite -subG1 -FTtypeP_reg_Fcore subsetI subsetIl /=. -by rewrite -(dprodW defP) centM subsetI cW1K. -Qed. - -End Thirteen_4_10_to_16. - -Section Thirteen_17_to_19. - -(* These assumptions repeat the part of Peterfalvi, Hypothesis (13.1) used *) -(* to prove (13.17-19). *) - -Variables S U W W1 W2 : {group gT}. -Hypotheses (maxS : S \in 'M) (defW : W1 \x W2 = W). -Hypotheses (StypeP : of_typeP S U defW). - -Local Notation "` 'W1'" := (gval W1) (at level 0, only parsing) : group_scope. -Local Notation "` 'W2'" := (gval W2) (at level 0, only parsing) : group_scope. -Local Notation "` 'W'" := (gval W) (at level 0, only parsing) : group_scope. -Local Notation V := (cyclicTIset defW). - -Local Notation "` 'S'" := (gval S) (at level 0, only parsing) : group_scope. -Local Notation P := `S`_\F%G. -Local Notation "` 'P'" := `S`_\F (at level 0) : group_scope. -Local Notation PU := S^`(1)%G. -Local Notation "` 'PU'" := `S^`(1) (at level 0) : group_scope. -Local Notation "` 'U'" := (gval U) (at level 0, only parsing) : group_scope. - -Let defS : PU ><| W1 = S. Proof. by have [[]] := StypeP. Qed. -Let defPU : P ><| U = PU. Proof. by have [_ []] := StypeP. Qed. - -Let notStype1 : FTtype S != 1%N. Proof. exact: FTtypeP_neq1 StypeP. Qed. -Let notStype5 : FTtype S != 5%N. Proof. exact: FTtype5_exclusion maxS. Qed. - -Let pddS := FT_prDade_hypF maxS StypeP. -Let ptiWS : primeTI_hypothesis S PU defW := FT_primeTI_hyp StypeP. -Let ctiWG : cyclicTI_hypothesis G defW := pddS. -Local Notation Sfacts := (FTtypeP_facts maxS StypeP). - -Let ntW1 : W1 :!=: 1. Proof. by have [[]] := StypeP. Qed. -Let ntW2 : W2 :!=: 1. Proof. by have [_ _ _ []] := StypeP. Qed. -Let cycW1 : cyclic W1. Proof. by have [[]] := StypeP. Qed. -Let cycW2 : cyclic W2. Proof. by have [_ _ _ []] := StypeP. Qed. - -Let p := #|W2|. -Let q := #|W1|. - -Let pr_p : prime p. Proof. by have [] := FTtypeP_primes maxS StypeP. Qed. -Let pr_q : prime q. Proof. by have [] := FTtypeP_primes maxS StypeP. Qed. - -Let qgt2 : q > 2. Proof. by rewrite odd_gt2 ?mFT_odd ?cardG_gt1. Qed. -Let pgt2 : p > 2. Proof. by rewrite odd_gt2 ?mFT_odd ?cardG_gt1. Qed. - -Let coPUq : coprime #|PU| q. -Proof. by rewrite (coprime_sdprod_Hall_r defS); have [[]] := StypeP. Qed. - -Let sW2P: W2 \subset P. Proof. by have [_ _ _ []] := StypeP. Qed. - -Let p'q : q != p. -Proof. -by rewrite -dvdn_prime2 -?prime_coprime -?(cyclic_dprod defW) //; case: ctiWG. -Qed. - -Let nirrW1 : #|Iirr W1| = q. Proof. by rewrite card_Iirr_cyclic. Qed. -Let nirrW2 : #|Iirr W2| = p. Proof. by rewrite card_Iirr_cyclic. Qed. -Let NirrW1 : Nirr W1 = q. Proof. by rewrite -nirrW1 card_ord. Qed. -Let NirrW2 : Nirr W2 = p. Proof. by rewrite -nirrW2 card_ord. Qed. - -Local Open Scope ring_scope. - -Let sigma := (cyclicTIiso ctiWG). -Let w_ i j := (cyclicTIirr defW i j). -Local Notation eta_ i j := (sigma (w_ i j)). - -Let mu_ := primeTIred ptiWS. -Local Notation tau := (FT_Dade0 maxS). - -Let calS0 := seqIndD PU S S`_\s 1. -Let rmR := FTtypeP_coh_base maxS StypeP. -Let scohS0 : subcoherent calS0 tau rmR. -Proof. exact: FTtypeP_subcoherent StypeP. Qed. - -Let calS := seqIndD PU S P 1. -Let sSS0 : cfConjC_subset calS calS0. -Proof. exact/seqInd_conjC_subset1/Fcore_sub_FTcore. Qed. - -(* This is Peterfalvi (13.17). *) -Lemma FTtypeII_support_facts T L (Q := T`_\F) (H := L`_\F) : - FTtype S == 2 -> typeP_pair S T defW -> L \in 'M('N(U)) -> - [/\ (*a*) [Frobenius L with kernel H], - (*b*) U \subset H - & (*c*) H ><| W1 = L \/ (exists2 y, y \in Q & H ><| (W1 <*> W2 :^ y) = L)]. -Proof. -move=> Stype2 pairST /setIdP[maxL sNU_L]. -have [pgt0 qgt0] := (ltnW (ltnW pgt2), ltnW (ltnW qgt2)). -have [[_ _ maxT] _ _ _ allST] := pairST. -have [[_ ntU _ _] _ not_sNU_S _ _] := compl_of_typeII maxS StypeP Stype2. -have [[_ _ frobUW1 cUU] _ _ _ _] := Sfacts. -have xdefW: W2 \x W1 = W by rewrite dprodC. -have [V TtypeP] := typeP_pairW (typeP_pair_sym xdefW pairST). -have [abelQ oQ]: q.-abelem Q /\ #|Q| = (q ^ p)%N. - by have [] := FTtypeP_facts maxT TtypeP. -have sUL: U \subset L := subset_trans (normG U) sNU_L. -have [/mulG_sub[sPPU sUPU] sPUS] := (sdprodW defPU, der_sub 1 S). -have nUW1: W1 \subset 'N(U) by have [_ []] := StypeP. -have sW1L := subset_trans nUW1 sNU_L. -have Ltype1: FTtype L == 1%N. - apply: contraR not_sNU_S => /allST/setUP[]// /imsetP[y _ defL]. - have hallU: \pi(U).-Hall(S) U. - have /Hall_pi/(subHall_Hall _ (piSg sUPU)): Hall PU U. - have /pHall_Hall:= pHall_subl sPPU sPUS (Fcore_Hall S). - by rewrite (sdprod_Hall defPU). - by apply; rewrite Hall_pi // -(coprime_sdprod_Hall_l defS). - have hallUy: \pi(U).-Hall(S) (U :^ y^-1). - by rewrite pHallE sub_conjgV -defL sUL /= cardJg -(card_Hall hallU). - have [x /conjGid <- ->] := Hall_trans (mmax_sol maxS) hallU hallUy. - by rewrite !normJ conjSg sub_conjgV -defL. - have oH: #|H| = (q ^ p)%N by rewrite /H defL FcoreJ cardJg. - have sW1H: W1 \subset H. - rewrite (sub_normal_Hall (Fcore_Hall L)) ?gFnormal //=. - by rewrite oH pi_of_exp ?prime_gt0 // pgroup_pi. - have regUW1: 'C_U(W1) = 1%g := Frobenius_trivg_cent frobUW1. - have /negP[] := ntU; rewrite -subG1 -regUW1 subsetIidl (sameP commG1P trivgP). - have /coprime_TIg <-: coprime #|U| #|H|. - by rewrite oH coprime_pexpr ?(coprimeSg sUPU). - rewrite commg_subI //; last by rewrite subsetI sW1H. - by rewrite subsetIidl (subset_trans sUL) ?gFnorm. -have frobL := FTtype1_Frobenius maxL Ltype1. -have solH: solvable H by rewrite nilpotent_sol ?Fcore_nil. -have coHW1: coprime #|H| #|W1|. - rewrite -(coprime_pexpr _ _ pgt0) -oQ. - apply/(coprimegS (Fcore_sub_FTcore maxT))/(coprimeSg (Fcore_sub_FTcore maxL)). - have [_ -> //] := FT_Dade_support_partition gT. - have: FTtype T != 1%N := FTtypeP_neq1 maxT TtypeP. - by apply: contra => /imsetP[y _ ->] /=; rewrite FTtypeJ. -have tiHW1: H :&: W1 = 1%g := coprime_TIg coHW1. -have sUH: U \subset H; last split=> //. - have [ntH _ /andP[sHL nHL] regHL] := Frobenius_kerP frobL. - have regHE E: gval E != 1%g -> E \subset L -> H :&: E = 1%g -> 'C_H(E) = 1%g. - move=> ntE sEL tiHE; apply: contraNeq ntE => /trivgPn[x /setIP[Hx cEx] ntx]. - rewrite -subG1 -tiHE subsetIidr (subset_trans _ (regHL x _)) ?inE ?ntx //. - by rewrite subsetI sEL sub_cent1. - suffices /trivgPn[x /setIP[Hx Ux] ntx]: H :&: U != 1%g. - apply: subset_trans (regHL x _); last by rewrite !inE ntx. - by rewrite subsetI sUL sub_cent1 (subsetP cUU). - apply: contraNneq (ntH) => tiHU; rewrite trivg_card1. - have [nHU nHW1] := (subset_trans sUL nHL, subset_trans sW1L nHL). - have nHUW1: U <*> W1 \subset 'N(H) by rewrite join_subG nHU. - have coHUW1: coprime #|H| #|U <*> W1|. - have [/eqP defUW1 _] := andP frobUW1. - rewrite (sdprodWY defUW1) -(sdprod_card defUW1) coprime_mulr coHW1 andbT. - have defHU: H ><| U = H <*> U by rewrite sdprodEY. - rewrite (coprime_sdprod_Hall_l defHU). - apply: pHall_Hall (pHall_subl (joing_subl _ _) _ (Fcore_Hall L)). - by rewrite join_subG sHL. - have [_ _] := Frobenius_Wielandt_fixpoint frobUW1 nHUW1 coHUW1 solH. - by move->; rewrite regHE // cards1 exp1n. -have [E sW1E frobHE]: exists2 E, W1 \subset gval E & [Frobenius L = H ><| E]. - have [E frobHE] := existsP frobL; have [/eqP defL _] := andP frobHE. - have hallE: \pi(H)^'.-Hall(L) E. - by rewrite -(compl_pHall E (Fcore_Hall L)) sdprod_compl. - have [|x Lx sW1Ex] := Hall_subJ (mmax_sol maxL) hallE sW1L. - by rewrite /pgroup -coprime_pi' ?cardG_gt0. - rewrite -(FrobeniusJ x) conjGid // (normsP (gFnorm _ _)) // in frobHE. - by exists (E :^ x)%G. -have [defL ntH ntE _ _] := Frobenius_context frobHE. -have [_ sEL _ nHE _] := sdprod_context defL. -have solE := solvableS sEL (mmax_sol maxL). -have [regHE regEH] := (Frobenius_reg_ker frobHE, Frobenius_reg_compl frobHE). -have qW1: q.-group W1 by apply: pnat_id. -have cycEr (r : nat) R: r.-group R -> R \subset E -> cyclic R. - move=> rR sRE; have nHR := subset_trans sRE nHE. - apply: odd_regular_pgroup_cyclic rR (mFT_odd _) ntH nHR _. - by move=> y /setD1P[nty Ry]; rewrite regHE // !inE nty (subsetP sRE). -have /normal_norm nW1E: W1 <| E. - exact: prime_odd_regular_normal (mFT_odd E) _ _ _ (Frobenius_reg_ker frobHE). -have defNW1: Q ><| W2 = 'N(W1). - by have [] := FTtypeP_norm_cent_compl maxT TtypeP. -have [nsQN sW2N _ _ _] := sdprod_context defNW1. -have sylQ: q.-Sylow('N(W1)) Q. - rewrite /pHall normal_sub // abelem_pgroup //=. - by rewrite -(index_sdprod defNW1) pnatE //= !inE eq_sym. -have hallW2: q^'.-Hall('N(W1)) W2 by rewrite -(compl_pHall _ sylQ) sdprod_compl. -pose Q1 := Q :&: E; have sylQ1: q.-Sylow(E) Q1 by apply: setI_normal_Hall nW1E. -have defQ1: Q1 = W1. - have abelQ1: q.-abelem Q1 := abelemS (subsetIl Q E) abelQ. - have sW1Q: W1 \subset Q by have [_ _ _ []] := TtypeP. - have sW1Q1: W1 \subset Q1 by apply/subsetIP. - have ntQ1: Q1 != 1%g by apply: subG1_contra ntW1. - apply/esym/eqP; rewrite eqEcard sW1Q1 (cyclic_abelem_prime abelQ1) //=. - by rewrite (cycEr q) ?(pHall_pgroup sylQ1) ?subsetIr. -have [P2 hallP2] := Hall_exists q^' solE; have [sP2E q'P2 _] := and3P hallP2. -have defE: W1 ><| P2 = E. - apply/(sdprod_normal_p'HallP _ hallP2); rewrite /= -defQ1 //. - by rewrite /Q1 setIC norm_normalI // (subset_trans nW1E) ?normal_norm. -have [P2_1 | ntP2] := eqsVneq P2 1%g. - by left; rewrite -defE P2_1 sdprodg1 in defL. -have solNW1: solvable 'N(W1). - by rewrite mFT_sol ?mFT_norm_proper // mFT_sol_proper (solvableS sW1E). -have [zy /=] := Hall_subJ solNW1 hallW2 (subset_trans sP2E nW1E) q'P2. -rewrite -{1}(sdprodWC defNW1) => /mulsgP[z y W2z Qy ->{zy}]. -rewrite conjsgM (conjGid W2z) {z W2z} => sP2W2y. -right; exists y => //; congr (_ ><| _ = _): defL. -rewrite -(sdprodWY defE); congr (W1 <*> _). -by apply/eqP; rewrite eqEsubset sP2W2y prime_meetG ?cardJg ?(setIidPr _). -Qed. - -Local Notation Imu2 := (primeTI_Iirr ptiWS). -Local Notation mu2_ i j := (primeTIirr ptiWS i j). - -Definition FTtypeP_bridge j := 'Ind[S, P <*> W1] 1 - mu2_ 0 j. -Local Notation beta_ := FTtypeP_bridge. -Definition FTtypeP_bridge_gap := tau (beta_ #1) - 1 + eta_ 0 #1. -Local Notation Gamma := FTtypeP_bridge_gap. - -Let u := #|U|. - -(* This is Peterfalvi (13.18). *) -(* Part (d) is stated with a slightly weaker hypothesis that fits better with *) -(* the usage pattern in (13.19) and (14.9). *) -Lemma FTtypeP_bridge_facts (V_S := class_support (cyclicTIset defW) S) : - [/\ (*a*) [/\ forall j, j != 0 -> beta_ j \in 'CF(S, 'A0(S)) - & forall j, j != 0 -> beta_ j \in 'CF(S, P^# :|: V_S)], - (*b*) forall j, j != 0 -> '[beta_ j] = (u.-1 %/ q + 2)%:R, - (*c*) [/\ forall j, j != 0 -> tau (beta_ j) - 1 + eta_ 0 j = Gamma, - '[Gamma, 1] = 0 & cfReal Gamma], - (*d*) forall X Y : 'CF(G), - Gamma = X + Y -> '[X, Y] = 0 -> - orthogonal Y (map sigma (irr W)) -> - '[Y] <= (u.-1 %/ q)%:R - & q %| u.-1]. -Proof. -have [_ sW1S _ nPUW1 tiPUW1] := sdprod_context defS. -have /mulG_sub[sPPU sUPU] := sdprodW defPU. -have sPW1S: P <*> W1 \subset S by rewrite join_subG gFsub. -have /= defS_P := Ptype_Fcore_sdprod StypeP; have nsPS: P <| S := gFnormal _ _. -have defPW1: P ><| W1 = P <*> W1 := sdprod_subr defS_P (joing_subr U W1). -pose W1bar := (W1 / P)%g; pose Sbar := (S / P)%g; pose Ubar := (U / P)%g. -pose gamma := 'Ind[Sbar, W1bar] 1. -have Dgamma: 'Ind[S, P <*> W1] 1 = (gamma %% P)%CF. - rewrite -(rmorph1 _ : 1 %% P = 1)%CF cfIndMod ?joing_subl //. - by rewrite quotientYidl //; have [] := sdprodP defPW1. -have gamma1: gamma 1%g = u%:R. - rewrite -cfMod1 -Dgamma cfInd1 // cfun11 -divgS // -(sdprod_card defPW1). - by rewrite mulr1 -(sdprod_card defS) -(sdprod_card defPU) divnMr // mulKn. -have frobUW1: [Frobenius U <*> W1 = U ><| W1] by have [[]] := Sfacts. -have q_dv_u1: q %| u.-1 := Frobenius_dvd_ker1 frobUW1. -have [nP_UW1 /isomP[/=]] := sdprod_isom defS_P; set h := restrm _ _ => injh hS. -have /joing_sub[sUUW1 sW1UW1] := erefl (U <*> W1). -have [hU hW1]: h @* U = Ubar /\ h @* W1 = W1bar. - by rewrite !morphim_restrm /= !(setIidPr _). -have{hS} frobSbar: [Frobenius Sbar = Ubar ><| W1bar]. - by rewrite -[Sbar]hS -hU -hW1 injm_Frobenius. -have tiW1bar: normedTI W1bar^# Sbar W1bar by have /and3P[] := frobSbar. -have gammaW1 xbar: xbar \in W1bar^# -> gamma xbar = 1. - move=> W1xbar; have [ntxbar _] := setD1P W1xbar. - rewrite cfIndE ?quotientS //; apply: canLR (mulKf (neq0CG _)) _. - have ->: #|W1bar| = #|Sbar :&: W1bar| by rewrite (setIidPr _) ?quotientS. - rewrite mulr1 cardsE -sumr_const big_mkcondr; apply: eq_bigr => zbar Szbar. - have [_ _ W1bar_xJ] := normedTI_memJ_P tiW1bar. - by rewrite -mulrb -(W1bar_xJ xbar) // !inE conjg_eq1 ntxbar cfun1E. -have PVSbeta j: j != 0 -> beta_ j \in 'CF(S, P^# :|: V_S). - move=> nzj; apply/cfun_onP=> z; rewrite !inE => /norP[P'z VS'z]. - have [Sz | /cfun0->//] := boolP (z \in S); apply/eqP; rewrite !cfunE subr_eq0. - have [[_ mulW12 _ tiW12] C1] := (dprodP defW, FTtypeP_reg_Fcore maxS StypeP). - have [PUz {VS'z} | PU'z {P'z}] := boolP (z \in PU). - rewrite eq_sym -(cfResE _ _ PUz) ?gFsub // -['Res _](scalerK (neq0CG W1)). - rewrite cfRes_prTIirr -cfRes_prTIred -/q cfunE cfResE ?gFsub // mulrC. - case/nandP: P'z => [/negbNE/eqP-> | P'z]. - rewrite Dgamma cfModE // morph1 gamma1 FTprTIred1 // C1 indexg1. - by rewrite natrM mulfK ?neq0CG. - have:= seqInd_on (Fitting_normal S) (FTprTIred_Ind_Fitting maxS StypeP nzj). - have [/= <- _ _ _] := typeP_context StypeP; rewrite C1 dprodg1 -/(mu_ j). - move/cfun_on0->; rewrite // mul0r (cfun_on0 (cfInd_on _ (cfun_onG _))) //. - rewrite -(sdprodW defPW1); apply: contra P'z => /imset2P[x t PW1x St Dz]. - rewrite Dz !memJ_norm ?(subsetP (gFnorm _ _)) // in PUz *. - by rewrite -(mulg1 P) -tiPUW1 setIC group_modl // inE PW1x. - have /imset2P[x t /setD1P[ntx W1x] St ->]: z \in class_support W1^# S. - have /bigcupP[_ /rcosetsP[x W1x ->]]: z \in cover (rcosets PU W1). - by rewrite (cover_partition (rcosets_partition_mul _ _)) (sdprodW defS). - have [-> | ntx] := eqVneq x 1%g; first by rewrite mulg1 => /idPn[]. - have nPUx: x \in 'N(PU) by rewrite (subsetP nPUW1). - have coPUx: coprime #|PU| #[x] by rewrite (coprime_dvdr (order_dvdG W1x)). - have [/cover_partition <- _] := partition_cent_rcoset nPUx coPUx. - have [_ _ _ [_ _ _ _ prPUW1] _] := StypeP; rewrite {}prPUW1 ?inE ?ntx //. - rewrite cover_imset => /bigcupP[t PUt /imsetP[_ /rcosetP[y W2y ->] Dz]]. - have{PUt} St: t \in S by rewrite (subsetP _ _ PUt) ?der_sub. - have [y1 | nty] := eqVneq y 1%g. - by rewrite Dz y1 mul1g memJ_class_support // !inE ntx. - rewrite Dz memJ_class_support // !inE groupMr // groupMl // in VS'z. - rewrite -(dprodWC defW) mem_mulg // andbT; apply/norP. - by rewrite -!in_set1 -set1gE -tiW12 !inE W1x W2y andbT in ntx nty. - rewrite !cfunJ // Dgamma cfModE ?(subsetP sW1S) // gammaW1; last first. - by rewrite !inE (morph_injm_eq1 injh) ?(subsetP sW1UW1) ?ntx ?mem_quotient. - rewrite prTIirr_id ?FTprTIsign // ?scale1r ?dprod_IirrEr; last first. - rewrite -in_set1 -set1gE -tiW12 inE W1x /= in ntx. - by rewrite inE ntx -mulW12 (subsetP (mulG_subl W2 W1)). - by rewrite -[x]mulg1 cfDprodEr ?lin_char1 ?irr_prime_lin. -have A0beta j: j != 0 -> beta_ j \in 'CF(S, 'A0(S)). - move/PVSbeta; apply: cfun_onS; rewrite (FTtypeP_supp0_def _ StypeP) //. - by rewrite setSU ?(subset_trans _ (FTsupp1_sub _)) ?setSD ?Fcore_sub_FTcore. -have norm_beta j: j != 0 -> '[beta_ j] = (u.-1 %/ q + 2)%:R. - move=> nzj; rewrite cfnormBd ?Dgamma; last first. - apply: contraNeq (cfker_prTIres pddS nzj); rewrite -irr_consttE => S1_mu0j. - rewrite -(cfRes_prTIirr _ 0) sub_cfker_Res //. - rewrite (subset_trans _ (cfker_constt _ S1_mu0j)) ?cfker_mod //. - by rewrite -Dgamma cfInd_char ?rpred1. - have [[/eqP defUW1 _] [/eqP defSbar _]] := (andP frobUW1, andP frobSbar). - rewrite cfnorm_irr cfMod_iso //. - rewrite (cfnormE (cfInd_on _ (cfun_onG _))) ?quotientS // -/gamma. - rewrite card_quotient ?gFnorm // -(index_sdprod defS_P) -(sdprod_card defUW1). - rewrite -/u -/q (big_setD1 1%g) ?mem_class_support ?group1 //=. - have{tiW1bar} [_ tiW1bar /eqP defNW1bar] := and3P tiW1bar. - rewrite gamma1 normr_nat class_supportD1 big_trivIset //=. - rewrite (eq_bigr (fun xbar => #|W1bar|.-1%:R)) ?sumr_const; last first. - rewrite (cardsD1 1%g) group1 /= => _ /imsetP[tbar Stbar ->]. - rewrite -sumr_const big_imset /=; last exact: in2W (conjg_inj tbar). - by apply: eq_bigr => xbar W1xbar; rewrite cfunJ ?gammaW1 // normr1 expr1n. - rewrite card_conjugates -divgS ?subsetIl //= -(sdprod_card defSbar) defNW1bar. - rewrite mulnK ?cardG_gt0 // -hU -hW1 ?card_injm // -/q -/u natrM invfM mulrC. - rewrite -[rhs in _ ^+ 2 + rhs]mulr_natr -mulrDl mulrA mulfK ?neq0CG //. - rewrite -subn1 natrB ?cardG_gt0 // addrCA mulrDl divff ?neq0CG //. - by rewrite -natrB ?cardG_gt0 // subn1 -natf_div // addrAC addrC natrD. -have nzj1: #1 != 0 :> Iirr W2 by apply: Iirr1_neq0. -have [_ _ _ _ [_ Dtau]] := Sfacts; pose eta01 := eta_ 0 #1. -have oeta01_1: '[eta01, 1] = 0. - by rewrite -(cycTIiso1 ctiWG) -(cycTIirr00 defW) cfdot_cycTIiso (negPf nzj1). -have Deta01s: eta01^*%CF = eta_ 0 (conjC_Iirr #1). - by rewrite cfAut_cycTIiso /w_ !dprod_IirrEr cfAutDprodr aut_IirrE. -have oGamma1: '[Gamma, 1] = 0. - rewrite cfdotDl cfdotBl cfnorm1 oeta01_1 addr0 Dtau ?A0beta //. - rewrite -cfdot_Res_r rmorph1 cfdotBl -cfdot_Res_r rmorph1 cfnorm1. - by rewrite -(prTIirr00 ptiWS) cfdot_prTIirr (negPf nzj1) subr0 subrr. -have defGamma j: j != 0 -> tau (beta_ j) - 1 + eta_ 0 j = Gamma. - move=> nzj; apply/eqP; rewrite -subr_eq0 opprD addrACA opprB !addrA subrK. - rewrite -linearB opprD addrACA subrr add0r -opprD linearN /=. - move/prDade_sub_TIirr: pddS => -> //; last first. - by apply: (mulfI (neq0CG W1)); rewrite -!prTIred_1 !FTprTIred1. - by rewrite -/sigma FTprTIsign // scale1r -addrA addNr. -have GammaReal: cfReal Gamma. - rewrite /cfReal rmorphD rmorphB rmorph1 /= Deta01s Dtau ?A0beta // cfAutInd. - rewrite rmorphB /= cfAutInd rmorph1 -prTIirr_aut aut_Iirr0 -/(beta_ _). - by rewrite -Dtau ?A0beta ?defGamma ?aut_Iirr_eq0. -split=> // X Y defXY oXY oYeta; pose a := '[Gamma, eta01]. -have Za: a \in Cint. - rewrite Cint_cfdot_vchar ?(rpredB, rpredD, rpred1, cycTIiso_vchar) //. - by rewrite Dtau ?A0beta // !(cfInd_vchar, rpredB) ?rpred1 ?irr_vchar. -have{oYeta} oYeta j: '[Y, eta_ 0 j] = 0. - by rewrite (orthoPl oYeta) ?map_f ?mem_irr. -have o_eta1s1: '[eta01^*, eta01] = 0. - rewrite Deta01s cfdot_cycTIiso /= -(inj_eq irr_inj) aut_IirrE. - by rewrite odd_eq_conj_irr1 ?mFT_odd // irr_eq1 (negPf nzj1). -rewrite -(ler_add2r 2%:R) -natrD -(norm_beta #1) //. -have ->: '[beta_ #1] = '[Gamma - eta01 + 1]. - by rewrite addrK subrK Dade_isometry ?A0beta. -rewrite addrA cfnormDd ?cfnorm1 ?ler_add2r; last first. - by rewrite cfdotBl oeta01_1 oGamma1 subrr. -rewrite defXY addrAC addrC cfnormDd ?ler_add2r; last first. - by rewrite cfdotBl oXY cfdotC oYeta conjC0 subrr. -have oXeta j: '[X, eta_ 0 j] = '[Gamma, eta_ 0 j]. - by rewrite defXY cfdotDl oYeta addr0. -pose X1 := X - a *: eta01 - a *: eta01^*%CF. -have ->: X - eta01 = X1 + a *: eta01^*%CF + (a - 1) *: eta01. - by rewrite scalerBl scale1r addrA !subrK. -rewrite cfnormDd; last first. - rewrite cfdotZr subrK cfdotBl oXeta -/a cfdotZl cfnorm_cycTIiso mulr1. - by rewrite subrr mulr0. -rewrite cfnormDd; last first. - rewrite cfdotZr !cfdotBl !cfdotZl Deta01s cfnorm_cycTIiso oXeta -Deta01s. - rewrite !cfdot_conjCr o_eta1s1 conjC0 mulr0 ((_ =P Gamma) GammaReal) -/a. - by rewrite conj_Cint // mulr1 subr0 subrr mulr0. -rewrite -addrA ler_paddl ?cfnorm_ge0 // !cfnormZ Deta01s !cfnorm_cycTIiso. -rewrite !mulr1 !Cint_normK ?rpredB ?rpred1 // sqrrB1 !addrA -mulr2n. -by rewrite -subr_ge0 addrK subr_ge0 ler_pmuln2r ?Cint_ler_sqr. -Qed. - -(* The assumptions of Peterfalvi (13.19). *) -(* We do not need to put these in a subsection as this is the last Lemma. *) -Variable L : {group gT}. -Hypotheses (maxL : L \in 'M) (Ltype1 : FTtype L == 1%N). - -Local Notation "` 'L'" := (gval L) (at level 0, only parsing) : group_scope. -Local Notation H := `L`_\F%G. -Local Notation "` 'H'" := `L`_\F (at level 0) : group_scope. - -Let e := #|L : H|. -Let tauL := FT_DadeF maxL. -Let calL := seqIndD H L H 1. - -Let frobL : [Frobenius L with kernel H]. Proof. exact: FTtype1_Frobenius. Qed. - -(* The coherence part of the preamble of (13.19). *) -Lemma FTtype1_coherence : coherent calL L^# tauL. -Proof. -have [_ [tau1 [IZtau1 Dtau1]]] := FT_Frobenius_coherence maxL frobL. -exists tau1; split=> // phi Sphi; rewrite ?Dtau1 //. -move/(zcharD1_seqInd_on (Fcore_normal _)) in Sphi. -by rewrite /tauL FT_DadeF_E ?FT_DadeE ?(cfun_onS (Fcore_sub_FTsupp _)). -Qed. - -Lemma FTtype1_Ind_irr : {subset calL <= irr L}. -Proof. by case: (FT_Frobenius_coherence maxL frobL). Qed. -Let irrL := FTtype1_Ind_irr. - -(* We re-quantify over the witnesses so that the main part of the lemma can *) -(* be used for Section variables in the very last part of Section 14. *) -Variables (tau1 : {additive 'CF(L) -> 'CF(G)}) (phi : 'CF(L)). -Hypothesis cohL : coherent_with calL L^# tauL tau1. -Hypotheses (Lphi : phi \in calL) (phi1e : phi 1%g = e%:R). - -Let betaL := 'Ind[L, H] 1 - phi. -Let betaS := beta_ #1. -Let eta01 := eta_ 0 #1. - -(* This is Peterfalvi (13.19). *) -Lemma FTtypeI_bridge_facts : - [/\ (*a*) 'A~(L) :&: (class_support P G :|: class_support W G) = set0, - (*b*) orthogonal (map tau1 calL) (map sigma (irr W)), - (*c*) forall j, j != 0 -> '[tauL betaL, eta_ 0 j] = '[tauL betaL, eta01] - & (*c1*) ('[tau betaS, tau1 phi] == 1 %[mod 2])%C - /\ #|H|.-1%:R / e%:R <= (u.-1 %/ q)%:R :> algC - \/ (*c2*) ('[tauL betaL, eta01] == 1 %[mod 2])%C /\ (p <= e)%N]. -Proof. -have nsHL: H <| L := gFnormal _ L; have [sHL nHL] := andP nsHL. -have coHr T r: T \in 'M -> FTtype T != 1%N -> r.-abelem T`_\F -> coprime #|H| r. - move=> maxT notTtype1 /andP[rR _]. - have [_ _ [n oR]] := pgroup_pdiv rR (mmax_Fcore_neq1 maxT). - rewrite -(coprime_pexpr _ r (ltn0Sn n)) -oR /= -FTcore_type1 //. - apply: coprimegS (Fcore_sub_FTcore maxT) _. - have [_ -> //] := FT_Dade_support_partition gT. - by apply: contra notTtype1 => /imsetP[y _ ->] /=; rewrite FTtypeJ. -have coHp: coprime #|H| p by apply: (coHr S) => //; have [_ []] := Sfacts. -have{coHr} coHq: coprime #|H| q. - have [T pairST [xdefW [V TtypeP]]] := FTtypeP_pair_witness maxS StypeP. - have [[_ _ maxT] _ _ _ _] := pairST; have Ttype'1 := FTtypeP_neq1 maxT TtypeP. - by rewrite (coHr T) ?Ttype'1 //; have [_ []] := FTtypeP_facts maxT TtypeP. -have defA: 'A(L) = H^# := FTsupp_Frobenius maxL frobL. -set PWG := class_support P G :|: class_support W G. -have tiA_PWG: 'A~(L) :&: PWG = set0. - apply/setP=> x; rewrite !inE; apply/andP=> [[Ax PWGx]]. - suffices{Ax}: \pi(H)^'.-elt x. - have [y Ay /imset2P[_ t /rcosetP[z Rz ->] _ ->]] := bigcupP Ax => H'zyt. - do [rewrite -def_FTsignalizer //; set ddL := FT_Dade_hyp maxL] in Rz. - have /setD1P[nty Hy]: y \in H^# by rewrite -defA. - have /idPn[]: (z * y).`_\pi('C_H[y]) == 1%g. - rewrite (constt1P _) // -(p_eltJ _ _ t); apply: sub_in_pnat H'zyt => r _. - by apply: contra; apply: piSg; apply: subsetIl. - rewrite consttM; last first. - exact: cent1P (subsetP (Dade_signalizer_cent _ y) z Rz). - rewrite (constt1P (mem_p_elt _ Rz)) ?mul1g; last first. - rewrite /pgroup -coprime_pi' ?cardG_gt0 // coprime_sym. - by rewrite (coprimegS _ (Dade_coprime _ Ay Ay)) ?setSI. - by rewrite (constt_p_elt (mem_p_elt (pgroup_pi _) _)) // inE Hy cent1id. - suffices /pnat_dvd: #[x] %| #|P| * #|W|. - have [_ [_ ->] _ _ _] := Sfacts; rewrite -(dprod_card defW) -/p -/q. - by apply; rewrite !pnat_mul pnat_exp -!coprime_pi' ?cardG_gt0 ?coHp ?coHq. - case/orP: PWGx => /imset2P[y z PWy _ ->]; rewrite {z}orderJ. - by rewrite dvdn_mulr ?order_dvdG. - by rewrite dvdn_mull ?order_dvdG. -have ZsubL psi: psi \in calL -> psi - psi^*%CF \in 'Z[calL, L^#]. - have ZcalL: {subset calL <= 'Z[irr L]} by apply: seqInd_vcharW. - by move=> Lpsi; rewrite sub_aut_zchar ?zchar_onG ?mem_zchar ?cfAut_seqInd. -have mem_eta j: eta_ 0 j \in map sigma (irr W) by rewrite map_f ?mem_irr. -have otau1eta: orthogonal (map tau1 calL) (map sigma (irr W)). - apply/orthogonalP=> _ _ /mapP[psi Lpsi ->] /mapP[w irr_w ->]. - have{w irr_w} [i [j ->]] := cycTIirrP defW irr_w; rewrite -/(w_ i j). - pose Psi := tau1 (psi - psi^*%CF); pose NC := cyclicTI_NC ctiWG. - have [[Itau1 Ztau1] Dtau1] := cohL. - have Lpsis: psi^*%CF \in calL by rewrite cfAut_seqInd. - have Z1dpsi := ZsubL _ Lpsi; have Zdpsi := zcharW Z1dpsi. - have{Dtau1} PsiV0: {in V, Psi =1 \0}. - move=> x /setDP[Wx _]; rewrite /Psi Dtau1 ?(cfun_on0 (Dade_cfunS _ _)) //. - rewrite FT_DadeF_supportE -defA; apply: contra_eqN tiA_PWG => Ax. - by apply/set0Pn; exists x; rewrite !inE Ax orbC mem_class_support. - have opsi: '[psi, psi^*] = 0 by apply: seqInd_conjC_ortho (mFT_odd _) _ Lpsi. - have n2Psi: '[Psi] = 2%:R. - by rewrite Itau1 ?cfnormBd // cfnorm_conjC ?irrWnorm ?irrL. - have NC_Psi: (NC Psi < minn q p)%N. - by rewrite (@leq_ltn_trans 2) ?leq_min ?qgt2 // cycTI_NC_norm ?Ztau1 ?n2Psi. - apply: contraTeq (NC_Psi) => t1psi_eta; rewrite -leqNgt cycTI_NC_minn //. - rewrite mul2n -addnn (leq_trans NC_Psi) ?leq_addl // andbT card_gt0. - suffices [b Deta]: exists b : bool, eta_ i j = (-1) ^+ b *: tau1 psi. - apply/set0Pn; exists (i, j); rewrite !inE /= /Psi raddfB cfdotBl {2}Deta. - by rewrite cfdotZr Itau1 ?mem_zchar // cfdot_conjCl opsi conjC0 mulr0 subr0. - exists (tau1 psi == - eta_ i j); apply: (canRL (signrZK _)). - move/eqP: t1psi_eta; rewrite cfdot_dirr ?cycTIiso_dirr //; last first. - by rewrite dirrE Itau1 ?Ztau1 ?mem_zchar //= irrWnorm ?irrL. - by rewrite scaler_sign; do 2!case: eqP => //. -have [[A0beta PVbeta] n2beta [defGa Ga1 R_Ga] ubGa dvu] := FTtypeP_bridge_facts. -have [_ _ _ _ [_ Dtau]] := Sfacts. -have o_tauL_S zeta j: j != 0 -> '[tauL zeta, tau (beta_ j)] = 0. - move=> nzj; pose ABS := class_support (P^# :|: class_support V S) G. - have ABSbeta: tau (beta_ j) \in 'CF(G, ABS). - by rewrite Dtau ?A0beta // cfInd_on ?subsetT ?PVbeta. - have{ABSbeta} PWGbeta: tau (beta_ j) \in 'CF(G, PWG). - apply: cfun_onS ABSbeta; apply/subsetP=> _ /imset2P[x t PVSx _ ->]. - case/setUP: PVSx => [/setD1P[_ Px] | /imset2P[y z /setDP[Wy _] _ ->]]. - by rewrite inE memJ_class_support ?inE. - by rewrite -conjgM inE orbC memJ_class_support ?inE. - rewrite (cfdotElr (Dade_cfunS _ _) PWGbeta) big_pred0 ?mulr0 // => x. - by rewrite FT_DadeF_supportE -defA tiA_PWG inE. -have betaLeta j: j != 0 -> '[tauL betaL, eta_ 0 j] = '[tauL betaL, eta01]. - move=> nzj; apply/eqP; rewrite -subr_eq0 -cfdotBr. - rewrite (canRL (addKr _) (defGa j nzj)) !addrA addrK -addrA addrCA. - by rewrite opprD subrK cfdotBr !o_tauL_S ?subrr ?Iirr1_neq0. -split=> //; have [[[Itau1 Ztau1] Dtau1] irr_phi] := (cohL, irrL Lphi). -pose GammaL := tauL betaL - (1 - tau1 phi). -have DbetaL: tauL betaL = 1 - tau1 phi + GammaL by rewrite addrC subrK. -have RealGammaL: cfReal GammaL. - rewrite /cfReal -subr_eq0 !rmorphB rmorph1 /= !opprB !addrA subrK addrC. - rewrite -addrA addrCA addrA addr_eq0 opprB -Dade_aut -linearB /= -/tauL. - rewrite rmorphB /= cfAutInd rmorph1 addrC opprB addrA subrK. - by rewrite (cfConjC_Dade_coherent cohL) ?mFT_odd // -raddfB Dtau1 // ZsubL. -have:= Dade_Ind1_sub_lin cohL _ irr_phi Lphi; rewrite -/betaL -/tauL -/calL. -rewrite (seqInd_nontrivial _ _ _ Lphi) ?odd_Frobenius_index_ler ?mFT_odd //. -case=> // -[o_tauL_1 o_betaL_1 ZbetaL] ub_betaL _. -have{o_tauL_1 o_betaL_1} o_GaL_1: '[GammaL, 1] = 0. - by rewrite !cfdotBl cfnorm1 o_betaL_1 (orthoPr o_tauL_1) ?map_f ?subr0 ?subrr. -have Zt1phi: tau1 phi \in 'Z[irr G] by rewrite Ztau1 ?mem_zchar. -have Zeta01: eta01 \in 'Z[irr G] by apply: cycTIiso_vchar. -have ZbetaS: tau betaS \in 'Z[irr G]. - rewrite Dade_vchar // zchar_split A0beta ?Iirr1_neq0 //. - by rewrite rpredB ?irr_vchar ?cfInd_vchar ?rpred1. -have Z_Ga: Gamma \in 'Z[irr G] by rewrite rpredD ?rpredB ?rpred1. -have Z_GaL: GammaL \in 'Z[irr G] by rewrite !rpredB ?rpred1. -have{RealGammaL} Gamma_even: (2 %| '[GammaL, Gamma])%C. - by rewrite cfdot_real_vchar_even ?mFT_odd // o_GaL_1 (dvdC_nat 2 0). -set bSphi := '[tau betaS, tau1 phi]; set bLeta := '[tauL betaL, eta01]. -have [ZbSphi ZbLeta]: bSphi \in Cint /\ bLeta \in Cint. - by rewrite !Cint_cfdot_vchar. -have{Gamma_even} odd_bSphi_bLeta: (bSphi + bLeta == 1 %[mod 2])%C. - rewrite -(conj_Cint ZbSphi) -cfdotC /bLeta DbetaL cfdotDl cfdotBl. - have: '[tauL betaL, tau betaS] == 0 by rewrite o_tauL_S ?Iirr1_neq0. - have ->: tau betaS = 1 - eta01 + Gamma by rewrite addrCA !addrA !subrK. - rewrite !['[tau1 _, _]]cfdotDr 2!cfdotDr !cfdotNr DbetaL. - rewrite 2!cfdotDl 2!['[_, eta01]]cfdotDl 2!['[_, Gamma]]cfdotDl !cfdotNl. - rewrite cfnorm1 o_GaL_1 ['[1, Gamma]]cfdotC Ga1 conjC0 addr0 add0r. - have ->: 1 = eta_ 0 0 by rewrite /w_ cycTIirr00 cycTIiso1. - rewrite cfdot_cycTIiso mulrb ifN_eqC ?Iirr1_neq0 // add0r. - rewrite 2?(orthogonalP otau1eta _ _ (map_f _ _) (mem_eta _)) // oppr0 !add0r. - by rewrite addr0 addrA addrC addr_eq0 !opprB addrA /eqCmod => /eqP <-. -have abs_mod2 a: a \in Cint -> {b : bool | a == b%:R %[mod 2]}%C. - move=> Za; pose n := truncC `|a|; exists (odd n). - apply: eqCmod_trans (eqCmod_addl_mul _ (rpred_nat _ n./2) _). - rewrite addrC -natrM -natrD muln2 odd_double_half truncCK ?Cnat_norm_Cint //. - rewrite -{1}[a]mul1r -(canLR (signrMK _) (CintEsign Za)) eqCmodMr // signrE. - by rewrite /eqCmod opprB addrC subrK dvdC_nat dvdn2 odd_double. -have [[bL DbL] [bS DbS]] := (abs_mod2 _ ZbLeta, abs_mod2 _ ZbSphi). -have{odd_bSphi_bLeta} xor_bS_bL: bS (+) bL. - rewrite eqCmod_sym in odd_bSphi_bLeta. - have:= eqCmod_trans odd_bSphi_bLeta (eqCmodD DbS DbL). - rewrite -natrD eqCmod_sym -(eqCmodDr _ 1) -mulrSr => xor_bS_bL. - have:= eqCmod_trans xor_bS_bL (eqCmodm0 _); rewrite /eqCmod subr0. - by rewrite (dvdC_nat 2 _.+1) dvdn2 /= negbK odd_add !oddb; case: (_ (+) _). -have ?: (0 != 1 %[mod 2])%C by rewrite eqCmod_sym /eqCmod subr0 (dvdC_nat 2 1). -case is_c1: bS; [left | right]. - rewrite is_c1 in DbS; split=> //. - pose a_ (psi : 'CF(L)) := psi 1%g / e%:R. - have Na_ psi: psi \in calL -> a_ psi \in Cnat by apply: dvd_index_seqInd1. - have [X tau1X [D [dGa oXD oDtau1]]] := orthogonal_split (map tau1 calL) Gamma. - have oo_L: orthonormal calL. - by apply: sub_orthonormal (irr_orthonormal L); rewrite ?seqInd_uniq. - have oo_tau1L: orthonormal (map tau1 calL) by apply: map_orthonormal. - have defX: X = bSphi *: (\sum_(psi <- calL) a_ psi *: tau1 psi). - have [_ -> defX] := orthonormal_span oo_tau1L tau1X. - rewrite defX big_map scaler_sumr; apply: eq_big_seq => psi Lpsi. - rewrite scalerA; congr (_ *: _); apply/eqP; rewrite -subr_eq0 mulrC. - rewrite -[X](addrK D) -dGa cfdotBl (orthoPl oDtau1) ?map_f // subr0. - rewrite cfdotC cfdotDr cfdotBr -/betaS -/eta01. - have ->: 1 = eta_ 0 0 by rewrite /w_ cycTIirr00 cycTIiso1. - rewrite 2?(orthogonalP otau1eta _ _ (map_f _ _) (mem_eta _)) // subrK. - rewrite -cfdotC -(conj_Cnat (Na_ _ Lpsi)) -cfdotZr -cfdotBr. - rewrite -raddfZ_Cnat ?Na_ // -raddfB cfdotC. - rewrite Dtau1; last by rewrite zcharD1_seqInd ?seqInd_sub_lin_vchar. - by rewrite o_tauL_S ?Iirr1_neq0 ?conjC0. - have nz_bSphi: bSphi != 0 by apply: contraTneq DbS => ->. - have ub_a: \sum_(psi <- calL) a_ psi ^+ 2 <= (u.-1 %/ q)%:R. - apply: ler_trans (ubGa D X _ _ _); first 1 last; first by rewrite addrC. - - by rewrite cfdotC oXD conjC0. - - apply/orthoPl=> eta Weta; rewrite (span_orthogonal otau1eta) //. - exact: memv_span. - rewrite defX cfnormZ cfnorm_sum_orthonormal // mulr_sumr !big_seq. - apply: ler_sum => psi Lpsi; rewrite -{1}(norm_Cnat (Na_ _ _)) //. - by rewrite ler_pemull ?exprn_ge0 ?normr_ge0 // Cint_normK // sqr_Cint_ge1. - congr (_ <= _): ub_a; do 2!apply: (mulIf (neq0CiG L H)); rewrite -/e. - rewrite divfK ?neq0CiG // -mulrA -expr2 mulr_suml. - rewrite -subn1 natrB ?neq0CG // -indexg1 mulrC. - rewrite -(sum_seqIndD_square nsHL) ?normal1 ?sub1G // -/calL. - apply: eq_big_seq => psi Lpsi; rewrite irrWnorm ?irrL // divr1. - by rewrite -exprMn divfK ?neq0CiG. -rewrite is_c1 /= in xor_bS_bL; rewrite xor_bS_bL in DbL; split=> //. -have nz_bL: bLeta != 0 by apply: contraTneq DbL => ->. -have{ub_betaL} [X [otau1X oX1 [a Za defX]] [//|_ ubX]] := ub_betaL. -rewrite -/e in defX; rewrite -leC_nat -(ler_add2r (-1)); apply: ler_trans ubX. -pose calX0 := [seq w_ 0 j | j in predC1 0]. -have ooX0: orthonormal calX0. - apply: sub_orthonormal (irr_orthonormal W). - by move=> _ /imageP[j _ ->]; apply: mem_irr. - by apply/dinjectiveP=> j1 j2 _ _ /irr_inj/dprod_Iirr_inj[]. -have Isigma: {in 'Z[calX0] &, isometry sigma}. - by apply: in2W; apply: cycTIisometry. -rewrite -[X](subrK (bLeta *: (\sum_(xi <- calX0) sigma xi))). -rewrite cfnormDd ?ler_paddl ?cfnorm_ge0 //; last first. - rewrite cfdotZr cfdot_sumr big1_seq ?mulr0 // => xi X0xi. - apply/eqP; rewrite cfdotBl scaler_sumr cfproj_sum_orthonormal // subr_eq0. - have {xi X0xi}[j nzj ->] := imageP X0xi; rewrite inE /= in nzj. - rewrite -[bLeta](betaLeta j nzj) defX cfdotDl -addrA cfdotDl. - have ->: 1 = eta_ 0 0 by rewrite /w_ cycTIirr00 cycTIiso1. - rewrite cfdot_cycTIiso mulrb (ifN_eqC _ _ nzj) add0r eq_sym -subr_eq0 addrK. - rewrite (span_orthogonal otau1eta) //; last by rewrite memv_span ?mem_eta. - rewrite big_seq rpredD ?(rpredN, rpredZ, rpred_sum) ?memv_span ?map_f //. - by move=> xi Lxi; rewrite rpredZ ?memv_span ?map_f. -rewrite cfnormZ cfnorm_map_orthonormal // size_image cardC1 nirrW2. -rewrite -(natrB _ (prime_gt0 pr_p)) Cint_normK // subn1. -by rewrite ler_pemull ?ler0n ?sqr_Cint_ge1. -Qed. - -End Thirteen_17_to_19. - -End Thirteen. - diff --git a/mathcomp/odd_order/PFsection14.v b/mathcomp/odd_order/PFsection14.v deleted file mode 100644 index 1b8a531..0000000 --- a/mathcomp/odd_order/PFsection14.v +++ /dev/null @@ -1,1271 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div choice. -From mathcomp -Require Import fintype tuple finfun bigop prime binomial ssralg poly finset. -From mathcomp -Require Import fingroup morphism perm automorphism quotient action finalg zmodp. -From mathcomp -Require Import gfunctor gproduct center cyclic commutator gseries nilpotent. -From mathcomp -Require Import pgroup sylow hall abelian maximal frobenius. -From mathcomp -Require Import matrix mxalgebra mxrepresentation mxabelem vector. -From mathcomp -Require Import BGsection1 BGsection3 BGsection7. -From mathcomp -Require Import BGsection14 BGsection15 BGsection16 BGappendixC. -From mathcomp -Require Import ssrnum rat algC cyclotomic algnum. -From mathcomp -Require Import classfun character integral_char inertia vcharacter. -From mathcomp -Require Import PFsection1 PFsection2 PFsection3 PFsection4. -From mathcomp -Require Import PFsection5 PFsection6 PFsection7 PFsection8 PFsection9. -From mathcomp -Require Import PFsection10 PFsection11 PFsection12 PFsection13. - -(******************************************************************************) -(* This file covers Peterfalvi, Section 14: Non_existence of G. *) -(* It completes the proof of the Odd Order theorem. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope GRing.Theory FinRing.Theory Num.Theory. - -Section Fourteen. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). -Implicit Types (p q : nat) (x y z : gT). -Implicit Types H K L N P Q R S T U W : {group gT}. - -Local Notation "#1" := (inord 1) (at level 0). - -(* Supplementary results that apply to both S and T, but that are not *) -(* formally stated as such; T, V, L, tau1L and phi are only used at the end *) -(* of this section, to state and prove FTtype2_support_coherence. *) -Section MoreSTlemmas. - -Local Open Scope ring_scope. -Variables W W1 W2 S T U V L : {group gT}. -Variables (tau1L : {additive 'CF(L) -> 'CF(G)}) (phi : 'CF(L)). - -(* Implicit (dependent) forward assuptions. *) -Hypotheses (defW : W1 \x W2 = W) (xdefW : W2 \x W1 = W) (maxL : L \in 'M). - -Local Notation "` 'S'" := (gval S) (at level 0, only parsing) : group_scope. -Local Notation P := `S`_\F%G. -Local Notation "` 'P'" := `S`_\F (at level 0) : group_scope. -Local Notation PU := S^`(1)%G. -Local Notation "` 'PU'" := `S^`(1)%g (at level 0) : group_scope. -Local Notation "` 'L'" := (gval L) (at level 0, only parsing). -Local Notation H := `L`_\F%G. -Local Notation "` 'H'" := `L`_\F%g (at level 0, format "` 'H'") : group_scope. - -Let p := #|W2|. -Let q := #|W1|. -Let u := #|U|. -Let v := #|V|. -Let h := #|H|. -Let e := #|L : H|. -Let ccG A := class_support A G. - -Let calL := seqIndD H L H 1. -Let betaL := 'Ind[L, H] 1 - phi. -Local Notation tauL := (FT_DadeF maxL). - -(* Explicit (non-dependent) forward assumptions. *) -Hypotheses (StypeP : of_typeP S U defW) (TtypeP : of_typeP T V xdefW). -Hypothesis (cohL : coherent_with calL L^# tauL tau1L) (Lphi : phi \in calL). - -(* The remaining assumptions can be generated as backchaining gools. *) -Hypotheses (maxS : S \in 'M) (maxT : T \in 'M). - -Let pddS := FT_prDade_hypF maxS StypeP. -Let pddT := FT_prDade_hypF maxT TtypeP. -Let ctiWG : cyclicTI_hypothesis G defW := pddS. -Let sigma := cyclicTIiso ctiWG. -Let w_ i j := cyclicTIirr defW i j. - -(* An inequality used in the proof of (14.11.4), at the bottom of page 90, to *) -(* show that 1/uq and 1/vp are less that 1/2q^2 (so Wn is either W1 or W2). *) -Lemma FTtypeP_complV_ltr (Wn : {group gT}) : - (#|Wn| <= q)%N -> (u * q)%:R^-1 < (2 * #|Wn| ^ 2)%:R^-1 :> algC. -Proof. -move=> leWn_q; rewrite !natrM ltf_pinv ?rpredM ?qualifE ?gt0CG ?ltr0n //. -rewrite -!natrM ltr_nat (@leq_ltn_trans (2 * q ^ 2)) ?mulnA ?leq_mul // mul2n. -have: [Frobenius U <*> W1 = U ><| W1] by have [[]] := FTtypeP_facts maxS StypeP. -by move/ltn_odd_Frobenius_ker/implyP; rewrite mFT_odd ltn_pmul2r ?cardG_gt0. -Qed. - -(* This formalizes the loose symmetry used in (14.11.3) to show that #[g] is *) -(* coprime to pq. *) -Lemma coprime_typeP_Galois_core g : - typeP_Galois StypeP -> g \notin ccG W^# -> g \notin ccG P^# -> coprime #[g] p. -Proof. -move=> galS W'g; apply: contraR => p_g. -have ntg: g != 1%g by apply: contraNneq p_g => ->; rewrite order1 coprime1n. -have [pr_q pr_p]: prime q /\ prime p := FTtypeP_primes maxS StypeP. -have [[_ hallW1 _ defS] [_ _ _ defPU] _ [_ _ sW2P _ regPUW1] _] := StypeP. -have coPUq: coprime #|PU| q by rewrite (coprime_sdprod_Hall_r defS). -have [[_ _ nPUW1 _] [_ _ nPU _]] := (sdprodP defS, sdprodP defPU). -have ntP: P :!=: 1%g := mmax_Fcore_neq1 maxS. -have frobPU: [Frobenius PU = P ><| U]. - have notS5 := FTtype5_exclusion maxS. - have inN1 x: x \in 'N(1) by rewrite norm1 inE. - have [_ ntU _ _] := compl_of_typeII_IV maxS StypeP notS5. - have [] := typeP_Galois_P maxS notS5 galS; rewrite Ptype_factor_prime //. - rewrite (group_inj (Ptype_Fcore_kernel_trivial _ _)) // => F [fP [fU _]]. - rewrite Ptype_Fcompl_kernel_trivial //. - case=> /trivgP injfU fJ [_ /isomP[injfP _] _] _. - apply/Frobenius_semiregularP=> // y /setD1P[nty Uy]. - apply/trivgP/subsetP=> x /setIP[Px /cent1P-cxy]; apply: contraR nty. - rewrite -(morph_injm_eq1 injfU) // -val_eqE -(cosetpre1 1) !(inN1, inE) /=. - rewrite -(morph_injm_eq1 injfP) ?mem_quotient //= => /mulfI/inj_eq <-. - rewrite mulr1 -[_ * _]fJ ?mem_quotient //= qactE ?dom_qactJ //=. - by rewrite conjgE cxy mulKg. -have pP: p.-group P by have [_ [/andP[]]] := FTtypeP_facts _ StypeP. -have{p_g}[y [a P1a cagy]]: exists y, exists2 a, a \in P^# & g ^ y \in 'C[a]. - have sylP: p.-Sylow(G) P. - have [/Hall_pi/= hallP _ _] := FTcore_facts maxS; apply: etrans hallP. - have [_ _ [n ->]] := pgroup_pdiv pP (mmax_Fcore_neq1 maxS). - by apply/eq_pHall => r1; rewrite pi_of_exp ?pi_of_prime. - have [y _ Pa] := Sylow_Jsub sylP (subsetT _) (p_elt_constt p g). - pose a := g.`_p ^ y; have{Pa} Pa: a \in P by rewrite -cycle_subG cycleJ. - exists y, a; last by rewrite cent1C /a conjXg groupX ?cent1id. - rewrite !inE conjg_eq1 (contraNneq _ p_g) // => /constt1P/p'nat_coprime-> //. - exact: pnat_id. -have /(mem_sdprod defS)[x [w [PUx W1w Dgy _]]]: g ^ y \in S. - have A0a: a \in 'A0(S) := subsetP (Fcore_sub_FTsupp0 maxS) a P1a. - have [_ _ _ _ [tiA0 _]] := FTtypeP_facts _ StypeP. - by rewrite (subsetP (cent1_normedTI tiA0 A0a)) // 2!inE. -suffices w_eq1: w = 1%g. - have sCaP: 'C_PU[a] \subset P := Frobenius_cent1_ker frobPU P1a. - rewrite -[g](conjgK y) mem_imset2 ?inE //= conjg_eq1 ntg /=. - by rewrite (subsetP sCaP) // inE cagy Dgy w_eq1 mulg1 PUx. -apply: contraNeq W'g => ntw; have nPUw := subsetP nPUW1 w W1w. -have{x PUx Dgy} /imset2P[x z W2w_x _ Dgy]: g ^ y \in class_support (W2 :* w) PU. - rewrite -(regPUW1 w) ?inE ?ntw // class_supportEr -cover_imset. - have coPUw := coprime_dvdr (order_dvdG W1w) coPUq. - have [/cover_partition-> _] := partition_cent_rcoset nPUw coPUw. - by rewrite Dgy mem_rcoset mulgK. -rewrite -[g](conjgK (y * z^-1)%g) mem_imset2 ?inE //= conjg_eq1 ntg /= conjgM. -by rewrite Dgy conjgK -(dprodWC defW) -[x](mulgKV w) mem_mulg -?mem_rcoset. -Qed. - -Hypothesis Stype2 : FTtype S == 2. - -(* This is used to bound #|ccG P^#| and #|ccG Q^#| in the proof of (14.11.4). *) -Lemma FTtype2_cc_core_ler : #|G|%:R^-1 * #|ccG P^#|%:R <= (u * q)%:R^-1 :> algC. -Proof. -have ->: (u * q)%:R^-1 = #|S|%:R^-1 * #|P|%:R :> algC. - have [[_ _ _ /sdprod_card <-] [_ _ _ /sdprod_card <-] _ _ _] := StypeP. - by rewrite mulrC -mulnA [in RHS]natrM invfM mulVKf ?neq0CG. -have [_ _] := FTtypeII_ker_TI maxS Stype2; rewrite FTsupp1_type2 // => tiP1. -rewrite {tiP1}(card_support_normedTI tiP1) natrM natf_indexg ?subsetT //. -rewrite mulrCA mulKf ?neq0CG // mulrC ler_pmul2l ?invr_gt0 ?gt0CG // leC_nat. -by rewrite cardsDS ?sub1G ?leq_subr. -Qed. - -Hypotheses (maxNU_L : L \in 'M('N(U))) (phi1 : phi 1%g = e%:R). - -(* This is Peterfalvi (14.11.2), stated for S and L rather than T and M; it *) -(* is loosely used in this form at the very end of the proof of (14.16). *) -Lemma FTtype2_support_coherence : - (u.-1 %/ q < h.-1 %/ e)%N -> (v.-1 %/ p < h.-1 %/ e)%N -> - [/\ e = (p * q)%N - & exists nb, exists2 chi, chi = tau1L phi \/ chi = - tau1L phi^*%CF - & tauL betaL = \sum_ij (-1)^+ nb ij *: sigma 'chi_ij - chi]. -Proof. -move=> ub_u ub_v; have nsHL : H <| L := gFnormal _ _. -have pairST := of_typeP_pair maxS StypeP maxT TtypeP. -have [//|frobL sUH defL] := FTtypeII_support_facts maxS StypeP _ pairST maxNU_L. -have Ltype1 := FT_Frobenius_type1 maxL frobL. -have irr_phi: phi \in irr L by apply: FTtype1_Ind_irr Lphi. -have betaL_P := FTtypeI_bridge_facts _ _ Ltype1 cohL Lphi phi1. -have e_dv_h1: e %| h.-1 by apply: Frobenius_ker_dvd_ker1. -pose a i j := '[tauL betaL, sigma (w_ i j)]. -have a0j j: j != 0 -> (a 0 j == 1 %[mod 2])%C. - rewrite /a => nz_j; case/betaL_P: StypeP => _ _ -> //. - by case=> [[_ /idPn[]] | [//]]; rewrite -natf_div // leC_nat -ltnNge. -have ai0 i: i != 0 -> (a i 0 == 1 %[mod 2])%C. - rewrite /a (cycTIisoC _ pddT) => nz_i; case/betaL_P: TtypeP => _ _ -> //. - by case=> [[_ /idPn[]] | [//]]; rewrite -natf_div // leC_nat -ltnNge. -have HbetaL: betaL \in 'CF(L, H^#) by apply: cfInd1_sub_lin_on Lphi phi1. -have betaL_W_0: {in cyclicTIset defW, tauL betaL =1 \0}. - move=> z; case/betaL_P: StypeP => tiAM_W _ _ _. - rewrite !inE -(setCK W) inE => /andP[_]; apply: cfun_onP z. - apply: cfun_onS (Dade_cfunS _ _); rewrite FT_DadeF_supportE -disjoints_subset. - rewrite -FTsupp_Frobenius // -setI_eq0 -subset0 -tiAM_W setIS //. - by rewrite setUC subsetU ?sub_class_support. -have calL_gt1: (1 < size calL)%N. - by apply: seqInd_nontrivial Lphi; rewrite ?mFT_odd. -have [] := Dade_Ind1_sub_lin cohL calL_gt1 irr_phi Lphi phi1; rewrite -/betaL. -rewrite -/calL odd_Frobenius_index_ler ?mFT_odd //= -/e -/h. -case=> _ a00 ZbetaL [Gamma [o_tau1_Ga o_1_Ga [aa Zaa Dbeta] []// _ ubGa _]]. -have{a00} a00: a 0 0 = 1 by rewrite /a /w_ cycTIirr00 cycTIiso1. -have{a0j ai0} a_odd i j: (a i j == 1 %[mod 2])%C. - have [[-> | /ai0 ai01] [-> | /a0j a0j1] //] := (eqVneq i 0, eqVneq j 0). - by rewrite a00 (eqCmod_nat 2 1 1). - by rewrite -(eqCmodDr _ 1) -{1}a00 cycTIiso_cfdot_exchange // eqCmodD. -have [_ o_tauLeta _ _] := FTtypeI_bridge_facts _ StypeP Ltype1 cohL Lphi phi1. -pose etaW := map sigma (irr W). -have o1eta: orthonormal etaW := cycTIiso_orthonormal _. -have [X etaX [Y [defGa oXY oYeta]]] := orthogonal_split etaW (Gamma + 1). -have lbY: 0 <= '[Y] ?= iff (Y == 0). - by split; rewrite ?cfnorm_ge0 // eq_sym cfnorm_eq0. -have [b Db defX] := orthonormal_span o1eta etaX. -do [rewrite addrC !addrA addrAC -addrA; set Z := _ - _] in Dbeta. -have oZeta: orthogonal Z etaW. - apply/orthoPl=> xi /memv_span; apply: {xi}(span_orthogonal o_tauLeta). - rewrite rpredB ?rpredZ ?big_seq ?rpred_sum ?memv_span ?map_f // => xi Lxi. - by rewrite rpredZ ?memv_span ?map_f. -have lb_b ij (b_ij := b (sigma 'chi_ij)): - 1 <= `|b_ij| ^+ 2 ?= iff [exists n : bool, b_ij == (-1) ^+ n]. -- have /codomP[[i j] Dij] := dprod_Iirr_onto defW ij. - have{b_ij} ->: b_ij = a i j. - rewrite /a /w_ -Dij Dbeta defGa 2!cfdotDl. - have ->: '[X, sigma 'chi_ij] = b_ij by rewrite /b_ij Db. - by rewrite (orthoPl oYeta) ?(orthoPl oZeta) ?map_f ?mem_irr // !addr0. - have Zaij: a i j \in Cint by rewrite Cint_cfdot_vchar ?cycTIiso_vchar. - rewrite Cint_normK //; split. - rewrite sqr_Cint_ge1 //; apply: contraTneq (a_odd i j) => ->. - by rewrite (eqCmod_nat 2 0 1). - apply/eqP/exists_eqP=> [a2_1|[n ->]]; last by rewrite sqrr_sign. - rewrite (CintEsign Zaij) normC_def conj_Cint // -expr2 -a2_1 sqrtC1 mulr1. - by exists (a i j < 0). -have ub_e: e%:R <= #|Iirr W|%:R ?= iff (e == p * q)%N :> algC. - rewrite lerif_nat card_Iirr_cyclic //; last by have [] := ctiWG. - rewrite -(dprod_card xdefW); apply: leqif_eq. - case: defL => [|[y Qy]] defL; rewrite /e -(index_sdprod defL). - by rewrite leq_pmull ?cardG_gt0. - suffices /normP <-: y \in 'N(W1). - by rewrite -conjYg !cardJg (dprodWY defW) -(dprod_card xdefW). - have cQQ: abelian T`_\F by have [_ [/and3P[]]] := FTtypeP_facts maxT TtypeP. - have sW1Q: W1 \subset T`_\F by have [_ _ _ []] := TtypeP. - by rewrite (subsetP _ y Qy) // sub_abelian_norm. -have /(_ predT) := lerif_add (lerif_sum (in1W lb_b)) lbY. -rewrite sumr_const addr0 => /(lerif_trans ub_e)/ger_lerif/esym. -have ->: \sum_i `|b (sigma 'chi_i)| ^+ 2 = '[X]. - rewrite defX cfnorm_sum_orthonormal // big_map (big_nth 0) big_mkord. - by rewrite size_tuple; apply: eq_bigr => ij _; rewrite -tnth_nth. -rewrite -cfnormDd // -defGa cfnormDd // cfnorm1 -ler_subr_addr ubGa. -case/and3P=> /eqP-De /'forall_exists_eqP/fin_all_exists[/= n Dn] /eqP-Y0. -pose chi := X - tauL betaL; split=> //; exists n, chi; last first. - apply: canRL (addrK _) _; rewrite addrC subrK defX big_map (big_nth 0). - by rewrite big_mkord size_tuple; apply: eq_bigr => ij; rewrite -tnth_nth Dn. -have Z1chi: chi \in dirr G. - rewrite dirrE rpredB //=; last first. - rewrite defX big_map (big_nth 0) big_mkord size_tuple rpred_sum //= => ij. - have [_ Zsigma] := cycTI_Zisometry ctiWG. - by rewrite -tnth_nth Dn rpredZsign ?Zsigma ?irr_vchar. - apply/eqP/(addIr '[X]); rewrite -cfnormBd; last first. - rewrite /chi Dbeta defGa Y0 addr0 opprD addNKr cfdotNl. - by rewrite (span_orthogonal oZeta) ?oppr0 // memv_span ?mem_head. - rewrite addrAC subrr add0r cfnormN Dade_isometry // cfnormBd; last first. - by rewrite cfdotC (seqInd_ortho_Ind1 _ _ Lphi) ?conjC0. - rewrite cfnorm_Ind_cfun1 // -/e irrWnorm // addrC; congr (1 + _). - rewrite defX cfnorm_sum_orthonormal // big_map big_tuple. - rewrite De (dprod_card xdefW) -card_Iirr_cyclic //; last by have[]:= ctiWG. - by rewrite -sumr_const; apply: eq_bigr => ij _; rewrite Dn normr_sign expr1n. -have [[Itau1 Ztau1] Dtau1] := cohL. -suffices /cfdot_add_dirr_eq1: '[tau1L phi - tau1L phi^*%CF, chi] = 1. - rewrite -(cfConjC_Dade_coherent cohL) ?mFT_odd // rpredN dirr_aut. - by apply; rewrite // dirrE Ztau1 ?Itau1 ?mem_zchar ?irrWnorm /=. -rewrite cfdotBr (span_orthogonal o_tauLeta) ?add0r //; last first. - by rewrite rpredB ?memv_span ?map_f ?cfAut_seqInd. -have Zdphi := seqInd_sub_aut_zchar nsHL conjC Lphi. -rewrite -raddfB Dtau1 ?zcharD1_seqInd // Dade_isometry ?(zchar_on Zdphi) //. -rewrite cfdotBr !cfdotBl cfdot_conjCl cfAutInd rmorph1 irrWnorm //. -rewrite (seqInd_ortho_Ind1 _ _ Lphi) // conjC0 subrr add0r opprK. -by rewrite cfdot_conjCl (seqInd_conjC_ortho _ _ _ Lphi) ?mFT_odd ?conjC0 ?subr0. -Qed. - -End MoreSTlemmas. - -Section NonconjType1. -(* Properties of non-conjugate type I groups, used symmetrically for L and M *) -(* in the proofs of (14.14) and (14.16). *) - -Local Open Scope ring_scope. -Variables (M L : {group gT}) (phi : 'CF(L)) (psi : 'CF(M)). -Variable (tau1L : {additive 'CF(L) -> 'CF(G)}). -Variable (tau1M : {additive 'CF(M) -> 'CF(G)}). -Hypotheses (maxL : L \in 'M) (maxM : M \in 'M). -Let ddL := FT_DadeF_hyp maxL. -Let ddM := FT_DadeF_hyp maxM. -Let tauL := Dade ddL. -Let tauM := Dade ddM. -Let H := L`_\F%G. -Let K := M`_\F%G. -Let calL := seqIndD H L H 1. -Let calM := seqIndD K M K 1. -Let u : algC := #|L : H|%:R. -Let v : algC := #|M : K|%:R. -Let betaL := 'Ind[L, H] 1 - phi. -Let a := '[tauL betaL, tau1M psi]. - -Hypothesis (cohL : coherent_with calL L^# tauL tau1L). -Hypothesis (cohM : coherent_with calM M^# tauM tau1M). -Hypotheses (Lphi : phi \in calL) (Mpsi : psi \in calM). -Hypotheses (phi1 : phi 1%g = u) (psi1 : psi 1%g = v). -Hypotheses (Ltype1 : FTtype L == 1%N) (Mtype1 : FTtype M == 1%N). -Hypothesis not_MG_L : gval L \notin M :^: G. - -Let irrL := FTtype1_Ind_irr maxL Ltype1. -Let irrM := FTtype1_Ind_irr maxM Mtype1. - -Lemma disjoint_Dade_FTtype1 : [disjoint Dade_support ddM & Dade_support ddL]. -Proof. -by rewrite !FT_DadeF_supportE -!FTsupp1_type1 ?FT_Dade1_support_disjoint. -Qed. -Let TItauML := disjoint_Dade_FTtype1. - -Lemma coherent_FTtype1_ortho : orthogonal (map tau1M calM) (map tau1L calL). -Proof. -apply/orthogonalP=> _ _ /mapP[xiM Mxi ->] /mapP[xiL Lxi ->]. -have [irrLxi irrMxi] := (irrL Lxi, irrM Mxi). -exact: (disjoint_coherent_ortho (mFT_odd _) _ cohM cohL). -Qed. -Let oML := coherent_FTtype1_ortho. - -(* This is the inequality used in both branches of (14.14). *) -Lemma coherent_FTtype1_core_ltr : a != 0 -> #|K|.-1%:R / v <= u - 1. -Proof. -have [nsHL nsKM]: H <| L /\ K <| M by rewrite !gFnormal. -have [irr_phi irr_psi] := (irrL Lphi, irrM Mpsi). -have frobL: [Frobenius L with kernel H] := FTtype1_Frobenius maxL Ltype1. -have [[Itau1 Ztau1] Dtau1] := cohM. -have o1M: orthonormal (map tau1M calM). - apply: map_orthonormal Itau1 _. - exact: sub_orthonormal (undup_uniq _) (irr_orthonormal M). -have Lgt1: (1 < size calL)%N by apply: seqInd_nontrivial (mFT_odd _ ) _ Lphi. -have [[_ _]] := Dade_Ind1_sub_lin cohL Lgt1 irr_phi Lphi phi1. -rewrite -/tauL -/betaL -/calL => ZbetaL [Gamma [_ _ [b _ Dbeta]]]. -rewrite odd_Frobenius_index_ler ?mFT_odd // -/u => -[]// _ ub_Ga _ nz_a. -have Za: a \in Cint by rewrite Cint_cfdot_vchar // ?Ztau1 ?mem_zchar. -have [X M_X [Del [defGa oXD oDM]]] := orthogonal_split (map tau1M calM) Gamma. -apply: ler_trans ub_Ga; rewrite defGa cfnormDd // ler_paddr ?cfnorm_ge0 //. -suffices ->: '[X] = (a / v) ^+ 2 * (\sum_(xi <- calM) xi 1%g ^+ 2 / '[xi]). - rewrite sum_seqIndC1_square // -(natrB _ (cardG_gt0 K)) subn1. - rewrite exprMn !mulrA divfK ?neq0CiG // mulrAC -mulrA. - by rewrite ler_pemull ?sqr_Cint_ge1 // divr_ge0 ?ler0n. -have [_ -> defX] := orthonormal_span o1M M_X. -have Mgt1: (1 < size calM)%N by apply: seqInd_nontrivial (mFT_odd _ ) _ Mpsi. -have [[oM1 _ _] _ _] := Dade_Ind1_sub_lin cohM Mgt1 irr_psi Mpsi psi1. -rewrite exprMn -(Cint_normK Za) -[v]normr_nat -normfV -/v mulr_sumr. -rewrite defX cfnorm_sum_orthonormal // big_map; apply: eq_big_seq => xi Mxi. -have Zxi1 := Cint_seqInd1 Mxi; rewrite -(Cint_normK Zxi1) -(conj_Cint Zxi1). -rewrite irrWnorm ?irrM // divr1 -!exprMn -!normrM; congr (`|_| ^+ 2). -rewrite -mulrA mulrC -mulrA; apply: canRL (mulKf (neq0CiG _ _)) _. -rewrite -(canLR (addrK _) defGa) cfdotBl (orthoPl oDM) ?map_f // subr0. -rewrite -(canLR (addKr _) Dbeta) cfdotDl cfdotNl cfdotC cfdotDr cfdotBr. -rewrite (orthoPr oM1) ?map_f // (orthogonalP oML) ?map_f // subrr add0r. -rewrite cfdotZr cfdot_sumr big1_seq ?mulr0 ?oppr0 => [|nu Mnu]; last first. - by rewrite cfdotZr (orthogonalP oML) ?map_f ?mulr0. -apply/eqP; rewrite conjC0 oppr0 add0r -subr_eq0 -conjC_nat -!cfdotZr. -rewrite -raddfZnat -raddfZ_Cint // -cfdotBr -raddfB -/v -psi1. -rewrite Dtau1 ?zcharD1_seqInd ?sub_seqInd_zchar //. -rewrite (cfdotElr (Dade_cfunS _ _) (Dade_cfunS _ _)) setIC. -by have:= TItauML; rewrite -setI_eq0 => /eqP->; rewrite big_set0 mulr0. -Qed. - -End NonconjType1. - -(* This is the context associated with Hypothesis (13.1). *) -Variables S T U V W W1 W2 : {group gT}. -Hypotheses (defW : W1 \x W2 = W) (xdefW : W2 \x W1 = W). -Hypotheses (pairST : typeP_pair S T defW) (maxS : S \in 'M) (maxT : T \in 'M). -Hypotheses (StypeP : of_typeP S U defW) (TtypeP : of_typeP T V xdefW). - -Local Notation "` 'W1'" := (gval W1) (at level 0, only parsing) : group_scope. -Local Notation "` 'W2'" := (gval W2) (at level 0, only parsing) : group_scope. -Local Notation "` 'W'" := (gval W) (at level 0, only parsing) : group_scope. -Local Notation What := (cyclicTIset defW). - -Local Notation "` 'S'" := (gval S) (at level 0, only parsing) : group_scope. -Local Notation P := `S`_\F%G. -Local Notation "` 'P'" := `S`_\F (at level 0) : group_scope. -Local Notation PU := S^`(1)%G. -Local Notation "` 'PU'" := `S^`(1) (at level 0) : group_scope. -Local Notation "` 'U'" := (gval U) (at level 0, only parsing) : group_scope. - -Local Notation "` 'T'" := (gval T) (at level 0, only parsing) : group_scope. -Local Notation Q := `T`_\F%G. -Local Notation "` 'Q'" := `T`_\F (at level 0) : group_scope. -Local Notation QV := T^`(1)%G. -Local Notation "` 'QV'" := `T^`(1) (at level 0) : group_scope. -Local Notation "` 'V'" := (gval V) (at level 0, only parsing) : group_scope. - -Let defS : PU ><| W1 = S. Proof. by have [[]] := StypeP. Qed. -Let defPU : P ><| U = PU. Proof. by have [_ []] := StypeP. Qed. - -Let defT : QV ><| W2 = T. Proof. by have [[]] := TtypeP. Qed. -Let defQV : Q ><| V = QV. Proof. by have [_ []] := TtypeP. Qed. - -Let notStype1 : FTtype S != 1%N. Proof. exact: FTtypeP_neq1 StypeP. Qed. -Let notStype5 : FTtype S != 5%N. Proof. exact: FTtype5_exclusion maxS. Qed. - -Let pddS := FT_prDade_hypF maxS StypeP. -Let ptiWS : primeTI_hypothesis S PU defW := FT_primeTI_hyp StypeP. -Let ctiWG : cyclicTI_hypothesis G defW := pddS. - -Let pddT := FT_prDade_hypF maxT TtypeP. -Let ptiWT : primeTI_hypothesis T QV xdefW := FT_primeTI_hyp TtypeP. - -Let ntW1 : W1 :!=: 1. Proof. by have [[]] := StypeP. Qed. -Let ntW2 : W2 :!=: 1. Proof. by have [_ _ _ []] := StypeP. Qed. -Let cycW1 : cyclic W1. Proof. by have [[]] := StypeP. Qed. -Let cycW2 : cyclic W2. Proof. by have [_ _ _ []] := StypeP. Qed. - -Let p := #|W2|. -Let q := #|W1|. -Let u := #|U|. -Let v := #|V|. -Let nU := (p ^ q).-1 %/ p.-1. -Let nV := (q ^ p).-1 %/ q.-1. - -Let pr_p : prime p. Proof. by have [] := FTtypeP_primes maxS StypeP. Qed. -Let pr_q : prime q. Proof. by have [] := FTtypeP_primes maxS StypeP. Qed. - -Local Open Scope ring_scope. - -Let qgt2 : (q > 2)%N. Proof. by rewrite odd_gt2 ?mFT_odd ?cardG_gt1. Qed. -Let pgt2 : (p > 2)%N. Proof. by rewrite odd_gt2 ?mFT_odd ?cardG_gt1. Qed. - -Let coPUq : coprime #|PU| q. -Proof. by rewrite (coprime_sdprod_Hall_r defS); have [[]] := StypeP. Qed. - -Let nirrW1 : #|Iirr W1| = q. Proof. by rewrite card_Iirr_cyclic. Qed. -Let nirrW2 : #|Iirr W2| = p. Proof. by rewrite card_Iirr_cyclic. Qed. -Let NirrW1 : Nirr W1 = q. Proof. by rewrite -nirrW1 card_ord. Qed. -Let NirrW2 : Nirr W2 = p. Proof. by rewrite -nirrW2 card_ord. Qed. - -Let sigma := (cyclicTIiso ctiWG). -Let w_ i j := (cyclicTIirr defW i j). -Local Notation eta_ i j := (sigma (w_ i j)). - -Local Notation Imu2 := (primeTI_Iirr ptiWS). -Let mu2_ i j := primeTIirr ptiWS i j. -Let mu_ := primeTIred ptiWS. -Local Notation chi_ j := (primeTIres ptiWS j). - -Local Notation Inu2 := (primeTI_Iirr ptiWT). -Let nu2_ i j := primeTIirr ptiWT j i. -Let nu_ := primeTIred ptiWT. - -Local Notation tauS := (FT_Dade0 maxS). -Local Notation tauT := (FT_Dade0 maxT). - -Let calS0 := seqIndD PU S S`_\s 1. -Let rmR_S := FTtypeP_coh_base maxS StypeP. -Let scohS0 : subcoherent calS0 tauS rmR_S. -Proof. exact: FTtypeP_subcoherent StypeP. Qed. - -Let calS := seqIndD PU S P 1. -Let sSS0 : cfConjC_subset calS calS0. -Proof. exact/seqInd_conjC_subset1/Fcore_sub_FTcore. Qed. - -Let calT := seqIndD QV T Q 1. - -(* This is Hypothesis (14.1). *) -Hypothesis ltqp: (q < p)%N. - -(* This corresponds to Peterfalvi, Theorem (14.2). *) -(* As we import the conclusion of BGappendixC, which covers Appendix C of the *) -(* Bender and Glauberman text, we can state this theorem negatively. This *) -(* will avoid having to repeat its statement thoughout the proof : we will *) -(* simply end each nested set of assumptions (corresponding to (14.3) and *) -(* (14.10)) with a contradiction. *) -Theorem no_full_FT_Galois_structure : - ~ [/\ (*a*) exists Fpq : finFieldImage P W2 U, - [/\ #|P| = (p ^ q)%N, #|U| = nU & coprime nU p.-1] - & (*b*) [/\ q.-abelem Q, W2 \subset 'N(Q) - & exists2 y, y \in Q & W2 :^ y \subset 'N(U)]]. -Proof. -case=> [[Fpq [oP oU coUp1]] [abelQ nQW2 nU_W2Q]]. -have /idPn[] := ltqp; rewrite -leqNgt. -exact: (prime_dim_normed_finField _ _ _ defPU) nU_W2Q. -Qed. - -(* Justification for Hypothesis (14.3). *) -Fact FTtypeP_max_typeII : FTtype S == 2. -Proof. by have [[_ ->]] := FTtypeP_facts maxS StypeP. Qed. -Let Stype2 := FTtypeP_max_typeII. - -(* These correspond to Peterfalvi, Hypothesis (14.3). *) -Variables (L : {group gT}) (tau1L : {additive 'CF(L) -> 'CF(G)}) (phi : 'CF(L)). -Local Notation "` 'L'" := (gval L) (at level 0, only parsing). -Local Notation H := `L`_\F%G. -Local Notation "` 'H'" := `L`_\F%g (at level 0, format "` 'H'") : group_scope. - -Hypothesis maxNU_L : L \in 'M('N(U)). - -(* Consequences of the above. *) -Hypotheses (maxL : L \in 'M) (sNUL : 'N(U) \subset L) (sUH : U \subset H). -Hypotheses (frobL : [Frobenius L with kernel H]) (Ltype1 : FTtype L == 1%N). - -Let calL := seqIndD H L H 1. -Local Notation tauL := (FT_DadeF maxL). -Let nsHL : H <| L. Proof. exact: gFnormal. Qed. -Let irrL : {subset calL <= irr L}. Proof. exact: FTtype1_Ind_irr. Qed. - -Hypothesis cohL : coherent_with calL L^# tauL tau1L. -Hypotheses (Lphi : phi \in calL) (phi1 : phi 1%g = #|L : H|%:R). - -Let betaS := FTtypeP_bridge StypeP #1. -Let betaT := FTtypeP_bridge TtypeP #1. -Let betaL := 'Ind[L, H] 1 - phi. - -(* This is the first assertion of Peterfalvi (14.4). *) -Let galT : typeP_Galois TtypeP. -Proof. -apply: contraLR ltqp => /(FTtypeP_nonGalois_facts maxT)[]. -by rewrite -/p -leqNgt => ->. -Qed. - -(* This is the second assertion of Peterfalvi (14.4). *) -Let oV : v = nV. -Proof. -rewrite /v (card_FTtypeP_Galois_compl maxT galT) -/nV. -by rewrite !modn_small ?gtn_eqF // ltnW. -Qed. - -(* This is Peterfalvi (14.5). *) -Let defL : exists2 y, y \in Q & H ><| (W1 <*> W2 :^ y) = L. -Proof. -have [//|_ _ []// defL] := FTtypeII_support_facts maxS StypeP _ pairST maxNU_L. -have [_ _ /negP[]] := compl_of_typeII maxS StypeP Stype2. -have [_ _ _] := FTtypeI_bridge_facts maxS StypeP Ltype1 cohL Lphi phi1. -case=> [[_ ubH] | [_ /idPn[]]]; last by rewrite -(index_sdprod defL) -ltnNge. -have{ubH} /eqP defH: `H == U. - rewrite eq_sym eqEcard sUH /= -(prednK (cardG_gt0 U)) -add1n -leq_subLR subn1. - have [_ _ _ _ /divnK <-] := FTtypeP_bridge_facts maxS StypeP. - by rewrite -leC_nat natrM -ler_pdivr_mulr ?gt0CG // {1}(index_sdprod defL). -rewrite (subset_trans sNUL) // -(sdprodW defL) -(sdprodW defS) mulSg //. -by rewrite -(sdprodW defPU) defH mulG_subr. -Qed. - -Let indexLH : #|L : H| = (p * q)%N. -Proof. -have [y Qy /index_sdprod <-] := defL; rewrite (dprod_card xdefW). -suffices /normP <-: y \in 'N(W1) by rewrite -conjYg cardJg (dprodWY defW). -have cQQ: abelian Q by have [_ [/and3P[]]] := FTtypeP_facts _ TtypeP. -by apply: (subsetP (sub_abelian_norm cQQ _)) => //; have [_ _ _ []] := TtypeP. -Qed. - -(* This is Peterfalvi (14.6). *) -Let galS : typeP_Galois StypeP. -Proof. -apply/idPn=> gal'S; have [q3 oU] := FTtypeP_nonGalois_facts maxS gal'S. -have [H1 [_ _ _ _]] := typeP_Galois_Pn maxS (FTtype5_exclusion maxS) gal'S. -rewrite def_Ptype_factor_prime // Ptype_Fcompl_kernel_trivial // -/p q3 /=. -set a := #|U : _| => [] [a_gt1 a_dv_p1 _ [U1 isoU1]]. -have{isoU1} isoU: U \isog U1 := isog_trans (quotient1_isog U) isoU1. -have{a_gt1 a_dv_p1} defU1: U1 :=: [set: 'rV_2]. - apply/eqP; rewrite eqEcard subsetT -(card_isog isoU) oU. - rewrite cardsT card_matrix card_ord Zp_cast // leq_sqr -/p. - apply: dvdn_leq; first by rewrite -(subnKC pgt2). - rewrite -divn2 -(@Gauss_dvdl a _ 2) ?divnK //. - by rewrite dvdn2 -subn1 odd_sub ?odd_gt0 ?mFT_odd. - by rewrite coprimen2 (dvdn_odd (dvdn_indexg U _)) ?mFT_odd. -have [r pr_r r_r_U] := rank_witness U. -have [R0 sylR0] := Sylow_exists r U; have [sR0U rR0 _] := and3P sylR0. -have [R sylR sR0R] := Sylow_superset (subset_trans sR0U sUH) rR0. -have [sRH rR _] := and3P sylR. -have cUU: abelian U by have [[]] := FTtypeP_facts maxS StypeP. -have tiA0: normedTI 'A0(S) G S by have [_ _ _ _ []] := FTtypeP_facts _ StypeP. -have [_ sUPU _ nPU _] := sdprod_context defPU. -have coPU := coprimegS (joing_subl U W1) (Ptype_Fcore_coprime StypeP). -have abR0: abelian R0 := abelianS sR0U cUU. -have{a U1 defU1 isoU r_r_U} rR0_2: 'r(R0) = 2. - by rewrite (rank_Sylow sylR0) -r_r_U (isog_rank isoU) defU1 rank_mx_group. -have piUr: r \in \pi(U) by rewrite -p_rank_gt0 -(rank_Sylow sylR0) rR0_2. -have /exists_inP[x /setD1P[ntx R0x] ntCPx]: [exists x in R0^#, 'C_P[x] != 1%g]. - have ncycR0: ~~ cyclic R0 by rewrite abelian_rank1_cyclic ?rR0_2. - have coPR0: coprime #|P| #|R0| := coprimegS sR0U coPU. - rewrite -negb_forall_in; apply: contra (mmax_Fcore_neq1 maxS) => regR0P. - rewrite -subG1 -(coprime_abelian_gen_cent1 abR0 _ (subset_trans sR0U nPU)) //. - by rewrite gen_subG; apply/bigcupsP=> x /(eqfun_inP regR0P)->. -have{x ntx R0x ntCPx} sZR_R0: 'Z(R) \subset R0. - have A0x: x \in 'A0(S). - have [z /setIP[Pz cyz] ntz] := trivgPn _ ntCPx. - apply/setUP; left; apply/bigcupP; exists z. - by rewrite !inE ntz (subsetP (Fcore_sub_FTcore maxS)). - by rewrite (eqP Stype2) 3!inE ntx cent1C (subsetP sUPU) ?(subsetP sR0U). - have sCxS: 'C[x] \subset S by rewrite -['C[x]]setTI (cent1_normedTI tiA0). - suffices <-: 'C_R[x] = R0. - by rewrite -cent_set1 setIS ?centS // sub1set (subsetP sR0R). - have /Hall_pi hallU: Hall PU U by rewrite -(coprime_sdprod_Hall_r defPU). - have /Hall_pi hallPU: Hall S PU by rewrite -(coprime_sdprod_Hall_l defS). - have sylR0_S: r.-Sylow(S) R0. - by apply: subHall_Sylow piUr sylR0; apply: subHall_Hall (piSg sUPU) hallU. - rewrite ['C_R[x]](sub_pHall sylR0_S) ?(pgroupS _ rR) ?subsetIl //. - by rewrite subsetI sR0R sub_cent1 (subsetP abR0). - by rewrite subIset ?sCxS ?orbT. -pose R1 := 'Ohm_1('Z(R))%G; pose m := logn r #|R1|. -have sR10: R1 \subset R0 by apply: gFsub_trans. -have oR1: #|R1| = (r ^ m)%N by rewrite -card_pgroup ?(pgroupS sR10). -have{sZR_R0 rR0_2} m12: pred2 1%N 2 m. - transitivity (0 < m < 1 + 2)%N; first by rewrite -mem_iota !inE. - rewrite -[m]p_rank_abelian ?center_abelian -?rank_pgroup ?(pgroupS sZR_R0) //. - rewrite rank_gt0 ltnS -rR0_2 rankS // center_nil_eq1 ?(pgroup_nil rR) //. - by rewrite (subG1_contra sR0R) // -rank_gt0 rR0_2. -have [y Qy defLy] := defL; have [_ _ /joing_subP[_ nHW2y] _] := sdprodP defLy. -have chR1H: R1 \char H. - by rewrite !gFchar_trans // (nilpotent_Hall_pcore (Fcore_nil L) sylR) gFchar. -have nR1W2y: W2 :^ y \subset 'N(R1) by apply: char_norm_trans chR1H nHW2y. -have regR1W2y: semiregular R1 (W2 :^ y). - have /Frobenius_reg_ker regHW12y := set_Frobenius_compl defLy frobL. - exact: semiregularS (char_sub chR1H) (joing_subr _ _) regHW12y. -have /idPn[]: r %| p.-1./2. - have:= piUr; rewrite mem_primes => /and3P[_ _ /=]. - by rewrite oU Euclid_dvdX ?andbT. -rewrite gtnNdvd //; first by rewrite -(subnKC pgt2). -apply: leq_trans (_ : p.-1 <= r)%N. - by rewrite -divn2 ltn_divLR // -{1}[p.-1]muln1 -(subnKC pgt2) ltn_pmul2l. -have: p %| (r ^ m).-1. - by have:= regular_norm_dvd_pred nR1W2y regR1W2y; rewrite cardJg oR1. -rewrite -[p.-1]subn1 leq_subLR predn_exp Euclid_dvdM // => /orP[]/dvdn_leq. - by rewrite -(subnKC (prime_gt1 pr_r)) => /(_ isT)/leq_trans->; rewrite 2?ltnW. -case/pred2P: m12 => ->; rewrite ?(big_ord_recl 1) big_ord1 => /(_ isT) //. -by move/leq_trans->. -Qed. - -(* This is Peterfalvi (14.7). *) -Let not_charUH : ~~ (U \char H). -Proof. -have [y Qy defLy] := defL; have [_ _ /joing_subP[_ nHW2y] _] := sdprodP defLy. -apply/negP=> chUH; have nUW2y := char_norm_trans chUH nHW2y. -case: no_full_FT_Galois_structure; split; last first. - split; [by have [_ []] := FTtypeP_facts _ TtypeP | | by exists y]. - by have /sdprodP[_ _ /joing_subP[]] := Ptype_Fcore_sdprod TtypeP. -have <-: #|U| = nU. - have regUW2y: semiregular U (W2 :^ y). - have /Frobenius_reg_ker regHW12y := set_Frobenius_compl defLy frobL. - exact: semiregularS (char_sub chUH) (joing_subr _ _) regHW12y. - case: ifP (card_FTtypeP_Galois_compl maxS galS) => //. - rewrite -/p -/q -/nU => p_modq_1 oU. - have{p_modq_1 oU} oU: (#|U| * q)%N = nU. - by rewrite oU divnK //; have [|_ ->] := FTtypeP_primes_mod_cases _ StypeP. - have /eqP Umodp: #|U| == 1 %[mod p]. - have:= regular_norm_dvd_pred nUW2y regUW2y. - by rewrite cardJg -/p -subn1 eqn_mod_dvd. - have: nU == 1 %[mod p]. - rewrite /nU predn_exp mulKn; last by rewrite -(subnKC pgt2). - rewrite -(ltn_predK qgt2) big_ord_recl addnC -modnDml -modn_summ modnDml. - by rewrite big1 // => i _; rewrite expnS modnMr. - by rewrite -oU -modnMml Umodp modnMml mul1n !modn_small ?gtn_eqF ?prime_gt1. -have [F []] := typeP_Galois_P maxS (FTtype5_exclusion maxS) galS. -rewrite Ptype_factor_prime ?(group_inj (Ptype_Fcore_kernel_trivial _ _)) //. -rewrite Ptype_Fcompl_kernel_trivial // => psiP [psiU _ [/trivgP inj_psiU psiJ]]. -rewrite /= -injm_subcent ?coset1_injm ?norms1 // -morphim_comp -/p. -rewrite (typeP_cent_core_compl StypeP) => [[_ /isomP[inj_psiP im_psiP] psiW2]]. -rewrite -(card_isog (quotient1_isog U)) => [[_ coUp1 _]]. -suffices FPU: finFieldImage P W2 U. - by exists FPU; have [_ []] := FTtypeP_facts maxS StypeP. -have /domP[sig [Dsig Ksig _ im_sig]]: 'dom (psiP \o coset 1) = P. - by apply: injmK; rewrite ?coset1_injm ?norms1. -have{Ksig} inj_sig: 'injm sig by rewrite Ksig injm_comp ?coset1_injm. -exists F sig; first by apply/isomP; rewrite im_sig morphim_comp. - by rewrite -psiW2 -im_sig injmK // -(typeP_cent_core_compl StypeP) subsetIl. -exists psiU => // z x Pz Ux /=; have inN1 x1: x1 \in 'N(1) by rewrite norm1 inE. -by rewrite !Dsig -psiJ ?mem_morphim //= qactE ?dom_qactJ. -Qed. - -(* This is Peterfalvi (14.8)(a). *) -(* In order to avoid the use of real analysis and logarithms we bound the *) -(* binomial expansion of n.+1 ^ q.+1 directly. *) -Let qp1_gt_pq1 : (q ^ p.+1 > p ^ q.+1)%N. -Proof. -have: (4 < p)%N by rewrite odd_geq ?mFT_odd ?(leq_trans _ ltqp). -elim: p ltqp => // n IHn; rewrite !ltnS => ngeq. -rewrite leq_eqVlt => /predU1P[/esym n4 | ngt4]. - suffices /eqP <-: 3 == q by rewrite n4. - by rewrite eqn_leq qgt2 -ltnS -(odd_ltn 5) ?mFT_odd // -n4. -apply: leq_trans (_ : q * n ^ q.+1 <= _)%N; last first. - rewrite (expnS q) leq_mul //. - by move: ngeq; rewrite leq_eqVlt => /predU1P[-> | /IHn/(_ ngt4)/ltnW]. -apply: leq_trans (_ : (2 * q.+1 + n) * n ^ q <= _)%N; last first. - rewrite expnS mulnA leq_mul // addnC. - move: ngeq; rewrite leq_eqVlt => /predU1P[-> | n_gtq]. - apply: leq_trans (_ : 4 * n <= _)%N; last by rewrite leq_mul // ltnW. - by rewrite mulnSr addnA -mulSn (mulSnr 3) leq_add2l 3?ltnW. - by rewrite -{2}(subnKC qgt2) addSn (mulSn _ n) leq_add2l leq_mul. -rewrite mulnDl -expnS -[n.+1]add1n expnDn big_ord_recr binn subnn !mul1n /=. -rewrite ltn_add2r -(@ltn_pmul2l (2 ^ q)) ?expn_gt0 // !mulnA -expnSr. -apply: leq_ltn_trans (_ : (2 ^ q.+1).-1 * q.+1 * n ^ q < _)%N; last first. - by rewrite -(subnKC ngt4) !ltn_pmul2r ?prednK ?expn_gt0. -rewrite -mulnA predn_exp mul1n big_distrr big_distrl leq_sum // => [[i]] /=. -rewrite ltnS exp1n mul1n => leiq _; rewrite -{1 4}(subnKC leiq) !expnD. -rewrite -mulnA leq_mul // mulnA mulnCA mulnC leq_mul // -bin_sub ?leqW //. -rewrite -(leq_pmul2r (fact_gt0 (q.+1 - i))) -mulnA bin_ffact mulnC subSn //. -rewrite ffactnS /= -!mulnA leq_mul //=; elim: {i leiq}(q - i)%N => //= i IHi. -rewrite ffactnSr expnSr mulnACA expnS factS (mulnACA n) mulnC leq_mul //. -by rewrite leq_mul // (leq_trans (leq_subr _ _)). -Qed. - -(* This is Peterfalvi (14.8)(b). *) -Let v1p_gt_u1q : (v.-1 %/ p > u.-1 %/ q)%N. -Proof. -have ub_u: (u.-1 <= nU - 1)%N. - rewrite -subn1 leq_sub2r //; have [_ _] := FTtypeP_facts maxS StypeP. - by rewrite (FTtypeP_reg_Fcore maxS StypeP) indexg1. -rewrite ltn_divLR ?prime_gt0 // {ub_u}(leq_ltn_trans ub_u) //. -have p_dv_v1: p %| v.-1 by have [] := FTtypeP_bridge_facts maxT TtypeP. -rewrite divn_mulAC // ltn_divRL ?dvdn_mulr // oV -subn1. -rewrite -(@ltn_pmul2l q.-1) ?(mulnCA q.-1); last by rewrite -(subnKC qgt2). -rewrite !mulnA -(@ltn_pmul2l p.-1); last by rewrite -(subnKC pgt2). -rewrite -mulnA mulnCA mulnA !(mulnBl _ _ _.-1) !divnK ?dvdn_pred_predX //. -rewrite !mul1n mulnCA -!subn1 ltn_mul ?ltn_sub2r ?prime_gt1 //. -rewrite -!subnDA !subnKC ?prime_gt0 // !mulnBl -!expnSr !mulnn. -by rewrite -subSn ?leq_exp2l ?leqW ?prime_gt1 ?leq_sub ?leq_exp2r // ltnW. -Qed. - -Let calT0 := seqIndD QV T T`_\s 1. -Let rmR_T := FTtypeP_coh_base maxT TtypeP. -Let scohT0 : subcoherent calT0 tauT rmR_T. -Proof. exact: FTtypeP_subcoherent. Qed. - -Let sTT0 : cfConjC_subset calS calS0. -Proof. exact/seqInd_conjC_subset1/Fcore_sub_FTcore. Qed. - -(* This is Peterfalvi (14.9). *) -Lemma FTtypeP_min_typeII : FTtype T == 2. -Proof. -apply: contraLR v1p_gt_u1q => notTtype2; rewrite -leqNgt -leC_nat. -have [o_betaT0_eta _ [Ttype3 _]] := FTtype34_structure maxT TtypeP notTtype2. -have Ttype_gt2: (2 < FTtype T)%N by rewrite (eqP Ttype3). -have [[_ _ frobVW2 cVV] _ _ _ _] := FTtypeP_facts _ TtypeP. -pose calT1 := seqIndD QV T QV Q; have sT10: cfConjC_subset calT1 calT0. - by apply/seqInd_conjC_subset1; rewrite /= FTcore_eq_der1. -rewrite (FTtypeP_reg_Fcore maxT TtypeP) (group_inj (joingG1 _)) in o_betaT0_eta. -do [rewrite -/calT1; set eta_0 := \sum_j _] in o_betaT0_eta. -have scohT1: subcoherent calT1 tauT rmR_T := subset_subcoherent scohT0 sT10. -have [nsQQV sVQV _ _ _] := sdprod_context defQV. -have nsQVT: QV <| T := der_normal 1 T. -have calT1_1p zeta: zeta \in calT1 -> zeta 1%g = p%:R. - case/seqIndP=> s /setDP[kerQs _] -> /=; rewrite inE in kerQs. - rewrite cfInd1 ?gFsub // -(index_sdprod defT) lin_char1 ?mulr1 //. - rewrite lin_irr_der1 (subset_trans _ kerQs) // der1_min ?normal_norm //. - by rewrite -(isog_abelian (sdprod_isog defQV)). -have [tau1T cohT1]: coherent calT1 T^# tauT. - apply/(uniform_degree_coherence scohT1)/(@all_pred1_constant _ p%:R). - by apply/allP=> _ /mapP[zeta T1zeta ->]; rewrite /= calT1_1p. -have irrT1: {subset calT1 <= irr T}. - move=> _ /seqIndP[s /setDP[kerQs nz_s] ->]; rewrite inE in kerQs. - rewrite inE subGcfker in nz_s; rewrite -(quo_IirrK nsQQV kerQs) mod_IirrE //. - rewrite cfIndMod ?normal_sub ?cfMod_irr ?gFnormal //. - rewrite irr_induced_Frobenius_ker ?quo_Iirr_eq0 //=. - have /sdprod_isom[nQ_VW1 /isomP[injQ <-]] := Ptype_Fcore_sdprod TtypeP. - have ->: (QV / Q)%g = (V / Q)%g by rewrite -(sdprodW defQV) quotientMidl. - have ->: (V / Q)%g = restrm nQ_VW1 (coset Q) @* V. - by rewrite morphim_restrm (setIidPr _) // joing_subl. - by rewrite injm_Frobenius_ker // (FrobeniusWker frobVW2). -have [[A0betaS PVbetaS] _ [_]] := FTtypeP_bridge_facts maxS StypeP. -rewrite -/q -/u; set Gamma := FTtypeP_bridge_gap _ _ => oGa1 R_Ga lb_Ga _. -have oT1eta: orthogonal (map tau1T calT1) (map sigma (irr W)). - apply/orthogonalP=> _ _ /mapP[zeta T1zeta ->] /mapP[omega Womega ->]. - have{omega Womega} [i [j ->]] := cycTIirrP defW Womega. - by rewrite (cycTIisoC _ pddT) (coherent_ortho_cycTIiso _ sT10 cohT1) ?irrT1. -have [[Itau1T Ztau1T] Dtau1T] := cohT1. -have nzT1_Ga zeta: zeta \in calT1 -> `|'[Gamma, tau1T zeta]| ^+ 2 >= 1. - have Z_Ga: Gamma \in 'Z[irr G]. - rewrite rpredD ?cycTIiso_vchar // rpredB ?rpred1 ?Dade_vchar // zchar_split. - by rewrite A0betaS ?Iirr1_neq0 // rpredB ?cfInd_vchar ?rpred1 ?irr_vchar. - move=> T1zeta; rewrite expr_ge1 ?normr_ge0 // norm_Cint_ge1 //. - by rewrite Cint_cfdot_vchar ?Ztau1T ?(mem_zchar T1zeta). - suffices: ('[Gamma, tau1T zeta] == 1 %[mod 2])%C. - by apply: contraTneq => ->; rewrite (eqCmod_nat 2 0 1). - pose betaT0 := nu_ 0 - zeta. - have{o_betaT0_eta} o_eta0_betaT0 j: '[eta_ 0 j, tauT betaT0] = (j == 0)%:R. - transitivity '[eta_ 0 j, eta_0]; rewrite (cycTIisoC _ pddT). - apply/eqP; rewrite -subr_eq0 -cfdotBr cfdotC. - by rewrite (orthoPl (o_betaT0_eta _ _)) ?conjC0 // map_f ?mem_irr. - rewrite cfdot_sumr (bigD1 0) //= cfdot_cycTIiso andbT big1 ?addr0 //. - by move=> i /negPf nz_i; rewrite cfdot_cycTIiso andbC eq_sym nz_i. - have QVbetaT0: betaT0 \in 'CF(T, QV^#). - rewrite cfun_onD1 rpredB ?(seqInd_on _ T1zeta) //=; last first. - by rewrite /nu_ -cfInd_prTIres cfInd_normal. - by rewrite !cfunE prTIred_1 prTIirr0_1 mulr1 calT1_1p ?subrr. - have A0betaT0: betaT0 \in 'CF(T, 'A0(T)). - by rewrite (cfun_onS (FTsupp1_sub0 _)) // /'A1(T) ?FTcore_eq_der1. - have ZbetaT0: betaT0 \in 'Z[irr T]. - by rewrite rpredB ?char_vchar ?(seqInd_char T1zeta) ?prTIred_char. - pose Delta := tauT betaT0 - 1 + tau1T zeta. - have nz_i1: #1 != 0 := Iirr1_neq0 ntW2. - rewrite -(canLR (addKr _) (erefl Delta)) opprB cfdotDr cfdotBr oGa1 add0r. - rewrite cfdotDl cfdotBl -/betaS o_eta0_betaT0 (negPf nz_i1) // addr0 opprB. - rewrite -(cycTIiso1 pddS) -(cycTIirr00 defW) {}o_eta0_betaT0 mulr1n. - have QV'betaS: tauS betaS \in 'CF(G, ~: class_support QV^# G). - have [_ [pP _] _ _ [_ ->]] := FTtypeP_facts _ StypeP; rewrite ?A0betaS //. - apply: cfun_onS (cfInd_on (subsetT S) (PVbetaS _ nz_i1)). - apply/subsetP=> x PWx; rewrite inE. - have{PWx}: p \in \pi(#[x]). - case/imset2P: PWx => {x}x y PWx _ ->; rewrite {y}orderJ. - case/setUP: PWx => [/setD1P[ntx Px] | /imset2P[{x}x y Wx _ ->]]. - rewrite -p_rank_gt0 -rank_pgroup ?rank_gt0 ?cycle_eq1 //. - exact: mem_p_elt (abelem_pgroup pP) Px. - case/setDP: Wx; rewrite {y}orderJ; have [_ <- cW12 _] := dprodP defW. - case/mulsgP=> {x}x y W1x W2y ->; have cyx := centsP cW12 _ W2y _ W1x. - have [-> | nty _] := eqVneq y 1%g; first by rewrite inE mulg1 W1x. - have p'x: p^'.-elt x. - by rewrite (mem_p_elt _ W1x) /pgroup ?pnatE ?inE ?ltn_eqF. - have p_y: p.-elt y by rewrite (mem_p_elt (pnat_id _)). - rewrite -cyx orderM ?(pnat_coprime p_y) // pi_ofM // inE /=. - by rewrite -p_rank_gt0 -rank_pgroup // rank_gt0 cycle_eq1 nty. - apply: contraL => /imset2P[z y /setD1P[_ QVz] _ ->]; rewrite {x y}orderJ. - rewrite -p'natEpi // [_.-nat _](mem_p_elt _ QVz) // /pgroup ?p'natE //. - rewrite -prime_coprime // coprime_sym (coprime_sdprod_Hall_r defT). - by have [[]] := TtypeP. - have [_ _ _ _ [_ -> //]] := FTtypeP_facts _ TtypeP. - rewrite (cfdotElr QV'betaS (cfInd_on _ QVbetaT0)) ?subsetT //=. - rewrite setIC setICr big_set0 mulr0 subr0 addrC /eqCmod addrK. - rewrite cfdot_real_vchar_even ?mFT_odd ?oGa1 ?rpred0 //; split. - rewrite rpredD ?Ztau1T ?(mem_zchar T1zeta) // rpredB ?rpred1 //. - by rewrite Dade_vchar // zchar_split ZbetaT0. - rewrite /cfReal -subr_eq0 opprD opprB rmorphD rmorphB rmorph1 /= addrACA. - rewrite !addrA subrK -Dade_aut -linearB /= -/tauT rmorphB opprB /=. - rewrite -prTIred_aut aut_Iirr0 -/nu_ [sum in tauT sum]addrC addrA subrK. - rewrite -Dtau1T; last first. - by rewrite (zchar_onS _ (seqInd_sub_aut_zchar _ _ _)) // setSD ?der_sub. - rewrite raddfB -addrA addrC addrA subrK subr_eq0. - by rewrite (cfConjC_Dade_coherent cohT1) ?mFT_odd ?irrT1. -have [Y T1_Y [X [defGa oYX oXT1]]] := orthogonal_split (map tau1T calT1) Gamma. -apply: ler_trans (lb_Ga X Y _ _ _); first 1 last; rewrite 1?addrC //. -- by rewrite cfdotC oYX conjC0. -- by apply/orthoPl=> eta Weta; rewrite (span_orthogonal oT1eta) // memv_span. -have ->: v.-1 = (p * size calT1)%N; last rewrite mulKn ?prime_gt0 //. - rewrite [p](index_sdprod defT); have isoV := sdprod_isog defQV. - rewrite [v](card_isog isoV) -card_Iirr_abelian -?(isog_abelian isoV) //. - rewrite -(card_imset _ (can_inj (mod_IirrK nsQQV))) (cardD1 0) /=. - rewrite -{1}(mod_Iirr0 QV Q) mem_imset //=. - rewrite (size_irr_subseq_seqInd _ (subseq_refl _)) //=. - apply: eq_card => s; rewrite !inE mem_seqInd ?gFnormal // !inE subGcfker. - congr (_ && _); apply/idP/idP=> [/imsetP[r _ ->] | kerQs]. - by rewrite mod_IirrE ?cfker_mod. - by rewrite -(quo_IirrK nsQQV kerQs) mem_imset. -have o1T1: orthonormal (map tau1T calT1). - rewrite map_orthonormal ?(sub_orthonormal irrT1) ?seqInd_uniq //. - exact: irr_orthonormal. -have [_ -> ->] := orthonormal_span o1T1 T1_Y. -rewrite cfnorm_sum_orthonormal // big_map -sum1_size natr_sum !big_seq. -apply: ler_sum => // zeta T1zeta; rewrite -(canLR (addrK X) defGa). -by rewrite cfdotBl (orthoPl oXT1) ?subr0 ?nzT1_Ga ?map_f. -Qed. -Let Ttype2 := FTtypeP_min_typeII. - -(* These declarations correspond to Hypothesis (14.10). *) -Variables (M : {group gT}) (tau1M : {additive 'CF(M) -> 'CF(G)}) (psi : 'CF(M)). -Hypothesis maxNV_M : M \in 'M('N(V)). - -Local Notation "` 'M'" := (gval M) (at level 0, only parsing). -Local Notation K := `M`_\F%G. -Local Notation "` 'K'" := `M`_\F%g (at level 0, format "` 'K'") : group_scope. - -(* Consequences of the above. *) -Hypotheses (maxM : M \in 'M) (sNVM : 'N(V) \subset M). -Hypotheses (frobM : [Frobenius M with kernel K]) (Mtype1 : FTtype M == 1%N). - -Let calM := seqIndD K M K 1. -Local Notation tauM := (FT_DadeF maxM). -Let nsKM : K <| M. Proof. exact: gFnormal. Qed. -Let irrM : {subset calM <= irr M}. Proof. exact: FTtype1_Ind_irr. Qed. - -Hypothesis cohM : coherent_with calM M^# tauM tau1M. -Hypotheses (Mpsi : psi \in calM) (psi1 : psi 1%g = #|M : K|%:R). - -Let betaM := 'Ind[M, K] 1 - psi. - -Let pairTS : typeP_pair T S xdefW. Proof. exact: typeP_pair_sym pairST. Qed. - -Let pq : algC := (p * q)%:R. -Let h := #|H|. - -(* This is the first (and main) part of Peterfalvi (14.11). *) -Let defK : `K = V. -Proof. -pose e := #|M : K|; pose k := #|K|; apply: contraTeq isT => notKV. -have [_ sVK defM] := FTtypeII_support_facts maxT TtypeP Ttype2 pairTS maxNV_M. -have ltVK: V \proper K by rewrite properEneq eq_sym notKV. -have e_dv_k1: e %| k.-1 := Frobenius_ker_dvd_ker1 frobM. -have [e_lepq regKW2]: (e <= p * q)%N /\ semiregular K W2. - case: defM => [|[y Py]] defM; rewrite /e -(index_sdprod defM). - have /Frobenius_reg_ker regHW1 := set_Frobenius_compl defM frobM. - by rewrite leq_pmulr ?cardG_gt0. - have /Frobenius_reg_ker regHW21y := set_Frobenius_compl defM frobM. - split; last exact: semiregularS (joing_subl _ _) regHW21y. - suffices /normP <-: y \in 'N(W2). - by rewrite -conjYg cardJg (dprodWY xdefW) -(dprod_card xdefW). - have cPP: abelian P by have [_ [/and3P[]]] := FTtypeP_facts maxS StypeP. - have sW2P: W2 \subset P by have [_ _ _ []] := StypeP. - by rewrite (subsetP _ y Py) // sub_abelian_norm. -(* This is (14.11.1). *) -have{regKW2} [lb_k lb_k1e_v]: (2 * p * v < k /\ v.-1 %/ p < k.-1 %/ e)%N. - have /dvdnP[x Dk]: v %| k := cardSg sVK. - have lb_x: (p.*2 < x)%N. - have x_gt1: (1 < x)%N. - by rewrite -(ltn_pmul2r (cardG_gt0 V)) -Dk mul1n proper_card. - have x_gt0 := ltnW x_gt1; rewrite -(prednK x_gt0) ltnS -subn1. - rewrite dvdn_leq ?subn_gt0 // -mul2n Gauss_dvd ?coprime2n ?mFT_odd //. - rewrite dvdn2 odd_sub // (dvdn_odd _ (mFT_odd K)) -/k ?Dk ?dvdn_mulr //=. - rewrite -eqn_mod_dvd // -[x]muln1 -modnMmr. - have nVW2: W2 \subset 'N(V) by have [_ []] := TtypeP. - have /eqP{1} <-: (v == 1 %[mod p]). - rewrite eqn_mod_dvd ?cardG_gt0 // subn1 regular_norm_dvd_pred //. - exact: semiregularS regKW2. - rewrite modnMmr -Dk /k eqn_mod_dvd // subn1 regular_norm_dvd_pred //. - by rewrite (subset_trans (subset_trans nVW2 sNVM)) ?gFnorm. - have lb_k: (2 * p * v < k)%N by rewrite mul2n Dk ltn_pmul2r ?cardG_gt0. - split=> //; rewrite ltn_divLR ?cardG_gt0 // divn_mulAC ?prednK ?cardG_gt0 //. - rewrite leq_divRL ?indexg_gt0 // (leq_trans (leq_mul (leqnn v) e_lepq)) //. - rewrite mulnA mulnAC leq_mul // -ltnS prednK ?cardG_gt0 //. - apply: leq_ltn_trans lb_k; rewrite mulnC leq_mul // ltnW ?(leq_trans ltqp) //. - by rewrite mul2n -addnn leq_addl. -have lb_k1e_u := ltn_trans v1p_gt_u1q lb_k1e_v; have irr_psi := irrM Mpsi. -have Mgt1: (1 < size calM)%N by apply: seqInd_nontrivial Mpsi; rewrite ?mFT_odd. -(* This is (14.11.2). *) -have [] // := FTtype2_support_coherence TtypeP StypeP cohM Mpsi. -rewrite -/e -/p -/q mulnC /= => De [nb [chi Dchi]]. -rewrite cycTIiso_irrelC -/sigma -/betaM => DbetaM. -pose ddMK := FT_DadeF_hyp maxM; pose AM := Dade_support ddMK. -have defAM: AM = 'A~(M) by rewrite FTsupp_Frobenius -?FT_DadeF_supportE. -pose ccG A := class_support A G. -pose G0 := ~: ('A~(M) :|: ccG What :|: ccG P^# :|: ccG Q^#). -have sW2P: W2 \subset P by have [_ _ _ []] := StypeP. -have sW1Q: W1 \subset Q by have [_ _ _ []] := TtypeP. -(* This is (14.11.3). *) -have lbG0 g: g \in G0 -> 1 <= `|tau1M psi g| ^+ 2. - rewrite !inE ?expr_ge1 ?normr_ge0 // => /norP[/norP[/norP[AM'g W'g P'g Q'g]]]. - have{W'g} /coprime_typeP_Galois_core-co_p_g: g \notin ccG W^#. - apply: contra W'g => /imset2P[x y /setD1P[ntx Wx] Gy Dg]. - rewrite Dg mem_imset2 // !inE Wx andbT; apply/norP; split. - by apply: contra Q'g => /(subsetP sW1Q)?; rewrite Dg mem_imset2 ?inE ?ntx. - by apply: contra P'g => /(subsetP sW2P)Px; rewrite Dg mem_imset2 ?inE ?ntx. - have{AM'g} betaMg0: tauM betaM g = 0. - by apply: cfun_on0 AM'g; rewrite -defAM Dade_cfunS. - suffices{betaMg0}: 1 <= `|(\sum_ij (-1) ^+ nb ij *: sigma 'chi_ij) g|. - rewrite -[\sum_i _](subrK chi) -DbetaM !cfunE betaMg0 add0r. - case: Dchi => -> //; rewrite cfunE normrN. - by rewrite -(cfConjC_Dade_coherent cohM) ?mFT_odd ?cfunE ?norm_conjC. - have{co_p_g} Zeta_g ij: sigma 'chi_ij g \in Cint. - apply/Cint_cycTIiso_coprime/(coprime_dvdr (cforder_lin_char_dvdG _)). - by apply: irr_cyclic_lin; have [] := ctiWG. - rewrite -(dprod_card defW) coprime_mulr. - by apply/andP; split; [apply: co_p_g galT _ | apply: co_p_g galS _]. - rewrite sum_cfunE norm_Cint_ge1 ?rpred_sum // => [ij _|]. - by rewrite cfunE rpredMsign. - set a := \sum_i _; suffices: (a == 1 %[mod 2])%C. - by apply: contraTneq=> ->; rewrite (eqCmod_nat 2 0 1). - have signCmod2 n ij (b := sigma 'chi_ij g): ((-1) ^+ n * b == b %[mod 2])%C. - rewrite -signr_odd mulr_sign eqCmod_sym; case: ifP => // _. - by rewrite -(eqCmodDl _ b) subrr -[b + b](mulr_natr b 2) eqCmodMl0 /b. - rewrite -[1]addr0 [a](bigD1 0) {a}//= cfunE eqCmodD //. - by rewrite (eqCmod_trans (signCmod2 _ _)) // irr0 cycTIiso1 cfun1E inE. - rewrite (partition_big_imset (fun ij => [set ij; conjC_Iirr ij])) /= eqCmod0. - apply: rpred_sum => _ /=/imsetP[ij /negPf nz_ij ->]. - rewrite (bigD1 ij) /=; last by rewrite unfold_in nz_ij eqxx. - rewrite (big_pred1 (conjC_Iirr ij)) => [|ij1 /=]; last first. - rewrite unfold_in eqEsubset !subUset !sub1set !inE !(eq_sym ij). - rewrite !(can_eq (@conjC_IirrK _ _)) (canF_eq (@conjC_IirrK _ _)). - rewrite -!(eq_sym ij1) -!(orbC (_ == ij)) !andbb andbAC -andbA. - rewrite andb_orr andNb andbA andb_idl // => /eqP-> {ij1}. - rewrite conjC_Iirr_eq0 nz_ij -(inj_eq irr_inj) conjC_IirrE. - by rewrite odd_eq_conj_irr1 ?mFT_odd // irr_eq1 nz_ij. - rewrite -signr_odd -[odd _]negbK signrN !cfunE mulNr addrC. - apply: eqCmod_trans (signCmod2 _ _) _. - by rewrite eqCmod_sym conjC_IirrE -cfAut_cycTIiso cfunE conj_Cint. -have cardG_D1 R: #|R^#| = #|R|.-1 by rewrite [#|R|](cardsD1 1%g) group1. -pose rho := invDade ddMK; pose nG : algC := #|G|%:R. -pose sumG0 := \sum_(g in G0) `|tau1M psi g| ^+ 2. -pose sumG0_diff := sumG0 - (#|G0| + #|ccG What| + #|ccG P^#| + #|ccG Q^#|)%:R. -have ub_rho: '[rho (tau1M psi)] <= k.-1%:R / #|M|%:R - nG^-1 * sumG0_diff. - have NtauMpsi: '[tau1M psi] = 1. - by have [[Itau1 _] _] := cohM; rewrite Itau1 ?mem_zchar //= irrWnorm. - rewrite ler_subr_addl -subr_le0 -addrA. - have ddM_ i j: i != j :> 'I_1 -> [disjoint AM & AM] by rewrite !ord1. - apply: ler_trans (Dade_cover_inequality ddM_ NtauMpsi); rewrite -/nG -/AM. - rewrite !big_ord1 cardG_D1 ler_add2r ler_pmul2l ?invr_gt0 ?gt0CG //= defAM. - rewrite setTD ler_add ?ler_opp2 ?leC_nat //; last first. - do 3!rewrite -?addnA -cardsUI ?addnA (leq_trans _ (leq_addr _ _)) //. - by rewrite subset_leq_card // -setCD setCS -!setUA subDset setUC. - rewrite (big_setID G0) /= (setIidPr _) ?setCS -?setUA ?subsetUl // ler_addl. - by apply: sumr_ge0 => g _; rewrite ?exprn_ge0 ?normr_ge0. -have lb_rho: 1 - pq / k%:R <= '[rho (tau1M psi)]. - have [_] := Dade_Ind1_sub_lin cohM Mgt1 irr_psi Mpsi psi1; rewrite -/e -/k. - rewrite odd_Frobenius_index_ler ?mFT_odd // => -[_ _ [|/(ler_trans _)->] //]. - by rewrite ler_add2l ler_opp2 ler_pmul2r ?invr_gt0 ?gt0CG // leC_nat. -have{rho sumG0 sumG0_diff ub_rho lb_rho} []: - ~ pq / k%:R + 2%:R / pq + (u * q)%:R^-1 + (v * p)%:R^-1 < p%:R^-1 + q%:R^-1. -- rewrite ler_gtF // -!addrA -ler_subl_addl -ler_subr_addl -(ler_add2l 1). - apply: ler_trans {ub_rho lb_rho}(ler_trans lb_rho ub_rho) _. - rewrite /sumG0_diff -!addnA natrD opprD addrA mulrBr opprB addrA. - rewrite ler_subl_addr ler_paddr //. - by rewrite mulr_ge0 ?invr_ge0 ?ler0n // subr_ge0 -sumr_const ler_sum. - rewrite mulrDl -!addrA addrCA [1 + _]addrA [_ + (_ - _)]addrA ler_add //. - rewrite -(Lagrange (normal_sub nsKM)) natrM invfM mulrA -/k -/e /pq -De. - rewrite ler_pmul2r ?invr_gt0 ?gt0CiG // ler_pdivr_mulr ?gt0CG //. - by rewrite mul1r leC_nat leq_pred. - rewrite [1 + _ + _]addrA addrAC !natrD !mulrDr !ler_add //; first 1 last. - + exact: (FTtype2_cc_core_ler StypeP). - + exact: (FTtype2_cc_core_ler TtypeP). - have [_ _ /card_support_normedTI->] := ctiWG. - rewrite natrM natf_indexg ?subsetT // mulrCA mulKf ?neq0CG // card_cycTIset. - rewrite mulnC -(dprod_card xdefW) /pq !natrM -!subn1 !natrB // -/p -/q invfM. - rewrite mulrACA !mulrBl ?divff ?neq0CG // !mul1r mulrBr mulr1 opprB. - by rewrite addrACA -opprB opprK. -rewrite -!addrA ler_lt_add //; last first. - pose q2 : algC := (q ^ 2)%:R. - apply: ltr_le_trans (_ : 2%:R / q2 + (2%:R * q2)^-1 *+ 2 <= _); last first. - rewrite addrC -[_ *+ 2]mulr_natl invfM mulVKf ?pnatr_eq0 //. - rewrite mulr_natl -mulrS -mulr_natl [q2]natrM. - by rewrite ler_pdivr_mulr ?mulr_gt0 ?gt0CG // mulKf ?neq0CG ?leC_nat. - rewrite -natrM !addrA ltr_add ?(FTtypeP_complV_ltr TtypeP) 1?ltnW //. - rewrite ltr_add ?(FTtypeP_complV_ltr StypeP) // /pq mulnC /q2 !natrM !invfM. - by rewrite !ltr_pmul2l ?ltf_pinv ?invr_gt0 ?qualifE ?gt0CG ?ltr0n ?ltr_nat. -rewrite ler_pdivr_mulr ?ler_pdivl_mull ?gt0CG // -natrM leC_nat. -apply: leq_trans lb_k; rewrite leqW // mulnAC mulnC leq_mul //. -have [[_ _ frobVW2 _] _ _ _ _] := FTtypeP_facts maxT TtypeP. -rewrite -[(p * q)%N]mul1n leq_mul // (leq_trans _ (leq_pred v)) // dvdn_leq //. - by rewrite -subn1 subn_gt0 cardG_gt1; have[] := Frobenius_context frobVW2. -rewrite Gauss_dvd ?prime_coprime ?(dvdn_prime2 pr_p pr_q) ?gtn_eqF //. -rewrite (Frobenius_dvd_ker1 frobVW2) /= oV /nV predn_exp. -rewrite -(subnKC qgt2) -(ltn_predK pgt2) mulKn // subnKC //. -by rewrite big_ord_recl dvdn_sum // => i _; rewrite expnS dvdn_mulr. -Qed. - -(* This is the first part of Peterfalvi (14.11). *) -Let indexMK : #|M : K| = (p * q)%N. -Proof. -have [_ _ [defM|]] := FTtypeII_support_facts maxT TtypeP Ttype2 pairTS maxNV_M. - have:= Ttype2; rewrite (mmax_max maxM (mmax_proper maxT)) ?(eqP Mtype1) //. - rewrite -(sdprodW (Ptype_Fcore_sdprod TtypeP)) -defK (sdprodWY defM). - exact: mulG_subr. -case=> y Py /index_sdprod <-; rewrite (dprod_card xdefW) -(dprodWY xdefW). -suffices /normP {1}<-: y \in 'N(W2) by rewrite -conjYg cardJg. -have cPP: abelian P by have [_ [/and3P[]]] := FTtypeP_facts maxS StypeP. -by rewrite (subsetP (sub_abelian_norm cPP _)) //; have [_ _ _ []] := StypeP. -Qed. - -(* This is Peterfalvi (14.12), and also (14.13) since we have already proved *) -(* the negation of Theorem (14.2). *) -Let not_MG_L : (L : {set gT}) \notin M :^: G. -Proof. -rewrite orbit_sym; apply: contra not_charUH => /imsetP[z _ /= defLz]. -rewrite sub_cyclic_char // -(cyclicJ _ z) -FcoreJ -defLz defK. -have [_ _ [cycV _ _]] := typeP_Galois_P maxT (FTtype5_exclusion maxT) galT. -rewrite Ptype_Fcompl_kernel_trivial // in cycV. -by rewrite -(isog_cyclic (quotient1_isog V)) in cycV. -Qed. - -(* This is Peterfalvi (14.14). *) -Let LM_cases : - '[tauM betaM, tau1L phi] != 0 /\ h.-1%:R / pq <= pq - 1 - \/ '[tauL betaL, tau1M psi] != 0 /\ q = 3 /\ p = 5. -Proof. -have [irr_phi irr_psi] := (irrL Lphi, irrM Mpsi). -have:= Dade_sub_lin_nonorthogonal (mFT_odd _) _ cohM cohL _ Mpsi _ _ Lphi. -rewrite -/betaL -/betaM disjoint_Dade_FTtype1 //. -case=> //; set a := '[_, _] => nz_a; [left | right]; split=> //. - rewrite {1}/pq -indexLH /pq -indexMK. - by rewrite (coherent_FTtype1_core_ltr cohM cohL Mpsi Lphi) // orbit_sym. -have ub_v: v.-1%:R / pq <= pq - 1. - rewrite {1}/pq -indexMK /pq -indexLH /v -defK. - exact: (coherent_FTtype1_core_ltr cohL cohM Lphi Mpsi). -have{ub_v} ub_qp: (q ^ (p - 3) < p ^ 2)%N. - rewrite -(@ltn_pmul2l (q ^ 3)) ?expn_gt0 ?cardG_gt0 // -expnD subnKC //. - have: v.-1%:R < pq ^+ 2. - rewrite -ltr_pdivr_mulr ?ltr0n ?muln_gt0 ?cardG_gt0 //. - by rewrite (ler_lt_trans ub_v) // ltr_subl_addl -mulrS ltC_nat. - rewrite -natrX ltC_nat prednK ?cardG_gt0 // mulnC expnMn oV. - rewrite leq_divLR ?dvdn_pred_predX // mulnC -subn1 leq_subLR. - move/leq_ltn_trans->; rewrite // -addSn addnC -(leq_add2r (q ^ 2 * p ^ 2)). - rewrite addnAC -mulSnr prednK ?cardG_gt0 // mulnA leq_add2l -expnMn. - by rewrite (ltn_sqr 1) (@ltn_mul 1 1) ?prime_gt1. -have q3: q = 3. - apply/eqP; rewrite eqn_leq qgt2 -ltnS -(odd_ltn 5) ?mFT_odd // -ltnS. - rewrite -(ltn_exp2l _ _ (ltnW pgt2)) (leq_trans qp1_gt_pq1) // ltnW //. - by rewrite -{1}(subnK pgt2) -addnS expnD (expnD p 2 4) ltn_mul ?ltn_exp2r. -split=> //; apply/eqP; rewrite eqn_leq -ltnS andbC. -rewrite (odd_geq 5) -1?(odd_ltn 7) ?mFT_odd //= doubleS -{1}q3 ltqp /=. -move: ub_qp; rewrite 2!ltnNge q3; apply: contra. -elim: p => // x IHx; rewrite ltnS leq_eqVlt => /predU1P[<- // | xgt6]. -apply: (@leq_trans (3 * x ^ 2)); last first. - rewrite subSn ?(leq_trans _ xgt6) //. - by rewrite [rhs in (_ <= rhs)%N]expnS leq_mul ?IHx. -rewrite -addn1 sqrnD -addnA (mulSn 2) leq_add2l muln1. -rewrite (@leq_trans (2 * (x * 7))) ?leq_mul //. -by rewrite mulnCA (mulnDr x 12 2) mulnC leq_add2r -(subnKC xgt6). -Qed. - -(* This is Peterfalvi (14.15). *) -Let oU : u = nU. -Proof. -case: ifP (card_FTtypeP_Galois_compl maxS galS) => // p1modq oU. -pose x := #|H : U|; rewrite -/u -/nU -/p -/q in p1modq oU. -have DnU: (q * u)%N = nU. - rewrite mulnC oU divnK //. - by have [_ ->] := FTtypeP_primes_mod_cases maxS StypeP. -have oH: h = (u * x)%N by rewrite Lagrange. -have xmodp: x = q %[mod p]. - have hmodp: h = 1 %[mod p]. - apply/eqP; rewrite eqn_mod_dvd ?cardG_gt0 // subn1. - apply: dvdn_trans (Frobenius_ker_dvd_ker1 frobL). - have [y _ /index_sdprod <-] := defL. - by rewrite -[p](cardJg _ y) cardSg ?joing_subr. - rewrite -[q]muln1 -modnMmr -hmodp modnMmr oH mulnA DnU -modnMml. - suffices ->: nU = 1 %[mod p] by rewrite modnMml mul1n. - rewrite /nU predn_exp mulKn; last by rewrite -(subnKC pgt2). - apply/eqP; rewrite -(ltn_predK qgt2) big_ord_recl eqn_mod_dvd ?subn1 //=. - by apply: dvdn_sum => i _; rewrite expnS dvdn_mulr. -have{xmodp} [n Dx]: {n | x = q + n * p}%N. - by exists (x %/ p); rewrite -(modn_small ltqp) addnC -xmodp -divn_eq. -have nmodq: n = 1 %[mod q]. - have [y _ defLy] := defL; have [_ _ /joing_subP[nHW1 _] _] := sdprodP defLy. - have regHW1: semiregular H W1. - have /Frobenius_reg_ker := set_Frobenius_compl defLy frobL. - by apply: semiregularS; rewrite ?joing_subl. - have hmodq: h = 1 %[mod q]. - apply/eqP; rewrite eqn_mod_dvd ?cardG_gt0 // subn1. - exact: regular_norm_dvd_pred regHW1. - have umodq: u = 1 %[mod q]. - apply/eqP; rewrite eqn_mod_dvd ?cardG_gt0 // subn1. - apply: regular_norm_dvd_pred; first by have [_ []] := StypeP. - exact: semiregularS regHW1. - rewrite -hmodq oH -modnMml umodq modnMml mul1n Dx modnDl. - by rewrite -modnMmr (eqP p1modq) modnMmr muln1. -have{n nmodq Dx} lb_x: (q + q.+1 * p <= x)%N. - rewrite (divn_eq n q) nmodq (modn_small (ltnW qgt2)) addn1 in Dx. - rewrite Dx leq_add2l leq_mul // ltnS leq_pmull // lt0n. - have: odd x by rewrite (dvdn_odd (dvdn_indexg _ _)) ?mFT_odd. - by rewrite Dx odd_add odd_mul !mFT_odd; apply: contraNneq => ->. -have lb_h: (p ^ q < h)%N. - rewrite (@leq_trans (p * nU)) //; last first. - rewrite -DnU oH mulnA mulnC leq_mul // (leq_trans _ lb_x) //. - by rewrite mulSn addnA mulnC leq_addl. - rewrite /nU predn_exp mulKn; last by rewrite -(subnKC pgt2). - rewrite -(subnKC (ltnW qgt2)) subn2 big_ord_recr big_ord_recl /=. - by rewrite -add1n !mulnDr -!expnS -addnA leq_add ?leq_addl // cardG_gt0. -have ub_h: (h <= p ^ 2 * q ^ 2)%N. - have [[_ ub_h] | [_ [q3 p5]]] := LM_cases; last by rewrite q3 p5 in p1modq. - rewrite -expnMn -(ltn_predK lb_h) -ltC_nat natrM -/pq. - rewrite -ltr_pdivr_mulr ?ltr0n ?muln_gt0 ?cardG_gt0 //. - by rewrite (ler_lt_trans ub_h) // ltr_subl_addl -mulrS ltC_nat. -have{lb_h} lb_q2: (p ^ q.-2 < q ^ 2)%N. - rewrite -(@ltn_pmul2l (p ^ 2)) ?expn_gt0 ?cardG_gt0 // (leq_trans _ ub_h) //. - by rewrite -subn2 -expnD subnKC // ltnW. -have q3: q = 3. - apply/eqP; rewrite eqn_leq qgt2 -(subnKC (ltnW qgt2)) subn2 ltnS. - by rewrite -(ltn_exp2l _ _ (ltnW pgt2)) (ltn_trans lb_q2) ?ltn_exp2r. -have{lb_q2 p1modq} p7: p = 7. - suff: p \in [seq n <- iota 4 5 | prime n & n == 1 %[mod 3]] by case/predU1P. - by rewrite mem_filter pr_p mem_iota -q3 p1modq ltqp; rewrite q3 in lb_q2 *. -rewrite oH mulnC oU /nU q3 p7 -leq_divRL //= in ub_h lb_x. -by have:= leq_trans lb_x ub_h. -Qed. - -(* This is Peterfalvi (14.16), the last step towards the final contradiction. *) -Let defH : `H = U. -Proof. -pose x := #|H : U|; have oH: h = (u * x)%N by rewrite Lagrange. -apply/eqP/idPn; rewrite eqEsubset sUH andbT -indexg_gt1 -/x => xgt1. -have hmodpq: h = 1 %[mod p * q]. - apply/eqP; rewrite eqn_mod_dvd ?cardG_gt0 // -indexLH subn1. - exact: Frobenius_ker_dvd_ker1. -have [[_ _ frobUW1 _] _ _ _ _] := FTtypeP_facts maxS StypeP. -have /eqP umodpq: u == 1 %[mod p * q]. - rewrite chinese_remainder ?prime_coprime ?dvdn_prime2 ?(gtn_eqF ltqp) //. - rewrite !eqn_mod_dvd ?cardG_gt0 // subn1 (Frobenius_dvd_ker1 frobUW1). - rewrite oU /nU predn_exp mulKn; last by rewrite -(subnKC pgt2). - by rewrite -(ltn_predK qgt2) big_ord_recl dvdn_sum //= => i; rewrite dvdn_exp. -have{hmodpq} lb_x: (p * q < x)%N. - rewrite -(subnKC (ltnW xgt1)) ltnS dvdn_leq ?subn_gt0 //. - by rewrite -eqn_mod_dvd 1?ltnW // -hmodpq oH -modnMml umodpq modnMml mul1n. -have [[_ ub_h] | [nz_a [q3 p5]]] := LM_cases. - have /idPn[]: (p * q < u)%N. - have ugt1: (1 < u)%N. - by rewrite cardG_gt1; have [] := Frobenius_context frobUW1. - rewrite -(subnKC (ltnW ugt1)) ltnS dvdn_leq ?subn_gt0 //. - by rewrite -eqn_mod_dvd ?umodpq 1?ltnW. - rewrite -leqNgt -(leq_pmul2r (indexg_gt0 L H)) indexLH. - apply: (@leq_trans h.-1). - by rewrite -ltnS prednK ?cardG_gt0 // oH ltn_pmul2l ?cardG_gt0. - rewrite -indexLH -leC_nat natrM -ler_pdivr_mulr ?gt0CiG // indexLH -/pq. - by rewrite (ler_trans ub_h) // ler_subl_addl -mulrS leC_nat ltnW. -have lb_h1e_v: (v.-1 %/ p < h.-1 %/ #|L : H|)%N. - rewrite -(@ltn_pmul2l u) ?cardG_gt0 // -oH oU /nU q3 p5 /= in lb_x. - rewrite -(ltn_subRL 1) /= subn1 in lb_x. - by rewrite leq_divRL ?indexG_gt0 // oV /nV indexLH q3 p5 (leq_trans _ lb_x). -have oLM: orthogonal (map tau1L calL) (map tau1M calM). - by rewrite orthogonal_sym coherent_FTtype1_ortho. -case/eqP: nz_a; have lb_h1e_u := ltn_trans v1p_gt_u1q lb_h1e_v. -have [] // := FTtype2_support_coherence StypeP TtypeP cohL Lphi. -rewrite -/tauL -/sigma => _ [nb [chi Dchi ->]]. -rewrite cfdotBl cfdot_suml big1 => [|ij _]; last first. - have [_ o_tauMeta _ _] := FTtypeI_bridge_facts _ StypeP Mtype1 cohM Mpsi psi1. - rewrite cfdotZl cfdotC (orthogonalP o_tauMeta) ?map_f ?mem_irr //. - by rewrite conjC0 mulr0. -case: Dchi => ->; first by rewrite (orthogonalP oLM) ?map_f // subr0. -by rewrite cfdotNl opprK add0r (orthogonalP oLM) ?map_f // cfAut_seqInd. -Qed. - -Lemma FTtype2_exclusion : False. -Proof. by have /negP[] := not_charUH; rewrite /= defH char_refl. Qed. - -End Fourteen. - -Lemma no_minSimple_odd_group (gT : minSimpleOddGroupType) : False. -Proof. -have [/forall_inP | [S [T [_ W W1 W2 defW pairST]]]] := FTtypeP_pair_cases gT. - exact/negP/not_all_FTtype1. -have xdefW: W2 \x W1 = W by rewrite dprodC. -have pairTS := typeP_pair_sym xdefW pairST. -pose p := #|W2|; pose q := #|W1|. -have p'q: q != p. - have [[[ctiW _ _] _ _ _ _] /mulG_sub[sW1W sW2W]] := (pairST, dprodW defW). - have [cycW _ _] := ctiW; apply: contraTneq (cycW) => eq_pq. - rewrite (cyclic_dprod defW) ?(cyclicS _ cycW) // -/q eq_pq. - by rewrite /coprime gcdnn -trivg_card1; have [] := cycTI_nontrivial ctiW. -without loss{p'q} ltqp: S T W1 W2 defW xdefW pairST pairTS @p @q / q < p. - move=> IH_ST; rewrite neq_ltn in p'q. - by case/orP: p'q; [apply: (IH_ST S T) | apply: (IH_ST T S)]. -have [[_ maxS maxT] _ _ _ _] := pairST. -have [[U StypeP] [V TtypeP]] := (typeP_pairW pairST, typeP_pairW pairTS). -have Stype2: FTtype S == 2 := FTtypeP_max_typeII maxS StypeP ltqp. -have Ttype2: FTtype T == 2 := FTtypeP_min_typeII maxS maxT StypeP TtypeP ltqp. -have /mmax_exists[L maxNU_L]: 'N(U) \proper setT. - have [[_ ntU _ _] cUU _ _ _] := compl_of_typeII maxS StypeP Stype2. - by rewrite mFT_norm_proper // mFT_sol_proper abelian_sol. -have /mmax_exists[M maxNV_M]: 'N(V) \proper setT. - have [[_ ntV _ _] cVV _ _ _] := compl_of_typeII maxT TtypeP Ttype2. - by rewrite mFT_norm_proper // mFT_sol_proper abelian_sol. -have [[maxL sNU_L] [maxM sNV_M]] := (setIdP maxNU_L, setIdP maxNV_M). -have [frobL sUH _] := FTtypeII_support_facts maxS StypeP Stype2 pairST maxNU_L. -have [frobM _ _] := FTtypeII_support_facts maxT TtypeP Ttype2 pairTS maxNV_M. -have Ltype1 := FT_Frobenius_type1 maxL frobL. -have Mtype1 := FT_Frobenius_type1 maxM frobM. -have [tau1L cohL] := FTtype1_coherence maxL Ltype1. -have [tau1M cohM] := FTtype1_coherence maxM Mtype1. -have [phi Lphi phi1] := FTtype1_ref_irr maxL. -have [psi Mpsi psi1] := FTtype1_ref_irr maxM. -exact: (FTtype2_exclusion pairST maxS maxT StypeP TtypeP ltqp - maxNU_L sNU_L sUH frobL Ltype1 cohL Lphi phi1 - maxNV_M sNV_M frobM Mtype1 cohM Mpsi psi1). -Qed. - -Theorem Feit_Thompson (gT : finGroupType) (G : {group gT}) : - odd #|G| -> solvable G. -Proof. exact: (minSimpleOdd_ind no_minSimple_odd_group). Qed. - -Theorem simple_odd_group_prime (gT : finGroupType) (G : {group gT}) : - odd #|G| -> simple G -> prime #|G|. -Proof. exact: (minSimpleOdd_prime no_minSimple_odd_group). Qed. - - diff --git a/mathcomp/odd_order/PFsection2.v b/mathcomp/odd_order/PFsection2.v deleted file mode 100644 index c982642..0000000 --- a/mathcomp/odd_order/PFsection2.v +++ /dev/null @@ -1,830 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div choice. -From mathcomp -Require Import fintype tuple finfun bigop prime ssralg poly finset center. -From mathcomp -Require Import fingroup morphism perm automorphism quotient action zmodp. -From mathcomp -Require Import gfunctor gproduct cyclic pgroup frobenius ssrnum. -From mathcomp -Require Import matrix mxalgebra mxrepresentation vector algC classfun character. -From mathcomp -Require Import inertia vcharacter PFsection1. - -(******************************************************************************) -(* This file covers Peterfalvi, Section 2: the Dade isometry *) -(* Defined here: *) -(* Dade_hypothesis G L A <-> G, L, and A satisfy the hypotheses under which *) -(* which the Dade isometry relative to G, L and *) -(* A is well-defined. *) -(* For ddA : Dade_hypothesis G L A, we also define *) -(* Dade ddA == the Dade isometry relative to G, L and A. *) -(* Dade_signalizer ddA a == the normal complement to 'C_L[a] in 'C_G[a] for *) -(* a in A (this is usually denoted by H a). *) -(* Dade_support1 ddA a == the set of elements identified with a by the Dade *) -(* isometry. *) -(* Dade_support ddA == the natural support of the Dade isometry. *) -(* The following are used locally in expansion of the Dade isometry as a sum *) -(* of induced characters: *) -(* Dade_transversal ddA == a transversal of the L-conjugacy classes *) -(* of non empty subsets of A. *) -(* Dade_set_signalizer ddA B == the generalization of H to B \subset A, *) -(* denoted 'H(B) below. *) -(* Dade_set_normalizer ddA B == the generalization of 'C_G[a] to B. *) -(* denoted 'M(B) = 'H(B) ><| 'N_L(B) below. *) -(* Dade_cfun_restriction ddA B aa == the composition of aa \in 'CF(L, A) *) -(* with the projection of 'M(B) onto 'N_L(B), *) -(* parallel to 'H(B). *) -(* In addition, if sA1A : A1 \subset A and nA1L : L \subset 'N(A1), we have *) -(* restr_Dade_hyp ddA sA1A nA1L : Dade_hypothesis G L A1 H *) -(* restr_Dade ddA sA1A nA1L == the restriction of the Dade isometry to *) -(* 'CF(L, A1). *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope GRing.Theory Num.Theory. -Local Open Scope ring_scope. - -Reserved Notation "alpha ^\tau" (at level 2, format "alpha ^\tau"). - -Section Two. - -Variable gT : finGroupType. - -(* This is Peterfalvi (2.1). *) -Lemma partition_cent_rcoset (H : {group gT}) g (C := 'C_H[g]) (Cg := C :* g) : - g \in 'N(H) -> coprime #|H| #[g] -> - partition (Cg :^: H) (H :* g) /\ #|Cg :^: H| = #|H : C|. -Proof. -move=> nHg coHg; pose pi := \pi(#[g]). -have notCg0: Cg != set0 by apply/set0Pn; exists g; apply: rcoset_refl. -have id_pi: {in Cg, forall u, u.`_ pi = g}. - move=> _ /rcosetP[u /setIP[Hu cgu] ->]; rewrite consttM; last exact/cent1P. - rewrite (constt_p_elt (pgroup_pi _)) (constt1P _) ?mul1g //. - by rewrite (mem_p_elt _ Hu) // /pgroup -coprime_pi' // coprime_sym. -have{id_pi} /and3P[_ tiCg /eqP defC]: normedTI Cg H C. - apply/normedTI_P; rewrite subsetI subsetIl normsM ?normG ?subsetIr //. - split=> // x Hx /pred0Pn[u /andP[/= Cu Cxu]]; rewrite !inE Hx /= conjg_set1. - by rewrite -{2}(id_pi _ Cu) -(conjgKV x u) consttJ id_pi -?mem_conjg. -have{tiCg} partCg := partition_class_support notCg0 tiCg. -have{defC} oCgH: #|Cg :^: H| = #|H : C| by rewrite -defC -astab1Js -card_orbit. -split=> //; congr (partition _ _): (partCg); apply/eqP. -rewrite eqEcard card_rcoset {1}class_supportEr; apply/andP; split. - apply/bigcupsP=> x Hx; rewrite conjsgE -rcosetM conjgCV rcosetM mulgA. - by rewrite mulSg ?mul_subG ?subsetIl // sub1set ?memJ_norm ?groupV. -have oCg Cx: Cx \in Cg :^: H -> #|Cx| = #|C|. - by case/imsetP=> x _ ->; rewrite cardJg card_rcoset. -by rewrite (card_uniform_partition oCg partCg) oCgH mulnC Lagrange ?subsetIl. -Qed. - -Definition is_Dade_signalizer (G L A : {set gT}) (H : gT -> {group gT}) := - {in A, forall a, H a ><| 'C_L[a] = 'C_G[a]}. - -(* This is Peterfalvi Definition (2.2). *) -Definition Dade_hypothesis (G L A : {set gT}) := - [/\ A <| L, L \subset G, 1%g \notin A, - (*a*) {in A &, forall x, {subset x ^: G <= x ^: L}} - & (*b*) exists2 H, is_Dade_signalizer G L A H - & (*c*) {in A &, forall a b, coprime #|H a| #|'C_L[b]| }]. - -Variables (G L : {group gT}) (A : {set gT}). - -Let pi := [pred p | [exists a in A, p \in \pi('C_L[a])]]. - -Let piCL a : a \in A -> pi.-group 'C_L[a]. -Proof. -move=> Aa; apply: sub_pgroup (pgroup_pi _) => p cLa_p. -by apply/exists_inP; exists a. -Qed. - -Fact Dade_signalizer_key : unit. Proof. by []. Qed. -Definition Dade_signalizer_def a := 'O_pi^'('C_G[a])%G. -Definition Dade_signalizer of Dade_hypothesis G L A := - locked_with Dade_signalizer_key Dade_signalizer_def. - -Hypothesis ddA : Dade_hypothesis G L A. -Notation H := (Dade_signalizer ddA). -Canonical Dade_signalizer_unlockable := [unlockable fun H]. - -Let pi'H a : pi^'.-group (H a). Proof. by rewrite unlock pcore_pgroup. Qed. -Let nsHC a : H a <| 'C_G[a]. Proof. by rewrite unlock pcore_normal. Qed. - -Lemma Dade_signalizer_sub a : H a \subset G. -Proof. by have /andP[/subsetIP[]] := nsHC a. Qed. - -Lemma Dade_signalizer_cent a : H a \subset 'C[a]. -Proof. by have /andP[/subsetIP[]] := nsHC a. Qed. - -Let nsAL : A <| L. Proof. by have [->] := ddA. Qed. -Let sAL : A \subset L. Proof. exact: normal_sub nsAL. Qed. -Let nAL : L \subset 'N(A). Proof. exact: normal_norm nsAL. Qed. -Let sLG : L \subset G. Proof. by have [_ ->] := ddA. Qed. -Let notA1 : 1%g \notin A. Proof. by have [_ _ ->] := ddA. Qed. -Let conjAG : {in A &, forall x, {subset x ^: G <= x ^: L}}. -Proof. by have [_ _ _ ? _] := ddA. Qed. -Let sHG := Dade_signalizer_sub. -Let cHA := Dade_signalizer_cent. -Let notHa0 a : H a :* a :!=: set0. -Proof. by rewrite -cards_eq0 -lt0n card_rcoset cardG_gt0. Qed. - -Let HallCL a : a \in A -> pi.-Hall('C_G[a]) 'C_L[a]. -Proof. -move=> Aa; have [_ _ _ _ [H1 /(_ a Aa)/sdprodP[_ defCa _ _] coH1L]] := ddA. -have [|//] := coprime_mulGp_Hall defCa _ (piCL Aa). -apply: sub_pgroup (pgroup_pi _) => p; apply: contraL => /exists_inP[b Ab]. -by apply: (@pnatPpi \pi(_)^'); rewrite -coprime_pi' ?cardG_gt0 ?coH1L. -Qed. - -Lemma def_Dade_signalizer H1 : is_Dade_signalizer G L A H1 -> {in A, H =1 H1}. -Proof. -move=> defH1 a Aa; apply/val_inj; rewrite unlock /=; have defCa := defH1 a Aa. -have /sdprod_context[nsH1Ca _ _ _ _] := defCa. -by apply/normal_Hall_pcore=> //; apply/(sdprod_normal_pHallP _ (HallCL Aa)). -Qed. - -Lemma Dade_sdprod : is_Dade_signalizer G L A H. -Proof. -move=> a Aa; have [_ _ _ _ [H1 defH1 _]] := ddA. -by rewrite (def_Dade_signalizer defH1) ?defH1. -Qed. -Let defCA := Dade_sdprod. - -Lemma Dade_coprime : {in A &, forall a b, coprime #|H a| #|'C_L[b]| }. -Proof. by move=> a b _ Ab; apply: p'nat_coprime (pi'H a) (piCL Ab). Qed. -Let coHL := Dade_coprime. - -Definition Dade_support1 a := class_support (H a :* a) G. -Local Notation dd1 := Dade_support1. - -Lemma mem_Dade_support1 a x : a \in A -> x \in H a -> (x * a)%g \in dd1 a. -Proof. by move=> Aa Hx; rewrite -(conjg1 (x * a)) !mem_imset2 ?set11. Qed. - -(* This is Peterfalvi (2.3), except for the existence part, which is covered *) -(* below in the NormedTI section. *) -Lemma Dade_normedTI_P : - reflect (A != set0 /\ {in A, forall a, H a = 1%G}) (normedTI A G L). -Proof. -apply: (iffP idP) => [tiAG | [nzA trivH]]. - split=> [|a Aa]; first by have [] := andP tiAG. - apply/trivGP; rewrite -(coprime_TIg (coHL Aa Aa)) subsetIidl subsetI cHA. - by rewrite (subset_trans (normal_sub (nsHC a))) ?(cent1_normedTI tiAG). -apply/normedTI_memJ_P; split=> // a g Aa Gg. -apply/idP/idP=> [Aag | Lg]; last by rewrite memJ_norm ?(subsetP nAL). -have /imsetP[k Lk def_ag] := conjAG Aa Aag (mem_imset _ Gg). -suffices: (g * k^-1)%g \in 'C_G[a]. - by rewrite -Dade_sdprod ?trivH // sdprod1g inE groupMr ?groupV // => /andP[]. -rewrite !inE groupM ?groupV // ?(subsetP sLG) //=. -by rewrite conjg_set1 conjgM def_ag conjgK. -Qed. - -(* This is Peterfalvi (2.4)(a) (extended to all a thanks to our choice of H). *) -Lemma DadeJ a x : x \in L -> H (a ^ x) :=: H a :^ x. -Proof. -by move/(subsetP sLG)=> Gx; rewrite unlock -pcoreJ conjIg -cent1J conjGid. -Qed. - -Lemma Dade_support1_id a x : x \in L -> dd1 (a ^ x) = dd1 a. -Proof. -move=> Lx; rewrite {1}/dd1 DadeJ // -conjg_set1 -conjsMg. -by rewrite class_supportGidl ?(subsetP sLG). -Qed. - -Let piHA a u : a \in A -> u \in H a :* a -> u.`_pi = a. -Proof. -move=> Aa /rcosetP[{u}u Hu ->]; have pi'u: pi^'.-elt u by apply: mem_p_elt Hu. -rewrite (consttM _ (cent1P (subsetP (cHA a) u Hu))). -suffices pi_a: pi.-elt a by rewrite (constt1P pi'u) (constt_p_elt _) ?mul1g. -by rewrite (mem_p_elt (piCL Aa)) // inE cent1id (subsetP sAL). -Qed. - -(* This is Peterfalvi (2.4)(b). *) -Lemma Dade_support1_TI : {in A &, forall a b, - ~~ [disjoint dd1 a & dd1 b] -> exists2 x, x \in L & b = a ^ x}. -Proof. -move=> a b Aa Ab /= /pred0Pn[_ /andP[/imset2P[x u /(piHA Aa) def_x Gu ->]]] /=. -case/imset2P=> y v /(piHA Ab) def_y Gv /(canLR (conjgK v)) def_xuv. -have def_b: a ^ (u * v^-1) = b by rewrite -def_x -consttJ conjgM def_xuv def_y. -by apply/imsetP/conjAG; rewrite // -def_b mem_imset ?groupM ?groupV. -Qed. - -(* This is an essential strengthening of Peterfalvi (2.4)(c). *) -Lemma Dade_cover_TI : {in A, forall a, normedTI (H a :* a) G 'C_G[a]}. -Proof. -move=> a Aa; apply/normedTI_P; split=> // [|g Gg]. - by rewrite subsetI subsetIl normsM ?subsetIr ?normal_norm ?nsHC. -rewrite disjoint_sym => /pred0Pn[_ /andP[/imsetP[u Ha_u ->] Ha_ug]]. -by rewrite !inE Gg /= conjg_set1 -{1}(piHA Aa Ha_u) -consttJ (piHA Aa). -Qed. - -(* This is Peterfalvi (2.4)(c). *) -Lemma norm_Dade_cover : {in A, forall a, 'N_G(H a :* a) = 'C_G[a]}. -Proof. by move=> a /Dade_cover_TI /and3P[_ _ /eqP]. Qed. - -Definition Dade_support := \bigcup_(a in A) dd1 a. -Local Notation Atau := Dade_support. - -Lemma not_support_Dade_1 : 1%g \notin Atau. -Proof. -apply: contra notA1 => /bigcupP[a Aa /imset2P[u x Ha_u _ ux1]]. -suffices /set1P <-: a \in [1] by []. -have [_ _ _ <-] := sdprodP (defCA Aa). -rewrite 2!inE cent1id (subsetP sAL) // !andbT. -by rewrite -groupV -(mul1g a^-1)%g -mem_rcoset -(conj1g x^-1) ux1 conjgK. -Qed. - -Lemma Dade_support_sub : Atau \subset G. -Proof. -apply/bigcupsP=> a Aa; rewrite class_support_subG // mul_subG ?sHG //. -by rewrite sub1set (subsetP sLG) ?(subsetP sAL). -Qed. - -Lemma Dade_support_norm : G \subset 'N(Atau). -Proof. -by rewrite norms_bigcup //; apply/bigcapsP=> a _; apply: class_support_norm. -Qed. - -Lemma Dade_support_normal : Atau <| G. -Proof. by rewrite /normal Dade_support_sub Dade_support_norm. Qed. - -Lemma Dade_support_subD1 : Atau \subset G^#. -Proof. by rewrite subsetD1 Dade_support_sub not_support_Dade_1. Qed. - -(* This is Peterfalvi Definition (2.5). *) -Fact Dade_subproof (alpha : 'CF(L)) : - is_class_fun <<G>> [ffun x => oapp alpha 0 [pick a in A | x \in dd1 a]]. -Proof. -rewrite genGid; apply: intro_class_fun => [x y Gx Gy | x notGx]. - congr (oapp _ _); apply: eq_pick => a; rewrite memJ_norm //. - by apply: subsetP Gy; apply: class_support_norm. -case: pickP => // a /andP[Aa Ha_u]. -by rewrite (subsetP Dade_support_sub) // in notGx; apply/bigcupP; exists a. -Qed. -Definition Dade alpha := Cfun 1 (Dade_subproof alpha). - -Lemma Dade_is_linear : linear Dade. -Proof. -move=> mu alpha beta; apply/cfunP=> x; rewrite !cfunElock. -by case: pickP => [a _ | _] /=; rewrite ?mulr0 ?addr0 ?cfunE. -Qed. -Canonical Dade_additive := Additive Dade_is_linear. -Canonical Dade_linear := Linear Dade_is_linear. - -Local Notation "alpha ^\tau" := (Dade alpha). - -(* This is the validity of Peterfalvi, Definition (2.5) *) -Lemma DadeE alpha a u : a \in A -> u \in dd1 a -> alpha^\tau u = alpha a. -Proof. -move=> Aa Ha_u; rewrite cfunElock. -have [b /= /andP[Ab Hb_u] | ] := pickP; last by move/(_ a); rewrite Aa Ha_u. -have [|x Lx ->] := Dade_support1_TI Aa Ab; last by rewrite cfunJ. -by apply/pred0Pn; exists u; rewrite /= Ha_u. -Qed. - -Lemma Dade_id alpha : {in A, forall a, alpha^\tau a = alpha a}. -Proof. -by move=> a Aa; rewrite /= -{1}[a]mul1g (DadeE _ Aa) ?mem_Dade_support1. -Qed. - -Lemma Dade_cfunS alpha : alpha^\tau \in 'CF(G, Atau). -Proof. -apply/cfun_onP=> x; rewrite cfunElock. -by case: pickP => [a /andP[Aa Ha_x] /bigcupP[] | //]; exists a. -Qed. - -Lemma Dade_cfun alpha : alpha^\tau \in 'CF(G, G^#). -Proof. by rewrite (cfun_onS Dade_support_subD1) ?Dade_cfunS. Qed. - -Lemma Dade1 alpha : alpha^\tau 1%g = 0. -Proof. by rewrite (cfun_on0 (Dade_cfun _)) // !inE eqxx. Qed. - -Lemma Dade_id1 : - {in 'CF(L, A) & 1%g |: A, forall alpha a, alpha^\tau a = alpha a}. -Proof. -move=> alpha a Aalpha; case/setU1P=> [-> |]; last exact: Dade_id. -by rewrite Dade1 (cfun_on0 Aalpha). -Qed. - -Section AutomorphismCFun. - -Variable u : {rmorphism algC -> algC}. -Local Notation "alpha ^u" := (cfAut u alpha). - -Lemma Dade_aut alpha : (alpha^u)^\tau = (alpha^\tau)^u. -Proof. -apply/cfunP => g; rewrite cfunE. -have [/bigcupP[a Aa A1g] | notAtau_g] := boolP (g \in Atau). - by rewrite !(DadeE _ Aa A1g) cfunE. -by rewrite !(cfun_on0 _ notAtau_g) ?rmorph0 ?Dade_cfunS. -Qed. - -End AutomorphismCFun. - -Lemma Dade_conjC alpha : (alpha^*)^\tau = ((alpha^\tau)^*)%CF. -Proof. exact: Dade_aut. Qed. - -(* This is Peterfalvi (2.7), main part *) -Lemma general_Dade_reciprocity alpha (phi : 'CF(G)) (psi : 'CF(L)) : - alpha \in 'CF(L, A) -> - {in A, forall a, psi a = #|H a|%:R ^-1 * (\sum_(x in H a) phi (x * a)%g)} -> - '[alpha^\tau, phi] = '[alpha, psi]. -Proof. -move=> CFalpha psiA; rewrite (cfdotEl _ (Dade_cfunS _)). -pose T := [set repr (a ^: L) | a in A]. -have sTA: {subset T <= A}. - move=> _ /imsetP[a Aa ->]; have [x Lx ->] := repr_class L a. - by rewrite memJ_norm ?(subsetP nAL). -pose P_G := [set dd1 x | x in T]. -have dd1_id: {in A, forall a, dd1 (repr (a ^: L)) = dd1 a}. - by move=> a Aa /=; have [x Lx ->] := repr_class L a; apply: Dade_support1_id. -have ->: Atau = cover P_G. - apply/setP=> u; apply/bigcupP/bigcupP=> [[a Aa Fa_u] | [Fa]]; last first. - by case/imsetP=> a /sTA Aa -> Fa_u; exists a. - by exists (dd1 a) => //; rewrite -dd1_id //; do 2!apply: mem_imset. -have [tiP_G inj_dd1]: trivIset P_G /\ {in T &, injective dd1}. - apply: trivIimset => [_ _ /imsetP[a Aa ->] /imsetP[b Ab ->] |]; last first. - apply/imsetP=> [[a]]; move/sTA=> Aa; move/esym; move/eqP; case/set0Pn. - by exists (a ^ 1)%g; apply: mem_imset2; rewrite ?group1 ?rcoset_refl. - rewrite !dd1_id //; apply: contraR. - by case/Dade_support1_TI=> // x Lx ->; rewrite classGidl. -rewrite big_trivIset //= big_imset {P_G tiP_G inj_dd1}//=. -symmetry; rewrite (cfdotEl _ CFalpha). -pose P_A := [set a ^: L | a in T]. -have rLid x: repr (x ^: L) ^: L = x ^: L. - by have [y Ly ->] := repr_class L x; rewrite classGidl. -have {1}<-: cover P_A = A. - apply/setP=> a; apply/bigcupP/idP=> [[_ /imsetP[d /sTA Ab ->]] | Aa]. - by case/imsetP=> x Lx ->; rewrite memJ_norm ?(subsetP nAL). - by exists (a ^: L); rewrite ?class_refl // -rLid; do 2!apply: mem_imset. -have [tiP_A injFA]: trivIset P_A /\ {in T &, injective (class^~ L)}. - apply: trivIimset => [_ _ /imsetP[a Aa ->] /imsetP[b Ab ->] |]; last first. - by apply/imsetP=> [[a _ /esym/eqP/set0Pn[]]]; exists a; apply: class_refl. - rewrite !rLid; apply: contraR => /pred0Pn[c /andP[/=]]. - by do 2!move/class_eqP <-. -rewrite big_trivIset //= big_imset {P_A tiP_A injFA}//=. -apply: canRL (mulKf (neq0CG G)) _; rewrite mulrA big_distrr /=. -apply: eq_bigr => a /sTA=> {T sTA}Aa. -have [La def_Ca] := (subsetP sAL a Aa, defCA Aa). -rewrite (eq_bigr (fun _ => alpha a * (psi a)^*)) => [|ax]; last first. - by case/imsetP=> x Lx ->{ax}; rewrite !cfunJ. -rewrite sumr_const -index_cent1 mulrC -mulr_natr -!mulrA. -rewrite (eq_bigr (fun xa => alpha a * (phi xa)^*)) => [|xa Fa_xa]; last first. - by rewrite (DadeE _ Aa). -rewrite -big_distrr /= -rmorph_sum; congr (_ * _). -rewrite mulrC mulrA -natrM mulnC -(Lagrange (subsetIl G 'C[a])). -rewrite -mulnA mulnCA -(sdprod_card def_Ca) -mulnA Lagrange ?subsetIl //. -rewrite mulnA natrM mulfK ?neq0CG // -conjC_nat -rmorphM; congr (_ ^*). -have /and3P[_ tiHa _] := Dade_cover_TI Aa. -rewrite (set_partition_big _ (partition_class_support _ _)) //=. -rewrite (eq_bigr (fun _ => \sum_(x in H a) phi (x * a)%g)); last first. - move=> _ /imsetP[x Gx ->]; rewrite -rcosetE. - rewrite (big_imset _ (in2W (conjg_inj x))) (big_imset _ (in2W (mulIg a))) /=. - by apply: eq_bigr => u Hu; rewrite cfunJ ?groupM ?(subsetP sLG a). -rewrite sumr_const card_orbit astab1Js norm_Dade_cover //. -by rewrite natrM -mulrA mulr_natl psiA // mulVKf ?neq0CG. -Qed. - -(* This is Peterfalvi (2.7), second part. *) -Lemma Dade_reciprocity alpha (phi : 'CF(G)) : - alpha \in 'CF(L, A) -> - {in A, forall a, {in H a, forall u, phi (u * a)%g = phi a}} -> - '[alpha^\tau, phi] = '[alpha, 'Res[L] phi]. -Proof. -move=> CFalpha phiH; apply: general_Dade_reciprocity => // a Aa. -rewrite cfResE ?(subsetP sAL) //; apply: canRL (mulKf (neq0CG _)) _. -by rewrite mulr_natl -sumr_const; apply: eq_bigr => x Hx; rewrite phiH. -Qed. - -(* This is Peterfalvi (2.6)(a). *) -Lemma Dade_isometry : {in 'CF(L, A) &, isometry Dade}. -Proof. -move=> alpha beta CFalpha CFbeta /=. -rewrite Dade_reciprocity ?Dade_cfun => // [|a Aa u Hu]; last first. - by rewrite (DadeE _ Aa) ?mem_Dade_support1 ?Dade_id. -rewrite !(cfdotEl _ CFalpha); congr (_ * _); apply: eq_bigr => x Ax. -by rewrite cfResE ?(subsetP sAL) // Dade_id. -Qed. - -(* Supplement to Peterfalvi (2.3)/(2.6)(a); implies Isaacs Lemma 7.7. *) -Lemma Dade_Ind : normedTI A G L -> {in 'CF(L, A), Dade =1 'Ind}. -Proof. -case/Dade_normedTI_P=> _ trivH alpha Aalpha. -rewrite [alpha^\tau]cfun_sum_cfdot ['Ind _]cfun_sum_cfdot. -apply: eq_bigr => i _; rewrite -cfdot_Res_r -Dade_reciprocity // => a Aa /= u. -by rewrite trivH // => /set1P->; rewrite mul1g. -Qed. - -Definition Dade_set_signalizer (B : {set gT}) := \bigcap_(a in B) H a. -Local Notation "''H' ( B )" := (Dade_set_signalizer B) - (at level 8, format "''H' ( B )") : group_scope. -Canonical Dade_set_signalizer_group B := [group of 'H(B)]. -Definition Dade_set_normalizer B := 'H(B) <*> 'N_L(B). -Local Notation "''M' ( B )" := (Dade_set_normalizer B) - (at level 8, format "''M' ( B )") : group_scope. -Canonical Dade_set_normalizer_group B := [group of 'M(B)]. - -Let calP := [set B : {set gT} | B \subset A & B != set0]. - -(* This is Peterfalvi (2.8). *) -Lemma Dade_set_sdprod : {in calP, forall B, 'H(B) ><| 'N_L(B) = 'M(B)}. -Proof. -move=> B /setIdP[sBA notB0]; apply: sdprodEY => /=. - apply/subsetP=> x /setIP[Lx nBx]; rewrite inE. - apply/bigcapsP=> a Ba; have Aa := subsetP sBA a Ba. - by rewrite sub_conjg -DadeJ ?groupV // bigcap_inf // memJ_norm ?groupV. -have /set0Pn[a Ba] := notB0; have Aa := subsetP sBA a Ba. -have [_ /mulG_sub[sHaC _] _ tiHaL] := sdprodP (defCA Aa). -rewrite -(setIidPl sLG) -setIA setICA (setIidPl sHaC) in tiHaL. -by rewrite setICA ['H(B)](bigD1 a) //= !setIA tiHaL !setI1g. -Qed. - -Section DadeExpansion. - -Variable aa : 'CF(L). -Hypothesis CFaa : aa \in 'CF(L, A). - -Definition Dade_restrm B := - if B \in calP then remgr 'H(B) 'N_L(B) else trivm 'M(B). -Fact Dade_restrM B : {in 'M(B) &, {morph Dade_restrm B : x y / x * y}%g}. -Proof. -rewrite /Dade_restrm; case: ifP => calP_B; last exact: morphM. -have defM := Dade_set_sdprod calP_B; have [nsHM _ _ _ _] := sdprod_context defM. -by apply: remgrM; first apply: sdprod_compl. -Qed. -Canonical Dade_restr_morphism B := Morphism (@Dade_restrM B). -Definition Dade_cfun_restriction B := - cfMorph ('Res[Dade_restrm B @* 'M(B)] aa). - -Local Notation "''aa_' B" := (Dade_cfun_restriction B) - (at level 3, B at level 2, format "''aa_' B") : ring_scope. - -Definition Dade_transversal := [set repr (B :^: L) | B in calP]. -Local Notation calB := Dade_transversal. - -Lemma Dade_restrictionE B x : - B \in calP -> 'aa_B x = aa (remgr 'H(B) 'N_L(B) x) *+ (x \in 'M(B)). -Proof. -move=> calP_B; have /sdprodP[_ /= defM _ _] := Dade_set_sdprod calP_B. -have [Mx | /cfun0-> //] := boolP (x \in 'M(B)). -rewrite mulrb cfMorphE // morphimEdom /= /Dade_restrm calP_B. -rewrite cfResE ?mem_imset {x Mx}//= -defM. -by apply/subsetP=> _ /imsetP[x /mem_remgr/setIP[Lx _] ->]. -Qed. -Local Notation rDadeE := Dade_restrictionE. - -Lemma Dade_restriction_vchar B : aa \in 'Z[irr L] -> 'aa_B \in 'Z[irr 'M(B)]. -Proof. -rewrite /'aa_B => /vcharP[a1 Na1 [a2 Na2 ->]]. -by rewrite !linearB /= rpredB // char_vchar ?cfMorph_char ?cfRes_char. -Qed. - -Let sMG B : B \in calP -> 'M(B) \subset G. -Proof. -case/setIdP=> /subsetP sBA /set0Pn[a Ba]. -by rewrite join_subG ['H(B)](bigD1 a Ba) !subIset ?sLG ?sHG ?sBA. -Qed. - -(* This is Peterfalvi (2.10.1) *) -Lemma Dade_Ind_restr_J : - {in L & calP, forall x B, 'Ind[G] 'aa_(B :^ x) = 'Ind[G] 'aa_B}. -Proof. -move=> x B Lx dB; have [defMB [sBA _]] := (Dade_set_sdprod dB, setIdP dB). -have dBx: B :^ x \in calP. - by rewrite !inE -{2}(normsP nAL x Lx) conjSg -!cards_eq0 cardJg in dB *. -have defHBx: 'H(B :^ x) = 'H(B) :^ x. - rewrite /'H(_) (big_imset _ (in2W (conjg_inj x))) -bigcapJ /=. - by apply: eq_bigr => a Ba; rewrite DadeJ ?(subsetP sBA). -have defNBx: 'N_L(B :^ x) = 'N_L(B) :^ x by rewrite conjIg -normJ (conjGid Lx). -have [_ mulHNB _ tiHNB] := sdprodP defMB. -have defMBx: 'M(B :^ x) = 'M(B) :^ x. - rewrite -mulHNB conjsMg -defHBx -defNBx. - by case/sdprodP: (Dade_set_sdprod dBx). -have def_aa_x y: 'aa_(B :^ x) (y ^ x) = 'aa_B y. - rewrite !rDadeE // defMBx memJ_conjg !mulrb -mulHNB defHBx defNBx. - have [[h z Hh Nz ->] | // ] := mulsgP. - by rewrite conjMg !remgrMid ?cfunJ ?memJ_conjg // -conjIg tiHNB conjs1g. -apply/cfunP=> y; have Gx := subsetP sLG x Lx. -rewrite [eq]lock !cfIndE ?sMG //= {1}defMBx cardJg -lock; congr (_ * _). -rewrite (reindex_astabs 'R x) ?astabsR //=. -by apply: eq_bigr => z _; rewrite conjgM def_aa_x. -Qed. - -(* This is Peterfalvi (2.10.2) *) -Lemma Dade_setU1 : {in calP & A, forall B a, 'H(a |: B) = 'C_('H(B))[a]}. -Proof. -move=> B a dB Aa; rewrite /'H(_) bigcap_setU big_set1 -/'H(B). -apply/eqP; rewrite setIC eqEsubset setIS // subsetI subsetIl /=. -have [sHBG pi'HB]: 'H(B) \subset G /\ pi^'.-group 'H(B). - have [sBA /set0Pn[b Bb]] := setIdP dB; have Ab := subsetP sBA b Bb. - have sHBb: 'H(B) \subset H b by rewrite ['H(B)](bigD1 b) ?subsetIl. - by rewrite (pgroupS sHBb) ?pi'H ?(subset_trans sHBb) ?sHG. -have [nsHa _ defCa _ _] := sdprod_context (defCA Aa). -have [hallHa _] := coprime_mulGp_Hall defCa (pi'H a) (piCL Aa). -by rewrite (sub_normal_Hall hallHa) ?(pgroupS (subsetIl _ _)) ?setSI. -Qed. - -Let calA g (X : {set gT}) := [set x in G | g ^ x \in X]%g. - -(* This is Peterfalvi (2.10.3) *) -Lemma Dade_Ind_expansion B g : - B \in calP -> - [/\ g \notin Atau -> ('Ind[G, 'M(B)] 'aa_B) g = 0 - & {in A, forall a, g \in dd1 a -> - ('Ind[G, 'M(B)] 'aa_B) g = - (aa a / #|'M(B)|%:R) * - \sum_(b in 'N_L(B) :&: a ^: L) #|calA g ('H(B) :* b)|%:R}]. -Proof. -move=> dB; set LHS := 'Ind _ g. -have defMB := Dade_set_sdprod dB; have [_ mulHNB nHNB tiHNB] := sdprodP defMB. -have [sHMB sNMB] := mulG_sub mulHNB. -have{LHS} ->: LHS = #|'M(B)|%:R^-1 * \sum_(x in calA g 'M(B)) 'aa_B (g ^ x). - rewrite {}/LHS cfIndE ?sMG //; congr (_ * _). - rewrite (bigID [pred x | g ^ x \in 'M(B)]) /= addrC big1 ?add0r => [|x]. - by apply: eq_bigl => x; rewrite inE. - by case/andP=> _ notMgx; rewrite cfun0. -pose fBg x := remgr 'H(B) 'N_L(B) (g ^ x). -pose supp_aBg := [pred b in A | g \in dd1 b]. -have supp_aBgP: {in calA g 'M(B), forall x, - ~~ supp_aBg (fBg x) -> 'aa_B (g ^ x)%g = 0}. -- move=> x /setIdP[]; set b := fBg x => Gx MBgx notHGx; rewrite rDadeE // MBgx. - have Nb: b \in 'N_L(B) by rewrite mem_remgr ?mulHNB. - have Cb: b \in 'C_L[b] by rewrite inE cent1id; have [-> _] := setIP Nb. - rewrite (cfun_on0 CFaa) // -/(fBg x) -/b; apply: contra notHGx => Ab. - have nHb: b \in 'N('H(B)) by rewrite (subsetP nHNB). - have [sBA /set0Pn[a Ba]] := setIdP dB; have Aa := subsetP sBA a Ba. - have [|/= partHBb _] := partition_cent_rcoset nHb. - rewrite (coprime_dvdr (order_dvdG Cb)) //= ['H(B)](bigD1 a) //=. - by rewrite (coprimeSg (subsetIl _ _)) ?coHL. - have Hb_gx: g ^ x \in 'H(B) :* b by rewrite mem_rcoset mem_divgr ?mulHNB. - have [defHBb _ _] := and3P partHBb; rewrite -(eqP defHBb) in Hb_gx. - case/bigcupP: Hb_gx => Cy; case/imsetP=> y HBy ->{Cy} Cby_gx. - have sHBa: 'H(B) \subset H a by rewrite bigcap_inf. - have sHBG: 'H(B) \subset G := subset_trans sHBa (sHG a). - rewrite Ab -(memJ_conjg _ x) class_supportGidr // -(conjgKV y (g ^ x)). - rewrite mem_imset2 // ?(subsetP sHBG) {HBy}// -mem_conjg. - apply: subsetP Cby_gx; rewrite {y}conjSg mulSg //. - have [nsHb _ defCb _ _] := sdprod_context (defCA Ab). - have [hallHb _] := coprime_mulGp_Hall defCb (pi'H b) (piCL Ab). - rewrite (sub_normal_Hall hallHb) ?setSI // (pgroupS _ (pi'H a)) //=. - by rewrite subIset ?sHBa. -split=> [notHGg | a Aa Hag]. - rewrite big1 ?mulr0 // => x; move/supp_aBgP; apply; set b := fBg x. - by apply: contra notHGg; case/andP=> Ab Hb_x; apply/bigcupP; exists b. -rewrite -mulrA mulrCA; congr (_ * _); rewrite big_distrr /=. -set nBaL := _ :&: _; rewrite (bigID [pred x | fBg x \in nBaL]) /= addrC. -rewrite big1 ?add0r => [|x /andP[calAx not_nBaLx]]; last first. - apply: supp_aBgP => //; apply: contra not_nBaLx. - set b := fBg x => /andP[Ab Hb_g]; have [Gx MBx] := setIdP calAx. - rewrite inE mem_remgr ?mulHNB //; apply/imsetP/Dade_support1_TI => //. - by apply/pred0Pn; exists g; apply/andP. -rewrite (partition_big fBg (mem nBaL)) /= => [|x]; last by case/andP. -apply: eq_bigr => b; case/setIP=> Nb aLb; rewrite mulr_natr -sumr_const. -apply: eq_big => x; rewrite ![x \in _]inE -!andbA. - apply: andb_id2l=> Gx; apply/and3P/idP=> [[Mgx _] /eqP <- | HBb_gx]. - by rewrite mem_rcoset mem_divgr ?mulHNB. - suffices ->: fBg x = b. - by rewrite inE Nb (subsetP _ _ HBb_gx) // -mulHNB mulgS ?sub1set. - by rewrite /fBg; have [h Hh ->] := rcosetP HBb_gx; apply: remgrMid. -move/and4P=> [_ Mgx _ /eqP def_fx]. -rewrite rDadeE // Mgx -/(fBg x) def_fx; case/imsetP: aLb => y Ly ->. -by rewrite cfunJ // (subsetP sAL). -Qed. - -(* This is Peterfalvi (2.10) *) -Lemma Dade_expansion : - aa^\tau = - \sum_(B in calB) (- 1) ^+ #|B| *: 'Ind[G, 'M(B)] 'aa_B. -Proof. -apply/cfunP=> g; rewrite !cfunElock sum_cfunE. -pose n1 (B : {set gT}) : algC := (-1) ^+ #|B| / #|L : 'N_L(B)|%:R. -pose aa1 B := ('Ind[G, 'M(B)] 'aa_B) g. -have dBJ: {acts L, on calP | 'Js}. - move=> x Lx /= B; rewrite !inE -!cards_eq0 cardJg. - by rewrite -{1}(normsP nAL x Lx) conjSg. -transitivity (- (\sum_(B in calP) n1 B * aa1 B)); last first. - congr (- _); rewrite {1}(partition_big_imset (fun B => repr (B :^: L))) /=. - apply: eq_bigr => B /imsetP[B1 dB1 defB]. - have B1L_B: B \in B1 :^: L by rewrite defB (mem_repr B1) ?orbit_refl. - have{dB1} dB1L: {subset B1 :^: L <= calP}. - by move=> _ /imsetP[x Lx ->]; rewrite dBJ. - have dB: B \in calP := dB1L B B1L_B. - rewrite (eq_bigl (mem (B :^: L))) => [|B2 /=]; last first. - apply/andP/idP=> [[_ /eqP <-] | /orbit_trans/(_ B1L_B)-B1L_B2]. - by rewrite orbit_sym (mem_repr B2) ?orbit_refl. - by rewrite [B2 :^: L](orbit_eqP B1L_B2) -defB dB1L. - rewrite (eq_bigr (fun _ => n1 B * aa1 B)) => [|_ /imsetP[x Lx ->]]. - rewrite cfunE sumr_const -mulr_natr mulrAC card_orbit astab1Js divfK //. - by rewrite pnatr_eq0 -lt0n indexg_gt0. - rewrite /aa1 Dade_Ind_restr_J //; congr (_ * _). - by rewrite /n1 cardJg -{1 2}(conjGid Lx) normJ -conjIg indexJg. -case: pickP => /= [a /andP[Aa Ha_g] | notHAg]; last first. - rewrite big1 ?oppr0 // /aa1 => B dB. - have [->] := Dade_Ind_expansion g dB; first by rewrite mulr0. - by apply/bigcupP=> [[a Aa Ha_g]]; case/andP: (notHAg a). -pose P_ b := [set B in calP | b \in 'N_L(B)]. -pose aa2 B b : algC := #|calA g ('H(B) :* b)|%:R. -pose nn2 (B : {set gT}) : algC := (-1) ^+ #|B| / #|'H(B)|%:R. -pose sumB b := \sum_(B in P_ b) nn2 B * aa2 B b. -transitivity (- aa a / #|L|%:R * \sum_(b in a ^: L) sumB b); last first. - rewrite !mulNr; congr (- _). - rewrite (exchange_big_dep (mem calP)) => [|b B _] /=; last by case/setIdP. - rewrite big_distrr /aa1; apply: eq_bigr => B dB; rewrite -big_distrr /=. - have [_ /(_ a) -> //] := Dade_Ind_expansion g dB; rewrite !mulrA. - congr (_ * _); last by apply: eq_bigl => b; rewrite inE dB /= andbC -in_setI. - rewrite -mulrA mulrCA -!mulrA; congr (_ * _). - rewrite -invfM mulrCA -invfM -!natrM; congr (_ / _%:R). - rewrite -(sdprod_card (Dade_set_sdprod dB)) mulnA mulnAC; congr (_ * _)%N. - by rewrite mulnC Lagrange ?subsetIl. -rewrite (eq_bigr (fun _ => sumB a)) /= => [|_ /imsetP[x Lx ->]]; last first. - rewrite {1}/sumB (reindex_inj (@conjsg_inj _ x)) /=. - symmetry; apply: eq_big => B. - rewrite ![_ \in P_ _]inE dBJ //. - by rewrite -{2}(conjGid Lx) normJ -conjIg memJ_conjg. - case/setIdP=> dB Na; have [sBA _] := setIdP dB. - have defHBx: 'H(B :^ x) = 'H(B) :^ x. - rewrite /'H(_) (big_imset _ (in2W (conjg_inj x))) -bigcapJ /=. - by apply: eq_bigr => b Bb; rewrite DadeJ ?(subsetP sBA). - rewrite /nn2 /aa2 defHBx !cardJg; congr (_ * _%:R). - rewrite -(card_rcoset _ x); apply: eq_card => y. - rewrite !(inE, mem_rcoset, mem_conjg) conjMg conjVg conjgK -conjgM. - by rewrite groupMr // groupV (subsetP sLG). -rewrite sumr_const mulrC [sumB a](bigD1 [set a]) /=; last first. - by rewrite 3!inE cent1id sub1set Aa -cards_eq0 cards1 (subsetP sAL). -rewrite -[_ *+ _]mulr_natr -mulrA mulrDl -!mulrA ['H(_)]big_set1 cards1. -have ->: aa2 [set a] a = #|'C_G[a]|%:R. - have [u x Ha_ux Gx def_g] := imset2P Ha_g. - rewrite -(card_lcoset _ x^-1); congr _%:R; apply: eq_card => y. - rewrite ['H(_)]big_set1 mem_lcoset invgK inE def_g -conjgM. - rewrite -(groupMl y Gx) inE; apply: andb_id2l => Gxy. - by have [_ _ -> //] := normedTI_memJ_P (Dade_cover_TI Aa); rewrite inE Gxy. -rewrite mulN1r mulrC mulrA -natrM -(sdprod_card (defCA Aa)). -rewrite -mulnA card_orbit astab1J Lagrange ?subsetIl // mulnC natrM. -rewrite mulrAC mulfK ?neq0CG // mulrC divfK ?neq0CG // opprK. -rewrite (bigID [pred B : {set gT} | a \in B]) /= mulrDl addrA. -apply: canRL (subrK _) _; rewrite -mulNr -sumrN; congr (_ + _ * _). -symmetry. -rewrite (reindex_onto (fun B => a |: B) (fun B => B :\ a)) /=; last first. - by move=> B; case/andP=> _; apply: setD1K. -symmetry; apply: eq_big => B. - rewrite setU11 andbT -!andbA; apply/and3P/and3P; case. - do 2![case/setIdP] => sBA ntB /setIP[La nBa] _ notBa. - rewrite 3!inE subUset sub1set Aa sBA La setU1K // -cards_eq0 cardsU1 notBa. - rewrite -sub1set normsU ?sub1set ?cent1id //= eq_sym eqEcard subsetUl /=. - by rewrite cards1 cardsU1 notBa ltnS leqn0 cards_eq0. - do 2![case/setIdP] => /subUsetP[_ sBA] _ /setIP[La]. - rewrite inE conjUg (normP (cent1id a)) => /subUsetP[_ sBa_aB]. - rewrite eq_sym eqEcard subsetUl cards1 (cardsD1 a) setU11 ltnS leqn0 /=. - rewrite cards_eq0 => notB0 /eqP defB. - have notBa: a \notin B by rewrite -defB setD11. - split=> //; last by apply: contraNneq notBa => ->; apply: set11. - rewrite !inE sBA La -{1 3}defB notB0 subsetD1 sBa_aB. - by rewrite mem_conjg /(a ^ _) invgK mulgA mulgK. -do 2![case/andP] => /setIdP[dB Na] _ notBa. -suffices ->: aa2 B a = #|'H(B) : 'H(a |: B)|%:R * aa2 (a |: B) a. - rewrite /nn2 cardsU1 notBa exprS mulN1r !mulNr; congr (- _). - rewrite !mulrA; congr (_ * _); rewrite -!mulrA; congr (_ * _). - apply: canLR (mulKf (neq0CG _)) _; apply: canRL (mulfK (neq0CG _)) _ => /=. - by rewrite -natrM mulnC Lagrange //= Dade_setU1 ?subsetIl. -rewrite /aa2 Dade_setU1 //= -natrM; congr _%:R. -have defMB := Dade_set_sdprod dB; have [_ mulHNB nHNB tiHNB] := sdprodP defMB. -have [sHMB sNMB] := mulG_sub mulHNB; have [La nBa] := setIP Na. -have nHa: a \in 'N('H(B)) by rewrite (subsetP nHNB). -have Ca: a \in 'C_L[a] by rewrite inE cent1id La. -have [|/= partHBa nbHBa] := partition_cent_rcoset nHa. - have [sBA] := setIdP dB; case/set0Pn=> b Bb; have Ab := subsetP sBA b Bb. - rewrite (coprime_dvdr (order_dvdG Ca)) //= ['H(B)](bigD1 b) //=. - by rewrite (coprimeSg (subsetIl _ _)) ?coHL. -pose pHBa := mem ('H(B) :* a). -rewrite -sum1_card (partition_big (fun x => g ^ x) pHBa) /= => [|x]; last first. - by case/setIdP=> _ ->. -rewrite (set_partition_big _ partHBa) /= -nbHBa -sum_nat_const. -apply: eq_bigr => _ /imsetP[x Hx ->]. -rewrite (big_imset _ (in2W (conjg_inj x))) /=. -rewrite -(card_rcoset _ x) -sum1_card; symmetry; set HBaa := 'C_(_)[a] :* a. -rewrite (partition_big (fun y => g ^ (y * x^-1)) (mem HBaa)); last first. - by move=> y; rewrite mem_rcoset => /setIdP[]. -apply: eq_bigr => /= u Ca_u; apply: eq_bigl => z. -rewrite -(canF_eq (conjgKV x)) -conjgM; apply: andb_id2r; move/eqP=> def_u. -have sHBG: 'H(B) \subset G. - have [sBA /set0Pn[b Bb]] := setIdP dB; have Ab := subsetP sBA b Bb. - by rewrite (bigcap_min b) ?sHG. -rewrite mem_rcoset !inE groupMr ?groupV ?(subsetP sHBG x Hx) //=. -congr (_ && _); have [/eqP defHBa _ _] := and3P partHBa. -symmetry; rewrite def_u Ca_u -defHBa -(mulgKV x z) conjgM def_u -/HBaa. -by rewrite cover_imset -class_supportEr mem_imset2. -Qed. - -End DadeExpansion. - -(* This is Peterfalvi (2.6)(b) *) -Lemma Dade_vchar alpha : alpha \in 'Z[irr L, A] -> alpha^\tau \in 'Z[irr G]. -Proof. -rewrite [alpha \in _]zchar_split => /andP[Zaa CFaa]. -rewrite Dade_expansion // rpredN rpred_sum // => B dB. -suffices calP_B: B \in calP. - by rewrite rpredZsign cfInd_vchar // Dade_restriction_vchar. -case/imsetP: dB => B0 /setIdP[sB0A notB00] defB. -have [x Lx ->]: exists2 x, x \in L & B = B0 :^ x. - by apply/imsetP; rewrite defB (mem_repr B0) ?orbit_refl. -by rewrite inE -cards_eq0 cardJg cards_eq0 -(normsP nAL x Lx) conjSg sB0A. -Qed. - -(* This summarizes Peterfalvi (2.6). *) -Lemma Dade_Zisometry : {in 'Z[irr L, A], isometry Dade, to 'Z[irr G, G^#]}. -Proof. -split; first by apply: sub_in2 Dade_isometry; apply: zchar_on. -by move=> phi Zphi; rewrite /= zchar_split Dade_vchar ?Dade_cfun. -Qed. - -End Two. - -Section RestrDade. - -Variables (gT : finGroupType) (G L : {group gT}) (A A1 : {set gT}). -Hypothesis ddA : Dade_hypothesis G L A. -Hypotheses (sA1A : A1 \subset A) (nA1L : L \subset 'N(A1)). -Let ssA1A := subsetP sA1A. - -(* This is Peterfalvi (2.11), first part. *) -Lemma restr_Dade_hyp : Dade_hypothesis G L A1. -Proof. -have [/andP[sAL nAL] notA_1 sLG conjAG [H defCa coHL]] := ddA. -have nsA1L: A1 <| L by rewrite /normal (subset_trans sA1A). -split; rewrite ?(contra (@ssA1A _)) //; first exact: sub_in2 conjAG. -by exists H; [apply: sub_in1 defCa | apply: sub_in2 coHL]. -Qed. -Local Notation ddA1 := restr_Dade_hyp. - -Local Notation H dd := (Dade_signalizer dd). -Lemma restr_Dade_signalizer H1 : {in A, H ddA =1 H1} -> {in A1, H ddA1 =1 H1}. -Proof. -move=> defH1; apply: def_Dade_signalizer => a /ssA1A Aa. -by rewrite -defH1 ?Dade_sdprod. -Qed. - -Lemma restr_Dade_support1 : {in A1, Dade_support1 ddA1 =1 Dade_support1 ddA}. -Proof. -by move=> a A1a; rewrite /Dade_support1 (@restr_Dade_signalizer (H ddA)). -Qed. - -Lemma restr_Dade_support : - Dade_support ddA1 = \bigcup_(a in A1) Dade_support1 ddA a. -Proof. by rewrite -(eq_bigr _ restr_Dade_support1). Qed. - -Definition restr_Dade := Dade ddA1. - -(* This is Peterfalvi (2.11), second part. *) -Lemma restr_DadeE : {in 'CF(L, A1), restr_Dade =1 Dade ddA}. -Proof. -move=> aa CF1aa; apply/cfunP=> g; rewrite cfunElock. -have CFaa: aa \in 'CF(L, A) := cfun_onS sA1A CF1aa. -have [a /= /andP[A1a Ha_g] | no_a /=] := pickP. - by apply/esym/DadeE; rewrite -1?restr_Dade_support1 ?ssA1A. -rewrite cfunElock; case: pickP => //= a /andP[_ Ha_g]. -rewrite (cfun_on0 CF1aa) //; apply: contraFN (no_a a) => A1a. -by rewrite A1a restr_Dade_support1. -Qed. - -End RestrDade. - -Section NormedTI. - -Variables (gT : finGroupType) (G L : {group gT}) (A : {set gT}). -Hypotheses (tiAG : normedTI A G L) (sAG1 : A \subset G^#). - -(* This is the existence part of Peterfalvi (2.3). *) -Lemma normedTI_Dade : Dade_hypothesis G L A. -Proof. -have [[sAG notA1] [_ _ /eqP defL]] := (subsetD1P sAG1, and3P tiAG). -have [_ sLG tiAG_L] := normedTI_memJ_P tiAG. -split=> // [|a b Aa Ab /imsetP[x Gx def_b]|]. -- rewrite /(A <| L) -{2}defL subsetIr andbT; apply/subsetP=> a Aa. - by rewrite -(tiAG_L a) ?(subsetP sAG) // conjgE mulKg. -- by rewrite def_b mem_imset // -(tiAG_L a) -?def_b. -exists (fun _ => 1%G) => [a Aa | a b _ _]; last by rewrite cards1 coprime1n. -by rewrite sdprod1g -(setIidPl sLG) -setIA (setIidPr (cent1_normedTI tiAG Aa)). -Qed. - -Let def_ddA := Dade_Ind normedTI_Dade tiAG. - -(* This is the identity part of Isaacs, Lemma 7.7. *) -Lemma normedTI_Ind_id1 : - {in 'CF(L, A) & 1%g |: A, forall alpha, 'Ind[G] alpha =1 alpha}. -Proof. by move=> aa a CFaa A1a; rewrite /= -def_ddA // Dade_id1. Qed. - -(* A more restricted, but more useful form. *) -Lemma normedTI_Ind_id : - {in 'CF(L, A) & A, forall alpha, 'Ind[G] alpha =1 alpha}. -Proof. by apply: sub_in11 normedTI_Ind_id1 => //; apply/subsetP/subsetUr. Qed. - -(* This is the isometry part of Isaacs, Lemma 7.7. *) -(* The statement in Isaacs is slightly more general in that it allows for *) -(* beta \in 'CF(L, 1%g |: A); this appears to be more cumbersome than useful. *) -Lemma normedTI_isometry : {in 'CF(L, A) &, isometry 'Ind[G]}. -Proof. by move=> aa bb CFaa CFbb; rewrite /= -!def_ddA // Dade_isometry. Qed. - -End NormedTI.
\ No newline at end of file diff --git a/mathcomp/odd_order/PFsection3.v b/mathcomp/odd_order/PFsection3.v deleted file mode 100644 index e229772..0000000 --- a/mathcomp/odd_order/PFsection3.v +++ /dev/null @@ -1,1864 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div choice. -From mathcomp -Require Import fintype tuple finfun bigop prime ssralg matrix poly finset. -From mathcomp -Require Import fingroup morphism perm automorphism quotient action finalg zmodp. -From mathcomp -Require Import gfunctor center gproduct cyclic pgroup abelian frobenius. -From mathcomp -Require Import mxalgebra mxrepresentation vector falgebra fieldext galois. -From mathcomp -Require Import ssrnum rat algC algnum classfun character. -From mathcomp -Require Import integral_char inertia vcharacter. -From mathcomp -Require Import PFsection1 PFsection2. - -(******************************************************************************) -(* This file covers Peterfalvi, Section 3: TI-Subsets with Cyclic Normalizers *) -(******************************************************************************) -(* Given a direct product decomposition defW : W1 \x W2 = W, we define here: *) -(* cyclicTIset defW == the set complement of W1 and W2 in W; this *) -(* (locally) V definition is usually Let-bound to V. *) -(* := W :\: (W1 :|: W2). *) -(* cyclicTI_hypothesis G defW <-> W is a cyclic of odd order that is the *) -(* normaliser in G of its non-empty TI subset *) -(* V = cyclicTIset defW = W :\: (W1 :|: W2). *) -(* -> This is Peterfalvi, Hypothesis (3.1), or Feit-Thompson (13.1). *) -(* cyclicTIirr defW i j == the irreducible character of W coinciding with *) -(* (locally) w_ i j chi_i and 'chi_j on W1 and W2, respectively. *) -(* This notation is usually Let-bound to w_ i j. *) -(* := 'chi_(dprod_Iirr defW (i, j)). *) -(* cfCyclicTIset defW i j == the virtual character of 'Z[irr W, V] coinciding *) -(* (locally) alpha_ i j with 1 - chi_i and 1 - 'chi_j on W1 and W2, *) -(* respectively. This definition is denoted by *) -(* alpha_ i j in this file, and is only used in the *) -(* proof if Peterfalvi (13.9) in the sequel. *) -(* := cfDprod defW (1 - 'chi_i) (1 - 'chi_j). *) -(* = 1 - w_ i 0 - w_ 0 j + w_ i j. *) -(* cfCyclicTIsetBase defW := the tuple of all the alpha_ i j, for i, j != 0. *) -(* (locally) cfWVbase This is a basis of 'CF(W, V); this definition is *) -(* not used outside this file. *) -(* For ctiW : cyclicTI_hypothesis defW G we also define *) -(* cyclicTIiso ctiW == a linear isometry from 'CF(W) to 'CF(G) that *) -(* (locally) sigma that extends induction on 'CF(W, V), maps the *) -(* w_ i j to virtual characters, and w_ 0 0 to 1. *) -(* This definition is usually Let-bound to sigma, *) -(* and only depends extensionally on W, V and G. *) -(* (locally) eta_ i j := sigma (w_ i j), as in sections 13 and 14 of *) -(* tha Peterfalv text. *) -(* cyclicTI_NC ctiW phi == the number of eta_ i j constituents of phi. *) -(* (locally) NC phi := #|[set ij | '[phi, eta_ ij .1 ij.2] != 0]|. *) -(* The construction of sigma involves a large combinatorial proof, for which *) -(* it is worthwhile to use reflection techniques to automate mundane and *) -(* repetitive arguments. We isolate the necessary boilerplate in a separate *) -(* CyclicTIisoReflexion module. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope GRing.Theory Num.Theory. -Local Open Scope ring_scope. - -Section Definitions. - -Variables (gT : finGroupType) (G W W1 W2 : {set gT}). - -Definition cyclicTIset of W1 \x W2 = W := W :\: (W1 :|: W2). - -Definition cyclicTI_hypothesis (defW : W1 \x W2 = W) := - [/\ cyclic W, odd #|W| & normedTI (cyclicTIset defW) G W]. - -End Definitions. - -(* These is defined as a Notation which clients can bind with a Section Let *) -(* that can be folded easily. *) -Notation cyclicTIirr defW i j := 'chi_(dprod_Iirr defW (i, j)). - -Module CyclicTIisoReflexion. - -(******************************************************************************) -(* Support for carrying out the combinatorial parts of the proof of Theorem *) -(* (3.5) by reflection. Specifically, we need to show that in a rectangular *) -(* array of virtual characters of norm 3, of even dimensions, and such that *) -(* the dot product of two entries is 1 if they are on the same row or column, *) -(* the entries of each column contain a "pivot" normal virtual character *) -(* orthogonal to all other columns. The proof never needs to consider more *) -(* than a 4 x 2 rectangle, but frequently renumbers lines, columns and *) -(* orthonormal components in order to do so. *) -(* We want to use reflection to automate this renumbering; we also want to *) -(* automate the evaluation of the dot product constaints for partially *) -(* described entries of the matrix. *) -(* To do so we define a "theory" data structure to store a reifed form of *) -(* such partial descriptions: a set of "clauses", each consisting in an index *) -(* (i, j) into the array, and a collection of "literals" (k, v) representing *) -(* constraints '[b_(i, j), x`_k] = v%:~R, with v = 0, 1 or -1. A clause with *) -(* exactly three nonzero literals defines b_(i, j) exactly. *) -(* We define special notation for the concrete instances that appear in *) -(* reflected proofs; for example *) -(* |= & b11 = -x1 + x2 + x3 & x1, ~x2 in b12 & ? in b31 *) -(* denotes the "theory" of arrays whose two left entries decomposes into *) -(* x1 + x2 + x3 for some orthonormal x1, x2, and x3, such that the second top *) -(* entry has x1 is a signed component but is orthogonal to x2, and which have *) -(* an (unconstrained) first entry in the third column. (The concrete encoding *) -(* shifts indices to start at 0.) *) -(* The "models" in which such theories are interpreted supply the dimensions *) -(* of the array, which must be even, nonequal and at least 2, the function *) -(* mapping indices to array entries, which must be virtual characters with *) -(* the requisite norms and dot products, and an orthonormal sequence of *) -(* virtual characters that will be used to interpret the xij; a model coerces *) -(* to any of these three components. *) -(* We are primarily interested in two predicates: *) -(* sat m th <=> the interpretation of th in m is well-defined (no out of *) -(* bound indices) and valid (all constraints true). *) -(* unsat th <-> forall m, ~ sat m th *) -(* While the main theorem of this section, column_pivot, can be seen as an *) -(* instance of "sat", all the principal combinatorial lemmas use "unsat", *) -(* whose universal quantifier allows symmetry reductions. We present the set *) -(* of lemmas implementing reflection-assisted proofs of "unsat th" as a small *) -(* domain-specific proof language consisting of the following tactics: *) -(* consider bij ::= add a clause for bij, which must not appear in th, *) -(* changing the goal to unsat th & ? in bij. *) -(* bij must be within a 4 x 2 bounding box, and th *) -(* must be symmetric if bij "breaks" the 2 x 2 box. *) -(* fill bij ::= add an x(k.+1) literal to the bij clause in th, *) -(* where x1, ..., xk are all the normal characters *) -(* appearing in th, and the clause for bij exists and *) -(* contains assumptions for all of x1, ..., xk, at *) -(* two of which are nonzero. *) -(* uwlog Dcl: cl [by tac] ::= add the clause cl to th, replacing an existing *) -(* clause for the same matrix entry. This produces a *) -(* side goal of unsat th, but with an additional *) -(* assumption Dcl : unsat th+cl, which can be resolved *) -(* with the optional "by tac". *) -(* uhave lit in bij as T(ij, kl) ::= adds the literal lit (one of xk, -xk, or *) -(* ~xk) to an existing clause for bij in th, using the *) -(* reflection lemma T(ij, kl) to rule out the other *) -(* possibilities for xk. Here T can be either O *) -(* (general dot product evaluation) or L (specific *) -(* line/column constraints following from (3.5.2)). *) -(* uhave lit, lit' in bij as T(ij, kl) ::= adds both lit and lit'. *) -(* uhave lit | lit' in bij as T(ij, kl) ::= produces two subgoals, where lit *) -(* (resp. lit') is added to the ... in bij clause in *) -(* th, using T(ij, kl) to eliminate the third literal. *) -(* (lit and lit' must constrain the same component). *) -(* uhave lit | lit' | lit'' in bij ::= produces three subgoals, where lit *) -(* (resp. lit', lit'') is added to the bij clause in *) -(* th; lit, lit', lit'' should be a permutation of xk, *) -(* -xk, and ~xk for some k. *) -(* uwlog Ebij: lit | lit' in bij as T(ij, kl) ::= adds lit to the bij clause *) -(* in th, but produces a side goal where lit' has been *) -(* added instead, with an additional assumption *) -(* Ebij: th + (lit in bij); T(ij, kl) is used to rule *) -(* out the third value. *) -(* counter to T(ij, kl) ::= use T(ij, kl) to conclude that unsat th. *) -(* uexact Hth' ::= use Hth' : unsat th', where th' is a subset of th *) -(* (with the same order of literals) to conclude. *) -(* symmetric to Hth' ::= use Hth' : unsat th', where th' is a permutation *) -(* of a subset of th (preserving columns, and with at *) -(* most one row exchange) to conclude. *) -(******************************************************************************) - -Import ssrint. - -(* Clause left-hand side, a reference to a value of beta; in the reference *) -(* model m, (i, j) stands for beta_ (inord i.+1) (inord j.+1). *) -Definition ref := (nat * nat)%type. -Implicit Type ij : ref. -Definition Ref b_ij : ref := edivn (b_ij - 11) 10. (* Ref 21 = (1, 0). *) -Notation "''b' ij" := (Ref ij) (at level 0, ij at level 0, format "''b' ij"). -Notation b11 := 'b11. Notation b12 := 'b12. -Notation b21 := 'b21. Notation b22 := 'b22. -Notation b31 := 'b31. Notation b32 := 'b32. -Notation b41 := 'b41. Notation b42 := 'b42. - -Definition bbox := (nat * nat)%type. (* bounding box for refs. *) -Implicit Type bb : bbox. -Identity Coercion pair_of_bbox : bbox >-> prod. - -Definition sub_bbox bb1 bb2 := (bb1.1 <= bb2.1)%N && (bb1.2 <= bb2.2)%N. -Definition wf_ref bb := [pred ij : ref | (ij.1 < bb.1)%N && (ij.2 < bb.2)%N]. -Definition dot_ref ij1 ij2 := ((ij1.1 == ij2.1).+1 * (ij1.2 == ij2.2).+1 - 1)%N. - -Lemma bbox_refl bb : sub_bbox bb bb. Proof. exact/andP. Qed. - -(* Clause right-hand side litteral, denoting the projection of the left-hand *) -(* side on an irreducible character of G: in a valid model m, (k, v) stands *) -(* for the component m`_k *~ v = (model_xi m)`_k, and for the projection *) -(* constraint '[m i j, m`_k] == v%:~R. *) -Definition lit := (nat * int)%type. (* +x1 = (0,1) ~x2 = (1,0) -x3 = (2, -1) *) -Implicit Types (kv : lit) (kvs : seq lit). -Definition Lit k1 v : lit := if (0 + k1)%N is k.+1 then (k, v) else (k1, v). -Notation "+x k" := (Lit k 1) (at level 0, k at level 0, format "+x k"). -Notation "-x k" := (Lit k (-1)) (at level 0, k at level 0, format "-x k"). -Notation "~x k" := (Lit k 0) (at level 0, k at level 0, format "~x k"). -Notation x1 := +x1. Notation x2 := +x2. -Notation x3 := +x3. Notation x4 := +x4. -Notation x5 := +x5. Notation x6 := +x6. -Notation x7 := +x7. Notation x8 := +x8. - -Definition AndLit kvs kv := kv :: kvs. -Definition AddLit := AndLit. -Notation "(*dummy*)" := (Prop Prop) (at level 0) : defclause_scope. -Arguments AddLit _%defclause_scope _. -Infix "+" := AddLit : defclause_scope. -Definition SubLit kvs kv := AddLit kvs (kv.1, - kv.2). -Arguments SubLit _%defclause_scope _. -Infix "-" := SubLit : defclause_scope. -Coercion LastLit kv := [:: kv]. - -Fixpoint norm_cl kvs : nat := - (if kvs is (_, v) :: kvs1 then `|v| ^ 2 + norm_cl kvs1 else 0)%N. - -Definition clause := (ref * seq lit)%type. -Implicit Type cl : clause. -Definition Clause ij kvs : clause := (ij, kvs). -Notation "& kv1 , .. , kvn 'in' ij" := - (Clause ij (AndLit .. (AndLit nil kv1) .. kvn)) - (at level 200, ij, kv1, kvn at level 0, - format "& kv1 , .. , kvn 'in' ij"). -Notation "& ? 'in' ij" := (Clause ij nil) - (at level 200, ij at level 0, format "& ? 'in' ij"). -Definition DefClause := Clause. -Arguments DefClause _ _%defclause_scope. -Notation "& ij = kvs" := (DefClause ij kvs) - (at level 200, ij at level 0, format "& ij = kvs"). - -Definition theory := seq clause. -Implicit Type th : theory. -Definition AddClause th cl : theory := cl :: th. -Notation "|= cl1 .. cln" := (AddClause .. (AddClause nil cl1) .. cln) - (at level 8, cl1, cln at level 200, - format "|= '[hv' cl1 '/' .. '/' cln ']'"). - -(* Transpose (W1 / W2 symmetry). *) - -Definition tr (ij : nat * nat) : ref := (ij.2, ij.1). -Definition tr_th th : theory := [seq (tr cl.1, cl.2) | cl <- th]. - -Lemma trK : involutive tr. Proof. by case. Qed. -Lemma tr_thK : involutive tr_th. Proof. by apply: mapK => [[[i j] kvs]]. Qed. - -(* Index range of a theory. *) - -Fixpoint th_bbox th : bbox := - if th is (i, j, _) :: th1 then - let: (ri, rj) := th_bbox th1 in (maxn i.+1 ri, maxn j.+1 rj) - else (0, 0)%N. - -Lemma th_bboxP th bb : - reflect {in th, forall cl, cl.1 \in wf_ref bb} (sub_bbox (th_bbox th) bb). -Proof. -pose in_bb := [pred cl : clause | cl.1 \in wf_ref bb]. -suffices ->: sub_bbox (th_bbox th) bb = all in_bb th by apply: allP. -elim: th => [|[[i j] _] th] //=; case: (th_bbox th) => ri rj /=. -by rewrite /sub_bbox /= !geq_max andbACA => ->. -Qed. -Arguments th_bboxP [th bb]. - -Fixpoint th_dim th : nat := - if th is (_, kvs) :: th1 then - foldr (fun kv => maxn kv.1.+1) (th_dim th1) kvs - else 0%N. - -Lemma th_dimP th bk : - reflect {in th, forall cl, {in cl.2, forall kv, kv.1 < bk}}%N - (th_dim th <= bk)%N. -Proof. -pose in_bk := [pred cl : clause | all (fun kv => kv.1 < bk)%N cl.2]. -suffices ->: (th_dim th <= bk)%N = all in_bk th. - by apply: (iffP allP) => bk_th cl /bk_th/allP. -elim: th => // [[_ kvs] th /= <-]; elim: kvs => //= kv kvs. -by rewrite -andbA geq_max => ->. -Qed. -Arguments th_dimP [th bk]. - -(* Theory and clause lookup. *) - -CoInductive get_spec T (P : T -> Prop) (Q : Prop) : option T -> Prop := - | GetSome x of P x : get_spec P Q (Some x) - | GetNone of Q : get_spec P Q None. - -Fixpoint get_cl ij (th : theory) : option clause := - if th is cl :: th1 then if cl.1 == ij then Some cl else get_cl ij th1 - else None. - -Lemma get_clP ij (th : theory) : - get_spec (fun cl : clause => cl \in th /\ cl.1 = ij) True (get_cl ij th). -Proof. -elim: th => /= [|cl th IHth]; first by right. -case: eqP => [Dij | _]; first by left; rewrite ?mem_head. -by case: IHth => [cl1 [th_cl1 Dij]|]; constructor; rewrite // mem_behead. -Qed. - -Fixpoint get_lit (k0 : nat) kvs : option int := - if kvs is (k, v) :: kvs1 then if k == k0 then Some v else get_lit k0 kvs1 - else None. - -Lemma get_litP k0 kvs : - get_spec (fun v => (k0, v) \in kvs) (k0 \notin unzip1 kvs) (get_lit k0 kvs). -Proof. -elim: kvs => [|[k v] kvs IHkvs /=]; [by right | rewrite inE eq_sym]. -have [-> | k'0] := altP eqP; first by left; rewrite ?mem_head. -by have [v0 kvs_k0v | kvs'k0] := IHkvs; constructor; rewrite // mem_behead. -Qed. - -(* Theory extension. *) - -Fixpoint set_cl cl2 th : wrapped theory := - if th is cl :: th1 then - let: Wrap th2 := set_cl cl2 th1 in - if cl.1 == cl2.1 then Wrap (AddClause th2 cl2) else Wrap (AddClause th2 cl) - else Wrap nil. - -Definition ext_cl th cl k v := - let: (ij, kvs) := cl in set_cl (Clause ij (AndLit kvs (Lit k.+1 v))) th. - -Definition wf_ext_cl cl k rk := (k \notin unzip1 cl.2) && (k < rk)%N. - -Definition wf_fill k kvs := (size kvs == k) && (norm_cl kvs < 3)%N. - -Lemma ext_clP cl1 th k v (cl1k := (cl1.1, (k, v) :: cl1.2)) : - cl1 \in th -> - exists2 th1, ext_cl th cl1 k v = Wrap th1 - & cl1k \in th1 - /\ th1 =i [pred cl | if cl.1 == cl1.1 then cl == cl1k else cl \in th]. -Proof. -case: cl1 => ij kvs /= in cl1k * => th_cl1; set th1p := [pred cl | _]. -pose th1 := [seq if cl.1 == ij then cl1k else cl | cl <- th]. -exists th1; first by elim: (th) @th1 => //= cl th' ->; rewrite -2!fun_if. -suffices Dth1: th1 =i th1p by rewrite Dth1 !inE !eqxx. -move=> cl; rewrite inE; apply/mapP/idP=> [[{cl}cl th_cl ->] | ]. - by case cl_ij: (cl.1 == ij); rewrite ?eqxx ?cl_ij. -case: ifP => [_ /eqP-> | cl'ij th_cl]; last by exists cl; rewrite ?cl'ij. -by exists (ij, kvs); rewrite ?eqxx. -Qed. - -(* Satisfiability tests. *) - -Definition sat_test (rO : rel clause) ij12 th := - if get_cl (Ref ij12.1) th is Some cl1 then - oapp (rO cl1) true (get_cl (Ref ij12.2) th) - else true. - -(* This reflects the application of (3.5.1) for an arbitrary pair of entries. *) -Definition Otest cl1 cl2 := - let: (ij1, kvs1) := cl1 in let: (ij2, kvs2) := cl2 in - let fix loop s1 s2 kvs2 := - if kvs2 is (k, v2) :: kvs2 then - if get_lit k kvs1 is Some v1 then loop (v1 * v2 + s1) s2 kvs2 else - loop s1 s2.+1 kvs2 - else (s1, if norm_cl kvs1 == 3 then 0%N else s2) in - let: (s1, s2) := loop 0 0%N kvs2 in - (norm_cl kvs2 == 3) ==> (`|s1 - dot_ref ij1 ij2| <= s2)%N. - -(* Matching up to a permutation of the rows, columns, and base vectors. *) - -Definition sub_match th1 th2 := - let match_cl cl1 cl2 := - if cl2.1 == cl1.1 then subseq cl1.2 cl2.2 else false in - all [pred cl1 | has (match_cl cl1) th2] th1. - -Definition wf_consider ij th (ri := (th_bbox th).1) := - (ij.1 < 2 + ((2 < ri) || sub_match th (tr_th th)).*2)%N && (ij.2 < 2)%N. - -CoInductive sym := Sym (si : seq nat) (sj : seq nat) (sk : seq nat). - -Definition sym_match s th1 th2 := - let: Sym si sj sk := s in let: (ri, rj, rk) := (th_bbox th1, th_dim th1) in - let is_sym r s := uniq s && all (gtn r) s in - let match_cl cl2 := - let: (i2, j2, kvs2) := cl2 in let ij := (nth ri si i2, nth rj sj j2) in - let match_lit kvs1 kv := (nth rk sk kv.1, kv.2) \in kvs1 in - let match_cl1 cl1 := - let: (ij1, kvs1) := cl1 in (ij1 == ij) && all (match_lit kvs1) kvs2 in - uniq (unzip1 kvs2) && has match_cl1 th1 in - [&& is_sym ri si, is_sym rj sj, is_sym rk sk & all match_cl th2]. - -(* Try to compute the base vector permutation for a given row and column *) -(* permutation. We assume each base vector is determined by the entries of *) -(* which it is a proper constituent, and that there are at most two columns. *) -Definition find_sym_k th1 th2 (si sj : seq nat) := - let store_lit c kv ksig := - let: (k, v) := kv in if v == 0 then ksig else let cv := (c, v) in - let fix insert_in (cvs : seq (nat * int)) := - if cvs is cv' :: cvs' then - if (c < cv'.1)%N then cv :: cvs else cv' :: insert_in cvs' - else [:: cv] in - set_nth nil ksig k (insert_in (nth nil ksig k)) in - let fix read_lit ksig1 ksig2 := - if ksig1 is cvs :: ksig1' then - let k := index cvs ksig2 in - k :: read_lit ksig1' (set_nth nil ksig2 k nil) - else nil in - let fix store2 ksig1 ksig2 cls1 := - if cls1 is (i1, j1, kvs1) :: cls1' then - if get_cl (nth 0 si i1, nth 0 sj j1)%N th2 is Some (_, kvs2) then - let st_kvs := foldr (store_lit (i1.*2 + j1)%N) in (* assume j1 <= 1 *) - store2 (st_kvs ksig1 kvs1) (st_kvs ksig2 kvs2) cls1' - else None - else - let sk := read_lit ksig1 ksig2 in - if all (gtn (size ksig2)) sk then Some (Sym si sj sk) else None in - store2 nil nil th1. - -(* Try to find a symmetry that maps th1 to th2, assuming the same number of *) -(* rows and columns, and considering at most one row exchange. *) -Definition find_sym th1 th2 := - let: (ri, rj) := th_bbox th2 in let si := iota 0 ri in let sj := iota 0 rj in - if find_sym_k th1 th2 si sj is Some _ as s then s else - let fix loop m := - if m is i.+1 then - let fix inner_loop m' := - if m' is i'.+1 then - let si' := (set_nth 0 (set_nth 0 si i i') i' i)%N in - if find_sym_k th1 th2 si' sj is Some _ as s then s else inner_loop i' - else None in - if inner_loop i is Some _ as s then s else loop i - else None in - loop ri. - -Section Interpretation. - -Variables (gT : finGroupType) (G : {group gT}). - -Definition is_Lmodel bb b := - [/\ [/\ odd bb.1.+1, odd bb.2.+1, bb.1 > 1, bb.2 > 1 & bb.1 != bb.2]%N, - forall ij, b ij \in 'Z[irr G] - & {in wf_ref bb &, forall ij1 ij2, '[b ij1, b ij2] = (dot_ref ij1 ij2)%:R}]. - -Definition is_Rmodel X := orthonormal X /\ {subset X <= 'Z[irr G]}. - -Inductive model := Model bb f X of is_Lmodel bb f & is_Rmodel X. - -Coercion model_bbox m := let: Model d _ _ _ _ := m in d. -Definition model_entry m := let: Model _ f _ _ _ := m in f. -Coercion model_entry : model >-> Funclass. -Coercion model_basis m := let: Model _ _ X _ _ := m in X. -Lemma LmodelP (m : model) : is_Lmodel m m. Proof. by case: m. Qed. -Lemma RmodelP (m : model) : is_Rmodel m. Proof. by case: m. Qed. - -Fact nil_RmodelP : is_Rmodel nil. Proof. by []. Qed. - -Definition eval_cl (m : model) kvs := \sum_(kv <- kvs) m`_kv.1 *~ kv.2. - -Definition sat_lit (m : model) ij kv := '[m ij, m`_kv.1] == kv.2%:~R. -Definition sat_cl m cl := uniq (unzip1 cl.2) && all (sat_lit m cl.1) cl.2. - -Definition sat (m : model) th := - [&& sub_bbox (th_bbox th) m, th_dim th <= size m & all (sat_cl m) th]%N. -Definition unsat th := forall m, ~ sat m th. - -Lemma satP (m : model) th : - reflect {in th, forall cl, - [/\ cl.1 \in wf_ref m, uniq (unzip1 cl.2) - & {in cl.2, forall kv, kv.1 < size m /\ sat_lit m cl.1 kv}%N]} - (sat m th). -Proof. -apply: (iffP and3P) => [[/th_bboxP thbP /th_dimP thdP /allP thP] cl th_cl |thP]. - have /andP[-> clP] := thP _ th_cl; split=> // [|kv cl_kv]; first exact: thbP. - by rewrite (thdP _ th_cl) ?(allP clP). -split; first by apply/th_bboxP=> cl /thP[]. - by apply/th_dimP=> cl /thP[_ _ clP] kv /clP[]. -by apply/allP=> cl /thP[_ Ucl clP]; rewrite /sat_cl Ucl; apply/allP=> kv /clP[]. -Qed. -Arguments satP [m th]. - -(* Reflexion of the dot product. *) - -Lemma norm_clP m th cl : - sat m th -> cl \in th -> - let norm := norm_cl cl.2 in let beta := m cl.1 in - [/\ (norm <= 3)%N, norm == 3 -> beta = eval_cl m cl.2 - & (norm < 3)%N -> size cl.2 == size m -> - exists2 dk, dk \in dirr_constt beta & orthogonal (dchi dk) m]. -Proof. -case: cl => ij kvs /satP thP /thP[wf_ij Uks clP] norm beta. -have [[_ ZmL Dm] [o1m ZmR]] := (LmodelP m, RmodelP m). -set ks := unzip1 kvs in Uks; pose Aij := [seq m`_k | k <- ks]. -have lt_ks k: k \in ks -> (k < size m)%N by case/mapP=> kv /clP[ltk _] ->. -have sAm: {subset Aij <= (m : seq _)} - by move=> _ /mapP[k /lt_ks ltk ->]; rewrite mem_nth. -have o1Aij: orthonormal Aij. - have [Um _] := orthonormalP o1m; apply: sub_orthonormal o1m => //. - rewrite map_inj_in_uniq // => k1 k2 /lt_ks ltk1 /lt_ks ltk2 /eqP. - by apply: contraTeq; rewrite nth_uniq. -have [X AijX [Y [defXY oXY oYij]]] := orthogonal_split Aij beta. -have{AijX} defX: X = \sum_(xi <- Aij) '[beta, xi] *: xi. - have [_ -> ->] := orthonormal_span o1Aij AijX; apply: eq_big_seq => xi CFxi. - by rewrite defXY cfdotDl (orthoPl oYij) ?addr0. -have ->: eval_cl m kvs = X. - rewrite {}defX !big_map; apply: eq_big_seq => kv /clP[_ /eqP->]. - by rewrite scaler_int. -rewrite -leC_nat -ltC_nat -eqC_nat /=. -have <-: '[beta] = 3%:R by rewrite Dm // /dot_ref !eqxx. -have <-: '[X] = norm%:R. - rewrite {}defX {}/norm cfnorm_sum_orthonormal // {o1Aij oYij sAm}/Aij. - transitivity (\sum_(kv <- kvs) `|kv.2%:~R| ^+ 2 : algC). - by rewrite !big_map; apply: eq_big_seq => kv /clP[_ /eqP->]. - rewrite unlock /=; elim: (kvs) => //= [[k v] kvs' ->]. - by rewrite -intr_norm -natrX -natrD. -rewrite defXY cfnormDd //; split; first by rewrite ler_paddr ?cfnorm_ge0. - by rewrite eq_sym addrC -subr_eq0 addrK cfnorm_eq0 => /eqP->; rewrite addr0. -have{ZmL} Zbeta: beta \in 'Z[irr G] by apply: ZmL. -have Z_X: X \in 'Z[irr G]. - rewrite defX big_seq rpred_sum // => xi /sAm/ZmR Zxi. - by rewrite rpredZ_Cint ?Cint_cfdot_vchar. -rewrite -ltr_subl_addl subrr cnorm_dconstt; last first. - by rewrite -[Y](addKr X) -defXY addrC rpredB. -have [-> | [dk Ydk] _ /eqP sz_kvs] := set_0Vmem (dirr_constt Y). - by rewrite big_set0 ltrr. -have Dks: ks =i iota 0 (size m). - have: {subset ks <= iota 0 (size m)} by move=> k /lt_ks; rewrite mem_iota. - by case/leq_size_perm=> //; rewrite size_iota size_map sz_kvs. -suffices o_dk_m: orthogonal (dchi dk) m. - exists dk; rewrite // dirr_consttE defX cfdotDl cfdot_suml. - rewrite big1_seq ?add0r -?dirr_consttE // => xi /sAm CFxi. - by rewrite cfdotC cfdotZr (orthoPl o_dk_m) // mulr0 conjC0. -apply/orthoPl=> _ /(nthP 0)[k ltk <-]; have [Um o_m] := orthonormalP o1m. -have Z1k: m`_k \in dirr G by rewrite dirrE ZmR ?o_m ?eqxx ?mem_nth. -apply: contraTeq Ydk => /eqP; rewrite dirr_consttE cfdot_dirr ?dirr_dchi //. -have oYm: '[Y, m`_k] = 0 by rewrite (orthoPl oYij) ?map_f // Dks mem_iota. -by do 2?case: eqP => [-> | _]; rewrite // ?cfdotNr oYm ?oppr0 ltrr. -Qed. - -Lemma norm_cl_eq3 m th cl : - sat m th -> cl \in th -> norm_cl cl.2 == 3 -> m cl.1 = eval_cl m cl.2. -Proof. by move=> m_th /(norm_clP m_th)[]. Qed. - -Lemma norm_lit m th cl kv : - sat m th -> cl \in th -> kv \in cl.2 -> (`|kv.2| <= 1)%N. -Proof. -move=> m_th /(norm_clP m_th)[cl_le3 _ _]. -elim: cl.2 => //= [[k v] kvs IHkvs] in cl_le3 * => /predU1P[-> | /IHkvs->//]. - by apply: contraLR cl_le3; rewrite -ltnNge -leq_sqr => /subnKC <-. -exact: leq_trans (leq_addl _ _) cl_le3. -Qed. - -(* Decision procedure framework (in which we will define O and L). *) - -Definition is_sat_test (tO : pred theory) := forall m th, sat m th -> tO th. - -Lemma sat_testP (rO : rel clause) ij12 : - (forall m th cl1 cl2, sat m th -> cl1 \in th -> cl2 \in th -> rO cl1 cl2) -> - is_sat_test (sat_test rO ij12). -Proof. -rewrite /sat_test => O m th /O O_th; case: get_clP => // cl1 [th_cl1 _]. -by case: get_clP => // cl2 [th_cl2 _]; apply: O_th. -Qed. - -(* Case analysis on the value of a specific projection. *) - -Definition lit_vals : seq int := [:: 0; 1; -1]. - -Lemma sat_cases (m : model) th k cl : - sat m th -> cl \in th -> wf_ext_cl cl k (size m) -> - exists2 v, v \in lit_vals & sat m (unwrap (ext_cl th cl k v)). -Proof. -case: cl => ij kvs /satP thP th_cl /andP[cl'k ltkm]. -have [[_ ZmL _] [o1m ZmR]] := (LmodelP m, RmodelP m). -have [m_ij Uij clP] := thP _ th_cl. -have /CintP[v Dv]: '[m ij, m`_k] \in Cint. - by rewrite Cint_cfdot_vchar ?ZmL ?ZmR ?mem_nth. -have [/= th1 Dthx [th1_cl Dth1]] := ext_clP k v th_cl. -suffices{Dthx} m_th1: sat m th1. - exists v; last by rewrite /ext_cl Dthx. - by case: (v) (norm_lit m_th1 th1_cl (mem_head _ _)); do 2?case. -apply/satP=> cl1; rewrite Dth1 inE; case: ifP => [_ /eqP-> | _ /thP] //=. -by rewrite cl'k; split=> // kv /predU1P[-> | /clP//]; rewrite /sat_lit Dv. -Qed. -Arguments sat_cases [m th] k [cl]. - -Definition unsat_cases_hyp th0 kvs tO cl := - let: (k, _) := head (2, 0) kvs in let thk_ := ext_cl th0 cl k in - let th's := [seq unwrap (thk_ v) | v <- lit_vals & v \notin unzip2 kvs] in - let add hyp kv := - let: (_, v) := kv in let: Wrap th := thk_ v in hyp /\ unsat th in - foldl add (wf_ext_cl cl k (th_dim th0) && all (predC tO) th's) kvs. - -Lemma unsat_cases th ij kvs tO : - is_sat_test tO -> oapp (unsat_cases_hyp th kvs tO) False (get_cl ij th) -> - unsat th. -Proof. -case: get_clP => //= cl [th_cl _] O; rewrite /unsat_cases_hyp. -case: head => k _; set thk_ := ext_cl th cl k; set add := fun _ _ => _. -set wf_kvs := _ && _; rewrite -[kvs]revK foldl_rev => Ukvs m m_th. -have{Ukvs}: all (fun kv => ~~ sat m (unwrap (thk_ kv.2))) (rev kvs) && wf_kvs. - elim: rev Ukvs => // [[_ v] /= kvs' IH]; case Dthk: (thk_ v) => [thv] [/IH]. - by rewrite -andbA => -> Uthk; rewrite andbT; apply/negP; apply: Uthk. -case/and3P=> /allP Uthkvs /andP[cl'k ltkr] /allP Uthkv's. -have [|{cl'k ltkr} v lit_v m_thv] := sat_cases k m_th th_cl. - by rewrite /wf_ext_cl cl'k (leq_trans ltkr) //; have [] := and3P m_th. -have /idPn[] := O _ _ m_thv; apply: Uthkv's; apply: map_f. -rewrite mem_filter lit_v andbT -mem_rev -map_rev. -by apply: contraL m_thv => /mapP[kv /Uthkvs m'thkv ->]. -Qed. - -(* Dot product reflection. *) - -Lemma O ij12 : is_sat_test (sat_test Otest ij12). -Proof. -apply: sat_testP => m th [ij1 kvs1] [ij2 kvs2] /= m_th th_cl1 th_cl2. -set cl1eq := _ == 3; set cl2eq := _ == 3; have [_ _ Dm] := LmodelP m. -pose goal s1 s2 := cl2eq ==> (`|s1 - (dot_ref ij1 ij2)%:~R| <= s2%:R :> algC). -set kvs := kvs2; set s1 := 0; set s2 := {2}0%N; have thP := satP m_th. -have{thP} [[wf_cl1 _ cl1P] [wf_cl2 _ cl2P]] := (thP _ th_cl1, thP _ th_cl2). -have: goal (s1%:~R + '[m ij1, eval_cl m kvs]) (if cl1eq then 0%N else s2). - apply/implyP=> /(norm_cl_eq3 m_th th_cl2) <-. - by rewrite if_same Dm // addrK normr0. -have /allP: {subset kvs <= kvs2} by []. -rewrite cfdot_sumr unlock; elim: kvs s1 s2 => [|[k v2] kvs IHkvs] s1 s2 /=. - by rewrite addr0 /goal -rmorphB pmulrn -!CintrE. -case/andP=> kvs2_v /IHkvs{IHkvs}IHkvs; have{cl2P} [ltk _] := cl2P _ kvs2_v. -have [v1 /cl1P[_ /eqP/=Dv1] | kvs1'k] := get_litP. - rewrite addrA => gl12; apply: IHkvs; congr (goal (_ + _) _): gl12. - by rewrite raddfMz addrC /= Dv1 -mulrzA -rmorphD. -move=> gl12; apply: IHkvs; case: ifP gl12 => [/(norm_cl_eq3 m_th th_cl1)->|_]. - rewrite cfdot_suml big1_seq ?add0r //= => kv1 kvs1_kv1. - have [[ltk1 _] [/orthonormalP[Um oom] _]] := (cl1P _ kvs1_kv1, RmodelP m). - rewrite -!scaler_int cfdotZl cfdotZr oom ?mem_nth ?nth_uniq // mulrb. - by rewrite ifN ?mulr0 //; apply: contraNneq kvs1'k => <-; apply: map_f. -rewrite /goal -(ler_add2r 1) -mulrSr; case: (cl2eq) => //; apply: ler_trans. -set s := '[_, _]; rewrite -[_ + _](addrK s) (ler_trans (ler_norm_sub _ _)) //. -rewrite 2![_ + s]addrAC addrA ler_add2l {}/s -scaler_int cfdotZr rmorph_int. -have [|v1 _] := sat_cases k m_th th_cl1; first exact/andP. -have [th1 -> /= [th1_cl1 _] m_th1] := ext_clP k v1 th_cl1. -have [_ _ /(_ _ (mem_head _ _))[_ /eqP->]] := satP m_th1 _ th1_cl1. -have ubv1: (`|v1| <= 1)%N := norm_lit m_th1 th1_cl1 (mem_head _ _). -have ubv2: (`|v2| <= 1)%N := norm_lit m_th th_cl2 kvs2_v. -by rewrite -rmorphM -intr_norm lern1 abszM /= (leq_mul ubv2 ubv1). -Qed. - -(* "Without loss" cut rules. *) - -Lemma unsat_wlog cl th : - (let: Wrap th1 := set_cl cl th in (unsat th1 -> unsat th) /\ unsat th1) -> - unsat th. -Proof. by case: set_cl => th1 [Uth /Uth]. Qed. - -Lemma unsat_wlog_cases th1 th2 : - (unsat th1 -> unsat th2) -> unsat th1 -> (true /\ unsat th1) /\ unsat th2. -Proof. by move=> Uth2 Uth1; split; last apply: Uth2. Qed. - -(* Extend the orthonormal basis *) - -Lemma sat_fill m th cl (k := th_dim th) : - sat m th -> cl \in th -> wf_fill k cl.2 -> - exists mr : {CFk | is_Rmodel CFk}, - sat (Model (LmodelP m) (svalP mr)) (unwrap (ext_cl th cl k 1)). -Proof. -move=> m_th th_cl /andP[/eqP sz_kvs n3cl]. -wlog sz_m: m m_th / size m = k. - have lekm: (k <= size m)%N by have [] := and3P m_th. - have mrP: is_Rmodel (take k m). - have [] := RmodelP m; rewrite -{1 2}(cat_take_drop k m) orthonormal_cat /=. - by case/andP=> o1mr _ /allP; rewrite all_cat => /andP[/allP]. - move/(_ (Model (LmodelP m) mrP)); apply; rewrite ?size_takel //. - congr (_ && _): m_th; rewrite lekm size_takel ?leqnn //=. - apply: eq_in_all => cl1 /th_dimP lt_cl1; congr (_ && _). - by apply: eq_in_all => kv1 /lt_cl1 lt_kv1; rewrite /sat_lit nth_take ?lt_kv1. -have [_ _ [//||dk cl_dk o_dk_m]] := norm_clP m_th th_cl. - by rewrite sz_kvs sz_m. -have CFkP: is_Rmodel (rcons m (dchi dk)). - have [o1m /allP Zm] := RmodelP m. - split; last by apply/allP; rewrite all_rcons /= dchi_vchar. - rewrite -cats1 orthonormal_cat o1m orthogonal_sym o_dk_m. - by rewrite /orthonormal /= cfnorm_dchi eqxx. -exists (exist _ _ CFkP); set mk := Model _ _. -have{m_th} mk_th: sat mk th. - congr (_ && _): m_th; rewrite size_rcons sz_m leqnn ltnW //=. - apply: eq_in_all => cl1 /th_dimP lt_cl1; congr (_ && _). - apply: eq_in_all => kv1 /lt_cl1 lt_kv1; congr ('[_, _] == _). - by rewrite nth_rcons sz_m lt_kv1. -have [|{mk_th}v ub_v m_th] := sat_cases k mk_th th_cl. - rewrite /wf_ext_cl size_rcons sz_m (contraFN _ (ltnn k)) //=. - by case/mapP=> kv kv_cl {1}->; rewrite (th_dimP _ _ th_cl). -suffices: 0 < v by case/or4P: ub_v m_th => // /eqP->. -case: (ext_clP k v th_cl) m_th => th1 -> [th1_cl1 _] /and3P[_ _]. -case/allP/(_ _ th1_cl1)/and3P=> _ /eqP/=. -by rewrite nth_rcons sz_m ltnn eqxx CintrE => <- _; rewrite -dirr_consttE. -Qed. - -Lemma unsat_fill ij th : - let fill_cl cl := - if (th_dim th).+1 %/ 1 is k.+1 then - let: Wrap thk := ext_cl th cl k 1 in wf_fill k cl.2 /\ unsat thk - else True in - oapp fill_cl False (get_cl ij th) -> unsat th. -Proof. -rewrite divn1; case: get_clP => //= cl [th_cl _]. -case Dthk: ext_cl => [th1] [wf_thk Uth1] m m_th. -by have [mk] := sat_fill m_th th_cl wf_thk; rewrite Dthk => /Uth1. -Qed. - -(* Matching an assumption exactly. *) - -Lemma sat_exact m th1 th2 : sub_match th1 th2 -> sat m th2 -> sat m th1. -Proof. -move/allP=> s_th12 /satP th2P; apply/satP => cl1 /s_th12/hasP[cl2 th_cl2]. -case: eqP => // <- s_cl12; have [wf_ij2 Ucl2 cl2P] := th2P _ th_cl2. -split=> // [|kv /(mem_subseq s_cl12)/cl2P//]. -by rewrite (subseq_uniq _ Ucl2) ?map_subseq. -Qed. - -Lemma unsat_exact th1 th2 : sub_match th1 th2 -> unsat th1 -> unsat th2. -Proof. by move=> sth21 Uth1 m /(sat_exact sth21)/Uth1. Qed. - -(* Transpose (W1 / W2 symmetry). *) - -Fact tr_Lmodel_subproof (m : model) : is_Lmodel (tr m) (fun ij => m (tr ij)). -Proof. -case: m => /= d f _ [[odd_d1 odd_d2 d1gt1 d2gt1 neq_d12] Zf fP] _. -split=> // [|[j1 i1] [j2 i2]]; first by rewrite eq_sym. -by rewrite ![_ \in _]andbC /= => wf_ij1 wf_ij2; rewrite fP // /dot_ref mulnC. -Qed. - -Definition tr_model m := Model (tr_Lmodel_subproof m) (RmodelP m). - -Lemma sat_tr m th : sat m th -> sat (tr_model m) (tr_th th). -Proof. -move/satP=> thP; apply/satP=> _ /mapP[[[i j] kvs] /thP[m_ij Uks kvsP] ->]. -by rewrite inE /= andbC. -Qed. - -(* Extend the theory (add a new empty clause). *) - -Lemma unsat_consider ij th : - wf_consider ij th -> unsat (AddClause th (& ? in ij)) -> unsat th. -Proof. -case: ij => i j; case/andP; set sym_t := sub_match _ _ => lti ltj Uthij m m_th. -wlog le_m21: m m_th / sym_t -> (m.2 <= m.1)%N. - move=> IH; apply: (IH m m_th) => sym_th. - rewrite leqNgt; apply/negP=> /leqW le_m1_m2. - by have /(sat_exact sym_th)/IH[] := sat_tr m_th. -apply: (Uthij m); congr (_ && _): (m_th) => /=; case: (th_bbox th) => ri rj /=. -have [[odd_m1 _ m1gt1 m2gt1 neq_m12] _ _] := LmodelP m. -rewrite /sub_bbox !geq_max (leq_trans ltj) ?(leq_trans lti) //; case: orP => //. -rewrite -(ltnS 4) (odd_geq _ odd_m1) ltnS. -case=> [/leq_trans-> // | /le_m21]; first by have [/andP[]] := and3P m_th. -by rewrite leq_eqVlt eq_sym (negPf neq_m12); apply: leq_trans. -Qed. - -(* Matching up to a permutation of the rows, columns, and base vectors. *) - -Lemma unsat_match s th1 th2 : sym_match s th1 th2 -> unsat th2 -> unsat th1. -Proof. -pose I_ si mi := si ++ filter [predC si] (iota 0 mi). -have SsP mi si ri (Ii := I_ si mi): - uniq si && all (gtn ri) si -> (ri <= mi)%N -> - [/\ {in Ii, forall i, i < mi}%N, uniq Ii & size Ii = mi]. -- case/andP=> Usi /allP/=ltsi le_ri_mi; have uIm := iota_uniq 0 mi. - have uIi: uniq Ii by rewrite cat_uniq Usi -all_predC filter_all filter_uniq. - have defIi: Ii =i iota 0 mi. - move=> i; rewrite mem_cat mem_filter orb_andr orbN mem_iota. - by apply: orb_idl => /ltsi/leq_trans->. - split=> // [i|]; first by rewrite defIi mem_iota. - by rewrite (perm_eq_size (uniq_perm_eq _ _ defIi)) ?size_iota. -have lt_nth ri si i: (nth ri si i < ri)%N -> (i < size si)%N. - by rewrite !ltnNge; apply: contra => le_si; rewrite nth_default. -case: s => [si sj sk] /= sym12 Uth2 m m_th1; case/and3P: (m_th1) sym12. -case: th_bbox (th_bboxP (bbox_refl (th_bbox th1))) => ri rj rijP. -case/andP=> /= leri lerj lerk _ /and4P[Ssi Ssj /andP[Usk /allP/=lesrk] sym12]. -have{Ssi} /SsP/(_ leri)[ltIi uIi szIi] := Ssi. -have{Ssj SsP} /SsP/(_ lerj)[ltIj uIj szIj] := Ssj. -pose smL ij := m (nth ri (I_ si m.1) ij.1, nth rj (I_ sj m.2) ij.2)%N. -pose smR := [seq m`_k | k <- sk]. -have [[lb_m ZmL Dm] [o1m ZmR]] := (LmodelP m, RmodelP m). -have{lb_m} smLP: is_Lmodel m smL. - split=> // [ij | ij1 ij2 /andP[lti1 ltj1] /andP[lti2 ltj2]]; first exact: ZmL. - by rewrite Dm ?inE /dot_ref/= ?nth_uniq ?ltIi ?ltIj ?mem_nth ?szIi ?szIj. -have{lesrk} ubk k: k \in sk -> (k < size m)%N by move=> /lesrk/leq_trans->. -have smRP: is_Rmodel smR. - have ssmR: {subset smR <= (m : seq _)}. - by move=> _ /mapP[k s_k ->]; rewrite mem_nth ?ubk. - split=> [|xi /ssmR/ZmR//]; have [Um _] := orthonormalP o1m. - apply: sub_orthonormal o1m; rewrite ?map_inj_in_uniq //. - by apply: can_in_inj (index^~ m) _ => k s_k; rewrite /= index_uniq ?ubk. -apply: (Uth2 (Model smLP smRP)); apply/satP=> [][[i2 j2] kvs2] /(allP sym12). -case/andP=> -> /hasP[[[i1 j1] kvs1] th1_cl1 /andP[/eqP[Di1 Dj1] /allP s_kv12]]. -have:= rijP _ th1_cl1; rewrite Di1 Dj1 => /andP[/lt_nth lti1 /lt_nth ltj1]. -rewrite !inE -szIi -szIj !size_cat !(leq_trans _ (leq_addr _ _)) //. -split=> // kv /s_kv12 kvs1_kv1; rewrite size_map /sat_lit /=. -have /lt_nth ltk := th_dimP (leqnn _) _ th1_cl1 _ kvs1_kv1; split=> //. -rewrite (nth_map (th_dim th1)) // /smL !nth_cat lti1 ltj1 -Di1 -Dj1. -by have [_ _ /(_ _ kvs1_kv1)[]] := satP m_th1 _ th1_cl1. -Qed. - -Lemma unsat_sym th1 th2 : - (if find_sym th1 th2 is Some s then sym_match s th2 th1 else false) -> - unsat th1 -> unsat th2. -Proof. by case: find_sym => // s; apply: unsat_match. Qed. - -End Interpretation. - -Arguments satP [gT G m th]. -Arguments unsat [gT G]. -Arguments sat_cases [gT G m th] k [cl]. -Arguments unsat_cases [gT G th] ij kvs [tO]. -Arguments unsat_wlog [gT G]. -Arguments unsat_fill [gT G]. -Arguments unsat_consider [gT G]. -Arguments unsat_match [gT G] s [th1 th2]. - -(* The domain-specific tactic language. *) - -Tactic Notation "consider" constr(ij) := - apply: (unsat_consider ij); first exact isT. - -(* Note that "split" here would be significantly less efficient, because it *) -(* would evaluate the reflected assumption four times. *) -Tactic Notation "fill" constr(ij) := - apply: (unsat_fill ij); apply: (conj isT _). - -Tactic Notation "uwlog" simple_intropattern(IH) ":" constr(cl) := - apply: (unsat_wlog cl); split=> [IH | ]. - -Tactic Notation "uwlog" simple_intropattern(IH) ":" constr(cl) - "by" tactic4(tac) := - apply: (unsat_wlog cl); split=> [IH | ]; first by [tac]. - -Tactic Notation "uhave" constr(kv) "in" constr(ij) - "as" constr(T) constr(ij12) := - apply: (unsat_cases ij [:: kv] (T ij12)); apply: (conj isT _). - -Tactic Notation "uhave" constr(kv1) "," constr(kv2) "in" constr(ij) - "as" constr(T) constr(ij12) := - uhave kv1 in ij as T ij12; uhave kv2 in ij as T ij12. - -Tactic Notation "uhave" constr(kv1) "|" constr(kv2) "in" constr(ij) - "as" constr(T) constr(ij12) := - apply: (unsat_cases ij [:: kv1; kv2] (T ij12)); apply: (conj (conj isT _) _). - -Tactic Notation "uhave" constr(kv1) "|" constr(kv2) "|" constr(kv3) - "in" constr(ij) := - apply: (unsat_cases ij [:: kv1; kv2; kv3] (fun _ _ _ => isT)); - apply: (conj (conj (conj isT _) _) _). - -Tactic Notation "uwlog" simple_intropattern(IH) ":" - constr(kv1) "|" constr(kv2) "in" constr(ij) - "as" constr(T) constr(ij12) := - apply: (unsat_cases ij [:: kv1; kv2] (T ij12)); - apply: unsat_wlog_cases => [IH | ]. - -Tactic Notation "counter" "to" constr(T) constr(ij12) := by move=> ? /(T ij12). - -Tactic Notation "uexact" constr(IH) := apply: unsat_exact IH; exact isT. - -Tactic Notation "symmetric" "to" constr(IH) := apply: unsat_sym (IH); exact isT. - -End CyclicTIisoReflexion. - -Section Three. - -Variables (gT : finGroupType) (G W W1 W2 : {group gT}). -Hypothesis defW : W1 \x W2 = W. - -Let V := cyclicTIset defW. -Let w_ i j := cyclicTIirr defW i j. -Let w1 := #|W1|. -Let w2 := #|W2|. - -Lemma cyclicTIirrC (xdefW : W2 \x W1 = W) i j : - cyclicTIirr xdefW j i = w_ i j. -Proof. by rewrite (dprod_IirrC xdefW defW). Qed. - -Lemma cycTIirrP chi : chi \in irr W -> {i : Iirr W1 & {j | chi = w_ i j}}. -Proof. -case/irrP/sig_eqW=> k ->{chi}. -by have /codomP/sig_eqW[[i j] ->] := dprod_Iirr_onto defW k; exists i, j. -Qed. - -Lemma cycTIirr_aut u i j : w_ (aut_Iirr u i) (aut_Iirr u j) = cfAut u (w_ i j). -Proof. by rewrite /w_ !dprod_IirrE cfAutDprod !aut_IirrE. Qed. - -Let sW1W : W1 \subset W. Proof. by have /mulG_sub[] := dprodW defW. Qed. -Let sW2W : W2 \subset W. Proof. by have /mulG_sub[] := dprodW defW. Qed. - -Lemma card_cycTIset : #|V| = (w1.-1 * w2.-1)%N. -Proof. -have [_ _ _ tiW12] := dprodP defW. -rewrite cardsD (setIidPr _) ?subUset ?sW1W // cardsU {}tiW12 cards1. -rewrite -(dprod_card defW) -addnBA // -!subn1 -/w1 -/w2 subnDA. -by rewrite mulnBl mulnBr mul1n muln1. -Qed. - -Definition cfCyclicTIset i j := cfDprod defW (1 - 'chi_i) (1 - 'chi_j). -Local Notation alpha_ := cfCyclicTIset. - -Lemma cycTIirr00 : w_ 0 0 = 1. Proof. by rewrite /w_ dprod_Iirr0 irr0. Qed. -Local Notation w_00 := cycTIirr00. - -Lemma cycTIirr_split i j : w_ i j = w_ i 0 * w_ 0 j. -Proof. by rewrite /w_ !dprod_IirrE !irr0 cfDprod_split. Qed. - -Lemma cfker_cycTIl j : W1 \subset cfker (w_ 0 j). -Proof. by rewrite /w_ dprod_IirrE irr0 cfDprod_cfun1l cfker_sdprod. Qed. - -Lemma cfker_cycTIr i : W2 \subset cfker (w_ i 0). -Proof. by rewrite /w_ dprod_IirrE irr0 cfDprod_cfun1r cfker_sdprod. Qed. - -Let cfdot_w i1 j1 i2 j2 : '[w_ i1 j1, w_ i2 j2] = ((i1 == i2) && (j1 == j2))%:R. -Proof. exact: cfdot_dprod_irr. Qed. - -Lemma cfCycTI_E i j : alpha_ i j = 1 - w_ i 0 - w_ 0 j + w_ i j. -Proof. -rewrite -w_00 -[w_ i j]opprK /w_ !dprod_IirrE !irr0 -addrA -opprD -!mulrBl. -by rewrite -mulrBr -!rmorphB. -Qed. -Local Notation alphaE := cfCycTI_E. - -Lemma cfCycTI_vchar i j : alpha_ i j \in 'Z[irr W]. -Proof. by rewrite alphaE rpredD ?rpredB ?rpred1 ?irr_vchar. Qed. - -Definition cfCyclicTIsetBase := - [seq alpha_ ij.1 ij.2 | ij in setX [set~ 0] [set~ 0]]. -Local Notation cfWVbase := cfCyclicTIsetBase. - -Let cfdot_alpha_w i1 j1 i2 j2 : - i2 != 0 -> j2 != 0 -> '[alpha_ i1 j1, w_ i2 j2] = [&& i1 == i2 & j1 == j2]%:R. -Proof. -move=> nzi2 nzj2; rewrite alphaE -w_00 !cfdotDl !cfdotNl !cfdot_w. -by rewrite !(eq_sym 0) (negPf nzi2) (negPf nzj2) /= andbF !subr0 add0r. -Qed. - -Let cfdot_alpha_1 i j : i != 0 -> j != 0 -> '[alpha_ i j, 1] = 1. -Proof. -move=> nzi nzj; rewrite alphaE -w_00 !cfdotDl !cfdotNl !cfdot_w. -by rewrite !eqxx andbT /= (negPf nzi) (negPf nzj) addr0 !subr0. -Qed. - -Let cfnorm_alpha i j : i != 0 -> j != 0 -> '[alpha_ i j] = 4%:R. -Proof. -move=> nzi nzj; rewrite -[4]/(size [:: 1; - w_ i 0; - w_ 0 j; w_ i j]). -rewrite -cfnorm_orthonormal 3?big_cons ?big_seq1 ?addrA -?alphaE //. -rewrite /orthonormal -w_00 /= !cfdotNl !cfdotNr !opprK !oppr_eq0 !cfnorm_irr. -by rewrite !cfdot_w !eqxx /= !(eq_sym 0) (negPf nzi) (negPf nzj) !eqxx. -Qed. - -Lemma cfCycTIbase_free : free cfWVbase. -Proof. -apply/freeP=> s /= s_alpha_0 ij; case def_ij: (enum_val ij) => [i j]. -have /andP[nzi nzj]: (i != 0) && (j != 0). - by rewrite -!in_setC1 -in_setX -def_ij enum_valP. -have:= congr1 (cfdotr (w_ i j)) s_alpha_0; rewrite raddf_sum raddf0 => <-. -rewrite (bigD1 ij) //= nth_image def_ij cfdotZl cfdot_alpha_w // !eqxx mulr1. -rewrite big1 ?addr0 // => ij1; rewrite nth_image -(inj_eq enum_val_inj) def_ij. -case: (enum_val ij1) => i1 j1 /= => ne_ij1_ij. -by rewrite cfdotZl cfdot_alpha_w // mulr_natr mulrb ifN. -Qed. - -(* Further results on alpha_ depend on the assumption that W is cyclic. *) - -Hypothesis ctiW : cyclicTI_hypothesis G defW. - -Let cycW : cyclic W. Proof. by case: ctiW. Qed. -Let oddW : odd #|W|. Proof. by case: ctiW. Qed. -Let tiV : normedTI V G W. Proof. by case: ctiW. Qed. -Let ntV : V != set0. Proof. by case/andP: tiV. Qed. - -Lemma cyclicTIhyp_sym (xdefW : W2 \x W1 = W) : cyclicTI_hypothesis G xdefW. -Proof. by split; rewrite // /cyclicTIset setUC. Qed. - -Let cycW1 : cyclic W1. Proof. exact: cyclicS cycW. Qed. -Let cycW2 : cyclic W2. Proof. exact: cyclicS cycW. Qed. -Let coW12 : coprime w1 w2. Proof. by rewrite -(cyclic_dprod defW). Qed. - -Let Wlin k : 'chi[W]_k \is a linear_char. Proof. exact/irr_cyclic_lin. Qed. -Let W1lin i : 'chi[W1]_i \is a linear_char. Proof. exact/irr_cyclic_lin. Qed. -Let W2lin i : 'chi[W2]_i \is a linear_char. Proof. exact/irr_cyclic_lin. Qed. -Let w_lin i j : w_ i j \is a linear_char. Proof. exact: Wlin. Qed. - -Let nirrW1 : #|Iirr W1| = w1. Proof. exact: card_Iirr_cyclic. Qed. -Let nirrW2 : #|Iirr W2| = w2. Proof. exact: card_Iirr_cyclic. Qed. -Let NirrW1 : Nirr W1 = w1. Proof. by rewrite -nirrW1 card_ord. Qed. -Let NirrW2 : Nirr W2 = w2. Proof. by rewrite -nirrW2 card_ord. Qed. - -Lemma cycTI_nontrivial : W1 :!=: 1%g /\ W2 :!=: 1%g. -Proof. -apply/andP; rewrite -!cardG_gt1 -!(subn_gt0 1) !subn1 -muln_gt0. -by rewrite -card_cycTIset card_gt0. -Qed. - -Let ntW1 : W1 :!=: 1%g. Proof. by case: cycTI_nontrivial. Qed. -Let ntW2 : W2 :!=: 1%g. Proof. by case: cycTI_nontrivial. Qed. -Let oddW1 : odd w1. Proof. exact: oddSg oddW. Qed. -Let oddW2 : odd w2. Proof. exact: oddSg oddW. Qed. -Let w1gt2 : (2 < w1)%N. Proof. by rewrite odd_gt2 ?cardG_gt1. Qed. -Let w2gt2 : (2 < w2)%N. Proof. by rewrite odd_gt2 ?cardG_gt1. Qed. - -Let neq_w12 : w1 != w2. -Proof. -by apply: contraTneq coW12 => ->; rewrite /coprime gcdnn -(subnKC w2gt2). -Qed. - -Let cWW : abelian W. Proof. exact: cyclic_abelian. Qed. -Let nsVW : V <| W. Proof. by rewrite -sub_abelian_normal ?subsetDl. Qed. -Let sWG : W \subset G. Proof. by have [_ /subsetIP[]] := normedTI_P tiV. Qed. -Let sVG : V \subset G^#. Proof. by rewrite setDSS ?subsetU ?sub1G. Qed. - -Let alpha1 i j : alpha_ i j 1%g = 0. -Proof. by rewrite cfDprod1 !cfunE cfun11 lin_char1 // subrr mul0r. Qed. - -(* This first part of Peterfalvi (3.4) will be used in (4.10) and (13.9). *) -Lemma cfCycTI_on i j : alpha_ i j \in 'CF(W, V). -Proof. -apply/cfun_onP=> x; rewrite !inE negb_and negbK orbC. -case/or3P => [/cfun0->// | W1x | W2x]. - by rewrite -[x]mulg1 cfDprodE // !cfunE cfun11 lin_char1 ?subrr ?mulr0. -by rewrite -[x]mul1g cfDprodE // !cfunE cfun11 lin_char1 ?subrr ?mul0r. -Qed. - -(* This is Peterfalvi (3.4). *) -Lemma cfCycTIbase_basis : basis_of 'CF(W, V) cfWVbase. -Proof. -rewrite basisEfree cfCycTIbase_free /=. -have ->: \dim 'CF(W, V) = #|V| by rewrite dim_cfun_on_abelian ?subsetDl. -rewrite size_tuple cardsX !cardsC1 nirrW1 nirrW2 -card_cycTIset leqnn andbT. -by apply/span_subvP=> _ /imageP[[i j] _ ->]; apply: cfCycTI_on. -Qed. -Local Notation cfWVbasis := cfCycTIbase_basis. - -Section CyclicTIisoBasis. - -Import CyclicTIisoReflexion ssrint. - -Local Notation unsat := (@unsat gT G). -Local Notation O := (@O gT G). -Local Notation "#1" := (inord 1). - -(* This is the combinatorial core of Peterfalvi (3.5.2). *) -(* Peterfalvi uses evaluation at 1%g to conclude after the second step; since *) -(* this is not covered by our model, we have used the dot product constraints *) -(* between b12 and b11, b21 instead. *) -Let unsat_J : unsat |= & x1 in b11 & -x1 in b21. -Proof. -uwlog b11x1: (& b11 = x1 + x2 + x3) by do 2!fill b11. -uwlog b21x1: (& b21 = -x1 + x2 + x3) by uhave x2, x3 in b21 as O(21, 11). -consider b12; uhave -x2 | x2 | ~x2 in b12. -- by uhave x1 in b12 as O(12, 11); counter to O(12, 21). -- uhave x1 | ~x1 in b12 as O(12, 21). - by uhave ~x3 in b12 as O(12, 21); counter to O(12, 11). - by uhave ~x3 in b12 as O(12, 11); counter to O(12, 21). -uhave x3 | ~x3 in b12 as O(12, 11). - by uhave x1 in b12 as O(12, 21); counter to O(12, 11). -by uhave x1 in b12 as O(12, 11); counter to O(12, 21). -Qed. - -Let unsat_II: unsat |= & x1, x2 in b11 & x1, x2 in b21. -Proof. by fill b11; uhave -x3 in b21 as O(21, 11); symmetric to unsat_J. Qed. - -(* This reflects the application of (3.5.2), but only to rule out nonzero *) -(* components of the first entry that conflict with positive components of *) -(* the second entry; Otest covers all the other uses of (3.5.2) in the proof. *) -Let Ltest (cl1 cl2 : clause) := - let: (i1, j1, kvs1) := cl1 in let: (i2, j2, kvs2) := cl2 in - let fix loop mm kvs2' := - if kvs2' is (k, v2) :: kvs2'' then - let v1 := odflt 0 (get_lit k kvs1) in - if (v2 != 1) || (v1 == 0) then loop mm kvs2'' else - if (v1 != 1) || mm then false else loop true kvs2'' - else true in - (i1 == i2) (+) (j1 == j2) ==> loop false kvs2. - -Let L ij12 : is_sat_test G (sat_test Ltest ij12). -Proof. -apply: sat_testP => m th [[i1 j1] kvs1] [[i2 j2] kvs2] m_th th_cl1 th_cl2. -wlog eq_j: m th i1 i2 j1 j2 m_th th_cl1 th_cl2 / j1 == j2. - move=> IH; case eq_j: (j1 == j2); first exact: IH m_th th_cl1 th_cl2 eq_j. - case eq_i: (i1 == i2); last by rewrite /= eq_i eq_j. - have /(_ (_, _, _)) mem_trt: _ \in tr_th th := map_f _ _. - by rewrite /= addbC; apply: IH (sat_tr m_th) _ _ eq_i; rewrite ?mem_trt. -apply/implyP; rewrite eq_j addbT => neq_i. -rewrite -[f in f _ kvs2]/(idfun _); set f := idfun _; rewrite /= in f *. -have [/= _ Ukvs2 kvsP] := satP m_th _ th_cl2. -move: Ukvs2; set kvs2' := kvs2; set mm := false. -have /allP: {subset kvs2' <= kvs2} by []. -pose lit12 k := (k, 1) \in kvs1 /\ (k, 1) \in kvs2. -have: mm -> {k | lit12 k & k \notin unzip1 kvs2'} by []. -elim: kvs2' mm => [|[k v2] kvs2' IH] //= mm mmP /andP[kvs2k /IH{IH}IHkvs]. -case/andP=> kvs2'k /IHkvs{IHkvs}IHkvs; case: ifP => [_ | /norP[]]. - by apply/IHkvs=> /mmP[kv kvs12kv /norP[]]; exists kv. -have [v1 /= kvs1k | //] := get_litP; case: eqP => // -> in kvs2k * => _ nz_v1. -case Dbb: (th_bbox th) (th_bboxP (bbox_refl (th_bbox th))) => [ri rj] rijP. -have [/andP[/=lti1r ltj1r] /andP[/=lti2r _]] := (rijP _ th_cl1, rijP _ th_cl2). -have rkP := th_dimP (leqnn _) _ th_cl1; have /= ltkr := rkP _ kvs1k. -have symP := unsat_match (Sym [:: i2; i1] [:: j1] _) _ _ m m_th. -rewrite /= Dbb lti1r lti2r ltj1r inE eq_sym neq_i /= in symP. -have [Dv1 | v1_neq1] /= := altP eqP; first rewrite Dv1 in kvs1k. - case: ifP => [/mmP[k0 [kvs1k0 kvs2k0]] | _]; last by apply: IHkvs; exists k. - case/norP=> k'k0; have [/=] := symP [:: k0; k] _ _ unsat_II. - rewrite inE k'k0 ltkr (rkP _ kvs1k0) /= andbT; apply/andP; split; apply/hasP. - by exists (i1, j1, kvs1) => //=; rewrite eqxx kvs1k kvs1k0. - by exists (i2, j2, kvs2) => //=; rewrite (eqP eq_j) eqxx kvs2k kvs2k0. -have{nz_v1 v1_neq1} Dv1: v1 = -1; last rewrite Dv1 in kvs1k. - by case: (v1) nz_v1 v1_neq1 (norm_lit m_th th_cl1 kvs1k) => [[|[]] | []]. -have[] := symP [:: k] _ _ unsat_J; rewrite /= ltkr !andbT /=; apply/andP; split. - by apply/hasP; exists (i1, j1, kvs1); rewrite //= eqxx kvs1k. -by apply/hasP; exists (i2, j2, kvs2); rewrite //= (eqP eq_j) eqxx kvs2k. -Qed. - -(* This is the combinatorial core of Peterfalvi (3.5.4). *) -(* We have made a few simplifications to the combinatorial analysis in the *) -(* text: we omit the (unused) step (3.5.4.4) entirely, which lets us inline *) -(* step (3.5.4.1) in the proof of (3.5.4.2); we clear the assumptions on b31 *) -(* and b32 before the final step (3.5.4.5), exposing a hidden symmetry. *) -Let unsat_Ii : unsat |= & x1 in b11 & x1 in b21 & ~x1 in b31. -Proof. -uwlog Db11: (& b11 = x1 + x2 + x3) by do 2!fill b11. -uwlog Db21: (& b21 = x1 + x4 + x5). - by uhave ~x2, ~x3 in b21 as L(21, 11); do 2!fill b21; uexact Db21. -uwlog Db31: (& b31 = x2 + x4 + x6). - uwlog b31x2: x2 | ~x2 in b31 as L(31, 11). - by uhave x3 in b31 as O(31, 11); symmetric to b31x2. - uwlog b31x4: x4 | ~x4 in b31 as L(31, 21). - by uhave x5 in b31 as O(31, 21); symmetric to b31x4. - uhave ~x3 in b31 as O(31, 11); uhave ~x5 in b31 as L(31, 21). - by fill b31; uexact Db31. -consider b41; uwlog b41x1: x1 | ~x1 in b41 as L(41, 11). - uwlog Db41: (& b41 = x3 + x5 + x6) => [|{b41x1}]. - uhave ~x2 | x2 in b41 as L(41, 11); last symmetric to b41x1. - uhave ~x4 | x4 in b41 as L(41, 21); last symmetric to b41x1. - uhave x3 in b41 as O(41, 11); uhave x5 in b41 as O(41, 21). - by uhave x6 in b41 as O(41, 31); uexact Db41. - consider b12; uwlog b12x1: x1 | ~x1 in b12 as L(12, 11). - uhave ~x2 | x2 in b12 as L(12, 11); last symmetric to b12x1. - by uhave x3 in b12 as O(12, 11); symmetric to b12x1. - uwlog b12x4: -x4 | ~x4 in b12 as O(12, 21). - by uhave -x5 in b12 as O(12, 21); symmetric to b12x4. - uhave ~x2, ~x3 in b12 as L(12, 11); uhave ~x5 in b12 as O(12, 21). - by uhave x6 in b12 as O(12, 31); counter to O(12, 41). -uwlog Db41: (& b41 = x1 + x6 + x7). - uhave ~x2, ~x3 in b41 as L(41, 11); uhave ~x4, ~x5 in b41 as L(41, 21). - by uhave x6 in b41 as O(41, 31); fill b41; uexact Db41. -consider b32; uwlog Db32: (& b32 = x6 - x7 + x8). - uwlog b32x6: x6 | ~x6 in b32 as L(32, 31). - uhave ~x2 | x2 in b32 as L(32, 31); last symmetric to b32x6. - by uhave x4 in b32 as O(32, 31); symmetric to b32x6. - uhave ~x2, ~x4 in b32 as L(32, 31). - uhave -x7 | ~x7 in b32 as O(32, 41). - uhave ~x1 in b32 as O(32, 41); uhave ~x3 in b32 as O(32, 11). - by uhave ~x5 in b32 as O(32, 21); fill b32; uexact Db32. - uhave -x1 in b32 as O(32, 41). - by uhave x3 in b32 as O(32, 11); counter to O(32, 21). -consider b42; uwlog Db42: (& b42 = x6 - x4 + x5). - uhave ~x6 | x6 in b42 as L(42, 41). - uhave ~x7 | x7 in b42 as L(42, 41); last counter to O(42, 32). - uhave x1 in b42 as O(42, 41); uhave x8 in b42 as O(42, 32). - uhave ~x2 | -x2 in b42 as O(42, 11); last counter to O(42, 21). - by uhave -x3 in b42 as O(42, 11); counter to O(42, 21). - uwlog b42x4: -x4 | ~x4 in b42 as O(42, 31). - by uhave -x2 in b42 as O(42, 31); symmetric to b42x4. - by uhave ~x1 in b42 as L(42, 41); uhave x5 in b42 as O(42, 21); uexact Db42. -uwlog Db32: (& ? in b32); first uexact Db32. -uwlog Db41: (& ? in b41); first uexact Db41. -consider b12; uwlog b12x5: x5 | ~x5 in b12 as L(12, 42). - uhave ~x6 | x6 in b12 as L(12, 42); last by consider b22; symmetric to b12x5. - uhave -x4 in b12 as O(12, 42); uhave x1 in b12 as O(12, 21). - by uhave ~x2 in b12 as L(12, 11); counter to O(12, 31). -uhave ~x6 in b12 as L(12, 42); uhave ~x4 in b12 as O(12, 42). -uhave ~x2 in b12 as O(12, 31). -by uhave -x1 in b12 as O(12, 21); counter to L(12, 11). -Qed. - -Let unsat_C : unsat |= & x1 in b11 & x1 in b21 & x1 in b12. -Proof. -consider b31; uwlog Db21: (& b21 = x1 + x2 + x3) by do 2!fill b21. -uwlog Db12: (& b12 = x1 - x2 + x4). - uwlog b21x2: -x2 | ~x2 in b12 as O(12, 21). - by uhave -x3 in b12 as O(12, 21); symmetric to b21x2. - by uhave ~x3 in b12 as O(12, 21); fill b12; uexact Db12. -uwlog Db31: (& b31 = x1 - x4 + x5). - uhave x1 | ~x1 in b31 as L(31, 21); last uexact unsat_Ii. - uhave ~x2, ~x3 in b31 as L(31, 21). - by uhave -x4 in b31 as O(31, 12); fill b31; uexact Db31. -consider b41; uhave x1 | ~x1 in b41 as L(41, 21); last symmetric to unsat_Ii. -uhave ~x5 in b41 as L(41, 31); uhave ~x4 in b41 as O(41, 31). -by uhave ~x2 in b41 as L(41, 21); counter to O(41, 12). -Qed. - -(* This refinement of Peterfalvi (3.5.4) is the essential part of (3.5.5). *) -Let column_pivot (m : model G) (j0 : 'I_m.2.+1) : - exists dk, forall (i : 'I_m.1.+1) (j : 'I_m.2.+1), - j0 != 0 -> i != 0 -> j != 0 -> '[m (i.-1, j.-1), dchi dk] = (j == j0)%:R. -Proof. -pose t_i (i0 i1 : nat) := [eta id with i0 |-> i1, i1 |-> i0]. -pose t_ij i0 i1 ij : ref := (t_i i0 i1 ij.1, ij.2). -have t_iK i0 i1: involutive (t_i i0 i1). - move=> i /=; have [-> | i0'i] := altP (i =P i0). - by rewrite eqxx; case: eqP. - by have [-> | /negPf->] := altP (i =P i1); rewrite ?eqxx // ifN. -have lt_t_i i0 i1 ri i: (i0 <= i1 < ri)%N -> (t_i i0 i1 i < ri)%N = (i < ri)%N. - case/andP=> le_i01 lti1 /=. - by do 2?case: eqP => [-> | _] //; rewrite ?(leq_trans _ lti1). -have t_mP i0 i1 (m0 : model G): - (i0 <= i1 < m0.1)%N -> is_Lmodel m0 (m0 \o t_ij i0 i1). -- have [lbm0 Zm0 Dm0] := LmodelP m0; split=> //= ij1 ij2 wf_ij1 wf_ij2. - by rewrite Dm0 /dot_ref ?(can_eq (t_iK _ _)) // !inE ?lt_t_i. -pose t_m i0 i1 m0 lti01 := Model (t_mP i0 i1 m0 lti01) (RmodelP m0). -without loss suffices{j0 lt_t_i} IHm: m / - exists dk, {in wf_ref m, forall ij, '[m ij, dchi dk] = (ij.2 == 0%N)%:R}. -- have [_ | nzj0] := altP eqP; first by exists (dirr1 G). - have ltj0: (j0.-1 < m.2)%N by rewrite prednK ?lt0n ?leq_ord. - have{IHm} [dk Ddk] := IHm (tr_model (t_m 0%N j0.-1 (tr_model m) ltj0)). - exists dk => i j _ nzi nzj; rewrite -[j.-1](t_iK 0%N j0.-1). - rewrite (Ddk (_, _)) ?inE ?lt_t_i // ?prednK ?lt0n ?leq_ord //. - by rewrite (inv_eq (t_iK _ _)) -eqSS !prednK ?lt0n. -pose cl11 := & b11 = x1 + x2 + x3. -without loss m_th: m / sat m |= cl11 & ? in b21. - move=> IHm; suffices{IHm}: sat m |= & ? in b11 & ? in b21. - have fill_b11 := sat_fill _ (mem_nth cl11 (_ : 1 < _))%N. - by do 3![case/fill_b11=> // ?]; apply: IHm. - have [[_ _ m1gt2 /ltnW m2gt0 _] _ _] := LmodelP m. - by rewrite /sat /= -!andbA /= m2gt0 -(subnKC m1gt2). -without loss{m_th} m_th: m / sat m |= & x1 in b11 & x1 in b21. - pose sat123P := @allP _ (fun k => sat_lit m _ (k, _)) (rev (iota 0 3)). - have [m123 | ] := altP (sat123P b21 0). - suffices: sat m |= cl11 & ~x1, ~x2, ~x3 in b21 by move/(O(21, 11)). - by rewrite /sat /= {1}/sat_cl /= !m123. - case/allPn=> k k012 /negP nz_m21 IHm; rewrite -[sat_lit _ _ _]andbT in nz_m21. - have ltk3: (k < 3)%N by rewrite mem_rev mem_iota in k012. - have [[/andP[/allP/=n1m _] Zm] [_ /= m_gt2 _]] := (RmodelP m, and3P m_th). - have ltk := leq_trans ltk3 m_gt2. - have{n1m Zm} mkP: is_Rmodel [:: m`_k]. - by split=> [|_ /predU1P[->|//]]; rewrite /orthonormal /= ?n1m ?Zm ?mem_nth. - pose mk := Model (LmodelP m) mkP; apply: {IHm}(IHm mk). - have{m_th} [v lit_v m_th] := sat_cases k m_th (mem_head _ _) ltk. - suffices: sat mk |= & x1 in b11 & (Lit 1 v) in b21. - by case/or4P: lit_v m_th => // /eqP-> => [/and4P[] | | _ /(L(21,11))]. - have [m_bb _ m_b21 /sat123P m_b11 _] := and5P m_th. - by apply/and5P; split; rewrite // /sat_cl /= [sat_lit _ _ _]m_b11. -have /dIrrP[dk Ddk]: m`_0 \in dirr G. - have [[/andP[/allP n1m _] Zm] [_ m_gt0 _]] := (RmodelP m, and3P m_th). - by rewrite dirrE Zm ?[_ == 1]n1m ?mem_nth. -exists dk => [][i j] /andP[/= lti ltj]; apply/eqP. -suffices{dk Ddk}: sat_cl m (& (Lit 1 (j == 0))%N in (i, j)). - by rewrite /sat_cl /= andbT /sat_lit Ddk. -without loss{i lti} ->: m i ltj m_th / i = 0%N. - have [bb21_m m_gt0 m11_x1 m21_x1 _] := and5P m_th. - move=> IHi; suffices{IHi} m_i1_x1: sat_lit m (i, 0)%N x1 && true. - apply: (IHi (t_m 0%N i m lti) 0%N); rewrite /sat /sat_cl //= bb21_m m_gt0. - by rewrite /= m_i1_x1 /sat_lit /= andbT /t_ij /=; case: ifP. - case i_gt1: (1 < i)%N; last by case: (i) i_gt1 => [|[|[]]]. - have itv_i: (1 < i < m.1)%N by [apply/andP]; pose m2 := t_m 2 i m itv_i. - have m2_th: sat m2 |= & x1 in b11 & x1 in b21 & ? in b31. - rewrite /sat m_gt0 -andbA (leq_trans _ lti) ?(leq_trans _ ltj) /sat_cl //=. - by rewrite /sat_lit /= -(subnKC i_gt1); have [_ _] := and3P m_th. - have [v] := sat_cases _ m2_th (mem_head _ _) m_gt0; rewrite !inE. - by case/or3P=> /eqP-> => [/unsat_Ii | /and4P[] | /(L(31,11))]. -have [-> | nzj] := posnP j; first by case/and5P: m_th. -without loss{ltj nzj} ->: m j m_th / j = 1%N. - have itv_j: (0 < j < m.2)%N by rewrite nzj. - move/(_ (tr_model (t_m _ j (tr_model m) itv_j)) _ _ (erefl _)) => /=. - by rewrite /sat /sat_cl /sat_lit /= -(prednK nzj) => ->. -have{m_th}[/= _ m_gt0 m_x1] := and3P m_th. -have{m_x1} m_th: sat m |= & x1 in b11 & x1 in b21 & ? in b12. - by rewrite /sat m_gt0 /sub_bbox; have [[_ _ -> ->]] := LmodelP m. -have [v] := sat_cases 0%N m_th (mem_head _ _) m_gt0; rewrite !inE. -by case/or3P=> /eqP-> => [/and4P[] | /unsat_C | /(L(12,11))]. -Qed. - -(* This is Peterfalvi (3.5). *) -(* We have inlined part of the proof of (3.5.5) in this main proof, replacing *) -(* some combinatorial arguments with direct computation of the dot product, *) -(* this avoids the duplicate case analysis required to exploit (3.5.5) as it *) -(* is stated in the text. *) -Lemma cyclicTIiso_basis_exists : - exists xi_ : Iirr W1 -> Iirr W2 -> 'CF(G), - [/\ xi_ 0 0 = 1, forall i j, xi_ i j \in 'Z[irr G], - forall i j, i != 0 -> j != 0 -> - 'Ind (alpha_ i j) = 1 - xi_ i 0 - xi_ 0 j + xi_ i j - & forall i1 j1 i2 j2, '[xi_ i1 j1, xi_ i2 j2] = ((i1, j1) == (i2, j2))%:R]. -Proof. -(* Instantiate the abstract theory vertically and horizontally. *) -pose beta i j : 'CF(G) := 'Ind[G] (alpha_ i j) - 1. -have Zbeta i j: beta i j \in 'Z[irr G]. - by rewrite rpredB ?rpred1 ?cfInd_vchar ?cfCycTI_vchar. -have o_alphaG_1 i j: i != 0 -> j != 0 -> '['Ind[G] (alpha_ i j), 1] = 1. - by move=> nz_i nz_j; rewrite -cfdot_Res_r rmorph1 cfdot_alpha_1. -have o_beta_1 i j: i != 0 -> j != 0 -> '[beta i j, 1] = 0. - by move=> nzi nzj; rewrite cfdotBl o_alphaG_1 // cfnorm1 subrr. -have o_beta i1 j1 i2 j2 : i1 != 0 -> j1 != 0 -> i2 != 0 -> j2 != 0 -> - '[beta i1 j1, beta i2 j2] = ((i1 == i2).+1 * (j1 == j2).+1 - 1)%:R. -- move=> nzi1 nzj1 nzi2 nzj2; rewrite mulSnr addnS mulnSr /=. - rewrite cfdotBr o_beta_1 // subr0 cfdotBl (cfdotC 1) o_alphaG_1 //. - rewrite (normedTI_isometry tiV) ?cfCycTI_on // rmorph1 addrC. - rewrite (alphaE i2) cfdotDr !cfdotBr cfdot_alpha_1 // -!addrA addKr addrA. - rewrite addrC cfdot_alpha_w // subn1 -addnA !natrD mulnb; congr (_ + _). - rewrite alphaE -w_00 !(cfdotBl, cfdotDl) !cfdot_w !eqxx !(eq_sym 0). - rewrite (negPf nzi1) (negPf nzj1) (negPf nzi2) (negPf nzj2) /= !andbF !andbT. - by rewrite !addr0 !subr0 !opprB !subr0. -pose beta_fun := [fun ij => beta (inord ij.1.+1) (inord ij.2.+1)]. -have beta_modelP: is_Lmodel ((Nirr W1).-1, (Nirr W2).-1) beta_fun. - split=> [ | //= | ij1 ij2 /=/andP[lti1 ltj1] /andP[lti2 ltj2]]. - by rewrite -!(ltnS 2) -eqSS NirrW1 NirrW2. - by rewrite o_beta -?val_eqE /= ?inordK. -pose beta_model := Model beta_modelP (nil_RmodelP G). -have betaE i j: i != 0 -> j != 0 -> beta i j = beta_fun (i.-1, j.-1). - by move=> nzi nzj /=; rewrite !prednK ?lt0n ?inord_val. -have /fin_all_exists [dXi0 betaXi0] i0: exists dX, i0 != 0 -> - forall i j, i != 0 -> j != 0 -> '[beta i j, dchi dX] = (i == i0)%:R. -- have [/= dX DdX] := @column_pivot (tr_model beta_model) i0. - by exists dX => nzi0 i j nzi nzj; rewrite betaE ?DdX. -have /fin_all_exists [dX0j betaX0j] j0: exists dX, j0 != 0 -> - forall i j, i != 0 -> j != 0 -> '[beta i j, dchi dX] = (j == j0)%:R. -- have [dX DdX] := @column_pivot beta_model j0. - by exists dX => nzj0 i j nzi nzj; rewrite betaE ?DdX. -pose Xi0 j := dchi (dXi0 j); pose X0j i := dchi (dX0j i). -(* Construct the orthonormal family xi_ i j. *) -pose xi_ i j := if i == 0 then if j == 0 then 1 else - X0j j else - if j == 0 then - Xi0 i else beta i j - Xi0 i - X0j j. -exists xi_; split=> [| i j | i j nzi nzj | i1 j1 i2 j2]. -- by rewrite /xi_ !eqxx. -- rewrite /xi_; do 2!case: ifP => _; rewrite ?rpred1 ?rpredN ?dchi_vchar //. - by rewrite 2?rpredB ?dchi_vchar. -- by rewrite /xi_ /= !ifN // addrCA subrK addrACA subrK addrA addrK. -have o_dchi i j dk1 dk2 (phi := beta i j): - '[phi, dchi dk1] = 1 -> '[phi, dchi dk2] = 0 -> '[dchi dk1, dchi dk2] = 0. -- move=> phi1 phi0; have /eqP: 1 != 0 :> algC := oner_neq0 _. - rewrite -phi1 cfdot_dchi; do 2!case: eqP => [->|_]; rewrite ?subrr //. - by rewrite dchi_ndirrE cfdotNr phi0 oppr0. -have [nzi01 nzj01] := (Iirr1_neq0 ntW1, Iirr1_neq0 ntW2). -have X0j_1 j: j != 0 -> '[X0j j, 1] = 0. - by move=> nzj; rewrite -dchi1 (o_dchi #1 j) ?betaX0j ?eqxx ?dchi1 ?o_beta_1. -have Xi0_1 i: i != 0 -> '[Xi0 i, 1] = 0. - by move=> nzi; rewrite -dchi1 (o_dchi i #1) ?betaXi0 ?eqxx ?dchi1 ?o_beta_1. -have Xi0_X0j i j: i != 0 -> j != 0 -> '[Xi0 i, X0j j] = 0. - move=> nzi nzj; pose j' := conjC_Iirr j. - apply: (o_dchi i j'); rewrite (betaX0j, betaXi0) ?conjC_Iirr_eq0 ?eqxx //. - by rewrite -(inj_eq irr_inj) conjC_IirrE mulrb ifN ?odd_eq_conj_irr1 ?irr_eq1. -have X0j_X0j j j0: j != 0 -> j0 != 0 -> '[X0j j, X0j j0] = (j == j0)%:R. - move=> nzj nzj0; case: (altP eqP) => [-> | j0'j]; first exact: cfnorm_dchi. - by apply: (o_dchi #1 j); rewrite ?betaX0j ?eqxx ?(negPf j0'j). -have Xi0_Xi0 i i0: i != 0 -> i0 != 0 -> '[Xi0 i, Xi0 i0] = (i == i0)%:R. - move=> nzi nzi0; case: (altP eqP) => [-> | i0'i]; first exact: cfnorm_dchi. - by apply: (o_dchi i #1); rewrite ?betaXi0 ?eqxx ?(negPf i0'i). -have oxi_00 i j: '[xi_ i j, xi_ 0 0] = ((i == 0) && (j == 0))%:R. - rewrite /xi_; case: ifPn => [_ | nzi]. - by case: ifPn => [_ | nzj]; rewrite ?cfnorm1 // cfdotNl X0j_1 ?oppr0. - case: ifPn => [_ | nzj]; first by rewrite cfdotNl Xi0_1 ?oppr0. - by rewrite 2!cfdotBl o_beta_1 ?X0j_1 ?Xi0_1 ?subr0. -have oxi_0j i j j0: '[xi_ i j, xi_ 0 j0] = ((i == 0) && (j == j0))%:R. - rewrite /xi_; have [-> | nzj0] := altP (j0 =P 0); first exact: oxi_00. - rewrite cfdotNr; case: ifPn => [_ | nzi]. - have [-> | nzj] := altP eqP; last by rewrite cfdotNl opprK X0j_X0j. - by rewrite cfdotC X0j_1 // conjC0 oppr0 mulrb ifN_eqC. - have [_ | nzj] := ifPn; first by rewrite cfdotNl Xi0_X0j ?oppr0. - by rewrite 2!cfdotBl Xi0_X0j // subr0 betaX0j ?X0j_X0j // subrr oppr0. -have{oxi_00} oxi_i0 i j i0: '[xi_ i j, xi_ i0 0] = ((i == i0) && (j == 0))%:R. - rewrite /xi_; have [-> | nzi0] := altP (i0 =P 0); first exact: oxi_00. - rewrite cfdotNr andbC; have [_ | nzj] := boolP (j == 0). - have [-> | nzi] := altP eqP; last by rewrite cfdotNl opprK Xi0_Xi0. - by rewrite cfdotC Xi0_1 // conjC0 oppr0 mulrb ifN_eqC. - have [_ | nzi] := ifPn; first by rewrite cfdotNl opprK cfdotC Xi0_X0j ?conjC0. - rewrite 2!cfdotBl betaXi0 ?Xi0_Xi0 // subrr add0r opprK. - by rewrite cfdotC Xi0_X0j // conjC0. -have [-> | nzi2] := altP (i2 =P 0); first exact: oxi_0j. -have [-> | nzj2] := altP (j2 =P 0); first exact: oxi_i0. -rewrite cfdotC eq_sym; apply: canLR (@conjCK _) _; rewrite rmorph_nat. -have [-> | nzi1] := altP (i1 =P 0); first exact: oxi_0j. -have [-> | nzj1] := altP (j1 =P 0); first exact: oxi_i0. -have ->: xi_ i1 j1 = beta i1 j1 + xi_ i1 0 + xi_ 0 j1 by rewrite /xi_ !ifN. -rewrite 2!cfdotDr oxi_i0 oxi_0j andbC /xi_ (negPf nzi2) (negPf nzj2) !addr0. -rewrite eq_sym xpair_eqE cfdotC 2!cfdotBr o_beta // betaXi0 ?betaX0j //. -by rewrite -!CintrE /= rmorph_int; do 2!case: (_ == _). -Qed. - -End CyclicTIisoBasis. - -(* This is PeterFalvi, Theorem (3.2)(a, b, c). *) -Theorem cyclicTIiso_exists : - {sigma : 'Hom(cfun_vectType W, cfun_vectType G) | - [/\ {in 'Z[irr W], isometry sigma, to 'Z[irr G]}, sigma 1 = 1 - & {in 'CF(W, V), forall phi : 'CF(W), sigma phi = 'Ind[G] phi}]}. -Proof. -pose sigmaVP f := ('CF(W, V) <= lker (linfun f - linfun 'Ind[G]))%VS. -pose sigmaP f := [&& orthonormal (map f (irr W)), f 1 == 1 & sigmaVP f]. -pose sigma_base f := [seq (dchi (f k) : 'CF(G)) | k : Iirr W]. -pose sigma_spec f := sigmaP (sval (linear_of_free (irr W) (sigma_base f))). -suffices /sigW[f /and3P[]]: exists f : {ffun _}, sigma_spec f. - case: linear_of_free => /=sigma Dsigma o1sigma /eqP sigma1 /eqlfun_inP sigmaV. - exists (linfun sigma); split=> [|| phi /sigmaV]; try by rewrite !lfunE. - do [rewrite size_map !size_tuple => /(_ (irr_free W) (card_ord _))] in Dsigma. - have [inj_sigma dot_sigma] := orthonormalP o1sigma. - rewrite -(map_tnth_enum (irr W)) -map_comp in Dsigma inj_sigma. - move/eq_in_map in Dsigma; move/injectiveP in inj_sigma. - split=> [|_ /zchar_tuple_expansion[z Zz ->]]. - apply: isometry_in_zchar=> _ _ /irrP[k1 ->] /irrP[k2 ->] /=. - by rewrite !lfunE dot_sigma ?map_f ?mem_irr // cfdot_irr (inj_eq inj_sigma). - rewrite linear_sum rpred_sum // => k _; rewrite linearZ rpredZ_Cint //=. - by rewrite -tnth_nth lfunE [sigma _]Dsigma ?mem_enum ?dchi_vchar. -have [xi_ [xi00 Zxi Dxi o1xi]] := cyclicTIiso_basis_exists. -pose f := [ffun k => dirr_dIirr (prod_curry xi_) (inv_dprod_Iirr defW k)]. -exists f; apply/and3P; case: linear_of_free => /= sigma Dsigma. -have{f Dsigma} Deta i j: sigma (w_ i j) = xi_ i j. - rewrite /w_ -tnth_map /= (tnth_nth 0) /=. - rewrite Dsigma ?irr_free //; last by rewrite !size_tuple card_ord. - rewrite nth_mktuple ffunE dprod_IirrK dirr_dIirrE // => {i j} [[i j]] /=. - by rewrite dirrE Zxi o1xi !eqxx. -have sigma1: sigma 1 = 1 by rewrite -w_00 Deta. -rewrite sigma1 /sigmaVP -(span_basis cfWVbasis); split=> //. - rewrite map_orthonormal ?irr_orthonormal //; apply: isometry_in_zchar. - move=> _ _ /cycTIirrP[i1 [j1 ->]] /cycTIirrP[i2 [j2 ->]] /=. - by rewrite !Deta o1xi cfdot_w. -apply/span_subvP=> _ /imageP[[i j] /setXP[nzi nzj] ->]; rewrite !inE in nzi nzj. -rewrite memv_ker !lfun_simp /= subr_eq0 Dxi //. -by rewrite alphaE linearD !linearB sigma1 !Deta. -Qed. - -Fact cyclicTIiso_key : unit. Proof. by []. Qed. -Definition cyclicTIiso := - locked_with cyclicTIiso_key (lfun_linear (sval cyclicTIiso_exists)). -Local Notation sigma := cyclicTIiso. -Let im_sigma := map sigma (irr W). -Let eta_ i j := sigma (w_ i j). - -Lemma cycTI_Zisometry : {in 'Z[irr W], isometry sigma, to 'Z[irr G]}. -Proof. by rewrite [sigma]unlock; case: cyclicTIiso_exists => ? []. Qed. - -Let Isigma : {in 'Z[irr W] &, isometry sigma}. -Proof. by case: cycTI_Zisometry. Qed. -Let Zsigma : {in 'Z[irr W], forall phi, sigma phi \in 'Z[irr G]}. -Proof. by case: cycTI_Zisometry. Qed. - -Lemma cycTIisometry : isometry sigma. -Proof. -move=> phi psi; have [[a ->] [b ->]] := (cfun_irr_sum phi, cfun_irr_sum psi). -rewrite !linear_sum !cfdot_suml; apply: eq_bigr => i _. -rewrite !cfdot_sumr; apply: eq_bigr => j _. -by rewrite !linearZ !cfdotZl !cfdotZr /= Isigma ?irr_vchar. -Qed. - -Lemma cycTIiso_vchar i j : eta_ i j \in 'Z[irr G]. -Proof. by rewrite Zsigma ?irr_vchar. Qed. - -Lemma cfdot_cycTIiso i1 i2 j1 j2 : - '[eta_ i1 j1, eta_ i2 j2] = ((i1 == i2) && (j1 == j2))%:R. -Proof. by rewrite cycTIisometry. Qed. - -Lemma cfnorm_cycTIiso i j : '[eta_ i j] = 1. -Proof. by rewrite cycTIisometry cfnorm_irr. Qed. - -Lemma cycTIiso_dirr i j : eta_ i j \in dirr G. -Proof. by rewrite dirrE cycTIiso_vchar /= cfnorm_cycTIiso. Qed. - -Lemma cycTIiso_orthonormal : orthonormal im_sigma. -Proof. by rewrite map_orthonormal ?irr_orthonormal. Qed. - -Lemma cycTIiso_eqE i1 i2 j1 j2 : - (eta_ i1 j1 == eta_ i2 j2) = ((i1 == i2) && (j1 == j2)). -Proof. -have /inj_in_eq-> := Zisometry_inj Isigma; try exact: irr_vchar. -by rewrite (inj_eq irr_inj) (inj_eq (dprod_Iirr_inj _)). -Qed. - -Lemma cycTIiso_neqN i1 i2 j1 j2 : (eta_ i1 j1 == - eta_ i2 j2) = false. -Proof. -rewrite -addr_eq0; apply/eqP=> /(congr1 (cfdot (eta_ i1 j1)))/eqP. -by rewrite cfdot0r cfdotDr !cfdot_cycTIiso !eqxx -mulrS pnatr_eq0. -Qed. - -Lemma cycTIiso1 : sigma 1 = 1. -Proof. by rewrite [sigma]unlock; case: cyclicTIiso_exists => ? []. Qed. - -Lemma cycTIiso_Ind : {in 'CF(W, V), forall phi, sigma phi = 'Ind[G, W] phi}. -Proof. by rewrite [sigma]unlock; case: cyclicTIiso_exists => ? []. Qed. - -Let sigma_Res_V : - [/\ forall phi, {in V, sigma phi =1 phi} - & forall psi : 'CF(G), orthogonal psi im_sigma -> {in V, psi =1 \0}]. -Proof. -have sigW i j : '[sigma 'chi_i, sigma 'chi_j] = (i == j)%:R. - by rewrite cycTIisometry cfdot_irr. -have [j | sigmaV sigma'V] := equiv_restrict_compl_ortho sWG nsVW cfWVbasis sigW. - rewrite /= -/cfWVbase -(eq_bigr _ (fun _ _ => linearZ _ _)) /= -linear_sum. - rewrite -cfun_sum_cfdot cycTIiso_Ind //. - by rewrite (basis_mem cfWVbasis) ?mem_nth ?size_image. -split=> [phi v Vv | psi /orthoPl o_psi_sigma]. - rewrite [phi]cfun_sum_cfdot linear_sum !sum_cfunE. - by apply: eq_bigr => k _; rewrite linearZ !cfunE sigmaV. -by apply: sigma'V => k; rewrite o_psi_sigma ?map_f ?mem_irr. -Qed. - -(* This is Peterfalvi, Theorem (3.2)(d). *) -Theorem cycTIiso_restrict phi : {in V, sigma phi =1 phi}. -Proof. by case: sigma_Res_V. Qed. - -(* This is Peterfalvi, Theorem (3.2)(e). *) -Theorem ortho_cycTIiso_vanish (psi : 'CF(G)) : - orthogonal psi im_sigma -> {in V, forall x, psi x = 0}. -Proof. by case: sigma_Res_V psi. Qed. - -(* This is PeterFalvi (3.7). *) -Lemma cycTIiso_cfdot_exchange (psi : 'CF(G)) i1 i2 j1 j2 : - {in V, forall x, psi x = 0} -> - '[psi, eta_ i1 j1] + '[psi, eta_ i2 j2] - = '[psi, eta_ i1 j2] + '[psi, eta_ i2 j1]. -Proof. -move=> psiV_0; pose phi : 'CF(W) := w_ i1 j1 + w_ i2 j2 - w_ i1 j2 - w_ i2 j1. -have Vphi: phi \in 'CF(W, V). - apply/cfun_onP=> g; rewrite inE negb_and negbK !inE orbC. - case/or3P=> [/cfun0-> // | W1g | W2g]; apply/eqP; rewrite !cfunE subr_eq0. - by rewrite addrC -[g]mulg1 /w_ !dprod_IirrE !cfDprodE ?lin_char1 ?addKr. - by rewrite -[g]mul1g /w_ !dprod_IirrE !cfDprodE ?lin_char1 ?addrK. -suffices: '[psi, 'Ind[G] phi] == 0. - rewrite -!cycTIiso_Ind // !linearB !linearD !cfdotBr !cfdotDr. - by rewrite -addrA -opprD subr_eq0 => /eqP. -rewrite (cfdotEr _ (cfInd_on sWG Vphi)) big1 ?mulr0 //. -by move=> _ /imset2P[x y Vx Gy ->]; rewrite cfunJ ?psiV_0 ?mul0r. -Qed. - -(* This is NC as defined in PeterFalvi (3.6). *) -Definition cyclicTI_NC phi := #|[set ij | '[phi, eta_ ij.1 ij.2] != 0]|. -Local Notation NC := cyclicTI_NC. - -Lemma cycTI_NC_opp (phi : 'CF(G)) : (NC (- phi)%R = NC phi)%N. -Proof. by apply: eq_card=> [[i j]]; rewrite !inE cfdotNl oppr_eq0. Qed. - -Lemma cycTI_NC_sign (phi : 'CF(G)) n : (NC ((-1) ^+ n *: phi)%R = NC phi)%N. -Proof. -elim: n=> [|n IH]; rewrite ?(expr0,scale1r) //. -by rewrite exprS -scalerA scaleN1r cycTI_NC_opp. -Qed. - -Lemma cycTI_NC_iso i j : NC (eta_ i j) = 1%N. -Proof. -rewrite -(cards1 (i, j)); apply: eq_card => [[i1 j1]]; rewrite !inE /=. -rewrite cfdot_cycTIiso //= pnatr_eq0 (can_eq oddb _ false) eqbF_neg negbK. -by rewrite -xpair_eqE eq_sym. -Qed. - -Lemma cycTI_NC_irr i : (NC 'chi_i <= 1)%N. -Proof. -apply: wlog_neg; rewrite -ltnNge => /ltnW/card_gt0P[[i1 j1]]. -rewrite inE cfdot_dirr ?(irr_dirr, cycTIiso_dirr) //=. -case: ('chi_i =P _) => [-> | _]; first by rewrite cycTI_NC_opp cycTI_NC_iso. -by case: ('chi_i =P _)=> [-> | _]; rewrite (cycTI_NC_iso, eqxx). -Qed. - -Lemma cycTI_NC_dirr f : f \in dirr G -> (NC f <= 1)%N. -Proof. by case/dirrP=> b [i ->]; rewrite cycTI_NC_sign cycTI_NC_irr. Qed. - -Lemma cycTI_NC_dchi di : (NC (dchi di) <= 1)%N. -Proof. by rewrite cycTI_NC_dirr ?dirr_dchi. Qed. - -Lemma cycTI_NC_0 : NC 0 = 0%N. -Proof. by apply: eq_card0 => ij; rewrite !inE cfdot0l eqxx. Qed. - -Lemma cycTI_NC_add n1 n2 phi1 phi2 : - (NC phi1 <= n1 -> NC phi2 <= n2 -> NC (phi1 + phi2)%R <= n1 + n2)%N. -Proof. -move=> ub1 ub2; apply: leq_trans {ub1 ub2}(leq_add ub1 ub2). -rewrite -cardsUI -[NC _]addn0 leq_add // subset_leq_card //. -apply/subsetP=> [[i j]]; rewrite !inE /= -negb_and cfdotDl. -by apply: contra => /andP[/eqP-> /eqP->]; rewrite addr0. -Qed. - -Lemma cycTI_NC_sub n1 n2 phi1 phi2 : - (NC phi1 <= n1 -> NC phi2 <= n2 -> NC (phi1 - phi2)%R <= n1 + n2)%N. -Proof. by move=> ub1 ub2; rewrite cycTI_NC_add ?cycTI_NC_opp. Qed. - -Lemma cycTI_NC_scale_nz a phi : a != 0 -> NC (a *: phi) = NC phi. -Proof. -move=> nz_a; apply: eq_card => ij. -by rewrite !inE cfdotZl mulf_eq0 negb_or nz_a. -Qed. - -Lemma cycTI_NC_scale a phi n : (NC phi <= n -> NC (a *: phi) <= n)%N. -Proof. -have [-> _ | /cycTI_NC_scale_nz-> //] := eqVneq a 0. -by rewrite scale0r cycTI_NC_0. -Qed. - -Lemma cycTI_NC_norm phi n : - phi \in 'Z[irr G] -> '[phi] <= n%:R -> (NC phi <= n)%N. -Proof. -move=> Zphi ub_phi; apply: leq_trans (_ : #|dirr_constt phi| <= n)%N. - rewrite {1}[phi]cfun_sum_dconstt // -sum1_card. - elim/big_rec2: _ => [|/= i n1 phi1 _]; first by rewrite cycTI_NC_0. - by apply: cycTI_NC_add; rewrite cycTI_NC_scale ?cycTI_NC_dchi. -rewrite -leC_nat (ler_trans _ ub_phi) ?cnorm_dconstt // -sumr_const. -apply: ler_sum => i phi_i; rewrite sqr_Cint_ge1 ?Cint_Cnat ?Cnat_dirr //. -by rewrite gtr_eqF -?dirr_consttE. -Qed. - -(* This is PeterFalvi (3.8). *) -Lemma small_cycTI_NC phi i0 j0 (a0 := '[phi, eta_ i0 j0]) : - {in V, forall x, phi x = 0} -> (NC phi < 2 * minn w1 w2)%N -> a0 != 0 -> - (forall i j, '[phi, eta_ i j] = (j == j0)%:R * a0) - \/ (forall i j, '[phi, eta_ i j] = (i == i0)%:R * a0). -Proof. -pose a i j := '[phi, eta_ i j]; pose A := [set ij | a ij.1 ij.2 != 0]. -rewrite -[NC phi]/#|A| ltnNge => phiV_0 ubA nz_a0. -have{phiV_0} Da i2 j2 i1 j1 : a i1 j1 = a i1 j2 + a i2 j1 - a i2 j2. - by rewrite cycTIiso_cfdot_exchange ?addrK. -have ubA2: ~~ (w2 + w1 <= #|A| + 2)%N. - rewrite addnC addn2 -ltnS (contra _ ubA) //; apply: (@leq_trans _ _.+3). - rewrite odd_geq /= ?odd_add ?oddW1 ?oddW2 // mul2n -addn_min_max -addnn. - by rewrite uphalf_double leq_add2l gtn_min !leq_max !ltnn orbF -neq_ltn. -(* This is step (3.8.1). *) -have Za i1 i2 j1 j2 : a i1 j2 == 0 -> a i2 j1 == 0 -> a i1 j1 == 0. - have [-> // | /negPf i2'1 /eqP Za12 /eqP Za21] := eqVneq i1 i2. - apply: contraR ubA2 => nz_a11. - pose L := [set (if a i1 j == 0 then i2 else i1, j) | j : Iirr W2]. - pose C := [set (i, if a i j1 == 0 then j2 else j1) | i : Iirr W1]. - have [<- <-]: #|L| = w2 /\ #|C| = w1 by rewrite !card_imset // => ? ? []. - have <-: #|[set (i1, j1); (i2, j2)]| = 2 by rewrite cards2 xpair_eqE i2'1. - rewrite -cardsUI leq_add ?subset_leq_card //; last first. - apply/subsetP=> _ /setIP[/imsetP[j _ ->] /imsetP[i _ []]]. - by case: ifP => _ <- ->; rewrite !inE ?Za21 ?(negPf nz_a11) !eqxx ?orbT. - apply/subsetP=> ij /setUP[] /imsetP[] => [j | i] _ {ij}->; rewrite inE. - by case: ifPn => // /eqP Za1j; rewrite (Da i1 j1) Za21 Za1j !add0r oppr_eq0. - by case: ifPn => // /eqP Zai1; rewrite (Da i1 j1) Za12 Zai1 !add0r oppr_eq0. -pose L i := [set ij | ij.1 == i] :&: A; pose C j := [set ij | ij.2 == j] :&: A. -have{ubA2} ubLC i j: (#|L i| + #|C j| != w2 + w1)%N. - apply: contraNneq ubA2 => <-; rewrite addnS leqW // -cardsUI -setIUl -setIIl. - rewrite -(card1 (i, j)) leq_add ?subset_leq_card ?subsetIr //. - by apply/subsetP=> ij /setIP[]; rewrite !inE. -have lbA L1 L2: L1 :&: L2 =i set0 -> (#|L1 :&: A| + #|L2 :&: A| <= #|A|)%N. - rewrite -cardsUI -setIUl -setIIl => /setP->. - by rewrite set0I cards0 addn0 subset_leq_card ?subsetIr. -have oL i1: ~~ [exists j, a i1 j == 0] -> #|L i1| = w2. - rewrite negb_exists => /forallP nz_a1. - transitivity #|predX (pred1 i1) (Iirr W2)|; last by rewrite cardX card1 mul1n. - by apply/eq_card=> ij; rewrite !inE andbT andb_idr // => /eqP->. -have oC i1 j1 j2 : a i1 j1 != 0 -> a i1 j2 == 0 -> #|C j1| = w1. - move=> nz_a11 /(Za i1)/contra/(_ nz_a11) nz_a1. - transitivity #|predX (Iirr W1) (pred1 j1)|; last by rewrite cardX card1 muln1. - by apply/eq_card=> ij; rewrite !inE andb_idr // => /eqP->. -(* This is step (3.8.2). *) -have [/existsP[j1 Za01] | /oL oL0] := boolP [exists j, a i0 j == 0]. - have j0'1 : j1 != j0 by apply: contraTneq Za01 => ->. - have oC0: #|C j0| = w1 by apply: oC nz_a0 Za01. - suffices Za0 i j: j != j0 -> a i j = 0. - left=> i j; rewrite -/(a i j) mulr_natl mulrb; have [->|/Za0//] := altP eqP. - by rewrite (Da i0 j1) !(Za0 _ j1) // subr0 add0r. - move=> j0'j; apply: contraNeq (ubLC i j0) => nz_aij; rewrite oC0 oL //. - apply: contra ubA => /existsP[_ /Za/contra/(_ nz_aij) nz_a_j]. - rewrite minn_mulr geq_min mul2n -addnn -{2}oC0 -(oC i0 j j1) ?lbA // => ij. - by rewrite !inE; apply/andP=> [[/eqP-> /idPn]]. -(* This is step (3.8.3). *) -suffices Za0 i j: i != i0 -> a i j = 0. - right=> i j; rewrite -/(a i j) mulr_natl mulrb; have [->|/Za0//] := altP eqP. - have /card_gt0P[i1 i0'i]: (0 < #|predC1 i0|)%N. - by rewrite cardC1 nirrW1 -(subnKC w1gt2). - by rewrite (Da i1 j0) !(Za0 i1) // subr0 addr0. -move=> i0'i; suffices /existsP[j1 Zai1]: [exists j, a i j == 0]. - by apply: contraNeq (ubLC i0 j) => /oC/(_ Zai1)->; rewrite oL0. -apply: contraR ubA; rewrite minn_mulr geq_min orbC mul2n -addnn => /oL{1}<-. -by rewrite -oL0 lbA // => ij; rewrite !inE; apply/andP=> [[/eqP-> /idPn]]. -Qed. - -(* A weaker version of PeterFalvi (3.8). *) -Lemma cycTI_NC_minn (phi : 'CF(G)) : - {in V, forall x, phi x = 0} -> (0 < NC phi < 2 * minn w1 w2)%N -> - (minn w1 w2 <= NC phi)%N. -Proof. -move=> phiV_0 /andP[/card_gt0P[[i0 j0]]]; rewrite inE /= => nz_a0 ubNC. -pose L := [seq (i0, j) | j : Iirr W2]; pose C := [seq (i, j0) | i : Iirr W1]. -have [oL oC]: #|L| = w2 /\ #|C| = w1 by rewrite !card_image // => i j []. -have [Da | Da] := small_cycTI_NC phiV_0 ubNC nz_a0. - rewrite geq_min -oC subset_leq_card //. - by apply/subsetP=> _ /codomP[i ->]; rewrite !inE /= Da eqxx mul1r. -rewrite geq_min orbC -oL subset_leq_card //. -by apply/subsetP=> _ /codomP[j ->]; rewrite !inE /= Da eqxx mul1r. -Qed. - -(* Another consequence of (3.8), used in (4.8), (10.5), (10.10) and (11.8). *) -Lemma eq_signed_sub_cTIiso phi e i j1 j2 : - let rho := (-1) ^+ e *: (eta_ i j1 - eta_ i j2) in - phi \in 'Z[irr G] -> '[phi] = 2%:R -> j1 != j2 -> - {in V, phi =1 rho} -> phi = rho. -Proof. -set rho := _ - _; move: phi => phi0 /= Zphi0 n2phi0 neq_j12 eq_phi_rho. -pose phi := (-1) ^+ e *: phi0; pose psi := phi - rho. -have{eq_phi_rho} psiV0 z: z \in V -> psi z = 0. - by move=> Vz; rewrite !cfunE eq_phi_rho // !cfunE signrMK subrr. -have{Zphi0} Zphi: phi \in 'Z[irr G] by rewrite rpredZsign. -have{n2phi0} n2phi: '[phi] = 2%:R by rewrite cfnorm_sign. -have Zrho: rho \in 'Z[irr G] by rewrite rpredB ?cycTIiso_vchar. -have n2rho: '[rho] = 2%:R. - by rewrite cfnormBd !cfdot_cycTIiso ?eqxx ?(negPf neq_j12) ?andbF. -have [oIphi _ Dphi] := dirr_small_norm Zphi n2phi isT. -have [oIrho _ Drho] := dirr_small_norm Zrho n2rho isT. -set Iphi := dirr_constt _ in oIphi Dphi. -set Irho := dirr_constt _ in oIrho Drho. -suffices /eqP eqIrho: Irho == Iphi by rewrite Drho eqIrho -Dphi signrZK. -have psi_phi'_lt0 di: di \in Irho :\: Iphi -> '[psi, dchi di] < 0. - case/setDP=> rho_di phi'di; rewrite cfdotBl subr_lt0. - move: rho_di; rewrite dirr_consttE; apply: ler_lt_trans. - rewrite real_lerNgt -?dirr_consttE ?real0 ?Creal_Cint //. - by rewrite Cint_cfdot_vchar ?dchi_vchar. -have NCpsi: (NC psi < 2 * minn w1 w2)%N. - suffices NCpsi4: (NC psi <= 2 + 2)%N. - by rewrite (leq_ltn_trans NCpsi4) // !addnn mul2n ltn_double leq_min w1gt2. - by rewrite cycTI_NC_sub // cycTI_NC_norm ?n2phi ?n2rho. -pose rhoId := dirr_dIirr (fun sk => (-1) ^+ (sk.1 : bool) *: eta_ i sk.2). -have rhoIdE s k: dchi (rhoId (s, k)) = (-1) ^+ s *: eta_ i k. - by apply: dirr_dIirrE => sk; rewrite rpredZsign cycTIiso_dirr. -rewrite eqEcard oIrho oIphi andbT -setD_eq0; apply/set0Pn=> [[dk1 phi'dk1]]. -have [[rho_dk1 _] psi_k1_lt0] := (setDP phi'dk1, psi_phi'_lt0 _ phi'dk1). -have dot_dk1: '[rho, dchi dk1] = 1. - rewrite Drho cfdot_suml (big_setD1 dk1) //= cfnorm_dchi big1 ?addr0 //. - move=> dk2 /setD1P[/negPf dk1'2 /dirr_constt_oppl]; rewrite cfdot_dchi dk1'2. - by case: eqP => [-> /negP[] | _ _]; rewrite ?subrr ?ndirrK. -have dot_dk2: 0 < '[rho, rho - dchi dk1]. - by rewrite cfdotBr dot_dk1 n2rho addrK ltr01. -have{dot_dk1 dot_dk2} [s [k Dk1 rho_k2]]: - exists s, exists2 k, rhoId (s, k.1) = dk1 & rhoId (~~ s, k.2) \in Irho. -- move/cfdot_add_dirr_eq1: dot_dk1. - rewrite dirr_dchi rpredN !cycTIiso_dirr //. - case=> // Dk1; [exists false, (j1, j2) | exists true, (j2, j1)]; - try apply: dirr_inj; rewrite ?dirr_consttE rhoIdE scaler_sign //=. - + by rewrite addrC Dk1 addKr in dot_dk2. - by rewrite Dk1 addrK in dot_dk2. -rewrite -Dk1 rhoIdE cfdotZr rmorph_sign in psi_k1_lt0. -have psi_k1_neq0: '[psi, eta_ i k.1] != 0. - by rewrite -(can_eq (signrMK s)) mulr0 ltr_eqF. -set dk2 := rhoId _ in rho_k2. -have NCk2'_le1 (dI : {set _}): - dk2 \in dI -> #|dI| = 2%N -> (NC (\sum_(dk in dI :\ dk2) dchi dk)%R <= 1)%N. -- rewrite (cardsD1 dk2) => -> /eqP/cards1P[dk ->]. - by rewrite big_set1 cycTI_NC_dirr ?dirr_dchi. -suffices /psi_phi'_lt0/ltr_geF/idP[]: dk2 \in Irho :\: Iphi. - rewrite rhoIdE cfdotZr signrN rmorphN mulNr oppr_ge0 rmorph_sign. - have := small_cycTI_NC psiV0 NCpsi psi_k1_neq0. - by case=> // ->; rewrite mulrCA nmulr_lle0 ?ler0n. -have: (1 + 1 < NC psi)%N. - apply (@leq_trans (minn w1 w2)); first by rewrite leq_min w1gt2. - apply: cycTI_NC_minn => //; rewrite NCpsi /NC. - by rewrite (cardsD1 (i, k.1)) inE /= psi_k1_neq0. -rewrite inE rho_k2 andbT ltnNge; apply: contra => phi_k2. -rewrite /psi Drho (big_setD1 dk2) //= Dphi (big_setD1 dk2) //=. -by rewrite addrAC opprD addNKr addrC cycTI_NC_sub ?NCk2'_le1. -Qed. - -(* This is PeterFalvi (3.9)(a). *) -Lemma eq_in_cycTIiso (i : Iirr W) (phi : 'CF(G)) : - phi \in dirr G -> {in V, phi =1 'chi_i} -> phi = sigma 'chi_i. -Proof. -move=> Dphi; rewrite -(inv_dprod_IirrK defW i). -case: (inv_dprod_Iirr _)=> /= i1 j1 EphiC. -pose psi : 'CF(G) := eta_ i1 j1 - phi. -have ZpsiV: {in V, forall g, psi g = 0}=> [g GiV|]. - by rewrite /psi !cfunE cycTIiso_restrict // -(EphiC _ GiV) subrr. -pose a i j := '[psi, eta_ i j]; pose S := [set ij | a ij.1 ij.2 != 0]. -case: (boolP ((i1, j1) \in S))=> [I1J1iS|]; last first. - rewrite inE negbK /a cfdotBl cfdot_cycTIiso !eqxx /=. - rewrite cfdot_dirr ?(irr_dirr, cycTIiso_dirr) //. - case: (boolP (phi == _))=> [|_]. - by rewrite opprK -(natrD _ 1 1) pnatr_eq0. - case: (boolP (phi == _))=> [/eqP //|]. - by rewrite subr0 oner_eq0. -have SPos : (0 < #|S|)%N by rewrite (cardD1 (i1,j1)) I1J1iS. -have SLt: (#|S| <= 2)%N. - by rewrite -[2]add1n cycTI_NC_sub // !cycTI_NC_dirr // cycTIiso_dirr. -have: (0 < #|S| < 2 * minn w1 w2)%N. - rewrite SPos; apply: leq_ltn_trans SLt _. - by rewrite -{1}[2%N]muln1 ltn_mul2l /= leq_min ![(1 < _)%N]ltnW. -move/(cycTI_NC_minn ZpsiV); rewrite leqNgt; case/negP. -by apply: leq_ltn_trans SLt _; rewrite leq_min w1gt2. -Qed. - -(* This is the second part of Peterfalvi (3.9)(a). *) -Lemma cfAut_cycTIiso u phi : cfAut u (sigma phi) = sigma (cfAut u phi). -Proof. -rewrite [phi]cfun_sum_cfdot !raddf_sum; apply: eq_bigr => ij _. -rewrite /= !(linearZ, cfAutZ) /= -aut_IirrE; congr (_ *: _) => {phi}. -apply: eq_in_cycTIiso => [|x Vx /=]. - by have /cycTIirrP[i [j ->]] := mem_irr ij; rewrite dirr_aut cycTIiso_dirr. -by rewrite cfunE cycTIiso_restrict // aut_IirrE cfunE. -Qed. - -Section AutCyclicTI. - -Variable iw : Iirr W. -Let w := 'chi_iw. -Let a := #[w]%CF. - -Let Zsigw : sigma w \in 'Z[irr G]. -Proof. by have [_ -> //] := cycTI_Zisometry; apply: irr_vchar. Qed. - -Let lin_w: w \is a linear_char := Wlin iw. - -(* This is Peterfalvi (3.9)(b). *) -Lemma cycTIiso_aut_exists k : - coprime k a -> - [/\ exists u, sigma (w ^+ k) = cfAut u (sigma w) - & forall x, coprime #[x] a -> sigma (w ^+ k) x = sigma w x]. -Proof. -case/(make_pi_cfAut G)=> u Du_a Du_a'. -suffices Dwk: sigma (w ^+ k) = cfAut u (sigma w). - by split=> [|x co_x_a]; [exists u | rewrite Dwk Du_a']. -rewrite cfAut_cycTIiso; congr (sigma _); apply/cfun_inP=> x Wx. -have Wxbar: coset _ x \in (W / cfker w)%G by rewrite mem_quotient. -rewrite exp_cfunE // cfunE -cfQuoEker //. -rewrite -lin_charX ?cfQuo_lin_char ?cfker_normal // -Du_a ?cfunE //. - by rewrite char_vchar ?cfQuo_char ?irr_char. -by rewrite [a]cforder_lin_char // dvdn_exponent. -Qed. - -(* This is Peterfalvi (3.9)(c). *) -Lemma Cint_cycTIiso_coprime x : coprime #[x] a -> sigma w x \in Cint. -Proof. -move=> co_x_a; apply: Cint_rat_Aint (Aint_vchar _ Zsigw). -have [Qb galQb [QbC AutQbC [w_b genQb memQb]]] := group_num_field_exists <[x]>. -have{memQb} [wx Dwx]: exists wx, sigma w x = QbC wx. - have /memQb Qbx := dvdnn #[x]. - have [sw1 /Qbx[wx1 Dwx1] [sw2 /Qbx[wx2 Dwx2] ->]] := vcharP _ Zsigw. - by exists (wx1 - wx2); rewrite rmorphB !cfunE Dwx1 Dwx2. -suffices: wx \in fixedField 'Gal({:Qb} / 1). - rewrite Dwx (galois_fixedField galQb) ?subvf // => /vlineP[z ->]. - by rewrite -in_algE fmorph_eq_rat fmorph_rat Crat_rat. -apply/fixedFieldP=> [|v_b _]; first exact: memvf. -have [v Dv] := AutQbC v_b; apply: (fmorph_inj QbC); rewrite Dv -Dwx. -have [u uQb uQb'] := dvd_restrict_cfAut (W / cfker w) #[x] v. -transitivity (sigma (cfAut u w) x); first by rewrite -cfAut_cycTIiso cfunE -uQb. -congr (sigma _ _); apply/cfun_inP=> y Wy; rewrite cfunE -cfQuoEker //. -rewrite uQb' ?char_vchar ?cfQuo_char ?irr_char // coprime_sym. -apply: coprime_dvdr co_x_a; rewrite [a]cforder_lin_char //. -by rewrite dvdn_exponent ?mem_quotient. -Qed. - -End AutCyclicTI. - -End Three. - -Arguments ortho_cycTIiso_vanish [gT G W W1 W2 defW] ctiW [psi]. - -Section ThreeSymmetry. - -Variables (gT : finGroupType) (G W W1 W2 : {group gT}). -Implicit Types (defW : W1 \x W2 = W) (xdefW : W2 \x W1 = W). -Local Notation sigma_ := (@cyclicTIiso gT G W _ _). -Local Notation w_ defW i j := (cyclicTIirr defW i j). - -Lemma cycTIisoC defW xdefW ctiW xctiW i j : - @sigma_ defW ctiW (w_ defW i j) = @sigma_ xdefW xctiW (w_ xdefW j i). -Proof. -apply: eq_in_cycTIiso; first exact: cycTIiso_dirr. -by rewrite /cyclicTIset setUC cyclicTIirrC; apply: cycTIiso_restrict. -Qed. - -Lemma cycTIiso_irrelC defW xdefW ctiW xctiW : - @sigma_ defW ctiW = @sigma_ xdefW xctiW. -Proof. -suffices: sigma_ ctiW =1 sigma_ xctiW by rewrite ![sigma_ _]unlock => /lfunP->. -move=> phi; have [z_ ->] := cfun_irr_sum phi; rewrite !linear_sum. -apply/eq_bigr=> ij _; have [i [j ->]] := cycTIirrP defW (mem_irr ij). -by rewrite !linearZ /= {1}cycTIisoC cyclicTIirrC. -Qed. - -Lemma cycTIiso_irrel defW defW' ctiW ctiW' : - @sigma_ defW ctiW = @sigma_ defW' ctiW'. -Proof. -have xdefW: W2 \x W1 = W by rewrite dprodC. -by rewrite !(cycTIiso_irrelC _ (cyclicTIhyp_sym ctiW xdefW)). -Qed. - -End ThreeSymmetry. diff --git a/mathcomp/odd_order/PFsection4.v b/mathcomp/odd_order/PFsection4.v deleted file mode 100644 index 3cdff96..0000000 --- a/mathcomp/odd_order/PFsection4.v +++ /dev/null @@ -1,994 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div choice. -From mathcomp -Require Import fintype tuple finfun bigop prime ssralg poly finset fingroup. -From mathcomp -Require Import morphism perm automorphism quotient action gfunctor gproduct. -From mathcomp -Require Import center commutator zmodp cyclic pgroup nilpotent hall frobenius. -From mathcomp -Require Import matrix mxalgebra mxrepresentation vector ssrnum algC classfun. -From mathcomp -Require Import character inertia vcharacter PFsection1 PFsection2 PFsection3. - -(******************************************************************************) -(* This file covers Peterfalvi, Section 4: The Dade isometry of a certain *) -(* type of subgroup. *) -(* Given defW : W1 \x W2 = W, we define here: *) -(* primeTI_hypothesis L K defW <-> *) -(* L = K ><| W1, where W1 acts in a prime manner on K (see *) -(* semiprime in frobenius.v), and both W1 and W2 = 'C_K(W1) *) -(* are nontrivial and cyclic of odd order; these conditions *) -(* imply that cyclicTI_hypothesis L defW holds. *) -(* -> This is Peterfalvi, Hypothesis (4.2), or Feit-Thompson (13.2). *) -(* prime_Dade_definition L K H A A0 defW <-> *) -(* A0 = A :|: class_support (cyclicTIset defW) L where A is *) -(* an L-invariant subset of K^# containing all the elements *) -(* of K that do not act freely on H <| L; in addition *) -(* W2 \subset H \subset K. *) -(* prime_Dade_hypothesis G L K H A A0 defW <-> *) -(* The four assumptions primeTI_hypothesis L K defW, *) -(* cyclicTI_hypothesis G defW, Dade_hypothesis G L A0 and *) -(* prime_Dade_definition L K H A A0 defW hold jointly. *) -(* -> This is Peterfalvi, Hypothesis (4.6), or Feit-Thompson (13.3) (except *) -(* that H is not required to be nilpotent, and the "supporting groups" *) -(* assumptions have been replaced by Dade hypothesis). *) -(* -> This hypothesis is one of the alternatives under which Sibley's *) -(* coherence theorem holds (see PFsection6.v), and is verified by all *) -(* maximal subgroups of type P in a minimal simple odd group. *) -(* -> prime_Dade_hypothesis coerces to Dade_hypothesis, cyclicTI_hypothesis, *) -(* primeTI_hypothesis and prime_Dade_definition. *) -(* For ptiW : primeTI_hypothesis L K defW we also define: *) -(* prime_cycTIhyp ptiW :: cyclicTI_hypothesis L defW (though NOT a coercion) *) -(* primeTIirr ptiW i j == the (unique) irreducible constituent of the image *) -(* (locally) mu2_ i j in 'CF(L) of w_ i j = cyclicTIirr defW i j under *) -(* the sigma = cyclicTIiso (prime_cycTIhyp ptiW). *) -(* primeTI_Iirr ptiW ij == the index of mu2_ ij.1 ij.2; indeed mu2_ i j is *) -(* just notation for 'chi_(primeTI_Iirr ptiW (i, j)). *) -(* primeTIsign ptiW j == the sign of mu2_ i j in sigma (w_ i j), which does *) -(* (locally) delta_ j not depend on i. *) -(* primeTI_Isign ptiW j == the boolean b such that delta_ j := (-1) ^+ b. *) -(* primeTIres ptiW j == the restriction to K of mu2_ i j, which is an *) -(* (locally) chi_ j irreducible character that does not depend on i. *) -(* primeTI_Ires ptiW j == the index of chi_ j := 'chi_(primeTI_Ires ptiW j). *) -(* primeTIred ptiW j == the (reducible) character equal to the sum of all *) -(* (locally) mu_ j the mu2_ i j, and also to 'Ind (chi_ j). *) -(* uniform_prTIred_seq ptiW k == the sequence of all the mu_ j, j != 0, with *) -(* the same degree as mu_ k (s.t. mu_ j 1 = mu_ k 1). *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope GRing.Theory Num.Theory. -Local Open Scope ring_scope. - -Section Four_1_to_2. - -(* This is Peterfalvi (4.1). *) - -Variable gT : finGroupType. - -Lemma vchar_pairs_orthonormal (X : {group gT}) (a b c d : 'CF(X)) u v : - {subset (a :: b) <= 'Z[irr X]} /\ {subset (c :: d) <= 'Z[irr X]} -> - orthonormal (a :: b) && orthonormal (c :: d) -> - [&& u \is Creal, v \is Creal, u != 0 & v != 0] -> - [&& '[a - b, u *: c - v *: d] == 0, - (a - b) 1%g == 0 & (u *: c - v *: d) 1%g == 0] -> - orthonormal [:: a; b; c; d]. -Proof. -have osym2 (e f : 'CF(X)) : orthonormal (e :: f) -> orthonormal (f :: e). - by rewrite !(orthonormal_cat [::_] [::_]) orthogonal_sym andbCA. -have def_o f S: orthonormal (f :: S) -> '[f : 'CF(X)] = 1. - by case/andP=> /andP[/eqP]. -case=> /allP/and3P[Za Zb _] /allP/and3P[Zc Zd _] /andP[o_ab o_cd]. -rewrite (orthonormal_cat (a :: b)) o_ab o_cd /=. -case/and4P=> r_u r_v nz_u nz_v /and3P[o_abcd ab1 cd1]. -wlog suff: a b c d u v Za Zb Zc Zd o_ab o_cd r_u r_v nz_u nz_v o_abcd ab1 cd1 / - '[a, c]_X == 0. -- move=> IH; rewrite /orthogonal /= !andbT (IH a b c d u v) //=. - have vc_sym (e f : 'CF(X)) : ((e - f) 1%g == 0) = ((f - e) 1%g == 0). - by rewrite -opprB cfunE oppr_eq0. - have ab_sym e: ('[b - a, e] == 0) = ('[a - b, e] == 0). - by rewrite -opprB cfdotNl oppr_eq0. - rewrite (IH b a c d u v) // 1?osym2 1?vc_sym ?ab_sym //=. - rewrite -oppr_eq0 -cfdotNr opprB in o_abcd. - by rewrite (IH a b d c v u) ?(IH b a d c v u) // 1?osym2 1?vc_sym ?ab_sym. -apply: contraLR cd1 => nz_ac. -have [/orthonormal2P[ab0 a1 b1] /orthonormal2P[cd0 c1 d1]] := (o_ab, o_cd). -have [ea [ia def_a]] := vchar_norm1P Za a1. -have{nz_ac} [e defc]: exists e : bool, c = (-1) ^+ e *: a. - have [ec [ic def_c]] := vchar_norm1P Zc c1; exists (ec (+) ea). - move: nz_ac; rewrite def_a def_c scalerA; rewrite -signr_addb addbK. - rewrite cfdotZl cfdotZr cfdot_irr mulrA mulrC mulf_eq0. - by have [-> // | _]:= ia =P ic; rewrite eqxx. -have def_vbd: v * '[b, d]_X = - ((-1) ^+ e * u). - apply/eqP; have:= o_abcd; rewrite cfdotDl cfdotNl !raddfB /=. - rewrite defc !cfdotZr a1 (cfdotC b) ab0 rmorph0 mulr1. - rewrite -[a]scale1r -{2}[1]/((-1) ^+ false) -(addbb e) signr_addb -scalerA. - rewrite -defc cfdotZl cd0 !mulr0 opprK addrA !subr0 mulrC addrC addr_eq0. - by rewrite rmorph_sign !conj_Creal. -have nz_bd: '[b, d] != 0. - move/esym/eqP: def_vbd; apply: contraTneq => ->. - by rewrite mulr0 oppr_eq0 mulf_eq0 signr_eq0. -have{nz_bd} defd: d = '[b, d] *: b. - move: nz_bd; have [eb [ib ->]] := vchar_norm1P Zb b1. - have [ed [id ->]] := vchar_norm1P Zd d1. - rewrite scalerA cfdotZl cfdotZr rmorph_sign mulrA cfdot_irr. - have [-> _ | _] := ib =P id; last by rewrite !mulr0 eqxx. - by rewrite mulr1 mulrAC -!signr_addb addbb. -rewrite defd scalerA def_vbd scaleNr opprK defc scalerA mulrC -raddfD cfunE. -rewrite !mulf_neq0 ?signr_eq0 // -(subrK a b) -opprB addrCA 2!cfunE. -rewrite (eqP ab1) oppr0 add0r cfunE -mulr2n -mulr_natl mulf_eq0 pnatr_eq0. -by rewrite /= def_a cfunE mulf_eq0 signr_eq0 /= irr1_neq0. -Qed. - -Corollary orthonormal_vchar_diff_ortho (X : {group gT}) (a b c d : 'CF(X)) : - {subset a :: b <= 'Z[irr X]} /\ {subset c :: d <= 'Z[irr X]} -> - orthonormal (a :: b) && orthonormal (c :: d) -> - [&& '[a - b, c - d] == 0, (a - b) 1%g == 0 & (c - d) 1%g == 0] -> - '[a, c] = 0. -Proof. -move=> Zabcd Oabcd; rewrite -[c - d]scale1r scalerBr. -move/(vchar_pairs_orthonormal Zabcd Oabcd) => /implyP. -rewrite rpred1 oner_eq0 (orthonormal_cat (a :: b)) /=. -by case/and3P=> _ _ /andP[] /andP[] /eqP. -Qed. - -(* This is Peterfalvi, Hypothesis (4.2), with explicit parameters. *) -Definition primeTI_hypothesis (L K W W1 W2 : {set gT}) of W1 \x W2 = W := - [/\ (*a*) [/\ K ><| W1 = L, W1 != 1, Hall L W1 & cyclic W1], - (*b*) [/\ W2 != 1, W2 \subset K & cyclic W2], - {in W1^#, forall x, 'C_K[x] = W2} - & (*c*) odd #|W|]%g. - -End Four_1_to_2. - -Arguments primeTI_hypothesis _ _%g _%g _%g _ _%g _%g. - -Section Four_3_to_5. - -Variables (gT : finGroupType) (L K W W1 W2 : {group gT}) (defW : W1 \x W2 = W). -Hypothesis ptiWL : primeTI_hypothesis L K defW. - -Let V := cyclicTIset defW. -Let w1 := #|W1|. -Let w2 := #|W2|. - -Let defL : K ><| W1 = L. Proof. by have [[]] := ptiWL. Qed. -Let ntW1 : W1 :!=: 1%g. Proof. by have [[]] := ptiWL. Qed. -Let cycW1 : cyclic W1. Proof. by have [[]] := ptiWL. Qed. -Let hallW1 : Hall L W1. Proof. by have [[]] := ptiWL. Qed. - -Let ntW2 : W2 :!=: 1%g. Proof. by have [_ []] := ptiWL. Qed. -Let sW2K : W2 \subset K. Proof. by have [_ []] := ptiWL. Qed. -Let cycW2 : cyclic W2. Proof. by have [_ []] := ptiWL. Qed. -Let prKW1 : {in W1^#, forall x, 'C_K[x] = W2}. Proof. by have [] := ptiWL. Qed. - -Let oddW : odd #|W|. Proof. by have [] := ptiWL. Qed. - -Let nsKL : K <| L. Proof. by case/sdprod_context: defL. Qed. -Let sKL : K \subset L. Proof. by case/andP: nsKL. Qed. -Let sW1L : W1 \subset L. Proof. by case/sdprod_context: defL. Qed. -Let sWL : W \subset L. -Proof. by rewrite -(dprodWC defW) -(sdprodW defL) mulgSS. Qed. -Let sW1W : W1 \subset W. Proof. by have /mulG_sub[] := dprodW defW. Qed. -Let sW2W : W2 \subset W. Proof. by have /mulG_sub[] := dprodW defW. Qed. - -Let coKW1 : coprime #|K| #|W1|. -Proof. by rewrite (coprime_sdprod_Hall_r defL). Qed. -Let coW12 : coprime #|W1| #|W2|. -Proof. by rewrite coprime_sym (coprimeSg sW2K). Qed. - -Let cycW : cyclic W. Proof. by rewrite (cyclic_dprod defW). Qed. -Let cWW : abelian W. Proof. exact: cyclic_abelian. Qed. -Let oddW1 : odd w1. Proof. exact: oddSg oddW. Qed. -Let oddW2 : odd w2. Proof. exact: oddSg oddW. Qed. - -Let ntV : V != set0. -Proof. -by rewrite -card_gt0 card_cycTIset muln_gt0 -!subn1 !subn_gt0 !cardG_gt1 ntW1. -Qed. - -Let sV_V2 : V \subset W :\: W2. Proof. by rewrite setDS ?subsetUr. Qed. - -Lemma primeTIhyp_quotient (M : {group gT}) : - (W2 / M != 1)%g -> M \subset K -> M <| L -> - {defWbar : (W1 / M) \x (W2 / M) = W / M - & primeTI_hypothesis (L / M) (K / M) defWbar}%g. -Proof. -move=> ntW2bar sMK /andP[_ nML]. -have coMW1: coprime #|M| #|W1| by rewrite (coprimeSg sMK). -have [nMW1 nMW] := (subset_trans sW1L nML, subset_trans sWL nML). -have defWbar: (W1 / M) \x (W2 / M) = (W / M)%g. - by rewrite (quotient_coprime_dprod nMW) ?quotient_odd. -exists defWbar; split; rewrite ?quotient_odd ?quotient_cyclic ?quotientS //. - have isoW1: W1 \isog W1 / M by rewrite quotient_isog ?coprime_TIg. - by rewrite -(isog_eq1 isoW1) ?morphim_Hall // (quotient_coprime_sdprod nML). -move=> Kx /setD1P[ntKx /morphimP[x nKx W1x defKx]] /=. -rewrite -cent_cycle -cycle_eq1 {Kx}defKx -quotient_cycle // in ntKx *. -rewrite -strongest_coprime_quotient_cent ?cycle_subG //; first 1 last. -- by rewrite subIset ?sMK. -- by rewrite (coprimeSg (subsetIl M _)) // (coprimegS _ coMW1) ?cycle_subG. -- by rewrite orbC abelian_sol ?cycle_abelian. -rewrite cent_cycle prKW1 // !inE W1x (contraNneq _ ntKx) // => ->. -by rewrite cycle1 quotient1. -Qed. - -(* This is the first part of PeterFalvi, Theorem (4.3)(a). *) -Theorem normedTI_prTIset : normedTI (W :\: W2) L W. -Proof. -have [[_ _ cW12 _] [_ _ nKW1 tiKW1]] := (dprodP defW, sdprodP defL). -have nV2W: W \subset 'N(W :\: W2) by rewrite sub_abelian_norm ?subsetDl. -have piW1_W: {in W1 & W2, forall x y, (x * y).`_\pi(W1) = x}. - move=> x y W1x W2y /=; rewrite consttM /commute ?(centsP cW12 y) //. - rewrite constt_p_elt ?(mem_p_elt _ W1x) ?pgroup_pi // (constt1P _) ?mulg1 //. - by rewrite /p_elt -coprime_pi' // (coprimegS _ coW12) ?cycle_subG. -have nzV2W: W :\: W2 != set0 by apply: contraNneq ntV; rewrite -subset0 => <-. -apply/normedTI_memJ_P; split=> // xy g V2xy Lg. -apply/idP/idP=> [| /(subsetP nV2W)/memJ_norm->//]. -have{xy V2xy} [/(mem_dprod defW)[x [y [W1x W2y -> _]]] W2'xy] := setDP V2xy. -have{W2'xy} ntx: x != 1%g by have:= W2'xy; rewrite groupMr // => /group1_contra. -have{g Lg} [k [w [Kk /(subsetP sW1W)Ww -> _]]] := mem_sdprod defL Lg. -rewrite conjgM memJ_norm ?(subsetP nV2W) ?(groupMr k) // => /setDP[Wxyk _]. -have{Wxyk piW1_W} W1xk: x ^ k \in W1. - have [xk [yk [W1xk W2yk Dxyk _]]] := mem_dprod defW Wxyk. - by rewrite -(piW1_W x y) // -consttJ Dxyk piW1_W. -rewrite (subsetP sW2W) // -(@prKW1 x) ?in_setD1 ?ntx // inE Kk /=. -rewrite cent1C (sameP cent1P commgP) -in_set1 -set1gE -tiKW1 inE. -by rewrite (subsetP _ _ (mem_commg W1x Kk)) ?commg_subr // groupM ?groupV. -Qed. - -(* Second part of PeterFalvi, Theorem (4.3)(a). *) -Theorem prime_cycTIhyp : cyclicTI_hypothesis L defW. -Proof. -have nVW: W \subset 'N(V) by rewrite sub_abelian_norm ?subsetDl. -by split=> //; apply: normedTI_S normedTI_prTIset. -Qed. -Local Notation ctiW := prime_cycTIhyp. -Let sigma := cyclicTIiso ctiW. -Let w_ i j := cyclicTIirr defW i j. - -Let Wlin k : 'chi[W]_k \is a linear_char. Proof. exact/irr_cyclic_lin. Qed. -Let W1lin i : 'chi[W1]_i \is a linear_char. Proof. exact/irr_cyclic_lin. Qed. -Let W2lin i : 'chi[W2]_i \is a linear_char. Proof. exact/irr_cyclic_lin. Qed. -Let w_lin i j : w_ i j \is a linear_char. Proof. exact: Wlin. Qed. - -Let nirrW1 : #|Iirr W1| = w1. Proof. exact: card_Iirr_cyclic. Qed. -Let nirrW2 : #|Iirr W2| = w2. Proof. exact: card_Iirr_cyclic. Qed. -Let NirrW1 : Nirr W1 = w1. Proof. by rewrite -nirrW1 card_ord. Qed. -Let NirrW2 : Nirr W2 = w2. Proof. by rewrite -nirrW2 card_ord. Qed. -Let w1gt1 : (1 < w1)%N. Proof. by rewrite cardG_gt1. Qed. - -Let cfdot_w i1 j1 i2 j2 : '[w_ i1 j1, w_ i2 j2] = ((i1 == i2) && (j1 == j2))%:R. -Proof. exact: cfdot_dprod_irr. Qed. - -(* Witnesses for Theorem (4.3)(b). *) -Fact primeTIdIirr_key : unit. Proof. by []. Qed. -Definition primeTIdIirr_def := dirr_dIirr (sigma \o prod_curry w_). -Definition primeTIdIirr := locked_with primeTIdIirr_key primeTIdIirr_def. -Definition primeTI_Iirr ij := (primeTIdIirr ij).2. -Definition primeTI_Isign j := (primeTIdIirr (0, j)).1. -Local Notation Imu2 := primeTI_Iirr. -Local Notation mu2_ i j := 'chi_(primeTI_Iirr (i, j)). -Local Notation delta_ j := (GRing.sign algCring (primeTI_Isign j)). - -Let ew_ i j := w_ i j - w_ 0 j. -Let V2ew i j : ew_ i j \in 'CF(W, W :\: W2). -Proof. -apply/cfun_onP=> x; rewrite !inE negb_and negbK => /orP[W2x | /cfun0->//]. -by rewrite -[x]mul1g !cfunE /w_ !dprod_IirrE !cfDprodE ?lin_char1 ?subrr. -Qed. - -(* This is Peterfalvi, Theorem (4.3)(b, c). *) -Theorem primeTIirr_spec : - [/\ (*b*) injective Imu2, - forall i j, 'Ind (ew_ i j) = delta_ j *: (mu2_ i j - mu2_ 0 j), - forall i j, sigma (w_ i j) = delta_ j *: mu2_ i j, - (*c*) forall i j, {in W :\: W2, mu2_ i j =1 delta_ j *: w_ i j} - & forall k, k \notin codom Imu2 -> {in W :\: W2, 'chi_k =1 \0}]. -Proof. -have isoV2 := normedTI_isometry normedTI_prTIset (setDSS sWL (sub1G W2)). -have /fin_all_exists2[dmu injl_mu Ddmu] j: - exists2 dmu : bool * {ffun Iirr W1 -> Iirr L}, injective dmu.2 - & forall i, 'Ind (ew_ i j) = dchi (dmu.1, dmu.2 i) - dchi (dmu.1, dmu.2 0). -- pose Sj := [tuple w_ i j | i < Nirr W1]. - have Sj0: Sj`_0 = w_ 0 j by rewrite (nth_mktuple _ 0 0). - have irrSj: {subset Sj <= irr W} by move=> ? /mapP[i _ ->]; apply: mem_irr. - have: {in 'Z[Sj, W :\: W2], isometry 'Ind, to 'Z[irr L, L^#]}. - split=> [|phi]; first by apply: sub_in2 isoV2; apply: zchar_on. - move/(zchar_subset irrSj)/(zchar_onS (setDS W (sub1G W2))). - by rewrite !zcharD1E cfInd1 // mulf_eq0 orbC => /andP[/cfInd_vchar-> // ->]. - case/vchar_isometry_base=> // [|||i|mu Umu [d Ddmu]]; first by rewrite NirrW1. - + rewrite orthonormal_free // (sub_orthonormal irrSj) ?irr_orthonormal //. - by apply/injectiveP=> i1 i2 /irr_inj/dprod_Iirr_inj[]. - + by move=> _ /mapP[i _ ->]; rewrite Sj0 !lin_char1. - + by rewrite nth_mktuple Sj0 V2ew. - exists (d, [ffun i => tnth mu i]) => [|i]. - apply/injectiveP; congr (uniq _): Umu. - by rewrite (eq_map (ffunE _)) map_tnth_enum. - by rewrite -scalerBr /= !ffunE !(tnth_nth 0 mu) -Ddmu nth_mktuple Sj0. -pose Imu ij := (dmu ij.2).2 ij.1; pose mu i j := 'chi_(Imu (i, j)). -pose d j : algC := (-1) ^+ (dmu j).1. -have{Ddmu} Ddmu i j: 'Ind (ew_ i j) = d j *: (mu i j - mu 0 j). - by rewrite Ddmu scalerBr. -have{injl_mu} inj_Imu: injective Imu. - move=> [i1 j1] [i2 j2]; rewrite /Imu /=; pose S i j k := mu i j :: mu k j. - have [-> /injl_mu-> // | j2'1 /eqP/negPf[] /=] := eqVneq j1 j2. - apply/(can_inj oddb)/eqP; rewrite -eqC_nat -cfdot_irr -!/(mu _ _) mulr0n. - have oIew_j12 i k: '['Ind[L] (ew_ i j1), 'Ind[L] (ew_ k j2)] = 0. - by rewrite isoV2 // cfdotBl !cfdotBr !cfdot_w (negPf j2'1) !andbF !subr0. - have defSd i j k: mu i j - mu k j = d j *: ('Ind (ew_ i j) - 'Ind (ew_ k j)). - by rewrite !Ddmu -scalerBr signrZK opprB addrA subrK. - have Sd1 i j k: (mu i j - mu k j) 1%g == 0. - by rewrite defSd !(cfunE, cfInd1) ?lin_char1 // !subrr mulr0. - have exS i j: {k | {subset S i j k <= 'Z[irr L]} & orthonormal (S i j k)}. - have:= w1gt1; rewrite -nirrW1 (cardD1 i) => /card_gt0P/sigW[k /andP[i'k _]]. - exists k; first by apply/allP; rewrite /= !irr_vchar. - apply/andP; rewrite /= !cfdot_irr !eqxx !andbT /=. - by rewrite (inj_eq (injl_mu j)) mulrb ifN_eqC. - have [[k1 ZS1 o1S1] [k2 ZS2 o1S2]] := (exS i1 j1, exS i2 j2). - rewrite (orthonormal_vchar_diff_ortho (conj ZS1 ZS2)) ?o1S1 ?Sd1 ?andbT //. - by rewrite !defSd cfdotZl cfdotZr cfdotBl !cfdotBr !oIew_j12 !subrr !mulr0. -pose V2base := [tuple of [seq ew_ ij.1 ij.2 | ij in predX (predC1 0) predT]]. -have V2basis: basis_of 'CF(W, W :\: W2) V2base. - suffices V2free: free V2base. - rewrite basisEfree V2free size_image /= cardX cardC1 nirrW1 nirrW2 -subn1. - rewrite mulnBl mul1n dim_cfun_on_abelian ?subsetDl //. - rewrite cardsD (setIidPr _) // (dprod_card defW) leqnn andbT. - by apply/span_subvP=> _ /mapP[ij _ ->]. - apply/freeP=> /= z zV2e0 k. - move Dk: (enum_val k) (enum_valP k) => [i j] /andP[/= nz_i _]. - rewrite -(cfdot0l (w_ i j)) -{}zV2e0 cfdot_suml (bigD1 k) //= cfdotZl. - rewrite nth_image Dk cfdotBl !cfdot_w !eqxx eq_sym (negPf nz_i) subr0 mulr1. - rewrite big1 ?addr0 // => k1; rewrite -(inj_eq enum_val_inj) {}Dk nth_image. - case: (enum_val k1) => /= i1 j1 ij'ij1. - rewrite cfdotZl cfdotBl !cfdot_dprod_irr [_ && _](negPf ij'ij1). - by rewrite eq_sym (negPf nz_i) subr0 mulr0. -have nsV2W: W :\: W2 <| W by rewrite -sub_abelian_normal ?subsetDl. -pose muW k := let: ij := inv_dprod_Iirr defW k in d ij.2 *: mu ij.1 ij.2. -have inW := codomP (dprod_Iirr_onto defW _). -have ImuW k1 k2: '[muW k1, muW k2] = (k1 == k2)%:R. - have [[[i1 j1] -> {k1}] [[i2 j2] -> {k2}]] := (inW k1, inW k2). - rewrite cfdotZl cfdotZr !dprod_IirrK (can_eq (dprod_IirrK _)) /= rmorph_sign. - rewrite cfdot_irr (inj_eq inj_Imu (_, _) (_, _)) -/(d _). - by case: eqP => [[_ ->] | _]; rewrite ?signrMK ?mulr0. -have [k|muV2 mu'V2] := equiv_restrict_compl_ortho sWL nsV2W V2basis ImuW. - rewrite nth_image; case: (enum_val k) (enum_valP k) => /= i j /andP[/= nzi _]. - pose inWj i1 := dprod_Iirr defW (i1, j); rewrite (bigD1 (inWj 0)) //=. - rewrite (bigD1 (inWj i)) ?(can_eq (dprod_IirrK _)) ?xpair_eqE ?(negPf nzi) //. - rewrite /= big1 ?addr0 => [|k1 /andP[]]; last first. - rewrite !(eq_sym k1); have [[i1 j1] -> {k1}] := inW k1. - rewrite !(can_eq (dprod_IirrK _)) => ij1'i ij1'0. - by rewrite cfdotBl !cfdot_w !mulrb !ifN // subrr scale0r. - rewrite /muW !dprod_IirrK /= addrC !cfdotBl !cfdot_w !eqxx /= !andbT. - by rewrite eq_sym (negPf nzi) subr0 add0r scaleNr !scale1r -scalerBr. -have Dsigma i j: sigma (w_ i j) = d j *: mu i j. - apply/esym/eq_in_cycTIiso=> [|x Vx]; first exact: (dirr_dchi (_, _)). - by rewrite -muV2 ?(subsetP sV_V2) // /muW dprod_IirrK. -have /all_and2[Dd Dmu] j: d j = delta_ j /\ forall i, Imu (i, j) = Imu2 (i, j). - suffices DprTI i: primeTIdIirr (i, j) = ((dmu j).1, (dmu j).2 i). - by split=> [|i]; rewrite /primeTI_Isign /Imu2 DprTI. - apply: dirr_inj; rewrite /primeTIdIirr unlock_with dirr_dIirrE /= ?Dsigma //. - by case=> i1 j1; apply: cycTIiso_dirr. -split=> [[i1 j1] [i2 j2] | i j | i j | i j x V2x | k mu2p'k]. -- by rewrite -!Dmu => /inj_Imu. -- by rewrite -!Dmu -Dd -Ddmu. -- by rewrite -Dmu -Dd -Dsigma. -- by rewrite cfunE -muV2 // /muW dprod_IirrK Dd cfunE signrMK -Dmu. -apply: mu'V2 => k1; have [[i j] ->{k1}] := inW k1. -apply: contraNeq mu2p'k; rewrite cfdotZr rmorph_sign mulf_eq0 signr_eq0 /=. -rewrite /mu Dmu dprod_IirrK -irr_consttE constt_irr inE /= => /eqP <-. -exact: codom_f. -Qed. - -(* These lemmas restate the various parts of Theorem (4.3)(b, c) separately. *) -Lemma prTIirr_inj : injective Imu2. Proof. by case: primeTIirr_spec. Qed. - -Corollary cfdot_prTIirr i1 j1 i2 j2 : - '[mu2_ i1 j1, mu2_ i2 j2] = ((i1 == i2) && (j1 == j2))%:R. -Proof. by rewrite cfdot_irr (inj_eq prTIirr_inj). Qed. - -Lemma cfInd_sub_prTIirr i j : - 'Ind[L] (w_ i j - w_ 0 j) = delta_ j *: (mu2_ i j - mu2_ 0 j). -Proof. by case: primeTIirr_spec i j. Qed. - -Lemma cycTIiso_prTIirr i j : sigma (w_ i j) = delta_ j *: mu2_ i j. -Proof. by case: primeTIirr_spec. Qed. - -Lemma prTIirr_id i j : {in W :\: W2, mu2_ i j =1 delta_ j *: w_ i j}. -Proof. by case: primeTIirr_spec. Qed. - -Lemma not_prTIirr_vanish k : k \notin codom Imu2 -> {in W :\: W2, 'chi_k =1 \0}. -Proof. by case: primeTIirr_spec k. Qed. - -(* This is Peterfalvi, Theorem (4.3)(d). *) -Theorem prTIirr1_mod i j : (mu2_ i j 1%g == delta_ j %[mod w1])%C. -Proof. -rewrite -(cfRes1 W1) -['Res _](subrK ('Res (delta_ j *: w_ i j))) cfunE. -set phi := _ - _; pose a := '[phi, 1]. -have phi_on_1: phi \in 'CF(W1, 1%g). - apply/cfun_onP=> g; have [W1g | /cfun0-> //] := boolP (g \in W1). - rewrite -(coprime_TIg coW12) inE W1g !cfunE !cfResE //= => W2'g. - by rewrite prTIirr_id ?cfunE ?subrr // inE W2'g (subsetP sW1W). -have{phi_on_1} ->: phi 1%g = a * w1%:R. - rewrite mulrC /a (cfdotEl _ phi_on_1) mulVKf ?neq0CG //. - by rewrite big_set1 cfun11 conjC1 mulr1. -rewrite cfResE // cfunE lin_char1 // mulr1 eqCmod_addl_mul //. -by rewrite Cint_cfdot_vchar ?rpred1 ?rpredB ?cfRes_vchar ?rpredZsign ?irr_vchar. -Qed. - -Lemma prTIsign_aut u j : delta_ (aut_Iirr u j) = delta_ j. -Proof. -have /eqP := cfAut_cycTIiso ctiW u (w_ 0 j). -rewrite -cycTIirr_aut aut_Iirr0 -/sigma !cycTIiso_prTIirr raddfZsign /=. -by rewrite -aut_IirrE eq_scaled_irr => /andP[/eqP]. -Qed. - -Lemma prTIirr_aut u i j : - mu2_ (aut_Iirr u i) (aut_Iirr u j) = cfAut u (mu2_ i j). -Proof. -rewrite -!(canLR (signrZK _) (cycTIiso_prTIirr _ _)) -!/(delta_ _). -by rewrite prTIsign_aut raddfZsign /= cfAut_cycTIiso -cycTIirr_aut. -Qed. - -(* The (reducible) column sums of the prime TI irreducibles. *) -Definition primeTIred j : 'CF(L) := \sum_i mu2_ i j. -Local Notation mu_ := primeTIred. - -Definition uniform_prTIred_seq j0 := - image mu_ [pred j | j != 0 & mu_ j 1%g == mu_ j0 1%g]. - -Lemma prTIred_aut u j : mu_ (aut_Iirr u j) = cfAut u (mu_ j). -Proof. -rewrite raddf_sum [mu_ _](reindex_inj (aut_Iirr_inj u)). -by apply: eq_bigr => i _; rewrite /= prTIirr_aut. -Qed. - -Lemma cfdot_prTIirr_red i j k : '[mu2_ i j, mu_ k] = (j == k)%:R. -Proof. -rewrite cfdot_sumr (bigD1 i) // cfdot_prTIirr eqxx /=. -rewrite big1 ?addr0 // => i1 neq_i1i. -by rewrite cfdot_prTIirr eq_sym (negPf neq_i1i). -Qed. - -Lemma cfdot_prTIred j1 j2 : '[mu_ j1, mu_ j2] = ((j1 == j2) * w1)%:R. -Proof. -rewrite cfdot_suml (eq_bigr _ (fun i _ => cfdot_prTIirr_red i _ _)) sumr_const. -by rewrite mulrnA card_Iirr_cyclic. -Qed. - -Lemma cfnorm_prTIred j : '[mu_ j] = w1%:R. -Proof. by rewrite cfdot_prTIred eqxx mul1n. Qed. - -Lemma prTIred_neq0 j : mu_ j != 0. -Proof. by rewrite -cfnorm_eq0 cfnorm_prTIred neq0CG. Qed. - -Lemma prTIred_char j : mu_ j \is a character. -Proof. by apply: rpred_sum => i _; apply: irr_char. Qed. - -Lemma prTIred_1_gt0 j : 0 < mu_ j 1%g. -Proof. by rewrite char1_gt0 ?prTIred_neq0 ?prTIred_char. Qed. - -Lemma prTIred_1_neq0 i : mu_ i 1%g != 0. -Proof. by rewrite char1_eq0 ?prTIred_neq0 ?prTIred_char. Qed. - -Lemma prTIred_inj : injective mu_. -Proof. -move=> j1 j2 /(congr1 (cfdot (mu_ j1)))/esym/eqP; rewrite !cfdot_prTIred. -by rewrite eqC_nat eqn_pmul2r ?cardG_gt0 // eqxx; case: (j1 =P j2). -Qed. - -Lemma prTIred_not_real j : j != 0 -> ~~ cfReal (mu_ j). -Proof. -apply: contraNneq; rewrite -prTIred_aut -irr_eq1 -odd_eq_conj_irr1 //. -by rewrite -aut_IirrE => /prTIred_inj->. -Qed. - -Lemma prTIsign0 : delta_ 0 = 1. -Proof. -have /esym/eqP := cycTIiso_prTIirr 0 0; rewrite -[sigma _]scale1r. -by rewrite /w_ /sigma cycTIirr00 cycTIiso1 -irr0 eq_scaled_irr => /andP[/eqP]. -Qed. - -Lemma prTIirr00 : mu2_ 0 0 = 1. -Proof. -have:= cycTIiso_prTIirr 0 0; rewrite prTIsign0 scale1r. -by rewrite /w_ /sigma cycTIirr00 cycTIiso1. -Qed. - -(* This is PeterFalvi (4.4). *) -Lemma prTIirr0P k : - reflect (exists i, 'chi_k = mu2_ i 0) (K \subset cfker 'chi_k). -Proof. -suff{k}: [set k | K \subset cfker 'chi_k] == [set Imu2 (i, 0) | i : Iirr W1]. - move/eqP/setP/(_ k); rewrite inE => ->. - by apply: (iffP imsetP) => [[i _]|[i /irr_inj]] ->; exists i. -have [isoW1 abW1] := (sdprod_isog defL, cyclic_abelian cycW1). -have abLbar: abelian (L / K) by rewrite -(isog_abelian isoW1). -rewrite eqEcard andbC card_imset ?nirrW1 => [| i1 i2 /prTIirr_inj[] //]. -rewrite [w1](card_isog isoW1) -card_Iirr_abelian //. -rewrite -(card_image (can_inj (mod_IirrK nsKL))) subset_leq_card; last first. - by apply/subsetP=> _ /imageP[k1 _ ->]; rewrite inE mod_IirrE ?cfker_mod. -apply/subsetP=> k; rewrite inE => kerKk. -have /irrP[ij DkW]: 'Res 'chi_k \in irr W. - rewrite lin_char_irr ?cfRes_lin_char // lin_irr_der1. - by apply: subset_trans kerKk; rewrite der1_min ?normal_norm. -have{ij DkW} [i DkW]: exists i, 'Res 'chi_k = w_ i 0. - have /codomP[[i j] Dij] := dprod_Iirr_onto defW ij; exists i. - rewrite DkW Dij; congr (w_ i _); apply/eqP; rewrite -subGcfker. - rewrite -['chi_j](cfDprodKr_abelian defW i) // -dprod_IirrE -{}Dij -{}DkW. - by rewrite cfResRes // sub_cfker_Res // (subset_trans sW2K kerKk). -apply/imsetP; exists i => //=; apply/irr_inj. -suffices ->: 'chi_k = delta_ 0 *: mu2_ i 0 by rewrite prTIsign0 scale1r. -rewrite -cycTIiso_prTIirr -(eq_in_cycTIiso _ (irr_dirr k)) // => x /setDP[Wx _]. -by rewrite -/(w_ i 0) -DkW cfResE. -Qed. - -(* This is the first part of PeterFalvi, Theorem (4.5)(a). *) -Theorem cfRes_prTIirr_eq0 i j : 'Res[K] (mu2_ i j) = 'Res (mu2_ 0 j). -Proof. -apply/eqP; rewrite -subr_eq0 -rmorphB /=; apply/eqP/cfun_inP=> x0 Kx0. -rewrite -(canLR (signrZK _) (cfInd_sub_prTIirr i j)) -/(delta_ j). -rewrite cfResE // !cfunE (cfun_on0 (cfInd_on _ (V2ew i j))) ?mulr0 //. -apply: contraL Kx0 => /imset2P[x y /setDP[Wx W2'x] Ly ->] {x0}. -rewrite memJ_norm ?(subsetP (normal_norm nsKL)) //; apply: contra W2'x => Kx. -by rewrite -(mul1g W2) -(coprime_TIg coKW1) group_modr // inE Kx (dprodW defW). -Qed. - -Lemma prTIirr_1 i j : mu2_ i j 1%g = mu2_ 0 j 1%g. -Proof. by rewrite -!(@cfRes1 _ K L) cfRes_prTIirr_eq0. Qed. - -Lemma prTIirr0_1 i : mu2_ i 0 1%g = 1. -Proof. by rewrite prTIirr_1 prTIirr00 cfun11. Qed. - -Lemma prTIirr0_linear i : mu2_ i 0 \is a linear_char. -Proof. by rewrite qualifE irr_char /= prTIirr0_1. Qed. - -Lemma prTIred_1 j : mu_ j 1%g = w1%:R * mu2_ 0 j 1%g. -Proof. -rewrite mulr_natl -nirrW1 sum_cfunE. -by rewrite -sumr_const; apply: eq_bigr => i _; rewrite prTIirr_1. -Qed. - -Definition primeTI_Ires j : Iirr K := cfIirr ('Res[K] (mu2_ 0 j)). -Local Notation Ichi := primeTI_Ires. -Local Notation chi_ j := 'chi_(Ichi j). - -(* This is the rest of PeterFalvi, Theorem (4.5)(a). *) -Theorem prTIres_spec j : chi_ j = 'Res (mu2_ 0 j) /\ mu_ j = 'Ind (chi_ j). -Proof. -rewrite /Ichi; set chi_j := 'Res _. -have [k chi_j_k]: {k | k \in irr_constt chi_j} := constt_cfRes_irr K _. -have Nchi_j: chi_j \is a character by rewrite cfRes_char ?irr_char. -have lb_mu_1: w1%:R * 'chi_k 1%g <= mu_ j 1%g ?= iff (chi_j == 'chi_k). - have [chi' Nchi' Dchi_j] := constt_charP _ Nchi_j chi_j_k. - rewrite prTIred_1 (mono_lerif (ler_pmul2l (gt0CG W1))). - rewrite -subr_eq0 Dchi_j addrC addKr -(canLR (addrK _) Dchi_j) !cfunE. - rewrite lerif_subLR addrC -lerif_subLR cfRes1 subrr -char1_eq0 // eq_sym. - by apply: lerif_eq; rewrite char1_ge0. -pose psi := 'Ind 'chi_k - mu_ j; have Npsi: psi \is a character. - apply/forallP=> l; rewrite coord_cfdot cfdotBl; set a := '['Ind _, _]. - have Na: a \in Cnat by rewrite Cnat_cfdot_char_irr ?cfInd_char ?irr_char. - have [[i /eqP Dl] | ] := altP (@existsP _ (fun i => 'chi_l == mu2_ i j)). - have [n Da] := CnatP a Na; rewrite Da cfdotC Dl cfdot_prTIirr_red. - rewrite rmorph_nat -natrB ?Cnat_nat // eqxx lt0n -eqC_nat -Da. - by rewrite -irr_consttE constt_Ind_Res Dl cfRes_prTIirr_eq0. - rewrite negb_exists => /forallP muj'l. - rewrite cfdot_suml big1 ?subr0 // => i _. - rewrite cfdot_irr -(inj_eq irr_inj) mulrb ifN_eqC ?muj'l //. -have ub_mu_1: mu_ j 1%g <= 'Ind[L] 'chi_k 1%g ?= iff ('Ind 'chi_k == mu_ j). - rewrite -subr_eq0 -/psi (canRL (subrK _) (erefl psi)) cfunE -lerif_subLR. - by rewrite subrr -char1_eq0 // eq_sym; apply: lerif_eq; rewrite char1_ge0. -have [_ /esym] := lerif_trans lb_mu_1 ub_mu_1; rewrite cfInd1 //. -by rewrite -(index_sdprod defL) eqxx => /andP[/eqP-> /eqP <-]; rewrite irrK. -Qed. - -Lemma cfRes_prTIirr i j : 'Res[K] (mu2_ i j) = chi_ j. -Proof. by rewrite cfRes_prTIirr_eq0; case: (prTIres_spec j). Qed. - -Lemma cfInd_prTIres j : 'Ind[L] (chi_ j) = mu_ j. -Proof. by have [] := prTIres_spec j. Qed. - -Lemma cfRes_prTIred j : 'Res[K] (mu_ j) = w1%:R *: chi_ j. -Proof. -rewrite -nirrW1 scaler_nat -sumr_const linear_sum /=; apply: eq_bigr => i _. -exact: cfRes_prTIirr. -Qed. - -Lemma prTIres_aut u j : chi_ (aut_Iirr u j) = cfAut u (chi_ j). -Proof. -by rewrite -(cfRes_prTIirr (aut_Iirr u 0)) prTIirr_aut -cfAutRes cfRes_prTIirr. -Qed. - -Lemma prTIres0 : chi_ 0 = 1. -Proof. by rewrite -(cfRes_prTIirr 0) prTIirr00 cfRes_cfun1. Qed. - -Lemma prTIred0 : mu_ 0 = w1%:R *: '1_K. -Proof. -by rewrite -cfInd_prTIres prTIres0 cfInd_cfun1 // -(index_sdprod defL). -Qed. - -Lemma prTIres_inj : injective Ichi. -Proof. by move=> j1 j2 Dj; apply: prTIred_inj; rewrite -!cfInd_prTIres Dj. Qed. - -(* This is the first assertion of Peterfalvi (4.5)(b). *) -Theorem prTIres_irr_cases k (theta := 'chi_k) (phi := 'Ind theta) : - {j | theta = chi_ j} + {phi \in irr L /\ (forall i j, phi != mu2_ i j)}. -Proof. -pose imIchi := [set Ichi j | j : Iirr W2]. -have [/imsetP/sig2_eqW[j _] | imIchi'k] := boolP (k \in imIchi). - by rewrite /theta => ->; left; exists j. -suffices{phi} theta_inv: 'I_L[theta] = K. - have irr_phi: phi \in irr L by apply: inertia_Ind_irr; rewrite ?theta_inv. - right; split=> // i j; apply: contraNneq imIchi'k => Dphi; apply/imsetP. - exists j => //; apply/eqP; rewrite -[k == _]constt_irr -(cfRes_prTIirr i). - by rewrite -constt_Ind_Res -/phi Dphi irr_consttE cfnorm_irr oner_eq0. -rewrite -(sdprodW (sdprod_modl defL (sub_inertia _))); apply/mulGidPl. -apply/subsetP=> z /setIP[W1z Itheta_z]; apply: contraR imIchi'k => K'z. -have{K'z} [Lz ntz] := (subsetP sW1L z W1z, group1_contra K'z : z != 1%g). -have [p p_pr p_z]: {p | prime p & p %| #[z]} by apply/pdivP; rewrite order_gt1. -have coKp := coprime_dvdr (dvdn_trans p_z (order_dvdG W1z)) coKW1. -wlog{p_z} p_z: z W1z Lz Itheta_z ntz / p.-elt z. - move/(_ z.`_p)->; rewrite ?groupX ?p_elt_constt //. - by rewrite (sameP eqP constt1P) /p_elt p'natE ?negbK. -have JirrP: is_action L (@conjg_Iirr gT K); last pose Jirr := Action JirrP. - split=> [y k1 k2 eq_k12 | k1 y1 y2 Gy1 Gy2]; apply/irr_inj. - by apply/(can_inj (cfConjgK y)); rewrite -!conjg_IirrE eq_k12. - by rewrite !conjg_IirrE (cfConjgM _ nsKL). -have [[_ nKL] [nKz _]] := (andP nsKL, setIdP Itheta_z). -suffices{k theta Itheta_z} /eqP->: imIchi == 'Fix_Jirr[z]. - by apply/afix1P/irr_inj; rewrite conjg_IirrE inertiaJ. -rewrite eqEcard; apply/andP; split. - apply/subsetP=> _ /imsetP[j _ ->]; apply/afix1P/irr_inj. - by rewrite conjg_IirrE -(cfRes_prTIirr 0) (cfConjgRes _ _ nsKL) ?cfConjg_id. -have ->: #|imIchi| = w2 by rewrite card_imset //; apply: prTIres_inj. -have actsL_KK: [acts L, on classes K | 'Js \ subsetT L]. - rewrite astabs_ract subsetIidl; apply/subsetP=> y Ly; rewrite !inE /=. - apply/subsetP=> _ /imsetP[x Kx ->]; rewrite !inE /= -class_rcoset. - by rewrite norm_rlcoset ?class_lcoset ?mem_classes ?memJ_norm ?(subsetP nKL). -rewrite (card_afix_irr_classes Lz actsL_KK) => [|k x y Kx /=]; last first. - by case/imsetP=> _ /imsetP[t Kt ->] ->; rewrite conjg_IirrE cfConjgEJ ?cfunJ. -apply: leq_trans (subset_leq_card _) (leq_imset_card (class^~ K) _). -apply/subsetP=> _ /setIP[/imsetP[x Kx ->] /afix1P/normP nxKz]. -suffices{Kx} /pred0Pn[t /setIP[xKt czt]]: #|'C_(x ^: K)[z]| != 0%N. - rewrite -(class_eqP xKt); apply: mem_imset; have [y Ky Dt] := imsetP xKt. - by rewrite -(@prKW1 z) ?(czt, inE) ?ntz // Dt groupJ. -have{coKp}: ~~ (p %| #|K|) by rewrite -prime_coprime // coprime_sym. -apply: contraNneq => /(congr1 (modn^~ p))/eqP; rewrite mod0n. -rewrite -cent_cycle -afixJ -sylow.pgroup_fix_mod ?astabsJ ?cycle_subG //. -by move/dvdn_trans; apply; rewrite -index_cent1 dvdn_indexg. -Qed. - -(* Implicit elementary converse to the above. *) -Lemma prTIred_not_irr j : mu_ j \notin irr L. -Proof. by rewrite irrEchar cfnorm_prTIred pnatr_eq1 gtn_eqF ?andbF. Qed. - -(* This is the second assertion of Peterfalvi (4.5)(b). *) -Theorem prTIind_irr_cases ell (phi := 'chi_ell) : - {i : _ & {j | phi = mu2_ i j}} - + {k | k \notin codom Ichi & phi = 'Ind 'chi_k}. -Proof. -have [k] := constt_cfRes_irr K ell; rewrite -constt_Ind_Res => kLell. -have [[j Dk] | [/irrP/sig_eqW[l1 DkL] chi'k]] := prTIres_irr_cases k. - have [i /=/eqP <- | mu2j'l] := pickP (fun i => mu2_ i j == phi). - by left; exists i, j. - case/eqP: kLell; rewrite Dk cfInd_prTIres cfdot_suml big1 // => i _. - by rewrite cfdot_irr -(inj_eq irr_inj) mu2j'l. -right; exists k; last by move: kLell; rewrite DkL constt_irr inE => /eqP <-. -apply/codomP=> [[j Dk]]; have/negP[] := prTIred_not_irr j. -by rewrite -cfInd_prTIres -Dk DkL mem_irr. -Qed. - -End Four_3_to_5. - -Notation primeTIsign ptiW j := - (GRing.sign algCring (primeTI_Isign ptiW j)) (only parsing). -Notation primeTIirr ptiW i j := 'chi_(primeTI_Iirr ptiW (i, j)) (only parsing). -Notation primeTIres ptiW j := 'chi_(primeTI_Ires ptiW j) (only parsing). - -Arguments prTIirr_inj [gT L K W W1 W2 defW] ptiWL [x1 x2]. -Arguments prTIred_inj [gT L K W W1 W2 defW] ptiWL [x1 x2]. -Arguments prTIres_inj [gT L K W W1 W2 defW] ptiWL [x1 x2]. -Arguments not_prTIirr_vanish [gT L K W W1 W2 defW] ptiWL [k]. - -Section Four_6_t0_10. - -Variables (gT : finGroupType) (G L K H : {group gT}) (A A0 : {set gT}). -Variables (W W1 W2 : {group gT}) (defW : W1 \x W2 = W). - -Local Notation V := (cyclicTIset defW). - -(* These correspond to Peterfalvi, Hypothesis (4.6). *) -Definition prime_Dade_definition := - [/\ (*c*) [/\ H <| L, W2 \subset H & H \subset K], - (*d*) [/\ A <| L, \bigcup_(h in H^#) 'C_K[h]^# \subset A & A \subset K^#] - & (*e*) A0 = A :|: class_support V L]. - -Record prime_Dade_hypothesis : Prop := PrimeDadeHypothesis { - prDade_cycTI :> cyclicTI_hypothesis G defW; - prDade_prTI :> primeTI_hypothesis L K defW; - prDade_hyp :> Dade_hypothesis G L A0; - prDade_def :> prime_Dade_definition -}. - -Hypothesis prDadeHyp : prime_Dade_hypothesis. - -Let ctiWG : cyclicTI_hypothesis G defW := prDadeHyp. -Let ptiWL : primeTI_hypothesis L K defW := prDadeHyp. -Let ctiWL : cyclicTI_hypothesis L defW := prime_cycTIhyp ptiWL. -Let ddA0 : Dade_hypothesis G L A0 := prDadeHyp. -Local Notation ddA0def := (prDade_def prDadeHyp). - -Local Notation w_ i j := (cyclicTIirr defW i j). -Local Notation sigma := (cyclicTIiso ctiWG). -Local Notation eta_ i j := (sigma (w_ i j)). -Local Notation mu2_ i j := (primeTIirr ptiWL i j). -Local Notation delta_ j := (primeTIsign ptiWL j). -Local Notation chi_ j := (primeTIres ptiWL j). -Local Notation mu_ := (primeTIred ptiWL). -Local Notation tau := (Dade ddA0). - -Let defA0 : A0 = A :|: class_support V L. Proof. by have [] := ddA0def. Qed. -Let nsAL : A <| L. Proof. by have [_ []] := ddA0def. Qed. -Let sAA0 : A \subset A0. Proof. by rewrite defA0 subsetUl. Qed. - -Let nsHL : H <| L. Proof. by have [[]] := ddA0def. Qed. -Let sHK : H \subset K. Proof. by have [[]] := ddA0def. Qed. -Let defL : K ><| W1 = L. Proof. by have [[]] := ptiWL. Qed. -Let sKL : K \subset L. Proof. by have /mulG_sub[] := sdprodW defL. Qed. -Let coKW1 : coprime #|K| #|W1|. -Proof. by rewrite (coprime_sdprod_Hall_r defL); have [[]] := ptiWL. Qed. - -Let sIH_A : \bigcup_(h in H^#) 'C_K[h]^# \subset A. -Proof. by have [_ []] := ddA0def. Qed. - -Let sW2H : W2 \subset H. Proof. by have [[]] := ddA0def. Qed. -Let ntW1 : W1 :!=: 1%g. Proof. by have [[]] := ptiWL. Qed. -Let ntW2 : W2 :!=: 1%g. Proof. by have [_ []] := ptiWL. Qed. - -Let oddW : odd #|W|. Proof. by have [] := ctiWL. Qed. -Let sW1W : W1 \subset W. Proof. by have /mulG_sub[] := dprodW defW. Qed. -Let sW2W : W2 \subset W. Proof. by have /mulG_sub[] := dprodW defW. Qed. -Let tiW12 : W1 :&: W2 = 1%g. Proof. by have [] := dprodP defW. Qed. - -Let cycW : cyclic W. Proof. by have [] := ctiWG. Qed. -Let cycW1 : cyclic W1. Proof. by have [[]] := ptiWL. Qed. -Let cycW2 : cyclic W2. Proof. by have [_ []] := ptiWL. Qed. -Let sLG : L \subset G. Proof. by case: ddA0. Qed. -Let sW2K : W2 \subset K. Proof. by have [_ []] := ptiWL. Qed. - -Let sWL : W \subset L. -Proof. by rewrite -(dprodWC defW) -(sdprodW defL) mulgSS. Qed. -Let sWG : W \subset G. Proof. exact: subset_trans sWL sLG. Qed. - -Let oddW1 : odd #|W1|. Proof. exact: oddSg oddW. Qed. -Let oddW2 : odd #|W2|. Proof. exact: oddSg oddW. Qed. - -Let w1gt1 : (2 < #|W1|)%N. Proof. by rewrite odd_gt2 ?cardG_gt1. Qed. -Let w2gt2 : (2 < #|W2|)%N. Proof. by rewrite odd_gt2 ?cardG_gt1. Qed. - -Let nirrW1 : #|Iirr W1| = #|W1|. Proof. exact: card_Iirr_cyclic. Qed. -Let nirrW2 : #|Iirr W2| = #|W2|. Proof. exact: card_Iirr_cyclic. Qed. -Let W1lin i : 'chi[W1]_i \is a linear_char. Proof. exact/irr_cyclic_lin. Qed. -Let W2lin i : 'chi[W2]_i \is a linear_char. Proof. exact/irr_cyclic_lin. Qed. - -(* This is the first part of Peterfalvi (4.7). *) -Lemma prDade_irr_on k : - ~~ (H \subset cfker 'chi[K]_k) -> 'chi_k \in 'CF(K, 1%g |: A). -Proof. -move=> kerH'i; apply/cfun_onP=> g; rewrite !inE => /norP[ntg A'g]. -have [Kg | /cfun0-> //] := boolP (g \in K). -apply: irr_reg_off_ker_0 (normalS _ _ nsHL) kerH'i _ => //. -apply/trivgP/subsetP=> h /setIP[Hh cgh]; apply: contraR A'g => nth. -apply/(subsetP sIH_A)/bigcupP; exists h; first exact/setDP. -by rewrite 3!inE ntg Kg cent1C. -Qed. - -(* This is the second part of Peterfalvi (4.7). *) -Lemma prDade_Ind_irr_on k : - ~~ (H \subset cfker 'chi[K]_k) -> 'Ind[L] 'chi_k \in 'CF(L, 1%g |: A). -Proof. -move/prDade_irr_on/(cfInd_on sKL); apply: cfun_onS; rewrite class_supportEr. -by apply/bigcupsP=> _ /normsP-> //; rewrite normsU ?norms1 ?normal_norm. -Qed. - -(* Third part of Peterfalvi (4.7). *) -Lemma cfker_prTIres j : j != 0 -> ~~ (H \subset cfker (chi_ j)). -Proof. -rewrite -(cfRes_prTIirr _ 0) cfker_Res ?irr_char // subsetI sHK /=. -apply: contra => kerHmu0j; rewrite -irr_eq1; apply/eqP/cfun_inP=> y W2y. -have [[x W1x ntx] mulW] := (trivgPn _ ntW1, dprodW defW). -rewrite cfun1E W2y -(cfDprodEr defW _ W1x W2y) -dprodr_IirrE -dprod_Iirr0l. -have{ntx} W2'x: x \notin W2 by rewrite -[x \in W2]andTb -W1x -in_setI tiW12 inE. -have V2xy: (x * y)%g \in W :\: W2 by rewrite inE -mulW mem_mulg ?groupMr ?W2'x. -rewrite -[w_ 0 j](signrZK (primeTI_Isign ptiWL j)) cfunE -prTIirr_id //. -have V2x: x \in W :\: W2 by rewrite inE W2'x (subsetP sW1W). -rewrite cfkerMr ?(subsetP (subset_trans sW2H kerHmu0j)) ?prTIirr_id // cfunE. -by rewrite signrMK -[x]mulg1 dprod_Iirr0l dprodr_IirrE cfDprodEr ?lin_char1. -Qed. - -(* Fourth part of Peterfalvi (4.7). *) -Lemma prDade_TIres_on j : j != 0 -> chi_ j \in 'CF(K, 1%g |: A). -Proof. by move/cfker_prTIres/prDade_irr_on. Qed. - -(* Last part of Peterfalvi (4.7). *) -Lemma prDade_TIred_on j : j != 0 -> mu_ j \in 'CF(L, 1%g |: A). -Proof. by move/cfker_prTIres/prDade_Ind_irr_on; rewrite cfInd_prTIres. Qed. - -Import ssrint. - -(* Second part of PeterFalvi (4.8). *) -Lemma prDade_TIsign_eq i j k : - mu2_ i j 1%g = mu2_ i k 1%g -> delta_ j = delta_ k. -Proof. -move=> eqjk; have{eqjk}: (delta_ j == delta_ k %[mod #|W1|])%C. - apply: eqCmod_trans (prTIirr1_mod ptiWL i k). - by rewrite eqCmod_sym -eqjk (prTIirr1_mod ptiWL). -have /negP: ~~ (#|W1| %| 2) by rewrite gtnNdvd. -rewrite /eqCmod -![delta_ _]intr_sign -rmorphB dvdC_int ?Cint_int //= intCK. -by do 2!case: (primeTI_Isign _ _). -Qed. - -(* First part of PeterFalvi (4.8). *) -Lemma prDade_sub_TIirr_on i j k : - j != 0 -> k != 0 -> mu2_ i j 1%g = mu2_ i k 1%g -> - mu2_ i j - mu2_ i k \in 'CF(L, A0). -Proof. -move=> nzj nzk eq_mu1. -apply/cfun_onP=> g; rewrite defA0 !inE negb_or !cfunE => /andP[A'g V'g]. -have [Lg | L'g] := boolP (g \in L); last by rewrite !cfun0 ?subrr. -have{Lg} /bigcupP[_ /rcosetsP[x W1x ->] Kx_g]: g \in cover (rcosets K W1). - by rewrite (cover_partition (rcosets_partition_mul W1 K)) (sdprodW defL). -have [x1 | ntx] := eqVneq x 1%g. - have [-> | ntg] := eqVneq g 1%g; first by rewrite eq_mu1 subrr. - have{A'g} A1'g: g \notin 1%g |: A by rewrite !inE negb_or ntg. - rewrite x1 mulg1 in Kx_g; rewrite -!(cfResE (mu2_ i _) sKL) ?cfRes_prTIirr //. - by rewrite !(cfun_onP (prDade_TIres_on _)) ?subrr. -have coKx: coprime #|K| #[x] by rewrite (coprime_dvdr (order_dvdG W1x)). -have nKx: x \in 'N(K) by have [_ _ /subsetP->] := sdprodP defL. -have [/cover_partition defKx _] := partition_cent_rcoset nKx coKx. -have def_cKx: 'C_K[x] = W2 by have [_ _ -> //] := ptiWL; rewrite !inE ntx. -move: Kx_g; rewrite -defKx def_cKx cover_imset => /bigcupP[z /(subsetP sKL)Lz]. -case/imsetP=> _ /rcosetP[y W2y ->] Dg; rewrite Dg !cfunJ //. -have V2yx: (y * x)%g \in W :\: W2. - rewrite inE -(dprodWC defW) mem_mulg // andbT groupMl //. - by rewrite -[x \in W2]andTb -W1x -in_setI tiW12 inE. -rewrite 2?{1}prTIirr_id //. -have /set1P->: y \in [1]. - rewrite -tiW12 inE W2y andbT; apply: contraR V'g => W1'y. - by rewrite Dg mem_imset2 // !inE negb_or -andbA -in_setD groupMr ?W1'y. -rewrite -commute1 (prDade_TIsign_eq eq_mu1) !cfunE -mulrBr. -by rewrite !dprod_IirrE !cfDprodE // !lin_char1 // subrr mulr0. -Qed. - -(* This is last part of PeterFalvi (4.8). *) -Lemma prDade_sub_TIirr i j k : - j != 0 -> k != 0 -> mu2_ i j 1%g = mu2_ i k 1%g -> - tau (mu2_ i j - mu2_ i k) = delta_ j *: (eta_ i j - eta_ i k). -Proof. -move=> nz_j nz_k eq_mu2jk_1. -have [-> | k'j] := eqVneq j k; first by rewrite !subrr !raddf0. -have [[Itau Ztau] [_ Zsigma]] := (Dade_Zisometry ddA0, cycTI_Zisometry ctiWL). -set dmu2 := _ - _; set dsw := _ - _; have Dmu2 := prTIirr_id ptiWL. -have Zmu2: dmu2 \in 'Z[irr L, A0]. - by rewrite zchar_split rpredB ?irr_vchar ?prDade_sub_TIirr_on. -apply: eq_signed_sub_cTIiso => // [||x Vx]. -- exact: zcharW (Ztau _ Zmu2). -- rewrite Itau // cfnormBd ?cfnorm_irr // (cfdot_prTIirr ptiWL). - by rewrite (negPf k'j) andbF. -have V2x: x \in W :\: W2 by rewrite (subsetP _ x Vx) // setDS ?subsetUr. -rewrite !(cfunE, Dade_id) ?(cycTIiso_restrict _ _ Vx) //; last first. - by rewrite defA0 inE orbC mem_class_support. -by rewrite !Dmu2 // (prDade_TIsign_eq eq_mu2jk_1) !cfunE -mulrBr. -Qed. - -Lemma prDade_supp_disjoint : V \subset ~: K. -Proof. -rewrite subDset setUC -subDset setDE setCK setIC -(dprod_modr defW sW2K). -by rewrite coprime_TIg // dprod1g subsetUr. -Qed. - -(* This is Peterfalvi (4.9). *) -(* We have added the "obvious" fact that calT is pairwise orthogonal, since *) -(* we require this to prove membership in 'Z[calT], we encapsulate the *) -(* construction of tau1, and state its conformance to tau on the "larger" *) -(* domain 'Z[calT, L^#], so that clients can avoid using the domain equation *) -(* in part (a). *) -Theorem uniform_prTIred_coherent k (calT := uniform_prTIred_seq ptiWL k) : - k != 0 -> - (*a*) [/\ pairwise_orthogonal calT, ~~ has cfReal calT, cfConjC_closed calT, - 'Z[calT, L^#] =i 'Z[calT, A] - & exists2 psi, psi != 0 & psi \in 'Z[calT, A]] - (*b*) /\ (exists2 tau1 : {linear 'CF(L) -> 'CF(G)}, - forall j, tau1 (mu_ j) = delta_ k *: (\sum_i sigma (w_ i j)) - & {in 'Z[calT], isometry tau1, to 'Z[irr G]} - /\ {in 'Z[calT, L^#], tau1 =1 tau}). -Proof. -have uniqT: uniq calT by apply/dinjectiveP; apply: in2W; apply: prTIred_inj. -have sTmu: {subset calT <= codom mu_} by apply: image_codom. -have oo_mu: pairwise_orthogonal (codom mu_). - apply/pairwise_orthogonalP; split=> [|_ _ /codomP[j1 ->] /codomP[j2 ->]]. - apply/andP; split; last by apply/injectiveP; apply: prTIred_inj. - by apply/codomP=> [[i /esym/eqP/idPn[]]]; apply: prTIred_neq0. - by rewrite cfdot_prTIred; case: (j1 =P j2) => // -> /eqP. -have real'T: ~~ has cfReal calT. - by apply/hasPn=> _ /imageP[j /andP[nzj _] ->]; apply: prTIred_not_real. -have ccT: cfConjC_closed calT. - move=> _ /imageP[j Tj ->]; rewrite -prTIred_aut image_f // inE aut_Iirr_eq0. - by rewrite prTIred_aut cfunE conj_Cnat ?Cnat_char1 ?prTIred_char. -have TonA: 'Z[calT, L^#] =i 'Z[calT, A]. - have A'1: 1%g \notin A by apply: contra (subsetP sAA0 _) _; have [] := ddA0. - move=> psi; rewrite zcharD1E -(setU1K A'1) zcharD1; congr (_ && _). - apply/idP/idP; [apply: zchar_trans_on psi => psi Tpsi | exact: zcharW]. - have [j /andP[nz_j _] Dpsi] := imageP Tpsi. - by rewrite zchar_split mem_zchar // Dpsi prDade_TIred_on. -move=> nzk; split. - split=> //; first exact: sub_pairwise_orthogonal oo_mu. - have Tmuk: mu_ k \in calT by rewrite image_f // inE nzk /=. - exists ((mu_ k)^*%CF - mu_ k); first by rewrite subr_eq0 (hasPn real'T). - rewrite -TonA -rpredN opprB sub_aut_zchar ?zchar_onG ?mem_zchar ?ccT //. - by move=> _ /mapP[j _ ->]; rewrite char_vchar ?prTIred_char. -pose f0 j := delta_ k *: (\sum_i eta_ i j); have in_mu := codom_f mu_. -pose f1 psi := f0 (iinv (valP (insigd (in_mu k) psi))). -have f1mu j: f1 (mu_ j) = f0 j. - have in_muj := in_mu j. - rewrite /f1 /insigd /insubd /= insubT /=; [idtac]. - by rewrite iinv_f //; apply: prTIred_inj. -have iso_f1: {in codom mu_, isometry f1, to 'Z[irr G]}. - split=> [_ _ /codomP[j1 ->] /codomP[j2 ->] | _ /codomP[j ->]]; last first. - by rewrite f1mu rpredZsign rpred_sum // => i _; apply: cycTIiso_vchar. - rewrite !f1mu cfdotZl cfdotZr rmorph_sign signrMK !cfdot_suml. - apply: eq_bigr => i1 _; rewrite !cfdot_sumr; apply: eq_bigr => i2 _. - by rewrite cfdot_cycTIiso cfdot_prTIirr. -have [tau1 Dtau1 Itau1] := Zisometry_of_iso (orthogonal_free oo_mu) iso_f1. -exists tau1 => [j|]; first by rewrite Dtau1 ?codom_f ?f1mu. -split=> [|psi]; first by apply: sub_iso_to Itau1 => //; apply: zchar_subset. -rewrite zcharD1E => /andP[/zchar_expansion[//|z _ Dpsi] /eqP psi1_0]. -rewrite -[psi]subr0 -(scale0r (mu_ k)) -(mul0r (mu_ k 1%g)^-1) -{}psi1_0. -rewrite {psi}Dpsi sum_cfunE mulr_suml scaler_suml -sumrB !raddf_sum /=. -apply: eq_big_seq => _ /imageP[j /andP[nzj /eqP eq_mujk_1] ->]. -rewrite cfunE eq_mujk_1 mulfK ?prTIred_1_neq0 // -scalerBr !linearZ /=. -congr (_ *: _); rewrite {z}linearB !Dtau1 ?codom_f // !f1mu -scalerBr -!sumrB. -rewrite !linear_sum; apply: eq_bigr => i _ /=. -have{eq_mujk_1} eq_mu2ijk_1: mu2_ i j 1%g = mu2_ i k 1%g. - by apply: (mulfI (neq0CG W1)); rewrite !prTIirr_1 -!prTIred_1. -by rewrite -(prDade_TIsign_eq eq_mu2ijk_1) prDade_sub_TIirr. -Qed. - -(* This is Peterfalvi (4.10). *) -Lemma prDade_sub2_TIirr i j : - tau (delta_ j *: mu2_ i j - delta_ j *: mu2_ 0 j - mu2_ i 0 + mu2_ 0 0) - = eta_ i j - eta_ 0 j - eta_ i 0 + eta_ 0 0. -Proof. -pose V0 := class_support V L; have sVV0: V \subset V0 := sub_class_support L V. -have sV0A0: V0 \subset A0 by rewrite defA0 subsetUr. -have nV0L: L \subset 'N(V0) := class_support_norm V L. -have [_ _ /normedTI_memJ_P[ntV _ tiV]] := ctiWG. -have [/andP[sA0L _] _ A0'1 _ _] := ddA0. -have{sA0L A0'1} sV0G: V0 \subset G^#. - by rewrite (subset_trans sV0A0) // subsetD1 A0'1 (subset_trans sA0L). -have{sVV0} ntV0: V0 != set0 by apply: contraNneq ntV; rewrite -subset0 => <-. -have{ntV} tiV0: normedTI V0 G L. - apply/normedTI_memJ_P; split=> // _ z /imset2P[u y Vu Ly ->] Gz. - apply/idP/idP=> [/imset2P[u1 y1 Vu1 Ly1 Duyz] | Lz]; last first. - by rewrite -conjgM mem_imset2 ?groupM. - rewrite -[z](mulgKV y1) groupMr // -(groupMl _ Ly) (subsetP sWL) //. - by rewrite -(tiV u) ?groupM ?groupV // ?(subsetP sLG) // !conjgM Duyz conjgK. -have{ntV0 sV0A0 nV0L tiV0} DtauV0: {in 'CF(L, V0), tau =1 'Ind}. - by move=> beta V0beta; rewrite /= -(restr_DadeE _ sV0A0) //; apply: Dade_Ind. -pose alpha := cfCyclicTIset defW i j; set beta := _ *: mu2_ i j - _ - _ + _. -have Valpha: alpha \in 'CF(W, V) := cfCycTI_on ctiWL i j. -have Dalpha: alpha = w_ i j - w_ 0 j - w_ i 0 + w_ 0 0. - by rewrite addrC {1}cycTIirr00 addrA addrAC addrA addrAC -cfCycTI_E. -rewrite -!(linearB sigma) -linearD -Dalpha cycTIiso_Ind //. -suffices ->: beta = 'Ind[L] alpha by rewrite DtauV0 ?cfInd_on ?cfIndInd. -rewrite Dalpha -addrA -[w_ 0 0]opprK -opprD linearB /= /beta -scalerBr. -by rewrite !(cfInd_sub_prTIirr ptiWL) prTIsign0 scale1r opprD opprK addrA. -Qed. - -End Four_6_t0_10. diff --git a/mathcomp/odd_order/PFsection5.v b/mathcomp/odd_order/PFsection5.v deleted file mode 100644 index 94e9c42..0000000 --- a/mathcomp/odd_order/PFsection5.v +++ /dev/null @@ -1,1609 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div choice. -From mathcomp -Require Import fintype tuple finfun bigop prime ssralg poly finset center. -From mathcomp -Require Import fingroup morphism perm automorphism quotient action zmodp. -From mathcomp -Require Import gfunctor gproduct cyclic pgroup frobenius. -From mathcomp -Require Import matrix mxalgebra mxrepresentation vector ssrint. -From mathcomp -Require Import ssrnum algC classfun character inertia vcharacter. -From mathcomp -Require Import PFsection1 PFsection2 PFsection3 PFsection4. - -(******************************************************************************) -(* This file covers Peterfalvi, Section 5: Coherence. *) -(* Defined here: *) -(* coherent_with S A tau tau1 <-> tau1 is a Z-linear isometry from 'Z[S] to *) -(* 'Z[irr G] that coincides with tau on 'Z[S, A]. *) -(* coherent S A tau <-> (S, A, tau) is coherent, i.e., there is a Z-linear *) -(* isometry tau1 s.t. coherent_with S A tau tau1. *) -(* subcoherent S tau R <-> S : seq 'cfun(L) is non empty, pairwise orthogonal *) -(* and closed under complex conjugation, tau is an *) -(* isometry from 'Z[S, L^#] to virtual characters in *) -(* G that maps the difference chi - chi^*, for each *) -(* chi \in S, to the sum of an orthonormal family *) -(* R chi of virtual characters of G; also, R chi and *) -(* R phi are orthogonal unless phi \in chi :: chi^*. *) -(* dual_iso nu == the Z-linear (additive) mapping phi |-> - nu phi^* *) -(* for nu : {additive 'CF(L) -> 'CF(G)}. If nu is an *) -(* isometry extending a subcoherent tau on 'Z[S] with *) -(* size S = 2, then so is dual_iso nu. *) -(* We provide a set of definitions that cover the various \cal S notations *) -(* introduced in Peterfalvi sections 5, 6, 7, and 9 to 14. *) -(* Iirr_ker K A == the set of all i : Iirr K such that the kernel of *) -(* 'chi_i contains A. *) -(* Iirr_kerD K B A == the set of all i : Iirr K such that the kernel of *) -(* 'chi_i contains A but not B. *) -(* seqInd L calX == the duplicate-free sequence of characters of L *) -(* induced from K by the 'chi_i for i in calX. *) -(* seqIndT K L == the duplicate-free sequence of all characters of L *) -(* induced by irreducible characters of K. *) -(* seqIndD K L H M == the duplicate-free sequence of characters of L *) -(* induced by irreducible characters of K that have M *) -(* in their kernel, but not H. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope GRing.Theory Num.Theory. -Local Open Scope ring_scope. - -(* Results about the set of induced irreducible characters *) -Section InducedIrrs. - -Variables (gT : finGroupType) (K L : {group gT}). -Implicit Types (A B : {set gT}) (H M : {group gT}). -Implicit Type u : {rmorphism algC -> algC}. - -Section KerIirr. - -Definition Iirr_ker A := [set i | A \subset cfker 'chi[K]_i]. - -Lemma Iirr_kerS A B : B \subset A -> Iirr_ker A \subset Iirr_ker B. -Proof. by move/subset_trans=> sBA; apply/subsetP=> i; rewrite !inE => /sBA. Qed. - -Lemma sum_Iirr_ker_square H : - H <| K -> \sum_(i in Iirr_ker H) 'chi_i 1%g ^+ 2 = #|K : H|%:R. -Proof. -move=> nsHK; rewrite -card_quotient ?normal_norm // -irr_sum_square. -rewrite (eq_bigl _ _ (in_set _)) (reindex _ (mod_Iirr_bij nsHK)) /=. -by apply: eq_big => [i | i _]; rewrite mod_IirrE ?cfker_mod ?cfMod1. -Qed. - -Definition Iirr_kerD B A := Iirr_ker A :\: Iirr_ker B. - -Lemma sum_Iirr_kerD_square H M : - H <| K -> M <| K -> M \subset H -> - \sum_(i in Iirr_kerD H M) 'chi_i 1%g ^+ 2 = #|K : H|%:R * (#|H : M|%:R - 1). -Proof. -move=> nsHK nsMK sMH; have [sHK _] := andP nsHK. -rewrite mulrBr mulr1 -natrM Lagrange_index // -!sum_Iirr_ker_square //. -apply/esym/(canLR (addrK _)); rewrite /= addrC (big_setID (Iirr_ker H)). -by rewrite (setIidPr _) ?Iirr_kerS //. -Qed. - -Lemma Iirr_ker_aut u A i : (aut_Iirr u i \in Iirr_ker A) = (i \in Iirr_ker A). -Proof. by rewrite !inE aut_IirrE cfker_aut. Qed. - -Lemma Iirr_ker_conjg A i x : - x \in 'N(A) -> (conjg_Iirr i x \in Iirr_ker A) = (i \in Iirr_ker A). -Proof. -move=> nAx; rewrite !inE conjg_IirrE. -have [nKx | /cfConjgEout-> //] := boolP (x \in 'N(K)). -by rewrite cfker_conjg // -{1}(normP nAx) conjSg. -Qed. - -Lemma Iirr_kerDS A1 A2 B1 B2 : - A2 \subset A1 -> B1 \subset B2 -> Iirr_kerD B1 A1 \subset Iirr_kerD B2 A2. -Proof. by move=> sA12 sB21; rewrite setDSS ?Iirr_kerS. Qed. - -Lemma Iirr_kerDY B A : Iirr_kerD (A <*> B) A = Iirr_kerD B A. -Proof. by apply/setP=> i; rewrite !inE join_subG; apply: andb_id2r => ->. Qed. - -Lemma mem_Iirr_ker1 i : (i \in Iirr_kerD K 1%g) = (i != 0). -Proof. by rewrite !inE sub1G andbT subGcfker. Qed. - -End KerIirr. - -Hypothesis nsKL : K <| L. -Let sKL := normal_sub nsKL. -Let nKL := normal_norm nsKL. -Let e := #|L : K|%:R : algC. -Let nze : e != 0 := neq0CiG _ _. - -Section SeqInd. - -Variable calX : {set (Iirr K)}. - -(* The set of characters induced from the irreducibles in calX. *) -Definition seqInd := undup [seq 'Ind[L] 'chi_i | i in calX]. -Local Notation S := seqInd. - -Lemma seqInd_uniq : uniq S. Proof. exact: undup_uniq. Qed. - -Lemma seqIndP phi : - reflect (exists2 i, i \in calX & phi = 'Ind[L] 'chi_i) (phi \in S). -Proof. by rewrite mem_undup; apply: imageP. Qed. - -Lemma seqInd_on : {subset S <= 'CF(L, K)}. -Proof. by move=> _ /seqIndP[i _ ->]; apply: cfInd_normal. Qed. - -Lemma seqInd_char : {subset S <= character}. -Proof. by move=> _ /seqIndP[i _ ->]; rewrite cfInd_char ?irr_char. Qed. - -Lemma Cnat_seqInd1 phi : phi \in S -> phi 1%g \in Cnat. -Proof. by move/seqInd_char/Cnat_char1. Qed. - -Lemma Cint_seqInd1 phi : phi \in S -> phi 1%g \in Cint. -Proof. by rewrite CintE; move/Cnat_seqInd1->. Qed. - -Lemma seqInd_neq0 psi : psi \in S -> psi != 0. -Proof. by move=> /seqIndP[i _ ->]; apply: Ind_irr_neq0. Qed. - -Lemma seqInd1_neq0 psi : psi \in S -> psi 1%g != 0. -Proof. by move=> Spsi; rewrite char1_eq0 ?seqInd_char ?seqInd_neq0. Qed. - -Lemma cfnorm_seqInd_neq0 psi : psi \in S -> '[psi] != 0. -Proof. by move/seqInd_neq0; rewrite cfnorm_eq0. Qed. - -Lemma seqInd_ortho : {in S &, forall phi psi, phi != psi -> '[phi, psi] = 0}. -Proof. -move=> _ _ /seqIndP[i _ ->] /seqIndP[j _ ->]. -by case: ifP (cfclass_Ind_cases i j nsKL) => // _ -> /eqP. -Qed. - -Lemma seqInd_orthogonal : pairwise_orthogonal S. -Proof. -apply/pairwise_orthogonalP; split; last exact: seqInd_ortho. -by rewrite /= undup_uniq andbT; move/memPn: seqInd_neq0. -Qed. - -Lemma seqInd_free : free S. -Proof. exact: (orthogonal_free seqInd_orthogonal). Qed. - -Lemma seqInd_zcharW : {subset S <= 'Z[S]}. -Proof. by move=> phi Sphi; rewrite mem_zchar ?seqInd_free. Qed. - -Lemma seqInd_zchar : {subset S <= 'Z[S, K]}. -Proof. by move=> phi Sphi; rewrite zchar_split seqInd_zcharW ?seqInd_on. Qed. - -Lemma seqInd_vcharW : {subset S <= 'Z[irr L]}. -Proof. by move=> phi Sphi; rewrite char_vchar ?seqInd_char. Qed. - -Lemma seqInd_vchar : {subset S <= 'Z[irr L, K]}. -Proof. by move=> phi Sphi; rewrite zchar_split seqInd_vcharW ?seqInd_on. Qed. - -Lemma zcharD1_seqInd : 'Z[S, L^#] =i 'Z[S, K^#]. -Proof. -move=> phi; rewrite zcharD1E (zchar_split _ K^#) cfun_onD1. -by apply: andb_id2l => /(zchar_trans_on seqInd_zchar)/zchar_on->. -Qed. - -Lemma zcharD1_seqInd_on : {subset 'Z[S, L^#] <= 'CF(L, K^#)}. -Proof. by move=> phi; rewrite zcharD1_seqInd => /zchar_on. Qed. - -Lemma zcharD1_seqInd_Dade A : - 1%g \notin A -> {subset S <= 'CF(L, 1%g |: A)} -> 'Z[S, L^#] =i 'Z[S, A]. -Proof. -move=> notA1 A_S phi; rewrite zcharD1E (zchar_split _ A). -apply/andb_id2l=> ZSphi; apply/idP/idP=> [phi10 | /cfun_on0-> //]. -rewrite -(setU1K notA1) cfun_onD1 {}phi10 andbT. -have{phi ZSphi} [c -> _] := free_span seqInd_free (zchar_span ZSphi). -by rewrite big_seq memv_suml // => xi /A_S/memvZ. -Qed. - -Lemma dvd_index_seqInd1 phi : phi \in S -> phi 1%g / e \in Cnat. -Proof. -by case/seqIndP=> i _ ->; rewrite cfInd1 // mulrC mulKf ?Cnat_irr1. -Qed. - -Lemma sub_seqInd_zchar phi psi : - phi \in S -> psi \in S -> psi 1%g *: phi - phi 1%g *: psi \in 'Z[S, K^#]. -Proof. -move=> Sphi Spsi; rewrite zcharD1 !cfunE mulrC subrr eqxx. -by rewrite rpredB ?scale_zchar ?Cint_seqInd1 ?seqInd_zchar. -Qed. - -Lemma sub_seqInd_on phi psi : - phi \in S -> psi \in S -> psi 1%g *: phi - phi 1%g *: psi \in 'CF(L, K^#). -Proof. by move=> Sphi Spsi; apply: zchar_on (sub_seqInd_zchar Sphi Spsi). Qed. - -Lemma size_irr_subseq_seqInd S1 : - subseq S1 S -> {subset S1 <= irr L} -> - (#|L : K| * size S1 = #|[set i | 'Ind 'chi[K]_i \in S1]|)%N. -Proof. -move=> sS1S irrS1; have uniqS1: uniq S1 := subseq_uniq sS1S seqInd_uniq. -rewrite (card_imset_Ind_irr nsKL) => [|i|i y]; first 1 last. -- by rewrite inE => /irrS1. -- by rewrite !inE => *; rewrite conjg_IirrE -(cfConjgInd _ _ nsKL) ?cfConjg_id. -congr (_ * _)%N; transitivity #|map cfIirr S1|. - rewrite (card_uniqP _) ?size_map ?map_inj_in_uniq //. - exact: sub_in2 irrS1 _ (can_in_inj (@cfIirrE _ _)). -apply: eq_card => s; apply/idP/imsetP=> [/mapP[phi S1phi] | [i S1iG]] {s}->. - have /seqIndP[i _ Dphi]: phi \in S := mem_subseq sS1S S1phi. - by exists i; rewrite ?inE -Dphi. -by apply: map_f; rewrite inE in S1iG. -Qed. - -Section Beta. - -Variable xi : 'CF(L). -Hypotheses (Sxi : xi \in S) (xi1 : xi 1%g = e). - -Lemma cfInd1_sub_lin_vchar : 'Ind[L, K] 1 - xi \in 'Z[irr L, K^#]. -Proof. -rewrite zcharD1 !cfunE xi1 cfInd1 // cfun11 mulr1 subrr eqxx andbT. -rewrite rpredB ?(seqInd_vchar Sxi) // zchar_split cfInd_normal ?char_vchar //. -by rewrite cfInd_char ?cfun1_char. -Qed. - -Lemma cfInd1_sub_lin_on : 'Ind[L, K] 1 - xi \in 'CF(L, K^#). -Proof. exact: zchar_on cfInd1_sub_lin_vchar. Qed. - -Lemma seqInd_sub_lin_vchar : - {in S, forall phi : 'CF(L), phi - (phi 1%g / e) *: xi \in 'Z[S, K^#]}. -Proof. -move=> phi Sphi; rewrite /= zcharD1 !cfunE xi1 divfK // subrr eqxx. -by rewrite rpredB ?scale_zchar ?seqInd_zchar // CintE dvd_index_seqInd1. -Qed. - -Lemma seqInd_sub_lin_on : - {in S, forall phi : 'CF(L), phi - (phi 1%g / e) *: xi \in 'CF(L, K^#)}. -Proof. by move=> phi /seqInd_sub_lin_vchar/zchar_on. Qed. - -End Beta. - -End SeqInd. - -Arguments seqIndP [calX phi]. - -Lemma seqIndS (calX calY : {set Iirr K}) : - calX \subset calY -> {subset seqInd calX <= seqInd calY}. -Proof. -by move=> sXY _ /seqIndP[i /(subsetP sXY)Yi ->]; apply/seqIndP; exists i. -Qed. - -Definition seqIndT := seqInd setT. - -Lemma seqInd_subT calX : {subset seqInd calX <= seqIndT}. -Proof. exact: seqIndS (subsetT calX). Qed. - -Lemma mem_seqIndT i : 'Ind[L, K] 'chi_i \in seqIndT. -Proof. by apply/seqIndP; exists i; rewrite ?inE. Qed. - -Lemma seqIndT_Ind1 : 'Ind[L, K] 1 \in seqIndT. -Proof. by rewrite -irr0 mem_seqIndT. Qed. - -Lemma cfAut_seqIndT u : cfAut_closed u seqIndT. -Proof. -by move=> _ /seqIndP[i _ ->]; rewrite cfAutInd -aut_IirrE mem_seqIndT. -Qed. - -Definition seqIndD H M := seqInd (Iirr_kerD H M). - -Lemma seqIndDY H M : seqIndD (M <*> H) M = seqIndD H M. -Proof. by rewrite /seqIndD Iirr_kerDY. Qed. - -Lemma mem_seqInd H M i : - H <| L -> M <| L -> ('Ind 'chi_i \in seqIndD H M) = (i \in Iirr_kerD H M). -Proof. -move=> nsHL nsML; apply/seqIndP/idP=> [[j Xj] | Xi]; last by exists i. -case/cfclass_Ind_irrP/cfclassP=> // y Ly; rewrite -conjg_IirrE => /irr_inj->. -by rewrite inE !Iirr_ker_conjg -?in_setD ?(subsetP _ y Ly) ?normal_norm. -Qed. - -Lemma seqIndC1P phi : - reflect (exists2 i, i != 0 & phi = 'Ind 'chi[K]_i) (phi \in seqIndD K 1). -Proof. -by apply: (iffP seqIndP) => [] [i nzi ->]; - exists i; rewrite // mem_Iirr_ker1 in nzi *. -Qed. - -Lemma seqIndC1_filter : seqIndD K 1 = filter (predC1 ('Ind[L, K] 1)) seqIndT. -Proof. -rewrite filter_undup filter_map (eq_enum (in_set _)) enumT. -congr (undup (map _ _)); apply: eq_filter => i /=. -by rewrite mem_Iirr_ker1 cfInd_irr_eq1. -Qed. - -Lemma seqIndC1_rem : seqIndD K 1 = rem ('Ind[L, K] 1) seqIndT. -Proof. by rewrite rem_filter ?seqIndC1_filter ?undup_uniq. Qed. - -Section SeqIndD. - -Variables H0 H M : {group gT}. - -Local Notation S := (seqIndD H M). - -Lemma cfAut_seqInd u : cfAut_closed u S. -Proof. -move=> _ /seqIndP[i /setDP[kMi not_kHi] ->]; rewrite cfAutInd -aut_IirrE. -by apply/seqIndP; exists (aut_Iirr u i); rewrite // inE !Iirr_ker_aut not_kHi. -Qed. - -Lemma seqInd_conjC_subset1 : H \subset H0 -> cfConjC_subset S (seqIndD H0 1). -Proof. -move=> sHH0; split; [exact: seqInd_uniq | apply: seqIndS | exact: cfAut_seqInd]. -by rewrite Iirr_kerDS ?sub1G. -Qed. - -Lemma seqInd_sub_aut_zchar u : - {in S, forall phi, phi - cfAut u phi \in 'Z[S, K^#]}. -Proof. -move=> phi Sphi /=; rewrite sub_aut_zchar ?seqInd_zchar ?cfAut_seqInd //. -exact: seqInd_vcharW. -Qed. - -Lemma seqIndD_nonempty : H <| K -> M <| K -> M \proper H -> {phi | phi \in S}. -Proof. -move=> nsHK nsMK /andP[sMH ltMH]; pose X := Iirr_kerD H M. -suffices: \sum_(i in X) 'chi_i 1%g ^+ 2 > 0. - have [->|[i Xi]] := set_0Vmem X; first by rewrite big_set0 ltrr. - by exists ('Ind 'chi_i); apply/seqIndP; exists i. -by rewrite sum_Iirr_kerD_square ?mulr_gt0 ?gt0CiG ?subr_gt0 // ltr1n indexg_gt1. -Qed. - -Hypothesis sHK : H \subset K. - -Lemma seqInd_sub : {subset S <= seqIndD K 1}. -Proof. by apply: seqIndS; apply: Iirr_kerDS (sub1G M) sHK. Qed. - -Lemma seqInd_ortho_Ind1 : {in S, forall phi, '[phi, 'Ind[L, K] 1] = 0}. -Proof. -move=> _ /seqInd_sub/seqIndC1P[i nzi ->]. -by rewrite -irr0 not_cfclass_Ind_ortho // irr0 cfclass1 // inE irr_eq1. -Qed. - -Lemma seqInd_ortho_cfuni : {in S, forall phi, '[phi, '1_K] = 0}. -Proof. -move=> phi /seqInd_ortho_Ind1/eqP; apply: contraTeq => not_o_phi_1K. -by rewrite cfInd_cfun1 // cfdotZr rmorph_nat mulf_neq0. -Qed. - -Lemma seqInd_ortho_1 : {in S, forall phi, '[phi, 1] = 0}. -Proof. -move=> _ /seqInd_sub/seqIndC1P[i nzi ->]. -by rewrite -cfdot_Res_r cfRes_cfun1 // -irr0 cfdot_irr (negbTE nzi). -Qed. - -Lemma sum_seqIndD_square : - H <| L -> M <| L -> M \subset H -> - \sum_(phi <- S) phi 1%g ^+ 2 / '[phi] = #|L : H|%:R * (#|H : M|%:R - 1). -Proof. -move=> nsHL nsML sMH; rewrite -(Lagrange_index sKL sHK) natrM -/e -mulrA. -rewrite -sum_Iirr_kerD_square ?(normalS _ sKL) ?(subset_trans sMH) //. -pose h i := @Ordinal (size S).+1 _ (index_size ('Ind 'chi[K]_i) S). -rewrite (partition_big h (ltn^~ (size S))) => /= [|i Xi]; last first. - by rewrite index_mem mem_seqInd. -rewrite big_distrr big_ord_narrow //= big_index_uniq ?seqInd_uniq //=. -apply: eq_big_seq => phi Sphi; rewrite /eq_op insubT ?index_mem //= => _. -have /seqIndP[i kHMi def_phi] := Sphi. -have/cfunP/(_ 1%g) := scaled_cfResInd_sum_cfclass i nsKL. -rewrite !cfunE sum_cfunE -def_phi cfResE // mulrAC => ->; congr (_ * _). -rewrite reindex_cfclass //=; apply/esym/eq_big => j; last by rewrite !cfunE. -rewrite (sameP (cfclass_Ind_irrP _ _ nsKL) eqP) -def_phi -mem_seqInd //. -by apply/andP/eqP=> [[Sj /eqP/(congr1 (nth 0 S))] | ->]; rewrite ?nth_index. -Qed. - -Section Odd. - -Hypothesis oddL : odd #|L|. - -Lemma seqInd_conjC_ortho : {in S, forall phi, '[phi, phi^*] = 0}. -Proof. -by move=> _ /seqInd_sub/seqIndC1P[i nzi ->]; apply: odd_induced_orthogonal. -Qed. - -Lemma seqInd_conjC_neq : {in S, forall phi, phi^* != phi}%CF. -Proof. -move=> phi Sphi; apply: contraNneq (cfnorm_seqInd_neq0 Sphi) => {2}<-. -by rewrite seqInd_conjC_ortho. -Qed. - -Lemma seqInd_notReal : ~~ has cfReal S. -Proof. exact/hasPn/seqInd_conjC_neq. Qed. - -Lemma seqInd_nontrivial chi : chi \in S -> (1 < size S)%N. -Proof. -move=> Schi; pose S2 := chi^*%CF :: chi. -have: {subset S2 <= S} by apply/allP/and3P; rewrite /= cfAut_seqInd. -by apply: uniq_leq_size; rewrite /= inE seqInd_conjC_neq. -Qed. - -Variable chi : 'CF(L). -Hypotheses (irr_chi : chi \in irr L) (Schi : chi \in S). - -Lemma seqInd_conjC_ortho2 : orthonormal (chi :: chi^*)%CF. -Proof. -by rewrite /orthonormal/= cfnorm_conjC irrWnorm ?seqInd_conjC_ortho ?eqxx. -Qed. - -Lemma seqInd_nontrivial_irr : (#|[set i | 'chi_i \in S]| > 1)%N. -Proof. -have /irrP[i Dchi] := irr_chi; rewrite (cardsD1 i) (cardsD1 (conjC_Iirr i)). -rewrite !inE -(inj_eq irr_inj) conjC_IirrE -Dchi seqInd_conjC_neq //. -by rewrite cfAut_seqInd Schi. -Qed. - -End Odd. - -End SeqIndD. - -Lemma sum_seqIndC1_square : - \sum_(phi <- seqIndD K 1) phi 1%g ^+ 2 / '[phi] = e * (#|K|%:R - 1). -Proof. by rewrite sum_seqIndD_square ?normal1 ?sub1G // indexg1. Qed. - -End InducedIrrs. - -Arguments seqIndP [gT K L calX phi]. -Arguments seqIndC1P [gT K L phi]. - -Section Five. - -Variable gT : finGroupType. - -Section Defs. - -Variables L G : {group gT}. - -(* This is Peterfalvi, Definition (5.1). *) -(* We depart from the text in Section 5 on three points: *) -(* - We drop non-triviality condition in Z[S, A], which is not used *) -(* consistently in the rest of the proof. In particular, it is *) -(* incompatible with the use of "not coherent" in (6.2), and it is only *) -(* really used in (7.8), where it is equivalent to the simpler condition *) -(* (size S > 1). For us the empty S is coherent; this avoids duplicate *) -(* work in some inductive proofs, e.g., subcoherent_norm - Lemma (5.4) - *) -(* below. *) -(* - The preconditions for coherence (A < L, S < Z[irr L], and tau Z-linear *) -(* on some E < Z[irr L]) are not part of the definition of "coherent". *) -(* These will be captured as separate requirements; in particular in the *) -(* Odd Order proof tau will always be C-linear on all of 'CF(L). *) -(* - By contrast, our "coherent" only supplies an additive (Z-linear) *) -(* isometry, where the source text ambiguously specifies a "linear" one. *) -(* When S consists of virtual characters this implies the existence of *) -(* a C-linear one: the linear extension of the restriction of the *) -(* isometry to a basis of the Z-module Z[S]. The latter can be found from *) -(* the Smith normal form (see intdiv.v) of the coordinate matrix of S. *) -(* The weaker Z-linearity lets us use the dual_iso construction when *) -(* size S = 2. *) -(* Finally, note that although we have retained the A parameter, in the *) -(* sequel we shall always take A = L^#, as in the text it is always the case *) -(* that Z[S, A] = Z[S, L^#]. *) -Definition coherent_with S A tau (tau1 : {additive 'CF(L) -> 'CF(G)}) := - {in 'Z[S], isometry tau1, to 'Z[irr G]} /\ {in 'Z[S, A], tau1 =1 tau}. - -Definition coherent S A tau := exists tau1, coherent_with S A tau tau1. - -(* This is Peterfalvi, Hypothesis (5.2). *) -(* The Z-linearity constraint on tau will be expressed by an additive or *) -(* linear structure on tau. *) -Definition subcoherent S tau R := - [/\ (*a*) [/\ {subset S <= character}, ~~ has cfReal S & cfConjC_closed S], - (*b*) {in 'Z[S, L^#], isometry tau, to 'Z[@irr gT G, G^#]}, - (*c*) pairwise_orthogonal S, - (*d*) {in S, forall xi : 'CF(L : {set gT}), - [/\ {subset R xi <= 'Z[irr G]}, orthonormal (R xi) - & tau (xi - xi^*%CF) = \sum_(alpha <- R xi) alpha]} - & (*e*) {in S &, forall xi phi : 'CF(L), - orthogonal phi (xi :: xi^*%CF) -> orthogonal (R phi) (R xi)}]. - -Definition dual_iso (nu : {additive 'CF(L) -> 'CF(G)}) := - [additive of -%R \o nu \o cfAut conjC]. - -End Defs. - -Section SubsetCoherent. - -Variables L G : {group gT}. -Implicit Type tau : 'CF(L) -> 'CF(G). - -Lemma subgen_coherent S1 S2 A tau: - {subset S2 <= 'Z[S1]} -> coherent S1 A tau -> coherent S2 A tau. -Proof. -move/zchar_trans=> sS21 [tau1 [[Itau1 Ztau1] def_tau]]. -exists tau1; split; last exact: sub_in1 def_tau. -by split; [apply: sub_in2 Itau1 | apply: sub_in1 Ztau1]. -Qed. - -Lemma subset_coherent S1 S2 A tau: - {subset S2 <= S1} -> coherent S1 A tau -> coherent S2 A tau. -Proof. -by move=> sS21; apply: subgen_coherent => phi /sS21/mem_zchar->. -Qed. - -Lemma subset_coherent_with S1 S2 A tau (tau1 : {additive 'CF(L) -> 'CF(G)}) : - {subset S1 <= S2} -> coherent_with S2 A tau tau1 -> - coherent_with S1 A tau tau1. -Proof. -move=> /zchar_subset sS12 [Itau1 Dtau1]. -by split=> [|xi /sS12/Dtau1//]; apply: sub_iso_to Itau1. -Qed. - -Lemma perm_eq_coherent S1 S2 A tau: - perm_eq S1 S2 -> coherent S1 A tau -> coherent S2 A tau. -Proof. -by move=> eqS12; apply: subset_coherent => phi; rewrite (perm_eq_mem eqS12). -Qed. - -Lemma dual_coherence S tau R nu : - subcoherent S tau R -> coherent_with S L^# tau nu -> (size S <= 2)%N -> - coherent_with S L^# tau (dual_iso nu). -Proof. -move=> [[charS nrS ccS] _ oSS _ _] [[Inu Znu] Dnu] szS2. -split=> [|{Inu Znu oSS} phi ZSphi]. - have{oSS} ccZS := cfAut_zchar ccS. - have vcharS: {subset S <= 'Z[irr L]} by move=> phi /charS/char_vchar. - split=> [phi1 phi2 Sphi1 Sphi2 | phi Sphi]. - rewrite cfdotNl cfdotNr opprK Inu ?ccZS // cfdot_conjC aut_Cint //. - by rewrite Cint_cfdot_vchar ?(zchar_sub_irr vcharS). - by rewrite rpredN Znu ?ccZS. -rewrite -{}Dnu //; move: ZSphi; rewrite zcharD1E => /andP[]. -case/zchar_nth_expansion=> x Zx -> {phi} /=. -case: S charS nrS ccS szS2 x Zx => [_ _ _ _ x _| eta S1]. - by rewrite big_ord0 !raddf0. -case/allP/andP=> Neta _ /norP[eta'c _] /allP/andP[S1_etac _]. -rewrite inE [_ == _](negPf eta'c) /= in S1_etac. -case S1E: S1 S1_etac => [|u []] // /predU1P[] //= <- _ z Zz. -rewrite big_ord_recl big_ord1 !raddfD !raddfZ_Cint //=. -rewrite !cfunE (conj_Cnat (Cnat_char1 Neta)) -mulrDl mulf_eq0. -rewrite addr_eq0 char1_eq0 // !scalerN /= cfConjCK addrC. -by case/pred2P => ->; rewrite ?raddf0 //= !scaleNr opprK. -Qed. - -Lemma coherent_seqInd_conjCirr S tau R nu r : - subcoherent S tau R -> coherent_with S L^# tau nu -> - let chi := 'chi_r in let chi2 := (chi :: chi^*)%CF in - chi \in S -> - [/\ {subset map nu chi2 <= 'Z[irr G]}, orthonormal (map nu chi2), - chi - chi^*%CF \in 'Z[S, L^#] & (nu chi - nu chi^*)%CF 1%g == 0]. -Proof. -move=> [[charS nrS ccS] [_ Ztau] oSS _ _] [[Inu Znu] Dnu] chi chi2 Schi. -have sSZ: {subset S <= 'Z[S]} by apply: mem_zchar. -have vcharS: {subset S <= 'Z[irr L]} by move=> phi /charS/char_vchar. -have Schi2: {subset chi2 <= 'Z[S]} by apply/allP; rewrite /= !sSZ ?ccS. -have Schi_diff: chi - chi^*%CF \in 'Z[S, L^#]. - by rewrite sub_aut_zchar // zchar_onG sSZ ?ccS. -split=> // [_ /mapP[xi /Schi2/Znu ? -> //]||]. - apply: map_orthonormal; first by apply: sub_in2 Inu; apply: zchar_trans_on. - rewrite orthonormalE (conjC_pair_orthogonal ccS) //=. - by rewrite cfnorm_conjC !cfnorm_irr !eqxx. -by rewrite -raddfB -cfunD1E Dnu // irr_vchar_on ?Ztau. -Qed. - -(* There is a simple, direct way of establishing that S is coherent when S *) -(* has a pivot character eta1 whose degree divides the degree of all other *) -(* eta_i in S, as then (eta_i - a_i *: eta1)_i>1 will be a basis of Z[S, L^#] *) -(* for some integers a_i. In that case we just need to find a virtual *) -(* character zeta1 of G with the same norm as eta1, and the same dot product *) -(* on the image of the eta_i - a_i *: eta1 under tau, for then the linear *) -(* extension of tau that assigns zeta1 to eta1 is an isometry. *) -(* This is used casually by Peterfalvi, e.g., in (5.7), but a rigorous *) -(* proof does require some work, which is best factored as a Lemma. *) -Lemma pivot_coherence S (tau : {additive 'CF(L) -> 'CF(G)}) R eta1 zeta1 : - subcoherent S tau R -> eta1 \in S -> zeta1 \in 'Z[irr G] -> - {in [predD1 S & eta1], forall eta : 'CF(L), - exists2 a, a \in Cnat /\ eta 1%g = a * eta1 1%g - & '[tau (eta - a *: eta1), zeta1] = - a * '[eta1]} -> - '[zeta1] = '[eta1] -> - coherent S L^# tau. -Proof. -case=> -[N_S _ _] [Itau Ztau] oSS _ _ Seta1 Zzeta1 isoS Izeta1. -have freeS := orthogonal_free oSS; have uniqS := free_uniq freeS. -have{oSS} [/andP[S'0 _] oSS] := pairwise_orthogonalP oSS. -pose d := eta1 1%g; pose a (eta : 'CF(L)) := truncC (eta 1%g / d). -have{S'0} nzd: d != 0 by rewrite char1_eq0 ?N_S ?(memPn S'0). -pose S1 := eta1 :: [seq eta - eta1 *+ a eta | eta <- rem eta1 S]. -have sS_ZS1: {subset S <= 'Z[S1]}; last apply: (subgen_coherent sS_ZS1). - have Zeta1: eta1 \in 'Z[S1] by rewrite mem_zchar ?mem_head. - apply/allP; rewrite (eq_all_r (perm_eq_mem (perm_to_rem Seta1))) /= Zeta1. - apply/allP=> eta Seta; rewrite -(rpredBr eta (rpredMn (a eta) Zeta1)). - exact/mem_zchar/mem_behead/map_f. -have{sS_ZS1} freeS1: free S1. - have Sgt0: (0 < size S)%N by case: (S) Seta1. - rewrite /free eqn_leq dim_span /= size_map size_rem ?prednK // -(eqnP freeS). - by apply/dimvS/span_subvP => eta /sS_ZS1/zchar_span. -pose iso_eta1 zeta := zeta \in 'Z[S, L^#] /\ '[tau zeta, zeta1] = '[zeta, eta1]. -have{isoS} isoS: {in behead S1, forall zeta, iso_eta1 zeta}. - rewrite /iso_eta1 => _ /mapP[eta Seta ->]; rewrite mem_rem_uniq // in Seta. - have{Seta} [/isoS[q [Nq Dq] Itau_eta1] [eta1'eta Seta]] := (Seta, andP Seta). - rewrite zcharD1E rpredB ?rpredMn ?mem_zchar //= -scaler_nat /a Dq mulfK //. - by rewrite truncCK // !cfunE Dq subrr cfdotBl cfdotZl -mulNr oSS ?add0r. -have isoS1: {in S1, isometry [eta tau with eta1 |-> zeta1], to 'Z[irr G]}. - split=> [xi eta | eta]; rewrite !in_cons /=; last first. - by case: eqP => [-> | _ /isoS[/Ztau/zcharW]]. - do 2!case: eqP => [-> _|_ /isoS[? ?]] //; last exact: Itau. - by apply/(can_inj (@conjCK _)); rewrite -!cfdotC. -have [nu Dnu IZnu] := Zisometry_of_iso freeS1 isoS1. -exists nu; split=> // phi; rewrite zcharD1E => /andP[]. -case/(zchar_expansion (free_uniq freeS1)) => b Zb {phi}-> phi1_0. -have{phi1_0} b_eta1_0: b eta1 = 0. - have:= phi1_0; rewrite sum_cfunE big_cons big_seq big1 ?addr0 => [|zeta]. - by rewrite !cfunE (mulIr_eq0 _ (mulIf nzd)) => /eqP. - by case/isoS; rewrite cfunE zcharD1E => /andP[_ /eqP->] _; rewrite mulr0. -rewrite !raddf_sum; apply/eq_big_seq=> xi S1xi; rewrite !raddfZ_Cint //=. -by rewrite Dnu //=; case: eqP => // ->; rewrite b_eta1_0 !scale0r. -Qed. - -End SubsetCoherent. - -(* This is Peterfalvi (5.3)(a). *) -Lemma irr_subcoherent (L G : {group gT}) S tau : - cfConjC_subset S (irr L) -> ~~ has cfReal S -> - {in 'Z[S, L^#], isometry tau, to 'Z[irr G, G^#]} -> - {R | subcoherent S tau R}. -Proof. -case=> uniqS irrS ccS nrS [isoL Ztau]. -have N_S: {subset S <= character} by move=> _ /irrS/irrP[i ->]; apply: irr_char. -have Z_S: {subset S <= 'Z[irr L]} by move=> chi /N_S/char_vchar. -have o1S: orthonormal S by apply: sub_orthonormal (irr_orthonormal L). -have [[_ dotSS] oS] := (orthonormalP o1S, orthonormal_orthogonal o1S). -pose beta chi := tau (chi - chi^*%CF); pose eqBP := _ =P beta _. -have Zbeta: {in S, forall chi, chi - (chi^*)%CF \in 'Z[S, L^#]}. - move=> chi Schi; rewrite /= zcharD1E rpredB ?mem_zchar ?ccS //= !cfunE. - by rewrite subr_eq0 conj_Cnat // Cnat_char1 ?N_S. -pose sum_beta chi R := \sum_(alpha <- R) alpha == beta chi. -pose Zortho R := all (mem 'Z[irr G]) R && orthonormal R. -have R chi: {R : 2.-tuple 'CF(G) | (chi \in S) ==> sum_beta chi R && Zortho R}. - apply: sigW; case Schi: (chi \in S) => /=; last by exists [tuple 0; 0]. - move/(_ _ Schi) in Zbeta; have /irrP[i def_chi] := irrS _ Schi. - have: '[beta chi] = 2%:R. - rewrite isoL // cfnormBd ?dotSS ?ccS ?eqxx // eq_sym -/(cfReal _). - by rewrite (negPf (hasPn nrS _ _)). - case/zchar_small_norm; rewrite ?(zcharW (Ztau _ _)) // => R [oR ZR sumR]. - by exists R; apply/and3P; split; [apply/eqP | apply/allP | ]. -exists (fun xi => val (val (R xi))); split=> // [chi Schi | chi phi Schi Sphi]. - by case: (R chi) => Rc /=; rewrite Schi => /and3P[/eqBP-> /allP]. -case/andP => /and3P[/=/eqP-opx /eqP-opx' _] _. -have{opx opx'} obpx: '[beta phi, beta chi] = 0. - rewrite isoL ?Zbeta // cfdotBl !cfdotBr -{3}[chi]cfConjCK. - by rewrite !cfdot_conjC opx opx' rmorph0 !subr0. -case: (R phi) => [[[|a [|b []]] //= _]]. -rewrite Sphi => /and3P[/eqBP sum_ab Zab o_ab]. -case: (R chi) => [[[|c [|d []]] //= _]]. -rewrite Schi => /and3P[/eqBP-sum_cd Zcd o_cd]. -suffices: orthonormal [:: a; - b; c; d]. - rewrite (orthonormal_cat [:: a; _]) => /and3P[_ _]. - by rewrite /orthogonal /= !cfdotNl !oppr_eq0. -apply: vchar_pairs_orthonormal 1 (-1) _ _ _ _. -- by split; apply/allP; rewrite //= rpredN. -- by rewrite o_cd andbT /orthonormal/= cfnormN /orthogonal /= cfdotNr !oppr_eq0. -- by rewrite oppr_eq0 oner_eq0 rpredN rpred1. -rewrite !(big_seq1, big_cons) in sum_ab sum_cd. -rewrite scale1r scaleN1r !opprK sum_ab sum_cd obpx eqxx /=. -by rewrite !(cfun_on0 (zchar_on (Ztau _ _))) ?Zbeta ?inE ?eqxx. -Qed. - -(* This is Peterfalvi (5.3)(b). *) -Lemma prDade_subcoherent (G L K H W W1 W2 : {group gT}) A A0 S - (defW : W1 \x W2 = W) (ddA : prime_Dade_hypothesis G L K H A A0 defW) - (w_ := fun i j => cyclicTIirr defW i j) (sigma := cyclicTIiso ddA) - (mu := primeTIred ddA) (delta := fun j => primeTIsign ddA j) - (tau := Dade ddA) : - let dsw j k := [seq delta j *: sigma (w_ i k) | i : Iirr W1] in - let Rmu j := dsw j j ++ map -%R (dsw j (conjC_Iirr j)) in - cfConjC_subset S (seqIndD K L H 1) -> ~~ has cfReal S -> - {R | [/\ subcoherent S tau R, - {in [predI S & irr L] & irr W, - forall phi w, orthogonal (R phi) (sigma w)} - & forall j, R (mu j) = Rmu j ]}. -Proof. -pose mu2 i j := primeTIirr ddA i j. -set S0 := seqIndD K L H 1 => dsw Rmu [uS sSS0 ccS] nrS. -have nsKL: K <| L by have [[/sdprod_context[]]] := prDade_prTI ddA. -have /subsetD1P[sAK notA1]: A \subset K^# by have [_ []] := prDade_def ddA. -have [_ _ defA0] := prDade_def ddA. -have defSA: 'Z[S, L^#] =i 'Z[S, A]. - have sS0A1: {subset S0 <= 'CF(L, 1%g |: A)}. - move=> _ /seqIndP[i /setDP[_ kerH'i] ->]; rewrite inE in kerH'i. - exact: (prDade_Ind_irr_on ddA) kerH'i. - move=> phi; have:= zcharD1_seqInd_Dade nsKL notA1 sS0A1 phi. - rewrite !{1}(zchar_split _ A, zchar_split _ L^#) => eq_phiAL. - by apply: andb_id2l => /(zchar_subset sSS0) S0phi; rewrite S0phi in eq_phiAL. -have Itau: {in 'Z[S, L^#], isometry tau, to 'Z[irr G, G^#]}. - apply: sub_iso_to sub_refl (Dade_Zisometry _) => phi; rewrite defSA => SAphi. - rewrite defA0; apply: zchar_onS (subsetUl _ _) _ _. - by apply: zchar_sub_irr SAphi => ? /sSS0/seqInd_vcharW. -have orthoS: pairwise_orthogonal S. - exact: sub_pairwise_orthogonal sSS0 uS (seqInd_orthogonal nsKL _). -pose S1 := filter (mem (irr L)) S. -have sS1S: {subset S1 <= S} by apply/mem_subseq/filter_subseq. -have sZS1S: {subset 'Z[S1, L^#] <= 'Z[S, L^#]}. - by apply: zchar_subset sS1S; apply: orthogonal_free. -have [||R1 cohR1] := irr_subcoherent _ _ (sub_iso_to sZS1S sub_refl Itau). -- split=> [|phi|phi]; rewrite ?mem_filter ?filter_uniq //; try case/andP=> //. - by case/irrP=> i {2}-> /=/ccS->; rewrite cfConjC_irr. -- by apply/hasPn=> phi /sS1S/(hasPn nrS). -have{cohR1} [[charS1 _ _] _ _ R1ok R1ortho] := cohR1. -pose R phi := oapp Rmu (R1 phi) [pick j | phi == mu j]. -have inS1 phi: [pred j | phi == mu j] =1 pred0 -> phi \in S -> phi \in S1. - move=> mu'phi Sphi; rewrite mem_filter Sphi andbT /=. - have{Sphi} /seqIndP[ell _ Dphi] := sSS0 _ Sphi; rewrite Dphi. - have [[j Dell] | [] //] := prTIres_irr_cases ddA ell. - by have /=/eqP[] := mu'phi j; rewrite Dphi Dell cfInd_prTIres. -have Smu_nz j: mu j \in S -> j != 0. - move/(hasPn nrS); apply: contraNneq => ->. - by rewrite /cfReal -(prTIred_aut ddA) aut_Iirr0. -have oS1sigma phi: phi \in S1 -> orthogonal (R1 phi) (map sigma (irr W)). - move=> S1phi; have [zR1 oR1] := R1ok _ S1phi; set psi := _ - _=> Dpsi. - suffices o_psi_sigma: orthogonal (tau psi) (map sigma (irr W)). - apply/orthogonalP=> aa sw R1aa Wsw; have:= orthoPl o_psi_sigma _ Wsw. - have{sw Wsw} /dirrP[bw [lw ->]]: sw \in dirr G. - have [_ /(cycTIirrP defW)[i [j ->]] ->] := mapP Wsw. - exact: cycTIiso_dirr. - have [|ba [la Daa]] := vchar_norm1P (zR1 _ R1aa). - by have [_ -> //] := orthonormalP oR1; rewrite eqxx. - rewrite Daa cfdotZl !cfdotZr cfdot_irr. - case: eqP => [<-{lw} | _ _]; last by rewrite !mulr0. - move/(congr1 ( *%R ((-1) ^+ (ba (+) bw))^*)); rewrite mulr0 => /eqP/idPn[]. - rewrite mulrA -rmorphM -signr_addb {bw}addbK -cfdotZr -{ba la}Daa. - rewrite Dpsi -(eq_bigr _ (fun _ _ => scale1r _)). - by rewrite cfproj_sum_orthonormal ?oner_eq0. - apply/orthoPl=> _ /mapP[_ /(cycTIirrP defW)[i [j ->]] ->]; rewrite -/w_. - pose w1 := #|W1|; pose w2 := #|W2|. - have minw_gt2: (2 < minn w1 w2)%N. - have [[_ ntW1 _ _] [ntW2 _ _] _] := prDade_prTI ddA. - rewrite -(dprod_card defW) odd_mul => /andP[oddW1 oddW2]. - by rewrite leq_min !odd_gt2 ?cardG_gt1. - apply: contraTeq (minw_gt2) => ntNC; rewrite -leqNgt. - pose NC := cyclicTI_NC ddA. - have /andP[/=/irrP[l Dphi] Sphi]: phi \in [predI irr L & S]. - by rewrite mem_filter in S1phi. - have Zpsi: psi \in 'Z[S, L^#]. - rewrite sub_aut_zchar ?mem_zchar_on ?orthogonal_free ?ccS ?cfun_onG //. - by move=> ? /sSS0/seqInd_vcharW. - have NCpsi_le2: (NC (tau psi) <= 2)%N. - have{Itau} [Itau Ztau] := Itau. - suff: '[tau psi] <= 2%:R by apply: cycTI_NC_norm; apply: zcharW (Ztau _ _). - rewrite Itau // cfnormBd; first by rewrite cfnorm_conjC Dphi cfnorm_irr. - have /pairwise_orthogonalP[_ -> //] := orthoS; first exact: ccS. - by rewrite eq_sym (hasPn nrS). - apply: leq_trans (NCpsi_le2). - have: (0 < NC (tau psi) < 2 * minn w1 w2)%N. - rewrite -(subnKC minw_gt2) (leq_ltn_trans NCpsi_le2) // andbT lt0n. - by apply/existsP; exists (i, j); rewrite /= topredE inE. - apply: cycTI_NC_minn (ddA) _ _ => x Vx. - rewrite Dade_id; last by rewrite defA0 inE orbC mem_class_support. - rewrite defSA in Zpsi; rewrite (cfun_on0 (zchar_on Zpsi)) // -in_setC. - by apply: subsetP (subsetP (prDade_supp_disjoint ddA) x Vx); rewrite setCS. -exists R; split=> [|phi w S1phi irr_w|j]; first 1 last. -- rewrite /R; case: pickP => [j /eqP Dphi | _ /=]. - by case/nandP: S1phi; right; rewrite /= Dphi (prTIred_not_irr ddA). - apply/orthoPr=> aa R1aa; rewrite (orthogonalP (oS1sigma phi _)) ?map_f //. - by rewrite mem_filter andbC. -- by rewrite /R; case: pickP => /= [k /eqP/(prTIred_inj ddA)-> | /(_ j)/eqP]. -have Zw i j: w_ i j \in 'Z[irr W] by apply: irr_vchar. -have{oS1sigma} oS1dsw psi j: psi \in S1 -> orthogonal (R1 psi) (dsw _ j). - move/oS1sigma/orthogonalP=> opsiW. - apply/orthogonalP=> aa _ R1aa /codomP[i ->]. - by rewrite cfdotZr opsiW ?map_f ?mem_irr ?mulr0. -have odsw j1 j2: j1 != j2 -> orthogonal (dsw _ j1) (dsw _ j2). - move/negPf=> j2'1; apply/orthogonalP=> _ _ /codomP[i1 ->] /codomP[i2 ->]. - by rewrite cfdotZl cfdotZr (cfdot_cycTIiso ddA) j2'1 andbF !mulr0. -split=> // [|phi Sphi|phi xi Sphi Sxi]. -- by split=> // phi /sSS0; apply: seqInd_char. -- rewrite /R; case: pickP => [j /eqP Dphi /= | /inS1/(_ Sphi)/R1ok//]. - have nz_j: j != 0 by rewrite Smu_nz -?Dphi. - have [Isig Zsig]: {in 'Z[irr W], isometry sigma, to 'Z[irr G]}. - exact: cycTI_Zisometry. - split=> [aa | |]. - - rewrite mem_cat -map_comp. - by case/orP=> /codomP[i ->]; rewrite ?rpredN rpredZsign Zsig. - - rewrite orthonormal_cat orthogonal_oppr odsw ?andbT; last first. - rewrite -(inj_eq (prTIred_inj ddA)) (prTIred_aut ddA) -/mu -Dphi. - by rewrite eq_sym (hasPn nrS). - suffices oNdsw k: orthonormal (dsw j k). - by rewrite map_orthonormal ?oNdsw //; apply: in2W; apply: opp_isometry. - apply/orthonormalP; split=> [|_ _ /codomP[i1 ->] /codomP[i2 ->]]. - rewrite map_inj_uniq ?enum_uniq // => i1 i2 /(can_inj (signrZK _))/eqP. - by rewrite (cycTIiso_eqE ddA) eqxx andbT => /eqP. - rewrite cfdotZl cfdotZr rmorph_sign signrMK (cfdot_cycTIiso ddA). - by rewrite -(cycTIiso_eqE ddA) (inj_eq (can_inj (signrZK _))). - have [Tstruct [tau1 Dtau1 [_ Dtau]]] := uniform_prTIred_coherent ddA nz_j. - have{Tstruct} [/orthogonal_free freeT _ ccT _ _] := Tstruct. - have phi1c: (phi 1%g)^* = phi 1%g := conj_Cnat (Cnat_seqInd1 (sSS0 _ Sphi)). - rewrite -[tau _]Dtau; last first. - rewrite zcharD1E !cfunE phi1c subrr Dphi eqxx andbT. - by rewrite rpredB ?mem_zchar ?ccT ?image_f ?inE // nz_j eqxx. - rewrite linearB Dphi -(prTIred_aut ddA) !Dtau1 -/w_ -/sigma -/(delta j). - by rewrite big_cat /= !big_map !raddf_sum. -rewrite /R; case: pickP => [j1 /eqP Dxi | /inS1/(_ Sxi)S1xi]; last first. - case: pickP => [j2 _ _ | /inS1/(_ Sphi)S1phi]; last exact: R1ortho. - by rewrite orthogonal_catr orthogonal_oppr !oS1dsw. -case: pickP => [j2 /eqP Dphi | /inS1/(_ Sphi)S1phi _]; last first. - by rewrite orthogonal_sym orthogonal_catr orthogonal_oppr !oS1dsw. -case/andP=> /and3P[/= /eqP o_xi_phi /eqP o_xi_phi'] _ _. -have /eqP nz_xi: '[xi] != 0 := cfnorm_seqInd_neq0 nsKL (sSS0 _ Sxi). -have [Dj1 | j2'1] := eqVneq j1 j2. - by rewrite {2}Dxi Dj1 -Dphi o_xi_phi in nz_xi. -have [Dj1 | j2c'1] := eqVneq j1 (conjC_Iirr j2). - by rewrite {2}Dxi Dj1 /mu (prTIred_aut ddA) -/mu -Dphi o_xi_phi' in nz_xi. -rewrite orthogonal_catl orthogonal_oppl !orthogonal_catr !orthogonal_oppr. -by rewrite !odsw ?(inv_eq (@conjC_IirrK _ _)) ?conjC_IirrK. -Qed. - -Section SubCoherentProperties. - -Variables (L G : {group gT}) (S : seq 'CF(L)) (R : 'CF(L) -> seq 'CF(G)). -Variable tau : {linear 'CF(L) -> 'CF(G)}. -Hypothesis cohS : subcoherent S tau R. - -Lemma nil_coherent A : coherent [::] A tau. -Proof. -exists [additive of 'Ind[G]]; split=> [|u /zchar_span]; last first. - by rewrite span_nil memv0 => /eqP-> /=; rewrite !raddf0. -split=> [u v | u] /zchar_span; rewrite span_nil memv0 => /eqP->. - by rewrite raddf0 !cfdot0l. -by rewrite raddf0 rpred0. -Qed. - -Lemma subset_subcoherent S1 : cfConjC_subset S1 S -> subcoherent S1 tau R. -Proof. -case=> uS1 sS1 ccS1; have [[N_S nrS _] Itau oS defR oR] := cohS. -split; last 1 [exact: sub_in1 defR | exact: sub_in2 oR]. -- split=> // [xi /sS1/N_S// | ]. - by apply/hasPn; apply: sub_in1 (hasPn nrS). -- by apply: sub_iso_to Itau => //; apply: zchar_subset. -exact: sub_pairwise_orthogonal oS. -Qed. - -Lemma subset_ortho_subcoherent S1 chi : - {subset S1 <= S} -> chi \in S -> chi \notin S1 -> orthogonal S1 chi. -Proof. -move=> sS1S Schi S1'chi; apply/orthoPr=> phi S1phi; have Sphi := sS1S _ S1phi. -have [_ _ /pairwise_orthogonalP[_ -> //]] := cohS. -by apply: contraNneq S1'chi => <-. -Qed. - -Lemma subcoherent_split chi beta : - chi \in S -> beta \in 'Z[irr G] -> - exists2 X, X \in 'Z[R chi] - & exists Y, [/\ beta = X - Y, '[X, Y] = 0 & orthogonal Y (R chi)]. -Proof. -move=> Schi Zbeta; have [_ _ _ /(_ _ Schi)[ZR oRR _] _] := cohS. -have [X RX [Y [defXY oXY oYR]]] := orthogonal_split (R chi) beta. -exists X; last first. - by exists (- Y); rewrite opprK (orthogonal_oppl Y) cfdotNr oXY oppr0. -have [_ -> ->] := orthonormal_span oRR RX; rewrite big_seq rpred_sum // => a Ra. -rewrite rpredZ_Cint ?mem_zchar // -(addrK Y X) -defXY. -by rewrite cfdotBl (orthoPl oYR) // subr0 Cint_cfdot_vchar // ZR. -Qed. - -(* This is Peterfalvi (5.4). *) -(* The assumption X \in 'Z[R chi] has been weakened to '[X, Y] = 0; this *) -(* stronger form of the lemma is needed to strengthen the proof of (5.6.3) so *) -(* that it can actually be reused in (9.11.8), as the text suggests. *) -Lemma subcoherent_norm chi psi (tau1 : {additive 'CF(L) -> 'CF(G)}) X Y : - [/\ chi \in S, psi \in 'Z[irr L] & orthogonal (chi :: chi^*)%CF psi] -> - let S0 := chi - psi :: chi - chi^*%CF in - {in 'Z[S0], isometry tau1, to 'Z[irr G]} -> - tau1 (chi - chi^*%CF) = tau (chi - chi^*%CF) -> - [/\ tau1 (chi - psi) = X - Y, '[X, Y] = 0 & orthogonal Y (R chi)] -> - [/\ (*a*) '[chi] <= '[X] - & (*b*) '[psi] <= '[Y] -> - [/\ '[X] = '[chi], '[Y] = '[psi] - & exists2 E, subseq E (R chi) & X = \sum_(xi <- E) xi]]. -Proof. -case=> Schi Zpsi /and3P[/andP[/eqP-ochi_psi _] /andP[/eqP-ochic_psi _] _] S0. -move=> [Itau1 Ztau1] tau1dchi [defXY oXY oYR]. -have [[ZS nrS ccS] [tS Zt] oS /(_ _ Schi)[ZR o1R tau_dchi] _] := cohS. -have [/=/andP[S'0 uS] oSS] := pairwise_orthogonalP oS. -have [nRchi Schic] := (hasPn nrS _ Schi, ccS _ Schi). -have ZtauS00: tau1 S0`_0 \in 'Z[irr G] by rewrite Ztau1 ?mem_zchar ?mem_head. -have{ZtauS00} [X1 R_X1 [Y1 [dXY1 oXY1 oY1R]]] := subcoherent_split Schi ZtauS00. -have [uR _] := orthonormalP o1R; have [a Za defX1] := zchar_expansion uR R_X1. -have dotS00R xi: xi \in R chi -> '[tau1 S0`_0, xi] = a xi. - move=> Rxi; rewrite dXY1 cfdotBl (orthoPl oY1R) // subr0. - by rewrite defX1 cfproj_sum_orthonormal. -have nchi: '[chi] = \sum_(xi <- R chi) a xi. - transitivity '[tau1 S0`_0, tau1 S0`_1]; last first. - by rewrite tau1dchi tau_dchi cfdot_sumr; apply: eq_big_seq dotS00R. - rewrite [RHS]cfdotC Itau1 ?mem_zchar ?mem_nth // cfdotBl !cfdotBr. - by rewrite ochi_psi ochic_psi (oSS chi^*%CF) // !subr0 -cfdotC. -have normX: '[X1] <= '[X] ?= iff (X == X1). - rewrite -[in '[X]](subrK X1 X) -subr_eq0 cfnormDd. - by rewrite -lerif_subLR subrr -cfnorm_eq0 eq_sym; apply/lerif_eq/cfnorm_ge0. - rewrite defX1 cfdot_sumr big1_seq // => xi Rxi. - rewrite cfdotZr cfdotBl cfproj_sum_orthonormal // -{2}dotS00R // defXY. - by rewrite cfdotBl (orthoPl oYR) // subr0 subrr mulr0. -pose is01a xi := a xi == (a xi != 0)%:R. -have leXa xi: a xi <= `|a xi| ^+ 2 ?= iff is01a xi. - rewrite Cint_normK //; split; first by rewrite Cint_ler_sqr. - rewrite eq_sym -subr_eq0 -[lhs in _ - lhs]mulr1 -mulrBr mulf_eq0 subr_eq0. - by rewrite /is01a; case a_xi_0: (a xi == 0). -have{nchi normX} part_a: '[chi] <= '[X] ?= iff all is01a (R chi) && (X == X1). - apply: lerif_trans normX; rewrite nchi defX1 cfnorm_sum_orthonormal //. - by rewrite -big_all !(big_tnth _ _ (R chi)) big_andE; apply: lerif_sum. -split=> [|/lerif_eq part_b]; first by case: part_a. -have [_ /esym] := lerif_add part_a part_b; rewrite -!cfnormBd // -defXY. -rewrite Itau1 ?mem_zchar ?mem_head // eqxx => /andP[a_eq /eqP->]. -split=> //; first by apply/esym/eqP; rewrite part_a. -have{a_eq} [/allP a01 /eqP->] := andP a_eq; rewrite defX1. -exists [seq xi <- R chi | a xi != 0]; first exact: filter_subseq. -rewrite big_filter [rhs in _ = rhs]big_mkcond /=. -by apply: eq_big_seq => xi Rxi; rewrite -mulrb -scaler_nat -(eqP (a01 _ _)). -Qed. - -(* This is Peterfalvi (5.5). *) -Lemma coherent_sum_subseq chi (tau1 : {additive 'CF(L) -> 'CF(G)}) : - chi \in S -> - {in 'Z[chi :: chi^*%CF], isometry tau1, to 'Z[irr G]} -> - tau1 (chi - chi^*%CF) = tau (chi - chi^*%CF) -> - exists2 E, subseq E (R chi) & tau1 chi = \sum_(a <- E) a. -Proof. -set S1 := chi :: _ => Schi [iso_t1 Zt1] t1cc'. -have freeS1: free S1. - have [[_ nrS ccS] _ oS _ _] := cohS. - by rewrite orthogonal_free ?(conjC_pair_orthogonal ccS). -have subS01: {subset 'Z[chi - 0 :: chi - chi^*%CF] <= 'Z[S1]}. - apply: zchar_trans setT _; apply/allP; rewrite subr0 /= andbT. - by rewrite rpredB !mem_zchar ?inE ?eqxx ?orbT. -have Zt1c: tau1 (chi - 0) \in 'Z[irr G]. - by rewrite subr0 Zt1 ?mem_zchar ?mem_head. -have [X R_X [Y defXY]] := subcoherent_split Schi Zt1c. -case/subcoherent_norm: (defXY); last 2 [by []]. -- by rewrite Schi rpred0 /orthogonal /= !cfdot0r eqxx. -- by split; [apply: sub_in2 iso_t1 | apply: sub_in1 Zt1]. -move=> _ [|_ /eqP]; rewrite cfdot0l ?cfnorm_ge0 // cfnorm_eq0 => /eqP Y0. -case=> E sER defX; exists E => //; rewrite -defX -[X]subr0 -Y0 -[chi]subr0. -by case: defXY. -Qed. - -(* A reformulation of (5.5) that is more convenient to use. *) -Corollary mem_coherent_sum_subseq S1 chi (tau1 : {additive 'CF(L) -> 'CF(G)}) : - cfConjC_subset S1 S -> coherent_with S1 L^# tau tau1 -> chi \in S1 -> - exists2 E, subseq E (R chi) & tau1 chi = \sum_(a <- E) a. -Proof. -move=> uccS1 [Itau1 Dtau1] S1chi; have [uS1 sS1S ccS1] := uccS1. -have S1chi_s: chi^*%CF \in S1 by apply: ccS1. -apply: coherent_sum_subseq; first exact: sS1S. - by apply: sub_iso_to Itau1 => //; apply: zchar_subset; apply/allP/and3P. -apply: Dtau1; rewrite sub_aut_zchar ?zchar_onG ?mem_zchar // => phi /sS1S-Sphi. -by apply: char_vchar; have [[->]] := cohS. -Qed. - -(* A frequently used consequence of (5.5). *) -Corollary coherent_ortho_supp S1 chi (tau1 : {additive 'CF(L) -> 'CF(G)}) : - cfConjC_subset S1 S -> coherent_with S1 L^# tau tau1 -> - chi \in S -> chi \notin S1 -> - orthogonal (map tau1 S1) (R chi). -Proof. -move=> uccS1 cohS1 Schi S1'chi; have [uS1 sS1S ccS1] := uccS1. -apply/orthogonalP=> _ mu /mapP[phi S1phi ->] Rmu; have Sphi := sS1S _ S1phi. -have [e /mem_subseq Re ->] := mem_coherent_sum_subseq uccS1 cohS1 S1phi. -rewrite cfdot_suml big1_seq // => xi {e Re}/Re Rxi. -apply: orthogonalP xi mu Rxi Rmu; have [_ _ _ _ -> //] := cohS. -rewrite /orthogonal /= !andbT cfdot_conjCr fmorph_eq0. -by rewrite !(orthoPr (subset_ortho_subcoherent sS1S _ _)) ?ccS1 ?eqxx. -Qed. - -(* An even more frequently used corollary of the corollary above. *) -Corollary coherent_ortho S1 S2 (tau1 tau2 : {additive 'CF(L) -> 'CF(G)}) : - cfConjC_subset S1 S -> coherent_with S1 L^# tau tau1 -> - cfConjC_subset S2 S -> coherent_with S2 L^# tau tau2 -> - {subset S2 <= [predC S1]} -> - orthogonal (map tau1 S1) (map tau2 S2). -Proof. -move=> uccS1 cohS1 uccS2 cohS2 S1'2; have [_ sS2S _] := uccS2. -apply/orthogonalP=> mu _ S1mu /mapP[phi S2phi ->]. -have [e /mem_subseq Re ->] := mem_coherent_sum_subseq uccS2 cohS2 S2phi. -rewrite cfdot_sumr big1_seq // => xi {e Re}/Re; apply: orthogonalP mu xi S1mu. -by apply: coherent_ortho_supp; rewrite ?sS2S //; apply: S1'2. -Qed. - -(* A glueing lemma exploiting the corollary above. *) -Lemma bridge_coherent S1 S2 (tau1 tau2 : {additive 'CF(L) -> 'CF(G)}) chi phi : - cfConjC_subset S1 S -> coherent_with S1 L^# tau tau1 -> - cfConjC_subset S2 S -> coherent_with S2 L^# tau tau2 -> - {subset S2 <= [predC S1]} -> - [/\ chi \in S1, phi \in 'Z[S2] & chi - phi \in 'CF(L, L^#)] -> - tau (chi - phi) = tau1 chi - tau2 phi -> - coherent (S1 ++ S2) L^# tau. -Proof. -move=> uccS1 cohS1 uccS2 cohS2 S1'2 [S1chi S2phi chi1_phi] tau_chi_phi. -do [rewrite cfunD1E !cfunE subr_eq0 => /eqP] in chi1_phi. -have [[uS1 sS1S _] [uS2 sS2S _]] := (uccS1, uccS2). -have [[[Itau1 Ztau1] Dtau1] [[Itau2 Ztau2] Dtau2]] := (cohS1, cohS2). -have [[N_S1 _ _] _ oS11 _ _] := subset_subcoherent uccS1. -have [_ _ oS22 _ _] := subset_subcoherent uccS2. -have nz_chi1: chi 1%g != 0; last move/mem_zchar in S1chi. - by rewrite char1_eq0 ?N_S1 //; have [/memPn->] := andP oS11. -have oS12: orthogonal S1 S2. - apply/orthogonalP=> xi1 xi2 Sxi1 Sxi2; apply: orthoPr xi1 Sxi1. - by rewrite subset_ortho_subcoherent ?sS2S //; apply: S1'2. -set S3 := S1 ++ S2; pose Y := map tau1 S1 ++ map tau2 S2. -have oS3: pairwise_orthogonal S3 by rewrite pairwise_orthogonal_cat oS11 oS22. -have oY: pairwise_orthogonal Y. - by rewrite pairwise_orthogonal_cat !map_pairwise_orthogonal ?coherent_ortho. -have Z_Y: {subset Y <= 'Z[irr G]}. - move=> psi; rewrite mem_cat. - by case/orP=> /mapP[xi /mem_zchar] => [/Ztau1 | /Ztau2]-Zpsi ->. -have normY: map cfnorm Y = map cfnorm (S1 ++ S2). - rewrite !map_cat -!map_comp; congr (_ ++ _). - by apply/eq_in_map => xi S1xi; rewrite /= Itau1 ?mem_zchar. - by apply/eq_in_map => xi S2xi; rewrite /= Itau2 ?mem_zchar. -have [tau3 defY ZItau3] := Zisometry_of_cfnorm oS3 oY normY Z_Y. -have{defY} [defY1 defY2]: {in S1, tau3 =1 tau1} /\ {in S2, tau3 =1 tau2}. - have/eqP := defY; rewrite map_cat eqseq_cat ?size_map //. - by case/andP; split; apply/eq_in_map/eqP. -exists tau3; split=> {ZItau3}// eta; rewrite zcharD1E. -case/andP=> /(zchar_expansion (free_uniq (orthogonal_free oS3)))[b Zb {eta}->]. -pose bS Si := \sum_(xi <- Si) b xi *: xi. -have ZbS Si: bS Si \in 'Z[Si]. - by rewrite /bS big_seq rpred_sum // => eta /mem_zchar/rpredZ_Cint->. -rewrite big_cat /= -!/(bS _) cfunE addrC addr_eq0 linearD => /eqP-bS2_1. -transitivity (tau1 (bS S1) + tau2 (bS S2)). - by rewrite !raddf_sum; congr (_ + _); apply/eq_big_seq=> xi Si_xi; - rewrite !raddfZ_Cint // -(defY1, defY2). -have Z_S1_1 psi: psi \in 'Z[S1] -> psi 1%g \in Cint. - by move/zchar_sub_irr=> Zpsi; apply/Cint_vchar1/Zpsi => ? /N_S1/char_vchar. -apply/(scalerI nz_chi1)/(addIr (- bS S1 1%g *: tau (chi - phi))). -rewrite [in LHS]tau_chi_phi !scalerDr -!raddfZ_Cint ?rpredN ?Z_S1_1 //=. -rewrite addrACA -!raddfD -raddfB !scalerDr !scaleNr scalerN !opprK. -rewrite Dtau2 ?Dtau1 ?zcharD1E ?cfunE; first by rewrite -raddfD addrACA. - by rewrite mulrC subrr rpredB ?rpredZ_Cint ?Z_S1_1 /=. -by rewrite mulrC bS2_1 -chi1_phi mulNr addNr rpredD ?rpredZ_Cint ?Z_S1_1 /=. -Qed. - -(* This is essentially Peterfalvi (5.6.3), which gets reused in (9.11.8). *) -(* While the assumptions are similar to those of the pivot_coherence lemma, *) -(* the two results are mostly independent: here S1 need not have a pivot, and *) -(* extend_coherent_with does not apply to the base case (size S = 2) of *) -(* pivot_coherence, which is almost as hard to prove as the general case. *) -Lemma extend_coherent_with S1 (tau1 : {additive 'CF(L) -> 'CF(G)}) chi phi a X : - cfConjC_subset S1 S -> coherent_with S1 L^# tau tau1 -> - [/\ phi \in S1, chi \in S & chi \notin S1] -> - [/\ a \in Cint, chi 1%g = a * phi 1%g & '[X, a *: tau1 phi] = 0] -> - tau (chi - a *: phi) = X - a *: tau1 phi -> - coherent (chi :: chi^*%CF :: S1) L^# tau. -Proof. -set beta := _ - _ => sS10 cohS1 [S1phi Schi S1'chi] [Za chi1 oXaphi] tau_beta. -have [[uS1 sS1S ccS1] [[Itau1 Ztau1] _]] := (sS10, cohS1). -have [[N_S nrS ccS] ZItau _ R_P _] := cohS; have [Itau Ztau] := ZItau. -have [Sphi [ZR o1R sumR]] := (sS1S _ S1phi, R_P _ Schi). -have Zbeta: beta \in 'Z[S, L^#]. - by rewrite zcharD1E !cfunE -chi1 subrr rpredB ?scale_zchar ?mem_zchar /=. -have o_aphi_R: orthogonal (a *: tau1 phi) (R chi). - have /orthogonalP oS1R := coherent_ortho_supp sS10 cohS1 Schi S1'chi. - by apply/orthoPl=> xi Rxi; rewrite cfdotZl oS1R ?map_f ?mulr0. -have /orthoPl o_chi_S1: orthogonal chi S1. - by rewrite orthogonal_sym subset_ortho_subcoherent. -have Zdchi: chi - chi^*%CF \in 'Z[S, L^#]. - by rewrite sub_aut_zchar ?zchar_onG ?mem_zchar ?ccS // => xi /N_S/char_vchar. -have [||_] := subcoherent_norm _ _ (erefl _) (And3 tau_beta oXaphi o_aphi_R). -- rewrite Schi rpredZ_Cint ?char_vchar ?N_S /orthogonal //= !cfdotZr. - by rewrite cfdot_conjCl !o_chi_S1 ?ccS1 // conjC0 !mulr0 !eqxx. -- apply: sub_iso_to ZItau; [apply: zchar_trans_on; apply/allP | exact: zcharW]. - by rewrite /= Zbeta Zdchi. -case=> [|nX _ [e Re defX]]; first by rewrite !cfnormZ Itau1 ?mem_zchar. -have uR: uniq (R chi) by have [] := orthonormalP o1R. -have{uR} De: e = filter (mem e) (R chi) by apply/subseq_uniqP. -pose ec := filter [predC e] (R chi); pose Xc := - \sum_(xi <- ec) xi. -have defR: perm_eq (e ++ ec) (R chi) by rewrite De perm_filterC. -pose S2 := chi :: chi^*%CF; pose X2 := X :: Xc. -have{nrS} uS2: uniq S2 by rewrite /= andbT inE eq_sym (hasPn nrS). -have sS20: cfConjC_subset S2 S. - by split=> //; apply/allP; rewrite /= ?cfConjCK ?inE ?eqxx ?orbT // ccS Schi. -have oS2: pairwise_orthogonal S2 by have [] := subset_subcoherent sS20. -have nz_chi: chi != 0 by rewrite eq_sym; have [/norP[]] := andP oS2. -have o_chi_chic: '[chi, chi^*] = 0 by have [_ /andP[/andP[/eqP]]] := and3P oS2. -have def_XXc: X - Xc = tau (chi - chi^*%CF). - by rewrite opprK defX -big_cat sumR; apply: eq_big_perm. -have oXXc: '[X, Xc] = 0. - have /span_orthogonal o_e_ec: orthogonal e ec. - by move: o1R; rewrite -(eq_orthonormal defR) orthonormal_cat => /and3P[]. - by rewrite defX /Xc !big_seq o_e_ec ?rpredN ?rpred_sum // => xi /memv_span. -have{o_chi_chic} nXc: '[Xc] = '[chi^*]. - by apply: (addrI '[X]); rewrite -cfnormBd // nX def_XXc Itau // cfnormBd. -have{oXXc} oX2: pairwise_orthogonal X2. - rewrite /pairwise_orthogonal /= oXXc eqxx !inE !(eq_sym 0) -!cfnorm_eq0. - by rewrite nX nXc cfnorm_conjC cfnorm_eq0 orbb nz_chi. -have{nX nXc} nX2: map cfnorm X2 = map cfnorm S2 by congr [:: _; _]. -have [|tau2 [tau2X tau2Xc] Itau2] := Zisometry_of_cfnorm oS2 oX2 nX2. - apply/allP; rewrite /= defX De rpredN !big_seq. - by rewrite !rpred_sum // => xi; rewrite mem_filter => /andP[_ /ZR]. -have{Itau2} cohS2: coherent_with S2 L^# tau tau2. - split=> // psi; rewrite zcharD1E => /andP[/zchar_expansion[//|z Zz ->]]. - rewrite big_cons big_seq1 !cfunE conj_Cnat ?Cnat_char1 ?N_S // addrC addr_eq0. - rewrite -mulNr (inj_eq (mulIf _)) ?char1_eq0 ?N_S // => /eqP->. - by rewrite scaleNr -scalerBr !raddfZ_Cint // raddfB /= tau2X tau2Xc -def_XXc. -have: tau beta = tau2 chi - tau1 (a *: phi) by rewrite tau2X raddfZ_Cint. -apply: (bridge_coherent sS20 cohS2 sS10 cohS1) => //. - by apply/hasPn; rewrite has_sym !negb_or S1'chi (contra (ccS1 _)) ?cfConjCK. -by rewrite mem_head (zchar_on Zbeta) rpredZ_Cint ?mem_zchar. -Qed. - -(* This is Peterfalvi (5.6): Feit's result that a coherent set can always be *) -(* extended by a character whose degree is below a certain threshold. *) -Lemma extend_coherent S1 xi1 chi : - cfConjC_subset S1 S -> xi1 \in S1 -> chi \in S -> chi \notin S1 -> - [/\ (*a*) coherent S1 L^# tau, - (*b*) (xi1 1%g %| chi 1%g)%C - & (*c*) 2%:R * chi 1%g * xi1 1%g < \sum_(xi <- S1) xi 1%g ^+ 2 / '[xi]] -> - coherent (chi :: chi^*%CF :: S1) L^# tau. -Proof. -move=> ccsS1S S1xi1 Schi notS1chi [[tau1 cohS1] xi1_dv_chi1 ub_chi1]. -have [[uS1 sS1S ccS1] [[Itau1 Ztau1] Dtau1]] := (ccsS1S, cohS1). -have{xi1_dv_chi1} [a Za chi1] := dvdCP _ _ xi1_dv_chi1. -have [[N_S nrS ccS] ZItau oS R_P oR] := cohS; have [Itau Ztau] := ZItau. -have [Sxi1 [ZRchi o1Rchi sumRchi]] := (sS1S _ S1xi1, R_P _ Schi). -have ocS1 xi: xi \in S1 -> '[chi, xi] = 0. - by apply: orthoPl; rewrite orthogonal_sym subset_ortho_subcoherent. -have /andP[/memPn/=nzS _] := oS; have [Nchi nz_chi] := (N_S _ Schi, nzS _ Schi). -have oS1: pairwise_orthogonal S1 by apply: sub_pairwise_orthogonal oS. -have [freeS freeS1] := (orthogonal_free oS, orthogonal_free oS1). -have nz_nS1 xi: xi \in S1 -> '[xi] != 0 by rewrite cfnorm_eq0 => /sS1S/nzS. -have nz_xi11: xi1 1%g != 0 by rewrite char1_eq0 ?N_S ?nzS. -have inj_tau1: {in 'Z[S1] &, injective tau1} := Zisometry_inj Itau1. -have Z_S1: {subset S1 <= 'Z[S1]} by move=> xi /mem_zchar->. -have inj_tau1_S1: {in S1 &, injective tau1} := sub_in2 Z_S1 inj_tau1. -pose a_ t1xi := S1`_(index t1xi (map tau1 S1)) 1%g / xi1 1%g / '[t1xi]. -have a_E xi: xi \in S1 -> a_ (tau1 xi) = xi 1%g / xi1 1%g / '[xi]. - by move=> S1xi; rewrite /a_ nth_index_map // Itau1 ?Z_S1. -have a_xi1 : a_ (tau1 xi1) = '[xi1]^-1 by rewrite a_E // -mulrA mulVKf //. -have Zachi: chi - a *: xi1 \in 'Z[S, L^#]. - by rewrite zcharD1E !cfunE -chi1 subrr rpredB ?scale_zchar ?mem_zchar /=. -have Ztau_achi := zcharW (Ztau _ Zachi). -have [X R_X [Y defXY]] := subcoherent_split Schi Ztau_achi. -have [eqXY oXY oYRchi] := defXY; pose X1 := map tau1 (in_tuple S1). -suffices defY: Y = a *: tau1 xi1. - by move: eqXY; rewrite defY; apply: extend_coherent_with; rewrite -?defY. -have oX1: pairwise_orthogonal X1 by apply: map_pairwise_orthogonal. -have N_S1_1 xi: xi \in S1 -> xi 1%g \in Cnat by move/sS1S/N_S/Cnat_char1. -have oRchiX1 psi: psi \in 'Z[R chi] -> orthogonal psi X1. - move/zchar_span=> Rpsi; apply/orthoPl=> chi2 /memv_span. - by apply: span_orthogonal Rpsi; rewrite orthogonal_sym coherent_ortho_supp. -have [lam Zlam [Z oZS1 defY]]: - exists2 lam, lam \in Cint & exists2 Z : 'CF(G), orthogonal Z (map tau1 S1) & - Y = a *: tau1 xi1 - lam *: (\sum_(xi <- X1) a_ xi *: xi) + Z. -- pose lam := a * '[xi1] - '[Y, tau1 xi1]; exists lam. - rewrite rpredD ?mulr_natl ?rpredN //. - by rewrite rpredM // CintE Cnat_cfdot_char ?N_S. - rewrite Cint_cfdot_vchar ?Ztau1 ?Z_S1 // -(subrK X Y) -opprB -eqXY addrC. - by rewrite rpredB // (zchar_trans ZRchi). - set Z' := _ - _; exists (Y - Z'); last by rewrite addrC subrK. - have oXtau1 xi: xi \in S1 -> '[Y, tau1 xi] = - '[X - Y, tau1 xi]. - move=> S1xi; rewrite cfdotBl opprB. - by rewrite (orthogonalP (oRchiX1 X R_X) X) ?subr0 ?mem_head ?map_f. - apply/orthogonalP=> _ _ /predU1P[-> | //] /mapP[xi S1xi ->]. - rewrite !cfdotBl !cfdotZl Itau1 ?mem_zchar //. - rewrite cfproj_sum_orthogonal ?map_f // a_E // Itau1 ?Z_S1 //. - apply: (mulIf nz_xi11); rewrite divfK ?nz_nS1 // 2!mulrBl mulrA divfK //. - rewrite mul0r mulrBl opprB -addrA addrCA addrC !addrA !oXtau1 // !mulNr. - rewrite -(conj_Cnat (N_S1_1 _ S1xi)) -(conj_Cnat (N_S1_1 _ S1xi1)). - rewrite opprK [- _ + _]addrC -!(mulrC _^*) -!cfdotZr -cfdotBr. - rewrite -!raddfZ_Cnat ?N_S1_1 // -raddfB; set beta : 'CF(L) := _ - _. - have Zbeta: beta \in 'Z[S1, L^#]. - rewrite zcharD1E !cfunE mulrC subrr eqxx. - by rewrite rpredB ?rpredZ_Cint ?Z_S1 // CintE N_S1_1. - rewrite -eqXY Dtau1 // Itau // ?(zchar_subset sS1S) //. - rewrite cfdotBl !cfdotBr !cfdotZr !ocS1 // !mulr0 subrr add0r !cfdotZl. - by rewrite opprB addrAC subrK subrr. -have [||leXchi _] := subcoherent_norm _ _ (erefl _) defXY. -- rewrite Schi scale_zchar ?char_vchar ?N_S /orthogonal //= !cfdotZr ocS1 //. - by rewrite -[xi1]cfConjCK cfdot_conjC ocS1 ?ccS1 // conjC0 mulr0 eqxx. -- apply: sub_iso_to ZItau; [apply: zchar_trans_on; apply/allP | exact: zcharW]. - rewrite /= Zachi sub_aut_zchar ?zchar_onG ?mem_zchar ?ccS //. - by move=> xi /N_S/char_vchar. -have normXY: '[X] + '[Y] = '[chi] + '[a *: xi1]. - by rewrite -!cfnormBd // ?cfdotZr ?ocS1 ?mulr0 // -eqXY Itau. -have{leXchi normXY}: '[Y] <= a ^+ 2 * '[xi1]. - by rewrite -(ler_add2l '[X]) normXY cfnormZ Cint_normK // ler_add2r. -rewrite {}defY cfnormDd; last first. - rewrite cfdotC (span_orthogonal oZS1) ?rmorph0 ?memv_span1 //. - rewrite big_seq memvB ?memvZ ?memv_suml ?memv_span ?map_f //. - by move=> theta S1theta; rewrite memvZ ?memv_span. -rewrite -cfnormN opprB cfnormB !cfnormZ !Cint_normK // addrAC ler_subl_addl. -rewrite cfdotZl cfdotZr cfnorm_sum_orthogonal ?cfproj_sum_orthogonal ?map_f //. -rewrite a_xi1 Itau1 ?Z_S1 // addrAC ler_add2r !(divfK, mulrA) ?nz_nS1 //. -rewrite !conj_Cint ?rpredM // => /ler_gtF-lb_2_lam_a. -suffices lam0: lam = 0; last apply: contraFeq lb_2_lam_a => nz_lam. - suffices ->: Z = 0 by rewrite lam0 scale0r subrK. - by apply: contraFeq lb_2_lam_a; rewrite -cfnorm_gt0 lam0 expr0n !mul0r !add0r. -rewrite ltr_paddr ?cfnorm_ge0 // -mulr2n -mulr_natl mulrCA. -have xi11_gt0: xi1 1%g > 0 by rewrite char1_gt0 ?N_S ?sS1S -?cfnorm_eq0 ?nz_nS1. -have a_gt0: a > 0 by rewrite -(ltr_pmul2r xi11_gt0) mul0r -chi1 char1_gt0. -apply: ler_lt_trans (_ : lam ^+ 2 * (2%:R * a) < _). - by rewrite ler_pmul2r ?mulr_gt0 ?ltr0n ?Cint_ler_sqr. -rewrite ltr_pmul2l ?(ltr_le_trans ltr01) ?sqr_Cint_ge1 {lam Zlam nz_lam}//. -rewrite -(ltr_pmul2r xi11_gt0) -mulrA -chi1 -(ltr_pmul2r xi11_gt0). -congr (_ < _): ub_chi1; rewrite -mulrA -expr2 mulr_suml big_map. -apply/eq_big_seq=> xi S1xi; rewrite a_E // Itau1 ?mem_zchar //. -rewrite ger0_norm ?divr_ge0 ?cfnorm_ge0 ?char1_ge0 ?N_S ?sS1S //. -rewrite [_ / _ / _]mulrAC [RHS]mulrAC -exprMn divfK //. -by rewrite [RHS]mulrAC divfK ?nz_nS1 // mulrA. -Qed. - -(* This is Peterfalvi (5.7). *) -(* This is almost a superset of (1.4): we could use it to get a coherent *) -(* isometry, which would necessarily map irreducibles to signed irreducibles. *) -(* It would then only remain to show that the signs are chosen consistently, *) -(* by considering the degrees of the differences. *) -(* This result is complementary to (5.6): it follow from it when S has 4 or *) -(* fewer characters, or reducible characters. On the contrary, (5.7) can be *) -(* used to provide an initial set of characters with a threshold high enough *) -(* to enable (repeated) application of (5.6), as in seqIndD_irr_coherence. *) -Lemma uniform_degree_coherence : - constant [seq chi 1%g | chi : 'CF(L) <- S] -> coherent S L^# tau. -Proof. -case defS: {1}S => /= [|chi1 S1] szS; first by rewrite defS; apply nil_coherent. -have{szS} unifS xi: xi \in S -> xi 1%g = chi1 1%g. - by rewrite defS => /predU1P[-> // | S'xi]; apply/eqP/(allP szS)/map_f. -have{S1 defS} Schi1: chi1 \in S by rewrite defS mem_head. -have [[N_S nrS ccS] IZtau oS R_P oR] := cohS; have [Itau Ztau] := IZtau. -have Zd: {in S &, forall xi1 xi2, xi1 - xi2 \in 'Z[S, L^#]}. - move=> xi1 xi2 Sxi1 Sxi2 /=. - by rewrite zcharD1E rpredB ?mem_zchar //= !cfunE !unifS ?subrr. -pose chi2 := chi1^*%CF; have Schi2: chi2 \in S by rewrite ccS. -have ch1'2: chi2 != chi1 by apply/(hasPn nrS). -have [_ oSS] := pairwise_orthogonalP oS. -pose S1 xi := [predD1 S & xi]; pose S2 xi := [predD1 (S1 xi) & xi^*%CF]. -have{oR} oR xi1 xi2: xi1 \in S -> xi2 \in S2 xi1 -> orthogonal (R xi1) (R xi2). - move=> Sxi1 /and3P[/= xi1J'2 xi1'2 Sxi2]. - by rewrite orthogonal_sym oR // /orthogonal /= !oSS ?eqxx // ccS. -have oSc xi: xi \in S -> '[xi, xi^*] = 0. - by move=> Sxi; rewrite oSS ?ccS // eq_sym (hasPn nrS). -pose D xi := tau (chi1 - xi). -have Z_D xi: xi \in S -> D xi \in 'Z[irr G] by move/(Zd _ _ Schi1)/Ztau/zcharW. -have /CnatP[N defN]: '[chi1] \in Cnat by rewrite Cnat_cfdot_char ?N_S. -have dotD: {in S1 chi1 &, forall xi1 xi2, '[D xi1, D xi2] = N%:R + '[xi1, xi2]}. - move=> xi1 xi2 /andP[ch1'xi1 Sxi1] /andP[chi1'xi2 Sxi2]. - rewrite Itau ?Zd // cfdotBl !cfdotBr defN. - by rewrite 2?oSS // 1?eq_sym // opprB !subr0. -have /R_P[ZRchi oRchi defRchi] := Schi1. -have szRchi: size (R chi1) = (N + N)%N. - apply: (can_inj natCK); rewrite -cfnorm_orthonormal // -defRchi. - by rewrite dotD ?inE ?ccS ?(hasPn nrS) // cfnorm_conjC defN -natrD. -pose subRchi1 X := exists2 E, subseq E (R chi1) & X = \sum_(a <- E) a. -pose Xspec X := [/\ X \in 'Z[R chi1], '[X] = N%:R & subRchi1 X]. -pose Xi_spec (X : 'CF(G)) xi := X - D xi \in 'Z[R xi] /\ '[X, D xi] = N%:R. -have haveX xi: xi \in S2 chi1 -> exists2 X, Xspec X & Xi_spec X xi. - move=> S2xi; have /and3P[/= chi2'xi ch1'xi Sxi] := S2xi. - have [neq_xi' Sxi'] := (hasPn nrS xi Sxi, ccS xi Sxi). - have [X RchiX [Y1 defXY1]] := subcoherent_split Schi1 (Z_D _ Sxi). - have [[eqXY1 oXY1 oY1chi] sRchiX] := (defXY1, zchar_span RchiX). - have Z_Y1: Y1 \in 'Z[irr G]. - by rewrite -rpredN -(rpredDl _ (zchar_trans ZRchi RchiX)) -eqXY1 Z_D. - have [X1 RxiX1 [Y defX1Y]] := subcoherent_split Sxi Z_Y1. - have [[eqX1Y oX1Y oYxi] sRxiX1] := (defX1Y, zchar_span RxiX1). - pose Y2 : 'CF(G) := X + Y; pose D2 : 'CF(G) := tau (xi - chi1). - have oY2Rxi: orthogonal Y2 (R xi). - apply/orthoPl=> phi Rxi_phi; rewrite cfdotDl (orthoPl oYxi) // addr0. - by rewrite (span_orthogonal (oR chi1 xi _ _)) // memv_span. - have{oY2Rxi} defX1Y2: [/\ D2 = X1 - Y2, '[X1, Y2] = 0 & orthogonal Y2 (R xi)]. - rewrite -opprB -addrA -opprB -eqX1Y -eqXY1 -linearN opprB cfdotC. - by rewrite (span_orthogonal oY2Rxi) ?conjC0 ?memv_span1 ?(zchar_span RxiX1). - have [||minX eqX1] := subcoherent_norm _ _ (erefl _) defXY1. - - by rewrite char_vchar ?N_S /orthogonal //= !oSS ?eqxx // eq_sym. - - apply: sub_iso_to IZtau; last exact: zcharW. - by apply: zchar_trans_on; apply/allP; rewrite /= !Zd. - have [||minX1 _]:= subcoherent_norm _ _ (erefl _) defX1Y2. - - rewrite char_vchar ?N_S /orthogonal //= !oSS ?eqxx // inv_eq //. - exact: cfConjCK. - - apply: sub_iso_to IZtau; last exact: zcharW. - by apply: zchar_trans_on; apply/allP; rewrite /= !Zd. - rewrite eqX1Y cfnormBd // defN in eqX1. - have{eqX1} [|nX n_xi defX] := eqX1; first by rewrite ler_paddr ?cfnorm_ge0. - exists X => //; split; last by rewrite eqXY1 cfdotBr oXY1 subr0. - suffices Y0: Y = 0 by rewrite eqXY1 eqX1Y Y0 subr0 opprB addrC subrK. - apply/eqP; rewrite -cfnorm_eq0 lerif_le ?cfnorm_ge0 //. - by rewrite -(ler_add2l '[X1]) addr0 n_xi. -pose XDspec X := {in S2 chi1, forall xi, '[X, D xi] = N%:R}. -have [X [RchiX nX defX] XD_N]: exists2 X, Xspec X & XDspec X. - have [sSchi | /allPn[xi1 Sxi1]] := altP (@allP _ (pred2 chi1 chi2) S). - pose E := take N (R chi1). - exists (\sum_(a <- E) a) => [|xi]; last by case/and3P=> ? ? /sSchi/norP[]. - have defE: E ++ drop N (R chi1) = R chi1 by rewrite cat_take_drop. - have sER: subseq E (R chi1) by rewrite -defE prefix_subseq. - split; last by [exists E]; move/mem_subseq in sER. - by rewrite big_seq rpred_sum // => a Ea; rewrite mem_zchar ?sER. - rewrite cfnorm_orthonormal ?size_takel ?szRchi ?leq_addl //. - by have:= oRchi; rewrite -defE orthonormal_cat => /andP[]. - case/norP=> chi1'xi1 chi2'xi1'; have S2xi1: xi1 \in S2 chi1 by apply/and3P. - pose xi2 := xi1^*%CF; have /haveX[X [RchiX nX defX] [Rxi1X1 XD_N]] := S2xi1. - exists X => // xi S2xi; have [chi1'xi chi2'xi /= Sxi] := and3P S2xi. - have /R_P[_ _ defRxi1] := Sxi1; have [-> // | xi1'xi] := eqVneq xi xi1. - have [sRchiX sRxi1X1] := (zchar_span RchiX, zchar_span Rxi1X1). - have [-> | xi2'xi] := eqVneq xi xi2. - rewrite /D -[chi1](subrK xi1) -addrA linearD cfdotDr XD_N defRxi1 big_seq. - rewrite (span_orthogonal (oR chi1 xi1 _ _)) ?addr0 ?rpred_sum //. - exact/memv_span. - have /haveX[X' [RchiX' nX' _] [Rxi3X' X'D_N]] := S2xi. - have [sRchiX' sRxi1X'] := (zchar_span RchiX', zchar_span Rxi3X'). - suffices: '[X - X'] == 0 by rewrite cfnorm_eq0 subr_eq0 => /eqP->. - have ZXX': '[X, X'] \in Cint by rewrite Cint_cfdot_vchar ?(zchar_trans ZRchi). - rewrite cfnormB subr_eq0 nX nX' aut_Cint {ZXX'}//; apply/eqP/esym. - congr (_ *+ 2); rewrite -(addNKr (X - D xi1) X) cfdotDl cfdotC. - rewrite (span_orthogonal (oR chi1 xi1 _ _)) // conjC0. - rewrite -(subrK (D xi) X') cfdotDr cfdotDl cfdotNl opprB subrK. - rewrite (span_orthogonal (oR xi1 xi _ _)) //; last exact/and3P. - rewrite (span_orthogonal (oR chi1 xi _ _)) // oppr0 !add0r. - by rewrite dotD ?oSS ?addr0 1?eq_sym //; apply/andP. -have{RchiX} ZX: X \in 'Z[irr G] := zchar_trans ZRchi RchiX. -apply: (pivot_coherence cohS Schi1 ZX); rewrite defN //. -move=> xi /andP[chi1'xi Sxi]; exists 1; first by rewrite rpred1 mul1r unifS. -rewrite scale1r mulN1r -conjC_nat -opprB raddfN cfdotNl cfdotC; congr (- _^*). -have [-> /= | chi2'xi] := eqVneq xi chi2; last exact/XD_N/and3P. -have{defX}[E ssER defX] := defX; pose Ec := filter [predC E] (R chi1). -have eqRchi: perm_eq (R chi1) (E ++ Ec). - rewrite -(perm_filterC (mem E)) -(subseq_uniqP _ _) //. - exact/free_uniq/orthonormal_free. -have /and3P[oE _ oEEc]: [&& orthonormal E, orthonormal Ec & orthogonal E Ec]. - by rewrite (eq_orthonormal eqRchi) orthonormal_cat in oRchi. -rewrite defRchi (eq_big_perm _ eqRchi) big_cat -defX cfdotDr nX defX !big_seq. -by rewrite (span_orthogonal oEEc) ?addr0 ?rpred_sum //; apply: memv_span. -Qed. - -End SubCoherentProperties. - -(* A corollary of Peterfalvi (5.7) used (sometimes implicitly!) in the proof *) -(* of lemmas (11.9), (12.4) and (12.5). *) -Lemma pair_degree_coherence L G S (tau : {linear _ -> 'CF(gval G)}) R : - subcoherent S tau R -> - {in S &, forall phi1 phi2 : 'CF(gval L), phi1 1%g == phi2 1%g -> - exists S1 : seq 'CF(L), - [/\ phi1 \in S1, phi2 \in S1, cfConjC_subset S1 S & coherent S1 L^# tau]}. -Proof. -move=> scohS phi1 phi2 Sphi1 Sphi2 /= eq_phi12_1. -have [[N_S _ ccS] _ _ _ _] := scohS. -pose S1 := undup (phi1 :: phi1^* :: phi2 :: phi2^*)%CF. -have sS1S: cfConjC_subset S1 S. - split=> [|chi|chi]; rewrite ?undup_uniq //= !mem_undup; move: chi; apply/allP. - by rewrite /= !ccS ?Sphi1 ?Sphi2. - by rewrite /= !inE !cfConjCK !eqxx !orbT. -exists S1; rewrite !mem_undup !inE !eqxx !orbT; split=> //. -apply: uniform_degree_coherence (subset_subcoherent scohS sS1S) _. -apply/(@all_pred1_constant _ (phi2 1%g))/allP=> _ /mapP[chi S1chi ->] /=. -rewrite mem_undup in S1chi; move: chi S1chi; apply/allP. -by rewrite /= !cfAut_char1 ?N_S // eqxx eq_phi12_1. -Qed. - -(* This is Peterfalvi (5.8). *) -Lemma coherent_prDade_TIred (G H L K W W1 W2 : {group gT}) S A A0 - k (tau1 : {additive 'CF(L) -> 'CF(G)}) - (defW : W1 \x W2 = W) (ddA : prime_Dade_hypothesis G L K H A A0 defW) - (sigma := cyclicTIiso ddA) - (eta_ := fun i j => sigma (cyclicTIirr defW i j)) - (mu := primeTIred ddA) (dk := primeTIsign ddA k) (tau := Dade ddA) : - cfConjC_subset S (seqIndD K L H 1) -> - [/\ ~~ has cfReal S, has (mem (irr L)) S & mu k \in S] -> - coherent_with S L^# tau tau1 -> - let j := conjC_Iirr k in - tau1 (mu k) = dk *: (\sum_i eta_ i k) - \/ tau1 (mu k) = - dk *: (\sum_i eta_ i j) - /\ (forall ell, mu ell \in S -> mu ell 1%g = mu k 1%g -> ell = k \/ ell = j). -Proof. -set phi := tau1 (mu k) => uccS [nrS /hasP[zeta Szeta irr_zeta] Sk] cohS j. -pose sum_eta a ell := \sum_i a i ell *: eta_ i ell. -have [R [subcohS oS1sig defR]] := prDade_subcoherent ddA uccS nrS. -have [[charS _ ccS] _ /orthogonal_free freeS Rok _] := subcohS. -have [[Itau1 _] Dtau1] := cohS. -have natS1 xi: xi \in S -> xi 1%g \in Cnat by move/charS/Cnat_char1. -have k'j: j != k by rewrite -(inj_eq (prTIred_inj ddA)) prTIred_aut (hasPn nrS). -have nzSmu l (Sl : mu l \in S): l != 0. - apply: contraNneq (hasPn nrS _ Sl) => ->. - by rewrite /cfReal -prTIred_aut aut_Iirr0. -have [nzk nzj]: k != 0 /\ j != 0 by rewrite !nzSmu // /mu (prTIred_aut ddA) ccS. -have sSS: cfConjC_subset S S by have:= free_uniq freeS; split. -have{sSS} Dtau1S:= mem_coherent_sum_subseq subcohS sSS cohS. -have o_sum_eta a j1 i j2: j1 != j2 -> '[sum_eta a j1, eta_ i j2] = 0. - move/negPf=> neq_j; rewrite cfdot_suml big1 // => i1 _. - by rewrite cfdotZl cfdot_cycTIiso neq_j andbF mulr0. -have proj_sum_eta a i j1: '[sum_eta a j1, eta_ i j1] = a i j1. - rewrite cfdot_suml (bigD1 i) //= cfdotZl cfdot_cycTIiso !eqxx mulr1. - rewrite big1 ?addr0 // => i1 /negPf i'i1. - by rewrite cfdotZl cfdot_cycTIiso i'i1 mulr0. -have [a Dphi Da0]: exists2 a, phi = sum_eta a k + sum_eta a j - & pred2 0 dk (a 0 k) /\ pred2 0 (- dk) (a 0 j). -- have uRk: uniq (R (mu k)) by have [_ /orthonormal_free/free_uniq] := Rok _ Sk. - have [E sER Dphi] := Dtau1S _ Sk; rewrite /phi Dphi (subseq_uniqP uRk sER). - pose a i ell (alpha := dk *: eta_ i ell) := - if alpha \in E then dk else if - alpha \in E then - dk else 0. - have sign_eq := inj_eq (can_inj (signrZK _)). - have E'Nsk i: (- (dk *: eta_ i k) \in E) = false. - apply/idP=> /(mem_subseq sER); rewrite defR -/dk -/sigma mem_cat -map_comp. - case/orP=> /codomP[i1 /esym/eqP/idPn[]]. - by rewrite -scalerN sign_eq cycTIiso_neqN. - by rewrite (inj_eq oppr_inj) sign_eq cycTIiso_eqE (negPf k'j) andbF. - have E'sj i: (dk *: eta_ i j \in E) = false. - apply/idP=> /(mem_subseq sER); rewrite defR -/dk -/sigma mem_cat -map_comp. - case/orP=> /codomP[i1 /eqP/idPn[]]. - by rewrite sign_eq cycTIiso_eqE (negPf k'j) andbF. - by rewrite /= -scalerN sign_eq cycTIiso_neqN. - exists a; last first. - by rewrite !(fun_if (pred2 _ _)) /= !eqxx !orbT E'Nsk !(if_same, E'sj). - rewrite big_filter big_mkcond defR big_cat !big_map -/dk -/sigma /=. - congr (_ + _); apply: eq_bigr => i _; rewrite /a -/(eta_ i _). - by rewrite E'Nsk; case: ifP => // _; rewrite scale0r. - by rewrite E'sj; case: ifP => _; rewrite (scaleNr, scale0r). -pose V := cyclicTIset defW; have zetaV0: {in V, tau1 zeta =1 \0}. - apply: (ortho_cycTIiso_vanish ddA); apply/orthoPl=> _ /mapP[ww Www ->]. - rewrite (span_orthogonal (oS1sig zeta ww _ _)) ?memv_span1 ?inE ?Szeta //. - have [E sER ->] := Dtau1S _ Szeta; rewrite big_seq rpred_sum // => aa Raa. - by rewrite memv_span ?(mem_subseq sER). -pose zeta1 := zeta 1%g *: mu k - mu k 1%g *: zeta. -have Zzeta1: zeta1 \in 'Z[S, L^#]. - rewrite zcharD1E !cfunE mulrC subrr eqxx andbT. - by rewrite rpredB ?scale_zchar ?mem_zchar // CintE ?natS1. -have /cfun_onP A1zeta1: zeta1 \in 'CF(L, 1%g |: A). - rewrite memvB ?memvZ ?prDade_TIred_on //; have [_ sSS0 _] := uccS. - have /seqIndP[kz /setIdP[kerH'kz _] Dzeta] := sSS0 _ Szeta. - by rewrite Dzeta (prDade_Ind_irr_on ddA) //; rewrite inE in kerH'kz. -have{A1zeta1} zeta1V0: {in V, zeta1 =1 \0}. - move=> x Vx; rewrite /= A1zeta1 // -in_setC. - apply: subsetP (subsetP (prDade_supp_disjoint ddA) x Vx); rewrite setCS. - by rewrite subUset sub1G; have [/= _ _ _ [_ [_ _ /subsetD1P[->]]]] := ddA. -have o_phi_0 i: '[phi, eta_ i 0] = 0 by rewrite Dphi cfdotDl !o_sum_eta ?addr0. -have{o_phi_0 zeta1V0} proj_phi0 i ell: '[phi, eta_ i ell] = '[phi, eta_ 0 ell]. - rewrite -[LHS]add0r -(o_phi_0 0) -[RHS]addr0 -(o_phi_0 i). - apply: (cycTIiso_cfdot_exchange ddA); rewrite -/V => x Vx. - have: tau zeta1 x == 0. - have [_ _ defA0] := prDade_def ddA; rewrite Dade_id ?zeta1V0 //. - by rewrite defA0 inE orbC mem_class_support. - rewrite -Dtau1 // raddfB !raddfZ_Cnat ?natS1 // !cfunE zetaV0 //. - rewrite oppr0 mulr0 addr0 mulf_eq0 => /orP[/idPn[] | /eqP->//]. - by have /irrP[iz ->] := irr_zeta; apply: irr1_neq0. -have Dphi_j i: '[phi, eta_ i j] = a i j. - by rewrite Dphi cfdotDl proj_sum_eta o_sum_eta 1?eq_sym ?add0r. -have Dphi_k i: '[phi, eta_ i k] = a i k. - by rewrite Dphi cfdotDl proj_sum_eta o_sum_eta ?addr0. -have Da_j i: a i j = a 0 j by rewrite -!Dphi_j. -have{proj_phi0} Da_k i: a i k = a 0 k by rewrite -!Dphi_k. -have oW1: #|W1| = #|Iirr W1|. - by rewrite card_Iirr_cyclic //; have [[]] := prDade_prTI ddA. -have{oW1}: `|a 0 j| ^+ 2 + `|a 0 k| ^+ 2 == 1. - apply/eqP/(mulfI (neq0CG W1)); rewrite mulr1 {}[in LHS]oW1. - transitivity '[phi]; last by rewrite Itau1 ?mem_zchar ?cfnorm_prTIred. - rewrite {2}Dphi cfdotDr !cfdot_sumr mulrDr addrC !mulr_natl -!sumr_const. - congr (_ + _); apply: eq_bigr => i _; rewrite cfdotZr mulrC normCK. - by rewrite Dphi_k (Da_k i). - by rewrite Dphi_j (Da_j i). -have{Da0}[/pred2P[]Da0k /pred2P[]Da0j] := Da0; rewrite Da0k Da0j; last 2 first. -- left; rewrite Dphi [sum_eta a j]big1 ?addr0 => [|i _]; last first. - by rewrite Da_j Da0j scale0r. - by rewrite scaler_sumr; apply: eq_bigr => i _; rewrite Da_k Da0k. -- by rewrite normrN normr_sign expr1n (eqr_nat _ 2 1). -- by rewrite normr0 expr0n add0r (eqr_nat _ 0 1). -have{Dphi} Dphi: phi = - dk *: (\sum_i eta_ i j). - rewrite Dphi [sum_eta a k]big1 ?add0r => [|i _]; last first. - by rewrite Da_k Da0k scale0r. - by rewrite raddf_sum; apply: eq_bigr => i _; rewrite Da_j Da0j. -clear 1; right; split=> // l Sl deg_l; apply/pred2P. -have [_ [tau2 Dtau2 [_ Dtau]]] := uniform_prTIred_coherent ddA nzk. -have nz_l: l != 0 := nzSmu l Sl. -have Tmukl: mu k - mu l \in 'Z[uniform_prTIred_seq ddA k, L^#]. - rewrite zcharD1E !cfunE deg_l subrr eqxx andbT. - by rewrite rpredB ?mem_zchar ?image_f // !inE ?nzk ?nz_l ?deg_l eqxx. -pose ak (_ : Iirr W1) (_ : Iirr W2) := dk. -have: phi - tau1 (mu l) = sum_eta ak k - sum_eta ak l. - rewrite -raddfB Dtau1; last first. - by rewrite zcharD1E rpredB ?mem_zchar //= !cfunE deg_l subrr. - by rewrite -[tau _]Dtau // raddfB /= !Dtau2 2!raddf_sum. -have [E /mem_subseq sER ->] := Dtau1S _ Sl. -move/esym/(congr1 (cfdotr (eta_ 0 k))); apply: contra_eqT => /norP[k'l j'l] /=. -rewrite !cfdotBl Dphi_k Da0k proj_sum_eta o_sum_eta // cfdot_suml. -rewrite big_seq big1 ?subr0 ?signr_eq0 // => aa /sER; rewrite defR -map_comp. -rewrite mem_cat => /orP[]/codomP[/= i ->]; rewrite -/(eta_ i _). - by rewrite cfdotZl cfdot_cycTIiso (negPf k'l) andbF mulr0. -rewrite cfdotNl cfdotZl cfdot_cycTIiso (inv_eq (@conjC_IirrK _ _)) -/j. -by rewrite (negPf j'l) andbF mulr0 oppr0. -Qed. - -Section DadeAut. - -Variables (L G : {group gT}) (A : {set gT}). -Implicit Types K H M : {group gT}. -Hypothesis ddA : Dade_hypothesis G L A. - -Local Notation tau := (Dade ddA). -Local Notation "alpha ^\tau" := (tau alpha). - -Section DadeAutIrr. -Variable u : {rmorphism algC -> algC}. -Local Notation "alpha ^u" := (cfAut u alpha). - -(* This is Peterfalvi (5.9)(a), slightly reformulated to allow calS to also *) -(* contain non-irreducible characters; for groups of odd order, the second *) -(* assumption holds uniformly for all calS of the form seqIndD. *) -(* We have stated the coherence assumption directly over L^#; this lets us *) -(* drop the Z[S, A] = Z[S, L^#] assumption, and is more consistent with the *) -(* rest of the proof. *) -Lemma cfAut_Dade_coherent calS tau1 chi : - coherent_with calS L^# tau tau1 -> - (1 < #|[set i | 'chi_i \in calS]|)%N /\ cfAut_closed u calS -> - chi \in irr L -> chi \in calS -> - (tau1 chi)^u = tau1 (chi^u). -Proof. -case=> [[Itau1 Ztau1] tau1_tau] [irrS_gt1 sSuS] /irrP[i {chi}->] Schi. -have sSZS: {subset calS <= 'Z[calS]} by move=> phi Sphi; apply: mem_zchar. -pose mu j := 'chi_j 1%g *: 'chi_i - 'chi_i 1%g *: 'chi_j. -have ZAmu j: 'chi_j \in calS -> mu j \in 'Z[calS, L^#]. - move=> Sxj; rewrite zcharD1E !cfunE mulrC subrr. - by rewrite rpredB //= scale_zchar ?sSZS // ?Cint_Cnat ?Cnat_irr1. -have Npsi j: 'chi_j \in calS -> '[tau1 'chi_j] = 1%:R. - by move=> Sxj; rewrite Itau1 ?sSZS ?cfnorm_irr. -have{Npsi} Dtau1 Sxj := vchar_norm1P (Ztau1 _ (sSZS _ Sxj)) (Npsi _ Sxj). -have [e [r tau1_chi]] := Dtau1 _ Schi; set eps := (-1) ^+ e in tau1_chi. -have{Dtau1} Dtau1 j: 'chi_j \in calS -> exists t, tau1 'chi_j = eps *: 'chi_t. - move=> Sxj; suffices: 0 <= (eps *: tau1 'chi_j) 1%g. - have [f [t ->]] := Dtau1 j Sxj. - have [-> | neq_f_eps] := eqVneq f e; first by exists t. - rewrite scalerA -signr_addb scaler_sign addbC -negb_eqb neq_f_eps. - by rewrite cfunE oppr_ge0 ltr_geF ?irr1_gt0. - rewrite -(pmulr_rge0 _ (irr1_gt0 i)) cfunE mulrCA. - have: tau1 (mu j) 1%g == 0 by rewrite tau1_tau ?ZAmu ?Dade1. - rewrite raddfB 2?raddfZ_Cnat ?Cnat_irr1 // !cfunE subr_eq0 => /eqP <-. - by rewrite tau1_chi cfunE mulrCA signrMK mulr_ge0 ?Cnat_ge0 ?Cnat_irr1. -have SuSirr j: 'chi_j \in calS -> 'chi_(aut_Iirr u j) \in calS. - by rewrite aut_IirrE => /sSuS. -have [j Sxj neq_ij]: exists2 j, 'chi_j \in calS & 'chi_i != 'chi_j. - move: irrS_gt1; rewrite (cardsD1 i) inE Schi ltnS card_gt0 => /set0Pn[j]. - by rewrite !inE -(inj_eq irr_inj) eq_sym => /andP[]; exists j. -have: (tau1 (mu j))^u == tau1 (mu j)^u. - by rewrite !tau1_tau ?cfAut_zchar ?ZAmu ?Dade_aut. -rewrite !raddfB [-%R]lock !raddfZ_Cnat ?Cnat_irr1 //= -lock -!aut_IirrE. -have [/Dtau1[ru ->] /Dtau1[tu ->]] := (SuSirr i Schi, SuSirr j Sxj). -have: (tau1 'chi_i)^u != (tau1 'chi_j)^u. - apply: contraNneq neq_ij => /cfAut_inj/(isometry_raddf_inj Itau1)/eqP. - by apply; rewrite ?sSZS //; apply: rpredB. -have /Dtau1[t ->] := Sxj; rewrite tau1_chi !cfAutZ_Cint ?rpred_sign //. -rewrite !scalerA -!(mulrC eps) -!scalerA -!scalerBr -!aut_IirrE. -rewrite !(inj_eq (scalerI _)) ?signr_eq0 // (inj_eq irr_inj) => /negPf neq_urt. -have [/CnatP[a ->] /CnatP[b xj1]] := (Cnat_irr1 i, Cnat_irr1 j). -rewrite xj1 eq_subZnat_irr neq_urt orbF andbC => /andP[_]. -by rewrite eqn0Ngt -ltC_nat -xj1 irr1_gt0 /= => /eqP->. -Qed. - -End DadeAutIrr. - -(* This covers all the uses of (5.9)(a) in the rest of Peterfalvi, except *) -(* one instance in (6.8.2.1). *) -Lemma cfConjC_Dade_coherent K H M (calS := seqIndD K L H M) tau1 chi : - coherent_with calS L^# (Dade ddA) tau1 -> - [/\ odd #|G|, K <| L & H \subset K] -> chi \in irr L -> chi \in calS -> - (tau1 chi)^*%CF = tau1 chi^*%CF. -Proof. -move=> cohS [oddG nsKL sHK] irr_chi Schi. -apply: (cfAut_Dade_coherent cohS) => //; split; last exact: cfAut_seqInd. -have oddL: odd #|L| by apply: oddSg oddG; have [_] := ddA. -exact: seqInd_nontrivial_irr Schi. -Qed. - -(* This is Peterfalvi (5.9)(b). *) -Lemma Dade_irr_sub_conjC chi (phi := chi - chi^*%CF) : - chi \in irr L -> chi \in 'CF(L, 1%g |: A) -> - exists t, phi^\tau = 'chi_t - ('chi_t)^*%CF. -Proof. -case/irrP=> i Dchi Achi; rewrite {chi}Dchi in phi Achi *. -have [Rchi | notRchi] := eqVneq (conjC_Iirr i) i. - by exists 0; rewrite irr0 cfConjC_cfun1 /phi -conjC_IirrE Rchi !subrr linear0. -have Zphi: phi \in 'Z[irr L, A]. - have notA1: 1%g \notin A by have [] := ddA. - by rewrite -(setU1K notA1) sub_conjC_vchar // zchar_split irr_vchar. -have Zphi_tau: phi^\tau \in 'Z[irr G, G^#]. - by rewrite zchar_split Dade_cfun Dade_vchar ?Zphi. -have norm_phi_tau : '[phi^\tau] = 2%:R. - rewrite Dade_isometry ?(zchar_on Zphi) // cfnormB -conjC_IirrE. - by rewrite !cfdot_irr !eqxx eq_sym (negPf notRchi) rmorph0 addr0 subr0. -have [j [k ne_kj phi_tau]] := vchar_norm2 Zphi_tau norm_phi_tau. -suffices def_k: conjC_Iirr j = k by exists j; rewrite -conjC_IirrE def_k. -have/esym:= eq_subZnat_irr 1 1 k j (conjC_Iirr j) (conjC_Iirr k). -rewrite (negPf ne_kj) orbF /= !scale1r !conjC_IirrE -rmorphB. -rewrite -opprB -phi_tau /= -Dade_conjC // rmorphB /= cfConjCK. -by rewrite -linearN opprB eqxx => /andP[/eqP->]. -Qed. - -End DadeAut. - -End Five. - -Arguments coherent_prDade_TIred - [gT G H L K W W1 W2 S0 A A0 k tau1 defW].
\ No newline at end of file diff --git a/mathcomp/odd_order/PFsection6.v b/mathcomp/odd_order/PFsection6.v deleted file mode 100644 index 2add4af..0000000 --- a/mathcomp/odd_order/PFsection6.v +++ /dev/null @@ -1,1345 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div choice. -From mathcomp -Require Import fintype tuple finfun bigop prime ssralg poly finset center. -From mathcomp -Require Import fingroup morphism perm automorphism quotient action zmodp. -From mathcomp -Require Import gfunctor gproduct cyclic pgroup commutator gseries nilpotent. -From mathcomp -Require Import sylow abelian maximal hall frobenius. -From mathcomp -Require Import matrix mxalgebra mxrepresentation vector ssrnum algC algnum. -From mathcomp -Require Import classfun character inertia vcharacter integral_char. -From mathcomp -Require Import PFsection1 PFsection2 PFsection3 PFsection4 PFsection5. - -(******************************************************************************) -(* This file covers Peterfalvi, Section 6: *) -(* Some Coherence Theorems *) -(* Defined here: *) -(* odd_Frobenius_quotient K L M <-> *) -(* L has odd order, M <| L, K with K / M nilpotent, and L / H1 is a *) -(* Frobenius group with kernel K / H1, where H1 / M = (K / M)^(1). *) -(* This is the statement of Peterfalvi, Hypothesis (6.4), except for *) -(* the K <| L and subcoherence assumptions, to be required separately. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope GRing.Theory Num.Theory. -Local Open Scope ring_scope. - -(* The main section *) -Section Six. - -Variables (gT : finGroupType) (G : {group gT}). -Implicit Types H K L P M W Z : {group gT}. - -(* Grouping lemmas that assume Hypothesis (6.1). *) -Section GeneralCoherence. - -Variables K L : {group gT}. -Local Notation S M := (seqIndD K L K M). -Local Notation calS := (S 1). - -Variables (R : 'CF(L) -> seq 'CF(G)) (tau : {linear 'CF(L) -> 'CF(G)}). - -(* These may need to be grouped, in order to make the proofs of 6.8, 10.10, *) -(* and 12.6 more manageable. *) -Hypotheses (nsKL : K <| L) (solK : solvable K). -Hypothesis Itau : {in 'Z[calS, L^#] &, isometry tau}. -Hypothesis scohS : subcoherent calS tau R. - -Let sKL : K \subset L. Proof. exact: normal_sub. Qed. -Let nKL : L \subset 'N(K). Proof. exact: normal_norm. Qed. -Let orthS: pairwise_orthogonal calS. Proof. by case: scohS. Qed. -Let sSS M : {subset S M <= calS}. Proof. exact: seqInd_sub. Qed. -Let ccS M : cfConjC_closed (S M). Proof. exact: cfAut_seqInd. Qed. -Let uniqS M : uniq (S M). Proof. exact: seqInd_uniq. Qed. -Let nrS : ~~ has cfReal calS. Proof. by case: scohS => [[]]. Qed. - -Lemma exists_linInd M : - M \proper K -> M <| K -> exists2 phi, phi \in S M & phi 1%g = #|L : K|%:R. -Proof. -move=> ltMK nsMK; have [sMK nMK] := andP nsMK. -have ntKM: (K / M)%g != 1%g by rewrite -subG1 quotient_sub1 // proper_subn. -have [r lin_r ntr] := solvable_has_lin_char ntKM (quotient_sol M solK). -pose i := mod_Iirr r; exists ('Ind[L] 'chi_i); last first. - by rewrite cfInd1 ?mod_IirrE // cfMod1 lin_char1 ?mulr1. -apply/seqIndP; exists i; rewrite // !inE subGcfker mod_IirrE ?cfker_mod //=. -by rewrite mod_Iirr_eq0 // -irr_eq1 ntr. -Qed. - -(* This is Peterfalvi (6.2). *) -Lemma coherent_seqIndD_bound (A B C D : {group gT}) : - [/\ A <| L, B <| L, C <| L & D <| L] -> - (*a*) [/\ A \proper K, B \subset D, D \subset C, C \subset K - & D / B \subset 'Z(C / B)]%g -> - (*b*) coherent (S A) L^# tau -> \unless coherent (S B) L^# tau, - #|K : A|%:R - 1 <= 2%:R * #|L : C|%:R * sqrtC #|C : D|%:R :> algC. -Proof. -move=> [nsAL nsBL nsCL nsDL] [ltAK sBD sDC sCK sDbZC] cohA. -have sBC := subset_trans sBD sDC; have sBK := subset_trans sBC sCK. -have [sAK nsBK] := (proper_sub ltAK, normalS sBK sKL nsBL). -have{sBC} [nsAK nsBC] := (normalS sAK sKL nsAL, normalS sBC sCK nsBK). -rewrite real_lerNgt ?rpredB ?ger0_real ?mulr_ge0 ?sqrtC_ge0 ?ler0n ?ler01 //. -apply/unless_contra; rewrite negbK -(Lagrange_index sKL sCK) natrM => lb_KA. -pose S2 : seq 'CF(L) := [::]; pose S1 := S2 ++ S A; rewrite -[S A]/S1 in cohA. -have ccsS1S: cfConjC_subset S1 calS by apply: seqInd_conjC_subset1. -move: {2}_.+1 (leq_addr (size S1) (size calS).+1) => n. -elim: n => [|n IHn] in (S2) S1 ccsS1S cohA * => lb_n. - by rewrite ltnNge uniq_leq_size // in lb_n; case: ccsS1S. -without loss /allPn[psi /= SBpsi S1'psi]: / ~~ all (mem S1) (S B). - by case: allP => [sAB1 _ | _]; [apply: subset_coherent cohA | apply]. -have [[_ sS1S _] Spsi] := (ccsS1S, sSS SBpsi). -apply (IHn [:: psi, psi^* & S2]%CF); rewrite ?addnS 1?leqW {n lb_n IHn}//= -/S1. - exact: extend_cfConjC_subset. -have [phi SAphi phi1] := exists_linInd ltAK nsAK. -have{SAphi} S1phi: phi \in S1 by rewrite mem_cat SAphi orbT. -apply: (extend_coherent scohS) ccsS1S S1phi Spsi S1'psi _. -have{SBpsi} /seqIndP[i /setDP[kBi _] {psi}->] := SBpsi; rewrite inE in kBi. -rewrite {phi}phi1 cfInd1 // dvdC_mulr //; last by rewrite CintE Cnat_irr1. -split; rewrite // big_cat sum_seqIndD_square // big_seq ltr_paddl //=. - apply/sumr_ge0=> xi S2xi; rewrite divr_ge0 ?cfnorm_ge0 ?exprn_ge0 //. - by rewrite Cnat_ge0 // (Cnat_seqInd1 (sS1S _ _)) // mem_cat S2xi. -rewrite mulrC ltr_pmul2l ?gt0CiG //; apply: ler_lt_trans lb_KA. -by rewrite -!mulrA !ler_wpmul2l ?ler0n // (irr1_bound_quo nsBC). -Qed. - -(* This is Peterfalvi, Theorem (6.3). *) -Theorem bounded_seqIndD_coherence M H H1 : - [/\ M <| L, H <| L & H1 <| L] -> - [/\ M \subset H1, H1 \subset H & H \subset K] -> - (*a*) nilpotent (H / M) -> - (*b*) coherent (S H1) L^# tau -> - (*c*) (#|H : H1| > 4 * #|L : K| ^ 2 + 1)%N -> - coherent (S M) L^# tau. -Proof. -move: H1 => A [nsML nsHL nsAL] [sMA sAH sHK] nilHb cohA lbHA. -elim: {A}_.+1 {-2}A (ltnSn #|A|) => // m IHm A leAm in nsAL sMA sAH cohA lbHA *. -have [/group_inj-> // | ltMA] := eqVproper sMA; have [sAL nAL] := andP nsAL. -have{ltMA} [B maxB sMB]: {B : {group gT} | maxnormal B A L & M \subset B}. - by apply: maxgroup_exists; rewrite ltMA normal_norm. -have /andP[ltBA nBL] := maxgroupp maxB; have [sBA not_sAB] := andP ltBA. -have [sBH sBL] := (subset_trans sBA sAH, subset_trans sBA sAL). -have nsBL: B <| L by apply/andP. -suffices{m IHm leAm} cohB: coherent (S B) L^# tau. - apply: IHm cohB _ => //; first exact: leq_trans (proper_card ltBA) _. - by rewrite (leq_trans lbHA) // dvdn_leq // indexgS. -have /andP[sHL nHL] := nsHL. -have sAbZH: (A / B \subset 'Z(H / B))%g. - have nBA := subset_trans sAL nBL; have nsBA : B <| A by apply/andP. - set Zbar := 'Z(H / B); set Abar := (A / B)%g; pose Lbar := (L / B)%g. - have nZHbar: Lbar \subset 'N(Zbar) by rewrite gFnorm_trans ?quotient_norms. - have /mingroupP[/andP[ntAbar nALbar] minBbar]: minnormal Abar Lbar. - apply/mingroupP; split=> [|Dbar /andP[ntDbar nDLbar] sDAbar]. - by rewrite -subG1 quotient_sub1 // not_sAB quotient_norms. - have: Dbar <| Lbar by rewrite /normal (subset_trans sDAbar) ?quotientS. - case/(inv_quotientN nsBL)=> D defDbar sBD /andP[sDL nDL]. - apply: contraNeq ntDbar => neqDAbar; rewrite defDbar quotientS1 //. - have [_ /(_ D) {1}<- //] := maxgroupP maxB. - rewrite -(quotient_proper (normalS sBD sDL nsBL)) // -defDbar. - by rewrite properEneq sDAbar neqDAbar. - apply/setIidPl/minBbar; rewrite ?subsetIl {minBbar}//= andbC -/Abar -/Zbar. - rewrite normsI ?meet_center_nil ?quotient_normal ?(normalS sAH sHL) //=. - suffices /homgP[f /= <-]: (H / B)%g \homg (H / M)%g by rewrite morphim_nil. - by apply: homg_quotientS; rewrite ?(subset_trans sHL) ?normal_norm. -have ltAH: A \proper H. - by rewrite properEneq sAH (contraTneq _ lbHA) // => ->; rewrite indexgg addn1. -set x : algC := sqrtC #|H : A|%:R. -have [nz_x x_gt0]: x != 0 /\ 0 < x by rewrite gtr_eqF sqrtC_gt0 gt0CiG. -without loss{cohA} ubKA: / #|K : A|%:R - 1 <= 2%:R * #|L : H|%:R * x. - have [sAK ltAK] := (subset_trans sAH sHK, proper_sub_trans ltAH sHK). - exact: coherent_seqIndD_bound id. -suffices{lbHA}: (x - x^-1) ^+ 2 <= (2 * #|L : K|)%:R ^+ 2. - rewrite ltr_geF // sqrrB divff // sqrtCK ltr_spaddr ?exprn_gt0 ?invr_gt0 //. - by rewrite ler_subr_addr -natrX -natrD ler_nat expnMn addnS lbHA. -rewrite ler_pexpn2r ?unfold_in /= ?ler0n //; last first. - by rewrite subr_ge0 -div1r ler_pdivr_mulr // -expr2 sqrtCK ler1n. -rewrite -(ler_pmul2l x_gt0) -(ler_pmul2l (gt0CiG K H)) 2!mulrBr -expr2 sqrtCK. -rewrite !mulrA mulfK // mulrAC natrM mulrCA -2!natrM [in _ * x]mulnC. -by rewrite !Lagrange_index // (ler_trans _ ubKA) // ler_add2l ler_opp2 ler1n. -Qed. - -(* This is the statement of Peterfalvi, Hypothesis (6.4). *) -Definition odd_Frobenius_quotient M (H1 := K^`(1) <*> M) := - [/\ (*a*) odd #|L|, - (*b*) [/\ M <| L, M \subset K & nilpotent (K / M)] - & (*c*) [Frobenius L / H1 with kernel K / H1] ]%g. - -(* This is Peterfalvi (6.5). *) -Lemma non_coherent_chief M (H1 := (K^`(1) <*> M)%G) : - odd_Frobenius_quotient M -> \unless coherent (S M) L^# tau, - [/\ (*a*) chief_factor L H1 K /\ (#|K : H1| <= 4 * #|L : K| ^ 2 + 1)%N - & (*b*) exists2 p : nat, p.-group (K / M)%g /\ ~~ abelian (K / M) - & (*c*) ~~ (#|L : K| %| p - 1)]. -Proof. -case=> oddL [nsML sMK nilKM]; rewrite /= -(erefl (gval H1)) => frobLb. -set e := #|L : K|; have odd_e: odd e := dvdn_odd (dvdn_indexg L K) oddL. -have{odd_e} mod1e_lb m: odd m -> m == 1 %[mod e] -> (m > 1 -> 2 * e + 1 <= m)%N. - move=> odd_m e_dv_m1 m_gt1; rewrite eqn_mod_dvd 1?ltnW // subn1 in e_dv_m1. - by rewrite mul2n addn1 dvdn_double_ltn. -have nsH1L: H1 <| L by rewrite normalY // gFnormal_trans. -have nsH1K: H1 <| K by rewrite (normalS _ sKL nsH1L) // join_subG der_sub. -have [sH1K nH1K] := andP nsH1K; have sMH1: M \subset H1 by apply: joing_subr. -have cohH1: coherent (S H1) L^# tau. - apply: uniform_degree_coherence (subset_subcoherent scohS _) _ => //. - apply/(@all_pred1_constant _ e%:R)/allP=> _ /mapP[chi Schi ->] /=. - have [i /setIdP[_]] := seqIndP Schi; rewrite inE join_subG -lin_irr_der1. - by case/andP=> lin_chi _ ->; rewrite cfInd1 ?lin_char1 ?mulr1. -apply/unlessP; have [/val_inj-> | ltMH1] := eqVproper sMH1; first by left. -have [lbK|ubK] := ltnP; [by left; apply: bounded_seqIndD_coherence lbK | right]. -have{ubK} ubK: (#|K : H1| < (2 * e + 1) ^ 2)%N. - apply: leq_ltn_trans ubK _; rewrite -subn_gt0 sqrnD expnMn addKn. - by rewrite !muln_gt0 indexg_gt0. -have{frobLb} [[E1b frobLb] [sH1L nH1L]] := (existsP frobLb, andP nsH1L). -have [defLb ntKb _ _ /andP[sE1L _]] := Frobenius_context frobLb. -have iH1_mod1e H2: - H1 \subset H2 -> H2 \subset K -> L \subset 'N(H2) -> #|H2 : H1| == 1 %[mod e]. -- move=> sH12 sH2K nPL; have sH2L := subset_trans sH2K sKL. - rewrite eqn_mod_dvd // subn1 -card_quotient ?(subset_trans sH2L) //. - have [-> | ntH2b] := eqVneq (H2 / H1)%g 1%g; first by rewrite cards1. - have ->: e = #|E1b|. - by rewrite (index_sdprod defLb) index_quotient_eq ?(setIidPr sH1L). - have /Frobenius_subl/Frobenius_dvd_ker1-> := frobLb; rewrite ?quotientS //. - by rewrite (subset_trans sE1L) ?quotient_norms. -have{iH1_mod1e} chiefH1: chief_factor L H1 K. - have ltH1K: H1 \proper K by rewrite /proper sH1K -quotient_sub1 ?subG1. - rewrite /chief_factor nsKL andbT; apply/maxgroupP; rewrite ltH1K. - split=> // H2 /andP[ltH2K nH2L] sH12; have sH2K := proper_sub ltH2K. - have /eqVproper[// | ltH21] := sH12; case/idPn: ubK; rewrite -leqNgt. - have iKH1: (#|K : H2| * #|H2 : H1|)%N = #|K : H1| by apply: Lagrange_index. - have iH21_mod1e: #|H2 : H1| == 1 %[mod e] by apply/iH1_mod1e. - have iKH1_mod1e: #|K : H1| = 1 %[mod e] by apply/eqP/iH1_mod1e. - have iKH2_mod1e: #|K : H2| == 1 %[mod e]. - by rewrite -iKH1_mod1e -iKH1 -modnMmr (eqP iH21_mod1e) modnMmr muln1. - have odd_iK := dvdn_odd (dvdn_indexg _ _) (oddSg (subset_trans _ sKL) oddL). - by rewrite -iKH1 leq_mul ?mod1e_lb ?odd_iK ?indexg_gt1 ?proper_subn. -have nMK: K \subset 'N(M) := subset_trans sKL (normal_norm nsML). -have nMK1: K^`(1)%g \subset 'N(M) by apply: gFsub_trans. -have not_abKb: ~~ abelian (K / M). - apply: contra (proper_subn ltMH1) => /derG1P/trivgP/=. - by rewrite join_subG subxx andbT -quotient_der ?quotient_sub1. -have /is_abelemP[p p_pr /and3P[pKb _ _]]: is_abelem (K / H1). - have: solvable (K / H1)%g by apply: quotient_sol solK. - by case/(minnormal_solvable (chief_factor_minnormal chiefH1)). -have [[_ p_dv_Kb _] nsMK] := (pgroup_pdiv pKb ntKb, normalS sMK sKL nsML). -have isoKb: K / M / (H1 / M) \isog K / H1 := third_isog sMH1 nsMK nsH1K. -have{nilKM} pKM: p.-group (K / M)%g. - pose Q := 'O_p^'(K / M); have defKM: _ \x Q = _ := nilpotent_pcoreC p nilKM. - have nH1Q: Q \subset 'N(H1 / M) by rewrite gFsub_trans ?quotient_norms. - have hallQb := quotient_pHall nH1Q (nilpotent_pcore_Hall p^' nilKM). - have{nH1Q hallQb pKb} sQH1: (Q \subset H1 / M)%g. - rewrite -quotient_sub1 // subG1 trivg_card1 /= (card_Hall hallQb). - by rewrite partG_eq1 pgroupNK (isog_pgroup p isoKb). - suffices Q_1: Q = 1%g by rewrite -defKM Q_1 dprodg1 pcore_pgroup. - apply: contraTeq sQH1 => ntQ; rewrite quotientYidr ?quotient_der //. - rewrite (sameP setIidPl eqP) -(dprod_modr (der_dprod 1 defKM)) ?gFsub //= -/Q. - rewrite setIC coprime_TIg ?(coprimeSg (der_sub 1 _)) ?coprime_pcoreC //. - by rewrite dprod1g proper_neq ?(sol_der1_proper (nilpotent_sol nilKM)) ?gFsub. -split=> //; exists p => //; apply: contra not_abKb => e_dv_p1. -rewrite cyclic_abelian // Phi_quotient_cyclic //. -have /homgP[f <-]: (K / M / 'Phi(K / M) \homg K / H1)%g. - apply: homg_trans (isog_hom isoKb). - rewrite homg_quotientS ?gFnorm ?quotient_norms //= quotientYidr //. - by rewrite quotient_der // (Phi_joing pKM) joing_subl. -rewrite {f}morphim_cyclic // abelian_rank1_cyclic; last first. - by rewrite sub_der1_abelian ?joing_subl. -rewrite (rank_pgroup pKb) (leq_trans (p_rank_le_logn _ _)) //. -rewrite -ltnS -(ltn_exp2l _ _ (prime_gt1 p_pr)) -p_part part_pnat_id //. -rewrite card_quotient // (leq_trans ubK) // leq_exp2r //. -have odd_p: odd p by rewrite (dvdn_odd p_dv_Kb) ?quotient_odd ?(oddSg sKL). -by rewrite mod1e_lb ?eqn_mod_dvd ?prime_gt0 ?prime_gt1. -Qed. - -(* This is Peterfalvi (6.6). *) -Lemma seqIndD_irr_coherence Z (calX := seqIndD K L Z 1) : - odd_Frobenius_quotient 1 -> - [/\ Z <| L, Z :!=: 1 & Z \subset 'Z(K)]%g -> - {subset calX <= irr L} -> - calX =i [pred chi in irr L | ~~ (Z \subset cfker chi)] - /\ coherent calX L^#tau. -Proof. -move=> Frob_quo1 [nsZL ntZ sZ_ZK] irrX; have [sZL nZL] := andP nsZL. -have abZ: abelian Z by rewrite (abelianS sZ_ZK) ?center_abelian. -have /andP[sZK nZK]: Z <| K := sub_center_normal sZ_ZK. -split=> [chi|]. - apply/idP/andP=> [Xchi | [/irrP[r ->{chi}] nkerZr]]. - rewrite irrX //; case/seqIndP: Xchi => t /setIdP[nkerZt _] ->. - by rewrite inE in nkerZt; rewrite sub_cfker_Ind_irr. - have [t Res_r_t] := neq0_has_constt (Res_irr_neq0 K r). - pose chi := 'Ind[L] 'chi_t; have chi_r: '[chi, 'chi_r] != 0. - by rewrite -cfdot_Res_r cfdotC fmorph_eq0 -irr_consttE. - have Xchi: chi \in calX. - apply/seqIndP; exists t; rewrite // !inE sub1G andbT. - rewrite -(sub_cfker_Ind_irr t sKL nZL). - apply: contra nkerZr => /subset_trans-> //. - by rewrite cfker_constt // cfInd_char ?irr_char //. - case/irrX/irrP: Xchi chi_r (Xchi) => r' ->. - by rewrite cfdot_irr pnatr_eq0 -lt0n; case: eqP => // ->. -apply: non_coherent_chief (subset_coherent (seqInd_sub sZK)) _ => //= -[_ [p]]. -have [oddL _] := Frob_quo1; rewrite joingG1 -/calX => frobLb []. -rewrite -(isog_pgroup p (quotient1_isog K)) => pK ab'K. -set e := #|L : K| => not_e_dv_p1; have e_gt0: (e > 0)%N by apply: indexg_gt0. -have ntK: K != 1%G by apply: contraNneq ab'K => ->; rewrite quotient1 abelian1. -have{ab'K ntK} [p_pr p_dv_K _] := pgroup_pdiv pK ntK. -set Y := calX; pose d (xi : 'CF(L)) := logn p (truncC (xi 1%g) %/ e). -have: cfConjC_closed Y by apply: cfAut_seqInd. -have: perm_eq (Y ++ [::]) calX by rewrite cats0. -have: {in Y & [::], forall xi1 xi2, d xi1 <= d xi2}%N by []. -elim: {Y}_.+1 {-2}Y [::] (ltnSn (size Y)) => // m IHm Y X' leYm leYX' defX ccY. -have sYX: {subset Y <= calX}. - by move=> xi Yxi; rewrite -(perm_eq_mem defX) mem_cat Yxi. -have sX'X: {subset X' <= calX}. - by move=> xi X'xi; rewrite -(perm_eq_mem defX) mem_cat X'xi orbT. -have uniqY: uniq Y. - have: uniq calX := seqInd_uniq L _. - by rewrite -(perm_eq_uniq defX) cat_uniq => /and3P[]. -have sYS: {subset Y <= calS} by move=> xi /sYX/seqInd_sub->. -case homoY: (constant [seq xi 1%g | xi : 'CF(L) <- Y]). - exact: uniform_degree_coherence (subset_subcoherent scohS _) homoY. -have Ndg: {in calX, forall xi : 'CF(L), xi 1%g = (e * p ^ d xi)%:R}. - rewrite /d => _ /seqIndP[i _ ->]; rewrite cfInd1 // -/e. - have:= dvd_irr1_cardG i; have /CnatP[n ->] := Cnat_irr1 i. - rewrite -natrM natCK dvdC_nat mulKn // -p_part => dv_n_K. - by rewrite part_pnat_id // (pnat_dvd dv_n_K). -have [chi Ychi leYchi]: {chi | chi \in Y & {in Y, forall xi, d xi <= d chi}%N}. - have [/eqP/nilP Y0 | ntY] := posnP (size Y); first by rewrite Y0 in homoY. - pose i := [arg max_(i > Ordinal ntY) d Y`_i]. - exists Y`_i; [exact: mem_nth | rewrite {}/i; case: arg_maxP => //= i _ max_i]. - by move=> _ /(nthP 0)[j ltj <-]; apply: (max_i (Ordinal ltj)). -have{homoY} /hasP[xi1 Yxi1 lt_xi1_chi]: has (fun xi => d xi < d chi)%N Y. - apply: contraFT homoY => geYchi; apply: (@all_pred1_constant _ (chi 1%g)). - rewrite all_map; apply/allP=> xi Yxi; rewrite /= !Ndg ?sYX // eqr_nat. - rewrite eqn_pmul2l // eqn_exp2l ?prime_gt1 //. - by rewrite eqn_leq leYchi //= leqNgt (hasPn geYchi). -pose Y' := rem chi^*%CF (rem chi Y); pose X'' := [:: chi, chi^*%CF & X']. -have ccY': cfConjC_closed Y'. - move=> xi; rewrite !(inE, mem_rem_uniq) ?rem_uniq //. - by rewrite !(inv_eq (@cfConjCK _ _)) cfConjCK => /and3P[-> -> /ccY->]. -have Xchi := sYX _ Ychi; have defY: perm_eq [:: chi, chi^*%CF & Y'] Y. - rewrite (perm_eqrP (perm_to_rem Ychi)) perm_cons perm_eq_sym perm_to_rem //. - by rewrite mem_rem_uniq ?inE ?ccY // (seqInd_conjC_neq _ _ _ Xchi). -apply: perm_eq_coherent (defY) _. -have d_chic: d chi^*%CF = d chi. - by rewrite /d cfunE conj_Cnat // (Cnat_seqInd1 Xchi). -have /and3P[uniqY' Y'xi1 notY'chi]: [&& uniq Y', xi1 \in Y' & chi \notin Y']. - rewrite !(inE, mem_rem_uniq) ?rem_uniq // Yxi1 eqxx andbF !andbT -negb_or. - by apply: contraL lt_xi1_chi => /pred2P[] ->; rewrite ?d_chic ltnn. -have sY'Y: {subset Y' <= Y} by move=> xi /mem_rem/mem_rem. -have sccY'S: cfConjC_subset Y' calS by split=> // xi /sY'Y/sYS. -apply: (extend_coherent scohS _ Y'xi1); rewrite ?sYS {sccY'S notY'chi}//. -have{defX} defX: perm_eq (Y' ++ X'') calX. - by rewrite (perm_catCA Y' [::_; _]) catA -(perm_eqrP defX) perm_cat2r. -have{d_chic} le_chi_X'': {in X'', forall xi, d chi <= d xi}%N. - by move=> xi /or3P[/eqP-> | /eqP-> | /leYX'->] //; rewrite d_chic. -rewrite !Ndg ?sYX // dvdC_nat dvdn_pmul2l // dvdn_exp2l 1?ltnW //; split=> //. - apply: IHm defX ccY' => [|xi xi' /sY'Y/leYchi-le_xi_chi /le_chi_X'']. - by rewrite -ltnS // (leq_trans _ leYm) // -(perm_eq_size defY) ltnW. - exact: leq_trans. -have p_gt0 n: (0 < p ^ n)%N by rewrite expn_gt0 prime_gt0. -rewrite -!natrM; apply: (@ltr_le_trans _ (e ^ 2 * (p ^ d chi) ^ 2)%:R). - rewrite ltr_nat -expnMn -mulnn mulnAC !mulnA 2?ltn_pmul2r //. - rewrite -mulnA mulnCA ltn_pmul2l // -(subnK lt_xi1_chi) addnS expnS. - rewrite expnD mulnA ltn_pmul2r // -(muln1 3) leq_mul //. - rewrite ltn_neqAle prime_gt1 // eq_sym (sameP eqP (prime_oddPn p_pr)). - by rewrite (dvdn_odd p_dv_K) // (oddSg sKL). -have [r] := seqIndP (sYX _ Ychi); rewrite !inE => /andP[nkerZr _] def_chi. -have d_r: 'chi_r 1%g = (p ^ d chi)%:R. - by apply: (mulfI (neq0CiG L K)); rewrite -cfInd1 // -def_chi -natrM Ndg. -pose sum_p2d S := (\sum_(xi <- S) p ^ (d xi * 2))%N. -pose sum_xi1 (S : seq 'CF(L)) := \sum_(xi <- S) xi 1%g ^+ 2 / '[xi]. -have def_sum_xi1 S: {subset S <= calX} -> sum_xi1 S = (e ^ 2 * sum_p2d S)%:R. - move=> sSX; rewrite big_distrr natr_sum /=; apply: eq_big_seq => xi /sSX Xxi. - rewrite expnM -expnMn natrX -Ndg //. - by have /irrP[i ->] := irrX _ Xxi; rewrite cfnorm_irr divr1. -rewrite -/(sum_xi1 _) def_sum_xi1 ?leC_nat 1?dvdn_leq => [|||_ /sY'Y/sYX] //. - by rewrite muln_gt0 expn_gt0 e_gt0 [_ Y'](bigD1_seq xi1) //= addn_gt0 p_gt0. -have coep: coprime e p. - have:= Frobenius_ker_coprime frobLb; rewrite coprime_sym. - have /andP[_ nK'L]: K^`(1) <| L by apply: gFnormal_trans. - rewrite index_quotient_eq ?subIset ?der_sub ?orbT {nK'L}// -/e. - have ntKb: (K / K^`(1))%g != 1%g by case/Frobenius_kerP: frobLb. - have [_ _ [k ->]] := pgroup_pdiv (quotient_pgroup _ pK) ntKb. - by rewrite coprime_pexpr. -rewrite -expnM Gauss_dvd ?coprime_expl ?coprime_expr {coep}// dvdn_mulr //=. -have /dvdn_addl <-: p ^ (d chi * 2) %| e ^ 2 * sum_p2d X''. - rewrite big_distrr big_seq dvdn_sum //= => xi /le_chi_X'' le_chi_xi. - by rewrite dvdn_mull // dvdn_exp2l ?leq_pmul2r. -rewrite -mulnDr -big_cat (eq_big_perm _ defX) -(natCK (e ^ 2 * _)) /=. -rewrite -def_sum_xi1 // /sum_xi1 sum_seqIndD_square ?normal1 ?sub1G //. -rewrite indexg1 -(natrB _ (cardG_gt0 Z)) -natrM natCK. -rewrite -(Lagrange_index sKL sZK) mulnAC dvdn_mull //. -have /p_natP[k defKZ]: p.-nat #|K : Z| by rewrite (pnat_dvd (dvdn_indexg K Z)). -rewrite defKZ dvdn_exp2l // -(leq_exp2l _ _ (prime_gt1 p_pr)) -{k}defKZ. -rewrite -leC_nat expnM natrX -d_r ?(ler_trans (irr1_bound r).1) //. -rewrite ler_nat dvdn_leq ?indexgS ?(subset_trans sZ_ZK) //=. -by rewrite -cap_cfcenter_irr bigcap_inf. -Qed. - -End GeneralCoherence. - -(* This is Peterfalvi (6.7). *) -(* In (6.8) we only know initially the P group is Sylow in L; perhaps this *) -(* lemma should be stated with this equivalent (but weaker) assumption. *) -Lemma constant_irr_mod_TI_Sylow Z L P p i : - p.-Sylow(G) P -> odd #|L| -> normedTI P^# G L -> - [/\ Z <| L, Z :!=: 1%g & Z \subset 'Z(P)] -> - {in Z^# &, forall x y, #|'C_L[x]| = #|'C_L[y]| } -> - let phi := 'chi[G]_i in - {in Z^# &, forall x y, phi x = phi y} -> - {in Z^#, forall x, phi x \in Cint /\ (#|P| %| phi x - phi 1%g)%C}. -Proof. -move=> sylP oddL tiP [/andP[sZL nZL] ntZ sZ_ZP] prZL; move: i. -pose a := @gring_classM_coef _ G; pose C (i : 'I_#|classes G|) := enum_val i. -have [[sPG pP p'PiG] [sZP cPZ]] := (and3P sylP, subsetIP sZ_ZP). -have [ntP sLG memJ_P1] := normedTI_memJ_P tiP; rewrite setD_eq0 subG1 in ntP. -have nsPL: P <| L. - by have [_ _ /eqP<-] := and3P tiP; rewrite normD1 normal_subnorm. -have [p_pr _ [e oP]] := pgroup_pdiv pP ntP. -have [sZG [sPL _]] := (subset_trans sZP sPG, andP nsPL). -pose dC i (A : {set gT}) := [disjoint C i & A]. -have actsGC i: {acts G, on C i | 'J}. - apply/actsP; rewrite astabsJ /C; have /imsetP[x _ ->] := enum_valP i. - by apply/normsP; apply: classGidr. -have{actsGC} PdvKa i j s: - ~~ dC i Z^# -> ~~ dC j Z^# -> dC s Z -> (#|P| %| a i j s * #|C s|)%N. -- pose Omega := [set uv in [predX C i & C j] | mulgm uv \in C s]%g. - pose to_fn uv x := prod_curry (fun u v : gT => (u ^ x, v ^ x)%g) uv. - have toAct: is_action setT to_fn. - by apply: is_total_action => [[u v]|[u v] x y] /=; rewrite ?conjg1 ?conjgM. - move=> Zi Zj Z's; pose to := Action toAct. - have actsPO: [acts P, on Omega | to]. - apply/(subset_trans sPG)/subsetP=> x Gx; rewrite !inE. - apply/subsetP=> [[u v] /setIdP[/andP/=[Ciu Cjv] Csuv]]. - by rewrite !inE /= -conjMg !actsGC // Ciu Cjv. - have <-: #|Omega| = (a i j s * #|C s|)%N. - have /repr_classesP[_ defCs] := enum_valP s; rewrite -/(C s) in defCs. - rewrite -sum1_card mulnC -sum_nat_const. - rewrite (partition_big mulgm (mem (C s))) => [|[u v] /setIdP[]//]. - apply: eq_bigr; rewrite /= defCs => _ /imsetP[z Gz ->]. - rewrite -[a i j s]sum1_card -!/(C _) (reindex_inj (act_inj to z)) /=. - apply: eq_bigl => [[u v]]; rewrite !inE /= -conjMg (inj_eq (conjg_inj _)). - by apply: andb_id2r => /eqP->; rewrite {2}defCs mem_imset ?andbT ?actsGC. - suffices regPO: {in Omega, forall uv, 'C_P[uv | to] = 1%g}. - rewrite -(acts_sum_card_orbit actsPO) dvdn_sum // => _ /imsetP[uv Ouv ->]. - by rewrite card_orbit regPO // indexg1. - case=> u v /setIdP[/andP[/= Ciu Cjv] Csuv]; apply: contraTeq Z's. - case/trivgPn=> x /setIP[Px /astab1P[/= cux cvx]] nt_x. - suffices inZ k y: y \in C k -> ~~ dC k Z^# -> y ^ x = y -> y \in Z. - apply/exists_inP; exists (u * v)%g => //=. - by rewrite groupM // (inZ i u, inZ j v). - rewrite /dC /C; have /imsetP[_ _ ->{k} /class_eqP <-] := enum_valP k. - case/exists_inP=> _ /imsetP[g Gg ->] /setD1P[nt_yg Zyg] yx. - have xy: (x ^ y = x)%g by rewrite /conjg (conjgCV x) -{2}yx conjgK mulKg. - rewrite -(memJ_conjg _ g) (normsP nZL) //. - rewrite -(memJ_P1 y) ?inE //=; first by rewrite nt_yg (subsetP sZP). - rewrite -order_eq1 -(orderJ y g) order_eq1 nt_yg. - rewrite (mem_normal_Hall (pHall_subl sPL sLG sylP)) //. - by rewrite -(p_eltJ _ _ g) (mem_p_elt pP) ?(subsetP sZP). - rewrite -(memJ_P1 x) // ?xy ?inE ?nt_x // -[y](conjgK g) groupJ ?groupV //. - by rewrite (subsetP sZG). -pose a2 i j := (\sum_(s | ~~ dC s Z^#) a i j s)%N. -pose kerZ l := {in Z^# &, forall x y, 'chi[G]_l x = 'chi_l y}. -move=> l phi kerZl z Z1z; move: l @phi {kerZl}(kerZl : kerZ l). -have [ntz Zz] := setD1P Z1z. -have [[Pz Lz] Gz] := (subsetP sZP z Zz, subsetP sZL z Zz, subsetP sZG z Zz). -pose inC y Gy := enum_rank_in (@mem_classes _ y G Gy) (y ^: G). -have CE y Gy: C (inC y Gy) = y ^: G by rewrite /C enum_rankK_in ?mem_classes. -pose i0 := inC _ (group1 G); pose i1 := inC z Gz; pose i2 := inC _ (groupVr Gz). -suffices Ea2 l (phi := 'chi[G]_l) (kerZphi : kerZ l): - (phi z *+ a2 i1 i1 == phi 1%g + phi z *+ a2 i1 i2 %[mod #|P|])%A. -- move=> l phi kerZphi. - have Zphi1: phi 1%g \in Cint by rewrite irr1_degree rpred_nat. - have chi0 x: x \in Z -> 'chi[G]_0 x = 1. - by rewrite irr0 cfun1E => /(subsetP sZG) ->. - have: kerZ 0 by move=> x y /setD1P[_ Zx] /setD1P[_ Zy]; rewrite !chi0. - move/Ea2/(eqAmodMl (Aint_irr l z)); rewrite !{}chi0 // -/phi eqAmod_sym. - rewrite mulrDr mulr1 !mulr_natr => /eqAmod_trans/(_ (Ea2 l kerZphi)). - rewrite eqAmodDr -/phi eqAmod_rat ?rpred_nat ?(rpred_Cint _ Zphi1) //. - move=> PdvDphi; split; rewrite // -[phi z](subrK (phi 1%g)) rpredD //. - by have /dvdCP[b Zb ->] := PdvDphi; rewrite rpredM ?rpred_nat. - have nz_Z1: #|Z^#|%:R != 0 :> algC. - by rewrite pnatr_eq0 cards_eq0 setD_eq0 subG1. - rewrite -[phi z](mulfK nz_Z1) rpred_div ?rpred_nat // mulr_natr. - rewrite -(rpredDl _ (rpred_Cint _ Zphi1)) //. - rewrite -[_ + _](mulVKf (neq0CG Z)) rpredM ?rpred_nat //. - have: '['Res[Z] phi, 'chi_0] \in Crat. - by rewrite rpred_Cnat ?Cnat_cfdot_char ?cfRes_char ?irr_char. - rewrite irr0 cfdotE (big_setD1 _ (group1 Z)) cfun1E cfResE ?group1 //=. - rewrite rmorph1 mulr1; congr (_ * (_ + _) \in Crat). - rewrite -sumr_const; apply: eq_bigr => x Z1x; have [_ Zx] := setD1P Z1x. - by rewrite cfun1E cfResE ?Zx // rmorph1 mulr1; apply: kerZphi. -pose alpha := 'omega_l['K_i1]; pose phi1 := phi 1%g. -have tiZG: {in Z^#, forall y, 'C_G[y] \subset L}. - move=> y /setD1P[nty /(subsetP sZP)Py]. - apply/subsetP=> u /setIP[Gu /cent1P-cuy]. - by rewrite -(memJ_P1 y) // /conjg -?cuy ?mulKg !inE nty. -have Dalpha s: ~~ dC s Z^# -> alpha = 'omega_l['K_s]. - case/exists_inP=> x /= /gring_mode_class_sum_eq-> Z1x. - have Ci1z: z \in C i1 by rewrite CE class_refl. - rewrite [alpha](gring_mode_class_sum_eq _ Ci1z) -/phi (kerZphi z x) //. - have{tiZG} tiZG: {in Z^#, forall y, 'C_G[y] = 'C_L[y]}. - by move=> y /tiZG/setIidPr; rewrite setIA (setIidPl sLG). - by rewrite -!index_cent1 -!divgS ?subsetIl //= !tiZG ?(prZL z x). -have Ci01: 1%g \in C i0 by rewrite CE class_refl. -have rCi10: repr (C i0) = 1%g by rewrite CE class1G repr_set1. -have Dalpha2 i j: ~~ dC i Z^# -> ~~ dC j Z^# -> - (phi1 * alpha ^+ 2 == phi1 * ((a i j i0)%:R + alpha *+ a2 i j) %[mod #|P|])%A. -- move=> Z1i Z1j. - have ->: phi1 * alpha ^+ 2 = \sum_s (phi1 *+ a i j s) * 'omega_l['K_s]. - rewrite expr2 {1}(Dalpha i Z1i) (Dalpha j Z1j). - rewrite -gring_irr_modeM ?gring_class_sum_central //. - rewrite gring_classM_expansion raddf_sum mulr_sumr; apply: eq_bigr => s _. - by rewrite scaler_nat raddfMn mulrnAl mulrnAr. - rewrite (bigID (fun s => dC s Z^#)) (bigD1 i0) //=; last first. - by rewrite [dC _ _]disjoints_subset CE class1G sub1set !inE eqxx. - rewrite (gring_mode_class_sum_eq _ Ci01) mulfK ?irr1_neq0 //. - rewrite class1G cards1 mulr1 mulrDr mulr_natr -addrA eqAmodDl. - rewrite /eqAmod -addrA rpredD //; last first. - rewrite -mulr_natr natr_sum !mulr_sumr -sumrB rpred_sum // => s Z1s. - by rewrite -Dalpha // mulr_natr mulrnAl mulrnAr subrr rpred0. - apply: rpred_sum => // s /andP[Z1'Cs ntCs]; rewrite mulrnAl mulrC. - have /imsetP[x _ defCs] := enum_valP s. - have Cs_x: x \in C s by rewrite /C defCs class_refl. - rewrite (gring_mode_class_sum_eq _ Cs_x) divfK ?irr1_neq0 // -defCs -/(C s). - rewrite -mulrnAl -mulrnA mulnC -[_%:R]subr0 mulrBl. - apply: eqAmodMr; first exact: Aint_irr. - rewrite eqAmod0_rat ?rpred_nat // dvdC_nat PdvKa //. - rewrite -(setD1K (group1 Z)) [dC _ _]disjoint_sym disjoints_subset. - rewrite subUset sub1set inE -disjoints_subset disjoint_sym. - rewrite (contra _ ntCs) // [C s]defCs => /class_eqP. - by rewrite -(inj_eq enum_val_inj) defCs -/(C _) CE => ->. -have zG'z1: (z^-1 \notin z ^: G)%g. - have genL2 y: y \in L -> <[y]> = <[y ^+ 2]>. - move=> Ly; apply/eqP; rewrite [_ == _]generator_coprime. - by rewrite coprime_sym prime_coprime // dvdn2 (oddSg _ oddL) ?cycle_subG. - apply: contra (ntz) => /imsetP[y Gy zy]. - have cz_y2: (y ^+ 2 \in 'C[z])%g. - by rewrite !inE conjg_set1 conjgM -zy conjVg -zy invgK. - rewrite -cycle_eq1 genL2 // cycle_eq1 -eq_invg_mul zy (sameP eqP conjg_fixP). - rewrite (sameP commgP cent1P) cent1C -cycle_subG genL2 ?cycle_subG //. - by rewrite -(memJ_P1 z) -?zy ?in_setD ?groupV ?inE ?ntz. -have a110: a i1 i1 i0 = 0%N. - apply: contraNeq zG'z1 => /existsP[[u v] /setIdP[/andP[/=]]]. - rewrite rCi10 -!/(C _) !CE -eq_invg_mul => /imsetP[x Gx ->] /class_eqP <-. - by move/eqP <-; rewrite -conjVg classGidl ?class_refl. -have a120: a i1 i2 i0 = #|C i1|. - rewrite -(card_imset _ (@can_inj _ _ (fun y => (y, y^-1)%g) (@fst _ _) _)) //. - apply/eq_card=> [[u v]]; rewrite !inE rCi10 -eq_invg_mul -!/(C _) !CE -andbA. - apply/and3P/imsetP=> /= [[zGu _ /eqP<-] | [y zGy [-> ->]]]; first by exists u. - by rewrite classVg inE invgK. -have Z1i1: ~~ dC i1 Z^#. - by apply/exists_inP; exists z; rewrite //= CE class_refl. -have Z1i2: ~~ dC i2 Z^#. - apply/exists_inP; exists z^-1%g; first by rewrite /= CE class_refl. - by rewrite /= in_setD !groupV !inE ntz. -have{Dalpha2}: (phi1 * (alpha *+ a2 i1 i1) - == phi1 * (#|C i1|%:R + alpha *+ a2 i1 i2) %[mod #|P|])%A. -- rewrite -a120; apply: eqAmod_trans (Dalpha2 i1 i2 Z1i1 Z1i2). - by have:= Dalpha2 _ _ Z1i1 Z1i1; rewrite a110 add0r eqAmod_sym. -rewrite mulrDr !mulrnAr mulr1 -/phi1. -have ->: phi1 * alpha = phi z *+ #|C i1|. - have Ci1z: z \in C i1 by rewrite CE class_refl. - rewrite [alpha](gring_mode_class_sum_eq _ Ci1z) mulrC divfK ?irr1_neq0 //. - by rewrite mulr_natl CE. -rewrite -!mulrnA !(mulnC #|C _|) !mulrnA -mulrnDl. -have [|r _ /dvdnP[q Dqr]] := @Bezoutl #|C i1| #|P|. - by rewrite CE -index_cent1. -have Zq: q%:R \in Aint by apply: rpred_nat. -move/(eqAmodMr Zq); rewrite ![_ *+ #|C _| * _]mulrnAl -!mulrnAr -mulrnA -Dqr. -have /eqnP->: coprime #|C i1| #|P|. - rewrite (p'nat_coprime _ pP) // (pnat_dvd _ p'PiG) // CE -index_cent1. - by rewrite indexgS // subsetI sPG sub_cent1 (subsetP cPZ). -rewrite add1n !mulrS !mulrDr !mulr1 natrM !mulrA. -set u := _ * r%:R; set v := _ * r%:R; rewrite -[u](subrK v) mulrDl addrA. -rewrite eqAmodDr; apply: eqAmod_trans; rewrite eqAmod_sym addrC. -rewrite eqAmod_addl_mul // -mulrBl mulr_natr. -by rewrite !(rpredB, rpredD, rpredMn, Aint_irr). -Qed. - -(* This is Peterfalvi, Theorem (6.8). *) -(* We omit the semi-direct structure of L in assumption (a), since it is *) -(* implied by our statement of assumption (c). *) -Theorem Sibley_coherence L H W1 : - (*a*) [/\ odd #|L|, nilpotent H & normedTI H^# G L] -> - (*b*) let calS := seqIndD H L H 1 in let tau := 'Ind[G, L] in - (*c*) [\/ (*c1*) [Frobenius L = H ><| W1] - | (*c2*) exists2 W2 : {group gT}, prime #|W2| /\ W2 \subset H^`(1)%G - & exists A0, exists W : {group gT}, exists defW : W1 \x W2 = W, - prime_Dade_hypothesis G L H H H^# A0 defW] -> - coherent calS L^# tau. -Proof. -set case_c1 := [Frobenius L = H ><| W1]; pose case_c2 := ~~ case_c1. -set A := H^#; set H' := H^`(1)%G => -[oddL nilH tiA] S tau hyp_c. -have sLG: L \subset G by have [] := normedTI_memJ_P tiA. -have ntH: H :!=: 1%g by have [] := normedTI_P tiA; rewrite setD_eq0 subG1. -have [defL ntW1]: H ><| W1 = L /\ W1 :!=: 1%g. - by have [/Frobenius_context[] | [? _ [? [? [? [_ [[]]]]]]]] := hyp_c. -have [nsHL _ /mulG_sub[sHL sW1L] _ _] := sdprod_context defL. -have [uccS nrS]: cfConjC_subset S S /\ ~~ has cfReal S. - by do 2?split; rewrite ?seqInd_uniq ?seqInd_notReal //; apply: cfAut_seqInd. -have defZS: 'Z[S, L^#] =i 'Z[S, A] by apply: zcharD1_seqInd. -have c1_irrS: case_c1 -> {subset S <= irr L}. - move/FrobeniusWker=> frobL _ /seqIndC1P[i nz_i ->]. - exact: irr_induced_Frobenius_ker. -move defW2: 'C_H(W1)%G => W2; move defW: (W1 <*> W2)%G => W. -have{defW} defW: W1 \x W2 = W. - rewrite -defW dprodEY // -defW2 ?subsetIr // setICA setIA. - by have [_ _ _ ->] := sdprodP defL; rewrite setI1g. -pose V := cyclicTIset defW; pose A0 := A :|: class_support V L. -pose ddA0hyp := prime_Dade_hypothesis G L H H A A0 defW. -have c1W2: case_c1 -> W2 = 1%G by move/Frobenius_trivg_cent/group_inj <-. -have{hyp_c} hyp_c2: case_c2 -> [/\ prime #|W2|, W2 \subset H' & ddA0hyp]. - case: hyp_c => [/idPn// | [W2_ [prW2_ sW2_H'] [A0_ [W_ [defW_ ddA0_]]]] _]. - have idW2_: W2_ = W2. - have [[_ _ _ /cyclicP[x defW1]] [_ _ _ prW12] _] := prDade_prTI ddA0_. - have W1x: x \in W1^# by rewrite !inE -cycle_eq1 -defW1 ntW1 defW1 cycle_id. - by apply/group_inj; rewrite -defW2 /= defW1 cent_cycle prW12. - have idW_: W_ = W by apply/group_inj; rewrite -defW_ idW2_. - rewrite {}/ddA0hyp {}/A0 {}/V; rewrite -idW2_ -idW_ in defW *. - by rewrite (eq_irrelevance defW defW_); have [_ _ <-] := prDade_def ddA0_. -have{hyp_c2} [c2_prW2 c2_sW2H' c2_ddA0] := all_and3 hyp_c2. -have c2_ptiL c2 := prDade_prTI (c2_ddA0 c2). -have{c2_sW2H'} sW2H': W2 \subset H'. - by have [/c1W2-> | /c2_sW2H'//] := boolP case_c1; apply: sub1G. -pose sigma c2 := cyclicTIiso (c2_ddA0 c2). -have [R scohS oRW]: exists2 R, subcoherent S tau R & forall c2 : case_c2, - {in [predI S & irr L] & irr W, forall phi w, orthogonal (R phi) (sigma c2 w)}. -- have sAG: A \subset G^# by rewrite setSD // (subset_trans sHL). - have Itau: {in 'Z[S, L^#], isometry tau, to 'Z[irr G, G^#]}. - split=> [xi1 xi2|xi]; first rewrite !defZS => /zchar_on-Axi1 /zchar_on-Axi2. - exact: normedTI_isometry Axi1 Axi2. - rewrite !zcharD1E cfInd1 // => /andP[Zxi /eqP->]; rewrite mulr0. - by rewrite cfInd_vchar ?(zchar_trans_on _ Zxi) //=; apply: seqInd_vcharW. - have [/= c1 | /c2_ddA0-ddA0] := boolP (idfun case_c1). - suffices [R scohS]: {R | subcoherent S tau R} by exists R => // /negP[]. - by apply: irr_subcoherent; first have [[]] := (uccS, c1_irrS c1). - have Dtau: {in 'CF(L, A), tau =1 Dade ddA0}. - have nAL: L \subset 'N(A) by have [_ /subsetIP[]] := normedTI_P tiA. - have sAA0: A \subset A0 by apply: subsetUl. - by move=> phi Aphi /=; rewrite -(restr_DadeE _ sAA0) // [RHS]Dade_Ind. - have [R [subcohR oRW _]] := prDade_subcoherent ddA0 uccS nrS. - exists R => [|c2 phi w irrSphi irr_w]; last first. - by rewrite /sigma -(cycTIiso_irrel ddA0) oRW. - have [Sok _ oSS Rok oRR] := subcohR; split=> {Sok oSS oRR}// phi Sphi. - have [ZR oNR <-] := Rok _ Sphi; split=> {ZR oNR}//. - exact/Dtau/(zchar_on (seqInd_sub_aut_zchar _ _ Sphi)). -have solH := nilpotent_sol nilH; have nsH'H: H' <| H := der_normal 1 H. -have ltH'H: H' \proper H by rewrite (sol_der1_proper solH). -have nsH'L: H' <| L by apply: gFnormal_trans. -have [sH'H [sH'L nH'L]] := (normal_sub nsH'H, andP nsH'L). -have coHW1: coprime #|H| #|W1|. - suffices: Hall L W1 by rewrite (coprime_sdprod_Hall_r defL). - by have [/Frobenius_compl_Hall | /c2_ddA0/prDade_prTI[[]]] := boolP case_c1. -have oW1: #|W1| = #|L : H| by rewrite (index_sdprod defL). -have frobL1: [Frobenius L / H' = (H / H') ><| (W1 / H')]. - apply: (Frobenius_coprime_quotient defL nsH'L) => //; split=> // x W1x. - have [frobL | /c2_ptiL[_ [_ _ _ -> //]]] := boolP case_c1. - by rewrite (Frobenius_reg_ker frobL) ?sub1G. -have odd_frobL1: odd_Frobenius_quotient H L 1. - split=> //=; last by rewrite joingG1 (FrobeniusWker frobL1). - by rewrite normal1 sub1G quotient_nil. -without loss [/p_groupP[p p_pr pH] not_cHH]: / p_group H /\ ~~ abelian H. - apply: (non_coherent_chief _ _ scohS odd_frobL1) => // -[_ [p [pH ab'H] _]]. - have isoH := quotient1_isog H; rewrite -(isog_pgroup p isoH) in pH. - by apply; rewrite (isog_abelian isoH) (pgroup_p pH). -have sylH: p.-Sylow(G) H. (* required for (6.7) *) - rewrite -Sylow_subnorm -normD1; have [_ _ /eqP->] := and3P tiA. - by apply/and3P; rewrite -oW1 -pgroupE (coprime_p'group _ pH) // coprime_sym. -pose caseA := 'Z(H) :&: W2 \subset [1]%g; pose caseB := ~~ caseA. -have caseB_P: caseB -> [/\ case_c2, W2 :!=: 1%g & W2 \subset 'Z(H)]. - rewrite /caseB /caseA; have [->|] := eqP; first by rewrite subsetIr. - rewrite /case_c2; have [/c1W2->// | /c2_prW2-prW2 _] := boolP case_c1. - by rewrite setIC subG1 => /prime_meetG->. -pose Z := (if caseA then 'Z(H) :&: H' else W2)%G. -have /subsetIP[sZZH sZH']: Z \subset 'Z(H) :&: H'. - by rewrite /Z; case: ifPn => // /caseB_P[_ _ sZZH]; apply/subsetIP. -have caseB_sZZL: caseB -> Z \subset 'Z(L). - move=> in_caseB; have [_ _ /subsetIP[sW2H cW2H]] := caseB_P in_caseB. - rewrite /Z ifN // subsetI (subset_trans sW2H sHL). - by rewrite -(sdprodW defL) centM subsetI cW2H -defW2 subsetIr. -have nsZL: Z <| L; last have [sZL nZL] := andP nsZL. - have [in_caseA | /caseB_sZZL/sub_center_normal//] := boolP caseA. - by rewrite /Z in_caseA normalI ?gFnormal_trans. -have ntZ: Z :!=: 1%g. - rewrite /Z; case: ifPn => [_ | /caseB_P[] //]. - by rewrite /= setIC meet_center_nil // (sameP eqP derG1P). -have nsZH: Z <| H := sub_center_normal sZZH; have [sZH nZH] := andP nsZH. -have regZL: {in Z^# &, forall x y, #|'C_L[x]| = #|'C_L[y]| }. - have [in_caseA | /caseB_sZZL/subsetIP[_ cZL]] := boolP caseA; last first. - suffices defC x: x \in Z^# -> 'C_L[x] = L by move=> x y /defC-> /defC->. - by case/setD1P=> _ /(subsetP cZL); rewrite -sub_cent1 => /setIidPl. - suffices defC x: x \in Z^# -> 'C_L[x] = H by move=> x y /defC-> /defC->. - case/setD1P=> ntx Zx; have /setIP[Hx cHx] := subsetP sZZH x Zx. - have [_ <- _ _] := sdprodP defL; rewrite -group_modl ?sub_cent1 //=. - suffices ->: 'C_W1[x] = 1%g by rewrite mulg1. - have [/Frobenius_reg_compl-> // | c2] := boolP case_c1; first exact/setD1P. - have [_ [_ _ _ regW1] _] := c2_ptiL c2. - apply: contraTeq in_caseA => /trivgPn[y /setIP[W1y cxy] nty]; apply/subsetPn. - by exists x; rewrite inE // -(regW1 y) 2!inE ?nty // Hx cHx cent1C. -have{regZL} irrZmodH := - constant_irr_mod_TI_Sylow sylH oddL tiA (And3 nsZL ntZ sZZH) regZL. -pose X := seqIndD H L Z 1; pose Y := seqIndD H L H H'. -have ccsXS: cfConjC_subset X S by apply: seqInd_conjC_subset1. -have ccsYS: cfConjC_subset Y S by apply: seqInd_conjC_subset1. -have [[uX sXS ccX] [uY sYS ccY]] := (ccsXS, ccsYS). -have X'Y: {subset Y <= [predC X]}. - move=> _ /seqIndP[i /setIdP[_ kH'i] ->]; rewrite inE in kH'i. - by rewrite !inE mem_seqInd ?normal1 // !inE (subset_trans sZH'). -have oXY: orthogonal X Y. - apply/orthogonalP=> xi eta Xxi Yeta; apply: orthoPr xi Xxi. - exact: (subset_ortho_subcoherent scohS sXS (sYS _ Yeta) (X'Y _ Yeta)). -have irrY: {subset Y <= irr L}. - move=> _ /seqIndP[i /setIdP[not_kHi kH'i] ->]; rewrite !inE in not_kHi kH'i. - rewrite -(cfQuo_irr nsH'L) ?sub_cfker_Ind_irr -?cfIndQuo -?quo_IirrE //. - apply: (irr_induced_Frobenius_ker (FrobeniusWker frobL1)). - by rewrite quo_Iirr_eq0 -?subGcfker. -have oY: orthonormal Y by apply: sub_orthonormal (irr_orthonormal L). -have uniY: {in Y, forall phi : 'CF(L), phi 1%g = #|W1|%:R}. - move=> _ /seqIndP[i /setIdP[_ kH'i] ->]; rewrite inE -lin_irr_der1 in kH'i. - by rewrite cfInd1 // -divgS // -(sdprod_card defL) mulKn // lin_char1 ?mulr1. -have scohY: subcoherent Y tau R by apply: (subset_subcoherent scohS). -have [tau1 cohY]: coherent Y L^# tau. - apply/(uniform_degree_coherence scohY)/(@all_pred1_constant _ #|W1|%:R). - by apply/allP=> _ /mapP[phi Yphi ->]; rewrite /= uniY. -have [[Itau1 Ztau1] Dtau1] := cohY. -have oYtau: orthonormal (map tau1 Y) by apply: map_orthonormal. -have [[_ oYY] [_ oYYt]] := (orthonormalP oY, orthonormalP oYtau). -have [eta1 Yeta1]: {eta1 | eta1 \in Y} by apply: seqIndD_nonempty. -pose m : algC := (size Y)%:R; pose m_ub2 a := (a - 1) ^+ 2 + (m - 1) * a ^+ 2. -have m_ub2_lt2 a: a \in Cint -> m_ub2 a < 2%:R -> a = 0 \/ a = 1 /\ size Y = 2. - move=> Za ub_a; have [|nza] := eqVneq a 0; [by left | right]. - have ntY: (1 < size Y)%N by apply: seqInd_nontrivial Yeta1. - have m1_ge1: 1 <= m - 1 by rewrite ler_subr_addr (ler_nat _ 2). - have a1: a = 1. - apply: contraFeq (ltr_geF ub_a); rewrite -subr_eq0 /m_ub2 => nz_a1. - by rewrite ler_add ?(mulr_ege1 m1_ge1) // sqr_Cint_ge1 ?rpredB. - rewrite /m_ub2 a1 subrr expr0n add0r expr1n mulr1 in ub_a. - rewrite ltr_subl_addr -mulrSr ltr_nat ltnS in ub_a. - by split; last apply/anti_leq/andP. -have{odd_frobL1} caseA_cohXY: caseA -> coherent (X ++ Y) L^# tau. - move=> in_caseA. - have scohX: subcoherent X tau R by apply: subset_subcoherent ccsXS. - have irrX: {subset X <= irr L}. - have [c1 | c2] := boolP case_c1; first by move=> phi /sXS/c1_irrS->. - have ptiL := c2_ptiL c2; have [_ [ntW2 sW2H _ _] _] := ptiL. - have{sW2H} isoW2: W2 / Z \isog W2. - apply/isog_symr/quotient_isog; first exact: subset_trans sW2H nZH. - exact/trivgP/(subset_trans _ in_caseA)/setSI. - have{ntW2} ntW2bar: (W2 / Z != 1)%g by rewrite (isog_eq1 isoW2). - have{ntW2bar} [defWbar ptiLZ] := primeTIhyp_quotient ptiL ntW2bar sZH nsZL. - pose IchiZ := [set mod_Iirr (primeTI_Ires ptiLZ j) | j : Iirr (W2 / Z)]. - suffices /eqP-eq_Ichi: IchiZ == [set primeTI_Ires ptiL j | j : Iirr W2]. - move=> _ /seqIndP[k /setDP[_ kZ'k] ->]. - have [[j /irr_inj-Dk] | [] //] := prTIres_irr_cases ptiL k. - have{j Dk} /imsetP[j _ Dk]: k \in IchiZ by rewrite eq_Ichi Dk mem_imset. - by rewrite !inE Dk mod_IirrE ?cfker_mod in kZ'k. - rewrite eqEcard !card_imset; last exact: prTIres_inj; first last. - exact: inj_comp (morph_Iirr_inj _) (prTIres_inj _). - apply/andP; split; last by rewrite !card_ord !NirrE (nclasses_isog isoW2). - apply/subsetP=> k /imsetP[j _ Dk]. - have [[j1 /irr_inj->]|] := prTIres_irr_cases ptiL k; first exact: mem_imset. - case=> /idPn[]; rewrite {k}Dk mod_IirrE ?cfIndMod ?cfMod_irr //. - by rewrite cfInd_prTIres prTIred_not_irr. - have [//|defX [tau2 cohX]]: X =i _ /\ coherent X L^# tau := - seqIndD_irr_coherence nsHL solH scohS odd_frobL1 _ irrX. - have [[Itau2 Ztau2] Dtau2] := cohX. - pose dvd_degrees_X (d : algC) := {in X, forall xi : 'CF(L), d %| xi 1%g}%C. - have [xi1 Xxi1 dvd_xi1_1]: exists2 xi1, xi1 \in X & dvd_degrees_X (xi1 1%g). - have /all_sig[e De] i: {e | 'chi[H]_i 1%g = (p ^ e)%:R}. - have:= dvd_irr1_cardG i; rewrite irr1_degree dvdC_nat => dv_chi1_H. - by have /p_natP[e ->] := pnat_dvd dv_chi1_H pH; exists e. - have [_ /seqIndP[i0 IXi0 _]]: {phi | phi \in X}. - by apply: seqIndD_nonempty; rewrite ?normal1 ?proper1G. - pose xi1 := 'Ind[L] 'chi_[arg min_(i < i0 in Iirr_kerD H Z 1%G) e i]. - case: arg_minP => {i0 IXi0}//= i1 IXi1 min_i1 in xi1. - exists xi1 => [|_ /seqIndP[i IXi ->]]; first by apply/seqIndP; exists i1. - rewrite !cfInd1 // !De -!natrM dvdC_nat dvdn_pmul2l //. - by rewrite dvdn_Pexp2l ?min_i1 ?prime_gt1. - have nz_xi1_1: xi1 1%g != 0 by apply: seqInd1_neq0 Xxi1. - pose d (xi : 'CF(L)) : algC := (truncC (xi 1%g / xi1 1%g))%:R. - have{dvd_xi1_1} def_d xi: xi \in X -> xi 1%g = d xi * xi1 1%g. - rewrite /d => Xxi; have Xge0 := Cnat_ge0 (Cnat_seqInd1 (_ : _ \in X)). - by have /dvdCP_nat[||q ->] := dvd_xi1_1 xi Xxi; rewrite ?Xge0 ?mulfK ?natCK. - have d_xi1: d xi1 = 1 by rewrite /d divff ?truncC1. - have [_ [Itau /(_ _ _)/zcharW-Ztau] _ _ _] := scohS. - have o_tauXY: orthogonal (map tau2 X) (map tau1 Y). - exact: (coherent_ortho scohS). - have [a Na xi1_1]: exists2 a, a \in Cnat & xi1 1%g = a * #|W1|%:R. - have [i _ ->] := seqIndP Xxi1; rewrite cfInd1 // -oW1 mulrC. - by exists ('chi_i 1%g); first apply: Cnat_irr1. - pose psi1 := xi1 - a *: eta1. - have Zpsi1: psi1 \in 'Z[S, L^#]. - rewrite zcharD1E !cfunE (uniY _ Yeta1) -xi1_1 subrr eqxx andbT. - by rewrite rpredB ?rpredZ_Cnat ?mem_zchar ?(sXS _ Xxi1) // sYS. - have [Y1 dY1 [X1 [dX1 _ oX1tauY]]] := orthogonal_split (map tau1 Y)(tau psi1). - have{dX1 Y1 dY1 oYtau} [b Zb tau_psi1]: {b | b \in Cint & - tau psi1 = X1 - a *: tau1 eta1 + b *: (\sum_(eta <- Y) tau1 eta)}. - - exists ('[tau psi1, tau1 eta1] + a). - by rewrite rpredD ?Cint_cfdot_vchar ?Cint_Cnat ?Ztau ?Ztau1 ?mem_zchar. - rewrite [LHS]dX1 addrC -addrA; congr (_ + _). - have{dY1} [_ -> ->] := orthonormal_span oYtau dY1. - transitivity (\sum_(xi <- map tau1 Y) '[tau psi1, xi] *: xi). - by apply/eq_big_seq=> xi ?; rewrite dX1 cfdotDl (orthoPl oX1tauY) ?addr0. - rewrite big_map scaler_sumr !(big_rem eta1 Yeta1) /= addrCA addrA scalerDl. - rewrite addrK; congr (_ + _); apply: eq_big_seq => eta. - rewrite mem_rem_uniq // => /andP[eta1'eta /= Yeta]; congr (_ *: _). - apply/(canRL (addNKr _)); rewrite addrC -2!raddfB /=. - have Zeta: eta - eta1 \in 'Z[Y, L^#]. - by rewrite zcharD1E rpredB ?seqInd_zcharW //= !cfunE !uniY ?subrr. - rewrite Dtau1 // Itau // ?(zchar_subset sYS) // cfdotBl cfdotZl. - rewrite (span_orthogonal oXY) ?rpredB ?memv_span // add0r cfdotBr. - by rewrite !oYY // !mulrb eqxx ifN_eqC // sub0r mulrN1 opprK. - have oX: orthonormal X by apply: sub_orthonormal (irr_orthonormal L). - have [_ oXX] := orthonormalP oX. - have Zxi1Xd xi: xi \in X -> xi - d xi *: xi1 \in 'Z[X, L^#]. - move=> Xxi; rewrite zcharD1E !cfunE -def_d // subrr eqxx. - by rewrite rpredB ?rpredZnat ?mem_zchar. - pose psi := 'Res[L] (tau1 eta1); move Dc: '[psi, xi1] => c. - have Zpsi: psi \in 'Z[irr L] by rewrite cfRes_vchar ?Ztau1 ?seqInd_zcharW. - pose sumXd : 'CF(L) := \sum_(xi <- X) d xi *: xi. - have{Dc} [xi2 Dpsi oxi2X]: {xi2 | psi = c *: sumXd + xi2 & orthogonal xi2 X}. - exists (psi - c *: sumXd); first by rewrite addrC subrK. - apply/orthoPl=> xi Xxi; rewrite cfdotBl cfdotZl cfproj_sum_orthonormal //. - rewrite mulrC -[d xi]conjCK -Dc -cfdotZr -cfdotBr cfdot_Res_l -conjC0. - rewrite -/tau rmorph_nat -Dtau2 ?Zxi1Xd // raddfB raddfZnat -/(d xi) cfdotC. - by rewrite (span_orthogonal o_tauXY) ?rpredB ?rpredZ ?memv_span ?map_f. - have Exi2 z: z \in Z -> xi2 z = xi2 1%g. - rewrite [xi2]cfun_sum_constt => Zz; apply/cfker1; apply: subsetP z Zz. - apply: subset_trans (cfker_sum _ _ _); rewrite subsetI sZL. - apply/bigcapsP=> i; rewrite inE => xi2_i; rewrite cfker_scale_nz //. - by apply: contraR xi2_i => X_i; rewrite (orthoPl oxi2X) // defX inE mem_irr. - have Eba: '[psi, psi1] = b - a. - rewrite cfdotC cfdot_Res_r -/tau tau_psi1 cfdotDl cfdotBl cfdotZl. - rewrite (orthoPl oX1tauY) 1?oYYt ?map_f // eqxx sub0r addrC mulr1 rmorphB. - by rewrite scaler_sumr cfproj_sum_orthonormal // aut_Cint // aut_Cnat. - have{Eba oxi2X} Ebc: (a %| b - c)%C. - rewrite -[b](subrK a) -Eba cfdotBr {1}Dpsi cfdotDl cfdotZl. - rewrite cfproj_sum_orthonormal // (orthoPl oxi2X) // addr0 d_xi1 mulr1. - rewrite addrC -addrA addKr addrC rpredB ?dvdC_refl //= cfdotZr aut_Cnat //. - by rewrite dvdC_mulr // Cint_cfdot_vchar ?(seqInd_vcharW Yeta1). - have DsumXd: sumXd = (xi1 1%g)^-1 *: (cfReg L - cfReg (L / Z) %% Z)%CF. - apply/(canRL (scalerK nz_xi1_1))/(canRL (addrK _)); rewrite !cfReg_sum. - pose kerZ := [pred i : Iirr L | Z \subset cfker 'chi_i]. - rewrite 2!linear_sum (bigID kerZ) (reindex _ (mod_Iirr_bij nsZL)) /= addrC. - congr (_ + _). - apply: eq_big => [i | i _]; first by rewrite mod_IirrE ?cfker_mod. - by rewrite linearZ mod_IirrE // cfMod1. - transitivity (\sum_(xi <- X) xi 1%g *: xi). - by apply: eq_big_seq => xi Xxi; rewrite scalerA mulrC -def_d. - rewrite (eq_big_perm [seq 'chi_i | i in [predC kerZ]]). - by rewrite big_map big_filter. - apply: uniq_perm_eq => // [|xi]. - by rewrite (map_inj_uniq irr_inj) ?enum_uniq. - rewrite defX; apply/andP/imageP=> [[/irrP[i ->]] | [i]]; first by exists i. - by move=> kerZ'i ->; rewrite mem_irr. - have nz_a: a != 0 by have:= nz_xi1_1; rewrite xi1_1 mulf_eq0 => /norP[]. - have{psi Dpsi Zpsi xi2 Exi2 sumXd DsumXd} tau_eta1_Z z: - z \in Z^# -> tau1 eta1 z - tau1 eta1 1%g = - c * #|H|%:R / a. - - case/setD1P=> /negPf-ntz Zz; have Lz := subsetP sZL z Zz. - transitivity (psi z - psi 1%g); first by rewrite !cfResE. - rewrite Dpsi DsumXd !(cfRegE, cfunE) eqxx -opprB 2!mulrDr -[_ + xi2 _]addrA. - rewrite Exi2 ?cfModE ?morph1 ?coset_id // ntz add0r addrK -mulNr mulrAC. - by rewrite xi1_1 invfM -(sdprod_card defL) mulnC natrM !mulrA divfK ?neq0CG. - have{tau_eta1_Z} dvH_cHa: (#|H| %| c * #|H|%:R / a)%C. - have /dirrP[e [i /(canLR (signrZK e))Deta1]]: tau1 eta1 \in dirr G. - by rewrite dirrE Ztau1 ?seqInd_zcharW //= oYYt ?map_f ?eqxx. - have /set0Pn[z Zz]: Z^# != set0 by rewrite setD_eq0 subG1. - have [z1 z2 Zz1 Zz2|_] := irrZmodH i _ z Zz. - rewrite -Deta1 !cfunE; congr (_ * _); apply/(addIr (- tau1 eta1 1%g)). - by rewrite !tau_eta1_Z. - by rewrite -Deta1 !cfunE -mulrBr rpredMsign ?tau_eta1_Z ?mulNr ?rpredN. - have{dvH_cHa} dv_ac: (a %| c)%C. - by rewrite -(@dvdC_mul2r _ a) ?divfK // mulrC dvdC_mul2l ?neq0CG in dvH_cHa. - have{c Ebc dv_ac} /dvdCP[q Zq Db]: (a %| b)%C by rewrite rpredBr in Ebc. - have norm_psi1: '[psi1] = 1 + a ^+ 2. - rewrite cfnormBd; last by rewrite cfdotZr (orthogonalP oXY) ?mulr0. - by rewrite cfnormZ norm_Cnat // oXX // oYY // !eqxx mulr1. - have{Zb oYYt} norm_tau_psi1: '[tau psi1] = '[X1] + a ^+ 2 * m_ub2 q. - rewrite tau_psi1 -addrA cfnormDd /m_ub2; last first. - rewrite addrC big_seq (span_orthogonal oX1tauY) ?memv_span1 //. - by rewrite rpredB ?rpredZ ?rpred_sum // => *; rewrite memv_span ?map_f. - congr (_ + _); transitivity (b ^+ 2 * m + a ^+ 2 - a * b *+ 2); last first. - rewrite [RHS]mulrC [in RHS]addrC mulrBl sqrrB1 !addrA mulrDl !mul1r subrK. - by rewrite mulrBl [m * _]mulrC mulrnAl mulrAC Db exprMn (mulrCA a) addrAC. - rewrite addrC cfnormB !cfnormZ Cint_normK ?norm_Cnat // cfdotZr. - rewrite cfnorm_map_orthonormal // -/m linear_sum cfproj_sum_orthonormal //. - by rewrite oYYt ?map_f // eqxx mulr1 rmorphM conjCK aut_Cnat ?aut_Cint. - have{norm_tau_psi1} mq2_lt2: m_ub2 q < 2%:R. - suffices a2_gt1: a ^+ 2 > 1. - have /ltr_pmul2l <-: a ^+ 2 > 0 by apply: ltr_trans a2_gt1. - rewrite -(ltr_add2l '[X1]) -norm_tau_psi1 ltr_paddl ?cfnorm_ge0 //. - by rewrite Itau // mulr_natr norm_psi1 ltr_add2r. - suffices a_neq1: a != 1. - rewrite expr_gt1 ?Cnat_ge0 // ltr_neqAle eq_sym a_neq1. - by rewrite -(norm_Cnat Na) norm_Cint_ge1 ?Cint_Cnat. - have /seqIndP[i1 /setDP[_ not_kerH'i1] Dxi1] := Xxi1. - apply: contraNneq not_kerH'i1 => a_eq1; rewrite inE (subset_trans sZH') //. - rewrite -lin_irr_der1 qualifE irr_char /= -(inj_eq (mulfI (neq0CiG L H))). - by rewrite -cfInd1 // -Dxi1 xi1_1 a_eq1 mul1r mulr1 oW1. - without loss{tau_psi1 Itau1 Ztau1 Dtau1 b q Db mq2_lt2 Zq} tau_psi1: - tau1 cohY o_tauXY oX1tauY / tau psi1 = X1 - a *: tau1 eta1. - - move=> IH; have [q0 | [q1 /eq_leq-szY2]] := m_ub2_lt2 q Zq mq2_lt2. - by apply: (IH tau1) => //; rewrite tau_psi1 Db q0 mul0r scale0r addr0. - have defY: perm_eq Y (eta1 :: eta1^*)%CF. - have uYeta: uniq (eta1 :: eta1^*)%CF. - by rewrite /= inE eq_sym (hasPn nrS) ?sYS. - rewrite perm_eq_sym uniq_perm_eq //. - have [|//]:= leq_size_perm uYeta _ szY2. - by apply/allP; rewrite /= Yeta1 ccY. - have memYtau1c: {subset [seq tau1 eta^* | eta <- Y]%CF <= map tau1 Y}. - by move=> _ /mapP[eta Yeta ->]; rewrite /= map_f ?ccY. - apply: IH (dual_coherence scohY cohY szY2) _ _ _. - - rewrite (map_comp -%R) orthogonal_oppr. - by apply/orthogonalP=> phi psi ? /memYtau1c; apply: (orthogonalP o_tauXY). - - rewrite (map_comp -%R) orthogonal_oppr. - by apply/orthoPl=> psi /memYtau1c; apply: (orthoPl oX1tauY). - rewrite tau_psi1 (eq_big_perm _ defY) Db q1 /= mul1r big_cons big_seq1. - by rewrite scalerDr addrA subrK -scalerN opprK. - have [[Itau1 Ztau1] Dtau1] := cohY. - have n1X1: '[X1] = 1. - rewrite -(canLR (addrK _) norm_psi1) -Itau // tau_psi1. - rewrite cfnormBd; last by rewrite cfdotZr (orthoPl oX1tauY) ?map_f ?mulr0. - by rewrite cfnormZ norm_Cnat // Itau1 ?mem_zchar ?oYY // eqxx mulr1 addrK. - without loss{Itau2 Ztau2 Dtau2} defX1: tau2 cohX o_tauXY / X1 = tau2 xi1. - move=> IH; have ZX: {subset X <= 'Z[X]} by apply: seqInd_zcharW. - have dirrXtau xi: xi \in X -> tau2 xi \in dirr G. - by move=> Xxi; rewrite dirrE Ztau2 1?Itau2 ?ZX //= oXX ?eqxx. - have dirrX1: X1 \in dirr G. - rewrite dirrE n1X1 eqxx -(canLR (subrK _) tau_psi1). - by rewrite rpredD ?rpredZ_Cnat ?(zcharW (Ztau _ _)) ?Ztau1 ?seqInd_zcharW. - have{Zxi1Xd} oXdX1 xi: xi \in X -> xi != xi1 -> - '[d xi *: tau2 xi1 - tau2 xi, X1] = d xi. - - move=> Xxi xi1'xi; have ZXxi := Zxi1Xd xi Xxi. - rewrite -(canLR (subrK _) tau_psi1) cfdotDr addrC. - rewrite (span_orthogonal o_tauXY) ?rpredB ?rpredZ ?memv_span ?map_f //. - rewrite add0r -opprB cfdotNl -{1}raddfZ_Cnat ?Cnat_nat // -raddfB. - rewrite Dtau2 // Itau ?cfdotBr ?opprB //; last exact: zchar_subset ZXxi. - rewrite (span_orthogonal oXY) ?rpredB ?rpredZ ?memv_span // sub0r. - by rewrite cfdotBl cfdotZl opprB !oXX // eqxx mulr1 mulrb ifN ?subr0. - pose xi3 := xi1^*%CF; have Xxi3: xi3 \in X by apply: ccX. - have xi1'3: xi3 != xi1 by rewrite (hasPn nrS) ?sXS. - have [| defX1]: X1 = tau2 xi1 \/ X1 = - tau2 xi3; first 2 [exact : IH]. - have d_xi3: d xi3 = 1 by rewrite /d cfunE conj_Cnat ?(Cnat_seqInd1 Xxi1). - have:= oXdX1 xi3 Xxi3 xi1'3; rewrite d_xi3 scale1r. - by apply: cfdot_add_dirr_eq1; rewrite // ?rpredN dirrXtau. - have szX2: (size X <= 2)%N. - apply: uniq_leq_size (xi1 :: xi3) uX _ => // xi4 Xxi4; rewrite !inE. - apply: contraR (seqInd1_neq0 nsHL Xxi4) => /norP[xi1'4 xi3'4]. - rewrite def_d // -oXdX1 // defX1 cfdotNr cfdotBl cfdotZl opprB. - by rewrite !Itau2 ?ZX ?oXX // !mulrb ifN ?ifN_eqC // mulr0 subr0 mul0r. - apply: (IH _ (dual_coherence scohX cohX szX2)) defX1. - apply/orthogonalP=> _ psi2 /mapP[xi Xxi -> /=] Ytau_psi2. - by rewrite cfdotNl (orthogonalP o_tauXY) ?oppr0 // map_f ?ccX. - rewrite -raddfZ_Cnat // defX1 in tau_psi1. - apply: (bridge_coherent scohS ccsXS cohX ccsYS cohY X'Y) tau_psi1. - by rewrite (zchar_on Zpsi1) rpredZ_Cnat ?mem_zchar. -have{caseA_cohXY Itau1 Ztau1 Dtau1 oYYt} cohXY: coherent (X ++ Y) L^# tau. - have [in_caseA | in_caseB] := boolP caseA; first exact: caseA_cohXY. - have defZ: Z = W2 by rewrite /Z ifN. - have /subsetIP[_ cZL] := caseB_sZZL in_caseB. - have{in_caseB} [c2 _ _] := caseB_P in_caseB; move/(_ c2) in oRW. - pose PtypeL := c2_ddA0 c2; pose w2 := #|W2|. - have{c2_prW2} pr_w2: prime w2 := c2_prW2 c2. - have /cyclicP[z0 cycZ]: cyclic Z by rewrite defZ prime_cyclic. - have oz0: #[z0] = w2 by rewrite /w2 -defZ cycZ. - have regYZ: {in Y & Z^#, forall (eta : 'CF(L)) x, tau1 eta x = tau1 eta z0}. - rewrite cycZ => eta x Yeta /setD1P[ntx /cyclePmin[k lt_k_z0 Dx]]. - have{ntx} k_gt0: (0 < k)%N by case: (k) Dx ntx => // -> /eqP[]. - have{lt_k_z0} [cokw2 zz0_dv_w2]: coprime k w2 /\ #[z0] %| w2. - by rewrite coprime_sym prime_coprime // -oz0 // gtnNdvd. - have [u Du _]:= make_pi_cfAut G cokw2; rewrite Dx -Du ?Ztau1 ?mem_zchar //. - have nAL: L \subset 'N(A) by have [_ /subsetIP[]] := normedTI_P tiA. - pose ddA := restr_Dade_hyp PtypeL (subsetUl _ _) nAL. - have{Dtau1} Dtau1: {in 'Z[Y, L^#], tau1 =1 Dade ddA}. - by move=> phi Yphi/=; rewrite Dtau1 ?Dade_Ind ?(zcharD1_seqInd_on _ Yphi). - have cohY_Dade: coherent_with Y L^# (Dade ddA) tau1 by []. - rewrite (cfAut_Dade_coherent cohY_Dade) ?irrY //; last first. - split; last exact: cfAut_seqInd. - exact: seqInd_nontrivial_irr (irrY _ Yeta) (Yeta). - rewrite -[cfAut u _](subrK eta) -opprB addrC raddfB !cfunE -[RHS]subr0. - congr (_ - _); rewrite Dtau1 ?zcharD1_seqInd ?seqInd_sub_aut_zchar //. - rewrite Dade_id; last by rewrite !inE -cycle_eq1 -cycle_subG -cycZ ntZ. - rewrite !cfunE cfker1 ?aut_Cnat ?subrr ?(Cnat_seqInd1 Yeta) //. - have [j /setDP[kerH'j _] Deta] := seqIndP Yeta; rewrite inE in kerH'j. - by rewrite -cycle_subG -cycZ (subset_trans sZH') // Deta sub_cfker_Ind_irr. - have [_ [Itau /(_ _ _)/zcharW-Ztau] oSS _ _] := scohS. - pose gamma i : 'CF(L) := 'Ind[L] 'chi[Z]_i - #|H : Z|%:R *: eta1. - have [Y1 tau_gamma defY1]: exists2 Y1 : 'CF(G), forall i : Iirr Z, i != 0 -> - exists2 X1 : 'CF(G), orthogonal X1 (map tau1 Y) - & tau (gamma i) = X1 - #|H : Z|%:R *: Y1 - & Y1 = tau1 eta1 \/ size Y = 2 /\ Y1 = dual_iso tau1 eta1. - - pose psi1 := tau1 eta1; pose b := psi1 z0. - pose a := (psi1 1%g - b) / #|Z|%:R. - have sZG := subset_trans sZL sLG. - have Dpsi1: 'Res[Z] psi1 = a *: cfReg Z + b%:A. - apply/cfun_inP=> z Zz; rewrite cfResE // !(cfRegE, cfunE) cfun1E Zz mulr1. - have [-> | ntz] := altP eqP; first by rewrite divfK ?neq0CG ?subrK. - by rewrite mulr0 add0r regYZ // !inE ntz. - have /dvdCP[x0 Zx0 Dx0]: (#|H : Z| %| a)%C. - suffices dvH_p_psi1: (#|H| %| b - psi1 1%g)%C. - rewrite -(@dvdC_mul2r _ #|Z|%:R) ?divfK ?neq0CG // -opprB rpredN /=. - by rewrite -natrM mulnC Lagrange. - have psi1Z z: z \in Z^# -> psi1 z = b by apply: regYZ. - have /dirrP[e [i /(canLR (signrZK e))-Epsi1]]: psi1 \in dirr G. - have [_ oYt] := orthonormalP oYtau. - by rewrite dirrE oYt ?map_f // !eqxx Ztau1 ?seqInd_zcharW. - have Zz: z0 \in Z^# by rewrite !inE -cycle_eq1 -cycle_subG -cycZ ntZ /=. - have [z1 z2 Zz1 Zz2 |_] := irrZmodH i _ _ Zz. - by rewrite -Epsi1 !cfunE !psi1Z. - by rewrite -Epsi1 !cfunE -mulrBr rpredMsign psi1Z. - pose x1 := '[eta1, 'Res psi1]; pose x := x0 + 1 - x1. - have Zx: x \in Cint. - rewrite rpredB ?rpredD // Cint_cfdot_vchar // ?(seqInd_vcharW Yeta1) //. - by rewrite cfRes_vchar // Ztau1 ?seqInd_zcharW. - pose Y1 := - \sum_(eta <- Y) (x - (eta == eta1)%:R) *: tau1 eta. - have IndZfacts i: i != 0 -> - [/\ 'chi_i 1%g = 1, 'Ind 'chi_i \in 'Z[X] & gamma i \in 'Z[S, L^#]]. - - move=> nzi; have /andP[_ /eqP-lin_i]: 'chi_i \is a linear_char. - by rewrite lin_irr_der1 (derG1P _) ?sub1G // cycZ cycle_abelian. - have Xchi: 'Ind 'chi_i \in 'Z[X]. - rewrite -(cfIndInd _ sHL) // ['Ind[H] _]cfun_sum_constt linear_sum. - apply: rpred_sum => k k_i; rewrite linearZ rpredZ_Cint ?mem_zchar //=. - by rewrite Cint_cfdot_vchar_irr // cfInd_vchar ?irr_vchar. - rewrite mem_seqInd ?normal1 // !inE sub1G andbT. - by rewrite -(sub_cfker_constt_Ind_irr k_i) // subGcfker. - split=> //; rewrite zcharD1E !cfunE cfInd1 // uniY // lin_i mulr1. - rewrite oW1 -natrM mulnC Lagrange_index // subrr eqxx andbT. - by rewrite rpredB ?rpredZnat ?(zchar_subset sXS Xchi) ?mem_zchar ?sYS. - have Dgamma (i : Iirr Z) (nzi : i != 0): - exists2 X1 : 'CF(G), orthogonal X1 (map tau1 Y) - & tau (gamma i) = X1 - #|H : Z|%:R *: Y1. - - have [lin_i Xchi Zgamma] := IndZfacts i nzi. - have Da: '[tau (gamma i), psi1] = a - #|H : Z|%:R * x1. - rewrite !(=^~ cfdot_Res_r, cfdotBl) cfResRes // cfdotZl -/x1 Dpsi1. - congr (_ - _); rewrite cfdotDr cfReg_sum cfdotC cfdotZl cfdotZr. - rewrite -(big_tuple _ _ _ xpredT (fun xi : 'CF(Z) => xi 1%g *: xi)). - rewrite cfproj_sum_orthonormal ?irr_orthonormal ?mem_irr // lin_i mulr1. - rewrite -irr0 cfdot_irr (negPf nzi) mulr0 addr0. - by rewrite aut_Cint // Dx0 rpredM ?rpred_nat. - exists (tau (gamma i) + #|H : Z|%:R *: Y1); last by rewrite addrK. - apply/orthoPl=> _ /mapP[eta Yeta ->]. - rewrite scalerN cfdotBl cfdotZl cfproj_sum_orthonormal // [x]addrAC. - rewrite -addrA mulrDr mulrBr mulrC -Dx0 -Da opprD addrA -!raddfB /=. - have Yeta_1: eta - eta1 \in 'Z[Y, L^#]. - by rewrite zcharD1E rpredB ?seqInd_zcharW //= !cfunE !uniY ?subrr. - rewrite Dtau1 ?Itau // ?(zchar_subset sYS) // cfdotBl cfdotZl. - rewrite (span_orthogonal oXY) ?(zchar_span Xchi) ?(zchar_span Yeta_1) //. - by rewrite cfdotBr -mulrN opprB !oYY // eqxx eq_sym addrK. - have [i0 nz_i0] := has_nonprincipal_irr ntZ. - exists Y1 => //; have{Dgamma} [X1 oX1Y Dgamma] := Dgamma i0 nz_i0. - have [lin_i Xchi Zgamma] := IndZfacts i0 nz_i0. - have norm_gamma: '[tau (gamma i0)] = (#|L : Z| + #|H : Z| ^ 2)%:R. - rewrite natrD Itau // cfnormBd; last first. - rewrite (span_orthogonal oXY) ?(zchar_span Xchi) //. - by rewrite memvZ ?memv_span. - rewrite cfnorm_Ind_irr //; congr (#|_ : Z|%:R + _); last first. - by rewrite cfnormZ oYY // eqxx mulr1 normCK rmorph_nat -natrM. - by apply/setIidPl; rewrite (subset_trans _ (cent_sub_inertia _)) 1?centsC. - have{norm_gamma} ub_norm_gamma: '[tau (gamma i0)] < (#|H : Z| ^ 2).*2%:R. - rewrite norm_gamma -addnn ltr_nat ltn_add2r. - rewrite -(Lagrange_index sHL) ?ltn_pmul2r // -[#|H : Z| ]prednK // ltnS. - have frobL2: [Frobenius L / Z = (H / Z) ><| (W1 / Z)]%g. - apply: (Frobenius_coprime_quotient defL nsZL) => //. - split=> [|y W1y]; first exact: sub_proper_trans ltH'H. - by rewrite defZ; have [/= ? [_ [_ _ _ ->]]] := PtypeL. - have nZW1 := subset_trans sW1L nZL. - have tiZW1: Z :&: W1 = 1%g by rewrite coprime_TIg ?(coprimeSg sZH). - rewrite -oW1 (card_isog (quotient_isog nZW1 tiZW1)) -card_quotient //. - rewrite dvdn_leq ?(Frobenius_dvd_ker1 frobL2) // -subn1 subn_gt0. - by rewrite cardG_gt1; case/Frobenius_context: frobL2. - have{ub_norm_gamma} ub_xm: m_ub2 x < 2%:R. - have: '[Y1] < 2%:R. - rewrite -2!(ltr_pmul2l (gt0CiG H Z)) -!natrM mulnA muln2. - apply: ler_lt_trans ub_norm_gamma; rewrite Dgamma cfnormBd. - by rewrite cfnormZ normCK rmorph_nat mulrA -subr_ge0 addrK cfnorm_ge0. - rewrite (span_orthogonal oX1Y) ?memv_span1 ?rpredZ // rpredN big_seq. - by apply/rpred_sum => eta Yeta; rewrite rpredZ ?memv_span ?map_f. - rewrite cfnormN cfnorm_sum_orthonormal // (big_rem eta1) //= eqxx. - congr (_ + _ < _); first by rewrite Cint_normK 1?rpredB ?rpred1. - transitivity (\sum_(eta <- rem eta1 Y) x ^+ 2). - rewrite rem_filter // !big_filter; apply/eq_bigr => eta /negPf->. - by rewrite subr0 Cint_normK. - rewrite big_const_seq count_predT // -Monoid.iteropE -[LHS]mulr_natl. - by rewrite /m (perm_eq_size (perm_to_rem Yeta1)) /= mulrSr addrK. - have [x_eq0 | [x_eq1 szY2]] := m_ub2_lt2 x Zx ub_xm. - left; rewrite /Y1 x_eq0 (big_rem eta1) //= eqxx sub0r scaleN1r. - rewrite big_seq big1 ?addr0 ?opprK => // eta. - by rewrite mem_rem_uniq // => /andP[/negPf-> _]; rewrite subrr scale0r. - have eta1'2: eta1^*%CF != eta1 by apply: seqInd_conjC_neq Yeta1. - have defY: perm_eq Y (eta1 :: eta1^*%CF). - have uY2: uniq (eta1 :: eta1^*%CF) by rewrite /= inE eq_sym eta1'2. - rewrite perm_eq_sym uniq_perm_eq //. - have sY2Y: {subset (eta1 :: eta1^*%CF) <= Y}. - by apply/allP; rewrite /= cfAut_seqInd ?Yeta1. - by have [|//]:= leq_size_perm uY2 sY2Y; rewrite szY2. - right; split=> //; congr (- _); rewrite (eq_big_perm _ defY) /= x_eq1. - rewrite big_cons big_seq1 eqxx (negPf eta1'2) subrr scale0r add0r subr0. - by rewrite scale1r. - have normY1: '[Y1] = 1. - have [-> | [_ ->]] := defY1; first by rewrite oYYt ?eqxx ?map_f. - by rewrite cfnormN oYYt ?eqxx ?map_f ?ccY. - have YtauY1: Y1 \in 'Z[map tau1 Y]. - have [-> | [_ ->]] := defY1; first by rewrite mem_zchar ?map_f. - by rewrite rpredN mem_zchar ?map_f ?ccY. - have spanYtau1 := zchar_span YtauY1. - have norm_eta1: '[eta1] = 1 by rewrite oYY ?eqxx. - have /all_sig2[a Za Dxa] xi: {a | a \in Cnat - & xi \in X -> xi 1%g = a * #|W1|%:R - /\ (exists2 X1 : 'CF(G), orthogonal X1 (map tau1 Y) - & tau (xi - a *: eta1) = X1 - a *: Y1)}. - - case Xxi: (xi \in X); last by exists 0; rewrite ?rpred0. - have /sig2_eqW[k /setDP[_ kerZ'k] def_xi] := seqIndP Xxi. - rewrite inE in kerZ'k. - pose a := 'chi_k 1%g; have Na: a \in Cnat by apply: Cnat_irr1. - have Dxi1: xi 1%g = a * #|W1|%:R by rewrite mulrC oW1 def_xi cfInd1. - exists a => // _; split=> //. - have [i0 nzi0 Res_k]: exists2 i, i != 0 & 'Res[Z] 'chi_k = a *: 'chi_i. - have [chi lin_chi defRkZ] := cfcenter_Res 'chi_k. - have sZ_Zk: Z \subset 'Z('chi_k)%CF. - by rewrite (subset_trans sZZH) // -cap_cfcenter_irr bigcap_inf. - have{lin_chi} /irrP[i defRk]: 'Res chi \in irr Z. - by rewrite lin_char_irr ?cfRes_lin_char. - have{chi defRk defRkZ} defRk: 'Res[Z] 'chi_k = a *: 'chi_i. - by rewrite -defRk -linearZ -defRkZ /= cfResRes ?cfcenter_sub. - exists i => //; apply: contra kerZ'k => i_0; apply/constt0_Res_cfker=> //. - by rewrite inE defRk cfdotZl cfdot_irr i_0 mulr1 irr1_neq0. - set phi := 'chi_i0 in Res_k; pose a_ i := '['Ind[H] phi, 'chi_i]. - pose rp := irr_constt ('Ind[H] phi). - have defIphi: 'Ind phi = \sum_(i in rp) a_ i *: 'chi_i. - exact: cfun_sum_constt. - have a_k: a_ k = a. - by rewrite /a_ -cfdot_Res_r Res_k cfdotZr cfnorm_irr mulr1 conj_Cnat. - have rp_k: k \in rp by rewrite inE ['[_, _]]a_k irr1_neq0. - have resZr i: i \in rp -> 'Res[Z] 'chi_i = a_ i *: phi. - rewrite constt_Ind_Res -/phi => /Clifford_Res_sum_cfclass-> //. - have Na_i: a_ i \in Cnat by rewrite Cnat_cfdot_char ?cfInd_char ?irr_char. - rewrite -/phi cfdot_Res_l cfdotC conj_Cnat {Na_i}//; congr (_ *: _). - have <-: 'I_H['Res[Z] 'chi_k] = H. - apply/eqP; rewrite eqEsubset subsetIl. - by apply: subset_trans (sub_inertia_Res _ _); rewrite ?sub_Inertia. - by rewrite Res_k inertia_scale_nz ?irr1_neq0 // cfclass_inertia big_seq1. - have lin_phi: phi 1%g = 1. - apply: (mulfI (irr1_neq0 k)); have /resZr/cfunP/(_ 1%g) := rp_k. - by rewrite cfRes1 // cfunE mulr1 a_k. - have Da_ i: i \in rp -> 'chi_i 1%g = a_ i. - move/resZr/cfunP/(_ 1%g); rewrite cfRes1 // cfunE => ->. - by rewrite lin_phi mulr1. - pose chi i := 'Ind[L] 'chi[H]_i; pose alpha i := chi i - a_ i *: eta1. - have Aalpha i: i \in rp -> alpha i \in 'CF(L, A). - move=> r_i; rewrite cfun_onD1 !cfunE cfInd1 // (uniY _ Yeta1) -oW1. - rewrite Da_ // mulrC subrr eqxx. - by rewrite memvB ?cfInd_normal ?memvZ // (seqInd_on _ Yeta1). - have [sum_alpha sum_a2]: gamma i0 = \sum_(i in rp) a_ i *: alpha i - /\ \sum_(i in rp) a_ i ^+ 2 = #|H : Z|%:R. - + set lhs1 := LHS; set lhs2 := (lhs in _ /\ lhs = _). - set rhs1 := RHS; set rhs2 := (rhs in _ /\ _ = rhs). - have eq_diff: lhs1 - rhs1 = (lhs2 - rhs2) *: eta1. - rewrite scalerBl addrAC; congr (_ - _). - rewrite -(cfIndInd _ sHL sZH) defIphi linear_sum -sumrB scaler_suml. - apply: eq_bigr => i rp_i; rewrite linearZ scalerBr opprD addNKr. - by rewrite opprK scalerA. - have: (lhs1 - rhs1) 1%g == 0. - rewrite !cfunE -(cfIndInd _ sHL sZH) !cfInd1 // lin_phi mulr1. - rewrite -divgS // -(sdprod_card defL) mulKn // mulrC uniY // subrr. - rewrite sum_cfunE big1 ?subrr // => i rp_i. - by rewrite cfunE (cfun_on0 (Aalpha i rp_i)) ?mulr0 // !inE eqxx. - rewrite eq_diff cfunE mulf_eq0 subr_eq0 (negPf (seqInd1_neq0 _ Yeta1)) //. - rewrite orbF => /eqP-sum_a2; split=> //; apply/eqP; rewrite -subr_eq0. - by rewrite eq_diff sum_a2 subrr scale0r. - have Xchi i: i \in rp -> chi i \in X. - move=> rp_i; apply/seqIndP; exists i => //; rewrite !inE sub1G andbT. - apply: contra rp_i => kerZi; rewrite -cfdot_Res_r cfRes_sub_ker //. - by rewrite cfdotZr -irr0 cfdot_irr (negPf nzi0) mulr0. - have oRY i: i \in rp -> orthogonal (R (chi i)) (map tau1 Y). - move/Xchi=> Xchi_i; rewrite orthogonal_sym. - by rewrite (coherent_ortho_supp scohS) // ?sXS // (contraL (X'Y _)). - have Za_ i: a_ i \in Cint. - by rewrite Cint_cfdot_vchar_irr // cfInd_vchar ?irr_vchar. - have Zeta1: eta1 \in 'Z[irr L] := seqInd_vcharW Yeta1. - have Ztau_alpha i: tau (alpha i) \in 'Z[irr G]. - by rewrite !(cfInd_vchar, rpredB) ?irr_vchar ?rpredZ_Cint. - have /all_tag2[X1 R_X1 /all_tag2[b Rb /all_sig2[Z1 oZ1R]]] i: - {X1 : 'CF(G) & i \in rp -> X1 \in 'Z[R (chi i)] - & {b : algC & i \in rp -> b \is Creal - & {Z1 : 'CF(G) | i \in rp -> orthogonal Z1 (R (chi i)) - & tau (alpha i) = X1 - b *: Y1 + Z1 /\ '[Z1, Y1] = 0}}}. - + have [X1 dX1 [YZ1 [dXYZ _ oYZ1R]]] := - orthogonal_split (R (chi i)) (tau (alpha i)). - exists X1. - have [_ _ _ Rok _] := scohS => /Xchi/sXS/Rok[ZR oRR _]. - have [_ -> ->] := orthonormal_span oRR dX1. - rewrite big_seq rpred_sum // => aa Raa. - rewrite rpredZ_Cint ?mem_zchar // -(canLR (addrK _) dXYZ) cfdotBl. - by rewrite (orthoPl oYZ1R) // subr0 Cint_cfdot_vchar ?(ZR aa). - pose b := - '[YZ1, Y1]; exists b => [rp_i|]. - rewrite Creal_Cint // rpredN -(canLR (addKr _) dXYZ) cfdotDl. - rewrite (span_orthogonal (oRY i rp_i)) ?rpredN ?(zchar_span YtauY1) //. - rewrite add0r Cint_cfdot_vchar // (zchar_trans_on _ YtauY1) //. - by move=> _ /mapP[eta Yeta ->]; rewrite Ztau1 ?mem_zchar. - exists (YZ1 + b *: Y1) => [/oRY-oRiY|]; last first. - by rewrite addrCA subrK addrC cfdotDl cfdotZl normY1 mulr1 addrN. - apply/orthoPl=> aa Raa; rewrite cfdotDl (orthoPl oYZ1R) // add0r. - by rewrite cfdotC (span_orthogonal oRiY) ?conjC0 ?rpredZ // memv_span. - case/all_and2=> defXbZ oZY1; have spanR_X1 := zchar_span (R_X1 _ _). - have ub_alpha i: i \in rp -> - [/\ '[chi i] <= '[X1 i] - & '[a_ i *: eta1] <= '[b i *: Y1 - Z1 i] -> - [/\ '[X1 i] = '[chi i], '[b i *: Y1 - Z1 i] = '[a_ i *: eta1] - & exists2 E, subseq E (R (chi i)) & X1 i = \sum_(aa <- E) aa]]. - + move=> rp_i; apply: (subcoherent_norm scohS) (erefl _) _. - * rewrite sXS ?Xchi ?rpredZ_Cint /orthogonal //; split=> //=. - by rewrite !cfdotZr !(orthogonalP oXY) ?mulr0 ?eqxx ?ccX // Xchi. - * have [[/(_ _ _)/char_vchar-Z_S _ _] IZtau _ _ _] := scohS. - apply: sub_iso_to IZtau; [apply: zchar_trans_on | exact: zcharW]. - apply/allP; rewrite /= zchar_split (cfun_onS (setSD _ sHL)) ?Aalpha //. - rewrite rpredB ?rpredZ_Cint ?mem_zchar ?(sYS eta1) // ?sXS ?Xchi //=. - by rewrite sub_aut_zchar ?zchar_onG ?mem_zchar ?sXS ?ccX ?Xchi. - suffices oYZ_R: orthogonal (b i *: Y1 - Z1 i) (R (chi i)). - rewrite opprD opprK addrA -defXbZ cfdotC. - by rewrite (span_orthogonal oYZ_R) ?memv_span1 ?spanR_X1 ?conjC0. - apply/orthoPl=> aa Raa; rewrite cfdotBl (orthoPl (oZ1R i _)) // cfdotC. - by rewrite subr0 (span_orthogonal (oRY i _)) ?conjC0 ?rpredZ // memv_span. - have leba i: i \in rp -> b i <= a_ i. - move=> rp_i; have ai_gt0: a_ i > 0 by rewrite -Da_ ?irr1_gt0. - rewrite (ler_trans (real_ler_norm (Rb i _))) //. - rewrite -(@ler_pexpn2r _ 2) ?qualifE ?(ltrW ai_gt0) ?norm_ger0 //. - apply: ler_trans (_ : '[b i *: Y1 - Z1 i] <= _). - rewrite cfnormBd; last by rewrite cfdotZl cfdotC oZY1 ?conjC0 ?mulr0. - by rewrite cfnormZ normY1 mulr1 ler_addl cfnorm_ge0. - rewrite -(ler_add2l '[X1 i]) -cfnormBd; last first. - rewrite cfdotBr cfdotZr (span_orthogonal (oRY i _)) ?spanR_X1 //. - rewrite mulr0 sub0r cfdotC. - by rewrite (span_orthogonal (oZ1R i _)) ?raddf0 ?memv_span1 ?spanR_X1. - have Salpha: alpha i \in 'Z[S, L^#]. - rewrite zcharD1_seqInd // zchar_split Aalpha // andbT. - by rewrite rpredB ?rpredZ_Cint ?mem_zchar ?(sYS eta1) ?sXS ?Xchi. - rewrite opprD opprK addrA -defXbZ ?Itau //. - rewrite cfnormBd; last by rewrite cfdotZr (orthogonalP oXY) ?mulr0 ?Xchi. - rewrite cfnormZ Cint_normK ?(oYY eta1) // eqxx mulr1 ler_add2r. - by have lbX1i: '[chi i] <= '[X1 i] by have [] := ub_alpha i rp_i. - have{leba} eq_ab: {in rp, a_ =1 b}. - move=> i rp_i; apply/eqP; rewrite -subr_eq0; apply/eqP. - apply: (mulfI (irr1_neq0 i)); rewrite mulr0 Da_ // mulrBr. - move: i rp_i; apply: psumr_eq0P => [i rp_i | ]. - by rewrite subr_ge0 ler_pmul2l ?leba // -Da_ ?irr1_gt0. - have [X2 oX2Y /(congr1 (cfdotr Y1))] := tau_gamma i0 nzi0. - rewrite sumrB sum_a2 sum_alpha /tau linear_sum /= cfdot_suml cfdotBl. - rewrite (span_orthogonal oX2Y) ?memv_span1 ?(zchar_span YtauY1) // add0r. - rewrite cfdotZl normY1 mulr1 => /(canLR (@opprK _)) <-. - rewrite -opprD -big_split big1 ?oppr0 //= => i rp_i. - rewrite linearZ cfdotZl /= -/tau defXbZ addrC cfdotDl oZY1 addr0. - rewrite cfdotBl cfdotZl normY1 mulr1 mulrBr addrC subrK. - by rewrite (span_orthogonal (oRY i _)) ?spanR_X1 ?mulr0. - exists (X1 k). - apply/orthoPl=> psi /memv_span Ypsi. - by rewrite (span_orthogonal (oRY k _)) // (zchar_span (R_X1 k rp_k)). - apply/eqP; rewrite -/a def_xi -a_k defXbZ addrC -subr_eq0 eq_ab // addrK. - rewrite -cfnorm_eq0 -(inj_eq (addrI '[b k *: Y1])). - have [_ [|_]] := ub_alpha k rp_k. - rewrite cfnormBd; last by rewrite cfdotZl cfdotC oZY1 conjC0 mulr0. - by rewrite addrC !cfnormZ eq_ab // normY1 norm_eta1 ler_addr cfnorm_ge0. - rewrite cfnormBd; last by rewrite cfdotZl cfdotC oZY1 conjC0 mulr0. - by move=> -> _; rewrite addr0 !cfnormZ eq_ab // normY1 norm_eta1. - have scohXY: subcoherent (X ++ Y) tau R. - apply/(subset_subcoherent scohS). - split; first by rewrite cat_uniq uX uY andbT; apply/hasPn. - by move=> xi; rewrite mem_cat => /orP[/sXS | /sYS]. - by move=> xi; rewrite !mem_cat => /orP[/ccX-> | /ccY->]; rewrite ?orbT. - have XYeta1: eta1 \in X ++ Y by rewrite mem_cat Yeta1 orbT. - have Z_Y1: Y1 \in 'Z[irr G]. - by case: defY1 => [|[_]] ->; rewrite ?rpredN Ztau1 ?mem_zchar ?ccY. - apply: pivot_coherence scohXY XYeta1 Z_Y1 _ _; rewrite norm_eta1 //. - move=> xi /andP[eta1'xi]; rewrite /= mem_cat => /orP[Xxi | Yxi]. - have [Da1 [X1 oX1Y tauX1]] := Dxa _ Xxi. - exists (a xi); first by rewrite (uniY _ Yeta1). - rewrite -/tau {}tauX1 cfdotBl cfdotZl normY1 !mulr1. - by rewrite (span_orthogonal oX1Y) ?add0r ?memv_span1. - exists 1; first by rewrite rpred1 mul1r !uniY. - rewrite scale1r mulr1 -/tau -Dtau1 ?raddfB ?cfdotBl; last first. - by rewrite zcharD1E rpredB ?mem_zchar //= !cfunE !uniY ?subrr. - have [-> | [szY2 ->]] := defY1; rewrite ?cfdotNr !Itau1 ?mem_zchar ?ccY //. - by rewrite !oYY // eqxx (negPf eta1'xi) add0r. - pose Y2 := eta1 :: eta1^*%CF; suffices: xi \in Y2. - rewrite opprK !inE (negPf eta1'xi) /= => /eqP->. - by rewrite !oYY ?ccY // !mulrb eqxx ifN_eqC ?(hasPn nrS) ?sYS ?addr0. - have /leq_size_perm: {subset Y2 <= Y} by apply/allP; rewrite /= Yeta1 ccY. - by case=> [||->]; rewrite ?szY2 //= inE eq_sym (hasPn nrS) ?sYS. -pose S1 := [::] ++ X ++ Y; set S2 := [::] in S1; rewrite -[X ++ Y]/S1 in cohXY. -have ccsS1S: cfConjC_subset S1 S. - rewrite /S1 /=; split; first by rewrite cat_uniq uX uY andbT; apply/hasPn. - by apply/allP; rewrite all_cat !(introT allP). - by move=> xi; rewrite !mem_cat => /orP[/ccX|/ccY]->; rewrite ?orbT. -move: {2}_.+1 (leq_addr (size S1) (size S).+1) => n. -elim: n => // [|n IHn] in (S2) S1 ccsS1S cohXY * => lb_n. - by rewrite ltnNge ?uniq_leq_size // in lb_n; have [] := ccsS1S. -have sXYS1: {subset X ++ Y <= S1} by apply/mem_subseq/suffix_subseq. -without loss /allPn[psi /= Spsi notS1psi]: / ~~ all (mem S1) S. - by case: allP => [/subset_coherent-cohS _ | _ cohS]; apply: cohS. -apply: (IHn [:: psi, psi^* & S2]%CF) => [|{lb_n}|]; last by rewrite !addnS leqW. - by have [_ _ ccS] := uccS; apply: extend_cfConjC_subset. -have /seqIndC1P[i nzi Dpsi] := Spsi. -have ltZH': Z \proper H'. - rewrite properEneq (contraNneq _ notS1psi) // => eqZH'; apply: sXYS1. - rewrite mem_cat Dpsi !mem_seqInd ?normal1 //. - by rewrite !inE sub1G andbT subGcfker nzi eqZH' orNb. -have Seta1: eta1 \in S1 by rewrite !mem_cat Yeta1 !orbT. -apply: (extend_coherent scohS ccsS1S Seta1) => {Seta1}//; split=> //. - rewrite (uniY _ Yeta1) Dpsi cfInd1 // oW1 dvdC_mulr //. - by rewrite Cint_Cnat ?Cnat_irr1. -rewrite !big_cat /= addrCA sum_seqIndD_square ?normal1 ?sub1G // ltr_spaddr //. - have /irrY/irrP[j Deta1] := Yeta1; have [_ sS1S _] := ccsS1S. - rewrite (big_rem eta1 Yeta1) addrCA -big_cat big_seq ltr_spaddl //=. - by rewrite Deta1 cfnorm_irr divr1 exprn_gt0 ?irr1_gt0. - apply/sumr_ge0=> phi YS2phi; rewrite divr_ge0 ?cfnorm_ge0 ?exprn_ge0 //. - rewrite char1_ge0 ?(seqInd_char (sS1S _ _)) //. - by move: YS2phi; rewrite !mem_cat => /orP[-> | /mem_rem->]; rewrite ?orbT. -rewrite indexg1 -(Lagrange_index sHL sZH) -oW1 natrM mulrC -mulrA. -rewrite uniY ?ler_wpmul2l ?ler0n -?(@natrB _ _ 1) // -natrM. -suffices ubW1: (#|W1|.*2 ^ 2 <= #|H : Z| * (#|Z| - 1) ^ 2)%N. - have chi1_ge0: 0 <= 'chi_i 1%g by rewrite char1_ge0 ?irr_char. - rewrite Dpsi cfInd1 // -oW1 -(@ler_pexpn2r _ 2) ?rpredM ?rpred_nat //. - rewrite -natrX expnMn mulnAC natrM mulrA -natrM exprMn -natrX mul2n. - rewrite ler_pmul ?ler0n ?exprn_ge0 ?(ler_trans (irr1_bound i)) ?ler_nat //. - rewrite dvdn_leq ?indexgS ?(subset_trans sZZH) //=. - by rewrite -cap_cfcenter_irr bigcap_inf. -have nZW1 := subset_trans sW1L nZL. -have tiZW1: Z :&: W1 = 1%g by rewrite coprime_TIg ?(coprimeSg sZH). -have [in_caseA | in_caseB] := boolP caseA. - rewrite (leq_trans _ (leq_pmull _ _)) ?leq_exp2r // subn1 -ltnS prednK //. - suffices frobZW1: [Frobenius Z <*> W1 = Z ><| W1]. - by apply: ltn_odd_Frobenius_ker frobZW1 (oddSg _ oddL); apply/joing_subP. - have [|/c2_ptiL[_ _ prW1H _]] := boolP case_c1; first exact: Frobenius_subl. - apply/Frobenius_semiregularP; rewrite ?sdprodEY // => x W1x; apply/trivgP. - by rewrite /= -(setIidPl sZH) -setIA -(trivgP in_caseA) prW1H ?setSI. -rewrite (leq_trans _ (leq_pmulr _ _)) ?expn_gt0 ?orbF ?subn_gt0 ?cardG_gt1 //. -rewrite -(Lagrange_index sH'H sZH') leq_mul // ltnW //. - have tiH'W1: H' :&: W1 = 1%g by rewrite coprime_TIg ?(coprimeSg sH'H). - rewrite (card_isog (quotient_isog (subset_trans sW1L nH'L) tiH'W1)). - rewrite -card_quotient ?gFnorm // (ltn_odd_Frobenius_ker frobL1) //. - exact: quotient_odd. -suffices frobHW1Z: [Frobenius (H' / Z) <*> (W1 / Z) = (H' / Z) ><| (W1 / Z)]. - rewrite (card_isog (quotient_isog nZW1 tiZW1)). - rewrite -card_quotient ?(subset_trans sH'H) //. - apply: ltn_odd_Frobenius_ker frobHW1Z (oddSg _ (quotient_odd Z oddL)). - by rewrite join_subG !quotientS. -suffices: [Frobenius (L / Z) = (H / Z) ><| (W1 / Z)]. - apply: Frobenius_subl (quotientS Z sH'H) _. - by rewrite quotient_neq1 // (normalS sZH' sH'H). - by rewrite quotient_norms ?(subset_trans sW1L). -apply: (Frobenius_coprime_quotient defL nsZL) => //. -split=> [|x W1x]; first exact: sub_proper_trans sZH' ltH'H. -by rewrite /Z ifN //; have /caseB_P[/c2_ptiL[_ _ ->]] := in_caseB. -Qed. - -End Six. - - diff --git a/mathcomp/odd_order/PFsection7.v b/mathcomp/odd_order/PFsection7.v deleted file mode 100644 index 559ed7c..0000000 --- a/mathcomp/odd_order/PFsection7.v +++ /dev/null @@ -1,828 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div choice. -From mathcomp -Require Import fintype tuple finfun bigop prime ssralg poly finset center. -From mathcomp -Require Import fingroup morphism perm automorphism quotient action zmodp. -From mathcomp -Require Import gfunctor gproduct cyclic pgroup commutator nilpotent frobenius. -From mathcomp -Require Import matrix mxalgebra mxrepresentation BGsection3 vector. -From mathcomp -Require Import ssrnum algC classfun character inertia vcharacter. -From mathcomp -Require Import PFsection1 PFsection2 PFsection4 PFsection5 PFsection6. - -(******************************************************************************) -(* This file covers Peterfalvi, Section 7: *) -(* Non-existence of a Certain Type of Group of Odd Order *) -(* Defined here: *) -(* inDade ddA == the right inverse to the Dade isometry with respect to G, *) -(* L, A, given ddA : Dade_hypothesis G L A. *) -(* phi^\rho == locally-bindable Notation for invDade ddA phi. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope GRing.Theory Num.Theory. -Local Open Scope ring_scope. - -Reserved Notation "alpha ^\rho" (at level 2, format "alpha ^\rho"). - -Section Seven. - -Variables (gT : finGroupType) (G : {group gT}). -Implicit Types (L H P : {group gT}) (DH : gT -> {group gT}). - -(* Properties of the inverse to the Dade isometry (Peterfalvi (7.1) to (7.3). *) -Section InverseDade. - -Variables (A : {set gT}) (L : {group gT}). -Hypothesis ddA : Dade_hypothesis G L A. - -Local Notation "alpha ^\tau" := (Dade ddA alpha). -Local Notation Atau := (Dade_support ddA). -Local Notation H := (Dade_signalizer ddA). - -Let nsAL : A <| L. Proof. by have [] := ddA. Qed. -Let sAL : A \subset L. Proof. exact: normal_sub nsAL. Qed. -Let nAL : L \subset 'N(A). Proof. exact: normal_norm nsAL. Qed. -Let sLG : L \subset G. Proof. by have [] := ddA. Qed. - -(* This is the Definition embedded in Peterfalvi, Hypothesis (7.1). *) -Fact invDade_subproof (chi : 'CF(G)) : - is_class_fun <<L>> - [ffun a => #|H a|%:R^-1 * (\sum_(x in H a) chi (x * a)%g) *+ (a \in A)]. -Proof. -rewrite genGid; apply: intro_class_fun => [x y Lx Ly | x notLx]; last first. - by rewrite (contraNF (subsetP sAL x)). -rewrite memJ_norm ?(subsetP nAL) // !mulrb; case: ifP => // Ax. -rewrite (DadeJ ddA) // cardJg; congr (_ * _). -rewrite big_imset /= => [|z y0 _ _ /=]; last exact: conjg_inj. -by apply: eq_bigr => u Hu; rewrite -conjMg cfunJ // (subsetP sLG). -Qed. -Definition invDade alpha := Cfun 1 (invDade_subproof alpha). - -Local Notation "alpha ^\rho" := (invDade alpha). - -Fact invDade_is_linear : linear invDade. -Proof. -move=> mu alpha beta; apply/cfunP=> a; rewrite !cfunElock. -rewrite mulrnAr -mulrnDl mulrCA -mulrDr; congr (_ * _ *+ _). -by rewrite big_distrr -big_split; apply: eq_bigr => x _; rewrite !cfunE. -Qed. -Canonical invDade_linear := Linear invDade_is_linear. -Canonical invDade_additive := Additive invDade_is_linear. - -Lemma invDade_on chi : chi^\rho \in 'CF(L, A). -Proof. by apply/cfun_onP=> x notAx; rewrite cfunElock (negPf notAx). Qed. - -Lemma invDade_cfun1 : 1^\rho = '1_A. -Proof. -apply/cfunP=> x; rewrite cfuniE // cfunElock mulrb; case: ifP => //= Ax. -apply: canLR (mulKf (neq0CG _)) _; rewrite mulr1 -sumr_const. -apply: eq_bigr => u Hu; rewrite cfun1E (subsetP (subsetIl G 'C[x])) //. -have /sdprodP[_ <- _ _] := Dade_sdprod ddA Ax. -by rewrite mem_mulg // inE cent1id (subsetP sAL). -Qed. - -(* This is Peterfalvi (2.7), restated using invDade. *) -Lemma invDade_reciprocity chi alpha : - alpha \in 'CF(L, A) -> '[alpha^\tau, chi] = '[alpha, chi^\rho]. -Proof. -move=> Aalpha; apply: general_Dade_reciprocity => //= a Aa. -by rewrite cfunElock Aa. -Qed. - -(* This is Peterfalvi (7.2)(a). *) -Lemma DadeK alpha : alpha \in 'CF(L, A) -> (alpha^\tau)^\rho = alpha. -Proof. -move=> Aalpha; apply/cfunP=> a; rewrite cfunElock mulrb. -case: ifPn => [Aa | /cfun_on0-> //]; apply: canLR (mulKf (neq0CG _)) _. -rewrite mulr_natl -sumr_const; apply: eq_bigr => x Hx. -by rewrite (DadeE _ Aa) ?mem_class_support // mem_mulg ?set11. -Qed. - -(* This is Peterfalvi (7.2)(b); note that by (7.2)(a) chi is in the image of *) -(* tau iff chi = (chi^\rho)^\tau, and this condition is easier to write. *) -Lemma leC_norm_invDade chi : - '[chi^\rho] <= '[chi] ?= iff (chi == (chi^\rho)^\tau). -Proof. -have Achi_rho := invDade_on chi; rewrite -(Dade_isometry ddA) //. -set chi1 := _^\tau; rewrite -subr_eq0 -cfnorm_eq0; set mu := chi - chi1. -have owv: '[chi1, mu] = 0. - by rewrite invDade_reciprocity ?raddfB //= DadeK ?subrr. -rewrite -(subrK chi1 chi) -/mu addrC cfnormD owv conjC0 !addr0. -split; first by rewrite -subr_ge0 addrC addKr cfnorm_ge0. -by rewrite eq_sym addrC -subr_eq0 addrK. -Qed. - -(* This is Peterfalvi (7.3). *) -Lemma leC_cfnorm_invDade_support chi : - '[chi^\rho] <= #|G|%:R^-1 * (\sum_(g in Atau) `|chi g| ^+ 2) - ?= iff [forall a in A, forall u in H a, chi (u * a)%g == chi a]. -Proof. -have nsAtauG: Atau <| G := Dade_support_normal ddA. -pose chi1 := chi * '1_Atau; set RHS := _ * _. -have inA1 a x: a \in A -> x \in H a -> (x * a)%g \in Dade_support1 ddA a. - by move=> Aa Hx; rewrite mem_class_support ?mem_mulg ?set11. -have chi1E a x: a \in A -> x \in H a -> chi1 (x * a)%g = chi (x * a)%g. - move=> Aa Hx; rewrite cfunE cfuniE // mulr_natr mulrb. - by case: bigcupP => // [[]]; exists a; rewrite ?inA1. -have ->: chi^\rho = chi1^\rho. - apply/cfunP => a; rewrite !cfunElock !mulrb; case: ifP => // Aa. - by congr (_ * _); apply: eq_bigr => x /chi1E->. -have Achi1: chi1 \in 'CF(G, Atau). - by apply/cfun_onP=> x ?; rewrite cfunE (cfun_onP (cfuni_on _ _)) ?mulr0. -have{Achi1 RHS} <-: '[chi1] = RHS. - rewrite (cfnormE Achi1); congr (_ * _). - by apply: eq_bigr => x Atau_x; rewrite cfunE cfuniE // Atau_x mulr1. -congr (_ <= _ ?= iff _): (leC_norm_invDade chi1). -apply/eqP/forall_inP=> [chi1_id a Aa | chi_id]. - apply/forall_inP => x Ha_x; rewrite -{2}[a]mul1g -!chi1E // chi1_id mul1g. - by rewrite (DadeE _ Aa) ?inA1 ?Dade_id. -apply/cfunP => g; rewrite cfunE cfuniE // mulr_natr mulrb. -case: ifPn => [/bigcupP[a Aa] | /(cfun_onP (Dade_cfunS _ _))-> //]. -case/imset2P=> _ z /rcosetP[x Hx ->] Gz ->{g}; rewrite !cfunJ {z Gz}//. -have{chi_id} chi_id := eqP (forall_inP (chi_id a Aa) _ _). -rewrite chi_id // (DadeE _ Aa) ?inA1 {x Hx}// cfunElock mulrb Aa. -apply: canRL (mulKf (neq0CG _)) _; rewrite mulr_natl -sumr_const. -by apply: eq_bigr => x Hx; rewrite chi1E ?chi_id. -Qed. - -(* This is the norm expansion embedded in Peterfalvi (7.3). *) -Lemma cfnormE_invDade chi : - '[chi^\rho] = #|L|%:R^-1 * (\sum_(a in A) `|chi^\rho a| ^+ 2). -Proof. by apply: cfnormE; apply: invDade_on. Qed. - -End InverseDade. - -(* Hypothesis (7.4) and Lemma (7.5). *) -Section DadeCoverInequality. - -(* These declarations correspond to Peterfalvi, Hypothesis (7.4); as it is *) -(* only instantiated twice after this section we leave it unbundled. *) -Variables (I : finType) (L : I -> {group gT}) (A : I -> {set gT}). -Hypothesis ddA : forall i : I, Dade_hypothesis G (L i) (A i). - -Local Notation Atau i := (Dade_support (ddA i)). -Local Notation "alpha ^\rho" := (invDade (ddA _) alpha). -Hypothesis disjointA : forall i j, i != j -> [disjoint Atau i & Atau j]. - -(* This is Peterfalvi (7.5), generalised to all class functions of norm 1. *) -Lemma Dade_cover_inequality (chi : 'CF(G)) (G0 := G :\: \bigcup_i Atau i) : - '[chi] = 1 -> - #|G|%:R^-1 * (\sum_(g in G0) `|chi g| ^+ 2 - #|G0|%:R) - + \sum_i ('[chi^\rho]_(L i) - #|A i|%:R / #|L i|%:R) <= 0. -Proof. -move=> Nchi1; set vG := _^-1; rewrite sumrB /= addrCA mulrBr -addrA. -pose F (xi : 'CF(G)) (B : {set gT}) := vG * \sum_(g in B) `|xi g| ^+ 2. -have sumF xi: F xi G0 + \sum_i F xi (Atau i) = '[xi]. - rewrite (cfnormE (cfun_onG _)) -mulr_sumr -mulrDr; congr (_ * _). - rewrite -partition_disjoint_bigcup //=; set U_A := \bigcup_i _. - have sUG: U_A \subset G by apply/bigcupsP=> i _; apply: Dade_support_sub. - by rewrite -(setIidPr sUG) addrC -big_setID. -have ->: \sum_i #|A i|%:R / #|L i|%:R = \sum_i F 1 (Atau i). - apply: eq_bigr => i _; apply/eqP; rewrite /F. - have [[/andP[sAL nAL] _ _ _ _] sHG] := (ddA i, Dade_signalizer_sub (ddA i)). - rewrite -{1}[A i]setIid -cfdot_cfuni /normal ?sAL // -(invDade_cfun1 (ddA i)). - rewrite leC_cfnorm_invDade_support; apply/forall_inP=> a Aa. - by apply/forall_inP=> x Hx; rewrite !cfun1E groupMl // (subsetP (sHG a)). -have ->: vG * #|G0|%:R = F 1 G0. - congr (_ * _); rewrite -sumr_const; apply: eq_bigr => x /setDP[Gx _]. - by rewrite cfun1E Gx normr1 expr1n. -rewrite -opprD sumF cfnorm1 -Nchi1 -sumF opprD addNKr -oppr_ge0 opprB -sumrB. -by rewrite sumr_ge0 // => i _; rewrite subr_ge0 leC_cfnorm_invDade_support. -Qed. - -(* -set vG := _^-1; rewrite sumrB /= addrCA mulrBr -addrA. -pose F t (B : {set gT}) := vG * \sum_(g in B) `|'chi[G]_t g| ^+ 2. -have sumF t: F t G0 + \sum_i F t (Atau i) = 1. - rewrite -(cfnorm_irr t) (cfnormE (cfun_onG _)) -mulr_sumr -mulrDr. - congr (_ * _); rewrite -partition_disjoint_bigcup //=; set U_A := \bigcup_i _. - have sUG: U_A \subset G by apply/bigcupsP=> i _; apply: Dade_support_sub. - by rewrite -(setIidPr sUG) addrC -big_setID. -have ->: \sum_i #|A i|%:R / #|L i|%:R = \sum_i F 0 (Atau i). - apply: eq_bigr => i _; apply/eqP; rewrite /F irr0. - have [[/andP[sAL nAL] _ _ _ _] sHG] := (ddA i, Dade_signalizer_sub (ddA i)). - rewrite -{1}[A i]setIid -cfdot_cfuni /normal ?sAL // -(invDade_cfun1 (ddA i)). - rewrite leC_cfnorm_invDade_support; apply/forall_inP=> a Aa. - by apply/forall_inP=> x Hx; rewrite !cfun1E groupMl // (subsetP (sHG a)). -have ->: vG * #|G0|%:R = F 0 G0. - congr (_ * _); rewrite -sumr_const; apply: eq_bigr => x /setDP[Gx _]. - by rewrite irr0 cfun1E Gx normr1 expr1n. -rewrite -opprD sumF -(sumF r) opprD addNKr -oppr_ge0 opprB -sumrB. -by rewrite sumr_ge0 // => i _; rewrite subr_ge0 leC_cfnorm_invDade_support. -Qed. -*) - -End DadeCoverInequality. - -(* Hypothesis (7.6), and Lemmas (7.7) and (7.8) *) -Section Dade_seqIndC1. - -(* In this section, A = H^# with H <| L. *) -Variables L H : {group gT}. -Let A := H^#. -Hypothesis ddA : Dade_hypothesis G L A. - -Local Notation Atau := (Dade_support ddA). -Local Notation "alpha ^\tau" := (Dade ddA alpha). -Local Notation "alpha ^\rho" := (invDade ddA alpha). - -Let calT := seqIndT H L. -Local Notation calS := (seqIndD H L H 1). -Local Notation Ind1H := ('Ind[gval L, gval H] 1). -Let uniqS : uniq calS := seqInd_uniq _ _. - -Let h := #|H|%:R : algC. -Let e := #|L : H|%:R : algC. - -Let nsAL : A <| L. Proof. by have [] := ddA. Qed. -Let sLG : L \subset G. Proof. by have [] := ddA. Qed. -Let nsHL : H <| L. Proof. by rewrite -normalD1. Qed. -Let sHL := normal_sub nsHL. -Let nHL := normal_norm nsHL. - -Let nzh : h != 0 := neq0CG H. -Let nze : e != 0 := neq0CiG L H. -Let nzL : #|L|%:R != 0 := neq0CG L. - -Let eh : e * h = #|L|%:R. Proof. by rewrite -natrM mulnC Lagrange. Qed. - -Section InvDadeSeqInd. - -Variables (xi0 : 'CF(L)) (S : seq 'CF(L)) (chi : 'CF(G)). -Implicit Types xi mu : 'CF(L). - -Let d xi := xi 1%g / xi0 1%g. -Let psi xi := xi - d xi *: xi0. -Let c xi := '[(psi xi)^\tau, chi]. - -Let uc c xi mu := (c xi)^* * c mu / ('[xi] * '[mu]). -Let u c xi mu := uc c xi mu * ('[xi, mu] - xi 1%g * mu 1%g / (e * h)). - -(* This is Peterfalvi (7.7); it is stated using a bespoke concrete Prop so as *) -(* to encapsulate the coefficient definitions given above. *) -CoInductive is_invDade_seqInd_sum : Prop := - InvDadeSeqIndSum (c := c) (u := u c) of - (*a*) {in A, forall x, (chi^\rho) x = \sum_(xi <- S) (c xi)^* / '[xi] * xi x} - & (*b*) '[chi^\rho] = \sum_(xi <- S) \sum_(mu <- S) u xi mu. - -Lemma invDade_seqInd_sum : perm_eq calT (xi0 :: S) -> is_invDade_seqInd_sum. -Proof. -move=> defT; pose chi0 := \sum_(xi <- S) (c xi)^* / '[xi] *: xi. -have Txi0: xi0 \in calT by rewrite (perm_eq_mem defT) mem_head. -have sST : {subset S <= calT}. - by move=> xi Sxi; rewrite (perm_eq_mem defT) mem_behead. -have nz_xi01 : xi0 1%g != 0 by apply: seqInd1_neq0 Txi0. -have part_a: {in A, chi^\rho =1 chi0}. - pose phi := (chi^\rho - chi0) * '1_A. - have Aphi : phi \in 'CF(L, A) := mul_cfuni_on A _. - suffices: '[phi, chi^\rho - chi0] == 0; last clearbody phi. - rewrite -(eq_cfdotr Aphi (eq_mul_cfuni _ nsAL)) cfnorm_eq0 => /eqP phi0. - by move=> x Ax; rewrite -[chi0]add0r -phi0 cfunE eq_mul_cfuni ?cfunE ?subrK. - have{Aphi} [Hphi phi1]: phi \in 'CF(L, H) /\ phi 1%g = 0. - by move: Aphi; rewrite cfun_onD1 => /andP[-> /eqP]. - have{Hphi} def_phi: phi = e^-1 *: 'Ind ('Res[H] phi). - apply/cfunP=> y; have [Hy | notHy] := boolP (y \in H); last first. - by rewrite cfunE !(cfun_on0 _ notHy) ?mulr0 ?cfInd_normal. - rewrite cfunE cfIndE // mulrA -invfM eh. - apply: (canRL (mulKf nzL)); rewrite mulr_natl -sumr_const. - by apply: eq_bigr => z Lz; rewrite cfResE ?memJ_norm ?cfunJ ?(subsetP nHL). - have{def_phi} Tphi: phi \in <<calT>>%VS. - rewrite def_phi memvZ // ['Res _]cfun_sum_cfdot linear_sum. - apply: memv_suml => i _; rewrite linearZ memvZ ?memv_span //=. - by apply/seqIndP; exists i; rewrite ?inE. - have{Tphi} [z def_phi _] := free_span (seqInd_free nsHL _) Tphi. - have {phi def_phi phi1} ->: phi = \sum_(xi <- S) z xi *: psi xi. - rewrite def_phi (eq_big_perm _ defT) !big_cons /= 2!cfunE in phi1 *. - rewrite (canRL (mulfK nz_xi01) (canRL (addrK _) phi1)) add0r addrC mulNr. - rewrite sum_cfunE mulr_suml scaleNr scaler_suml -sumrB. - by apply: eq_bigr => xi _; rewrite cfunE -mulrA -scalerA -scalerBr. - rewrite cfdot_suml big1_seq //= => xi Sxi; have Txi := sST xi Sxi. - rewrite cfdotZl cfdotBr -invDade_reciprocity -/(c xi); last first. - rewrite cfun_onD1 !cfunE divfK // subrr eqxx andbT. - by rewrite memvB ?memvZ //= ((seqInd_on _) setT). - have [oSS /orthoPl o_xi0S]: pairwise_orthogonal S /\ orthogonal xi0 S. - have:= seqInd_orthogonal nsHL setT; rewrite (eq_pairwise_orthogonal defT). - by rewrite /= -cat1s pairwise_orthogonal_cat => /and3P[]. - rewrite cfdotBl cfdotC cfproj_sum_orthogonal {oSS}// cfdotZl cfdot_sumr. - rewrite big1_seq ?mulr0 => [|mu Smu]; last by rewrite cfdotZr o_xi0S ?mulr0. - by rewrite subr0 divfK ?(cfnorm_seqInd_neq0 _ Txi) // conjCK subrr mulr0. -split=> [x /part_a-> | ]. - by rewrite sum_cfunE; apply: eq_bigr => ?; rewrite cfunE. -rewrite (cfdotEl _ (invDade_on ddA _)) mulrC mulr_suml. -pose F xi mu x := uc c xi mu * (xi x * (mu x)^*) / #|L|%:R. -transitivity (\sum_(x in A) \sum_(xi <- S) \sum_(mu <- S) F xi mu x). - apply: eq_bigr => x Ax; rewrite part_a // sum_cfunE -mulrA mulr_suml. - apply: eq_bigr => xi _; rewrite mulrA -mulr_suml rmorph_sum; congr (_ * _). - rewrite mulr_sumr; apply: eq_bigr => mu _; rewrite !cfunE (cfdotC mu). - rewrite -{1}[mu x]conjCK -fmorph_div -rmorphM conjCK -3!mulrA 2!(mulrCA _^-1). - by rewrite (mulrA _^-1) -invfM 2!(mulrCA (xi x)) mulrA 2!(mulrA _^*). -rewrite exchange_big; apply: eq_bigr => xi _; rewrite exchange_big /=. -apply: eq_big_seq => mu Smu; have Tmu := sST mu Smu. -rewrite /u eh (cfdotEr _ (seqInd_on nsHL Tmu)) (mulrC _^-1) -mulrBl mulrA. -rewrite -mulr_suml -mulr_sumr (big_setD1 1%g (group1 H)) /=; congr (_ * _ * _). -by rewrite addrC conj_Cnat ?addKr // (Cnat_seqInd1 Tmu). -Qed. - -End InvDadeSeqInd. - -Notation "1" := (1 : 'CF(_)) : classfun_scope. - -(* This is Peterfalvi (7.8). *) -(* Our version is slightly stronger because we state the nontriviality of S *) -(* directly than through the coherence premise (see the discussion of (5.2)). *) -Lemma Dade_Ind1_sub_lin (nu : {additive 'CF(L) -> 'CF(G)}) zeta : - coherent_with calS L^# (Dade ddA) nu -> (1 < size calS)%N -> - zeta \in irr L -> zeta \in calS -> zeta 1%g = e -> - let beta := (Ind1H - zeta)^\tau in let calSnu := map nu calS in - let sumSnu := \sum_(xi <- calS) xi 1%g / e / '[xi] *: nu xi in - [/\ (*a1*) [/\ orthogonal calSnu 1%CF, '[beta, 1] = 1 & beta \in 'Z[irr G]], - exists2 Gamma : 'CF(G), - (*a2*) [/\ orthogonal calSnu Gamma, '[Gamma, 1] = 0 - & exists2 a, a \in Cint & beta = 1 - nu zeta + a *: sumSnu + Gamma] - & (*b*) e <= (h - 1) / 2%:R -> - '[(nu zeta)^\rho] >= 1 - e / h /\ '[Gamma] <= e - 1 - & (*c*) {in irr G, forall chi : 'CF(G), orthogonal calSnu chi -> - [/\ {in A, forall x, chi^\rho x = '[beta, chi]} - & '[chi^\rho] = #|A|%:R / #|L|%:R * '[beta, chi] ^+ 2]}]. -Proof. -move=> [[Inu Znu] nu_tau] nt_calS /irrWnorm Nzeta1 Szeta zeta1. -set mu := _ - _ => beta calSnu sumSnu; pose S1 := rem zeta calS. -have defS: perm_eq calS (zeta :: S1) := perm_to_rem Szeta. -have defZS: 'Z[calS, L^#] =i 'Z[calS, A] by apply: zcharD1_seqInd. -have S1P xi: xi \in S1 -> xi != zeta /\ xi \in calS. - by rewrite mem_rem_uniq // => /andP[]. -have defT: perm_eql calT [:: Ind1H, zeta & S1]. - apply/perm_eqlP; have Tind1: Ind1H \in calT := seqIndT_Ind1 H L. - by rewrite (perm_eqlP (perm_to_rem Tind1)) perm_cons -seqIndC1_rem. -have mu_vchar: mu \in 'Z[irr L, A] := cfInd1_sub_lin_vchar nsHL Szeta zeta1. -have beta_vchar: beta \in 'Z[irr G] by apply: Dade_vchar. -have [mu_on beta_on] := (zchar_on mu_vchar, zchar_on beta_vchar). -have{nt_calS} ntS1: (size S1 > 0)%N by rewrite size_rem // -subn1 subn_gt0. -case defS1: S1 ntS1 => // [phi S2] _. -have /S1P[neq_phi Sphi]: phi \in S1 by rewrite defS1 mem_head. -have nz_phi1: phi 1%g != 0 by rewrite (seqInd1_neq0 nsHL Sphi). -have NatS1e xi (Sxi : xi \in calS) := dvd_index_seqInd1 nsHL Sxi. -have oS1: {in calS, forall psi, '[psi, 1] = 0} by apply: seqInd_ortho_1. -have oS1H: {in calS, forall psi, '[psi, Ind1H] = 0} by apply: seqInd_ortho_Ind1. -have InuS: {in calS &, isometry nu} by apply: sub_in2 Inu; apply: seqInd_zcharW. -have ZnuS xi (Sxi : xi \in calS) := Znu xi (seqInd_zcharW Sxi). -have S_Se xi (Sxi : xi \in calS) := seqInd_sub_lin_vchar nsHL Szeta zeta1 Sxi. -have oSnu1: orthogonal calSnu 1%CF. - have dotSnu1 psi : psi \in calS -> '[nu psi, 1] = psi 1%g / e * '[nu zeta, 1]. - move=> Spsi; apply/eqP; rewrite -subr_eq0 -cfdotZl -cfdotBl. - rewrite -raddfZ_Cnat ?NatS1e // -raddfB; have Spi := S_Se _ Spsi. - rewrite nu_tau ?defZS // invDade_reciprocity ?(zchar_on Spi) //. - rewrite invDade_cfun1 (eq_cfdotr (zchar_on Spi) (eq_cfuni nsAL)). - by rewrite cfdotBl cfdotZl !oS1 // mulr0 subr0. - suffices oz1: '[nu zeta, 1] = 0. - by apply/orthoPr=> _ /mapP[psi Spsi ->]; rewrite dotSnu1 // oz1 mulr0. - have norm_nu_zeta : '[nu zeta] = 1 by rewrite InuS // irrWnorm. - have [et [t defz]] := vchar_norm1P (ZnuS _ Szeta) norm_nu_zeta. - rewrite defz cfdotZl -{1}irr0 cfdot_irr mulr_natr mulrb; case: eqP => // t0. - have /eqP/idPn[] := seqInd_ortho nsHL Sphi Szeta neq_phi. - rewrite -InuS // defz t0 cfdotZr irr0 dotSnu1 // mulrCA -irr0 -t0. - by rewrite -cfdotZr -defz norm_nu_zeta mulr1 mulf_neq0 ?invr_eq0. -have dot_beta_1: '[beta, 1] = 1. - rewrite invDade_reciprocity // invDade_cfun1 (eq_cfdotr _ (eq_cfuni nsAL)) //. - by rewrite cfdotBl -Frobenius_reciprocity cfRes_cfun1 ?cfnorm1 ?oS1 ?subr0. -have o_beta1: '[beta - 1, 1] = 0 by rewrite cfdotBl dot_beta_1 cfnorm1 subrr. -have [X SnuX [Gamma [def_beta1 _ oSnuG]]]:= orthogonal_split calSnu (beta - 1). -have oG1: '[Gamma, 1] = 0. - rewrite -(addKr X Gamma) -def_beta1 addrC cfdotBl o_beta1. - by rewrite (span_orthogonal oSnu1) ?subr0 // memv_span ?mem_head. -have oSS: pairwise_orthogonal calS by apply: seqInd_orthogonal. -have oSnuS: pairwise_orthogonal calSnu by apply: map_pairwise_orthogonal. -have [a_ def_a defX] := orthogonal_span oSnuS SnuX. -have{def_a} def_a: {in calS, forall xi, a_ (nu xi) = '[beta, nu xi] / '[xi]}. - move=> xi Sxi; rewrite (canRL (subrK 1) def_beta1) !cfdotDl def_a InuS //. - by rewrite (cfdotC 1) (orthoPl oSnuG) ?(orthoPr oSnu1) ?map_f ?conjC0 ?addr0. -pose a := '[beta, nu zeta] + 1; have Z1 := Cint1. -have{Z1} Za: a \in Cint by rewrite rpredD ?Cint_cfdot_vchar // ZnuS. -have {a_ def_a defX} defX: X = - nu zeta + a *: sumSnu. - rewrite linear_sum defX big_map !(eq_big_perm _ defS) !big_cons /= addrCA. - rewrite def_a // Nzeta1 !divr1 zeta1 divff // scalerDl !scale1r addrA. - rewrite addrK; congr (_ + _); apply: eq_big_seq => xi /S1P[neq_xi Sxi]. - rewrite def_a // scalerA mulrA mulrDl mul1r; congr (_ / _ *: _). - rewrite mulrC -(conj_Cnat (NatS1e _ Sxi)) -cfdotZr -raddfZ_Cnat ?NatS1e //. - rewrite addrC; apply: canRL (subrK _) _; rewrite -!raddfB /= -/e. - have Spi := S_Se xi Sxi; rewrite nu_tau ?defZS //. - rewrite Dade_isometry ?(zchar_on Spi) // cfdotC cfdotBl cfdotZl !cfdotBr. - by rewrite !oS1H ?(seqInd_ortho _ Sxi) // Nzeta1 subr0 !add0r mulrN1 opprK. -have Ind1H1: Ind1H 1%g = e by rewrite cfInd1 // cfun11 mulr1. -split=> // [ | chi /irrP[t def_chi] o_chiSnu]. - rewrite (canRL (subrK 1) def_beta1) defX addrC 2!addrA. - exists Gamma; first by rewrite orthogonal_sym; split; last exists a. - move=> lt_e_h2; pose v := h^-1; pose u := e^-1 * (1 - v); set w := 1 - e / h. - have hu: h * u = e^-1 * (h - 1) by rewrite mulrCA (mulrBr h) mulr1 divff. - have ->: '[(nu zeta)^\rho] = u * a ^+ 2 - v * a *+ 2 + w. - have defT1: perm_eq calT [:: phi, Ind1H, zeta & S2]. - by rewrite defT defS1 (perm_catCA [:: _; _] phi). - have [c ua _ ->] := invDade_seqInd_sum (nu zeta) defT1. - have def_c xi: xi \in calS -> c xi = '[xi, zeta]. - move=> S2xi; rewrite /c mulrC -{1}[xi]scale1r -(mulVf nz_phi1) -!scalerA. - rewrite -scalerBr linearZ cfdotZl /=; set pi := _ - _. - have Spi: pi \in 'Z[calS, A] by apply: sub_seqInd_zchar. - rewrite -nu_tau ?defZS // Inu ?(zcharW Spi) ?seqInd_zcharW //. - by rewrite cfdotBl !cfdotZl (seqInd_ortho _ Sphi) // mulr0 subr0 mulKf. - have c2: c zeta = 1 by rewrite def_c. - have c1: c Ind1H = a. - by rewrite /a -c2 -cfdotDl -linearD !addrA subrK zeta1 -Ind1H1. - have{def_c} c3 xi: xi \in S2 -> c xi = 0. - move=> S2xi; have /S1P[neq_xi Sxi]: xi \in S1 by rewrite defS1 mem_behead. - by rewrite def_c // (seqInd_ortho _ Sxi). - rewrite !big_cons; have kill0 := (mul0r, mulr0, big1, conjC0). - rewrite !big1_seq /ua; try by move=> psi /c3->; do 2?rewrite ?kill0 => *. - rewrite !addr0 c1 c2 Nzeta1 cfnorm_Ind_cfun1 // -/e Ind1H1 zeta1 conjC1. - rewrite cfdotC (seqInd_ortho_Ind1 _ _ Szeta) // !kill0 sub0r !mulrN !mulr1. - rewrite divr1 !mul1r !invfM mulrBr !mulrA !mulfK ?divfK // -/w. - rewrite aut_Cint // -[_ / h]mulrA -{1}[e^-1]mulr1 -2!mulrBr -/u -/v. - by rewrite mulrC mulrA addrA (mulrC v) -[_ - _]addrA -opprD. - have ->: '[Gamma] = e - 1 - h * (u * a ^+ 2 - v * a *+ 2). - have /(canLR (addrK 1)) <-: '[beta] = e + 1. - rewrite Dade_isometry // cfnormBd ?cfnorm_Ind_cfun1 ?Nzeta1 //. - by rewrite cfdotC (seqInd_ortho_Ind1 _ _ Szeta) ?conjC0. - rewrite -[beta](subrK 1) cfnormDd; last first. - by rewrite cfdotBl dot_beta_1 cfnorm1 subrr. - rewrite cfnorm1 addrK def_beta1 (addrC X) cfnormDd; last first. - by rewrite (span_orthogonal oSnuG) // memv_span ?mem_head. - do 2!apply: canRL (addrK _) _; rewrite -addrA; congr (_ + _). - rewrite defX (addrC (- nu _)) cfnormB cfnormZ Cint_normK // InuS //. - rewrite cfdotZl cfproj_sum_orthogonal // Nzeta1 zeta1 divff // divr1. - rewrite !mulr1 aut_Cint // mulrBr mulrDr mulVKf // addrAC. - rewrite mulrA mulrC hu -[e^-1](divfK nze) -expr2; congr (_ * _ - _ + 1). - rewrite -mulrA -sum_seqIndC1_square // mulr_sumr cfnorm_sum_orthogonal //. - apply: eq_big_seq => xi Sxi. - have [nz_xi Nxi1] := (cfnorm_seqInd_neq0 nsHL Sxi, Cnat_seqInd1 Sxi). - rewrite (normr_idP _) ?mulr_ge0 ?invr_ge0 ?ler0n ?cfnorm_ge0 ?Cnat_ge0 //. - by rewrite mulrCA !exprMn ['[xi]]lock !mulrA divfK // -lock. - apply/andP; rewrite -subr_ge0 addrK andbC -subr_ge0 addrC opprB subrK. - rewrite pmulr_rge0 ?gt0CG // andbb -mulr_natr (mulrAC v). - have v_ge0: 0 <= v by [rewrite invr_ge0 ler0n]; have L_gt0 := gt0CG L. - have Lu: #|L|%:R * u = h - 1 by rewrite -eh -mulrA hu mulVKf. - have h1ge0: 0 <= h - 1 by rewrite subr_ge0 ler1n cardG_gt0. - have{h1ge0} u_ge0: 0 <= u by rewrite -Lu pmulr_rge0 in h1ge0. - have [a_le0 | ] := boolP (a <= 0). - by rewrite -mulrN -sqrrN addr_ge0 ?(u_ge0, mulr_ge0) ?oppr_ge0 ?ler0n. - rewrite -real_ltrNge ?Creal_Cint // ltr_def => /andP[]. - move/(norm_Cint_ge1 Za)=> a_ge1 a_ge0; rewrite mulrA -mulrBl. - rewrite (normr_idP _) // -(@mulVf _ 2%:R) ?pnatr_eq0 // in a_ge1. - rewrite mulr_ge0 // subr_ge0 (ler_trans _ (ler_wpmul2l u_ge0 a_ge1)) // mulrA. - by rewrite ler_wpmul2r ?ler0n // -(ler_pmul2l L_gt0) mulrA Lu -eh mulfK. -have Zchi: chi \in 'Z[irr G] by rewrite def_chi irr_vchar. -have def_chi0: {in A, chi^\rho =1 (fun _ => '[beta, chi])}. - have defT1: perm_eq calT [:: zeta, Ind1H & S1]. - by rewrite defT (perm_catCA Ind1H zeta). - move=> x Ax; have [_ Hx] := setD1P Ax. - have [c _ -> // _] := invDade_seqInd_sum chi defT1. - rewrite big_cons big1_seq ?addr0 /c => [|xi /S1P[neq_xi /= Sxi]]; last first. - rewrite zeta1 -nu_tau ?defZS ?S_Se // raddfB cfdotBl raddfZ_Cnat ?NatS1e //. - by rewrite cfdotZl !(orthoPr o_chiSnu) ?map_f // mulr0 subr0 conjC0 !mul0r. - rewrite Ind1H1 zeta1 divff // scale1r -/beta aut_Cint ?Cint_cfdot_vchar //. - by rewrite cfnorm_Ind_cfun1 ?cfInd_cfun1 // cfunE cfuniE // Hx mulr1 divfK. -split=> //; rewrite -mulrA mulrCA cfnormE_invDade; congr (_ * _). -rewrite mulr_natl -sumr_const; apply: eq_bigr => _ /def_chi0->. -by rewrite Cint_normK ?Cint_cfdot_vchar. -Qed. - -End Dade_seqIndC1. - -(* The other results of the section are specific to groups of odd order. *) -Hypothesis oddG : odd #|G|. - -(* We explicitly factor out several intermediate results from the proof of *) -(* (7.9) that are reused throughout the proof (including in (7.10) below). *) - -Import ssrint. -Lemma cfdot_real_vchar_even phi psi : - phi \in 'Z[irr G] /\ cfReal phi -> psi \in 'Z[irr G] /\ cfReal psi -> - (2 %| '[phi, psi])%C = (2 %| '[phi, 1])%C || (2 %| '[psi, 1])%C. -Proof. -move=> [Zphi Rphi] [Zpsi Rpsi]; rewrite cfdot_vchar_r // (bigD1 (0 : 'I__)) //=. -rewrite addrC -irr0 (bigID [pred i | conjC_Iirr i < i]%N) /=. -set a1 := \sum_(i | _) _; set a2 := \sum_(i | _) _; suffices ->: a1 = a2. - rewrite -mulr2n -mulr_natr (rpredDl _ (dvdC_mull _ _)) //; last first. - by rewrite rpred_sum // => i; rewrite rpredM ?Cint_cfdot_vchar_irr. - have /CintP[m1 ->] := Cint_cfdot_vchar_irr 0 Zphi. - have /CintP[m2 ->] := Cint_cfdot_vchar_irr 0 Zpsi. - rewrite [m1]intEsign [m2]intEsign !rmorphMsign mulrACA -!mulrA !rpredMsign. - by rewrite -natrM !(dvdC_nat 2) Euclid_dvdM. -rewrite /a2 (reindex_inj (inv_inj (@conjC_IirrK _ _))) /=. -apply: eq_big => [t | t _]; last first. - by rewrite !conjC_IirrE !cfdot_real_conjC ?aut_Cint ?Cint_cfdot_vchar_irr. -rewrite (inv_eq (@conjC_IirrK _ _)) conjC_IirrK -leqNgt ltn_neqAle val_eqE. -rewrite -!(inj_eq irr_inj) !conjC_IirrE irr0 cfConjC_cfun1 odd_eq_conj_irr1 //. -by rewrite andbA andbb. -Qed. - -Section DisjointDadeOrtho. - -Variables (L1 L2 H1 H2 : {group gT}). -Let A1 := H1^#. -Let A2 := H2^#. - -Hypothesis ddA1 : Dade_hypothesis G L1 A1. -Hypothesis ddA2 : Dade_hypothesis G L2 A2. -Let Atau1 := Dade_support ddA1. -Let tau1 := Dade ddA1. -Let Atau2 := Dade_support ddA2. -Let tau2 := Dade ddA2. - -Hypothesis disjointA : [disjoint Atau1 & Atau2]. - -Lemma disjoint_Dade_ortho phi psi : '[tau1 phi, tau2 psi] = 0. -Proof. -rewrite (cfdot_complement (Dade_cfunS _ _)) ?(cfun_onS _ (Dade_cfunS _ _)) //. -by rewrite subsetD disjoint_sym Dade_support_sub. -Qed. - -Let odd_Dade_context L H : Dade_hypothesis G L H^# -> H <| L /\ odd #|L|. -Proof. by case=> nsAL sLG _ _ _; rewrite -normalD1 (oddSg sLG). Qed. - -(* This lemma encapsulates uses of lemma (4.1) in sections 7 and 14. *) -Lemma disjoint_coherent_ortho nu1 nu2 chi1 chi2 : - let S1 := seqIndD H1 L1 H1 1 in coherent_with S1 L1^# tau1 nu1 -> - let S2 := seqIndD H2 L2 H2 1 in coherent_with S2 L2^# tau2 nu2 -> - chi1 \in irr L1 -> chi1 \in S1 -> chi2 \in irr L2 -> chi2 \in S2 -> - '[nu1 chi1, nu2 chi2] = 0. -Proof. -move=> S1 cohS1 S2 cohS2 /irrP[i1 ->] Schi1 /irrP[i2 ->] Schi2. -have [[nsHL1 oddL1] [[Inu1 Znu1] nu1tau]] := (odd_Dade_context ddA1, cohS1). -have [[nsHL2 oddL2] [[Inu2 Znu2] nu2tau]] := (odd_Dade_context ddA2, cohS2). -pose nu_chiC L (nu : 'CF(L) -> 'CF(G)) i := map nu ('chi_i :: ('chi_i)^*)%CF. -have: orthonormal (nu_chiC L1 nu1 i1) && orthonormal (nu_chiC L2 nu2 i2). - rewrite /orthonormal /= !andbT !Inu1 ?Inu2 ?seqInd_zcharW ?cfAut_seqInd //=. - rewrite !cfnorm_conjC !cfnorm_irr (seqInd_conjC_ortho _ _ _ Schi1) ?eqxx //=. - by rewrite (seqInd_conjC_ortho _ _ _ Schi2). -move/orthonormal_vchar_diff_ortho=> -> //. - by split; apply/allP; rewrite /= !(Znu1, Znu2) ?seqInd_zcharW ?cfAut_seqInd. -rewrite -!raddfB !(nu1tau, nu2tau) ?zcharD1_seqInd ?seqInd_sub_aut_zchar //. -by rewrite !Dade1 disjoint_Dade_ortho !eqxx. -Qed. - -(* This is Peterfalvi (7.9). *) -(* We have inlined Hypothesis (7.4) because although it is readily available *) -(* for the proof of (7.10), it would be inconvenient to establish in (14.4). *) -(* Note that our Delta corresponds to Delta - 1 in the Peterfalvi proof. *) -Let beta L H ddA zeta := @Dade _ G L H^# ddA ('Ind[L, H] 1 - zeta). -Lemma Dade_sub_lin_nonorthogonal nu1 nu2 zeta1 zeta2 : - let S1 := seqIndD H1 L1 H1 1 in coherent_with S1 L1^# tau1 nu1 -> - let S2 := seqIndD H2 L2 H2 1 in coherent_with S2 L2^# tau2 nu2 -> - zeta1 \in irr L1 -> zeta1 \in S1 -> zeta1 1%g = #|L1 : H1|%:R -> - zeta2 \in irr L2 -> zeta2 \in S2 -> zeta2 1%g = #|L2 : H2|%:R -> - '[beta ddA1 zeta1, nu2 zeta2] != 0 \/ '[beta ddA2 zeta2, nu1 zeta1] != 0. -Proof. -move=> S1 cohS1 S2 cohS2 irr_zeta1 Szeta1 zeta1_1 irr_zeta2 Szeta2 zeta2_1. -apply/nandP; pose Delta ddA nu zeta := beta ddA zeta + nu zeta. -have Delta_context L H (A := H^#) ddA (tau := Dade ddA) nu zeta : - let S := seqIndD H L H 1 in coherent_with S L^# tau nu -> - zeta \in irr L -> zeta \in S -> zeta 1%g = #|L : H|%:R -> - let D := Delta L H ddA nu zeta in '[D, 1] = 1 /\ D \in 'Z[irr G] /\ cfReal D. -- move=> S cohS irr_zeta Szeta zeta_1 D. - have [[nsHL oddL] [[_ Znu] nu_tau]] := (odd_Dade_context ddA, cohS). - have ntS: (size S > 1)%N by apply: seqInd_nontrivial Szeta. - have [[nuS1_0 beta1_1 Zbeta] _ _] := - Dade_Ind1_sub_lin cohS ntS irr_zeta Szeta zeta_1. - rewrite cfdotDl {}beta1_1 {nuS1_0}(orthoPr nuS1_0) ?map_f // addr0. - rewrite rpredD ?{}Znu ?seqInd_zcharW {Zbeta}// /cfReal; do !split=> //. - rewrite rmorphD /= -subr_eq0 opprD addrAC addrA -addrA addr_eq0 opprD. - rewrite (cfConjC_Dade_coherent cohS) // opprK -Dade_conjC -!raddfB /=. - rewrite nu_tau ?zcharD1_seqInd ?seqInd_sub_aut_zchar //=. - by rewrite rmorphB /= conj_cfInd cfConjC_cfun1 opprB addrC addrA subrK. -have: ~~ (2 %| '[Delta L1 H1 ddA1 nu1 zeta1, Delta L2 H2 ddA2 nu2 zeta2])%C. - have /Delta_context/(_ irr_zeta1 Szeta1 zeta1_1)[Delta1_1 ZR_Delta1] := cohS1. - have /Delta_context/(_ irr_zeta2 Szeta2 zeta2_1)[Delta2_1 ZR_Delta2] := cohS2. - by rewrite cfdot_real_vchar_even // Delta1_1 Delta2_1 (dvdC_nat 2 1). -rewrite cfdotDl !cfdotDr disjoint_Dade_ortho // add0r addrC cfdotC. -apply: contra => /andP[/eqP-> /eqP->]; rewrite conjC0 add0r addr0. -by rewrite (disjoint_coherent_ortho cohS1 cohS2) ?dvdC0. -Qed. - -End DisjointDadeOrtho. - -(* A numerical fact used in Sections 7 and 14. *) -Lemma odd_Frobenius_index_ler (R : numFieldType) (K L : {group gT}) : - odd #|L| -> [Frobenius L with kernel K] -> - #|L : K|%:R <= (#|K|%:R - 1) / 2%:R :> R. -Proof. -move=> oddL /existsP[H frobL]; rewrite ler_pdivl_mulr ?ltr0n // ler_subr_addl. -have ->: #|L : K| = #|H| by have [/index_sdprod] := Frobenius_context frobL. -by rewrite -natrM -mulrS ler_nat muln2 (ltn_odd_Frobenius_ker frobL). -Qed. - -(* This final section factors the assumptions common to (7.10) and (7.11). *) -(* We add solvability of the Frobenius groups, so as not to rely on the *) -(* theorem of Thompson asserting the nilpotence of Frobenius kernels. *) - -Section CoherentFrobeniusPartition. - -Variables (k : nat) (L H E : 'I_k -> {group gT}). - -Local Notation A i := (gval (H i))^#. -Let h_ i : algC := #|H i|%:R. -Let e_ i : algC := #|L i : H i|%:R. -Let G0 := G :\: \bigcup_(i < k) class_support (H i)^# G. - -Hypothesis k_ge2: (k >= 2)%N. - -(*a*) Hypothesis frobeniusL_G : - forall i, [/\ L i \subset G, solvable (L i) & [Frobenius L i = H i ><| E i]]. - -(*b*) Hypothesis normedTI_A : forall i, normedTI (A i) G (L i). - -(*c*) Hypothesis card_coprime : forall i j, i != j -> coprime #|H i| #|H j|. - -(* A numerical fact that is used in both (7.10) and (7.11) *) -Let e_bounds i : 1 < e_ i /\ e_ i <= (h_ i - 1) / 2%:R. -Proof. -have [/oddSg/(_ oddG)oddL _ frobL] := frobeniusL_G i. -rewrite ltr1n odd_Frobenius_index_ler ?(FrobeniusWker frobL) //. -by have [/index_sdprod <-] := Frobenius_context frobL; rewrite cardG_gt1. -Qed. - -(* This is Peterfalvi (7.10). *) -Lemma coherent_Frobenius_bound : exists i, let e := e_ i in let h := h_ i in - (e - 1) * ((h - 2%:R * e - 1) / (e * h) + 2%:R / (h * (h + 2%:R))) - <= (#|G0|%:R - 1) / #|G|%:R. -Proof. -have [sLG solL frobL] := all_and3 frobeniusL_G. -have oddL i := oddSg (sLG i) oddG. -have /all_and2[nsHL ntH] i: H i <| L i /\ H i :!=: 1%g. - by case/Frobenius_context: (frobL i) => /sdprod_context[]. -have sHL i: H i \subset L i by case/andP: (nsHL i). -pose DH i := @Dade_signalizer gT G (L i) (A i). -have /fin_all_exists[ddA DH1] i: exists dd, {in A i, forall a, DH i dd a = 1%G}. - have /Dade_normedTI_P[|ddAi _] := normedTI_A i; last by exists ddAi. - by apply: normedTI_Dade => //; rewrite setSD // (subset_trans (sHL i)). -pose tau i := Dade (ddA i); pose rho i := invDade (ddA i). -pose Atau i := Dade_support (ddA i). -have defAtau i: Atau i = class_support (A i) G. - rewrite class_supportEl; apply: eq_bigr => x Ax. - by rewrite /Dade_support1 -/(DH i) DH1 // mul1g class_support_set1l. -have disjoint_Atau i j : i != j -> [disjoint Atau i & Atau j]. - move=> neq_ij; rewrite !defAtau !class_supportEr -setI_eq0 big_distrlr /=. - rewrite pair_big big1 // => [[x y] _] /=; apply/eqP. - by rewrite !conjD1g -setDIl setD_eq0 coprime_TIg // !cardJg card_coprime. -have{defAtau} defG0: G0 = G :\: \bigcup_i Atau i. - by congr (_ :\: _); apply: eq_bigr => i; rewrite defAtau. -pose S i := seqIndD (H i) (L i) (H i) 1. -have irrS i: {subset S i <= irr (L i)}. - move=> _ /seqIndC1P[t nz_t ->]; rewrite irr_induced_Frobenius_ker //. - exact: FrobeniusWker (frobL i). -have /fin_all_exists[r lin_r] i: exists r, 'chi_r \in S i /\ 'chi_r 1%g = e_ i. - have lt1Hi: [1] \proper H i by rewrite proper1G. - have solHi := solvableS (sHL i) (solL i). - have [xi Sxi lin_xi] := exists_linInd (nsHL i) solHi lt1Hi (normal1 _). - by have /irrP[r def_xi] := irrS i xi Sxi; exists r; rewrite -def_xi. -have{lin_r} [Sr r1] := all_and2 lin_r. -have ntS i: (size (S i) > 1)%N by apply: seqInd_nontrivial (Sr i). -have /fin_all_exists[nu cohS] i: coherent (S i) (L i)^# 'Ind[G, L i]. - have [[[frobLi tiAiL] sLiG] oddLi] := (frobL i, normedTI_A i, sLG i, oddL i). - have [defLi ntHi ntEi _ _] := Frobenius_context frobLi. - have{ntEi} nilHi: nilpotent (H i) by apply: (Frobenius_sol_kernel_nil frobLi). - exact: Sibley_coherence (or_introl _ frobLi). -have{cohS} [/all_and2[Inu Znu] nu_Ind] := all_and2 cohS. -have{DH DH1 nu_Ind} cohS i: coherent_with (S i) (L i)^# (tau i) (nu i). - split=> // phi Sphi; rewrite /tau nu_Ind ?Dade_Ind //. - by rewrite (@zchar_on _ _ (S i)) -?zcharD1_seqInd. -have n1S i xi: xi \in S i -> '[xi] = 1. - by case/irrS/irrP=> t ->; rewrite cfnorm_irr. -have n1Snu i xi: xi \in S i -> '[nu i xi] = 1. - by move=> Sxi; rewrite Inu ?n1S ?seqInd_zcharW. -have o_nu i j: i != j -> {in S i & S j, forall xi xj, '[nu i xi, nu j xj] = 0}. - move/disjoint_Atau/disjoint_coherent_ortho=> o_ij xi xj Sxi Sxj. - by rewrite o_ij ?irrS //; apply: cohS. -have /all_and2[nze nzh] i: e_ i != 0 /\ h_ i != 0 by rewrite neq0CiG neq0CG. -have h_gt1 i: 1 < h_ i by rewrite ltr1n cardG_gt1. -have eh i: e_ i * h_ i = #|L i|%:R by rewrite -natrM mulnC Lagrange. -have def_h1 i: h_ i - 1 = #|A i|%:R. - by rewrite /h_ (cardsD1 1%g) group1 addnC natrD addrK. -have [i1 min_i1]: {i1 | forall i, i != i1 -> h_ i1 + 2%:R <= h_ i}. - exists [arg min_(i < Ordinal k_ge2) #|H i|]; case: arg_minP => // i1 _ min_i1. - have oddH i: #|H i| = #|H i|./2.*2.+1. - by rewrite -{1}[#|H i|]odd_double_half (oddSg (sHL i)). - move=> i neq_i; rewrite -natrD ler_nat (oddH i) oddH addn2 -doubleS ltnS. - rewrite leq_double ltn_neqAle andbC half_leq ?min_i1 //=. - apply: contraTneq (card_coprime neq_i) => eqHii1. - by rewrite oddH -eqHii1 -oddH /coprime gcdnn -trivg_card1. -exists i1 => e h; set lhs := (e - 1) * _. -have nzh2: h + 2%:R != 0 by rewrite -natrD addnC pnatr_eq0. -have{lhs} ->: lhs = 1 - e / h - (h - 1) / (e * h) - (e - 1) / (h + 2%:R). - rewrite {}/lhs -{2}(addrK h 2%:R) !invfM (mulrBl _ _ h) mulVKf ?nzh //. - rewrite addrCA (addrC _ h) mulrCA mulrA addrA mulrBr; congr (_ - _). - rewrite mulfK // mulrDr addrAC addrC mulrC mulrBl -mulrA mulVKf ?nze //. - rewrite mulrC mulrBr mulrBl mul1r addrAC addrC addrA; congr (_ - _). - rewrite mulrCA mulVKf ?nze // addrCA mulrCA mulr_natl opprD addNKr. - by rewrite !mulrBl opprB addrA subrK divff ?nzh. -pose beta i := tau i ('Ind[L i, H i] 1 - 'chi_(r i)). -have betaP i := Dade_Ind1_sub_lin (cohS i) (ntS i) (mem_irr _) (Sr i) (r1 i). -pose chi i := nu i 'chi_(r i); pose c i j := '[beta i, chi j]. -have:= betaP i1; rewrite -/(S _) -/(tau _) -/(beta _) -/(chi _) -/(e_ _) -/e. -move=> [[oSnu1 o_beta1 Zbeta1] [Gamma [oSnuGamma oGamma1] [a Za def_beta1]]]. -have [_ lt_e_h2] := e_bounds i1; rewrite -/(rho _) -/(h_ _) -/h. -case/(_ lt_e_h2)=> min_rho1 maxGamma _ {lt_e_h2}. -pose calB := [set i | (i != i1) && (c i i1 == 0)]. -pose sumB := \sum_(i in calB) (h_ i - 1) / (e_ i * h_ i). -suffices{min_rho1} sumB_max: sumB <= (e - 1) / (h + 2%:R). - rewrite -subr_ge0 opprB addrCA -opprB subr_ge0; apply: ler_trans sumB_max. - rewrite -subr_ge0 opprB addrCA -(opprB _ sumB) subr_ge0. - have Zchi1: chi i1 \in 'Z[irr G] by rewrite Znu ?seqInd_zcharW ?Sr. - have [eps [t def_chi1]] := vchar_norm1P Zchi1 (n1Snu i1 'chi_(r i1) (Sr i1)). - pose sumG0 := \sum_(g in G0) `|'chi_t g| ^+ 2. - apply: (@ler_trans _ ((#|G0|%:R - sumG0) / #|G|%:R)); last first. - rewrite ler_pmul2r ?invr_gt0 ?gt0CG // ler_add2l ler_opp2. - rewrite [sumG0](bigD1 1%g) /=; last first. - rewrite !inE group1 andbT; apply/bigcupP=> [[i _]]. - by rewrite class_supportEr => /bigcupP[x _]; rewrite conjD1g !inE eqxx. - rewrite -[1]addr0 ler_add ?sumr_ge0 // => [|x _]; last first. - by rewrite -normrX normr_ge0. - have Zchit1: 'chi_t 1%g \in Cint by rewrite CintE Cnat_irr1. - by rewrite expr_ge1 ?normr_ge0 // norm_Cint_ge1 ?irr1_neq0. - pose ea i : algC := #|(H i)^#|%:R / #|L i|%:R. - apply: (@ler_trans _ (\sum_i ('[rho i 'chi_t] - ea i))); last first. - rewrite -subr_ge0 -opprB oppr_ge0 -mulNr opprB addrC mulrC. - by rewrite /sumG0 defG0 Dade_cover_inequality ?cfnorm_irr. - rewrite (bigID (mem calB)) /= addrC ler_add //. - rewrite -subr_ge0 opprK -big_split sumr_ge0 //= => i _. - by rewrite def_h1 eh subrK cfnorm_ge0. - rewrite (bigD1 i1) ?inE ?eqxx ?andbF //= -ler_subl_addl (@ler_trans _ 0) //. - rewrite opprB /ea -def_h1 -eh -/h -/e addrA subrK subr_le0. - by rewrite -(cfnorm_sign eps) -linearZ -def_chi1. - rewrite sumr_ge0 // => i; rewrite inE /c andbC => /andP[neq_i]. - rewrite neq_i subr_ge0 def_chi1 cfdotZr mulf_eq0 => /norP[_ not_o_beta_chi]. - have [[_ _ Zbeta_i] _ /(_ _ (mem_irr t))[|_ ->]] := betaP i. - apply/orthoPr=> _ /mapP[xi Sxi ->]; rewrite -['chi_t](signrZK eps). - by rewrite -def_chi1 cfdotZr o_nu ?mulr0 ?Sr. - rewrite -[ea i]mulr1 /ea ler_wpmul2l ?mulr_ge0 ?invr_ge0 ?ler0n //. - by rewrite -/(tau i) -/(beta i) sqr_Cint_ge1 ?Cint_cfdot_vchar_irr. -rewrite -(mulfK nzh2 sumB) -{2 3}natrD ler_wpmul2r ?invr_ge0 ?ler0n //. -apply: ler_trans maxGamma; rewrite mulr_suml. -pose phi i : 'CF(G) := \sum_(xi <- S i) xi 1%g / e_ i / '[xi] *: nu i xi. -have o_phi_nu i j xi: i != j -> xi \in S j -> '[phi i, nu j xi] = 0. - move/o_nu=> o_ij Sxi; rewrite cfdot_suml big1_seq //= => pi Spi. - by rewrite cfdotZl o_ij ?mulr0. -have o_phi i j: i != j -> '[phi i, phi j] = 0. - move/o_phi_nu=> o_ij; rewrite cfdot_sumr big1_seq // => xi Sxi. - by rewrite cfdotZr o_ij ?mulr0. -pose X : 'CF(G) := \sum_(i in calB) c i1 i *: phi i; pose Gamma1 := Gamma - X. -have ->: Gamma = Gamma1 + X by rewrite subrK. -have{betaP def_beta1} /cfnormDd->: '[Gamma1, X] = 0. - rewrite cfdot_sumr big1 // => i Bi; have [neq_i _] := setIdP Bi. - rewrite cfdotZr cfdot_sumr big1_seq ?mulr0 //= => xi Sxi. - apply/eqP; rewrite cfdotZr cfdotBl mulf_eq0; apply/pred2P; right. - rewrite cfdot_suml (bigD1 i) ?big1 //= => [|j /andP[_ neq_j]]; last first. - by rewrite cfdotZl o_phi_nu ?mulr0. - rewrite cfdotZl cfproj_sum_orthogonal ?seqInd_orthogonal //; last exact: Inu. - rewrite n1S // divr1 mulr1 addr0 mulrC -(canLR (addKr _) def_beta1). - rewrite !(cfdotDl, cfdotNl) cfdotZl o_nu ?o_phi_nu ?Sr 1?eq_sym // mulr0. - have[[/orthoPr oSnui_1 _ _] _ _] := betaP i; rewrite -/(S i) in oSnui_1. - rewrite cfdotC oSnui_1 ?map_f // conjC0 !(add0r, oppr0). - have Nxie: xi 1%g / e_ i \in Cnat by apply: dvd_index_seqInd1 _ Sxi. - rewrite -(conj_Cnat Nxie) // -cfdotZr -raddfZ_Cnat // -!raddfB /=. - have [_ Dnu] := cohS i. - rewrite Dnu ?zcharD1_seqInd ?seqInd_sub_lin_vchar ?Sr ?r1 //. - by rewrite disjoint_Dade_ortho ?disjoint_Atau 1?eq_sym. -rewrite -subr_ge0 cfdot_sumr -addrA -sumrB addr_ge0 ?cfnorm_ge0 //. -rewrite sumr_ge0 // => i Bi; have [neq_i ci1_0] := setIdP Bi. -have n_phi: '[phi i] = (h_ i - 1) / e_ i. - rewrite cfnorm_sum_orthogonal ?seqInd_orthogonal //; last exact: Inu. - rewrite -[_ - 1](mulKf (nze i)) -sum_seqIndC1_square // -/(S i) mulrAC. - rewrite -invfM mulrC mulr_suml; apply: eq_big_seq => _ /irrS/irrP[t ->]. - rewrite cfnorm_irr !divr1 mulr1 -expr2 -exprVn -exprMn. - by rewrite (normr_idP _) // mulr_ge0 ?invr_ge0 ?ler0n // ltrW ?irr1_gt0. -rewrite subr_ge0 cfdotZr cfdot_suml (bigD1 i) //=. -rewrite big1 ?addr0 => [|j /andP[_ ne_j]]; last by rewrite cfdotZl o_phi ?mulr0. -rewrite cfdotZl invfM 2!mulrA -n_phi -[_ * _]mulrA mulrC. -rewrite ler_wpmul2r ?cfnorm_ge0 // (@ler_trans _ 1) //. - by rewrite -{2}(mulVf (nzh i)) ler_wpmul2l ?invr_ge0 ?ler0n ?min_i1. -rewrite mulrC -normCK expr_ge1 ?normr_ge0 // norm_Cint_ge1 //. - rewrite Cint_cfdot_vchar ?Znu ?seqInd_zcharW ?Sr //. -suffices []: c i i1 != 0 \/ c i1 i != 0 by rewrite ?ci1_0. -apply/Dade_sub_lin_nonorthogonal; rewrite ?mem_irr ?Sr ?r1 //; try exact: cohS. -exact: disjoint_Atau. -Qed. - -(* This is Peterfalvi (7.11). *) -Theorem no_coherent_Frobenius_partition : G0 != 1%G. -Proof. -have [i] := coherent_Frobenius_bound; apply: contraTneq => ->. -have [] := e_bounds i; set e := e_ i; set h := h_ i => e_gt1 le_e_h2. -rewrite cards1 subrr mul0r ltr_geF // pmulr_rgt0 ?subr_gt0 // ltr_paddl //. - rewrite ?(mulr_ge0, invr_ge0) ?ler0n // addrAC subr_ge0. - by rewrite -[_ - 1](@divfK _ 2%:R) ?pnatr_eq0 // mulrC ler_wpmul2r ?ler0n. -by rewrite -natrD addnC ?(pmulr_rgt0, invr_gt0) ?ltr0n. -Qed. - -End CoherentFrobeniusPartition. - -End Seven. - diff --git a/mathcomp/odd_order/PFsection8.v b/mathcomp/odd_order/PFsection8.v deleted file mode 100644 index 2770369..0000000 --- a/mathcomp/odd_order/PFsection8.v +++ /dev/null @@ -1,1141 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div choice. -From mathcomp -Require Import fintype tuple finfun bigop prime ssralg poly finset center. -From mathcomp -Require Import fingroup morphism perm automorphism quotient action finalg zmodp. -From mathcomp -Require Import gfunctor gproduct cyclic commutator nilpotent pgroup. -From mathcomp -Require Import sylow hall abelian maximal frobenius. -From mathcomp -Require Import matrix mxalgebra mxrepresentation vector. -From mathcomp -Require Import BGsection1 BGsection3 BGsection7 BGsection10. -From mathcomp -Require Import BGsection14 BGsection15 BGsection16. -From mathcomp -Require ssrnum. -From mathcomp -Require Import algC classfun character inertia vcharacter. -From mathcomp -Require Import PFsection1 PFsection2 PFsection3 PFsection4 PFsection5. - -(******************************************************************************) -(* This file covers Peterfalvi, Section 8: Structure of a Minimal Simple *) -(* Group of Odd Order. Actually, most Section 8 definitions can be found in *) -(* BGsection16, which holds the conclusions of the Local Analysis part of the *) -(* proof, as the B & G text has been adapted to fit the usage in Section 8. *) -(* Most of the definitions of Peterfalvi Section 8 are covered in BGsection7, *) -(* BGsection15 and BGsection16; we only give here: *) -(* FT_Pstructure S T defW <-> the groups W, W1, W2, S, and T satisfy the *) -(* conclusion of Theorem (8.8)(b), in particular, S and T *) -(* are of type P, S = S^(1) ><| W1, and T = T^`(1) ><| W2. *) -(* The assumption defW : W1 \x W2 = W is a parameter. *) -(* 'R[x] == the "signalizer" group of x \in 'A1(M) for the Dade *) -(* hypothesis of M (note: this is only extensionally equal *) -(* to the 'R[x] defined in BGsection14). *) -(* 'R_M == the signalizer functor for the Dade hypothesis of M. *) -(* Note that this only maps x to 'R[x] for x in 'A1(M). *) -(* The casual use of the R(x) in Peterfalvi is improper, *) -(* as its meaning depends on which maximal group is *) -(* considered. *) -(* 'A~(M, A) == the support of the image of 'CF(M, A) under the Dade *) -(* isometry of a maximal group M. *) -(* 'A1~(M) := 'A~(M, 'A1(M)). *) -(* 'A~(M) := 'A~(M, 'A(M)). *) -(* 'A0~(M) := 'A~(M, 'A0(M)). *) -(* FT_Dade maxM, FT_Dade0 maxM, FT_Dade1 maxM, FT_DadeF maxM *) -(* FT_Dade_hyp maxM, FT_Dade0_hyp maxM, FT_Dade1_hyp maxM, FT_DadeF_hyp maxM *) -(* == for maxM : M \in 'M, the Dade isometry of M, with *) -(* domain 'A(M), 'A0(M), 'A1(M) and M`_\F^#, respectively, *) -(* and the proofs of the corresponding Dade hypotheses. *) -(* Note that we use an additional restriction (to M`_\F^#) *) -(* to fit better with the conventions of PFsection7. *) -(* FTsupports M L <-> L supports M in the sense of (8.14) and (8.18). This *) -(* definition is not used outside this file. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope GRing.Theory. - -Local Open Scope ring_scope. - -(* Supercedes the notation in BGsection14. *) -Notation "''R' [ x ]" := 'C_((gval 'N[x])`_\F)[x] - (at level 8, format "''R' [ x ]") : group_scope. -Notation "''R' [ x ]" := 'C_('N[x]`_\F)[x]%G : Group_scope. - -Section Definitions. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). -Implicit Types L M X : {set gT}. - -(* These cover Peterfalvi, Definition (8.14). *) -Definition FTsignalizer M x := if 'C[x] \subset M then 1%G else 'R[x]%G. - -Definition FTsupports M L := - [exists x in 'A(M), ~~ ('C[x] \subset M) && ('C[x] \subset L)]. - -Definition FT_Dade_support M X := - \bigcup_(x in X) class_support (FTsignalizer M x :* x) G. - -End Definitions. - -Notation "''R_' M" := (FTsignalizer M) - (at level 8, M at level 2, format "''R_' M") : group_scope. - -Notation "''A~' ( M , A )" := (FT_Dade_support M A) - (at level 8, format "''A~' ( M , A )"). - -Notation "''A1~' ( M )" := 'A~(M, 'A1(M)) (at level 8, format "''A1~' ( M )"). -Notation "''A~' ( M )" := 'A~(M, 'A(M)) (at level 8, format "''A~' ( M )"). -Notation "''A0~' ( M )" := 'A~(M, 'A0(M)) (at level 8, format "''A0~' ( M )"). - -Section Eight. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). -Implicit Types (p q : nat) (x y z : gT) (A B : {set gT}). -Implicit Types H K L M N P Q R S T U V W : {group gT}. - -(* Peterfalvi, Definition (8.1) is covered by BGsection16.of_typeF. *) - -(* This is the remark following Definition (8.1). *) -Remark compl_of_typeF M U V (H := M`_\F) : - H ><| U = M -> of_typeF M V -> of_typeF M U. -Proof. -move=> defM_U [[]]; rewrite -/H => ntH ntV defM part_b part_c. -have oU: #|U| = #|V|. - apply/eqP; rewrite -(@eqn_pmul2l #|H|) ?cardG_gt0 //. - by rewrite (sdprod_card defM) (sdprod_card defM_U). -have [x Mx defU]: exists2 x, x \in M & U :=: V :^ x. - pose pi := \pi(V); have hallV: pi.-Hall(M) V. - by rewrite Hall_pi // -(sdprod_Hall defM) (pHall_Hall (Fcore_Hall M)). - apply: Hall_trans (hallV). - rewrite mFT_sol // (sub_proper_trans _ (mFT_norm_proper ntH _)) ?gFnorm //. - rewrite (proper_sub_trans _ (subsetT M)) // properEcard gFsub. - by rewrite -(sdprod_card defM) ltn_Pmulr ?cardG_gt0 ?cardG_gt1. - rewrite pHallE -(card_Hall hallV) oU eqxx andbT. - by case/sdprod_context: defM_U. -have nHx: x \in 'N(H) by apply: subsetP Mx; rewrite gFnorm. -split; first by rewrite {1}defU conjsg_eq1. - have [U1 [nsU1U abU1 prU1H]] := part_b. - rewrite defU; exists (U1 :^ x)%G; split; rewrite ?normalJ ?abelianJ //. - rewrite -/H -(normP nHx) -conjD1g => _ /imsetP[h Hh ->]. - by rewrite -conjg_set1 normJ -conjIg conjSg prU1H. -have [U0 [sU0V expU0 frobHU0]] := part_c. -have [defHU0 _ ntU0 _ _] := Frobenius_context frobHU0. -rewrite defU; exists (U0 :^ x)%G; split; rewrite ?conjSg ?exponentJ //. -by rewrite -/H -(normP nHx) -conjYg FrobeniusJ. -Qed. - -Lemma Frobenius_of_typeF M U (H := M`_\F) : - [Frobenius M = H ><| U] -> of_typeF M U. -Proof. -move=> frobM; have [defM ntH ntU _ _] := Frobenius_context frobM. -have [_ _ nHU tiHU] := sdprodP defM. -split=> //; last by exists U; split; rewrite // -sdprodEY ?defM. -exists 1%G; split; rewrite ?normal1 ?abelian1 //. -by move=> x /(Frobenius_reg_compl frobM)->. -Qed. - -(* This is Peterfalvi (8.2). *) -Lemma typeF_context M U (H := M`_\F) : - of_typeF M U -> - [/\ (*a*) forall U0, is_typeF_complement M U U0 -> #|U0| = exponent U, - (*b*) [Frobenius M = H ><| U] = Zgroup U - & (*c*) forall U1 (i : Iirr H), - is_typeF_inertia M U U1 -> i != 0 -> 'I_U['chi_i] \subset U1]. -Proof. -case; rewrite -/H => [[ntH ntM defM] _ exU0]; set part_a := forall U0, _. -have [nsHM sUG mulHU nHU _] := sdprod_context defM. -have oU0: part_a. - move=> U0 [sU0U <- /Frobenius_reg_ker regU0]; rewrite exponent_Zgroup //. - apply/forall_inP=> S /SylowP[p _ /and3P[sSU0 pS _]]. - apply: odd_regular_pgroup_cyclic pS (mFT_odd S) ntH _ _. - by rewrite (subset_trans (subset_trans sSU0 sU0U)). - by move=> x /setD1P[ntx /(subsetP sSU0) U0x]; rewrite regU0 // !inE ntx. -split=> // [|U1 i [nsU1U abU1 s_cUH_U1] nz_i]. - apply/idP/idP=> [frobU | ZgU]. - apply/forall_inP=> S /SylowP[p _ /and3P[sSU pS _]]. - apply: odd_regular_pgroup_cyclic pS (mFT_odd S) ntH _ _. - by rewrite (subset_trans sSU). - move=> x /setD1P[ntx /(subsetP sSU) Ux]. - by rewrite (Frobenius_reg_ker frobU) // !inE ntx. - have [U0 [sU0U expU0 frobU0]] := exU0; have regU0 := Frobenius_reg_ker frobU0. - suffices defU0: U0 :=: U by rewrite defU0 norm_joinEr ?mulHU // in frobU0. - by apply/eqP; rewrite eqEcard sU0U /= (oU0 U0) // exponent_Zgroup. -have itoP: is_action M (fun (j : Iirr H) x => conjg_Iirr j x). - split=> [x | j x y Mx My]. - apply: can_inj (fun j => conjg_Iirr j x^-1) _ => j. - by apply: irr_inj; rewrite !conjg_IirrE cfConjgK. - by apply: irr_inj; rewrite !conjg_IirrE (cfConjgM _ nsHM). -pose ito := Action itoP; pose cto := ('Js \ subsetT M)%act. -have actsMcH: [acts M, on classes H | cto]. - apply/subsetP=> x Mx; rewrite !inE Mx; apply/subsetP=> _ /imsetP[y Hy ->]. - have nHx: x \in 'N(H) by rewrite (subsetP (gFnorm _ _)). - rewrite !inE /= -class_rcoset norm_rlcoset // class_lcoset mem_classes //. - by rewrite memJ_norm. -apply/subsetP=> g /setIP[Ug /setIdP[nHg c_i_g]]; have Mg := subsetP sUG g Ug. -apply: contraR nz_i => notU1g; rewrite (sameP eqP set1P). -suffices <-: 'Fix_ito[g] = [set 0 : Iirr H]. - by rewrite !inE sub1set inE -(inj_eq (@irr_inj _ _)) conjg_IirrE. -apply/eqP; rewrite eq_sym eqEcard cards1 !(inE, sub1set) /=. -rewrite -(inj_eq (@irr_inj _ _)) conjg_IirrE irr0 cfConjg_cfun1 eqxx. -rewrite (card_afix_irr_classes Mg actsMcH) => [|j y z Hy /=]; last first. - case/imsetP=> _ /imsetP[t Ht ->] -> {z}. - by rewrite conjg_IirrE cfConjgE // conjgK cfunJ. -rewrite -(cards1 [1 gT]) subset_leq_card //= -/H. -apply/subsetP=> _ /setIP[/imsetP[a Ha ->] /afix1P caHg]; rewrite inE classG_eq1. -have{caHg} /imsetP[x Hgx cax]: a \in a ^: (H :* g). - by rewrite class_rcoset caHg class_refl. -have coHg: coprime #|H| #[g]. - apply: (coprime_dvdr (order_dvdG Ug)). - by rewrite (coprime_sdprod_Hall_l defM) (pHall_Hall (Fcore_Hall M)). -have /imset2P[z y cHgg_z Hy defx]: x \in class_support ('C_H[g] :* g) H. - have [/and3P[/eqP defUcHgg _ _] _] := partition_cent_rcoset nHg coHg. - by rewrite class_supportEr -cover_imset defUcHgg. -rewrite -(can_eq (conjgKV y)) conj1g; apply: contraR notU1g => nt_ay'. -have{nt_ay'} Hay': a ^ y^-1 \in H^# by rewrite !inE nt_ay' groupJ ?groupV. -rewrite (subsetP (s_cUH_U1 _ Hay')) // inE Ug. -have ->: g = z.`_(\pi(H)^'). - have [h /setIP[Hh /cent1P cgh] ->] := rcosetP cHgg_z. - rewrite consttM // (constt1P _) ?mul1g ?constt_p_elt //. - by rewrite /p_elt -coprime_pi' ?cardG_gt0. - by rewrite (mem_p_elt _ Hh) // pgroupNK pgroup_pi. -by rewrite groupX //= -conjg_set1 normJ mem_conjgV -defx !inE conjg_set1 -cax. -Qed. - -(* Peterfalvi, Definition (8.3) is covered by BGsection16.of_typeI. *) -(* Peterfalvi, Definition (8.4) is covered by BGsection16.of_typeP. *) - -Section TypeP_Remarks. -(* These correspond to the remarks following Definition (8.4). *) - -Variables (M U W W1 W2 : {group gT}) (defW : W1 \x W2 = W). -Let H := M`_\F. -Let M' := M^`(1)%g. - -Hypothesis MtypeP : of_typeP M U defW. - -Remark of_typeP_sol : solvable M. -Proof. -have [_ [nilU _ _ defM'] _ _ _] := MtypeP. -have [nsHM' _ mulHU _ _] := sdprod_context defM'. -rewrite (series_sol (der_normal 1 M)) (abelian_sol (der_abelian 0 M)) andbT. -rewrite (series_sol nsHM') (nilpotent_sol (Fcore_nil M)). -by rewrite -mulHU quotientMidl quotient_sol ?(nilpotent_sol nilU). -Qed. - -Remark typeP_cent_compl : 'C_M'(W1) = W2. -Proof. -have [[/cyclicP[x ->] _ ntW1 _] _ _ [_ _ _ _ prM'W1] _] := MtypeP. -by rewrite cent_cycle prM'W1 // !inE cycle_id -cycle_eq1 ntW1. -Qed. - -Remark typeP_cent_core_compl : 'C_H(W1) = W2. -Proof. -have [sW2H sHM']: W2 \subset H /\ H \subset M'. - by have [_ [_ _ _ /sdprodW/mulG_sub[-> _]] _ []] := MtypeP. -by apply/eqP; rewrite eqEsubset subsetI sW2H -typeP_cent_compl ?subsetIr ?setSI. -Qed. - -Lemma typePF_exclusion K : ~ of_typeF M K. -Proof. -move=> [[ntH ntU1 defM_K] _ [U0 [sU01 expU0] frobU0]]. -have [[cycW1 hallW1 ntW1 defM] [_ _ _ defM'] _ [_]] := MtypeP; case/negP. -pose p := pdiv #|W1|; rewrite -/M' -/H in defM defM' frobU0 *. -have piW1p: p \in \pi(W1) by rewrite pi_pdiv cardG_gt1. -have piU0p: p \in \pi(U0). - rewrite -pi_of_exponent expU0 pi_of_exponent (pi_of_dvd _ _ piW1p) //=. - rewrite -(@dvdn_pmul2l #|H|) ?cardG_gt0 // (sdprod_card defM_K). - rewrite -(sdprod_card defM) dvdn_pmul2r ?cardSg //. - by case/sdprodP: defM' => _ <- _ _; apply: mulG_subl. -have [|X EpX]:= @p_rank_geP _ p 1 U0 _; first by rewrite p_rank_gt0. -have [ntX [sXU0 abelX _]] := (nt_pnElem EpX isT, pnElemP EpX). -have piW1_X: \pi(W1).-group X by apply: pi_pgroup piW1p; case/andP: abelX. -have sXM: X \subset M. - by rewrite -(sdprodWY defM_K) joingC sub_gen ?subsetU // (subset_trans sXU0). -have nHM: M \subset 'N(H) by apply: gFnorm. -have [regU0 solM] := (Frobenius_reg_ker frobU0, of_typeP_sol). -have [a Ma sXaW1] := Hall_Jsub solM (Hall_pi hallW1) sXM piW1_X. -rewrite -subG1 -(conjs1g a) -(cent_semiregular regU0 sXU0 ntX) conjIg -centJ. -by rewrite (normsP nHM) // -typeP_cent_core_compl ?setIS ?centS. -Qed. - -Remark of_typeP_compl_conj W1x : M' ><| W1x = M -> W1x \in W1 :^: M. -Proof. -case/sdprodP=> [[{W1x}_ W1x _ ->] mulM'W1x _ tiM'W1x]. -have [[_ /Hall_pi hallW1 _ defM] _ _ _ _] := MtypeP. -apply/imsetP; apply: Hall_trans of_typeP_sol _ (hallW1). -rewrite pHallE -(card_Hall hallW1) -(@eqn_pmul2l #|M'|) ?cardG_gt0 //. -by rewrite (sdprod_card defM) -mulM'W1x mulG_subr /= TI_cardMg. -Qed. - -Remark conj_of_typeP x : - {defWx : W1 :^ x \x W2 :^ x = W :^ x | of_typeP (M :^ x) (U :^ x) defWx}. -Proof. -have defWx: W1 :^ x \x W2 :^ x = W :^ x by rewrite -dprodJ defW. -exists defWx; rewrite /of_typeP !derJ FcoreJ FittingJ centJ -conjIg normJ. -rewrite !cyclicJ !conjsg_eq1 /Hall !conjSg indexJg cardJg -[_ && _]/(Hall M W1). -rewrite -(isog_nil (conj_isog U x)) -!sdprodJ -conjsMg -conjD1g. -rewrite -(conjGid (in_setT x)) -conjUg -conjDg normedTI_J. -have [[-> -> -> ->] [-> -> -> ->] [-> -> -> ->] [-> -> -> -> prW1] ->]:= MtypeP. -by do 2![split]=> // _ /imsetP[y /prW1<- ->]; rewrite cent1J -conjIg. -Qed. - -(* This is Peterfalvi (8.5), with an extra clause in anticipation of (8.15). *) -Lemma typeP_context : - [/\ (*a*) H \x 'C_U(H) = 'F(M), - (*b*) U^`(1)%g \subset 'C(H) /\ (U :!=: 1%g -> ~~ (U \subset 'C(H))), - (*c*) normedTI (cyclicTIset defW) G W - & cyclicTI_hypothesis G defW]. -Proof. -have defW2 := typeP_cent_core_compl. -case: MtypeP; rewrite /= -/H => [] [cycW1 hallW1 ntW1 defM] [nilU _ _ defM']. -set V := W :\: _ => [] [_ sM''F defF sFM'] [cycW2 ntW2 sW2H _ _] TI_V. -have [/andP[sHM' nHM'] sUM' mulHU _ tiHU] := sdprod_context defM'. -have sM'M : M' \subset M by apply: der_sub. -have hallM': \pi(M').-Hall(M) M' by rewrite Hall_pi // (sdprod_Hall defM). -have hallH_M': \pi(H).-Hall(M') H := pHall_subl sHM' sM'M (Fcore_Hall M). -have{defF} defF: (H * 'C_U(H))%g = 'F(M). - rewrite -(setIidPl sFM') -defF -group_modl //= -/H. - rewrite setIAC (setIidPr (der_sub 1 M)). - rewrite -(coprime_mulG_setI_norm mulHU) ?norms_cent //; last first. - by rewrite (coprime_sdprod_Hall_l defM') (pHall_Hall hallH_M'). - by rewrite mulgA (mulGSid (subsetIl _ _)). -have coW12: coprime #|W1| #|W2|. - rewrite coprime_sym (coprimeSg (subset_trans sW2H sHM')) //. - by rewrite (coprime_sdprod_Hall_r defM). -have cycW: cyclic W by rewrite (cyclic_dprod defW). -have ctiW: cyclicTI_hypothesis G defW by split; rewrite ?mFT_odd. -split=> //; first by rewrite dprodE ?subsetIr //= setIA tiHU setI1g. -split. - apply: subset_trans (_ : U :&: 'F(M) \subset _). - by rewrite subsetI gFsub (subset_trans (dergS 1 sUM')). - by rewrite -defF -group_modr ?subsetIl // setIC tiHU mul1g subsetIr. -apply: contra => cHU; rewrite -subG1 -tiHU subsetIidr (subset_trans sUM') //. -by rewrite (Fcore_max hallM') ?der_normal // -mulHU mulg_nil ?Fcore_nil. -Qed. - -End TypeP_Remarks. - -Remark FTtypeP_witness M : - M \in 'M -> FTtype M != 1%N -> exists_typeP (of_typeP M). -Proof. -move=> maxM /negbTE typeMnot1. -have:= FTtype_range M; rewrite -mem_iota !inE typeMnot1 /=. -by case/or4P=> /FTtypeP[//|U W W1 W2 defW [[]]]; exists U W W1 W2 defW. -Qed. - -(* Peterfalvi, Definition (8.6) is covered by BGsection16.of_typeII_IV et al. *) -(* Peterfalvi, Definition (8.7) is covered by BGsection16.of_typeV. *) - -Section FTypeP_Remarks. -(* The remarks for Definition (8.4) also apply to (8.6) and (8.7). *) - -Variables (M U W W1 W2 : {group gT}) (defW : W1 \x W2 = W). -Let H := M`_\F. -Let M' := M^`(1)%g. - -Hypotheses (maxM : M \in 'M) (MtypeP : of_typeP M U defW). - -Remark of_typeP_conj (Ux W1x W2x Wx : {group gT}) (defWx : W1x \x W2x = Wx) : - of_typeP M Ux defWx -> - exists x, - [/\ x \in M, U :^ x = Ux, W1 :^ x = W1x, W2 :^ x = W2x & W :^ x = Wx]. -Proof. -move=> MtypePx; have [[_ _ _ defMx] [_ _ nUW1x defM'x] _ _ _] := MtypePx. -have [[_ hallW1 _ defM] [_ _ nUW1 defM'] _ _ _] := MtypeP. -have [/mulG_sub[/= sHM' sUM'] [_ _ nM'W1 _]] := (sdprodW defM', sdprodP defM). -rewrite -/M' -/H in defMx defM'x defM defM' sHM' sUM' nM'W1. -have /imsetP[x2 Mx2 defW1x2] := of_typeP_compl_conj MtypeP defMx. -have /andP[sM'M nM'M]: M' <| M by apply: der_normal. -have solM': solvable M' := solvableS sM'M (of_typeP_sol MtypeP). -have [hallU hallUx]: \pi(H)^'.-Hall(M') U /\ \pi(H)^'.-Hall(M') (Ux :^ x2^-1). - have hallH: \pi(H).-Hall(M') H by apply: pHall_subl (Fcore_Hall M). - rewrite pHallJnorm ?(subsetP nM'M) ?groupV // -!(compl_pHall _ hallH). - by rewrite (sdprod_compl defM') (sdprod_compl defM'x). -have coM'W1: coprime #|M'| #|W1| by rewrite (coprime_sdprod_Hall_r defM). -have nUxW1: W1 \subset 'N(Ux :^ x2^-1) by rewrite normJ -sub_conjg -defW1x2. -have [x1] := coprime_Hall_trans nM'W1 coM'W1 solM' hallUx nUxW1 hallU nUW1. -case/setIP=> /(subsetP sM'M) My /(normsP (cent_sub _)) nW1x1 defUx1. -pose x := (x1 * x2)%g; have Mx: x \in M by rewrite groupM. -have defW1x: W1 :^ x = W1x by rewrite conjsgM nW1x1. -have defW2x: W2 :^ x = W2x. - rewrite -(typeP_cent_compl MtypeP) -(typeP_cent_compl MtypePx). - by rewrite conjIg -centJ defW1x (normsP nM'M). -by exists x; rewrite -defW dprodJ defW1x defW2x conjsgM -defUx1 conjsgKV. -Qed. - -Lemma FTtypeP_neq1 : FTtype M != 1%N. -Proof. by apply/FTtypeP=> // [[V [/(typePF_exclusion MtypeP)]]]. Qed. - -Remark compl_of_typeII_IV : FTtype M != 5 -> of_typeII_IV M U defW. -Proof. -move=> Mtype'5. -have [Ux Wx W1x W2x defWx Mtype24]: exists_typeP (of_typeII_IV M). - have:= FTtype_range M; rewrite leq_eqVlt eq_sym (leq_eqVlt _ 5). - rewrite (negPf FTtypeP_neq1) (negPf Mtype'5) /= -mem_iota !inE. - by case/or3P=> /FTtypeP[]// Ux Wx W1x W2x dWx []; exists Ux Wx W1x W2x dWx. -have [MtypePx ntUx prW1x tiFM] := Mtype24. -have [x [Mx defUx defW1x _ _]] := of_typeP_conj MtypePx. -by rewrite -defUx -defW1x cardJg conjsg_eq1 in ntUx prW1x. -Qed. - -Remark compl_of_typeII : FTtype M == 2 -> of_typeII M U defW. -Proof. -move=> Mtype2. -have [Ux Wx W1x W2x defWx [[MtypePx _ _ _]]] := FTtypeP 2 maxM Mtype2. -have [x [Mx <- _ _ _]] := of_typeP_conj MtypePx; rewrite -/M' -/H. -rewrite abelianJ normJ -{1}(conjGid Mx) conjSg => cUU not_sNUM M'typeF defH. -split=> //; first by apply: compl_of_typeII_IV; rewrite // (eqP Mtype2). -by apply: compl_of_typeF M'typeF; rewrite defH; have [_ []] := MtypeP. -Qed. - -Remark compl_of_typeIII : FTtype M == 3 -> of_typeIII M U defW. -Proof. -move=> Mtype3. -have [Ux Wx W1x W2x defWx [[MtypePx _ _ _]]] := FTtypeP 3 maxM Mtype3. -have [x [Mx <- _ _ _]] := of_typeP_conj MtypePx; rewrite -/M' -/H. -rewrite abelianJ normJ -{1}(conjGid Mx) conjSg. -by split=> //; apply: compl_of_typeII_IV; rewrite // (eqP Mtype3). -Qed. - -Remark compl_of_typeIV : FTtype M == 4 -> of_typeIV M U defW. -Proof. -move=> Mtype4. -have [Ux Wx W1x W2x defWx [[MtypePx _ _ _]]] := FTtypeP 4 maxM Mtype4. -have [x [Mx <- _ _ _]] := of_typeP_conj MtypePx; rewrite -/M' -/H. -rewrite abelianJ normJ -{1}(conjGid Mx) conjSg. -by split=> //; apply: compl_of_typeII_IV; rewrite // (eqP Mtype4). -Qed. - -Remark compl_of_typeV : FTtype M == 5 -> of_typeV M U defW. -Proof. -move=> Mtype5. -have [Ux Wx W1x W2x defWx [[MtypePx /eqP]]] := FTtypeP 5 maxM Mtype5. -have [x [Mx <- <- _ _]] := of_typeP_conj MtypePx; rewrite -/M' -/H. -by rewrite cardJg conjsg_eq1 => /eqP. -Qed. - -End FTypeP_Remarks. - -(* This is the statement of Peterfalvi, Theorem (8.8)(a). *) -Definition all_FTtype1 := [forall M : {group gT} in 'M, FTtype M == 1%N]. - -(* This is the statement of Peterfalvi, Theorem (8.8)(b). *) -Definition typeP_pair S T (W W1 W2 : {set gT}) (defW : W1 \x W2 = W) := - [/\ [/\ cyclicTI_hypothesis G defW, S \in 'M & T \in 'M], - (*b1*) [/\ S^`(1) ><| W1 = S, T^`(1) ><| W2 = T & S :&: T = W]%g, - (*b2*) (FTtype S == 2) || (FTtype T == 2), - (*b3*) (1 < FTtype S <= 5 /\ 1 < FTtype T <= 5)%N - & (*b4*) {in 'M, forall M, FTtype M != 1%N -> gval M \in S :^: G :|: T :^: G}]. - -Lemma typeP_pair_sym S T W W1 W2 (defW : W1 \x W2 = W) (xdefW : W2 \x W1 = W) : - typeP_pair S T defW -> typeP_pair T S xdefW. -Proof. -by case=> [[/cyclicTIhyp_sym ? ? ?] [? ?]]; rewrite setIC setUC orbC => ? ? []. -Qed. - -(* This is Peterfalvi, Theorem (8.8). *) -Lemma FTtypeP_pair_cases : - (*a*) {in 'M, forall M, FTtype M == 1%N} - \/ (*b*) exists S, exists T, exists_typeP (fun _ => typeP_pair S T). -Proof. -have [_ [| [[S T] [[maxS maxT] [[W1 W2] /=]]]]] := BGsummaryI gT; first by left. -set W := W1 <*> W2; set V := W :\: (W1 :|: W2). -case=> [[cycW tiV _] [defS defT tiST]] b4 /orP b2 b3. -have [cWW /joing_sub[sW1W sW2W]] := (cyclic_abelian cycW, erefl W). -have ntV: V != set0 by have [] := andP tiV. -suffices{tiST tiV cWW sW1W sW2W b3 b4} tiW12: W1 :&: W2 = 1%g. - have defW: W1 \x W2 = W by rewrite dprodEY ?(centSS _ _ cWW). - right; exists S, T; exists S _ _ _ defW; split=> // [|M _ /b4[] // x]. - by do 2?split; rewrite ?mFT_odd // /normedTI tiV nVW setTI /=. - by case=> <-; rewrite inE mem_orbit ?orbT. -wlog {b2 T defT maxT} Stype2: S W1 W2 @W @V maxS defS cycW ntV / FTtype S == 2. - move=> IH; case/orP: b2 cycW ntV => /IH; first exact. - by rewrite setIC /V /W /= joingC setUC; apply. -have{maxS Stype2 defS} prW1: prime #|W1|. - have [U ? W1x ? ? [[StypeP _ prW1x _] _ _ _ _]] := FTtypeP 2 maxS Stype2. - by have /imsetP[x _ ->] := of_typeP_compl_conj StypeP defS; rewrite cardJg. -rewrite prime_TIg //; apply: contra ntV => sW12. -by rewrite setD_eq0 (setUidPr sW12) join_subG sW12 /=. -Qed. - -(* This is Peterfalvi (8.9). *) -(* We state the lemma using the of_typeP predicate, as it is the Skolemised *) -(* form of Peterfalvi, Definition (8.4). *) -Lemma typeP_pairW S T W W1 W2 (defW : W1 \x W2 = W) : - typeP_pair S T defW -> exists U : {group gT}, of_typeP S U defW. -Proof. -case=> [[[cycW _ /and3P[_ _ /eqP nVW]] maxS _] [defS _ defST] _ [Stype25 _] _]. -set S' := S^`(1)%g in defS; have [nsS'S _ _ _ tiS'W1] := sdprod_context defS. -have{Stype25} Stype'1: FTtype S != 1%N by apply: contraTneq Stype25 => ->. -have [/mulG_sub[sW1W sW2W] [_ mulW12 cW12 _]] := (dprodW defW, dprodP defW). -have [cycW1 cycW2] := (cyclicS sW1W cycW, cyclicS sW2W cycW). -have{cycW1 cycW2} coW12: coprime #|W1| #|W2| by rewrite -(cyclic_dprod defW). -have{maxS Stype'1} [Ux Wx W1x W2x defWx StypeP] := FTtypeP_witness maxS Stype'1. -have /imsetP[y Sy defW1] := of_typeP_compl_conj StypeP defS. -suffices defW2: W2 :=: W2x :^ y. - have [] := conj_of_typeP StypeP y; rewrite -defWx dprodJ -defW1 -defW2. - by rewrite (conjGid Sy) {-1}defW; exists (Ux :^ y)%G. -have [[_ hallW1x _ defSx] _ _ [/cyclic_abelian abW2x _ _ _ _] _] := StypeP. -have{Sy} nS'y: y \in 'N(S') by rewrite (subsetP (normal_norm nsS'S)). -have{nS'y} defW2xy: W2x :^ y = 'C_S'(W1). - by rewrite -(typeP_cent_compl StypeP) conjIg -centJ -defW1 (normP nS'y). -have{nsS'S} sW2S': W2 \subset S'. - have sW2S: W2 \subset S by rewrite (subset_trans sW2W) // -defST subsetIl. - have{hallW1x} hallW1: \pi(W1).-Hall(S) W1x by rewrite defW1 /= cardJg Hall_pi. - have hallS': \pi(W1)^'.-Hall(S) S' by apply/(sdprod_normal_pHallP _ hallW1). - by rewrite coprime_pi' // (sub_normal_Hall hallS') in coW12 *. -have sW2xy: W2 \subset W2x :^ y by rewrite defW2xy subsetI sW2S'. -have defW2: W2 :=: S' :&: W by rewrite -mulW12 -group_modr ?tiS'W1 ?mul1g. -apply/eqP; rewrite eqEsubset sW2xy defW2 subsetI {1}defW2xy subsetIl /=. -rewrite -nVW /= setTI cents_norm // (centsS (subsetDl _ _)) // -mulW12. -by rewrite centM subsetI {1}defW2xy subsetIr sub_abelian_cent // abelianJ. -Qed. - -Section OneMaximal. - -Variable M U W W1 W2 : {group gT}. (* W, W1 and W2 are only used later. *) -Hypothesis maxM : M \in 'M. - -(* Peterfalvi, Definition (8.10) is covered in BGsection16. *) - -(* This is Peterfalvi (8.11). *) -Lemma FTcore_facts : - [/\ Hall G M`_\F, Hall G M`_\s - & forall S, Sylow M`_\s S -> S :!=: 1%g -> 'N(S) \subset M]. -Proof. -have hallMs := Msigma_Hall_G maxM; have [_ sMs _] := and3P hallMs. -rewrite def_FTcore // (pHall_Hall hallMs). -split=> // [|S /SylowP[p _ sylS] ntS]. - have sMF_Ms:= Fcore_sub_Msigma maxM. - apply: (@pHall_Hall _ \pi(M`_\F)); apply: (subHall_Hall hallMs). - by move=> p /(piSg sMF_Ms)/(pnatPpi sMs). - exact: pHall_subl (pcore_sub _ M) (Fcore_Hall M). -have s_p: p \in \sigma(M). - by rewrite (pnatPpi sMs) // -p_rank_gt0 -(rank_Sylow sylS) rank_gt0. -by apply: (norm_sigma_Sylow s_p); apply: (subHall_Sylow (Msigma_Hall maxM)). -Qed. - -(* This is Peterfalvi (8.12). *) -(* (b) could be stated for subgroups of U wlog -- usage should be checked. *) -Lemma FTtypeI_II_facts n (H := M`_\F) : - FTtype M == n -> H ><| U = M ^`(n.-1)%g -> - if 0 < n <= 2 then - [/\ (*a*) forall p S, p.-Sylow(U) S -> abelian S /\ ('r(S) <= 2)%N, - (*b*) forall X, X != set0 -> X \subset U^# -> 'C_H(X) != 1%g -> - 'M('C(X)) = [set M] - & (*c*) let B := 'A(M) :\: 'A1(M) in B != set0 -> normedTI B G M - ] else True. -Proof. -move=> typeM defMn; have [n12 | //] := ifP; rewrite -mem_iota !inE in n12. -have defH: H = M`_\sigma. - by rewrite -def_FTcore -?(Fcore_eq_FTcore _ _) // (eqP typeM) !inE orbA n12. -have [K complU]: exists K : {group gT}, kappa_complement M U K. - have [[V K] /= complV] := kappa_witness maxM. - have [[hallV hallK gVK] [_ sUMn _ _ _]] := (complV, sdprod_context defMn). - have hallU: \sigma_kappa(M)^'.-Hall(M) U. - rewrite pHallE -(card_Hall hallV) (subset_trans sUMn) ?der_sub //=. - rewrite -(@eqn_pmul2l #|H|) ?cardG_gt0 // (sdprod_card defMn) defH. - rewrite (sdprod_card (sdprod_FTder maxM complV)) (eqP typeM). - by case/pred2P: n12 => ->. - have [x Mx defU] := Hall_trans (mmax_sol maxM) hallU hallV. - exists (K :^ x)%G; split; rewrite ?pHallJ // defU -conjsMg. - by rewrite -(gen_set_id gVK) groupP. -have [part_a _ _ [part_b part_c]] := BGsummaryB maxM complU. -rewrite eqEsubset FTsupp1_sub // andbT -setD_eq0 in part_c. -split=> // X notX0 /subsetD1P[sXU notX1]; rewrite -cent_gen defH. -apply: part_b; rewrite -?subG1 ?gen_subG //. -by rewrite -setD_eq0 setDE (setIidPl _) // subsetC sub1set inE. -Qed. - -(* This is Peterfalvi (8.13). *) -(* We have substituted the B & G notation for the unique maximal supergroup *) -(* of 'C[x], and specialized the lemma to X := 'A0(M). *) -Lemma FTsupport_facts (X := 'A0(M)) (D := [set x in X | ~~('C[x] \subset M)]) : - [/\ (*a*) {in X &, forall x, {subset x ^: G <= x ^: M}}, - (*b*) D \subset 'A1(M) /\ {in D, forall x, 'M('C[x]) = [set 'N[x]]} - & (*c*) {in D, forall x (L := 'N[x]) (H := L`_\F), - [/\ (*c1*) H ><| (M :&: L) = L /\ 'C_H[x] ><| 'C_M[x] = 'C[x], - (*c2*) {in X, forall y, coprime #|H| #|'C_M[y]| }, - (*c3*) x \in 'A(L) :\: 'A1(L) - & (*c4*) 1 <= FTtype L <= 2 - /\ (FTtype L == 2 -> [Frobenius M with kernel M`_\F])]}]. -Proof. -have defX: X \in pred2 'A(M) 'A0(M) by rewrite !inE eqxx orbT. -have [sDA1 part_a part_c] := BGsummaryII maxM defX. -have{part_a} part_a: {in X &, forall x, {subset x ^: G <= x ^: M}}. - move=> x y A0x A0y /= /imsetP[g Gg def_y]; rewrite def_y. - by apply/imsetP/part_a; rewrite -?def_y. -do [split=> //; first split=> //] => x /part_c[_ ] //. -rewrite /= -(mem_iota 1) !inE => -> [-> ? -> -> L2_frob]. -by do 2![split=> //] => /L2_frob[E /FrobeniusWker]. -Qed. - -(* A generic proof of the first assertion of Peterfalvi (8.15). *) -Let norm_FTsuppX A : - M \subset 'N(A) -> 'A1(M) \subset A -> A \subset 'A0(M) -> 'N(A) = M. -Proof. -move=> nAM sA1A sAA0; apply: mmax_max => //. -rewrite (sub_proper_trans (norm_gen _)) ?mFT_norm_proper //; last first. - rewrite (sub_proper_trans _ (mmax_proper maxM)) // gen_subG. - by rewrite (subset_trans sAA0) // (subset_trans (FTsupp0_sub M)) ?subsetDl. -rewrite (subG1_contra (genS sA1A)) //= genD1 ?group1 //. -by rewrite genGid /= def_FTcore ?Msigma_neq1. -Qed. - -Lemma norm_FTsupp1 : 'N('A1(M)) = M. -Proof. exact: norm_FTsuppX (FTsupp1_norm M) _ (FTsupp1_sub0 maxM). Qed. - -Lemma norm_FTsupp : 'N('A(M)) = M. -Proof. exact: norm_FTsuppX (FTsupp_norm M) (FTsupp1_sub _) (FTsupp_sub0 M). Qed. - -Lemma norm_FTsupp0 : 'N('A0(M)) = M. -Proof. exact: norm_FTsuppX (FTsupp0_norm M) (FTsupp1_sub0 _) _. Qed. - -Lemma FTsignalizerJ x y : 'R_(M :^ x) (y ^ x) :=: 'R_M y :^ x. -Proof. -rewrite /'R__ /= {1}cent1J conjSg; case: ifP => _ /=; first by rewrite conjs1g. -by rewrite cent1J FT_signalizer_baseJ FcoreJ -conjIg. -Qed. - -Let is_FTsignalizer : is_Dade_signalizer G M 'A0(M) 'R_M. -Proof. -rewrite /'R_M => x A0x /=; rewrite setTI. -case: ifPn => [sCxM | not_sCxM]; first by rewrite sdprod1g (setIidPr sCxM). -by have [_ _ /(_ x)[| [] //]] := FTsupport_facts; apply/setIdP. -Qed. - -(* This is Peterfalvi (8.15), second assertion. *) -Lemma FT_Dade0_hyp : Dade_hypothesis G M 'A0(M). -Proof. -have [part_a _ parts_bc] := FTsupport_facts. -have /subsetD1P[sA0M notA0_1] := FTsupp0_sub M. -split; rewrite // /normal ?sA0M ?norm_FTsupp0 //=. -exists 'R_M => [|x y A0x A0y]; first exact: is_FTsignalizer. -rewrite /'R_M; case: ifPn => [_ | not_sCxM]; first by rewrite cards1 coprime1n. -rewrite (coprimeSg (subsetIl _ _)) //=. -by have [| _ -> //] := parts_bc x; apply/setIdP. -Qed. - -Definition FT_Dade_hyp := - restr_Dade_hyp FT_Dade0_hyp (FTsupp_sub0 M) (FTsupp_norm M). - -Definition FT_Dade1_hyp := - restr_Dade_hyp FT_Dade0_hyp (FTsupp1_sub0 maxM) (FTsupp1_norm M). - -Definition FT_DadeF_hyp := - restr_Dade_hyp FT_Dade0_hyp (Fcore_sub_FTsupp0 maxM) (normsD1 (gFnorm _ _)). - -Lemma def_FTsignalizer0 : {in 'A0(M), Dade_signalizer FT_Dade0_hyp =1 'R_M}. -Proof. exact: def_Dade_signalizer. Qed. - -Lemma def_FTsignalizer : {in 'A(M), Dade_signalizer FT_Dade_hyp =1 'R_M}. -Proof. exact: restr_Dade_signalizer def_FTsignalizer0. Qed. - -Lemma def_FTsignalizer1 : {in 'A1(M), Dade_signalizer FT_Dade1_hyp =1 'R_M}. -Proof. exact: restr_Dade_signalizer def_FTsignalizer0. Qed. - -Lemma def_FTsignalizerF : {in M`_\F^#, Dade_signalizer FT_DadeF_hyp =1 'R_M}. -Proof. exact: restr_Dade_signalizer def_FTsignalizer0. Qed. - -Local Notation tau := (Dade FT_Dade0_hyp). -Local Notation FT_Dade := (Dade FT_Dade_hyp). -Local Notation FT_Dade1 := (Dade FT_Dade1_hyp). -Local Notation FT_DadeF := (Dade FT_DadeF_hyp). - -Lemma FT_DadeE : {in 'CF(M, 'A(M)), FT_Dade =1 tau}. -Proof. exact: restr_DadeE. Qed. - -Lemma FT_Dade1E : {in 'CF(M, 'A1(M)), FT_Dade1 =1 tau}. -Proof. exact: restr_DadeE. Qed. - -Lemma FT_DadeF_E : {in 'CF(M, M`_\F^#), FT_DadeF =1 tau}. -Proof. exact: restr_DadeE. Qed. - -Lemma FT_Dade_supportS A B : A \subset B -> 'A~(M, A) \subset 'A~(M, B). -Proof. -by move/subsetP=> sAB; apply/bigcupsP=> x Ax; rewrite (bigcup_max x) ?sAB. -Qed. - -Lemma FT_Dade0_supportE : Dade_support FT_Dade0_hyp = 'A0~(M). -Proof. by apply/eq_bigr=> x /def_FTsignalizer0 <-. Qed. - -Let defA A (sAA0 : A \subset 'A0(M)) (nAM : M \subset 'N(A)) : - Dade_support (restr_Dade_hyp FT_Dade0_hyp sAA0 nAM) = 'A~(M, A). -Proof. -by apply/eq_bigr=> x /(restr_Dade_signalizer sAA0 nAM def_FTsignalizer0) <-. -Qed. - -Lemma FT_Dade_supportE : Dade_support FT_Dade_hyp = 'A~(M). -Proof. exact: defA. Qed. - -Lemma FT_Dade1_supportE : Dade_support FT_Dade1_hyp = 'A1~(M). -Proof. exact: defA. Qed. - -Lemma FT_DadeF_supportE : Dade_support FT_DadeF_hyp = 'A~(M, M`_\F^#). -Proof. exact: defA. Qed. - -Lemma FT_Dade0_supportJ x : 'A0~(M :^ x) = 'A0~(M). -Proof. -rewrite /'A0~(_) FTsupp0J big_imset /=; last exact: in2W (conjg_inj x). -apply: eq_bigr => y _; rewrite FTsignalizerJ -conjg_set1 -conjsMg. -by rewrite class_supportGidl ?inE. -Qed. - -Lemma FT_Dade1_supportJ x : 'A1~(M :^ x) = 'A1~(M). -Proof. -rewrite /'A1~(_) FTsupp1J big_imset /=; last exact: in2W (conjg_inj x). -apply: eq_bigr => y _; rewrite FTsignalizerJ -conjg_set1 -conjsMg. -by rewrite class_supportGidl ?inE. -Qed. - -Lemma FT_Dade_supportJ x : 'A~(M :^ x) = 'A~(M). -Proof. -rewrite /'A~(_) FTsuppJ big_imset /=; last exact: in2W (conjg_inj x). -apply: eq_bigr => y _; rewrite FTsignalizerJ -conjg_set1 -conjsMg. -by rewrite class_supportGidl ?inE. -Qed. - -(* Subcoherence and cyclicTI properties of type II-V subgroups. *) -Hypotheses (defW : W1 \x W2 = W) (MtypeP : of_typeP M U defW). -Let H := M`_\F%G. -Let K := M^`(1)%G. - -Lemma FT_cyclicTI_hyp : cyclicTI_hypothesis G defW. -Proof. by case/typeP_context: MtypeP. Qed. -Let ctiW := FT_cyclicTI_hyp. - -(* This is a useful combination of Peterfalvi (8.8) and (8.9). *) -Lemma FTtypeP_pair_witness : - exists2 T, typeP_pair M T defW - & exists xdefW : W2 \x W1 = W, exists V : {group gT}, of_typeP T V xdefW. -Proof. -have Mtype'1 := FTtypeP_neq1 maxM MtypeP. -case: FTtypeP_pair_cases => [/(_ M maxM)/idPn[] // | [S [T]]]. -case=> _ Wx W1x W2x defWx pairST. -without loss /imsetP[y2 _ defSy]: S T W1x W2x defWx pairST / gval M \in S :^: G. - have [_ _ _ _ coverST] := pairST => IH. - have /setUP[] := coverST M maxM Mtype'1; first exact: IH pairST. - by apply: IH (typeP_pair_sym _ pairST); rewrite dprodC. -have [U_S StypeP] := typeP_pairW pairST. -have [[_ maxS maxT] [defS defT defST] b2 b3 b4] := pairST. -have [[[_ _ _ defM] _ _ _ _] defW2] := (MtypeP, typeP_cent_compl MtypeP). -have /imsetP[y1 Sy1 /(canRL (conjsgKV _)) defW1]: W1 :^ y2^-1 \in W1x :^: S. - apply: (of_typeP_compl_conj StypeP). - by rewrite -(conjsgK y2 S) -defSy derJ -sdprodJ defM. -pose y := (y1 * y2)%g; rewrite -conjsgM -/y in defW1. -have{defSy} defSy: S :^ y = M by rewrite conjsgM (conjGid Sy1). -have{defW2} defW2: W2 :=: W2x :^ y. - by rewrite -(typeP_cent_compl StypeP) conjIg -derJ -centJ defSy -defW1. -suffices pairMTy: typeP_pair M (T :^ y) defW. - exists (T :^ y)%G => //; have xdefW: W2 \x W1 = W by rewrite dprodC. - by exists xdefW; apply: typeP_pairW (typeP_pair_sym xdefW pairMTy). -do [split; rewrite ?defM -?defSy ?mmaxJ ?FTtypeJ //] => [|L maxL /(b4 L maxL)]. - by rewrite -defW defW1 defW2 derJ -sdprodJ -dprodJ -conjIg defT defST defWx. -by rewrite !conjugates_conj lcoset_id // inE. -Qed. - -(* A converse to the above. *) -Lemma of_typeP_pair (xdefW : W2 \x W1 = W) T V : - T \in 'M -> of_typeP T V xdefW -> typeP_pair M T defW. -Proof. -have [S pairMS [xdefW' [V1 StypeP]]] := FTtypeP_pair_witness => maxT TtypeP. -have [[cycW2 /andP[sW2T _] ntW2 _] _ _ [cycW1 _ _ sW1T'' _] _] := TtypeP. -have{sW1T'' sW2T} sWT: W \subset T. - by rewrite -(dprodW defW) mul_subG ?(subset_trans sW1T'') ?gFsub. -have [cycW _ /and3P[_ _ /eqP defNW]] := ctiW. -rewrite (@group_inj _ T S) //; have{pairMS} [_ _ _ _ defT] := pairMS. -have /defT/setUP[] := FTtypeP_neq1 maxT TtypeP => {defT}// /imsetP[x _ defT]. - have [defWx] := conj_of_typeP MtypeP x; rewrite -defT. - case/(of_typeP_conj TtypeP)=> y [_ _ _ defW1y _]. - have /idP[]:= negbF cycW; rewrite (cyclic_dprod defW) // /coprime. - by rewrite -(cardJg _ y) defW1y cardJg gcdnn -trivg_card1. -have [defWx] := conj_of_typeP StypeP x; rewrite -defT. -case/(of_typeP_conj TtypeP)=> y [Ty _ defW2y defW1y defWy]. -have Wyx: (y * x^-1)%g \in W. - by rewrite -defNW !inE /= conjDg conjUg !conjsgM defW2y defW1y defWy !conjsgK. -by rewrite -(conjGid (subsetP sWT _ Wyx)) conjsgM (conjGid Ty) defT conjsgK. -Qed. - -Lemma FT_primeTI_hyp : primeTI_hypothesis M K defW. -Proof. -have [[cycW1 ntW1 hallW1 defM] _ _ [cycW2 ntW2 _ sW2M'' prM'W1] _] := MtypeP. -by split; rewrite ?mFT_odd // (subset_trans sW2M'') ?der_subS. -Qed. -Let ptiWM := FT_primeTI_hyp. - -Lemma FTtypeP_supp0_def : - 'A0(M) = 'A(M) :|: class_support (cyclicTIset defW) M. -Proof. -rewrite -(setID 'A0(M) 'A(M)) (FTsupp0_typeP maxM MtypeP) (setIidPr _) //. -exact: FTsupp_sub0. -Qed. - -Fact FT_Fcore_prime_Dade_def : prime_Dade_definition M K H 'A(M) 'A0(M) defW. -Proof. -have [_ [_ _ _ /sdprodW/mulG_sub[sHK _]] _ [_ _ sW2H _ _] _] := MtypeP. -split; rewrite ?gFnormal //; last exact: FTtypeP_supp0_def. -rewrite /normal FTsupp_norm andbT /'A(M) (FTtypeP_neq1 maxM MtypeP) /=. -do ?split=> //; apply/bigcupsP=> x A1x; last by rewrite setSD ?subsetIl. - by rewrite setDE -setIA subIset // gFsub. -by rewrite (bigcup_max x) // (subsetP _ x A1x) // setSD ?Fcore_sub_FTcore. -Qed. - -Definition FT_prDade_hypF : prime_Dade_hypothesis _ M K H 'A(M) 'A0(M) defW := - PrimeDadeHypothesis ctiW ptiWM FT_Dade0_hyp FT_Fcore_prime_Dade_def. - -Fact FT_core_prime_Dade_def : prime_Dade_definition M K M`_\s 'A(M) 'A0(M) defW. -Proof. -have [[_ sW2H sHK] [nsAM sCA sAK] defA0] := FT_Fcore_prime_Dade_def. -have [_ [_ sW2K _ _] _] := ptiWM. -split=> //=; first by rewrite FTcore_normal /M`_\s; case: ifP. -rewrite nsAM /= /'A(M) /M`_\s (FTtypeP_neq1 maxM MtypeP); split=> //=. -by apply/bigcupsP=> x _; rewrite setSD ?subsetIl. -Qed. - -Definition FT_prDade_hyp : prime_Dade_hypothesis _ M K M`_\s 'A(M) 'A0(M) defW - := PrimeDadeHypothesis ctiW ptiWM FT_Dade0_hyp FT_core_prime_Dade_def. - -Let calS := seqIndD K M M`_\s 1. - -Fact FTtypeP_cohererence_base_subproof : cfConjC_subset calS calS. -Proof. exact: seqInd_conjC_subset1. Qed. - -Fact FTtypeP_cohererence_nonreal_subproof : ~~ has cfReal calS. -Proof. by rewrite seqInd_notReal ?mFT_odd ?FTcore_sub_der1 ?der_normal. Qed. - -Definition FTtypeP_coh_base_sig := - prDade_subcoherent FT_prDade_hyp - FTtypeP_cohererence_base_subproof FTtypeP_cohererence_nonreal_subproof. - -Definition FTtypeP_coh_base := sval FTtypeP_coh_base_sig. - -Local Notation R := FTtypeP_coh_base. - -Lemma FTtypeP_subcoherent : subcoherent calS tau R. -Proof. by rewrite /R; case: FTtypeP_coh_base_sig => R1 []. Qed. -Let scohS := FTtypeP_subcoherent. - -Let w_ i j := cyclicTIirr defW i j. -Let sigma := cyclicTIiso ctiW. -Let eta_ i j := sigma (w_ i j). -Let mu_ := primeTIred ptiWM. -Let delta_ := fun j => primeTIsign ptiWM j. - -Lemma FTtypeP_base_ortho : - {in [predI calS & irr M] & irr W, forall phi w, orthogonal (R phi) (sigma w)}. -Proof. by rewrite /R; case: FTtypeP_coh_base_sig => R1 []. Qed. - -Lemma FTtypeP_base_TIred : - let dsw j k := [seq delta_ j *: eta_ i k | i : Iirr W1] in - let Rmu j := dsw j j ++ map -%R (dsw j (conjC_Iirr j)) in - forall j, R (mu_ j) = Rmu j. -Proof. by rewrite /R; case: FTtypeP_coh_base_sig => R1 []. Qed. - -Lemma coherent_ortho_cycTIiso calS1 (tau1 : {additive 'CF(M) -> 'CF(G)}) : - cfConjC_subset calS1 calS -> coherent_with calS1 M^# tau tau1 -> - forall chi i j, chi \in calS1 -> chi \in irr M -> '[tau1 chi, eta_ i j] = 0. -Proof. -move=> ccsS1S cohS1 chi i j S1chi chi_irr; have [_ sS1S _] := ccsS1S. -have [e /mem_subseq Re ->] := mem_coherent_sum_subseq scohS ccsS1S cohS1 S1chi. -rewrite cfdot_suml big1_seq // => xi /Re; apply: orthoPr. -by apply: FTtypeP_base_ortho (mem_irr _); rewrite !inE sS1S. -Qed. - -Import ssrnum Num.Theory. - -(* A reformuation of Peterfalvi (5.8) for the Odd Order proof context. *) -Lemma FTtypeP_coherent_TIred calS1 tau1 zeta j : - cfConjC_subset calS1 calS -> coherent_with calS1 M^# tau tau1 -> - zeta \in irr M -> zeta \in calS1 -> mu_ j \in calS1 -> - let d := primeTI_Isign ptiWM j in let k := conjC_Iirr j in - {dk : bool * Iirr W2 | tau1 (mu_ j) = (-1) ^+ dk.1 *: (\sum_i eta_ i dk.2) - & dk.1 = d /\ dk.2 = j - \/ [/\ dk.1 = ~~ d, dk.2 = k - & forall l, mu_ l \in calS1 -> mu_ l 1%g = mu_ j 1%g -> pred2 j k l]}. -Proof. -move=> ccsS1S cohS1 irr_zeta S1zeta S1mu_j d k. -have irrS1: [/\ ~~ has cfReal calS1, has (mem (irr M)) calS1 & mu_ j \in calS1]. - have [[_ -> _] _ _ _ _] := subset_subcoherent scohS ccsS1S. - by split=> //; apply/hasP; exists zeta. -have Dmu := coherent_prDade_TIred FT_prDade_hyp ccsS1S irrS1 cohS1. -rewrite -/mu_ -/d in Dmu; pose mu_sum d1 k1 := (-1) ^+ d1 *: (\sum_i eta_ i k1). -have mu_sumK (d1 d2 : bool) k1 k2: - ('[mu_sum d1 k1, (-1) ^+ d2 *: eta_ 0 k2] > 0) = (d1 == d2) && (k1 == k2). -- rewrite cfdotZl cfdotZr rmorph_sign mulrA -signr_addb cfdot_suml. - rewrite (bigD1 0) //= cfdot_cycTIiso !eqxx big1 => [|i nz_i]; last first. - by rewrite cfdot_cycTIiso (negPf nz_i). - rewrite addr0 /= andbC; case: (k1 == k2); rewrite ?mulr0 ?ltrr //=. - by rewrite mulr1 signr_gt0 negb_add. -have [dk tau1mu_j]: {dk : bool * Iirr W2 | tau1 (mu_ j) = mu_sum dk.1 dk.2}. - apply: sig_eqW; case: Dmu => [-> | [-> _]]; first by exists (d, j). - by exists (~~ d, k); rewrite -signrN. -exists dk => //; have:= mu_sumK dk.1 dk.1 dk.2 dk.2; rewrite !eqxx -tau1mu_j. -case: Dmu => [-> | [-> all_jk]]; - rewrite -?signrN mu_sumK => /andP[/eqP <- /eqP <-]; [by left | right]. -by split=> // j1 S1j1 /(all_jk j1 S1j1)/pred2P. -Qed. - -Lemma size_red_subseq_seqInd_typeP (calX : {set Iirr K}) calS1 : - uniq calS1 -> {subset calS1 <= seqInd M calX} -> - {subset calS1 <= [predC irr M]} -> - size calS1 = #|[set i : Iirr K | 'Ind 'chi_i \in calS1]|. -Proof. -move=> uS1 sS1S redS1; pose h s := 'Ind[M, K] 'chi_s. -apply/eqP; rewrite cardE -(size_map h) -uniq_size_uniq // => [|xi]; last first. - apply/imageP/idP=> [[i] | S1xi]; first by rewrite inE => ? ->. - by have /seqIndP[s _ Dxi] := sS1S _ S1xi; exists s; rewrite ?inE -?Dxi. -apply/dinjectiveP; pose h1 xi := cfIirr (#|W1|%:R^-1 *: 'Res[K, M] xi). -apply: can_in_inj (h1) _ => s; rewrite inE => /redS1 red_s. -have cycW1: cyclic W1 by have [[]] := MtypeP. -have [[j /irr_inj->] | [/idPn[]//]] := prTIres_irr_cases ptiWM s. -by rewrite /h cfInd_prTIres /h1 cfRes_prTIred scalerK ?neq0CG ?irrK. -Qed. - -End OneMaximal. - -(* This is Peterfalvi (8.16). *) -Lemma FTtypeII_ker_TI M : - M \in 'M -> FTtype M == 2 -> - [/\ normedTI 'A0(M) G M, normedTI 'A(M) G M & normedTI 'A1(M) G M]. -Proof. -move=> maxM typeM; have [sA1A sAA0] := (FTsupp1_sub maxM, FTsupp_sub0 M). -have [sA10 sA0M] := (subset_trans sA1A sAA0, FTsupp0_sub M). -have nzA1: 'A1(M) != set0 by rewrite setD_eq0 def_FTcore ?subG1 ?Msigma_neq1. -have [nzA nzA0] := (subset_neq0 sA1A nzA1, subset_neq0 sA10 nzA1). -suffices nTI_A0: normedTI 'A0(M) G M. - by rewrite nTI_A0 !(normedTI_S _ _ _ nTI_A0) // ?FTsupp_norm ?FTsupp1_norm. -have [U W W1 W2 defW [[MtypeP _ _ tiFM] _ _ _ _]] := FTtypeP 2 maxM typeM. -apply/(Dade_normedTI_P (FT_Dade0_hyp maxM)); split=> // x A0x. -rewrite /= def_FTsignalizer0 /'R_M //=; have [// | not_sCxM] := ifPn. -have [y cxy /negP[]] := subsetPn not_sCxM. -apply: subsetP cxy; rewrite -['C[x]]setTI (cent1_normedTI tiFM) //. -have /setD1P[ntx Ms_x]: x \in 'A1(M). - by have [_ [/subsetP-> // ]] := FTsupport_facts maxM; apply/setIdP. -rewrite !inE ntx (subsetP (Fcore_sub_Fitting M)) //. -by rewrite (Fcore_eq_FTcore _ _) ?(eqP typeM). -Qed. - -(* This is Peterfalvi, Theorem (8.17). *) -Theorem FT_Dade_support_partition : - [/\ (*a1*) - \pi(G) =i [pred p | [exists M : {group gT} in 'M, p \in \pi(M`_\s)]], - (*a2*) {in 'M &, forall M L, - gval L \notin M :^: G -> coprime #|M`_\s| #|L`_\s| }, - (*b*) {in 'M, forall M, #|'A1~(M)| = (#|M`_\s|.-1 * #|G : M|)%N} - & (*c*) let PG := [set 'A1~(Mi) | Mi : {group gT} in 'M^G] in - [/\ {in 'M^G &, injective (fun M => 'A1~(M))}, - all_FTtype1 -> partition PG G^# - & forall S T W W1 W2 (defW : W1 \x W2 = W), - let VG := class_support (cyclicTIset defW) G in - typeP_pair S T defW -> partition (VG |: PG) G^# /\ VG \notin PG]]. -Proof. -have defDsup M: M \in 'M -> class_support M^~~ G = 'A1~(M). - move=> maxM; rewrite class_supportEr /'A1~(M) /'A1(M) def_FTcore //. - rewrite -(eq_bigr _ (fun _ _ => bigcupJ _ _ _ _)) exchange_big /=. - apply: eq_bigr => x Ms_x; rewrite -class_supportEr. - rewrite -norm_rlcoset ?(subsetP (cent_sub _)) ?cent_FT_signalizer //=. - congr (class_support (_ :* x) G); rewrite /'R_M. - have [_ _ /(_ x Ms_x)[_ defCx _] /(_ x Ms_x)defNF]:= BGsummaryD maxM. - have [sCxM | /defNF[[_ <-]] //] := ifPn. - apply/eqP; rewrite trivg_card1 -(eqn_pmul2r (cardG_gt0 'C_M[x])). - by rewrite (sdprod_card defCx) mul1n /= (setIidPr _). -have [b [a1 a2] [/and3P[_ _ not_PG_set0] _ _]] := BGsummaryE gT. -split=> [p | M L maxM maxL /a2 | M maxM | {b a1 a2}PG]. -- apply/idP/exists_inP=> [/a1[M maxM sMp] | [M _]]. - by exists M => //; rewrite def_FTcore // pi_Msigma. - exact: piSg (subsetT _) p. -- move/(_ maxM maxL)=> coML; rewrite coprime_pi' // !def_FTcore //. - apply: sub_pgroup (pcore_pgroup _ L) => p; apply/implyP. - by rewrite implybN /= pi_Msigma // implybE -negb_and [_ && _]coML. -- by rewrite -defDsup // def_FTcore // b. -have [/subsetP sMG_M _ injMG sM_MG] := mmax_transversalP gT. -have{PG} ->: PG = [set class_support M^~~ G | M : {group gT} in 'M]. - apply/setP=> AG; apply/imsetP/imsetP=> [] [M maxM ->]. - by move/sMG_M in maxM; exists M; rewrite ?defDsup //. - have [x MG_Mx] := sM_MG M maxM. - by exists (M :^ x)%G; rewrite // defDsup ?mmaxJ ?FT_Dade1_supportJ. -have [c1 c2] := mFT_partition gT. -split=> [M H maxM maxH eq_MH | Gtype1 | S T W W1 W2 defW VG pairST]. -- apply: injMG => //; move/sMG_M in maxM; move/sMG_M in maxH. - apply/orbit_eqP/idPn => not_HG_M. - have /negP[]: ~~ [disjoint 'A1~(M) & 'A1~(H)]. - rewrite eq_MH -setI_eq0 setIid -defDsup //. - by apply: contraNneq not_PG_set0 => <-; apply: mem_imset. - rewrite -!defDsup // -setI_eq0 class_supportEr big_distrl -subset0. - apply/bigcupsP=> x /class_supportGidr <- /=; rewrite -conjIg sub_conjg conj0g. - rewrite class_supportEr big_distrr /=; apply/bigcupsP=> {x}x _. - rewrite subset0 setI_eq0 -sigma_supportJ sigma_support_disjoint ?mmaxJ //. - by rewrite (orbit_transl _ (mem_orbit _ _ _)) ?in_setT // orbit_sym. -- rewrite c1 // setD_eq0; apply/subsetP=> M maxM. - by rewrite FTtype_Fmax ?(forall_inP Gtype1). -have [[[cycW maxS _] _ _ _ _] [U_S StypeP]] := (pairST, typeP_pairW pairST). -have Stype'1 := FTtypeP_neq1 maxS StypeP. -have maxP_S: S \in TypeP_maxgroups _ by rewrite FTtype_Pmax. -have hallW1: \kappa(S).-Hall(S) W1. - have [[U1 K] /= complU1] := kappa_witness maxS. - have ntK: K :!=: 1%g by rewrite -(trivgPmax maxS complU1). - have [[defS_K _ _] [//|defS' _] _ _ _] := kappa_structure maxS complU1. - rewrite {}defS' in defS_K. - have /imsetP[x Sx defK] := of_typeP_compl_conj StypeP defS_K. - by have [_ hallK _] := complU1; rewrite defK pHallJ in hallK. -have{cycW} [[ntW1 ntW2] [cycW _ _]] := (cycTI_nontrivial cycW, cycW). -suffices defW2: 'C_(S`_\sigma)(W1) = W2. - by have [] := c2 _ _ maxP_S hallW1; rewrite defW2 /= (dprodWY defW). -have [U1 complU1] := ex_kappa_compl maxS hallW1. -have [[_ [_ _ sW2'F] _] _ _ _] := BGsummaryC maxS complU1 ntW1. -rewrite -(setIidPr sW2'F) setIA (setIidPl (Fcore_sub_Msigma maxS)). -exact: typeP_cent_core_compl StypeP. -Qed. - -(* This is Peterfalvi (8.18). Note that part (a) is not actually used later. *) -Lemma FT_Dade_support_disjoint S T : - S \in 'M -> T \in 'M -> gval T \notin S :^: G -> - [/\ (*a*) FTsupports S T = ~~ [disjoint 'A1(S) & 'A(T)] - /\ {in 'A1(S) :&: 'A(T), forall x, - ~~ ('C[x] \subset S) /\ 'C[x] \subset T}, - (*b*) [exists x, FTsupports S (T :^ x)] = ~~ [disjoint 'A1~(S) & 'A~(T)] - & (*c*) [disjoint 'A1~(S) & 'A~(T)] \/ [disjoint 'A1~(T) & 'A~(S)]]. -Proof. -move: S T; pose NC S T := gval T \notin S :^: G. -have part_a2 S T (maxS : S \in 'M) (maxT : T \in 'M) (ncST : NC S T) : - {in 'A1(S) :&: 'A(T), forall x, ~~ ('C[x] \subset S) /\ 'C[x] \subset T}. -- move=> x /setIP[/setD1P[ntx Ss_x] ATx]. - have coxTs: coprime #[x] #|T`_\s|. - apply: (coprime_dvdl (order_dvdG Ss_x)). - by have [_ ->] := FT_Dade_support_partition. - have [z /setD1P[ntz Ts_z] /setD1P[_ /setIP[Tn_x czx]]] := bigcupP ATx. - set n := FTtype T != 1%N in Tn_x. - have typeT: FTtype T == n.+1. - have notTs_x: x \notin T`_\s. - apply: contra ntx => Ts_x. - by rewrite -order_eq1 -dvdn1 -(eqnP coxTs) dvdn_gcd dvdnn order_dvdG. - apply: contraLR ATx => typeT; rewrite FTsupp_eq1 // ?inE ?ntx //. - move: (FTtype_range T) typeT; rewrite -mem_iota /n. - by do 5!case/predU1P=> [-> // | ]. - have defTs: T`_\s = T`_\F. - by apply/esym/Fcore_eq_FTcore; rewrite // (eqP typeT); case n. - have [U Ux defTn]: exists2 U : {group gT}, x \in U & T`_\F ><| U = T^`(n)%g. - have [[U K] /= complU] := kappa_witness maxT. - have defTn: T`_\s ><| U = T^`(n)%g. - by rewrite def_FTcore // (sdprod_FTder maxT complU). - have nsTsTn: T`_\s <| T^`(n)%g by case/sdprod_context: defTn. - have [sTsTn nTsTn] := andP nsTsTn. - have hallTs: \pi(T`_\s).-Hall(T^`(n)%g) T`_\s. - by rewrite defTs (pHall_subl _ (der_sub n T) (Fcore_Hall T)) //= -defTs. - have hallU: \pi(T`_\s)^'.-Hall(T^`(n)%g) U. - by apply/sdprod_Hall_pcoreP; rewrite /= (normal_Hall_pcore hallTs). - have solTn: solvable T^`(n)%g := solvableS (der_sub n T) (mmax_sol maxT). - rewrite coprime_sym coprime_pi' // in coxTs. - have [|y Tn_y] := Hall_subJ solTn hallU _ coxTs; rewrite cycle_subG //. - exists (U :^ y)%G; rewrite // -defTs. - by rewrite -(normsP nTsTn y Tn_y) -sdprodJ defTn conjGid. - have uniqCx: 'M('C[x]) = [set T]. - have:= FTtypeI_II_facts maxT typeT defTn; rewrite !ltnS leq_b1 -cent_set1. - case=> _ -> //; first by rewrite -cards_eq0 cards1. - by rewrite sub1set !inE ntx. - by apply/trivgPn; exists z; rewrite //= -defTs inE Ts_z cent_set1 cent1C. - split; last by case/mem_uniq_mmax: uniqCx. - by apply: contra ncST => /(eq_uniq_mmax uniqCx maxS)->; apply: orbit_refl. -have part_a1 S T (maxS : S \in 'M) (maxT : T \in 'M) (ncST : NC S T) : - FTsupports S T = ~~ [disjoint 'A1(S) & 'A(T)]. -- apply/existsP/pred0Pn=> [[x /and3P[ASx not_sCxS sCxT]] | [x /andP[A1Sx Atx]]]. - have [_ [/subsetP]] := FTsupport_facts maxS; set D := finset _. - have Dx: x \in D by rewrite !inE ASx. - move=> /(_ x Dx) A1x /(_ x Dx)uniqCx /(_ x Dx)[_ _ /setDP[ATx _] _]. - by rewrite (eq_uniq_mmax uniqCx maxT sCxT); exists x; apply/andP. - exists x; rewrite (subsetP (FTsupp1_sub maxS)) //=. - by apply/andP/part_a2=> //; apply/setIP. -have part_b S T (maxS : S \in 'M) (maxT : T \in 'M) (ncST : NC S T) : - [exists x, FTsupports S (T :^ x)] = ~~ [disjoint 'A1~(S) & 'A~(T)]. -- apply/existsP/pred0Pn=> [[x] | [y /andP[/= A1GSy AGTy]]]. - rewrite part_a1 ?mmaxJ // => [/pred0Pn[y /andP/=[A1Sy ATyx]]|]; last first. - by rewrite /NC -(rcoset_id (in_setT x)) orbit_rcoset. - rewrite FTsuppJ mem_conjg in ATyx; exists (y ^ x^-1); apply/andP; split. - by apply/bigcupP; exists y => //; rewrite mem_imset2 ?rcoset_refl ?inE. - apply/bigcupP; exists (y ^ x^-1) => //. - by rewrite mem_class_support ?rcoset_refl. - have{AGTy} [x2 ATx2 x2R_yG] := bigcupP AGTy. - have [sCx2T | not_sCx2T] := boolP ('C[x2] \subset T); last first. - have [_ _ _ [injA1G pGI pGP]] := FT_Dade_support_partition. - have{pGI pGP} tiA1g: trivIset [set 'A1~(M) | M : {group gT} in 'M^G]. - case: FTtypeP_pair_cases => [/forall_inP/pGI/and3P[] // | [M [L]]]. - by case=> _ W W1 W2 defW1 /pGP[]/and3P[_ /(trivIsetS (subsetUr _ _))]. - have [_ _ injMG sM_MG] := mmax_transversalP gT. - have [_ [sDA1T _] _] := FTsupport_facts maxT. - have [[z1 maxSz] [z2 maxTz]] := (sM_MG S maxS, sM_MG T maxT). - case/imsetP: ncST; exists (z1 * z2^-1)%g; first by rewrite inE. - rewrite conjsgM; apply/(canRL (conjsgK _))/congr_group/injA1G=> //. - apply/eqP/idPn=> /(trivIsetP tiA1g)/pred0Pn[]; try exact: mem_imset. - exists y; rewrite !FT_Dade1_supportJ /= A1GSy andbT. - by apply/bigcupP; exists x2; rewrite // (subsetP sDA1T) ?inE ?ATx2. - have{x2R_yG} /imsetP[z _ def_y]: y \in x2 ^: G. - by rewrite /'R_T {}sCx2T mul1g class_support_set1l in x2R_yG. - have{A1GSy} [x1 A1Sx1] := bigcupP A1GSy; rewrite {y}def_y -mem_conjgV. - rewrite class_supportGidr ?inE {z}//. - case/imset2P=> _ z /rcosetP[y Hy ->] _ def_x2. - exists z^-1%g; rewrite part_a1 ?mmaxJ //; last first. - by rewrite /NC (orbit_transl _ (mem_orbit _ _ _)) ?inE. - apply/pred0Pn; exists x1; rewrite /= A1Sx1 FTsuppJ mem_conjgV; apply/bigcupP. - pose ddS := FT_Dade1_hyp maxS; have [/andP[sA1S _] _ notA1_1 _ _] := ddS. - have [ntx1 Sx1] := (memPn notA1_1 _ A1Sx1, subsetP sA1S _ A1Sx1). - have [coHS defCx1] := (Dade_coprime ddS A1Sx1 A1Sx1, Dade_sdprod ddS A1Sx1). - rewrite def_FTsignalizer1 // in coHS defCx1. - have[u Ts_u /setD1P[_ cT'ux2]] := bigcupP ATx2. - exists u => {Ts_u}//; rewrite 2!inE -(conj1g z) (can_eq (conjgK z)) ntx1. - suffices{u cT'ux2} ->: x1 = (y * x1).`_(\pi('R_S x1)^'). - by rewrite -consttJ -def_x2 groupX. - have /setIP[_ /cent1P cx1y]: y \in 'C_G[x1]. - by case/sdprod_context: defCx1 => /andP[/subsetP->]. - rewrite consttM // (constt1P _) ?p_eltNK ?(mem_p_elt (pgroup_pi _)) // mul1g. - have piR'_Cx1: \pi('R_S x1)^'.-group 'C_S[x1] by rewrite coprime_pi' in coHS. - by rewrite constt_p_elt ?(mem_p_elt piR'_Cx1) // inE Sx1 cent1id. -move=> S T maxS maxT ncST; split; first split; auto. -apply/orP/idPn; rewrite negb_or -part_b // => /andP[suppST /negP[]]. -without loss{suppST} suppST: T maxT ncST / FTsupports S T. - move=> IH; case/existsP: suppST => x /IH {IH}. - rewrite FT_Dade1_supportJ (orbit_transl _ (mem_orbit _ _ _)) ?in_setT //. - by rewrite mmaxJ => ->. -have{suppST} [y /and3P[ASy not_sCyS sCyT]] := existsP suppST. -have Dy: y \in [set z in 'A0(S) | ~~ ('C[z] \subset S)] by rewrite !inE ASy. -have [_ [_ /(_ y Dy) uCy] /(_ y Dy)[_ coTcS _ typeT]] := FTsupport_facts maxS. -rewrite -mem_iota -(eq_uniq_mmax uCy maxT sCyT) !inE in coTcS typeT. -apply/negbNE; rewrite -part_b /NC 1?orbit_sym // negb_exists. -apply/forallP=> x; rewrite part_a1 ?mmaxJ ?negbK //; last first. - by rewrite /NC (orbit_transl _ (mem_orbit _ _ _)) ?in_setT // orbit_sym. -rewrite -setI_eq0 -subset0 FTsuppJ -bigcupJ big_distrr; apply/bigcupsP=> z Sxz. -rewrite conjD1g /= -setDIl coprime_TIg ?setDv //= cardJg. -rewrite -(Fcore_eq_FTcore maxT _) ?inE ?orbA; last by have [->] := typeT. -by rewrite (coprimegS _ (coTcS z _)) ?(subsetP (FTsupp1_sub0 _)) ?setSI ?gFsub. -Qed. - -(* A corollary to the above, which Peterfalvi derives from (8.17a) (i.e., *) -(* FT_Dade_support_partition) in the proof of (12.16). *) -Lemma FT_Dade1_support_disjoint S T : - S \in 'M -> T \in 'M -> gval T \notin S :^: G -> [disjoint 'A1~(S) & 'A1~(T)]. -Proof. -move=> maxS maxT /FT_Dade_support_disjoint[] // _ _ tiA1A. -without loss{tiA1A maxT}: S T maxS / [disjoint 'A1~(T) & 'A~(S)]. - by move=> IH_ST; case: tiA1A => /IH_ST; first rewrite disjoint_sym; apply. -by rewrite disjoint_sym; apply/disjoint_trans/FT_Dade_supportS/FTsupp1_sub. -Qed. - -End Eight. - -Notation FT_Dade0 maxM := (Dade (FT_Dade0_hyp maxM)). -Notation FT_Dade maxM := (Dade (FT_Dade_hyp maxM)). -Notation FT_Dade1 maxM := (Dade (FT_Dade1_hyp maxM)). -Notation FT_DadeF maxM := (Dade (FT_DadeF_hyp maxM)). - diff --git a/mathcomp/odd_order/PFsection9.v b/mathcomp/odd_order/PFsection9.v deleted file mode 100644 index d8ec417..0000000 --- a/mathcomp/odd_order/PFsection9.v +++ /dev/null @@ -1,2211 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div choice. -From mathcomp -Require Import fintype tuple finfun bigop prime binomial ssralg poly finset. -From mathcomp -Require Import fingroup morphism perm automorphism quotient action finalg zmodp. -From mathcomp -Require Import gfunctor gproduct cyclic commutator center gseries nilpotent. -From mathcomp -Require Import pgroup sylow hall abelian maximal frobenius. -From mathcomp -Require Import matrix mxalgebra mxrepresentation mxabelem vector. -From mathcomp -Require Import BGsection1 BGsection3 BGsection7 BGsection15 BGsection16. -From mathcomp -Require Import algC classfun character inertia vcharacter. -From mathcomp -Require Import PFsection1 PFsection2 PFsection3 PFsection4. -From mathcomp -Require Import PFsection5 PFsection6 PFsection8. - -(******************************************************************************) -(* This file covers Peterfalvi, Section 9: On the maximal subgroups of Types *) -(* II, III and IV. For defW : W1 \x W2 = W, MtypeP : of_typeP M U defW, and *) -(* H := M`_\F we define : *) -(* Ptype_Fcore_kernel MtypeP == a maximal normal subgroup of M contained *) -(* (locally) H0 in H and containing 'C_H(U), provided M is *) -(* not a maximal subgroup of type V. *) -(* Ptype_Fcore_kernel MtypeP == the stabiliser of Hbar := H / H0 in U; this *) -(* (locally to this file) C is locked for performance reasons. *) -(* typeP_Galois MtypeP <=> U acts irreducibly on Hbar; this implies *) -(* that M / H0C is isomorphic to a Galois group *) -(* acting on the semidirect product of the *) -(* additive group of a finite field with a *) -(* a subgroup of its multiplicative group. *) -(* --> This predicate reflects alternative (b) in Peterfalvi (9.7). *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Import GroupScope GRing.Theory FinRing.Theory. - -Section Nine. - -Variable gT : minSimpleOddGroupType. -Local Notation G := (TheMinSimpleOddGroup gT). -Implicit Types (p q : nat) (x y z : gT). -Implicit Types H K L N P Q R S T U V W : {group gT}. - -(* Peterfalvi (9.1) is covered by BGsection3.Frobenius_Wielandt_fixpoint. *) - -(* These assumptions correspond to Peterfalvi, Hypothesis (9.2). *) - -Variables M U W W1 W2 : {group gT}. -Hypotheses (maxM : M \in 'M) (defW : W1 \x W2 = W) (MtypeP: of_typeP M U defW). -Hypothesis notMtype5 : FTtype M != 5. - -Local Notation "` 'M'" := (gval M) (at level 0, only parsing) : group_scope. -Local Notation "` 'U'" := (gval U) (at level 0, only parsing) : group_scope. -Local Notation "` 'W1'" := (gval W1) (at level 0, only parsing) : group_scope. -Local Notation H := `M`_\F%G. -Local Notation "` 'H'" := `M`_\F (at level 0) : group_scope. -Local Notation "` 'W2'" := (gval W2) (at level 0, only parsing) : group_scope. -Local Notation HU := M^`(1)%G. -Local Notation "` 'HU'" := `M^`(1) (at level 0) : group_scope. -Local Notation U' := U^`(1)%G. -Local Notation "` 'U''" := `U^`(1) (at level 0) : group_scope. - -Let q := #|W1|. - -Let defM : HU ><| W1 = M. Proof. by have [[]] := MtypeP. Qed. -Let defHU : H ><| U = HU. Proof. by have [_ []] := MtypeP. Qed. -Let nUW1 : W1 \subset 'N(U). Proof. by have [_ []] := MtypeP. Qed. -Let cHU' : U' \subset 'C(H). Proof. by have [_ []] := typeP_context MtypeP. Qed. - -Let notMtype1 : FTtype M != 1%N. Proof. exact: FTtypeP_neq1 MtypeP. Qed. - -Local Notation Mtype24 := (compl_of_typeII_IV maxM MtypeP notMtype5). -Let ntU : U :!=: 1. Proof. by have [] := Mtype24. Qed. -Let pr_q : prime q. Proof. by have [] := Mtype24. Qed. -Let ntW2 : W2 :!=: 1. Proof. by have [_ _ _ []] := MtypeP. Qed. -Let sW2H : W2 \subset H. Proof. by have [_ _ _ []] := MtypeP. Qed. -Let defW2 : 'C_H(W1) = W2. Proof. exact: typeP_cent_core_compl MtypeP. Qed. - -Lemma Ptype_Fcore_sdprod : H ><| (U <*> W1) = M. -Proof. -have [_ /= sW1M mulHUW1 _ tiHUW1] := sdprod_context defM. -have [/= /andP[sHHU _] sUHU mulHU nHU tiHU] := sdprod_context defHU. -rewrite sdprodE /= norm_joinEr // ?mulgA ?mulHU //. - by rewrite mulG_subG nHU (subset_trans sW1M) ?gFnorm. -rewrite setIC -(setIidPr sHHU) setIA -group_modl //. -by rewrite (setIC W1) tiHUW1 mulg1 setIC tiHU. -Qed. -Local Notation defHUW1 := Ptype_Fcore_sdprod. - -Lemma Ptype_Fcore_coprime : coprime #|H| #|U <*> W1|. -Proof. -by rewrite (coprime_sdprod_Hall_l defHUW1) ?(pHall_Hall (Fcore_Hall M)). -Qed. -Let coH_UW1 := Ptype_Fcore_coprime. -Let coHU : coprime #|H| #|U|. -Proof. exact: coprimegS (joing_subl U W1) coH_UW1. Qed. - -Let not_cHU : ~~ (U \subset 'C(H)). -Proof. by have [_ [_ ->]] := typeP_context MtypeP. Qed. - -Lemma Ptype_compl_Frobenius : [Frobenius U <*> W1 = U ><| W1]. -Proof. -have [[_ _ ntW1 _] _ _ [_ _ _ _ prHU_W1] _] := MtypeP. -have [[_ _ _ tiHUW1] [_ sUHU _ _ tiHU]] := (sdprodP defM, sdprod_context defHU). -apply/Frobenius_semiregularP=> // [|x /prHU_W1 defCx]. - by rewrite sdprodEY //; apply/trivgP; rewrite -tiHUW1 setSI. -by apply/trivgP; rewrite -tiHU /= -{1}(setIidPr sUHU) setIAC defCx setSI. -Qed. -Local Notation frobUW1 := Ptype_compl_Frobenius. - -Let nilH : nilpotent H. Proof. exact: Fcore_nil. Qed. -Let solH : solvable H. Proof. exact: nilpotent_sol. Qed. - -(* This is Peterfalvi (9.3). *) -Lemma typeII_IV_core (p := #|W2|) : - if FTtype M == 2 then 'C_H(U) = 1 /\ #|H| = (#|W2| ^ q)%N - else [/\ prime p, 'C_H(U <*> W1) = 1 & #|H| = (p ^ q * #|'C_H(U)|)%N]. -Proof. -have [_ _ nHUW1 _] := sdprodP defHUW1. -have /= [oH _ oH1] := Frobenius_Wielandt_fixpoint frobUW1 nHUW1 coH_UW1 solH. -have [Mtype2 {oH}| notMtype2 {oH1}] := boolP (FTtype M == 2). - suffices regHU: 'C_H(U) = 1 by rewrite -defW2 oH1. - have [_ _ _ HUtypeF defHUF] := compl_of_typeII maxM MtypeP Mtype2. - have [_ _ [U0 [sU0U _]]] := HUtypeF; rewrite {}defHUF => frobHU0. - have /set0Pn[x U0x]: U0^# != set0. - by rewrite setD_eq0 subG1; case/Frobenius_context: frobHU0. - apply/trivgP; rewrite -(Frobenius_reg_ker frobHU0 U0x) setIS // -cent_cycle. - by rewrite centS // cycle_subG (subsetP sU0U) //; case/setD1P: U0x. -have p_pr: prime p. - have [S pairMS [xdefW [U_S StypeP]]] := FTtypeP_pair_witness maxM MtypeP. - have [[_ _ maxS] _] := pairMS; rewrite {1}(negPf notMtype2) /= => Stype2 _ _. - by have [[]] := compl_of_typeII maxS StypeP Stype2. -rewrite -/q -/p centY setICA defW2 setIC in oH *. -suffices regW2U: 'C_W2(U) = 1 by rewrite -oH regW2U cards1 exp1n mul1n. -apply: prime_TIg => //=; apply: contra not_cHU => /setIidPl cUW2. -rewrite centsC (sameP setIidPl eqP) eqEcard subsetIl. -by rewrite -(@leq_pmul2l (p ^ q)) -?oH ?cUW2 //= expn_gt0 cardG_gt0. -Qed. - -(* Existential witnesses for Peterfalvi (9.4). *) -Definition Ptype_Fcore_kernel of of_typeP M U defW := - odflt 1%G [pick H0 : {group gT} | chief_factor M H0 H & 'C_H(U) \subset H0]. -Let H0 := (Ptype_Fcore_kernel MtypeP). -Local Notation "` 'H0'" := (gval H0) (at level 0, only parsing) : group_scope. -Local Notation Hbar := (H / `H0)%G. -Local Notation "` 'Hbar'" := (`H / `H0)%g (at level 0) : group_scope. -Let p := pdiv #|Hbar|. - -(* This corresponds to Peterfalvi (9.4). *) -Lemma Ptype_Fcore_kernel_exists : chief_factor M H0 H /\ 'C_H(U) \subset H0. -Proof. -pose S := <<class_support 'C_H(U) H>> . -suffices [H1 maxH sCH1]: {H1 : {group gT} | maxnormal H1 H M & S \subset H1}. - apply/andP; rewrite /H0 /Ptype_Fcore_kernel; case: pickP => // /(_ H1)/idP[]. - rewrite /chief_factor maxH Fcore_normal (subset_trans _ sCH1) ?sub_gen //. - exact: sub_class_support. -apply/maxgroup_exists/andP; split. - have snCH: 'C_H(U) <|<| H by rewrite nilpotent_subnormal ?subsetIl. - by have [/setIidPl/idPn[] | // ] := subnormalEsupport snCH; rewrite centsC. -have [_ {3}<- nHUW1 _] := (sdprodP defHUW1). -rewrite norms_gen // mulG_subG class_support_norm norms_class_support //. -by rewrite normsI ?norms_cent // join_subG normG. -Qed. - -Let chiefH0 : chief_factor M H0 H. -Proof. by have [] := Ptype_Fcore_kernel_exists. Qed. -Let ltH0H : H0 \proper H. -Proof. by case/andP: chiefH0 => /maxgroupp/andP[]. Qed. -Let nH0M : M \subset 'N(H0). -Proof. by case/andP: chiefH0 => /maxgroupp/andP[]. Qed. -Let sH0H : H0 \subset H. Proof. exact: proper_sub ltH0H. Qed. -Let nsH0M : H0 <| M. Proof. by rewrite /normal (subset_trans sH0H) ?gFsub. Qed. -Let nsH0H : H0 <| H. Proof. by rewrite (normalS _ (Fcore_sub _)). Qed. -Let minHbar : minnormal Hbar (M / H0). -Proof. exact: chief_factor_minnormal. Qed. -Let ntHbar : Hbar :!=: 1. Proof. by case/mingroupp/andP: minHbar. Qed. -Let solHbar: solvable Hbar. Proof. by rewrite quotient_sol. Qed. -Let abelHbar : p.-abelem Hbar. -Proof. by have [] := minnormal_solvable minHbar _ solHbar. Qed. -Let p_pr : prime p. Proof. by have [/pgroup_pdiv[]] := and3P abelHbar. Qed. -Let abHbar : abelian Hbar. Proof. exact: abelem_abelian abelHbar. Qed. - -(* This is Peterfalvi, Hypothesis (9.5). *) -Fact Ptype_Fcompl_kernel_key : unit. Proof. by []. Qed. -Definition Ptype_Fcompl_kernel := - locked_with Ptype_Fcompl_kernel_key 'C_U(Hbar | 'Q)%G. -Local Notation C := Ptype_Fcompl_kernel. -Local Notation "` 'C'" := (gval C) (at level 0, only parsing) : group_scope. -Local Notation Ubar := (U / `C)%G. -Local Notation "` 'Ubar'" := (`U / `C)%g (at level 0) : group_scope. -Local Notation W1bar := (W1 / `H0)%G. -Local Notation "` 'W1bar'" := (`W1 / `H0)%g (at level 0) : group_scope. -Local Notation W2bar := 'C_Hbar(`W1bar)%G. -Local Notation "` 'W2bar'" := 'C_`Hbar(`W1bar) (at level 0) : group_scope. -Let c := #|C|. -Let u := #|Ubar|. -Local Notation tau := (FT_Dade0 maxM). -Local Notation "chi ^\tau" := (tau chi). -Let calX := Iirr_kerD M^`(1) H 1. -Let calS := seqIndD M^`(1) M M`_\F 1. -Let X_ Y := Iirr_kerD M^`(1) H Y. -Let S_ Y := seqIndD M^`(1) M M`_\F Y. - -Local Notation inMb := (coset (gval H0)). - -Local Notation H0C := (`H0 <*> `C)%G. -Local Notation "` 'H0C'" := (`H0 <*> `C) (at level 0) : group_scope. -Local Notation HC := (`H <*> `C)%G. -Local Notation "` 'HC'" := (`H <*> `C) (at level 0) : group_scope. -Local Notation H0U' := (`H0 <*> `U')%G. -Local Notation "` 'H0U''" := (gval H0 <*> `U')%G (at level 0) : group_scope. -Local Notation H0C' := (`H0 <*> `C^`(1)%g)%G. -Local Notation "` 'H0C''" := (`H0 <*> `C^`(1)) (at level 0) : group_scope. - -Let defW2bar : W2bar :=: W2 / H0. -Proof. -rewrite -defW2 coprime_quotient_cent ?(subset_trans _ nH0M) //. - by have [_ /mulG_sub[]] := sdprodP defM. -exact: coprimegS (joing_subr _ _) coH_UW1. -Qed. - -Let sCU : C \subset U. Proof. by rewrite [C]unlock subsetIl. Qed. - -Let nsCUW1 : C <| U <*> W1. -Proof. -have [_ sUW1M _ nHUW1 _] := sdprod_context defHUW1. -rewrite /normal [C]unlock subIset ?joing_subl // normsI //. - by rewrite join_subG normG. -rewrite /= astabQ norm_quotient_pre ?norms_cent ?quotient_norms //. -exact: subset_trans sUW1M nH0M. -Qed. - -Lemma Ptype_Fcore_extensions_normal : - [/\ H0C <| M, HC <| M, H0U' <| M & H0C' <| M]. -Proof. -have [nsHUM sW1M /mulG_sub[sHUM _] nHUW1 tiHUW1] := sdprod_context defM. -have [nsHHU sUHU /mulG_sub[sHHU _] nHU tiHU] := sdprod_context defHU. -have [sHM sUM] := (subset_trans sHHU sHUM, subset_trans sUHU sHUM). -have sCM: C \subset M := subset_trans sCU sUM. -have sH0C_M: H0C \subset M by rewrite /normal join_subG (subset_trans sH0H). -have [nH0C nH0_H0C] := (subset_trans sCM nH0M, subset_trans sH0C_M nH0M). -have nsH0C: H0C <| M. - rewrite /normal sH0C_M -{1}defM sdprodEY //= -defHU sdprodEY //= -joingA. - rewrite join_subG andbC normsY ?(normal_norm nsCUW1) //=; last first. - by rewrite (subset_trans _ nH0M) // join_subG sUM. - rewrite -quotientYK // -{1}(quotientGK nsH0H) morphpre_norms //= [C]unlock. - by rewrite cents_norm // centsC -quotient_astabQ quotientS ?subsetIr. -split=> //; first by rewrite /= -{1}(joing_idPl sH0H) -joingA normalY ?gFnormal. - rewrite normalY // /normal gFsub_trans //=. - rewrite -defM sdprodEY //= -defHU sdprodEY //=. - by rewrite !join_subG gFnorm cents_norm ?gFnorm_trans // centsC. -suffices ->: H0C' :=: H0 <*> H0C^`(1) by rewrite normalY ?gFnormal_trans. -by rewrite /= -!quotientYK ?gFsub_trans ?quotient_der ?subsetIl //= cosetpreK. -Qed. -Local Notation nsH0xx_M := Ptype_Fcore_extensions_normal. - -Let Du : u = #|HU : HC|. -Proof. -have nCU := subset_trans (joing_subl U W1) (normal_norm nsCUW1). -by rewrite -(index_sdprodr defHU) -?card_quotient. -Qed. - -(* This is Peterfalvi (9.6). *) -Lemma Ptype_Fcore_factor_facts : - [/\ C :!=: U, #|W2bar| = p & #|Hbar| = p ^ q]%N. -Proof. -have [defUW1 _ ntW1 _ _] := Frobenius_context Ptype_compl_Frobenius. -have coHW1: coprime #|H| #|W1| := coprimegS (joing_subr U W1) coH_UW1. -have [_ sUW1M _ nHUW1 _] := sdprod_context defHUW1. -have nH0UW1 := subset_trans sUW1M nH0M; have [nH0U nH0W1] := joing_subP nH0UW1. -have regUHb: 'C_Hbar(U / H0) = 1. - have [_ sCH0] := Ptype_Fcore_kernel_exists. - by rewrite -coprime_quotient_cent ?(nilpotent_sol nilH) ?quotientS1. -have ->: C != U. - apply: contraNneq ntHbar => defU; rewrite -subG1 -regUHb subsetIidl centsC. - by rewrite -defU [C]unlock -quotient_astabQ quotientS ?subsetIr. -have frobUW1b: [Frobenius U <*> W1 / H0 = (U / H0) ><| W1bar]. - have tiH0UW1 := coprime_TIg (coprimeSg sH0H coH_UW1). - have /isomP[inj_f im_f] := quotient_isom nH0UW1 tiH0UW1. - have:= injm_Frobenius (subxx _) inj_f frobUW1. - by rewrite im_f !morphim_restrm !(setIidPr _) ?joing_subl ?joing_subr. -have{frobUW1b} oHbar: #|Hbar| = (#|W2bar| ^ q)%N. - have nHbUW1 : U <*> W1 / H0 \subset 'N(Hbar) := quotient_norms H0 nHUW1. - have coHbUW1 : coprime #|Hbar| #|U <*> W1 / H0| by apply: coprime_morph. - have [//|_ _ -> //] := Frobenius_Wielandt_fixpoint frobUW1b nHbUW1 coHbUW1 _. - by rewrite -(card_isog (quotient_isog _ _)) // coprime_TIg ?(coprimeSg sH0H). -have abelW2bar: p.-abelem W2bar := abelemS (subsetIl _ _) abelHbar. -rewrite -(part_pnat_id (abelem_pgroup abelW2bar)) p_part in oHbar *. -suffices /eqP cycW2bar: logn p #|W2bar| == 1%N by rewrite oHbar cycW2bar. -have cycW2: cyclic W2 by have [_ _ _ []] := MtypeP. -rewrite eqn_leq -abelem_cyclic //= -/W2bar {1}defW2bar quotient_cyclic //=. -rewrite lt0n; apply: contraNneq ntHbar => W2bar1. -by rewrite trivg_card1 oHbar W2bar1 exp1n. -Qed. - -Lemma def_Ptype_factor_prime : prime #|W2| -> p = #|W2|. -Proof. -move=> prW2; suffices: p \in \pi(W2) by rewrite !(primes_prime, inE) // => /eqP. -rewrite mem_primes p_pr cardG_gt0; have [_ <- _] := Ptype_Fcore_factor_facts. -by rewrite defW2bar dvdn_quotient. -Qed. - -(* The first assertion of (9.4)(b) (the rest is subsumed by (9.6)). *) -Lemma typeIII_IV_core_prime : FTtype M != 2 -> p = #|W2|. -Proof. -by have:= typeII_IV_core => /=; case: ifP => // _ [/def_Ptype_factor_prime]. -Qed. - -Let frobUW1c : [Frobenius U <*> W1 / C = Ubar ><| W1 / C]. -Proof. -apply: Frobenius_quotient frobUW1 _ nsCUW1 _. - by apply: nilpotent_sol; have [_ []] := MtypeP. -by have [] := Ptype_Fcore_factor_facts; rewrite eqEsubset sCU. -Qed. - -Definition typeP_Galois := acts_irreducibly U Hbar 'Q. - -(* This is Peterfalvi (9.7)(a). *) -Lemma typeP_Galois_Pn : - ~~ typeP_Galois -> - {H1 : {group coset_of H0} | - [/\ #|H1| = p, U / H0 \subset 'N(H1), [acts U, on H1 | 'Q], - \big[dprod/1]_(w in W1bar) H1 :^ w = Hbar - & let a := #|U : 'C_U(H1 | 'Q)| in - [/\ a > 1, a %| p.-1, cyclic (U / 'C_U(H1 | 'Q)) - & exists V : {group 'rV['Z_a]_q.-1}, Ubar \isog V]]}. -Proof. -have [_ sUW1M defHUW1 nHUW1 _] := sdprod_context defHUW1. -have [nHU nHW1] := joing_subP nHUW1. -have nH0UW1 := subset_trans sUW1M nH0M; have [nH0U nH0W1] := joing_subP nH0UW1. -rewrite /typeP_Galois acts_irrQ //= => not_minHbarU. -have [H1 minH1 sH1Hb]: {H1 | minnormal (gval H1) (U / H0) & H1 \subset Hbar}. - by apply: mingroup_exists; rewrite ntHbar quotient_norms. -exists H1; have [defH1 | ltH1H] := eqVproper sH1Hb. - by rewrite -defH1 minH1 in not_minHbarU. -have [/andP[ntH1 nH1U] _] := mingroupP minH1. -have actsUH1: [acts U, on H1 | 'Q]. - by rewrite -(cosetpreK H1) actsQ ?norm_quotient_pre. -have [nH0H [neqCU _ oHbar]] := (normal_norm nsH0H, Ptype_Fcore_factor_facts). -have nUW1b: W1bar \subset 'N(U / H0) by apply: quotient_norms. -have oW1b: #|W1bar| = q. - rewrite -(card_isog (quotient_isog _ _)) // coprime_TIg //. - by rewrite (coprimeSg sH0H) // (coprimegS (joing_subr U W1)). -have [oH1 defHbar]: #|H1| = p /\ \big[dprod/1]_(w in W1bar) H1 :^ w = Hbar. - have nHbUW1: U <*> W1 / H0 \subset 'N(Hbar) by apply: quotient_norms. - pose rUW1 := abelem_repr abelHbar ntHbar nHbUW1. - have irrUW1: mx_irreducible rUW1. - apply/abelem_mx_irrP/mingroupP; split=> [|H2]; first by rewrite ntHbar. - case/andP=> ntH2 nH2UW1 sH2H; case/mingroupP: minHbar => _; apply=> //. - by rewrite ntH2 -defHUW1 quotientMl // mulG_subG sub_abelian_norm. - have nsUUW1: U / H0 <| U <*> W1 / H0 by rewrite quotient_normal // normalYl. - pose rU := subg_repr rUW1 (normal_sub nsUUW1). - pose V1 := rowg_mx (abelem_rV abelHbar ntHbar @* H1). - have simV1: mxsimple rU V1 by apply/mxsimple_abelem_subg/mxsimple_abelemGP. - have [W0 /subsetP sW01 [sumW0 dxW0]] := Clifford_basis irrUW1 simV1. - have def_q: q = (#|W0| * \rank V1)%N. - transitivity (\rank (\sum_(w in W0) V1 *m rUW1 w))%R. - by rewrite sumW0 mxrank1 /= (dim_abelemE abelHbar) // oHbar pfactorK. - rewrite (mxdirectP dxW0) -sum_nat_const; apply: eq_bigr => x /sW01/= Wx. - by rewrite mxrankMfree ?row_free_unit ?repr_mx_unit. - have oH1: #|H1| = (p ^ \rank V1)%N. - by rewrite -{1}(card_Fp p_pr) -card_rowg rowg_mxK card_injm ?abelem_rV_injm. - have oW0: #|W0| = q. - apply/prime_nt_dvdP=> //; last by rewrite def_q dvdn_mulr. - apply: contraTneq (proper_card ltH1H) => trivW0. - by rewrite oHbar def_q trivW0 mul1n -oH1 ltnn. - have q_gt0 := prime_gt0 pr_q. - rewrite oH1 -(mulKn (\rank V1) q_gt0) -{1}oW0 -def_q divnn q_gt0. - have defHbar: \big[dprod/1]_(w in W0) H1 :^ w = Hbar. - have inj_rV_Hbar := rVabelem_injm abelHbar ntHbar. - have/(injm_bigdprod _ inj_rV_Hbar)/= := bigdprod_rowg sumW0 dxW0. - rewrite sub_im_abelem_rV rowg1 im_rVabelem => <- //=; apply: eq_bigr => w. - by move/sW01=> Ww; rewrite abelem_rowgJ ?rowg_mxK ?abelem_rV_mK. - have injW0: {in W0 &, injective (fun w => H1 :^ w)}. - move=> x y Wx Wy /= eq_Hxy; apply: contraNeq ntH1 => neq_xy. - rewrite -(conjsg_eq1 _ x) -[H1 :^ x]setIid {1}eq_Hxy; apply/eqP. - rewrite (bigD1 y) // (bigD1 x) /= ?Wx // dprodA in defHbar. - by case/dprodP: defHbar => [[_ _ /dprodP[_ _ _ ->] _]]. - have defH1W0: [set H1 :^ w | w in W0] = [set H1 :^ w | w in W1 / H0]. - apply/eqP; rewrite eqEcard (card_in_imset injW0) oW0 -oW1b leq_imset_card. - rewrite andbT; apply/subsetP=> _ /imsetP[w /sW01/= Ww ->]. - move: Ww; rewrite norm_joinEr ?quotientMl // => /mulsgP[x w1 Ux Ww1 ->]. - by rewrite conjsgM (normsP nH1U) // mem_imset. - have injW1: {in W1 / H0 &, injective (fun w => H1 :^ w)}. - by apply/imset_injP; rewrite -defH1W0 (card_in_imset injW0) oW0 oW1b. - by rewrite -(big_imset id injW1) -defH1W0 big_imset. -split=> //; set a := #|_ : _|; pose q1 := #|(W1 / H0)^#|. -have a_gt1: a > 1. - rewrite indexg_gt1 subsetIidl /= astabQ -sub_quotient_pre //. - apply: contra neqCU => cH1U; rewrite [C]unlock (sameP eqP setIidPl) /= astabQ. - rewrite -sub_quotient_pre // -(bigdprodWY defHbar) cent_gen centsC. - by apply/bigcupsP=> w Ww; rewrite centsC centJ -(normsP nUW1b w) ?conjSg. -have Wb1: 1 \in W1bar := group1 _. -have ->: q.-1 = q1 by rewrite -oW1b (cardsD1 1) Wb1. -have /cyclicP[h defH1]: cyclic H1 by rewrite prime_cyclic ?oH1. -have o_h: #[h] = p by rewrite defH1 in oH1. -have inj_Zp_h w := injm_Zp_unitm (h ^ w). -pose phi w := invm (inj_Zp_h w) \o restr_perm <[h ^ w]> \o actperm 'Q. -have dU w: w \in W1bar -> {subset U <= 'dom (phi w)}. - move=> Ww x Ux; have Qx := subsetP (acts_dom actsUH1) x Ux. - rewrite inE Qx /= im_Zp_unitm inE mem_morphpre //=; last first. - by apply: Aut_restr_perm (actperm_Aut 'Q _); rewrite //= quotientT. - rewrite cycleJ -defH1 !inE /=; apply/subsetP=> z H1w_z; rewrite inE actpermK. - rewrite qactJ (subsetP nH0U) ?memJ_norm // normJ mem_conjg. - by rewrite (subsetP nH1U) // -mem_conjg (normsP nUW1b) ?mem_quotient. -have sUD := introT subsetP (dU _ _). -have Kphi w: 'ker (phi w) = 'C(H1 :^ w | 'Q). - rewrite !ker_comp ker_invm -kerE ker_restr_perm defH1 -cycleJ. - apply/setP=> x; rewrite !inE; congr (_ && _) => /=. - by apply: eq_subset_r => h1; rewrite !inE actpermK. -have o_phiU w: w \in W1bar -> #|phi w @* U| = a. - move=> Ww; have [w1 Nw1 Ww1 def_w] := morphimP Ww. - rewrite card_morphim Kphi (setIidPr _) ?sUD // /a indexgI /= !astabQ. - by rewrite centJ def_w morphpreJ // -{1}(normsP nUW1 w1 Ww1) indexJg. -have a_dv_p1: a %| p.-1. - rewrite -(o_phiU 1) // (dvdn_trans (cardSg (subsetT _))) // card_units_Zp //. - by rewrite conjg1 o_h (@totient_pfactor p 1) ?muln1. -have cycZhw w: cyclic (units_Zp #[h ^ w]). - rewrite -(injm_cyclic (inj_Zp_h w)) // im_Zp_unitm Aut_prime_cyclic //=. - by rewrite -orderE orderJ o_h. -have cyc_phi1U: cyclic (phi 1 @* U) := cyclicS (subsetT _) (cycZhw 1). -split=> //; last have{cyc_phi1U a_dv_p1} [z def_z] := cyclicP cyc_phi1U. - by rewrite -(conjsg1 H1) -Kphi (isog_cyclic (first_isog_loc _ _)) ?sUD. -have o_hw w: #[h ^ w] = #[h ^ 1] by rewrite !orderJ. -pose phi1 w x := eq_rect _ (fun m => {unit 'Z_m}) (phi w x) _ (o_hw w). -have val_phi1 w x: val (phi1 w x) = val (phi w x) :> nat. - by rewrite /phi1; case: _ / (o_hw _). -have mem_phi1 w x: w \in W1bar -> x \in U -> phi1 w x \in <[z]>%G. - move=> Ww Ux; have: #|<[z]>%G| = a by rewrite /= -def_z o_phiU. - rewrite /phi1; case: _ / (o_hw w) <[z]>%G => A oA /=. - suffices <-: phi w @* U = A by rewrite mem_morphim // dU. - by apply/eqP; rewrite (eq_subG_cyclic (cycZhw w)) ?subsetT // oA o_phiU. -have o_z: #[z] = a by rewrite orderE -def_z o_phiU. -pose phi0 w x := ecast m 'Z_m o_z (invm (injm_Zpm z) (phi1 w x)). -pose psi x := (\row_(i < q1) (phi0 (enum_val i) x * (phi0 1 x)^-1)%g)%R. -have psiM: {in U &, {morph psi: x y / x * y}}. - have phi0M w: w \in W1bar -> {in U &, {morph phi0 w: x y / x * y}}. - move=> Ww x y Ux Uy; rewrite /phi0; case: (a) / (o_z) => /=. - rewrite -morphM; first 1 [congr (invm _ _)] || by rewrite im_Zpm mem_phi1. - by rewrite /phi1; case: _ / (o_hw w); rewrite /= -morphM ?dU. - move=> x y Ux Uy; apply/rowP=> i; have /setD1P[_ Ww] := enum_valP i. - by rewrite !{1}mxE !{1}phi0M // addrCA -addrA -opprD addrCA addrA. -suffices Kpsi: 'ker (Morphism psiM) = C. - by exists [group of Morphism psiM @* U]; rewrite /Ubar -Kpsi first_isog. -apply/esym/eqP; rewrite eqEsubset; apply/andP; split. - rewrite [C]unlock -(bigdprodWY defHbar); apply/subsetP=> x /setIP[Ux cHx]. - suffices phi0x1 w: w \in W1bar -> phi0 w x = 1. - rewrite !inE Ux; apply/eqP/rowP=> i; have /setD1P[_ Ww] := enum_valP i. - by rewrite !mxE !phi0x1 ?mulgV. - move=> Ww; apply: val_inj; rewrite /phi0; case: (a) / (o_z); congr (val _). - suffices /eqP->: phi1 w x == 1 by rewrite morph1. - rewrite -2!val_eqE [val _]val_phi1 -(o_hw w) [phi _ _]mker // Kphi. - by apply: subsetP (astabS _ _) _ cHx; rewrite sub_gen // (bigcup_sup w). -have sKU: 'ker (Morphism psiM) \subset U by apply: subsetIl. -rewrite -quotient_sub1 -?(Frobenius_trivg_cent frobUW1c); last first. - by apply: subset_trans (normal_norm nsCUW1); rewrite subIset ?joing_subl. -rewrite subsetI quotientS //= quotient_cents2r // [C]unlock subsetI. -rewrite (subset_trans (commSg W1 sKU)) ?commg_subl //= astabQ gen_subG /=. -apply/subsetP=> _ /imset2P[x w1 Kx Ww1 ->]. -have:= Kx; rewrite -groupV 2!inE groupV => /andP[Ux /set1P/rowP psi_x'0]. -have [nH0x Ux'] := (subsetP nH0U x Ux, groupVr Ux); pose x'b := (inMb x)^-1. -rewrite mem_morphpre ?groupR ?morphR //= ?(subsetP nH0W1) //. -have conj_x'b w: w \in W1bar -> (h ^ w) ^ x'b = (h ^ w) ^+ val (phi 1 x^-1). - move=> Ww; transitivity (Zp_unitm (phi w x^-1) (h ^ w)). - have /morphpreP[_ /morphpreP[Px' Rx']] := dU w Ww x^-1 Ux'. - rewrite invmK ?restr_permE ?cycle_id //. - by rewrite actpermE qactJ groupV nH0x morphV. - have:= Ww; rewrite -(setD1K Wb1) autE ?cycle_id // => /setU1P[-> // | W'w]. - have /eqP := psi_x'0 (enum_rank_in W'w w); rewrite 2!mxE enum_rankK_in //. - rewrite -eq_mulgV1 -val_eqE /phi0; case: (a) / (o_z); rewrite /= val_eqE. - rewrite (inj_in_eq (injmP (injm_invm _))) /= ?im_Zpm ?mem_phi1 //. - by rewrite -2!val_eqE /= !val_phi1 // => /eqP->. -rewrite -sub_cent1 -(bigdprodWY defHbar) gen_subG; apply/bigcupsP=> w2 Ww2. -rewrite defH1 -cycleJ cycle_subG cent1C inE conjg_set1 !conjgM // conj_x'b //. -rewrite conjXg -!conjgM -conj_x'b ?groupM ?groupV ?mem_quotient //. -by rewrite !conjgM !conjgKV. -Qed. - -(* This is Peterfalvi (9.7)(b). *) -(* Note that part of this statement feeds directly into the final chapter of *) -(* the proof (PFsection14 and BGappendixC) and is not used before; we have *) -(* thus chosen to formulate the statement of (9.7)(b) accordingly. *) -(* For example, we supply separately the three component of the semi-direct *) -(* product isomorphism, because no use is made of the global isomorphism. We *) -(* also state explicitly that the image of W2bar is Fp because this is the *) -(* fact used in B & G, Appendix C, it is readily available during the proof, *) -(* whereas it can only be derived from the original statement of (9.7)(b) by *) -(* using Galois theory. Indeed the Galois part of the isomorphism is only *) -(* needed for this -- so with the formulation below it will not be used. *) -(* In order to avoid the use of the Wedderburn theorem on finite division *) -(* rings we build the field F from the enveloping algebra of the *) -(* representation of U rather than its endomorphism ring: then the fact that *) -(* Ubar is abelian yields commutativity directly. *) -Lemma typeP_Galois_P : - typeP_Galois -> - {F : finFieldType & {phi : {morphism Hbar >-> F} - & {psi : {morphism U >-> {unit F}} & {eta : {morphism W1 >-> {perm F}} - & forall alpha : {perm F}, reflect (rmorphism alpha) (alpha \in eta @* W1) - & [/\ 'injm eta, {in Hbar & W1, morph_act 'Q 'P phi eta} - & {in U & W1, forall x w, val (psi (x ^ w)) = eta w (val (psi x))}]} - & 'ker psi = C /\ {in Hbar & U, morph_act 'Q 'U phi psi}} - & [/\ #|F| = (p ^ q)%N, isom Hbar [set: F] phi & phi @* W2bar = <[1%R : F]>]} - & [/\ cyclic Ubar, coprime u p.-1 & u %| (p ^ q).-1 %/ p.-1]}. -Proof. -move=> irrU; have [_ sUW1M _ /joing_subP[nHU nHW1] _] := sdprod_context defHUW1. -have [nHbU nHbW1] := (quotient_norms H0 nHU, quotient_norms H0 nHW1). -have{sUW1M} /joing_subP[nH0U nH0W1] := subset_trans sUW1M nH0M. -have [ltCU oW2b oHb] := Ptype_Fcore_factor_facts. -pose rU := abelem_repr abelHbar ntHbar nHbU. -pose inHb := rVabelem abelHbar ntHbar; pose outHb := abelem_rV abelHbar ntHbar. -have{irrU} irrU: mx_irreducible rU by apply/abelem_mx_irrP; rewrite -acts_irrQ. -pose E_U := [pred A | (A \in enveloping_algebra_mx rU)%MS]. -have cEE A: A \in E_U -> centgmx rU A. - case/envelop_mxP=> z_ ->{A}; rewrite -memmx_cent_envelop linear_sum. - rewrite summx_sub // => x Ux; rewrite linearZ scalemx_sub {z_}//=. - rewrite memmx_cent_envelop; apply/centgmxP=> y Uy. - rewrite -repr_mxM // commgC 2?repr_mxM ?(groupR, groupM) // -/rU. - apply/row_matrixP=> i; rewrite row_mul; move: (row i _) => h. - have cHbH': (U / H0)^`(1) \subset 'C(Hbar). - by rewrite -quotient_der ?quotient_cents. - apply: rVabelem_inj; rewrite rVabelemJ ?groupR //. - by apply: (canLR (mulKg _)); rewrite -(centsP cHbH') ?mem_commg ?mem_rVabelem. -have{cEE} [F [outF [inF outFK inFK] E_F]]: - {F : finFieldType & {outF : {rmorphism F -> 'M(Hbar)%Mg} - & {inF : {additive _} | cancel outF inF & {in E_U, cancel inF outF}} - & forall a, outF a \in E_U}}%R. -- pose B := row_base (enveloping_algebra_mx rU). - have freeB: row_free B by apply: row_base_free. - pose outF := [additive of vec_mx \o mulmxr B]. - pose inF := [additive of mulmxr (pinvmx B) \o mxvec]. - have E_F a: outF a \in E_U by rewrite !inE vec_mxK mulmx_sub ?eq_row_base. - have inK: {in E_U, cancel inF outF}. - by move=> A E_A; rewrite /= mulmxKpV ?mxvecK ?eq_row_base. - have outI: injective outF := inj_comp (can_inj vec_mxK) (row_free_inj freeB). - have outK: cancel outF inF by move=> a; apply: outI; rewrite inK ?E_F. - pose one := inF 1%R; pose mul a b := inF (outF a * outF b)%R. - have outM: {morph outF: a b / mul a b >-> a * b}%R. - by move=> a b; rewrite inK //; apply: envelop_mxM; apply: E_F. - have out0: outF 0%R = 0%R by apply: raddf0. - have out1: outF one = 1%R by rewrite inK //; apply: envelop_mx1. - have nzFone: one != 0%R by rewrite -(inj_eq outI) out1 out0 oner_eq0. - have mulA: associative mul by move=> *; apply: outI; rewrite !{1}outM mulrA. - have mulC: commutative mul. - move=> a b; apply: outI; rewrite !{1}outM. - by apply: cent_mxP (E_F a); rewrite memmx_cent_envelop cEE ?E_F. - have mul1F: left_id one mul by move=> a; apply: outI; rewrite outM out1 mul1r. - have mulD: left_distributive mul +%R%R. - by move=> a1 a2 b; apply: canLR outK _; rewrite !raddfD mulrDl -!{1}outM. - pose Fring_NC := RingType 'rV__ (ComRingMixin mulA mulC mul1F mulD nzFone). - pose Fring := ComRingType Fring_NC mulC. - have outRM: multiplicative (outF : Fring -> _) by []. - have mulI (nza : {a | a != 0%R :> Fring}): GRing.rreg (val nza). - case: nza => a /=; rewrite -(inj_eq outI) out0 => nzA b1 b2 /(congr1 outF). - rewrite !{1}outM => /row_free_inj eqB12; apply/outI/eqB12. - by rewrite row_free_unit (mx_Schur irrU) ?cEE ?E_F. - pose inv (a : Fring) := oapp (fun nza => invF (mulI nza) one) a (insub a). - have inv0: (inv 0 = 0)%R by rewrite /inv insubF ?eqxx. - have mulV: GRing.Field.axiom inv. - by move=> a nz_a; rewrite /inv insubT /= (f_invF (mulI (exist _ _ _))). - pose Funit := FieldUnitMixin mulV inv0. - pose FringUcl := @GRing.ComUnitRing.Class _ (GRing.ComRing.class Fring) Funit. - have Ffield := @FieldMixin (GRing.ComUnitRing.Pack FringUcl nat) _ mulV inv0. - pose F := FieldType (IdomainType _ (FieldIdomainMixin Ffield)) Ffield. - by exists [finFieldType of F], (AddRMorphism outRM); first exists inF. -pose in_uF (a : F) : {unit F} := insubd (1 : {unit F}) a. -have in_uF_E a: a != 1 -> val (in_uF a) = a. - by move=> nt_a; rewrite insubdK /= ?unitfE. -have [psi psiK]: {psi : {morphism U >-> {unit F}} - | {in U, forall x, outF (val (psi x)) = rU (inMb x)}}. -- pose psi x := in_uF (inF (rU (inMb x))). - have psiK x: x \in U -> outF (val (psi x)) = rU (inMb x). - move/(mem_quotient H0)=> Ux; have EUx := envelop_mx_id rU Ux. - rewrite in_uF_E ?inFK //; apply: contraTneq (repr_mx_unitr rU Ux). - by move/(canRL_in inFK EUx)->; rewrite rmorph0 unitr0. - suffices psiM: {in U &, {morph psi: x y / x * y}} by exists (Morphism psiM). - move=> x y Ux Uy /=; apply/val_inj/(can_inj outFK); rewrite rmorphM //. - by rewrite !{1}psiK ?groupM // morphM ?(subsetP nH0U) ?repr_mxM ?mem_quotient. -have /trivgPn/sig2W[s W2s nts]: W2bar != 1%G. - by rewrite -cardG_gt1 oW2b prime_gt1. -pose sb := outHb s; have [Hs cW1s] := setIP W2s. -have nz_sb: sb != 0%R by rewrite morph_injm_eq1 ?abelem_rV_injm. -pose phi' a : coset_of H0 := inHb (sb *m outF a)%R. -have Hphi' a: phi' a \in Hbar by apply: mem_rVabelem. -have phi'D: {in setT &, {morph phi' : a b / a * b}}. - by move=> a b _ _; rewrite /phi' !raddfD [inHb _]morphM ?mem_im_abelem_rV. -have inj_phi': injective phi'. - move=> a b /rVabelem_inj eq_sab; apply: contraNeq nz_sb. - rewrite -[sb]mulmx1 idmxE -(rmorph1 outF) -subr_eq0 => /divff <-. - by rewrite rmorphM mulmxA !raddfB /= eq_sab subrr mul0mx. -have injm_phi': 'injm (Morphism phi'D) by apply/injmP; apply: in2W. -have Dphi: 'dom (invm injm_phi') = Hbar. - apply/setP=> h; apply/morphimP/idP=> [[a _ _ ->] // | Hh]. - have /cyclic_mxP[A E_A def_h]: (outHb h <= cyclic_mx rU sb)%MS. - by rewrite -(mxsimple_cyclic irrU) ?submx1. - by exists (inF A); rewrite ?inE //= /phi' inFK // -def_h [inHb _]abelem_rV_K. -have [phi [def_phi Kphi _ im_phi]] := domP _ Dphi. -have{Kphi} inj_phi: 'injm phi by rewrite Kphi injm_invm. -have{im_phi} im_phi: phi @* Hbar = setT by rewrite im_phi -Dphi im_invm. -have phiK: {in Hbar, cancel phi phi'} by rewrite def_phi -Dphi; apply: invmK. -have{def_phi Dphi injm_phi'} phi'K: cancel phi' phi. - by move=> a; rewrite def_phi /= invmE ?inE. -have phi'1: phi' 1%R = s by rewrite /phi' rmorph1 mulmx1 [inHb _]abelem_rV_K. -have phi_s: phi s = 1%R by rewrite -phi'1 phi'K. -have phiJ: {in Hbar & U, forall h x, phi (h ^ inMb x) = phi h * val (psi x)}%R. - move=> h x Hh Ux; have Uxb := mem_quotient H0 Ux. - apply: inj_phi'; rewrite phiK ?memJ_norm ?(subsetP nHbU) // /phi' rmorphM. - by rewrite psiK // mulmxA [inHb _]rVabelemJ // -/inHb [inHb _]phiK. -have Kpsi: 'ker psi = C. - apply/setP=> x; rewrite [C]unlock 2!in_setI /= astabQ; apply: andb_id2l => Ux. - have Ubx := mem_quotient H0 Ux; rewrite 3!inE (subsetP nH0U) //= inE. - apply/eqP/centP=> [psi_x1 h Hh | cHx]; last first. - by apply/val_inj; rewrite -[val _]mul1r -phi_s -phiJ // conjgE -cHx ?mulKg. - red; rewrite (conjgC h) -[h ^ _]phiK ?memJ_norm ?(subsetP nHbU) ?phiJ //. - by rewrite psi_x1 mulr1 phiK. -have etaP (w : subg_of W1): injective (fun a => phi (phi' a ^ inMb (val w))). - case: w => w /=/(mem_quotient H0)/(subsetP nHbW1) => nHw a b eq_ab. - apply/inj_phi'/(conjg_inj (inMb w)). - by apply: (injmP inj_phi) eq_ab; rewrite memJ_norm ?mem_rVabelem. -pose eta w : {perm F} := perm (etaP (subg W1 w)). -have etaK: {in Hbar & W1, forall h w, eta w (phi h) = phi (h ^ inMb w)}. - by move=> h w Hh Ww; rewrite /= permE subgK ?phiK. -have eta1 w: w \in W1 -> eta w 1%R = 1%R. - move=> Ww; rewrite -phi_s etaK //. - by rewrite conjgE (centP cW1s) ?mulKg ?mem_quotient. -have etaM: {in W1 &, {morph eta: w1 w2 / w1 * w2}}. - move=> w1 w2 Ww1 Ww2; apply/permP=> a; rewrite -[a]phi'K permM. - rewrite !etaK ?memJ_norm ?groupM ?(subsetP nHbW1) ?mem_quotient //. - by rewrite -conjgM -morphM ?(subsetP nH0W1). -have etaMpsi a: {in U & W1, forall x w, - eta w (a * val (psi x)) = eta w a * val (psi (x ^ w)%g)}%R. -- move=> x w Ux Ww; rewrite -[a]phi'K (etaK _ w (Hphi' a) Ww). - rewrite -!phiJ // ?memJ_norm ?(subsetP nHbW1, subsetP nUW1) ?mem_quotient //. - rewrite etaK ?memJ_norm ?(subsetP nHbU) ?mem_quotient // -!conjgM. - by rewrite conjgC -morphJ ?(subsetP nH0U x Ux, subsetP nH0W1 w Ww). -have psiJ: {in U & W1, forall x w, val (psi (x ^ w)) = eta w (val (psi x))}. - by move=> x w Ux Ww /=; rewrite -[val _]mul1r -(eta1 w Ww) -etaMpsi ?mul1r. -have etaRM w: w \in W1 -> rmorphism (eta w). - move=> Ww; have nUw := subsetP nHbW1 _ (mem_quotient _ Ww). - have etaD: additive (eta w). - move=> a b; rewrite -[a]phi'K -[b]phi'K -!zmodMgE -!zmodVgE. - rewrite -morphV // -morphM ?{1}etaK ?groupM ?groupV // conjMg conjVg. - by rewrite morphM 1?morphV ?groupV // memJ_norm. - do 2![split=> //] => [a b|]; last exact: eta1. - rewrite -[a]outFK; have /envelop_mxP[d ->] := E_F a. - rewrite raddf_sum mulr_suml ) mulr_suml. - apply: eq_bigr => _ /morphimP[x Nx Ux ->]; move: {d}(d _) => dx. - rewrite -[dx]natr_Zp scaler_nat !(mulrnAl, raddfMn); congr (_ *+ dx)%R. - by rewrite -psiK //= outFK mulrC etaMpsi // mulrC psiJ. -have oF: #|F| = (p ^ q)%N by rewrite -cardsT -im_phi card_injm. -pose nF := <[1%R : F]>; have o_nF: #|nF| = p. - by rewrite -orderE -phi_s (order_injm inj_phi) // (abelem_order_p abelHbar). -have cyc_uF := @field_unit_group_cyclic F. -exists F. - exists phi; last first. - split=> //; first exact/isomP; apply/esym/eqP; rewrite eqEcard o_nF -phi_s. - by rewrite (@cycle_subG F) mem_morphim //= card_injm ?subsetIl ?oW2b. - exists psi => //; last first. - by split=> // h x Hh Ux; rewrite qactJ (subsetP nH0U) ?phiJ. - have inj_eta: 'injm (Morphism etaM). - have /properP[_ [h Hh notW2h]]: W2bar \proper Hbar. - by rewrite properEcard subsetIl oW2b oHb (ltn_exp2l 1) prime_gt1. - apply/subsetP=> w /morphpreP[Ww /set1P/permP/(_ (phi h))]. - rewrite etaK // permE => /(injmP inj_phi) => chw. - rewrite -(@prime_TIg _ W1 <[w]>) //; first by rewrite inE Ww cycle_id. - rewrite proper_subn // properEneq cycle_subG Ww andbT. - apply: contraNneq notW2h => defW1; rewrite inE Hh /= -defW1. - rewrite quotient_cycle ?(subsetP nH0W1) // cent_cycle cent1C inE. - by rewrite conjg_set1 chw ?memJ_norm // (subsetP nHbW1) ?mem_quotient. - exists (Morphism etaM) => [alpha |]; last first. - by split=> // h w Hh Ww /=; rewrite qactJ (subsetP nH0W1) -?etaK. - pose autF (f : {perm F}) := rmorphism f. (* Bits of Galois theory... *) - have [r prim_r]: {r : F | forall f g, autF f -> autF g -> f r = g r -> f = g}. - have /cyclicP/sig_eqW[r def_uF] := cyc_uF [set: {unit F}]%G. - exists (val r) => f g fRM gRM eq_fgr; apply/permP=> a. - rewrite (_ : f =1 RMorphism fRM) // (_ : g =1 RMorphism gRM) //. - have [-> | /in_uF_E <-] := eqVneq a 0%R; first by rewrite !rmorph0. - have /cycleP[m ->]: in_uF a \in <[r]> by rewrite -def_uF inE. - by rewrite val_unitX !rmorphX /= eq_fgr. - have /sigW[P /and3P[Pr0 nP lePq]]: - exists P: {poly F}, [&& root P r, all (mem nF) P & #|root P| <= q]. - - pose Mr := (\matrix_(i < q.+1) (sb *m outF (r ^+ i)))%R. - have /rowV0Pn[v /sub_kermxP vMr0 nz_v]: kermx Mr != 0%R. - rewrite kermx_eq0 neq_ltn ltnS (leq_trans (rank_leq_col Mr)) //. - by rewrite (dim_abelemE abelHbar) // oHb pfactorK. - pose P : {poly F} := (\poly_(i < q.+1) (v 0 (inord i))%:R)%R. - have szP: size P <= q.+1 by apply: size_poly. - exists P; apply/and3P; split. - + apply/eqP/inj_phi'; congr (inHb _); rewrite rmorph0 mulmx0 -vMr0. - rewrite horner_poly !raddf_sum mulmx_sum_row; apply: eq_bigr => i _. - rewrite rowK inord_val //= mulr_natl rmorphMn -scaler_nat scalemxAr. - by rewrite natr_Zp. - + apply/(all_nthP 0%R)=> i /leq_trans/(_ szP) le_i_q. - by rewrite coef_poly /= le_i_q mem_cycle. - rewrite cardE -ltnS (leq_trans _ szP) //. - rewrite max_poly_roots ?enum_uniq //; last first. - by apply/allP=> r'; rewrite mem_enum. - apply: contraNneq nz_v => /polyP P0; apply/eqP/rowP=> i; apply/eqP. - have /eqP := P0 i; rewrite mxE coef0 coef_poly ltn_ord inord_val. - have charF: p \in [char F]%R by rewrite !inE p_pr -order_dvdn -o_nF /=. - by rewrite -(dvdn_charf charF) (dvdn_charf (char_Fp p_pr)) natr_Zp. - have{Pr0 nP} fPr0 f: autF f -> root P (f r). - move=> fRM; suff <-: map_poly (RMorphism fRM) P = P by apply: rmorph_root. - apply/polyP=> i; rewrite coef_map. - have [/(nth_default _)-> | lt_i_P] := leqP (size P) i; first exact: rmorph0. - by have /cycleP[n ->] := all_nthP 0%R nP i lt_i_P; apply: rmorph_nat. - apply: (iffP morphimP) => [[w _ Ww ->] | alphaRM]; first exact: etaRM. - suffices /setP/(_ (alpha r)): [set (eta w) r | w in W1] = [set t | root P t]. - rewrite inE fPr0 // => /imsetP[w Ww def_wr]; exists w => //. - by apply: prim_r => //; apply: etaRM. - apply/eqP; rewrite eqEcard; apply/andP; split. - by apply/subsetP=> _ /imsetP[w Ww ->]; rewrite inE fPr0 //; apply: etaRM. - rewrite (@cardsE F) card_in_imset // => w1 w2 Ww1 Ww2 /= /prim_r eq_w12. - by apply: (injmP inj_eta) => //; apply: eq_w12; apply: etaRM. -have isoUb: isog Ubar (psi @* U) by rewrite /Ubar -Kpsi first_isog. -pose unF := [set in_uF a | a in nF^#]. -have unF_E: {in nF^#, cancel in_uF val} by move=> a /setD1P[/in_uF_E]. -have unFg: group_set unF. - apply/group_setP; split=> [|_ _ /imsetP[a nFa ->] /imsetP[b nFb ->]]. - have nF1: 1%R \in nF^# by rewrite !inE cycle_id oner_eq0. - by apply/imsetP; exists 1%R => //; apply: val_inj; rewrite unF_E. - have nFab: (a * b)%R \in nF^#. - rewrite !inE mulf_eq0 negb_or. - have [[-> /cycleP[m ->]] [-> /cycleP[n ->]]] := (setD1P nFa, setD1P nFb). - by rewrite -natrM mem_cycle. - by apply/imsetP; exists (a * b)%R => //; apply: val_inj; rewrite /= !unF_E. -have <-: #|Group unFg| = p.-1. - by rewrite -o_nF (cardsD1 1 nF) group1 (card_in_imset (can_in_inj unF_E)). -have <-: #|[set: {unit F}]| = (p ^ q).-1. - rewrite -oF -(cardC1 1) cardsT card_sub; apply: eq_card => a /=. - by rewrite !inE unitfE. -rewrite /u (isog_cyclic isoUb) (card_isog isoUb) cyc_uF. -suffices co_u_p1: coprime #|psi @* U| #|Group unFg|. - by rewrite -(Gauss_dvdr _ co_u_p1) mulnC divnK ?cardSg ?subsetT. -rewrite -(cyclic_dprod (dprodEY _ _)) ?cyc_uF //. - by rewrite (sub_abelian_cent2 (cyclic_abelian (cyc_uF [set:_]%G))) ?subsetT. -apply/trivgP/subsetP=> _ /setIP[/morphimP[x Nx Ux ->] /imsetP[a nFa /eqP]]. -have nCx: x \in 'N(C) by rewrite -Kpsi (subsetP (ker_norm _)). -rewrite -val_eqE (unF_E a) //; case/setD1P: nFa => _ /cycleP[n {a}->]. -rewrite zmodXgE => /eqP def_psi_x; rewrite mker ?set11 // Kpsi coset_idr //. -apply/set1P; rewrite -set1gE -(Frobenius_trivg_cent frobUW1c) /= -/C. -rewrite inE mem_quotient //= -sub1set -quotient_set1 ?quotient_cents2r //. -rewrite gen_subG /= -/C -Kpsi; apply/subsetP=> _ /imset2P[_ w /set1P-> Ww ->]. -have Uxw: x ^ w \in U by rewrite memJ_norm ?(subsetP nUW1). -apply/kerP; rewrite (morphM, groupM) ?morphV ?groupV //. -apply/(canLR (mulKg _))/val_inj; rewrite psiJ // mulg1 def_psi_x. -exact: (rmorph_nat (RMorphism (etaRM w Ww))). -Qed. - -Local Open Scope ring_scope. - -Let redM := [predC irr M]. -Let mu_ := filter redM (S_ H0). - -(* This subproof is shared between (9.8)(b) and (9.9)(b). *) -Let nb_redM_H0 : size mu_ = p.-1 /\ {subset mu_ <= S_ H0C}. -Proof. -have pddM := FT_prDade_hypF maxM MtypeP; pose ptiWM := prDade_prTI pddM. -have [nsHUM sW1M /mulG_sub[sHUM _] nHUW1 tiHUW1] := sdprod_context defM. -have [nsHHU sUHU /mulG_sub[sHHU _] nHU tiHU] := sdprod_context defHU. -have nb_redM K: - K <| M -> K \subset HU -> K :&: H = H0 -> count redM (S_ K) = p.-1. -- move=> nsKM sKHU tiKHbar; have [sKM nKM] := andP nsKM; pose b L := (L / K)%G. - have [nsKHU [_ [_ sW2HU cycW2 _] _]] := (normalS sKHU sHUM nsKM, ptiWM). - have nKW2 := subset_trans sW2HU (normal_norm nsKHU). - have oW2b: #|b W2| = p. - have [_ <- _] := Ptype_Fcore_factor_facts; rewrite defW2bar. - rewrite !card_quotient ?(subset_trans (subset_trans sW2HU sHUM)) //. - by rewrite -indexgI -{2}(setIidPl sW2H) setIAC -setIA tiKHbar indexgI. - have{cycW2} cycW2b: cyclic (b W2) by apply: quotient_cyclic. - have ntW2b: (W2 / K != 1)%g by rewrite -cardG_gt1 oW2b prime_gt1. - have{ntW2b} [defWb ptiWMb]:= primeTIhyp_quotient ptiWM ntW2b sKHU nsKM. - pose muK j := (primeTIred ptiWMb j %% K)%CF. - apply/eqP; have <-: size (image muK (predC1 0)) = p.-1. - by rewrite size_map -cardE cardC1 card_Iirr_cyclic ?oW2b. - rewrite -size_filter -uniq_size_uniq ?filter_uniq ?seqInd_uniq // => [|phi]. - by apply/dinjectiveP=> j1 j2 _ _ /(can_inj (cfModK nsKM))/prTIred_inj. - rewrite mem_filter; apply/imageP/andP=> [[j nz_j ->] | [red_phi]]; last first. - case/seqIndP=> s /setDP[kerK ker'H] Dphi; rewrite !inE in kerK ker'H. - pose s1 := quo_Iirr K s; have Ds: s = mod_Iirr s1 by rewrite quo_IirrK. - rewrite {phi}Dphi Ds mod_IirrE ?cfIndMod // in kerK ker'H red_phi *. - have{red_phi} red_s1: 'Ind 'chi_s1 \notin irr (M / K) by rewrite -cfMod_irr. - have [[j Ds1] | [/idPn//]] := prTIres_irr_cases ptiWMb s1. - rewrite Ds1 cfInd_prTIres -/(muK j) in ker'H *; exists j => //. - by apply: contraNneq ker'H => ->; rewrite prTIres0 rmorph1 cfker_cfun1. - have red_j: redM (muK j) by rewrite /redM /= cfMod_irr // prTIred_not_irr. - have [s DmuKj]: exists s, muK j = 'Ind[M, HU] 'chi_s. - exists (mod_Iirr (primeTI_Ires ptiWMb j)). - by rewrite mod_IirrE // cfIndMod // cfInd_prTIres. - split=> //; apply/seqIndP; exists s; rewrite // !inE andbC. - rewrite -(@sub_cfker_Ind_irr _ M) ?gFnorm // -DmuKj cfker_mod //=. - have [[j1 Ds] | [/idPn]] := prTIres_irr_cases ptiWM s; last by rewrite -DmuKj. - rewrite Ds cfker_prTIres //; apply: contraNneq nz_j => j1_0. - apply/eqP/(prTIred_inj ptiWMb)/(can_inj (cfModK nsKM)); rewrite -{1}/(muK j). - by rewrite DmuKj Ds j1_0 -cfInd_prTIres !prTIres0 -cfIndMod ?rmorph1. -have [sH0HU sH0M] := (subset_trans sH0H sHHU, subset_trans sH0H (gFsub _ _)). -have sz_mu: size mu_ = p.-1. - by rewrite size_filter nb_redM ?(setIidPl sH0H) // /normal sH0M. -have s_muC_mu: {subset filter redM (S_ H0C) <= mu_}. - move=> phi; rewrite /= !mem_filter => /andP[->]; apply: seqIndS. - by rewrite setSD // Iirr_kerS ?joing_subl. -have UmuC: uniq (filter redM (S_ H0C)) by rewrite filter_uniq ?seqInd_uniq. -have [|Dmu _] := leq_size_perm UmuC s_muC_mu; last first. - by split=> // phi; rewrite -Dmu mem_filter => /andP[]. -have [nsH0C_M _ _ _] := nsH0xx_M. -have sCHU := subset_trans sCU sUHU; have sCM := subset_trans sCHU sHUM. -have sHOC_HU: H0C \subset HU by apply/joing_subP. -rewrite sz_mu size_filter nb_redM //= norm_joinEr ?(subset_trans sCM) //. -by rewrite -group_modl //= setIC [C]unlock setIA tiHU setI1g mulg1. -Qed. - -Let isIndHC (zeta : 'CF(M)) := - [/\ zeta 1%g = (q * u)%:R, zeta \in S_ H0C - & exists2 xi : 'CF(HC), xi \is a linear_char & zeta = 'Ind xi]. - -(* This is Peterfalvi (9.8). *) -Lemma typeP_nonGalois_characters (not_Galois : ~~ typeP_Galois) : - let a := #|U : 'C_U(sval (typeP_Galois_Pn not_Galois) | 'Q)| in - [/\ (*a*) {in X_ H0, forall s, (a %| 'chi_s 1%g)%C}, - (*b*) size mu_ = p.-1 /\ {in mu_, forall mu_j, isIndHC mu_j}, - (*c*) exists t, isIndHC 'chi_t - & (*d*) let irr_qa := [pred zeta in irr M | zeta 1%g == (q * a)%:R] in - let lb_n := (p.-1 * #|U|)%N in let lb_d := (a ^ 2 * #|U'|)%N in - (lb_d %| lb_n /\ lb_n %/ lb_d <= count irr_qa (S_ H0U'))%N]. -Proof. -case: (typeP_Galois_Pn _) => H1 [oH1 nH1U nH1Uq defHbar aP]; rewrite [sval _]/=. -move=> a; case: aP; rewrite -/a => a_gt1 a_dv_p1 cycUb1 isoUb. -set part_a := ({in _, _}); pose HCbar := (HC / H0)%G. -have [_ /mulG_sub[sHUM sW1M] nHUW1 tiHUW1] := sdprodP defM. -have [nsHHU _ /mulG_sub[sHHU sUHU] nHU tiHU] := sdprod_context defHU. -have [nH0H nHHU] := (normal_norm nsH0H, normal_norm nsHHU). -have sHHC: H \subset HC by rewrite joing_subl. -have [nH0HU sCHU] := (subset_trans sHUM nH0M, subset_trans sCU sUHU). -have nsH0_HU: H0 <| HU by rewrite /normal (subset_trans sH0H). -have nH0C := subset_trans sCHU nH0HU. -have [nsH0C_M nsHC_M nsH0U'_M _] := nsH0xx_M; have [sHC_M _] := andP nsHC_M. -have nsH0HC: H0 <| HC := normalS (subset_trans sH0H sHHC) sHC_M nsH0M. -have defHCbar: Hbar \x (C / H0) = HCbar. - rewrite /= quotientY // [C]unlock /= astabQ quotient_setIpre. - by rewrite dprodEY ?subsetIr // setIA -quotientGI // tiHU quotient1 setI1g. -have sHC_HU: HC \subset HU by rewrite join_subG sHHU. -have nsHC_HU: HC <| HU := normalS sHC_HU sHUM nsHC_M. -have defHb1 := defHbar; rewrite (big_setD1 1%g) ?group1 ?conjsg1 //= in defHb1. -have [[_ H1c _ defH1c] _ _ _] := dprodP defHb1; rewrite defH1c in defHb1. -have [nsH1H _] := dprod_normal2 defHb1; have [sH1H nH1H] := andP nsH1H. -have nHW1: W1 \subset 'N(H) := subset_trans sW1M (gFnorm _ _). -have nHbW1: W1bar \subset 'N(Hbar) by rewrite quotient_norms. -have sH1wH w: w \in W1bar -> H1 :^ w \subset Hbar. - by move/(normsP nHbW1) <-; rewrite conjSg. -have nsH1wHUb w: w \in W1bar -> H1 :^ w <| HU / H0. - move=> W1w; rewrite -(normsP (quotient_norms _ nHUW1) w W1w) normalJ. - rewrite /normal (subset_trans sH1H) ?quotientS //. - by rewrite -defHU sdprodE // quotientMl // mulG_subG nH1H. -have nH1wHUb := normal_norm (nsH1wHUb _ _). -have Part_a: part_a. - move=> s; rewrite !inE => /andP[kers'H kersH0]. - have [t sHt] := constt_cfRes_irr H s; pose theta := ('chi_t / H0)%CF. - have{kers'H} t_neq0: t != 0. - by rewrite -subGcfker (sub_cfker_constt_Res_irr sHt). - have{kersH0} kertH0: H0 \subset cfker 'chi_t. - by rewrite (sub_cfker_constt_Res_irr sHt). - have Ltheta: theta \is a linear_char. - by rewrite /theta -quo_IirrE // (char_abelianP _ _). - have Dtheta : _ = theta := cfBigdprod_Res_lin defHbar Ltheta. - set T := 'I_HU['chi_t]; have sHT: H \subset T by rewrite sub_Inertia. - have sTHU: T \subset HU by rewrite Inertia_sub. - suffices{s sHt} a_dv_iTHU: a %| #|HU : T|. - have [_ defInd_t _ imInd_t _] := cfInd_sum_Inertia t nsHHU. - have /imsetP[r tTr ->]: s \in Ind_Iirr HU @: irr_constt ('Ind[T] 'chi_t). - by rewrite imInd_t constt_Ind_Res. - by rewrite defInd_t ?cfInd1 // dvdC_mulr ?dvdC_nat // Cint_Cnat ?Cnat_irr1. - have /exists_inP[w W1w nt_t_w]: [exists w in W1bar, 'Res[H1 :^ w] theta != 1]. - rewrite -negb_forall_in; apply: contra t_neq0 => /forall_inP=> tH1w1. - rewrite -irr_eq1 -(cfQuoK nsH0H kertH0) -/theta -Dtheta. - rewrite [cfBigdprod _ _]big1 ?rmorph1 // => w /tH1w1/eqP->. - by rewrite /cfBigdprodi rmorph1. - have defT: H ><| (U :&: T) = T. - by rewrite (sdprod_modl defHU) // (setIidPr sTHU). - have /irrP[k Dk]: 'Res theta \in irr (H1 :^ w). - by rewrite lin_char_irr ?cfRes_lin_char. - rewrite -divgS // -(sdprod_card defHU) -(sdprod_card defT) divnMl // divgI. - rewrite -indexgI; have ->: a = #|U : 'C_U(H1 :^ w | 'Q)|. - have [w1 nH0w1 W1w1 ->] := morphimP W1w; rewrite astabQ centJ morphpreJ //. - by rewrite -astabQ indexgI -(normsP nUW1 _ W1w1) indexJg -indexgI. - rewrite indexgS ?setIS // sub_astabQ ?(subset_trans sTHU) //= -inertia_quo //. - apply: subset_trans (sub_inertia_Res _ (nH1wHUb w W1w)) _. - by rewrite Dk (inertia_irr_prime _ p_pr) ?subsetIr ?cardJg // -irr_eq1 -Dk. -pose isoJ := conj_isom H1; pose cfJ w i := 'chi_(isom_Iirr (isoJ w) i). -pose thetaH (f : {ffun _}) := cfBigdprod defHbar (fun w => cfJ w (f w)). -pose theta f := cfDprodl defHCbar (thetaH f). -have abH1: abelian H1 by rewrite cyclic_abelian ?prime_cyclic ?oH1. -have linH1 i: 'chi[H1]_i \is a linear_char by apply/char_abelianP. -have lin_thetaH f: thetaH f \is a linear_char. - by apply: cfBigdprod_lin_char => w _; rewrite /cfJ isom_IirrE cfIsom_lin_char. -have nz_thetaH f: thetaH f 1%g != 0 by rewrite lin_char_neq0. -have Dtheta f: {in W1bar & H1, forall w xb, theta f (xb ^ w) = 'chi_(f w) xb}. - move=> w xb W1w H1xb /=; have sHHCb := quotientS H0 sHHC. - transitivity ('Res[H1 :^ w] ('Res[Hbar] (theta f)) (xb ^ w)); last first. - by rewrite cfDprodlK cfBigdprodKabelian // isom_IirrE cfIsomE. - by rewrite cfResRes ?sH1wH // cfResE ?memJ_conjg ?(subset_trans (sH1wH w _)). -have lin_theta f: theta f \is a linear_char by rewrite cfDprodl_lin_char. -pose Ftheta := pffun_on (0 : Iirr H1) W1bar (predC1 0). -have inj_theta: {in Ftheta &, injective theta}. - move=> f1 f2 /pffun_onP[/supportP W1f1 _] /pffun_onP[/supportP W1f2 _] eq_f12. - apply/ffunP=> w. - have [W1w | W1'w] := boolP (w \in W1bar); last by rewrite W1f1 ?W1f2. - by apply/irr_inj/cfun_inP=> x H1x; rewrite -!Dtheta ?eq_f12. -have irr_thetaH0 f: (theta f %% H0)%CF \in irr HC. - by rewrite cfMod_irr ?lin_char_irr. -have def_Itheta f: f \in Ftheta -> 'I_HU[theta f %% H0]%CF = HC. - case/pffun_onP=> _ nz_fW1; apply/eqP; rewrite eqEsubset sub_Inertia //. - rewrite inertia_mod_pre //= -{1}(sdprodW defHU) -group_modl; last first. - rewrite (subset_trans sHHC) // -sub_quotient_pre ?normal_norm //. - by rewrite sub_Inertia ?quotientS. - rewrite -gen_subG genM_join genS ?setUS //= {2}[C]unlock setIS //= astabQ. - rewrite morphpreS // centsC -{1}(bigdprodWY defHbar) gen_subG. - apply/bigcupsP=> w W1w; rewrite centsC. - apply: subset_trans (sub_inertia_Res _ (quotient_norms _ nHHU)) _. - rewrite cfDprodlK inertia_bigdprod_irr // subIset // orbC (bigcap_min w) //. - rewrite (inertia_irr_prime _ p_pr) ?cardJg ?subsetIr // isom_Iirr_eq0. - by apply: nz_fW1; apply: image_f. -have irrXtheta f: f \in Ftheta -> 'Ind (theta f %% H0)%CF \in irr HU. - move/def_Itheta; rewrite -(cfIirrE (irr_thetaH0 f)) => I_f_HC. - by rewrite inertia_Ind_irr ?I_f_HC //. -pose Mtheta := [set cfIirr (theta f %% H0)%CF | f in Ftheta]. -pose Xtheta := [set cfIirr ('Ind[HU] 'chi_t) | t in Mtheta]. -have oXtheta: (u * #|Xtheta| = p.-1 ^ q)%N. - transitivity #|Ftheta|; last first. - rewrite card_pffun_on cardC1 card_Iirr_abelian // oH1. - rewrite -(card_isog (quotient_isog _ _)) ?oW1 ?(subset_trans sW1M) //. - by apply/trivgP; rewrite -tiHUW1 setSI ?(subset_trans sH0H). - rewrite Du -card_imset_Ind_irr ?card_in_imset //. - - move=> f1 f2 Df1 Df2 /(congr1 (tnth (irr HC))); rewrite !{1}cfIirrE //. - by move/(can_inj (cfModK nsH0HC)); apply: inj_theta. - - by move=> _ /imsetP[f Df ->]; rewrite cfIirrE ?irrXtheta. - move=> _ y /imsetP[f /familyP Ff ->] HUy; apply/imsetP. - pose yb := inMb y; have HUyb: yb \in (HU / H0)%g by apply: mem_quotient. - have nHb_y: inMb y \in 'N(Hbar) by rewrite (subsetP (quotient_norms _ nHHU)). - have nH1b_y := subsetP (nH1wHUb _ _) yb HUyb. - exists [ffun w => conjg_Iirr (f w) (inMb y ^ w^-1)]. - apply/familyP=> w; rewrite ffunE. - by case: ifP (Ff w) => _; rewrite !inE conjg_Iirr_eq0. - apply: irr_inj; rewrite !(cfIirrE, conjg_IirrE) // (cfConjgMod _ nsHC_HU) //. - rewrite cfConjgDprodl //; first congr (cfDprodl _ _ %% H0)%CF; last first. - rewrite /= -quotientYidl // (subsetP _ _ HUyb) ?quotient_norms //. - by rewrite (subset_trans sHUM) ?normal_norm. - rewrite cfConjgBigdprod //; apply: eq_bigr => w W1w; congr (cfBigdprodi _ _). - rewrite ffunE /cfJ !isom_IirrE conjg_IirrE. - apply/cfun_inP=> _ /imsetP[x Hx ->]; rewrite cfIsomE // cfConjgE ?nH1b_y //. - rewrite -conjgM conjgCV conjVg conjgM cfIsomE //; last first. - by rewrite -mem_conjg (normP _) // -mem_conjg -normJ ?nH1b_y. - by rewrite cfConjgE // -mem_conjg -normJ ?nH1b_y. -have sXthXH0C: Xtheta \subset X_ H0C. - apply/subsetP=> _ /imsetP[t Mt ->]; have{Mt} [f Ff Dt] := imsetP Mt. - rewrite !inE cfIirrE; last by rewrite Dt cfIirrE ?irrXtheta. - rewrite !sub_cfker_Ind_irr ?(subset_trans sHUM) ?normal_norm ?gFnormal //. - rewrite {t}Dt cfIirrE // join_subG andbCA {1}cfker_mod //. - rewrite !{1}sub_cfker_mod //= andbC {1}cfker_sdprod /=. - apply: contraL (familyP Ff 1%g) => kerHb; rewrite group1 negbK. - have:= sub_cfker_Res (subxx _) kerHb; rewrite cfDprodlK. - move/(subset_trans (sH1wH _ (group1 _)))/(sub_cfker_Res (subxx _)). - rewrite cfBigdprodKabelian // isom_IirrE cfker_isom morphim_conj /=. - by rewrite !conjsg1 subsetIidl subGcfker. -pose mu_f (i : Iirr H1) := [ffun w => if w \in W1bar then i else 0]. -have Fmu_f (i : Iirr H1): i != 0 -> mu_f i \in Ftheta. - by move=> nz_i; apply/familyP=> w; rewrite ffunE; case: ifP; rewrite !inE. -pose mk_mu i := 'Ind[HU] (theta (mu_f i) %% H0)%CF. -have sW1_Imu i: W1 \subset 'I[theta (mu_f i) %% H0]%CF. - apply/subsetP=> w W1w; have Mw := subsetP sW1M w W1w. - have nHC_W1 := subset_trans sW1M (normal_norm nsHC_M). - rewrite inE (subsetP nHC_W1) ?(cfConjgMod _ nsHC_M) //; apply/eqP. - have W1wb: inMb w \in W1bar by rewrite mem_quotient. - rewrite cfConjgDprodl ?(subsetP _ _ W1wb) ?quotient_norms //; last first. - by rewrite (subset_trans (joing_subr U W1)) ?normal_norm. - congr (cfDprodl _ _ %% H0)%CF. - apply/cfun_inP=> _ /(mem_bigdprod defHbar)[x [H1x -> _]]. - have Hx w1: w1 \in W1bar -> x w1 \in Hbar. - by move=> W1w1; rewrite (subsetP (sH1wH w1 _)) ?H1x. - rewrite !lin_char_prod ?cfConjg_lin_char //; apply/eq_bigr=> w1 W1w1. - rewrite cfConjgE ?(subsetP nHbW1) //. - have W1w1w: (w1 * (inMb w)^-1)%g \in W1bar by rewrite !in_group. - rewrite -(cfResE _ (sH1wH _ W1w1w)) -?mem_conjg -?conjsgM ?mulgKV ?H1x //. - rewrite -(cfResE _ (sH1wH _ W1w1)) ?H1x ?cfBigdprodKabelian //. - rewrite !ffunE W1w1 W1w1w -[x w1](conjgKV w1) -conjgM !isom_IirrE. - by rewrite !cfIsomE -?mem_conjg ?H1x. -have inj_mu: {in predC1 0 &, injective (fun i => cfIirr (mk_mu i))}. - move=> i1 i2 nz_i1 nz_i2 /(congr1 (tnth (irr HU))). - rewrite !{1}cfIirrE ?irrXtheta ?Fmu_f // /mk_mu. - do 2![move/esym; rewrite -{1}(cfIirrE (irr_thetaH0 _))]. - move/(cfclass_Ind_irrP _ _ nsHC_HU); rewrite !{1}cfIirrE //. - case/cfclassP=> _ /(mem_sdprod defHU)[x [y [Hx Uy -> _]]]. - rewrite (cfConjgM _ nsHC_HU) ?(subsetP sHHU x) ?(subsetP sUHU) //. - rewrite {x Hx}(cfConjg_id _ (subsetP sHHC x Hx)) => Dth1. - suffices /setIP[_ /inertiaJ]: y \in 'I_HU[theta (mu_f i2) %% H0]%CF. - rewrite -Dth1 => /(can_inj (cfModK nsH0HC))/inj_theta/ffunP/(_ 1%g). - by rewrite !ffunE group1 => -> //; apply: Fmu_f. - rewrite def_Itheta ?Fmu_f //= (subsetP (joing_subr _ _)) //. - have nCy: y \in 'N(C). - by rewrite (subsetP (normal_norm nsCUW1)) ?mem_gen ?inE ?Uy. - have [_ _ /trivgPn[wb W1wb ntwb] _ _] := Frobenius_context frobUW1c. - have /morphimP[w nCw W1w Dw] := W1wb; have Mw := subsetP sW1M w W1w. - rewrite coset_idr //; apply/set1P; rewrite -set1gE; apply: wlog_neg => nty. - rewrite -((Frobenius_reg_ker frobUW1c) wb); last by rewrite !inE ntwb. - rewrite inE mem_quotient //=; apply/cent1P/commgP. - rewrite Dw -morphR //= coset_id //. - suffices: [~ y, w] \in U :&: HC. - rewrite /= norm_joinEr ?(subset_trans sCU) // -group_modr ?subsetIl //=. - by rewrite setIC tiHU mul1g. - have Uyw: [~ y, w] \in U; last rewrite inE Uyw. - by rewrite {1}commgEl groupMl ?groupV // memJ_norm ?(subsetP nUW1) // Uy. - rewrite -(def_Itheta _ (Fmu_f _ nz_i1)) 2!inE /= andbA -in_setI. - rewrite (setIidPl (normal_norm nsHC_HU)) (subsetP sUHU) //=. - rewrite Dth1 -(cfConjgM _ nsHC_HU) ?(subsetP sUHU) //. - have My: y \in M := subsetP (subset_trans sUHU sHUM) y Uy. - rewrite mulKVg (cfConjgM _ nsHC_M) ?in_group //. - have /inertiaJ-> := subsetP (sW1_Imu i2) _ (groupVr W1w). - rewrite (cfConjgM _ nsHC_M) // -Dth1. - by have /inertiaJ-> := subsetP (sW1_Imu i1) w W1w. -pose Xmu := [set cfIirr (mk_mu i) | i in predC1 0]. -have def_IXmu: {in Xmu, forall s, 'I_M['chi_s] = M}. - move=> _ /imsetP[i nz_i ->]; apply/setIidPl. - rewrite -subsetIidl -{1}(sdprodW defM) mulG_subG sub_Inertia //. - rewrite !cfIirrE ?irrXtheta ?Fmu_f //=. - apply: subset_trans (sub_inertia_Ind _ (der_norm 1 M)). - by rewrite subsetI sW1M /=. -pose Smu := [seq 'Ind[M] 'chi_s | s in Xmu]. -have sSmu_mu: {subset Smu <= mu_}. - move=> _ /imageP[s Xmu_s ->]; rewrite mem_filter /=. - rewrite irrEchar cfnorm_Ind_irr ?gFnormal // def_IXmu //. - rewrite -(index_sdprod defM) (eqC_nat _ 1) gtn_eqF ?prime_gt1 // andbF. - rewrite mem_seqInd ?gFnormal /normal ?(subset_trans sH0H) ?gFsub //=. - suffices /(subsetP sXthXH0C): s \in Xtheta. - by apply: subsetP; rewrite setSD // Iirr_kerS ?joing_subl. - have /imsetP[i nz_i ->] := Xmu_s; rewrite /Xtheta -imset_comp. - by apply/imsetP; exists (mu_f i); rewrite /= ?cfIirrE ?Fmu_f. -have ResIndXmu: {in Xmu, forall s, 'Res ('Ind[M] 'chi_s) = q%:R *: 'chi_s}. - move=> s /def_IXmu Imu_s; rewrite cfResInd_sum_cfclass ?gFnormal ?Imu_s //. - by rewrite -(index_sdprod defM) -Imu_s cfclass_inertia big_seq1. -have uSmu: uniq Smu. - apply/dinjectiveP=> s1 s2 Xs1 Xs2 /(congr1 'Res[HU]); rewrite !ResIndXmu //. - by move/(can_inj (scalerK (neq0CG W1)))/irr_inj. -have sz_Smu: size Smu = p.-1. - by rewrite size_map -cardE card_in_imset // cardC1 card_Iirr_abelian ?oH1. -have [sz_mu s_mu_H0C] := nb_redM_H0. -have Dmu: Smu =i mu_. - by have [|//] := leq_size_perm uSmu sSmu_mu; rewrite sz_mu sz_Smu. -split=> {Part_a part_a}//. -- split=> // phi mu_phi; have S_HOC_phi := s_mu_H0C _ mu_phi. - move: mu_phi; rewrite -Dmu => /imageP[_ /imsetP[i nz_i ->]]. - rewrite cfIirrE ?irrXtheta ?Fmu_f // => Dphi. - split=> //; rewrite Dphi ?cfInd1 ?cfIndInd //. - rewrite -(index_sdprod defM) -/q -Du mulrA -natrM. - by rewrite lin_char1 1?cfMod_lin_char ?mulr1. - by exists (theta (mu_f i) %% H0)%CF; rewrite 1?cfMod_lin_char. -- have /eqVproper: Xmu \subset Xtheta. - apply/subsetP=> _ /imsetP[i nz_i ->]; rewrite -[Xtheta]imset_comp /=. - by apply/imsetP; exists (mu_f i); rewrite /= ?cfIirrE ?Fmu_f. - case=> [defXmu | /andP[_ /subsetPn[s theta_s Xmu'_s]]]; last first. - have [_ /imsetP[f Dth_f ->] Ds] := imsetP theta_s; rewrite cfIirrE // in Ds. - have /irrP[t Dt]: 'Ind 'chi_s \in irr M; last 1 [exists t; rewrite -{t}Dt]. - apply: contraR Xmu'_s => red_Ind_s. - have: 'Ind 'chi_s \in mu_. - rewrite mem_filter /= red_Ind_s mem_seqInd ?gFnormal //=. - apply: subsetP theta_s; rewrite (subset_trans sXthXH0C) ?setSD //. - by rewrite Iirr_kerS ?joing_subl. - rewrite -Dmu => /imageP[s1 Xmu_s1] /(congr1 (cfdot ('Ind 'chi_s1)))/eqP. - rewrite cfnorm_Ind_irr ?gFnormal // eq_sym -cfdot_Res_l. - rewrite ResIndXmu // cfdotZl cfdot_irr -natrM mulnC. - by case: (s1 =P s) => [<- // | _] /idPn[]; apply: neq0CiG. - split; first 2 [by rewrite mem_seqInd ?gFnormal ?(subsetP sXthXH0C)]. - rewrite Ds cfIirrE ?irrXtheta ?cfInd1 // -Du -(index_sdprod defM) -/q. - by rewrite mulrA -natrM lin_char1 ?cfMod_lin_char ?mulr1. - exists (theta f %% H0)%CF; first by rewrite cfMod_lin_char. - by rewrite Ds cfIirrE ?irrXtheta //= cfIndInd. - suffices /(congr1 odd): u = (p.-1 ^ q.-1)%N. - rewrite odd_exp -(subnKC (prime_gt1 pr_q)) /= -subn1 odd_sub ?prime_gt0 //. - by rewrite -oH1 (oddSg sH1H) ?quotient_odd // mFT_odd. - have p1_gt0: (0 < p.-1)%N by rewrite -(subnKC (prime_gt1 p_pr)). - apply/eqP; rewrite -(eqn_pmul2r p1_gt0) -expnSr prednK ?prime_gt0 //. - by rewrite -oXtheta -defXmu card_in_imset // cardC1 card_Iirr_abelian ?oH1. -clear Xmu def_IXmu Smu sSmu_mu ResIndXmu uSmu sz_Smu sz_mu s_mu_H0C Dmu. -clear Mtheta Xtheta irrXtheta oXtheta sXthXH0C mu_f Fmu_f mk_mu sW1_Imu inj_mu. -clear nz_thetaH lin_thetaH lin_theta Ftheta inj_theta irr_thetaH0 def_Itheta. -clear theta Dtheta => irr_qa lb_n lb_d. -have sU'U: U' \subset U := der_sub 1 U. -have nH0U := subset_trans sUHU nH0HU; have nH0U' := subset_trans sU'U nH0U. -have sU'CH1: U' \subset 'C_U(H1 | 'Q). - by rewrite subsetI sU'U sub_astabQ nH0U' (centsS sH1H) ?quotient_cents. -have sCH1_U: 'C_U(H1 | 'Q) \subset U := subsetIl U _. -have dvd_lb: lb_d %| lb_n. - rewrite -[lb_d]mulnA dvdn_mul // -(Lagrange sCH1_U). - by rewrite mulnC dvdn_pmul2r ?cardSg ?indexg_gt0. -split; rewrite ?leq_divLR // /lb_n -(Lagrange sCH1_U) -/a -(Lagrange sU'CH1). -rewrite mulnCA -mulnA mulnC !mulnA !leq_pmul2r ?cardG_gt0 ?indexg_gt0 // mulnC. -pose H1CH1 := (H1 <*> 'C_(U / H0)(H1))%G; pose HCH1 := (H <*> 'C_U(H1 | 'Q))%G. -have defH1CH1: H1 \x 'C_(U / H0)(H1) = H1CH1. - rewrite dprodEY ?subsetIr ?coprime_TIg ?(coprimeSg sH1H) //. - by rewrite (coprimegS (subsetIl _ _)) ?coprime_morph. -have sHCH1_HU: HCH1 \subset HU by rewrite join_subG sHHU (subset_trans sCH1_U). -have nsHCH1_HU: HCH1 <| HU. - rewrite /normal sHCH1_HU -(sdprodW defHU) mulG_subG normsG ?joing_subl //=. - by rewrite normsY // sub_der1_norm. -have nsH0_HCH1: H0 <| HCH1. - by rewrite (normalS _ sHCH1_HU) // (subset_trans sH0H) ?joing_subl. -have nsH1cHU: H1c <| HU / H0. - rewrite -(bigdprodWY defH1c) /normal gen_subG norms_gen ?andbT //. - by apply/bigcupsP=> w /setD1P[_ /nsH1wHUb/andP[]]. - by apply/norms_bigcup/bigcapsP=> w /setD1P[_ /nH1wHUb]. -have defHCH1: H1c ><| H1CH1 = (HCH1 / H0)%G. - have /sdprodP[_ /mulG_sub[sH1cH _] nH1cH1 tiH1cH1] := dprodWsdC defHb1. - rewrite sdprodE /= -(dprodW defH1CH1). - - rewrite mulgA (dprodWC defHb1) -morphim_setIpre -astabQ -quotientMl //. - by rewrite norm_joinEr // (subset_trans sCH1_U). - - rewrite mul_subG ?subIset // (subset_trans (quotientS _ sUHU)) //. - exact: normal_norm nsH1cHU. - rewrite -(setIidPl sH1cH) setIAC -setIA -group_modl // coprime_TIg ?mulg1 //. - by rewrite coprime_sym (coprimegS (subsetIl _ _)) ?coprime_morph. -have [nsH1cHCH1 sH1CH1_HCH1 _ nH1cH1C _] := sdprod_context defHCH1. -pose Clam := ('C_(U / H0)(H1) / (U' / H0))%G. -pose lam (j : Iirr Clam) := 'chi_(mod_Iirr j). -pose theta i j := cfSdprod defHCH1 (cfDprod defH1CH1 'chi_i (lam j)). -have nsU'CH1: U' <| 'C_U(H1 | 'Q) by rewrite (normalS _ sCH1_U) ?gFnormal. -have nsU'CH1b: U' / H0 <| 'C_(U / H0)(H1). - by rewrite -morphim_setIpre -astabQ quotient_normal. -have abClam: abelian Clam. - by rewrite sub_der1_abelian //= quotient_der ?dergS ?subsetIl. -have lam_lin j: lam j \is a linear_char. - by rewrite /lam mod_IirrE ?cfMod_lin_char //; apply/char_abelianP. -have theta_lin i j: theta i j \is a linear_char. - by rewrite cfSdprod_lin_char ?cfDprod_lin_char. -have <-: #|Clam| = #|'C_U(H1 | 'Q) : U'|. - rewrite -card_quotient ?normal_norm //= /= -morphim_setIpre -astabQ. - have nsU'U : U' <| U by apply: der_normal. - rewrite -(restrmEsub _ _ sCH1_U) -(restrm_quotientE _ sU'U) -morphim_quotm. - rewrite card_injm ?quotientS ?injm_quotm ?(isom_inj (quotient_isom _ _)) //. - by rewrite coprime_TIg ?(coprimeSg sH0H). -pose Mtheta := [set mod_Iirr (cfIirr (theta i j)) | i in [set~ 0], j in setT]. -have ->: (p.-1 * #|Clam|)%N = #|Mtheta|. - rewrite [Mtheta]curry_imset2X card_imset ?cardsX => [|[i1 j1] [i2 j2] /=/eqP]. - by rewrite cardsC1 cardsT !card_Iirr_abelian ?(abelianS sH1H) ?oH1. - rewrite (can_eq (mod_IirrK _)) // -(inj_eq irr_inj) !cfIirrE ?lin_char_irr //. - rewrite (can_eq (cfSdprodK _)) -!dprod_IirrE (inj_eq irr_inj). - by rewrite (can_eq (dprod_IirrK _)) => /eqP[->] /(can_inj (mod_IirrK _))->. -have{lam_lin} thetaH1 i j: 'Res[H1] (theta i j) = 'chi_i. - rewrite -(cfResRes _ _ sH1CH1_HCH1) ?joing_subl // cfSdprodK cfDprodKl //. - exact: lin_char1. -have Itheta r: r \in Mtheta -> 'I_HU['chi_r]%CF = HCH1. - case/imset2P=> i j; rewrite /= in_setC1 => nz_i _ Dr; apply/eqP. - rewrite eqEsubset sub_Inertia //= Dr mod_IirrE // cfIirrE ?lin_char_irr //. - rewrite andbT -(quotientSGK _ (normal_sub nsH0_HCH1)) ?subIset ?nH0HU //. - rewrite inertia_mod_quo //. - apply: subset_trans (sub_inertia_Res _ (nH1wHUb _ (group1 _))) _. - rewrite /= conjsg1 thetaH1 (inertia_irr_prime _ p_pr) //. - rewrite -quotient_setIpre -astabQ quotientS // -{1}(sdprodW defHU). - by rewrite -genM_join sub_gen // group_modl // sub_astabQ nH0H (centsS sH1H). -have irr_Xtheta: {in Mtheta, forall r, 'Ind[HU] 'chi_r \in irr HU}. - by move=> r Mr; rewrite /= inertia_Ind_irr ?Itheta. -pose Xtheta := [set cfIirr ('Ind[HU] 'chi_r) | r in Mtheta]. -have Da: a = #|HU : HCH1| by rewrite -(index_sdprodr defHU). -have Xtheta_1: {in Xtheta, forall s, 'chi_s 1%g = a%:R}. - move=> _ /imsetP[r Mr ->]; have /imset2P[i j _ _ Dr] := Mr. - rewrite cfIirrE ?irr_Xtheta ?cfInd1 //= -Da lin_char1 ?mulr1 //. - by rewrite Dr mod_IirrE ?cfMod_lin_char // cfIirrE ?lin_char_irr. -have nsH0U'HU: H0U' <| HU. - by apply: normalS nsH0U'_M; rewrite // -(sdprodWY defHU) genS ?setUSS. -have sXthetaXH0U': Xtheta \subset X_ H0U'. - apply/subsetP=> _ /imsetP[r Mr ->]; have [i j nz_i _ Dr] := imset2P Mr. - rewrite !inE cfIirrE ?irr_Xtheta ?sub_cfker_Ind_irr //= ?normal_norm //. - rewrite Dr mod_IirrE // cfIirrE ?lin_char_irr // join_subG andbCA. - rewrite {1}cfker_mod //= !{1}sub_cfker_mod //; apply/andP; split; last first. - rewrite -(sdprodWY (sdprod_cfker _ _)) sub_gen ?subsetU // orbC. - rewrite (subset_trans _ (cfker_dprod _ _ _)) // sub_gen ?subsetU // orbC. - by rewrite /lam mod_IirrE ?cfker_mod. - apply: contraL nz_i => /(subset_trans sH1H); rewrite !inE negbK. - by move/(sub_cfker_Res (subxx _)); rewrite thetaH1 subGcfker. -have nsCH1_U: 'C_U(H1 | 'Q) <| U by rewrite sub_der1_normal. -have nH1cU: (U / H0)%g \subset 'N(H1c). - rewrite -(bigdprodWY defH1c) norms_gen ?norms_bigcup //. - apply/bigcapsP=> w /setD1P[_ W1w]. - by rewrite normJ -sub_conjgV (normsP (quotient_norms H0 nUW1)) ?groupV. -have ->: #|Mtheta| = (#|Xtheta| * a)%N. - rewrite Da mulnC -card_imset_Ind_irr // => _ xy /imset2P[i j nz_i _ ->]. - case/(mem_sdprod defHU)=> x [y [Hx Uy -> _]]; have HUy := subsetP sUHU y Uy. - pose yb := inMb y; have Uyb: yb \in (U / H0)%g by rewrite mem_quotient. - pose iy := conjg_Iirr i yb; pose jy := conjg_Iirr j (coset (U' / H0)%g yb). - apply/imset2P; exists iy jy; rewrite !inE ?conjg_Iirr_eq0 // in nz_i *. - apply: irr_inj; have HCH1x: x \in HCH1 by rewrite mem_gen ?inE ?Hx. - rewrite conjg_IirrE (cfConjgM _ nsHCH1_HU) ?(subsetP sHHU x) {Hx}//. - rewrite {x HCH1x}(cfConjg_id _ HCH1x) !{1}mod_IirrE //. - rewrite !{1}cfIirrE ?lin_char_irr //. - rewrite cfConjgMod_norm ?(subsetP nH0U) ?(subsetP (normal_norm nsHCH1_HU)) //. - have nCH1_Ub: (U / H0)%g \subset 'N('C_(U / H0)(H1)). - by rewrite normsI ?normG ?norms_cent. - rewrite cfConjgSdprod ?cfConjgDprod ?(subsetP _ _ Uyb) ?normsY //. - rewrite /theta /lam !{1}mod_IirrE // !{1}conjg_IirrE. - by rewrite cfConjgMod_norm ?(subsetP _ _ Uyb) // quotient_norms ?gFnorm. -rewrite leq_pmul2r ?indexg_gt0 // cardE -(size_map (fun s => 'Ind[M] 'chi_s)). -have kerH1c s: s \in Xtheta -> H1c \subset (cfker 'chi_s / H0)%g. - case/imsetP=> r Mr {s}->; have [i j _ _ Dr] := imset2P Mr. - rewrite -(setIidPr (normal_sub nsH1cHCH1)) -morphim_setIpre quotientS //. - rewrite cfIirrE ?irr_Xtheta ?sub_cfker_Ind_irr //; last first. - by rewrite normsI ?normal_norm // -(quotientGK nsH0_HU) cosetpre_normal. - rewrite Dr mod_IirrE // cfker_morph ?normal_norm // cfIirrE ?lin_char_irr //. - by rewrite setIS ?joing_subl ?morphpreS // cfker_sdprod. -have injXtheta: - {in M & Xtheta &, forall w s1 s2, 'chi_s1 = 'chi_s2 ^ w -> w \in HU}%CF. -- move=> _ s1 s2 /(mem_sdprod defM)[y [w [HUy W1w -> _]]] Xs1 Xs2. - rewrite groupMl // cfConjgMnorm ?(subsetP (normG _) y) ?(subsetP nHUW1) //. - rewrite {y HUy}(cfConjg_id _ HUy) => Ds1. - have nH0w: w \in 'N(H0) by rewrite ?(subsetP nH0M) ?(subsetP sW1M). - rewrite (subsetP (normal_sub nsH0_HU)) // coset_idr //. - have /setDP[]:= subsetP sXthetaXH0U' s1 Xs1; rewrite !inE join_subG /=. - case/andP=> kerH0s1 _; apply: contraNeq; rewrite -eq_invg1 => ntw. - rewrite -(quotientSGK nH0H) // -(dprodW defHb1) mul_subG ?kerH1c //=. - rewrite Ds1 cfker_conjg ?(subsetP nHUW1) // quotientJ // -sub_conjgV. - rewrite (subset_trans _ (kerH1c s2 Xs2)) // -(bigdprodWY defH1c) sub_gen //. - by rewrite (bigcup_max (inMb w)^-1%g) // !inE ntw groupV mem_quotient. -rewrite -size_filter uniq_leq_size //. - apply/dinjectiveP=> s1 s2 Xs1 Xs2. - case/(cfclass_Ind_irrP _ _ (der_normal 1 M))/cfclassP=> y My Ds2. - by apply: irr_inj; rewrite Ds2 cfConjg_id ?(injXtheta y s1 s2). -move=> _ /imageP[s Xs ->]; rewrite mem_filter /= cfInd1 // -(index_sdprod defM). -rewrite Xtheta_1 // -natrM eqxx mem_seqInd ?gFnormal //. -rewrite (subsetP sXthetaXH0U') // !andbT inertia_Ind_irr ?gFnormal //. -by apply/subsetP=> y /setIP[My /inertiaJ/esym/injXtheta->]. -Qed. - -Import ssrnum Num.Theory. - -(* This is Peterfalvi (9.9); we have exported the fact that HU / H0 is a *) -(* Frobenius group in case (c), as this is directly used in (9.10). *) -Lemma typeP_Galois_characters (is_Galois : typeP_Galois) : - [/\ (*a*) {in X_ H0, forall s, (u %| 'chi_s 1%g)%Cx}, - {in X_ H0C', forall s, 'chi_s 1%g = u%:R /\ - (exists2 xi : 'CF(HC), xi \is a linear_char & 'chi_s = 'Ind xi)}, - (*b*) size mu_ = p.-1 /\ {in mu_, forall mu_j, isIndHC mu_j} - & (*c*) all redM (S_ H0C') -> - [/\ C :=: 1%g, u = (p ^ q).-1 %/ p.-1 - & [Frobenius HU / H0 = Hbar ><| (U / H0)]]]. -Proof. -have [F [phi [psi _ [Kpsi phiJ]]]] := typeP_Galois_P is_Galois. -case=> [oF /isomP[inj_phi im_phi] phiW2] [cycUbar co_u_p1 u_dv_pq1]. -have [nsHUM sW1M /mulG_sub[sHUM _] nHUW1 tiHUW1] := sdprod_context defM. -have [nsHHU sUHU /mulG_sub[sHHU _] nHU tiHU] := sdprod_context defHU. -have [nsH0C_M nsHC_M _ nsH0C'_M] := nsH0xx_M; have nH0H := normal_norm nsH0H. -have nsH0HU: H0 <| HU := normalS (subset_trans sH0H sHHU) sHUM nsH0M. -have nH0U: U \subset 'N(H0) := subset_trans sUHU (normal_norm nsH0HU). -have nH0C := subset_trans sCU nH0U. -have sH0C_HU: H0C \subset HU by rewrite -(sdprodWY defHU) genS ?setUSS. -have nsH0C_HU: H0C <| HU := normalS sH0C_HU sHUM nsH0C_M. -have nH0C_HU := normal_norm nsH0C_HU. -have [coH0U coHC] := (coprimeSg sH0H coHU, coprimegS sCU coHU). -have [nH0C_H nH0C_U] := (subset_trans sHHU nH0C_HU, subset_trans sUHU nH0C_HU). -have tiHOC_H: H0C :&: H = H0. - by rewrite /= norm_joinEr // -group_modl // setIC coprime_TIg ?mulg1. -have{coH0U} tiHOC_U: H0C :&: U = C. - by rewrite /= norm_joinEr // setIC -group_modr // setIC coprime_TIg ?mul1g. -have isoHbar: Hbar \isog H / H0C. - by have:= second_isog nH0C_H; rewrite tiHOC_H. -have isoUbar: Ubar \isog U / H0C. - by have:= second_isog nH0C_U; rewrite tiHOC_U. -have frobHU: [Frobenius HU / H0C = (H / H0C) ><| (U / H0C)]. - have defHUbar: (H / H0C) ><| (U / H0C) = (HU / H0C)%g. - exact: quotient_coprime_sdprod. - apply/Frobenius_semiregularP=> //; first by rewrite -(isog_eq1 isoHbar). - by rewrite -(isog_eq1 isoUbar); have [] := Frobenius_context frobUW1c. - move=> yb /setD1P[ntyb /morphimP[y nH0Cy Uy] Dyb] /=; rewrite Dyb. - apply/trivgP/subsetP=> _ /setIP[/morphimP[/= x nHOCx Hx ->] /cent1P/commgP]. - rewrite -morphR //; set xy := [~ x, y] => /eqP/coset_idr/=H0Cxy. - have [nH0x nH0y] := (subsetP nH0H x Hx, subsetP nH0U y Uy). - rewrite inE coset_id ?mem_gen // inE coset_idr //; apply: contraNeq ntyb. - rewrite -(morph_injm_eq1 inj_phi) ?mem_quotient // => nz_x. - rewrite {yb}Dyb /= coset_id ?mem_gen // -Kpsi !inE Uy orbC /= -val_eqE. - rewrite -(inj_eq (mulfI nz_x)) mulr1 -[_ * _]phiJ ?mem_quotient // qactJ nH0y. - rewrite -morphJ // conjg_mulR -/xy mkerr ?eqxx // ker_coset -tiHOC_H inE. - by rewrite andbC groupM ?groupV ?memJ_norm ?(subsetP nHU) //= H0Cxy ?groupR. -have{coHC} tiHbC: (Hbar :&: C / H0 = 1)%g by rewrite coprime_TIg ?coprime_morph. -have{tiHbC} defHCbar: Hbar \x (C / H0) = (HC / H0)%g. - by rewrite dprodEY ?quotientY // [C]unlock/= astabQ quotient_setIpre subsetIr. -have sHCHU: HC \subset HU by rewrite -(sdprodWY defHU) genS ?setUS. -have nsHCHU: HC <| HU := normalS sHCHU sHUM nsHC_M. -have sH0HC: H0 \subset HC := subset_trans sH0H (joing_subl H C). -have nsH0HC: H0 <| HC := normalS sH0HC sHCHU nsH0HU. -have nsHHUb: Hbar <| HU / H0 by rewrite quotient_normal. -have I_XH0_C i: i != 0 -> 'I_HU['chi[Hbar]_i %% H0]%CF = HC. - move=> /= nz_i; apply/esym/eqP. - have nsCHUb: C / H0 <| HU / H0 by rewrite -quotientYidl ?quotient_normal. - have sH0C_HC: H0C \subset HC by rewrite genS ?setSU. - have nsH0C_HC: H0C <| HC := normalS sH0C_HC sHCHU nsH0C_HU. - have [j Dj]: exists j, 'chi_j = (cfDprodl defHCbar 'chi_i %% H0)%CF. - by rewrite -dprodl_IirrE -mod_IirrE //; set j := mod_Iirr _; exists j. - have kerH0Cj: H0C \subset cfker 'chi_j. - by rewrite Dj sub_cfker_mod ?join_subG ?normG // quotientYidl ?cfker_sdprod. - rewrite inertia_mod_pre // -(inertia_dprodl defHCbar) ?normal_norm //. - rewrite -inertia_mod_pre // -Dj eqEsubset sub_Inertia //=. - rewrite -(quotientSGK _ sH0C_HC) ?subIset ?nH0C_HU -?inertia_quo //. - rewrite -(quotientYidr nH0C_H) joingA (joing_idPl sH0H) in frobHU. - rewrite -?quo_IirrE ?(inertia_Frobenius_ker (FrobeniusWker frobHU)) //. - by rewrite quo_Iirr_eq0 // -irr_eq1 Dj cfMod_eq1 // cfDprodl_eq1 irr_eq1. -have{I_XH0_C} irr_IndHC r: r \in Iirr_kerD HC H H0 -> 'Ind 'chi_r \in irr HU. - rewrite !inE => /andP[ker'H kerH0]; apply: inertia_Ind_irr => //. - apply: subset_trans (sub_inertia_Res _ (normal_norm nsHHU)) _. - rewrite -{kerH0}(quo_IirrK _ kerH0) // mod_IirrE // in ker'H *. - have /codomP[[i j] Dr] := dprod_Iirr_onto defHCbar (quo_Iirr H0 r). - rewrite {r}Dr dprod_IirrE cfResMod ?joing_subl ?sub_cfker_mod //= in ker'H *. - rewrite cfDprod_Resl linearZ inertia_scale_nz ?irr1_neq0 ?I_XH0_C //. - by apply: contraNneq ker'H => ->; rewrite irr0 cfDprod_cfun1l cfker_sdprod. -have [nb_mu H0C_mu] := nb_redM_H0; set part_a' := ({in X_ H0C', _}). -have Part_a s: s \in X_ H0 -> exists r, 'chi_s = 'Ind[HU, HC] 'chi_r. - rewrite !inE => /andP[Ks'H KsH0]; have [r sHCr] := constt_cfRes_irr HC s. - have{KsH0} KrH0: H0 \subset cfker 'chi_r. - by rewrite (sub_cfker_constt_Res_irr sHCr) // ?normal_norm. - have{Ks'H} Kr'H: ~~ (H \subset cfker 'chi_r). - by rewrite (sub_cfker_constt_Res_irr sHCr) ?joing_subl // ?normal_norm. - have [|s1 Ds1] := irrP _ (irr_IndHC r _); first by rewrite !inE Kr'H. - rewrite -constt_Ind_Res Ds1 constt_irr inE in sHCr. - by rewrite (eqP sHCr) -Ds1; exists r. -have [nH0HC nH0C'] := (normal_norm nsH0HC, subset_trans (der_sub 1 _) nH0C). -have Part_a': part_a'. - move=> s /setDP[KsH0C' Ks'H]; have [|r Ds] := Part_a s. - by rewrite inE Ks'H (subsetP (Iirr_kerS _ _) _ KsH0C') ?joing_subl. - suffices lin_r: 'chi_r \is a linear_char. - by split; [rewrite Du Ds cfInd1 ?lin_char1 ?mulr1 | exists 'chi_r]. - have KrH0C': H0C' \subset cfker 'chi_r. - rewrite inE Ds sub_cfker_Ind_irr // in KsH0C'. - by rewrite (subset_trans sHUM) ?normal_norm. - rewrite lin_irr_der1 (subset_trans _ KrH0C') //= (norm_joinEr nH0C'). - rewrite -quotientSK ?gFsub_trans ?quotient_der //= -/C. - by rewrite -(der_dprod 1 defHCbar) (derG1P abHbar) dprod1g. -split=> // [s /Part_a[r ->] | | {Part_a' part_a'}red_H0C']. -- by rewrite Du cfInd1 // dvdC_mulr // Cint_Cnat ?Cnat_irr1. -- split=> // mu_j /H0C_mu H0C_mu_j; have [s XH0Cs Dmuj] := seqIndP H0C_mu_j. - have [|s1u [xi lin_xi Ds]] := Part_a' s. - by rewrite (subsetP _ _ XH0Cs) ?Iirr_kerDS // genS ?setUS ?der_sub. - split=> //; first by rewrite Dmuj cfInd1 // s1u -natrM -(index_sdprod defM). - by rewrite Dmuj Ds cfIndInd //; exists xi. -have C1: C :=: 1%g. - apply: contraTeq red_H0C' => ntC; apply/allPn. - have sCM: C \subset M := subset_trans sCU (subset_trans sUHU sHUM). - have{sCM} solCbar: solvable (C / H0). - by rewrite quotient_sol ?(solvableS sCM) ?mmax_sol. - have [|{ntC solCbar} j lin_j nz_j] := solvable_has_lin_char _ solCbar. - rewrite -(isog_eq1 (quotient_isog _ _)) ?(subset_trans sCU) //. - by rewrite coprime_TIg ?(coprimegS sCU) ?(coprimeSg sH0H). - have [i lin_i nz_i] := solvable_has_lin_char ntHbar solHbar. - pose r := mod_Iirr (dprod_Iirr defHCbar (i, j)). - have KrH0: H0 \subset cfker 'chi_r by rewrite mod_IirrE ?cfker_mod. - have Kr'H: ~~ (H \subset cfker 'chi_r). - rewrite -subsetIidl -cfker_Res ?joing_subl ?irr_char // mod_IirrE //. - rewrite cfResMod ?joing_subl // sub_cfker_mod // dprod_IirrE. - by rewrite cfDprodKl ?lin_char1 // subGcfker -irr_eq1. - have [|s Ds] := irrP _ (irr_IndHC r _); first by rewrite !inE Kr'H. - have Ks'H: s \notin Iirr_ker HU H. - by rewrite inE -Ds sub_cfker_Ind_irr ?normal_norm. - exists ('Ind 'chi_s). - rewrite mem_seqInd ?gFnormal // inE Ks'H inE -Ds. - rewrite sub_cfker_Ind_irr // ?(subset_trans sHUM) ?normal_norm //=. - rewrite mod_IirrE // join_subG cfker_mod // sub_cfker_mod ?quotient_der //. - apply: subset_trans (dergS 1 (quotientS H0 (joing_subr H C))) _. - by rewrite -lin_irr_der1 dprod_IirrE cfDprod_lin_char. - apply: contra nz_j => red_j; have /implyP := H0C_mu ('Ind 'chi_s). - rewrite mem_filter red_j !mem_seqInd ?gFnormal // !in_setD Ks'H !inE -Ds. - rewrite irr_eq1 !sub_cfker_Ind_irr ?(normal_norm nsH0HU) //. - rewrite mod_IirrE // join_subG cfker_mod //= sub_cfker_mod // dprod_IirrE. - by move/(sub_cfker_Res (subxx _)); rewrite cfDprodKr ?lin_char1 ?subGcfker. -rewrite /= -/C C1 joingG1 in frobHU; split=> //; move/FrobeniusWker in frobHU. -have nsHbHU: Hbar <| (HU / H0) by rewrite quotient_normal. -have ->: (p ^ q).-1 = (#|X_ H0| * u)%N. - rewrite -oF -cardsT -im_phi card_injm // -(card_Iirr_abelian abHbar). - rewrite -(cardsC1 0) (card_imset_Ind_irr nsHbHU) => [|i|i y]; last first. - - by rewrite !inE conjg_Iirr_eq0. - - by rewrite !inE => nz_i; rewrite inertia_Ind_irr ?inertia_Frobenius_ker. - rewrite index_quotient_eq ?(subset_trans sHUM) ?subIset ?sH0H ?orbT //. - apply/eqP; rewrite Du /= C1 joingG1 mulnC eqn_pmul2r //. - rewrite -(card_imset _ (can_inj (mod_IirrK _))) // -imset_comp. - apply/eqP/eq_card=> s; apply/imsetP/idP=> [[i nz_i -> /=] | Xs]. - rewrite !inE mod_IirrE 1?{1}cfker_mod // andbT in nz_i *. - rewrite cfIirrE ?inertia_Ind_irr ?inertia_Frobenius_ker // sub_cfker_mod //. - by rewrite sub_cfker_Ind_irr ?quotientS ?normal_norm // subGcfker. - have [[]] := (Part_a s Xs, setDP Xs). - rewrite /= C1 joingG1 !inE => r Ds [kerH0s]. - have:= kerH0s; rewrite Ds !sub_cfker_Ind_irr ?normal_norm // => kerH0 ker'H. - exists (quo_Iirr H0 r). - by rewrite !inE -subGcfker quo_IirrE // cfker_quo ?quotientSGK. - by rewrite quo_IirrE // cfIndQuo // -Ds -quo_IirrE // irrK quo_IirrK. -suffices ->: #|X_ H0| = p.-1 by rewrite -(subnKC (prime_gt1 p_pr)) mulKn. -rewrite -nb_mu (size_red_subseq_seqInd_typeP MtypeP _ H0C_mu) //; last first. -- exact/allP/filter_all. -- by rewrite filter_uniq ?seqInd_uniq. -apply/esym/eq_card => i; rewrite inE mem_filter mem_seqInd ?gFnormal //. -rewrite andb_idl // => Xi; rewrite (allP red_H0C') //. -by rewrite mem_seqInd ?gFnormal //= C1 (trivgP (der_sub 1 _)) joingG1. -Qed. - -(* This combination of (9.8)(b) and (9.9)(b) covers most uses of these lemmas *) -(* in sections 10-14. *) -Lemma typeP_reducible_core_Ind (ptiWM := FT_primeTI_hyp MtypeP) : - [/\ size mu_ = p.-1, has predT mu_, - {subset mu_ <= [seq primeTIred ptiWM j | j in predC1 0]} - & {in mu_, forall mu_j, isIndHC mu_j}]. -Proof. -have [[sz_mu _] /mulG_sub[sHHU _]] := (nb_redM_H0, sdprodW defHU). -rewrite has_predT sz_mu -subn1 subn_gt0 prime_gt1 //; split=> // [mu_j|]. - rewrite mem_filter => /andP[red_chi /seqIndP[s /setDP[_ kerH's] Dchi]]. - have [[j Ds] | [/idPn[]]] := prTIres_irr_cases ptiWM s; last by rewrite -Dchi. - rewrite Dchi Ds cfInd_prTIres image_f ?inE //=. - by apply: contraNneq kerH's => j0; rewrite inE Ds j0 prTIres0 cfker_cfun1. -have[/typeP_Galois_characters[_ _ []] // | Gal'M] := boolP typeP_Galois. -by have [_ []] := typeP_nonGalois_characters Gal'M. -Qed. - -(* This is Peterfalvi (9.10), formulated as a constructive alternative. *) -Lemma typeP_reducible_core_cases : - {t : Iirr M & 'chi_t \in S_ H0C' /\ 'chi_t 1%g = (q * u)%:R - & {xi | xi \is a linear_char & 'chi_t = 'Ind[M, HC] xi}} - + [/\ typeP_Galois, [Frobenius HU / H0 = Hbar ><| (U / H0)], - cyclic U, #|U| = (p ^ q).-1 %/ p.-1 - & FTtype M == 2 -> [Frobenius HU = H ><| U]]. -Proof. -have [GalM | Gal'M] := boolP typeP_Galois; last first. - pose eqInHCb nu r := ('chi_r \is a linear_char) && (nu == 'Ind[M, HC] 'chi_r). - pose isIndHCb (nu : 'CF(M)) := - (nu 1%g == (q * u)%:R) && [exists r, eqInHCb nu r]. - suffices /sig2W[t H0C't]: exists2 t, 'chi_t \in S_ H0C' & isIndHCb 'chi_t. - case/andP=> /eqP t1qu /exists_inP/sig2W[r lin_r /eqP def_t]. - by left; exists t => //; exists 'chi_r. - have [_ _ [t [t1qu H0Ct IndHCt]] _] := typeP_nonGalois_characters Gal'M. - exists t; first by rewrite (seqIndS _ H0Ct) ?Iirr_kerDS ?genS ?setUS ?der_sub. - rewrite /isIndHCb t1qu eqxx; have [xi lin_xi ->] := IndHCt. - by apply/exists_inP; exists (cfIirr xi); rewrite cfIirrE ?lin_char_irr. -have [_ IndHC_SH0C' _] := typeP_Galois_characters GalM; rewrite all_predC. -case: hasP => [/sig2W[eta H0C'eta /irrP/sig_eqW[t Dt]] _ | _ [//|C1 <- frobHU]]. - have /sig2_eqW[s /IndHC_SH0C'[s1u IndHCs] Deta] := seqIndP H0C'eta. - have [joinHU [xi lin_xi Ds]] := (sdprodWY defHU, sig2_eqW IndHCs). - left; exists t; first split; rewrite -Dt // Deta. - by rewrite cfInd1 ?der_sub // -(index_sdprod defM) s1u -natrM. - by exists xi; rewrite ?Ds ?cfIndInd ?der_sub // -joinHU genS ?setUS ?subsetIl. -have cycU: cyclic U. - rewrite (isog_cyclic (quotient1_isog _)) -C1. - by have [_ _ []] := typeP_Galois_P GalM. -right; split=> //; first by rewrite /u /Ubar C1 -(card_isog (quotient1_isog _)). -case/(compl_of_typeII maxM MtypeP) => /= _ _ _ UtypeF <-. -have [_ -> _] := typeF_context UtypeF. -by apply/forall_inP=> S /and3P[_ /cyclicS->]. -Qed. - -Import ssrint. - -(* This is Peterfalvi (9.11) *) -(* We had to cover a small gap in step (9.11.4) of the proof, which starts by *) -(* proving that U1 \subset {1} u A(M), then asserts this obviously implies *) -(* HU1 \subset {1} u A(M). It is not, as while {1} u A(M) does contain H, it *) -(* is not (necessarily) a subgroup. We had to use the solvability of HU1 in a *) -(* significant way (using Philip Hall's theorems) to bridge the gap; it's *) -(* also possible to exploit lemma (2.1) (partition_cent_rcoset in PFsection1) *) -(* in a slightly different argument, but the inference is nontrivial in *) -(* either case. *) -Lemma Ptype_core_coherence : coherent (S_ H0C') M^# tau. -Proof. -have [nsHUM sW1M /mulG_sub[sHUM _] nHUW1 tiHUW1] := sdprod_context defM. -have [nsHHU sUHU /mulG_sub[sHHU _] nHU tiHU] := sdprod_context defHU. -have nsCU: C <| U := normalS sCU (joing_subl _ _) nsCUW1. -have [_ nCU] := andP nsCU; have sC'C: C^`(1)%g \subset C := der_sub 1 _. -have coHC := coprimegS sCU coHU; have coH0C := coprimeSg sH0H coHC. -have [nsH0C_M nsHC_M nsH0U'_M nsH0C'_M] := nsH0xx_M; have [_ nH0H]:= andP nsH0H. -have nH0HU := subset_trans sHUM nH0M; have nH0U := subset_trans sUHU nH0HU. -have nH0C := subset_trans sCU nH0U; have nH0C' := subset_trans sC'C nH0C. -have sHCHU: HC \subset HU by rewrite join_subG sHHU (subset_trans sCU). -have [nsHCHU nHC] := (normalS sHCHU sHUM nsHC_M, subset_trans sCU nHU). -have tiHCbar: Hbar :&: (C / H0)%g = 1%g by rewrite coprime_TIg ?coprime_morph. -have defHCbar: Hbar \x (C / H0) = (HC / H0)%g. - by rewrite dprodEY ?quotientY // [C]unlock/= astabQ quotient_setIpre subsetIr. -have{tiHCbar} defHC'bar: (HC / H0)^`(1)%g = (C^`(1) / H0)%g. - by rewrite -(der_dprod 1 defHCbar) (derG1P abHbar) dprod1g quotient_der. -have sU'U := der_sub 1 U; have nH0U' := subset_trans sU'U nH0U. -have sU'C: U' \subset C. - by rewrite [C]unlock subsetI sub_astabQ sU'U nH0U' quotient_cents. -have uS0: uniq (S_ H0C') by apply: seqInd_uniq. -have [rmR scohS0]: exists R : 'CF(M) -> seq 'CF(G), subcoherent (S_ H0C') tau R. - move: (FTtypeP_coh_base _ _) (FTtypeP_subcoherent maxM MtypeP) => R scohR. - exists R; apply: (subset_subcoherent scohR). - split=> //; last exact: cfAut_seqInd. - by apply: seqIndS; rewrite Iirr_kerDS ?sub1G ?Fcore_sub_FTcore. -have [GalM | Gal'M] := boolP typeP_Galois. - have [_ XOC'u _ _] := typeP_Galois_characters GalM. - apply: uniform_degree_coherence scohS0 _. - apply: all_pred1_constant (#|M : HU| * u)%:R _ _; rewrite all_map. - by apply/allP=> _ /seqIndP[s /XOC'u[s1u _] ->] /=; rewrite natrM cfInd1 ?s1u. -have:= typeP_nonGalois_characters Gal'M. -set U1 := 'C_U(_ | _); set a := #|_ : _|. -case: (_ Gal'M) => /= H1 [oH1 nH1U _ defHbar aP] in U1 a *. -rewrite -/U1 -/a in aP; case: aP => a_gt1 a_dv_p1 cycU1 _. -case=> [a_dv_XH0 [nb_mu IndHCmu] has_irrHC lb_Sqa]; rewrite -[S_ _]/(S_ H0C'). -have defHb1 := defHbar; rewrite (big_setD1 1%g) ?group1 ?conjsg1 //= in defHb1. -have [[_ H1c _ defH1c] _ _ _] := dprodP defHb1; rewrite defH1c in defHb1. -have [nsH1H _] := dprod_normal2 defHb1; have [sH1H _] := andP nsH1H. -have nsU1U: U1 <| U; last have [sU1U nU1U] := andP nsU1U. - by rewrite norm_normalI // astabQ norm_quotient_pre ?norms_cent. -have Da: a = #|HU : H <*> U1|. - rewrite /a -!divgS /= ?join_subG ?sHHU ?norm_joinEr ?(subset_trans sU1U) //=. - by rewrite -(sdprod_card defHU) coprime_cardMg ?(coprimegS sU1U) ?divnMl. -have sCU1: C \subset U1 by rewrite [C]unlock setIS ?astabS. -have a_dv_u: a %| u by rewrite Da Du indexgS ?genS ?setUS. -have [a_gt0 q_gt0 u_gt0 p1_gt0]: [/\ 0 < a, 0 < q, 0 < u & 0 < p.-1]%N. - rewrite !cardG_gt0 ltnW // -subn1 subn_gt0 prime_gt1 //. -have [odd_p odd_q odd_a]: [/\ odd p, odd q & odd a]. - by rewrite mFT_odd -oH1 (oddSg sH1H) ?(dvdn_odd a_dv_u) ?mFT_quo_odd. -have Dp: p = (2 * p.-1./2 + 1)%N. - by rewrite mul2n -[p]odd_double_half odd_p half_double addn1. -(* Start of main proof. *) -pose S1 := filter [pred zeta : 'CF(M) | zeta 1%g == (q * a)%:R] (S_ H0C'). -have ntS1: (0 < size S1)%N. - have [lb_dv lbS1] := lb_Sqa; apply: leq_trans (leq_trans lbS1 _). - by rewrite ltn_divRL // mul0n muln_gt0 p1_gt0 cardG_gt0. - rewrite -size_filter uniq_leq_size ?filter_uniq ?seqInd_uniq // => chi. - rewrite !mem_filter -andbA /= => /and3P[_ ->]. - by apply: seqIndS; rewrite Iirr_kerDS // genS ?setUS ?dergS ?subsetIl. -have sS10: cfConjC_subset S1 (S_ H0C'). - split=> [||chi]; first by rewrite filter_uniq. - by apply: mem_subseq; apply: filter_subseq. - rewrite !mem_filter !inE cfunE => /andP[/eqP <- S0chi]. - by rewrite cfAut_seqInd // andbT conj_Cnat ?(Cnat_seqInd1 S0chi). -have cohS1: coherent S1 M^# tau. - apply: uniform_degree_coherence (subset_subcoherent scohS0 sS10) _. - by apply: all_pred1_constant (q * a)%:R _ _; rewrite all_map filter_all. -pose S3 := filter [predC S1] (S_ H0C'); move: {2}_.+1 (ltnSn (size S3)) => nS. -move: @S3 (sS10) (cohS1); have: {subset S1 <= S1} by []. -elim: nS {-1}S1 => // nS IHnS S2 => sS12 S3 sS20 cohS2; rewrite ltnS => leS3nS. -have [ntS3|] := boolP (size S3 > 0)%N; last first. - rewrite size_filter -has_count has_predC negbK => /allP sS02. - exact: subset_coherent sS02 cohS2. -(* Ultimateley we'll contradict the maximality of S2 in (9.11.1) & (9.11.8). *) -suff [chi]: exists2 chi, chi \in S3 & coherent (chi :: chi^* :: S2)%CF M^# tau. - rewrite mem_filter => /andP[/= S2'chi S0chi]; have [uS2 sS2S0 ccS2] := sS20. - move/IHnS; apply=> [psi /sS12 S1psi||]; first by rewrite 2?mem_behead. - split. - - rewrite /= !inE negb_or S2'chi (contra (ccS2 _)) ?cfConjCK // eq_sym. - by rewrite (seqInd_conjC_neq _ _ _ S0chi) ?mFT_odd. - - by apply/allP; rewrite /= S0chi cfAut_seqInd //=; apply/allP. - apply/allP; rewrite /= !inE cfConjCK !eqxx orbT /=. - by apply/allP=> psi /ccS2; rewrite !inE orbA orbC => ->. - apply: leq_trans leS3nS; rewrite ltnNge; apply: contra S2'chi. - case/leq_size_perm=> [|psi|/(_ chi)]; first by rewrite filter_uniq. - by rewrite !mem_filter !inE orbA negb_or -andbA => /andP[]. - by rewrite !mem_filter !inE eqxx S0chi !andbT => /esym/negbFE. -(* This is step (9.11.1). *) clear nS IHnS leS3nS. -without loss [[eqS12 irrS1 H0C_S1] [Da_p defC] [S3qu ne_qa_qu] [oS1 oS1ua]]: - / [/\ [/\ S1 =i S2, {subset S1 <= irr M} & {subset S1 <= S_ H0C}], - a = p.-1./2 /\ C :=: U', - (forall chi, chi \in S3 -> chi 1%g == (q * u)%:R) /\ (q * u != q * a)%N - & size S1 = (p.-1 * u %/ a ^ 2)%N /\ size S1 = (2 * u %/ a)%N]. -- move=> IHwlog; have{sS20} [[uS2 sS20 ccS2] [uS1 _ _]] := (sS20, sS10). - pose is_qu := [pred chi : 'CF(M) | chi 1%g == (q * u)%:R]. - pose isn't_qu := [pred chi | is_qu chi ==> all is_qu S3]. - have /hasP[chi S3chi qu'chi]: has isn't_qu S3. - rewrite /isn't_qu; have [_|] := boolP (all _ _); last by rewrite has_predC. - by rewrite (eq_has (fun _ => implybT _)) has_predT. - have [S2'chi S0chi]: chi \notin S2 /\ chi \in S_ H0C'. - by apply/andP; rewrite mem_filter in S3chi. - have [s X0C's Dchi] := seqIndP S0chi. - have Dchi1: chi 1%g = q%:R * 'chi_s 1%g. - by rewrite Dchi cfInd1 // -(index_sdprod defM). - (* We'll show lb0 <= lb1 <= lb <= lb3 <= sumnS S1' <= sumnS S2 <= lb0, *) - (* with equality under conditions that imply the conclusion of (9.11.1). *) - pose lb0 := (2 * q * a)%:R * chi 1%g. - pose lb1 : algC := (2 * a * q ^ 2 * u)%:R. - pose lb2 : algC := (p.-1 * q ^ 2 * u)%:R. - pose lb3 : algC := (p.-1 * q ^ 2 * #|U : U'|)%:R. - pose S1' := filter [predI irr M & S_ H0U'] S1. - pose szS1' := ((p.-1 * #|U : U'|) %/ a ^ 2)%N; set lbS1' := _ %/ _ in lb_Sqa. - pose Snorm (psi : 'CF(M)) := psi 1%g ^+ 2 / '[psi]. - pose sumnS Si := \sum_(psi <- Si) Snorm psi. - have lb01: lb0 <= lb1 ?= iff (chi 1%g == (q * u)%:R). - rewrite /lb1 mulnA -mulnA natrM /lb0 mulnAC mono_lerif; last first. - by apply: ler_pmul2l; rewrite ltr0n !muln_gt0 a_gt0. - apply: lerif_eq; rewrite Dchi1 natrM ler_pmul2l ?gt0CG //. - have [KsH0C' _] := setDP X0C's; rewrite inE in KsH0C'. - have [t sHCt] := constt_cfRes_irr HC s. - have KtH0C': H0C' \subset cfker 'chi_t. - apply: subset_trans (cfker_constt (cfRes_char _ (irr_char s)) sHCt). - by rewrite cfker_Res ?irr_char // subsetI genS ?setUSS. - rewrite -constt_Ind_Res in sHCt. - apply: ler_trans (char1_ge_constt (cfInd_char _ (irr_char t)) sHCt) _. - rewrite cfInd1 // -Du lin_char1 ?mulr1 // lin_irr_der1. - apply: subset_trans KtH0C'; rewrite /= (norm_joinEr nH0C') /= -/C. - rewrite -quotientSK ?(subset_trans (der_sub _ _)) ?(subset_trans sHCHU) //. - by rewrite -defHC'bar quotient_der ?(subset_trans sHCHU). - have lb12: lb1 <= lb2 ?= iff (a == p.-1./2). - rewrite -(@eqn_pmul2l 2) // -(canLR (addnK 1) Dp) subn1 lerif_nat. - rewrite !(mono_leqif (fun _ _ => leq_pmul2r _)) ?expn_gt0 ?q_gt0 //. - apply: leqif_eq; rewrite dvdn_leq // Gauss_dvd //. - by rewrite {1}Dp addn1 dvdn_mulr. - by rewrite prime_coprime ?dvdn2 ?negbK. - have lb23: lb2 <= lb3 ?= iff (C :==: U') :> algC. - rewrite lerif_nat [u]card_quotient //. - rewrite (mono_leqif (fun _ _ => leq_pmul2l _)) ?muln_gt0 ?p1_gt0 ?q_gt0 //. - rewrite -(mono_leqif (fun _ _ => leq_pmul2l (cardG_gt0 C))) Lagrange //. - rewrite -(Lagrange sU'U) (mono_leqif (fun _ _ => leq_pmul2r _)) //. - by rewrite eq_sym; apply: subset_leqif_cards. - have lb3S1': lb3 <= sumnS S1' ?= iff (size S1' == szS1'). - rewrite /szS1' -(divnMr (cardG_gt0 U')) mulnAC -mulnA Lagrange // -/lbS1'. - have{lb_Sqa} [dv_lb lbSqa] := lb_Sqa; rewrite [sumnS S1']big_seq. - rewrite (eq_bigr (fun _ => ((q * a) ^ 2)%:R)) => [|psi]; last first. - rewrite !mem_filter -!andbA => /and4P[/irrP[r ->] _ /=/eqP r1qa _]. - by rewrite /Snorm cfnorm_irr divr1 r1qa natrX. - rewrite -big_seq (big_nth 0) -natr_sum sum_nat_const_nat subn0. - rewrite mulnC natrM [*%R]lock /lb3 natrM natf_indexg ?der_sub // mulrA. - rewrite -natrM mulnAC -(divnK dv_lb) mulnAC mulnA natrM mulfK ?neq0CG //. - rewrite -/lbS1' -mulnA -expnMn natrM mulrC -lock mono_lerif; last first. - by apply: ler_pmul2l; rewrite ltr0n !muln_gt0 a_gt0 q_gt0. - rewrite eq_sym lerif_nat; apply: leqif_eq; rewrite (leq_trans lbSqa) //. - rewrite -size_filter uniq_leq_size ?filter_uniq ?seqInd_uniq // => psi. - rewrite !mem_filter -!andbA /= => /and3P[-> -> S0psi]; rewrite S0psi. - by apply: seqIndS S0psi; rewrite Iirr_kerDS //= genS ?setUS ?dergS. - have lbS1'2: sumnS S1' <= sumnS S2 ?= iff ~~ has [predC S1'] S2. - have Ds2: perm_eq S2 (S1' ++ filter [predC S1'] S2). - rewrite -(perm_filterC (mem S1')) perm_cat2r. - rewrite uniq_perm_eq ?filter_uniq // => psi. - by rewrite mem_filter andb_idr //= mem_filter => /andP[_ /sS12]. - rewrite [sumnS S2](eq_big_perm _ Ds2) big_cat /= -/(sumnS S1') big_filter. - rewrite -all_predC -big_all_cond !(big_tnth _ _ S2) big_andE. - rewrite -{1}[_ S1']addr0 mono_lerif; last exact: ler_add2l. - set sumS2' := \sum_(i | _) _; rewrite -[0]/(sumS2' *+ 0) -sumrMnl. - apply: lerif_sum => i _; apply/lerifP; rewrite lt0r !mulf_eq0 invr_eq0. - set psi := tnth _ i; have Spsi := sS20 psi (mem_tnth _ _). - rewrite !negb_or (seqInd1_neq0 _ Spsi) //= (cfnorm_seqInd_neq0 _ Spsi) //=. - by rewrite divr_ge0 ?exprn_ge0 ?cfnorm_ge0 ?Cnat_ge0 ?(Cnat_seqInd1 Spsi). - have [lb0S2 | ] := boolP (lb0 < sumnS S2). - exists chi => //; have /hasP[xi S1xi _]: has predT S1 by rewrite has_predT. - have xi1: xi 1%g = (q * a)%:R. - by rewrite mem_filter in S1xi; have [/eqP] := andP S1xi. - apply: (extend_coherent scohS0 _ (sS12 _ S1xi)) => //. - split=> //; last by rewrite mulrAC xi1 -natrM mulnA. - rewrite xi1 Dchi1 irr1_degree -natrM dvdC_nat dvdn_pmul2l ?cardG_gt0 //. - rewrite -dvdC_nat /= !nCdivE -irr1_degree a_dv_XH0 //. - by rewrite (subsetP (Iirr_kerDS _ _ _) _ X0C's) ?joing_subl. - have lb1S2 := lerif_trans lb12 (lerif_trans lb23 (lerif_trans lb3S1' lbS1'2)). - rewrite ltr_neqAle !(lerif_trans lb01 lb1S2) andbT has_predC !negbK. - case/and5P=> /eqP-chi1qu /eqP-Da_p /eqP-defC /eqP-sz_S1' /allP/=sS21'. - have defS1': S1' = S1. - apply/eqP; rewrite -(geq_leqif (size_subseq_leqif (filter_subseq _ S1))). - by rewrite uniq_leq_size // => psi /sS12/sS21'. - apply: IHwlog; split=> //. - + split=> psi; do 1?[rewrite -defS1' mem_filter andbC => /and3P[_ _] //=]. - by apply/idP/idP=> [/sS12 | /sS21']; rewrite ?defS1'. - by congr (_ \in S_ _); apply/group_inj; rewrite /= defC. - + split; first by apply/allP; apply: contraLR qu'chi; rewrite /= chi1qu eqxx. - rewrite -eqC_nat -chi1qu; apply: contra S2'chi => chi1qa. - by rewrite sS12 // mem_filter /= chi1qa. - rewrite -defS1' sz_S1' /szS1' -defC -card_quotient // -/u. - by split=> //; rewrite -mulnn {1}Dp addn1 -Da_p mulnAC divnMr. -have nCW1: W1 \subset 'N(C). - by rewrite (subset_trans (joing_subr U W1)) ?normal_norm. -(* This is step (9.11.2). *) clear sS20 cohS2 sS12 has_irrHC lb_Sqa sU'C. -have [tiU1 le_u_a2]: {in W1^#, forall w, U1 :&: U1 :^ w = C} /\ (u <= a ^ 2)%N. - have tiU1 w: w \in W1^# -> U1 :&: U1 :^ w = C; last split => //. - case/setD1P=> ntw W1w; have nH0w := subsetP (subset_trans sW1M nH0M) w W1w. - pose wb := coset H0 w; have W1wb: wb \in W1bar^#. - rewrite !inE mem_quotient ?(contraNneq _ ntw) // => /coset_idr H0w. - rewrite -in_set1 -set1gE -tiHUW1 inE (subsetP sHHU) // (subsetP sH0H) //. - by rewrite H0w. - have ntH1 w1: H1 :^ w1 :!=: 1%g by rewrite -cardG_gt1 cardJg oH1 prime_gt1. - pose t_ w1 := - if pred2 1%g wb w1 then sval (has_nonprincipal_irr (ntH1 w1)) else 0. - pose theta := - cfDprodl defHCbar (cfBigdprod defHbar (fun w1 => 'chi_(t_ w1))). - have lin_theta : theta \is a linear_char. - rewrite cfDprodl_lin_char ?cfBigdprod_lin_char // => w1 _. - by rewrite irr_prime_lin ?cardJg ?oH1. - have nsH0HC: H0 <| HC. - by rewrite /normal join_subG nH0H sub_gen ?subsetU ?sH0H. - move defK: H0C => K. (* to avoid divergence in Coq kernel *) - have kerK: K \subset cfker (theta %% H0). - rewrite -defK sub_cfker_mod ?join_subG ?normG ?quotientYidl //. - exact: cfker_sdprod. - have sKHC: K \subset HC by rewrite -defK genS ?setSU. - have nsKHC: K <| HC by rewrite (normalS sKHC (normal_sub nsHC_M)) -?defK. - have sH0K: H0 \subset K by rewrite -defK joing_subl. - have nsKHU: K <| HU. - by rewrite (normalS (subset_trans sKHC sHCHU) sHUM) -?defK. - have [t2 Dt2]: {t2 : Iirr (HC / K) | 'chi_t2 %% K = theta %% H0}%CF. - exists (cfIirr ((theta %% H0) / K)). - by rewrite cfIirrE ?cfQuoK ?cfQuo_irr ?cfMod_irr ?lin_char_irr. - have nsHChatHU: HC / K <| HU / K by rewrite quotient_normal. - have sHChatHU := normal_sub nsHChatHU. - pose That := 'I_(HU / K)['chi_t2]%G. - have sThatHU: That \subset (HU / K)%G := Inertia_sub _ _. - have abThatHC: abelian (That / (HC / K)). - rewrite (abelianS (quotientS _ sThatHU)) //. - rewrite (isog_abelian (third_isog _ _ _)) // defC. - rewrite -(isog_abelian (quotient_sdprodr_isog defHU _)) ?gFnormal //. - by rewrite sub_der1_abelian. - have hallHChat: Hall That (HC / K). - rewrite /Hall -(card_isog (third_isog sH0K nsH0HC nsKHC)) /=. - rewrite sub_Inertia // -[in #|_|]defK /= quotientYidl //. - rewrite -(card_isog (sdprod_isog (dprodWsdC defHCbar))). - apply: coprime_dvdr (indexSg (sub_Inertia _ sHChatHU) sThatHU) _. - apply: coprime_dvdr (index_quotient _) _. - by rewrite subIset // normal_norm. - by rewrite -Du coprime_morphl // coprime_morphr. - have [s t2HUs] := constt_cfInd_irr t2 sHChatHU. - have s_1: ('chi_s %% K)%CF 1%g = #|U : U1 :&: U1 :^ w|%:R. - rewrite cfMod1. - have [||_ _ ->] // := cfInd_Hall_central_Inertia _ abThatHC. - rewrite -cfMod1 Dt2 cfMod1 lin_char1 //= mulr1 -inertia_mod_quo // Dt2. - rewrite index_quotient_eq ?normal_norm ?Inertia_sub ?setIS //; last first. - by rewrite (subset_trans sKHC) ?sub_inertia. - rewrite /= inertia_morph_pre //= -quotientE inertia_dprodl; first 1 last. - - by rewrite quotient_norms ?normal_norm. - - rewrite /= -(quotientYidl nH0C) quotient_norms ?normal_norm //. - by rewrite -defK in nsKHU. - have nH1wHU w1: w1 \in (W1 / H0)%g -> (HU / H0)%g \subset 'N(H1 :^ w1). - move=> W1w1; rewrite -(normsP (quotient_norms H0 nHUW1) _ W1w1) normJ. - rewrite conjSg /= -(sdprodW defHU) quotientMl ?mul_subG //. - exact: normal_norm. - rewrite indexgI /= inertia_bigdprod_irr // (big_setD1 1%g) ?group1 //=. - rewrite 2!{1}setIA setIid (bigD1 wb) //= {1 2}/t_ /= !eqxx ?orbT /=. - rewrite !(inertia_irr_prime _ p_pr) ?cardJg //=; - try by case: (has_nonprincipal_irr _). - rewrite conjsg1 centJ setIA -setIIr /=. - elim/big_rec: _ => [|w1 Uk /andP[/setD1P[ntw1 Ww1] w'w1] IHk]; last first. - rewrite /t_ -if_neg negb_or ntw1 w'w1 irr0 Inertia1 -?setIIr 1?setIA //. - rewrite /normal nH1wHU //= -(normsP (quotient_norms H0 nHUW1) _ Ww1). - by rewrite conjSg (subset_trans sH1H) ?quotientS. - rewrite setIT !morphpreI morphpreJ ?(subsetP nH0W1) //= -astabQ. - rewrite quotientGK //; last by rewrite /normal (subset_trans sH0H). - rewrite -(sdprodWY (sdprod_modl defHU _)); last first. - rewrite subsetI -sub_conjgV. - rewrite (normsP (gFnorm _ _)) ?groupV ?(subsetP sW1M) //= andbb. - by rewrite sub_astabQ nH0H sub_abelian_cent. - rewrite -(index_sdprodr defHU) ?subsetIl // conjIg (normsP nUW1) //. - by rewrite -setIIr. - apply/esym/eqP; rewrite eqEcard subsetI -sub_conjgV. - rewrite (normsP _ _ (groupVr W1w)) ?sCU1 /=; last first. - by rewrite (subset_trans (joing_subr U W1)) ?normal_norm. - have{s_1} : pred2 u a #|U : U1 :&: U1 :^ w|. - rewrite /= -!eqC_nat -{}s_1 -mod_IirrE //. - pose phi := 'Ind[M] 'chi_(mod_Iirr s). - have Sphi: phi \in S_ H0C'. - rewrite mem_seqInd ?gFnormal // !inE mod_IirrE //. - rewrite andbC (subset_trans _ (cfker_mod _ _)) //=; last first. - by rewrite -defK genS ?setUS ?der_sub. - rewrite sub_cfker_mod ?(subset_trans sHHU) ?normal_norm //. - have sHHC: H \subset HC by rewrite joing_subl. - rewrite -(sub_cfker_constt_Ind_irr t2HUs) ?quotientS //; last first. - by rewrite quotient_norms ?normal_norm. - rewrite -sub_cfker_mod ?(subset_trans sHHU (normal_norm nsKHU)) //. - rewrite Dt2 sub_cfker_mod //. - apply: contra (valP (has_nonprincipal_irr (ntH1 1%g))). - move/eq_cfker_Res; rewrite cfDprodlK => kerHbar. - have:= sH1H; rewrite -{1}(conjsg1 H1) -kerHbar => /eq_cfker_Res. - by rewrite cfBigdprodKabelian ?group1 // /t_ /= eqxx -subGcfker => ->. - have [/S3qu | ] := boolP (phi \in S3). - rewrite cfInd1 // natrM -(index_sdprod defM). - by rewrite (inj_eq (mulfI (neq0CG _))) => ->. - rewrite mem_filter Sphi andbT negbK /= -eqS12 mem_filter Sphi andbT /=. - rewrite cfInd1 // natrM -(index_sdprod defM) (inj_eq (mulfI (neq0CG _))). - by rewrite orbC => ->. - case/pred2P=> [iUCu | iUCa]. - rewrite -(leq_pmul2r u_gt0) -{1}iUCu /u card_quotient ?Lagrange //. - by rewrite /= -setIA subsetIl. - rewrite subset_leq_card // subIset // [C]unlock subsetI subsetIl sub_astabQ. - rewrite subIset ?nH0U //= centsC -(bigdprodWY defHbar) gen_subG. - apply/orP; left; apply/bigcupsP=> w1 Ww1; rewrite centsC centJ -sub_conjgV. - rewrite (normsP _ _ (groupVr Ww1)) ?quotient_norms //. - by rewrite /U1 astabQ quotient_setIpre subsetIr. - rewrite prime_meetG //; apply/trivgPn; exists w; rewrite // !inE W1w. - rewrite (sameP setIidPr eqP) eqEcard subsetIr /= cardJg. - by rewrite -(leq_pmul2r a_gt0) -{2}iUCa !Lagrange //= -setIA subsetIl. - have /trivgPn[w W1w ntw]: W1 :!=: 1%g by rewrite -cardG_gt1 prime_gt1. - rewrite -(leq_pmul2l u_gt0) mulnn. - have nCU1 := subset_trans sU1U nCU. - have {1}->: u = (#|(U1 / C)%g| * a)%N. - by rewrite mulnC /u !card_quotient // Lagrange_index. - rewrite expnMn leq_pmul2r ?expn_gt0 ?orbF // -mulnn. - rewrite -{2}[U1](conjsgK w) quotientJ ?groupV ?(subsetP nCW1) //. - rewrite cardJg -TI_cardMg /= -/U1 ?subset_leq_card //. - rewrite mul_subG ?quotientS ?subsetIl //. - by rewrite -(normsP nUW1 w W1w) conjSg subsetIl. - by rewrite -quotientGI // tiU1 ?trivg_quotient // !inE ntw. -pose S4 := filter [predD S_ H0C & redM] S3. -have sS43: {subset S4 <= S3} by apply: mem_subseq; apply: filter_subseq. -(* This is step (9.11.3). *) -have nsHM: H <| M by apply: gFnormal. -have oS4: (q * u * size S4 + p.-1 * (q + u))%N = (p ^ q).-1. - rewrite mulnAC {1}[q](index_sdprod defM) -[S4]filter_predI. - rewrite (size_irr_subseq_seqInd _ (filter_subseq _ _)) //; last first. - by move=> xi; rewrite mem_filter -!andbA negbK => /andP[]. - set Xn := finset _; pose sumH0C := \sum_(s in X_ H0C) 'chi_s 1%g ^+ 2. - have /eqP: sumH0C = (q * size S1 * a ^ 2 + (#|Xn| + p.-1) * u ^ 2)%:R. - rewrite [q](index_sdprod defM) natrD natrM natrX. - rewrite (size_irr_subseq_seqInd _ (filter_subseq _ _)) //= -/S1. - have sH0CC': {subset S_ H0C <= S_ H0C'}. - by apply: seqIndS; rewrite Iirr_kerDS // genS ?setUS ?der_sub. - rewrite [sumH0C](big_setID [set s | 'Ind 'chi_s \in S1]) /=; congr (_ + _). - rewrite mulr_natl -[rhs in _ = rhs]sumr_const; apply: eq_big => s. - by rewrite in_setI inE andb_idl // => /H0C_S1; rewrite mem_seqInd. - rewrite 2!inE mem_filter andbCA /= cfInd1 // -(index_sdprod defM) natrM. - by case/andP=> /eqP/(mulfI (neq0CG _))->. - rewrite (eq_bigr (fun _ => u%:R ^+ 2)) => [|s]; last first. - rewrite 2!inE eqS12 => /andP[S2's H0Cs]; congr (_ ^+ 2). - have /S3qu/eqP: 'Ind 'chi_s \in S3. - by rewrite mem_filter /= S2's sH0CC' ?mem_seqInd. - by rewrite natrM cfInd1 // -(index_sdprod defM) => /(mulfI (neq0CG _)). - rewrite sumr_const -mulr_natl natrM natrX -nb_mu; congr (_%:R * _). - have [_ s_mu_H0C] := nb_redM_H0. - rewrite (size_red_subseq_seqInd_typeP MtypeP _ s_mu_H0C); last first. - - by apply/allP; apply: filter_all. - - by rewrite filter_uniq ?seqInd_uniq. - rewrite -/mu_ -[#|_|](cardsID Xn) (setIidPr _); last first. - apply/subsetP=> s; rewrite inE in_setD mem_filter /= -!andbA -eqS12. - rewrite mem_seqInd ?gFnormal // => /and4P[_ -> S1'xi _]. - by rewrite inE S1'xi. - congr (_ + _)%N; apply: eq_card => i; rewrite inE -/mu_ 2!inE. - rewrite -[seqInd M _]/(S_ H0C') mem_filter /= andbC 2!inE eqS12 -!andbA. - rewrite -(mem_seqInd nsHUM) // -/(S_ H0C); set xi := 'Ind _. - apply/idP/idP=> [/and3P[-> H0Cxi] | mu_xi]. - rewrite H0Cxi sH0CC' //= andbT negbK mem_filter unfold_in => ->. - by rewrite (seqIndS _ H0Cxi) // Iirr_kerDS ?joing_subl. - have [xi1u H0Cxi _] := IndHCmu _ mu_xi. - rewrite H0Cxi -eqS12 mem_filter sH0CC' //= !andbT xi1u eqC_nat ne_qa_qu. - by rewrite andbT negbK mem_filter in mu_xi *; case/andP: mu_xi. - rewrite oS1 -mulnA divnK ?dvdn_mul // !mulnA -mulnDl mulnC natrM {}/sumH0C. - rewrite /X_ -Iirr_kerDY joingC joingA (joing_idPl sH0H) /=. - rewrite sum_Iirr_kerD_square ?genS ?setSU //; last first. - by apply: normalS nsH0C_M; rewrite // -(sdprodWY defHU) genS ?setUSS. - rewrite -Du (inj_eq (mulfI (neq0CG _))) -(prednK (indexg_gt0 _ _)). - rewrite mulrSr addrK eqC_nat addnC mulnDl addnAC (mulnC q) -addnA -mulnDr. - move/eqP <-; congr _.-1. - have nH0HC: HC \subset 'N(H0) by rewrite join_subG nH0H. - rewrite -(index_quotient_eq _ _ nH0HC) ?genS ?setSU //; last first. - by rewrite setIC subIset ?joing_subl. - rewrite quotientYidl // -(index_sdprod (dprodWsdC defHCbar)). - by case: Ptype_Fcore_factor_facts. -have /hasP[psi1 S1psi1 _]: has predT S1 by rewrite has_predT. -pose gamma := 'Ind[M, H <*> U1] 1; pose alpha := gamma - psi1. -(* This is step (9.11.4). *) -pose nm_alpha : algC := a%:R + 1 + (q.-1 * a ^ 2)%:R / u%:R. -have [Aalpha Nalpha]: alpha \in 'CF(M, 'A(M)) /\ '[alpha] = nm_alpha. - have sHU1_HU: H <*> U1 \subset HU by rewrite -(sdprodWY defHU) genS ?setUS. - have sHU1_M := subset_trans sHU1_HU sHUM. - have sHU1_A1: H <*> U1 \subset 1%g |: 'A(M). - pose pi := \pi(H); rewrite -subDset; apply/subsetP=> y /setD1P[nty HU1y]. - apply/bigcupP; rewrite notMtype1 /=; have sHMs := Fcore_sub_FTcore maxM. - have defHU1: H ><| U1 = H <*> U1 := sdprod_subr defHU sU1U. - have nsH_HU1: H <| H <*> U1 by have [] := sdprod_context defHU1. - have [HUy [_ nH_HU1]] := (subsetP sHU1_HU y HU1y, normalP nsH_HU1). - have hallH: pi.-Hall(H <*> U1) H. - by rewrite Hall_pi // -(coprime_sdprod_Hall_l defHU1) (coprimegS sU1U). - have hallU1: pi^'.-Hall(H <*> U1) U1. - by rewrite -(compl_pHall _ hallH) sdprod_compl. - have [pi'y | pi_y] := boolP (pi^'.-elt y); last first. - exists y.`_pi; last by rewrite 3!inE nty HUy cent1C groupX ?cent1id. - rewrite !inE (sameP eqP constt1P) pi_y (subsetP sHMs) //. - by rewrite (mem_normal_Hall hallH) ?groupX ?p_elt_constt. - have solHU1: solvable (H <*> U1) by rewrite (solvableS sHU1_M) ?mmax_sol. - have [||z HU1z U1yz] := Hall_Jsub _ hallU1 _ pi'y; rewrite ?cycle_subG //. - have /trivgPn[x /setIP[Hx cxyz] ntx]: 'C_H[y ^ z] != 1%g. - apply: contraTneq (prime_gt1 p_pr) => regHy; rewrite -oH1 cardG_gt1 negbK. - move: U1yz; rewrite -cycleJ subsetI sub_astabQ => /and3P[sYU nHY cH1Y]. - rewrite centsC in cH1Y; rewrite -(setIidPl cH1Y) -(setIidPl sH1H) -setIA. - rewrite -coprime_quotient_cent ?(coprimegS sYU) // cent_cycle regHy. - by rewrite quotient1 setIg1. - exists (x ^ z^-1)%g; last by rewrite 3!inE nty HUy cent1J mem_conjgV cent1C. - by rewrite 2!inE conjg_eq1 ntx (subsetP sHMs) // -mem_conjg nH_HU1. - have{sHU1_A1} Aalpha: alpha \in 'CF(M, 'A(M)). - have A'1: 1%g \notin 'A(M) by have /subsetD1P[] := FTsupp_sub M. - rewrite -['A(M)](setU1K A'1) cfun_onD1 !cfunE subr_eq0 cfInd1 // cfun11. - rewrite mulr1 -(Lagrange_index sHUM) // -(index_sdprod defM) -/q. - rewrite -(index_sdprodr defHU) ?subsetIl // -/a eq_sym andbC. - have:= S1psi1; rewrite mem_filter /= => /andP[-> _] /=. - rewrite rpredB //. - apply: cfun_onS (cfInd_on sHU1_M (cfun_onG _)). - rewrite class_supportEr; apply/bigcupsP=> w Mw. - by rewrite sub_conjg conjUg conjs1g (normsP (FTsupp_norm M)) ?groupV. - have /seqIndP[s /setDP[_ ker'H ] ->] := H0C_S1 _ S1psi1. - rewrite (prDade_Ind_irr_on (FT_prDade_hypF maxM MtypeP)) //. - by rewrite inE in ker'H. - have ->: '[alpha] = '[gamma] + 1. - have /irrP[t Dt] := irrS1 _ S1psi1. - rewrite cfnormBd; first by rewrite Dt cfnorm_irr. - have /seqIndP[s /setDP[_ ker'H ] Dpsi1] := H0C_S1 _ S1psi1. - apply: contraNeq ker'H; rewrite Dt /gamma -irr0 -irr_consttE => tHU1_0. - rewrite inE -(sub_cfker_Ind_irr _ sHUM) ?gFnorm // -Dpsi1 Dt. - rewrite -(sub_cfker_constt_Ind_irr tHU1_0) ?gFnorm ?joing_subl //. - by rewrite irr0 cfker_cfun1 joing_subl. - split=> //; rewrite /nm_alpha addrAC natrM mulrAC mulrC; congr (_ + 1). - rewrite -{1}(mulnK a a_gt0) natf_div ?dvdn_mull // -mulrDr mulnn natrX. - have /sdprod_isom[nH_UW1 isomMH]: H ><| (U <*> W1) = M. - rewrite sdprodEY ?join_subG ?nHU ?(subset_trans sW1M) ?gFnorm //. - by rewrite joingA (sdprodWY defHU) (sdprodWY defM). - rewrite /= -(setIidPl sHHU) norm_joinEr // setIAC -setIA -group_modl //. - by rewrite (setIC W1) tiHUW1 mulg1. - have sU1_UW1: U1 \subset U <*> W1 by rewrite subIset ?joing_subl. - rewrite /gamma -(cfMod_cfun1 _ H) cfIndMod ?joing_subl //. - rewrite cfMod_iso //= quotientYidl ?(subset_trans sU1_UW1) //. - rewrite -(restrm_quotientE _ sU1_UW1) -(cfIsom_cfun1 (restr_isom _ isomMH)). - rewrite (cfIndIsom isomMH) // {nH_UW1 isomMH}cfIsom_iso. - rewrite -(cfIndInd _ (joing_subl U W1)) // cfInd_cfun1 //= -/U1 -/a. - rewrite linearZ cfnormZ normr_nat /=; congr (_ * _). - have defUW1: U ><| W1 = U <*> W1. - by rewrite sdprodEY // -(setIidPl sUHU) -setIA tiHUW1 setIg1. - apply: canLR (mulKf (neq0CG _)) _; rewrite -(sdprod_card defUW1) natrM -/q. - rewrite mulrAC mulrDr mulrCA -{1}(Lagrange sU1U) /= -/U1 -/a -(Lagrange sCU). - rewrite -card_quotient // !natrM !mulfK ?neq0CiG ?neq0CG //. - transitivity (\sum_(x in U <*> W1) \sum_(w1 in W1) \sum_(w2 in W1) - (x ^ w1 \in U1 :&: U1 :^ w2)%g%:R : algC). - - apply: eq_bigr => x _; rewrite (cfIndEsdprod _ _ defUW1) mulr_suml. - apply: eq_bigr => w1 W1w1; rewrite rmorph_sum mulr_sumr. - rewrite (reindex_inj invg_inj) (eq_bigl _ _ (groupV W1)) /=. - rewrite (reindex_acts 'R _ (groupVr W1w1)) ?astabsR //=. - apply: eq_bigr => w2 _; rewrite inE !cfuniE // rmorph_nat -natrM mulnb. - by congr (_ && _)%:R; rewrite invMg invgK conjgM -mem_conjg. - rewrite exchange_big /= mulr_natr -sumr_const; apply: eq_bigr => w1 W1w1. - transitivity (\sum_(w in W1) #|U1 :&: U1 :^ w|%:R : algC). - rewrite exchange_big /=; apply: eq_bigr => w W1w. - rewrite (reindex_acts 'J _ (groupVr W1w1)) ?astabsJ ?normsG ?joing_subr //=. - symmetry; rewrite big_mkcond -sumr_const /= big_mkcond /=. - apply: eq_bigr => x _; rewrite conjgKV. - by case: setIP => [[/(subsetP sU1_UW1)-> //] | _]; rewrite if_same. - rewrite (big_setD1 1%g) //= conjsg1 setIid; congr (_ + _). - rewrite [q](cardsD1 1%g) group1 /= mulr_natl -sumr_const. - by apply: eq_bigr => w W1w; rewrite tiU1. -(* This is step (9.11.5). *) -have [gtS4alpha s4gt0]: (size S4)%:R > '[alpha] /\ (size S4 > 0)%N. - suffices gtS4alpha: (size S4)%:R > '[alpha]. - by split=> //; rewrite -ltC_nat (ler_lt_trans (cfnorm_ge0 alpha)). - rewrite Nalpha -(@ltr_pmul2r _ u%:R) ?ltr0n // mulrDl divfK ?neq0CG //. - rewrite -(ltr_pmul2l (gt0CG W1)) -/q -mulrSr -!(natrM, natrD) ltC_nat. - rewrite mulnA mulnAC -(ltn_add2r (p.-1 * (q + u))) oS4 {1}Dp addn1 -Da_p /=. - apply: leq_ltn_trans (_ : q.+2 * a ^ 3 + q ^ 2 * a ^ 2 + 2 * q * a < _)%N. - rewrite (addnC q) 2!mulnDr addnA (mulnAC _ a q) leq_add2r. - rewrite mulnA addnAC -mulnDl mulnS -addnA -mulnDl addn2 mulnCA -mulnA. - rewrite -[q in (_ <= _ + q * _)%N](prednK q_gt0) (mulSn q.-1) addnA. - by rewrite leq_add2r mulnA -mulnDl addnC leq_mul. - have q_gt2: (2 < q)%N. - by rewrite ltn_neqAle prime_gt1 ?(contraTneq _ odd_q) => // <-. - apply: leq_trans (_ : a.*2 ^ q + 'C(q, 2) * a.*2 ^ 2 + q * a.*2 <= _)%N. - rewrite -mul2n (mulnCA q) (mulnA 2) ltn_add2r !expnMn -addSn leq_add //. - apply: leq_ltn_trans (_ : q.-1.*2.+1 * a ^ q < _)%N. - rewrite leq_mul ?leq_pexp2l //. - by rewrite -(subnKC q_gt2) -addnn !addnS !ltnS leq_addl. - rewrite ltn_pmul2r ?expn_gt0 ?a_gt0 // -doubleS. - by rewrite -(prednK q_gt0) expnS mul2n leq_double ltn_expl. - rewrite mulnA leq_pmul2r ?expn_gt0 ?a_gt0 // -(subnKC q_gt2). - rewrite mulnCA mulnA addSn -mul_bin_diag bin1 -mulnA leq_pmul2l //. - by rewrite mulnS -addSnnS leq_addr. - rewrite Dp -Da_p mul2n (addnC a.*2) expnDn -(subnKC q_gt2) !addSn add0n. - rewrite 3!big_ord_recl big_ord_recr /= !exp1n /= bin1 binn !mul1n /bump /=. - by do 2!rewrite addnC leq_add2l; apply: leq_addl. -have{cohS1} [tau1 cohS1] := cohS1; have [[Itau1 Ztau1] Dtau1] := cohS1. -have sS30: cfConjC_subset S3 (S_ H0C'). - split=> [|chi|chi]; first by rewrite filter_uniq ?seqInd_uniq. - by rewrite mem_filter => /andP[]. - rewrite !mem_filter /= -!eqS12 => /andP[S1'chi S_chi]. - rewrite cfAut_seqInd // (contra _ S1'chi) //. - by have [_ _ ccS1] := sS10; move/ccS1; rewrite cfConjCK. -have scohS3: subcoherent S3 tau rmR := subset_subcoherent scohS0 sS30. -have [tau3 cohS3]: coherent S3 M^# tau. - apply: uniform_degree_coherence scohS3 _. - apply: all_pred1_constant (q * u)%:R _ _. - by rewrite all_map; apply/allP=> chi /S3qu. -have [IZtau3 Dtau3] := cohS3; have [Itau3 Ztau3] := IZtau3. -have notA1: 1%g \notin 'A(M) by have /subsetD1P[] := FTsupp_sub M. -have sS0_1A: {subset S_ H0C' <= 'CF(M, 1%g |: 'A(M))}. - move=> _ /seqIndP[s /setDP[_ ker'H] ->]; rewrite inE in ker'H. - by rewrite (prDade_Ind_irr_on (FT_prDade_hypF maxM MtypeP)). -have sS0A: {subset 'Z[S_ H0C', M^#] <= 'Z[irr M, 'A(M)]}. - move=> chi; rewrite (zcharD1_seqInd_Dade _ notA1) //. - by apply: zchar_sub_irr; apply: seqInd_vcharW. -have Zalpha: alpha \in 'Z[irr M]. - rewrite rpredB ?char_vchar ?cfInd_char ?rpred1 //. - exact: seqInd_char (H0C_S1 _ S1psi1). -have ZAalpha: alpha \in 'Z[irr M, 'A(M)] by rewrite zchar_split Zalpha. -have [Itau Ztau]: {in 'Z[irr M, 'A(M)], isometry tau, to 'Z[irr G]}. - apply: sub_iso_to (Dade_Zisometry _); last exact: zcharW. - by apply: zchar_onS; apply: FTsupp_sub0. -have oSgamma: {in S_ H0C', forall lam, '[gamma, lam] = 0}. - move=> _ /seqIndP[s /setDP[_ ker'H ] ->]. - rewrite ['Ind _]cfun_sum_constt cfdot_sumr big1 // => t sMt. - rewrite cfdotZr [gamma]cfun_sum_constt cfdot_suml big1 ?mulr0 // => t0 gMt0. - rewrite cfdotZl cfdot_irr (negPf (contraNneq _ ker'H)) ?mulr0 // => Dt0. - rewrite inE (sub_cfker_constt_Ind_irr sMt) ?gFnorm // -Dt0. - rewrite /gamma -irr0 in gMt0. - rewrite -(sub_cfker_constt_Ind_irr gMt0) ?gFnorm ?joing_subl //. - by rewrite irr0 cfker_cfun1 joing_subl. - by rewrite (subset_trans _ sHUM) // join_subG sHHU subIset ?sUHU. -(* This is step (9.11.6). *) -have [/eqP psi1qa Spsi1]: psi1 1%g == (q * a)%:R /\ psi1 \in S_ H0C'. - by move: S1psi1; rewrite mem_filter => /andP[]. -have o_alpha_S3: orthogonal alpha^\tau (map tau3 S3). - rewrite /orthogonal /= andbT all_map. - apply: contraFT (ltr_geF gtS4alpha) => /allPn[lam0 S3lam0 /= alpha_lam0]. - set ca := '[_, _] in alpha_lam0; pose al0 := (-1) ^+ (ca < 0)%R *: alpha. - have{alpha_lam0} al0_lam0: '[al0^\tau, tau3 lam0] > 0. - have Zca: ca \in Cint by rewrite Cint_cfdot_vchar ?Ztau // Ztau3 ?mem_zchar. - by rewrite linearZ cfdotZl (canLR (signrMK _) (CintEsign Zca)) normr_gt0. - rewrite -Itau // -(cfnorm_sign (ca < 0)%R) -linearZ /= -/al0. - have S4_dIirrK: {in map tau3 S4, cancel (dirr_dIirr id) (@dchi _ _)}. - apply: dirr_dIirrPE => _ /mapP[lam S4lam ->]. - rewrite mem_filter -andbA negbK in S4lam. - have [/irrP[i Dlam] _ S3lam] := and3P S4lam. - by rewrite dirrE Itau3 ?Ztau3 ?mem_zchar //= Dlam cfnorm_irr. - rewrite -(size_map tau3) -(size_map (dirr_dIirr id)). - rewrite -(card_uniqP _); last first. - rewrite !map_inj_in_uniq ?filter_uniq ?seqInd_uniq //. - apply: sub_in2 (Zisometry_inj Itau3) => lam. - by rewrite mem_filter => /andP[_ /mem_zchar->]. - exact: can_in_inj S4_dIirrK. - apply: ler_trans (_ : #|dirr_constt al0^\tau|%:R <= _); last first. - have Zal0: al0^\tau \in 'Z[irr G] by rewrite Ztau ?rpredZsign. - rewrite cnorm_dconstt // -sumr_const ler_sum // => i al0_i. - by rewrite sqr_Cint_ge1 ?gtr_eqF -?dirr_consttE // Cint_Cnat ?Cnat_dirr. - rewrite leC_nat subset_leq_card //; apply/subsetP=> _ /mapP[nu S4nu ->]. - rewrite dirr_consttE S4_dIirrK //; congr (_ > 0): al0_lam0. - rewrite {al0}linearZ !cfdotZl /=; congr (_ * _) => {ca}; apply/eqP. - have{nu S4nu} [lam S4lam ->] := mapP S4nu. - rewrite mem_filter in S4lam; have{S4lam} [_ S3lam] := andP S4lam. - have Zdlam: lam0 - lam \in 'Z[S3, M^#]. - rewrite zcharD1E rpredB ?mem_zchar //= !cfunE subr_eq0. - by have [/eqP->] := (S3qu _ S3lam, S3qu _ S3lam0). - rewrite -subr_eq0 -cfdotBr -raddfB Dtau3 //. - rewrite Itau // ?sS0A //; last exact: zchar_filter Zdlam. - suffices{lam S3lam Zdlam} oS3a: {in S3, forall lam, '[alpha, lam] = 0}. - by rewrite cfdotBr subr_eq0 !oS3a. - move=> lam; rewrite mem_filter /= -eqS12 => /andP[S1'lam H0C'lam]. - by rewrite cfdotBl oSgamma // (seqInd_ortho _ Spsi1) ?(memPn S1'lam) // subr0. -have{s4gt0 gtS4alpha} /hasP[lam1 S4lam1 _]: has predT S4 by rewrite has_predT. -have [/irrP[l1 Dl1] S3lam1]: lam1 \in irr M /\ lam1 \in S3. - by move: S4lam1; rewrite mem_filter -andbA negbK => /and3P[]. -have [S1'lam1 Slam1]: lam1 \notin S1 /\ lam1 \in S_ H0C'. - by move: S3lam1; rewrite mem_filter eqS12 => /andP[]. -have S3lam1s: lam1^*%CF \in S3 by have [[_ _ ->]] := scohS3. -have ZS3dlam1: lam1 - lam1^*%CF \in 'Z[S3, M^#]. - rewrite zcharD1E rpredB ?mem_zchar //. - by have:= seqInd_sub_aut_zchar nsHUM conjC Slam1; rewrite zcharD1 => /andP[]. -have ZAdlam1: lam1 - lam1^*%CF \in 'Z[irr M, 'A(M)]. - rewrite sS0A // zchar_split rpredB ?mem_zchar ?cfAut_seqInd //. - by rewrite (zchar_on ZS3dlam1). -pose beta := lam1 - (u %/ a)%:R *: psi1. -have ZAbeta: beta \in 'Z[irr M, 'A(M)]. - apply: sS0A; rewrite zcharD1E rpredB ?scaler_nat ?rpredMn ?mem_zchar //=. - by rewrite !cfunE subr_eq0 psi1qa -natrM mulnCA divnK // S3qu. -have [_ _ poSS _ _] := scohS0; have [_ oSS] := pairwise_orthogonalP poSS. -have o1S1: orthonormal S1. - rewrite orthonormalE filter_pairwise_orthogonal // andbT. - by apply/allP=> _ /irrS1/irrP[t ->]; rewrite /= cfnorm_irr. -have o1S4: orthonormal S4. - rewrite orthonormalE !filter_pairwise_orthogonal // andbT. - apply/allP=> nu; rewrite mem_filter /= -andbA negbK. - by case/andP=> /irrP[t ->]; rewrite cfnorm_irr. -have n1psi1: '[psi1] = 1 by have [_ -> //] := orthonormalP o1S1; rewrite eqxx. -have n1lam1: '[lam1] = 1 by have [_ -> //] := orthonormalP o1S4; rewrite eqxx. -have oS14tau: orthogonal (map tau1 S1) (map tau3 S4). - apply/orthogonalP=> psi _ S1psi /mapP[lam /sS43 S3lam ->]. - apply: {psi lam S3lam}orthogonalP S1psi (map_f tau3 S3lam). - apply: (coherent_ortho scohS0 sS10 cohS1 sS30 cohS3) => psi /=. - by rewrite mem_filter !inE eqS12 => /andP[-> _]. -have [Gamma [S4_Gamma normGamma [b Dbeta]]]: - exists Gamma, [/\ Gamma \in 'Z[map tau3 S4], '[Gamma] = 1 - & exists b : bool, beta^\tau - = Gamma - (u %/ a)%:R *: tau1 psi1 + b%:R *: \sum_(psi <- S1) tau1 psi]. -- have [G S4G [G' [Dbeta _ oG'4]]] := orthogonal_split (map tau3 S4) beta^\tau. - have [B S1B [Delta [dG' _ oD1]]] := orthogonal_split (map tau1 S1) G'. - have sZS43: {subset 'Z[S4] <= 'Z[S3]} := zchar_subset sS43. - have [Itau34 Ztau34] := sub_iso_to sZS43 sub_refl IZtau3. - have Z_G: G \in 'Z[map tau3 S4]. - have [_ -> ->] := orthonormal_span (map_orthonormal Itau34 o1S4) S4G. - rewrite big_seq rpred_sum // => xi S4xi; rewrite rpredZ_Cint ?mem_zchar //. - rewrite -(addrK G' G) -Dbeta cfdotBl (orthoPl oG'4) // subr0. - rewrite Cint_cfdot_vchar ?Ztau //. - by have{xi S4xi} [xi S4xi ->] := mapP S4xi; rewrite Ztau34 ?mem_zchar. - have oD4: orthogonal Delta (map tau3 S4). - apply/orthoPl=> xi S4xi; rewrite -(addKr B Delta) addrC -dG' cfdotBl. - by rewrite (orthoPl oG'4) // (span_orthogonal oS14tau) ?subrr // memv_span. - have [_ -> dB] := orthonormal_span (map_orthonormal Itau1 o1S1) S1B. - pose b := (u %/ a)%:R + '[B, tau1 psi1]. - have betaS1_B: {in S1, forall psi, '[beta^\tau, tau1 psi] = '[B, tau1 psi]}. - move=> psi S1psi; rewrite Dbeta dG' !cfdotDl (orthoPl oD1) ?map_f // addr0. - rewrite cfdotC (span_orthogonal oS14tau) ?rmorph0 ?add0r //. - by rewrite memv_span ?map_f. - have Zb: b \in Cint. - rewrite rpredD ?rpred_nat // -betaS1_B // Cint_cfdot_vchar ?Ztau //. - by rewrite Ztau1 ?mem_zchar. - have{dB} dB: B = - (u %/ a)%:R *: tau1 psi1 + b *: \sum_(psi <- S1) tau1 psi. - rewrite dB big_map !(big_rem _ S1psi1) /= scalerDr addrA -scalerDl addKr. - rewrite scaler_sumr; congr (_ + _); apply: eq_big_seq => psi. - rewrite mem_rem_uniq ?filter_uniq ?seqInd_uniq // => /andP[/= psi_1' S1psi]. - apply/esym/eqP; rewrite -subr_eq0 -scalerBl -addrA -!betaS1_B // -cfdotBr. - have [/eqP psi_qa Spsi]: psi 1%g == (q * a)%:R /\ psi \in S_ H0C'. - by move: S1psi; rewrite mem_filter => /andP[]. - have Z1dpsi: psi1 - psi \in 'Z[S1, M^#]. - by rewrite zcharD1E rpredB ?mem_zchar //= !cfunE psi1qa psi_qa subrr. - rewrite -raddfB Dtau1 // Itau //; last first. - by rewrite sS0A // zchar_split rpredB ?mem_zchar ?(zchar_on Z1dpsi). - rewrite cfdotC cfdotBr cfdotZr !cfdotBl 2?oSS ?(memPn S1'lam1) // subrr. - by rewrite add0r n1psi1 oSS // subr0 mulr1 rmorphN conjCK subrr scale0r. - have Gge1: 1 <= '[G] ?= iff ('[G] == 1). - rewrite eq_sym; apply: lerif_eq. - have N_G: '[G] \in Cnat. - apply: Cnat_cfnorm_vchar; apply: zchar_sub_irr Z_G => _ /mapP[nu S4nu ->]. - by rewrite Ztau34 ?mem_zchar. - rewrite -(truncCK N_G) ler1n lt0n -eqC_nat truncCK {N_G}// cfnorm_eq0. - have: '[beta^\tau, (lam1 - lam1^*%CF)^\tau] != 0. - rewrite Itau // cfdotBl cfdotZl !cfdotBr n1lam1. - rewrite (seqInd_conjC_ortho _ _ _ Slam1) ?mFT_odd // subr0. - rewrite !oSS ?cfAut_seqInd -?(inv_eq (@cfConjCK _ _)) ?(memPn S1'lam1) //. - by rewrite !(subr0, mulr0) oner_eq0. - by have [_ _ ->] := sS10. - rewrite Dbeta -Dtau3 //; apply: contraNneq => ->. - rewrite add0r raddfB cfdotBr !(orthoPl oG'4) ?map_f ?subr0 //. - move: S4lam1; rewrite ![_ \in S4]mem_filter /= !negbK /= cfAut_irr S3lam1s. - by case/andP=> /andP[-> /cfAut_seqInd->]. - have ubG: '[G] + (b ^+ 2 - b) * (u %/ a).*2%:R + '[Delta] = 1. - apply: (addrI ((u %/ a) ^ 2)%:R); transitivity '[beta^\tau]. - rewrite -!addrA addrCA Dbeta cfnormDd; last first. - by rewrite cfdotC (span_orthogonal oG'4) ?rmorph0 // memv_span ?inE. - congr (_ + _); rewrite !addrA dG' cfnormDd; last first. - by rewrite cfdotC (span_orthogonal oD1) ?rmorph0 // memv_span ?inE. - congr (_ + _); rewrite dB scaleNr [- _ + _]addrC cfnormB !cfnormZ. - rewrite normr_nat Cint_normK // scaler_sumr cfdotZr rmorph_nat. - rewrite cfnorm_map_orthonormal // cfproj_sum_orthonormal //. - rewrite Itau1 ?mem_zchar // n1psi1 mulr1 rmorphM rmorph_nat conj_Cint //. - rewrite -mulr2n oS1ua -muln_divA // mul2n -addrA addrCA -natrX mulrBl. - by congr (_ + (_ - _)); rewrite -mulrnAl -mulrnA muln2 mulrC. - rewrite Itau // cfnormBd; last first. - by rewrite cfdotZr oSS ?mulr0 // (memPnC S1'lam1). - by rewrite cfnormZ normr_nat n1psi1 n1lam1 mulr1 addrC -natrX. - have ubDelta: '[G] <= '[G] + '[Delta] ?= iff (Delta == 0). - rewrite addrC -lerif_subLR subrr -cfnorm_eq0 eq_sym. - by apply: lerif_eq; apply: cfnorm_ge0. - have{ubG} ubDeltaG: '[G] + '[Delta] <= 1 ?= iff pred2 0 1 b. - rewrite -{1}ubG addrAC [_ + _ + _] addrC -lerif_subLR subrr /=. - set n := _%:R; rewrite mulrC -{1}(mulr0 n) mono_lerif; last first. - by apply: ler_pmul2l; rewrite ltr0n double_gt0 divn_gt0 // dvdn_leq. - rewrite /= -(subr_eq0 b 1) -mulf_eq0 mulrBr mulr1 eq_sym. - apply: lerif_eq; rewrite subr_ge0. - have [-> | nz_b] := eqVneq b 0; first by rewrite expr2 mul0r. - rewrite (ler_trans (real_ler_norm _)) ?Creal_Cint // -[`|b|]mulr1. - by rewrite -Cint_normK // ler_pmul2l ?normr_gt0 // norm_Cint_ge1. - have [_ /esym] := lerif_trans Gge1 (lerif_trans ubDelta ubDeltaG). - rewrite eqxx => /and3P[/eqP normG1 /eqP Delta0 /pred2P b01]. - exists G; split=> //; exists (b != 0). - rewrite Dbeta dG' Delta0 addr0 dB scaleNr addrA; congr (_ + _ *: _). - by case: b01 => ->; rewrite ?eqxx ?oner_eq0. -(* Final step (9.11.8). *) -have alpha_beta: '[alpha^\tau, beta^\tau] = (u %/ a)%:R. - rewrite Itau // cfdotBr cfdotZr rmorph_nat !cfdotBl !oSgamma // !sub0r. - by rewrite n1psi1 mulrN opprK mulr1 addrC oSS ?subr0 // (memPn S1'lam1). -have [X S1X [Delta [Dalpha _ oD1]]]:= orthogonal_split (map tau1 S1) alpha^\tau. -pose x := 1 + '[X, tau1 psi1]. -have alphaS1_X: {in S1, forall psi, '[alpha^\tau, tau1 psi] = '[X, tau1 psi]}. - by move=> psi S1psi; rewrite Dalpha cfdotDl (orthoPl oD1) ?map_f // addr0. -have Zx: x \in Cint. - rewrite rpredD ?rpred1 // -alphaS1_X // Cint_cfdot_vchar ?Ztau //. - by rewrite Ztau1 ?mem_zchar. -have{alphaS1_X S1X} defX: X = x *: (\sum_(psi <- S1) tau1 psi) - tau1 psi1. - have [_ -> ->] := orthonormal_span (map_orthonormal Itau1 o1S1) S1X. - rewrite addrC -scaleN1r big_map !(big_rem _ S1psi1) /= scalerDr addrA. - rewrite -scalerDl addKr scaler_sumr; congr (_ + _); apply: eq_big_seq => psi. - rewrite mem_rem_uniq ?filter_uniq ?seqInd_uniq // => /andP[/= psi_1' S1psi]. - apply/esym/eqP; rewrite -subr_eq0 -scalerBl -addrA -!alphaS1_X // -cfdotBr. - have [/eqP psi_qa Spsi]: psi 1%g == (q * a)%:R /\ psi \in S_ H0C'. - by move: S1psi; rewrite mem_filter => /andP[]. - have Z1dpsi: psi1 - psi \in 'Z[S1, M^#]. - by rewrite zcharD1E rpredB ?mem_zchar //= !cfunE psi1qa psi_qa subrr. - rewrite -raddfB Dtau1 // Itau //; last first. - by rewrite sS0A // zchar_split rpredB ?mem_zchar ?(zchar_on Z1dpsi). - rewrite cfdotBr !cfdotBl !oSgamma // n1psi1 cfdotC oSS // rmorph0. - by rewrite !subr0 add0r subrr scale0r. -have{x Zx X defX Delta Dalpha oD1} b_mod_ua: (b == 0 %[mod u %/ a])%C. - rewrite -oppr0 -eqCmodN (eqCmod_trans _ (eqCmodm0 _)) // {2}nCdivE. - rewrite -alpha_beta Dbeta -addrA cfdotDr. - rewrite (span_orthogonal o_alpha_S3) ?add0r; first 1 last. - - by rewrite memv_span ?inE. - - apply: subvP (zchar_span S4_Gamma); apply: sub_span; apply: mem_subseq. - by rewrite map_subseq ?filter_subseq. - rewrite Dalpha addrC cfdotDl (span_orthogonal oD1); first 1 last. - - by rewrite memv_span ?inE. - - rewrite addrC rpredB ?rpredZ //; last by rewrite memv_span ?map_f. - by rewrite big_seq rpred_sum // => psi S1psi; rewrite memv_span ?map_f. - rewrite add0r addrC defX cfdotBr cfdotBl cfdotZl cfdotZr !scaler_sumr. - rewrite cfdotZr !rmorph_nat cfdotBl Itau1 ?mem_zchar // n1psi1. - rewrite cfnorm_map_orthonormal // cfdotC !cfproj_sum_orthonormal //. - rewrite rmorph_nat oS1ua -muln_divA // natrM !mulrA addrC mulrC addrA. - rewrite -mulNr -mulrDl eqCmod_sym eqCmod_addl_mul // addrC !rpredB ?rpred1 //. - by rewrite !rpredM ?rpred_nat. -have{b_mod_ua alpha_beta} b0: b = 0%N :> nat. - have:= b_mod_ua; rewrite /eqCmod subr0 dvdC_nat => /eqnP. - rewrite modn_small // (leq_ltn_trans (leq_b1 b)) // ltn_divRL // mul1n. - by rewrite ltn_neqAle -(eqn_pmul2l q_gt0) eq_sym ne_qa_qu dvdn_leq. -exists lam1 => //; suffices: coherent (lam1 :: lam1^* :: S1)%CF M^# tau. - by apply: subset_coherent => phi; rewrite !inE eqS12. -move: Dbeta; rewrite b0 scale0r addr0. -apply: (extend_coherent_with scohS0 sS10 cohS1); first by []. -rewrite rpred_nat psi1qa -natrM mulnCA (eqP (S3qu _ S3lam1)) divnK //. -rewrite cfdotC (span_orthogonal oS14tau) ?(zchar_span S4_Gamma) ?conjC0 //. -by rewrite rpredZ ?memv_span ?map_f. -Qed. - -End Nine. diff --git a/mathcomp/odd_order/README b/mathcomp/odd_order/README deleted file mode 120000 index e4e30e8..0000000 --- a/mathcomp/odd_order/README +++ /dev/null @@ -1 +0,0 @@ -../../etc/README
\ No newline at end of file diff --git a/mathcomp/odd_order/descr b/mathcomp/odd_order/descr deleted file mode 100644 index ee393a9..0000000 --- a/mathcomp/odd_order/descr +++ /dev/null @@ -1,6 +0,0 @@ -Odd Order Theorem - -This library contains the complete formal proof of the Odd Order -Theorem (aka Feit Thompson Theorem). -The file stripped_odd_order_theorem.v contains a proof of a self -contained statement of the odd order.
\ No newline at end of file diff --git a/mathcomp/odd_order/opam b/mathcomp/odd_order/opam deleted file mode 100644 index f745e77..0000000 --- a/mathcomp/odd_order/opam +++ /dev/null @@ -1,16 +0,0 @@ -opam-version: "1.2" -name: "coq-mathcomp-odd_order" -version: "dev" -maintainer: "Mathematical Components <mathcomp-dev@sympa.inria.fr>" - -homepage: "http://math-comp.github.io/math-comp/" -bug-reports: "Mathematical Components <mathcomp-dev@sympa.inria.fr>" -license: "CeCILL-B" - -build: [ make "-j" "%{jobs}%" ] -install: [ make "install" ] -remove: [ "sh" "-c" "rm -rf '%{lib}%/coq/user-contrib/mathcomp/odd_order'" ] -depends: [ "coq-mathcomp-character" { = "dev" } ] - -tags: [ "keyword:Feit Thompson theorem" "keyword:small scale reflection" "keyword:mathematical components" "keyword:odd order theorem" ] -authors: [ "Jeremy Avigad <>" "Andrea Asperti <>" "Stephane Le Roux <>" "Yves Bertot <>" "Laurence Rideau <>" "Enrico Tassi <>" "Ioana Pasca <>" "Georges Gonthier <>" "Sidi Ould Biha <>" "Cyril Cohen <>" "Francois Garillot <>" "Alexey Solovyev <>" "Russell O'Connor <>" "Laurent Théry <>" "Assia Mahboubi <>" ] diff --git a/mathcomp/odd_order/stripped_odd_order_theorem.v b/mathcomp/odd_order/stripped_odd_order_theorem.v deleted file mode 100644 index 19b9d0b..0000000 --- a/mathcomp/odd_order/stripped_odd_order_theorem.v +++ /dev/null @@ -1,209 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require mathcomp.ssreflect.ssreflect. -From mathcomp -Require ssrbool ssrfun eqtype ssrnat fintype finset fingroup. -From mathcomp -Require morphism quotient action gfunctor gproduct commutator gseries nilpotent. -From mathcomp -Require PFsection14. - -(******************************************************************************) -(* This file contains a minimal, self-contained reformulation of the Odd *) -(* Order theorem, using only the bare Coq logic, and avoiding any use of *) -(* extra-logical features such as notation, coercion or implicit arguments. *) -(* This stripped theorem would hardly be usable, however; it just provides *) -(* evidence for the sceptics. *) -(******************************************************************************) - -(* Equivalence and equality *) - -Inductive equivalent P Q := Equivalent (P_to_Q : P -> Q) (Q_to_P : Q -> P). - -Inductive equal T (x : T) : T -> Type := Equal : equal T x x. - -(* Arithmetic *) - -Inductive natural := Zero | Add_1_to (n : natural). - -Fixpoint add (m n : natural) : natural := - match m with Zero => n | Add_1_to m_minus_1 => add m_minus_1 (Add_1_to n) end. - -Definition double (n : natural) : natural := add n n. - -Inductive odd (n : natural) := - Odd (half : natural) - (n_odd : equal natural n (Add_1_to (double half))). - -Inductive less_than (m n : natural) := - LessThan (diff : natural) - (m_lt_n : equal natural n (Add_1_to (add m diff))). - -(* Finite subsets *) - -Definition injective_in T R (D : T -> Type) (f : T -> R) := - forall x y, D x -> D y -> equal R (f x) (f y) -> equal T x y. - -Inductive in_image T R (D : T -> Type) (f : T -> R) (a : R) := - InImage (x : T) (x_in_D : D x) (a_is_fx : equal R a (f x)). - -Inductive finite_of_order T (D : T -> Type) (n : natural) := - FiniteOfOrder (rank : T -> natural) - (rank_injective : injective_in T natural D rank) - (rank_onto : - forall i, equivalent (less_than i n) (in_image T natural D rank i)). - -(* Elementary group theory *) - -Inductive group_axioms T (mul : T -> T -> T) (one : T) (inv : T -> T) := - GroupAxioms - (associativity : forall x y z, equal T (mul x (mul y z)) (mul (mul x y) z)) - (left_identity : forall x, equal T (mul one x) x) - (left_inverse : forall x, equal T (mul (inv x) x) one). - -Inductive group T mul one inv (G : T -> Type) := - Group - (G_closed_under_mul : forall x y, G x -> G y -> G (mul x y)) - (one_in_G : G one) - (G_closed_under_inv : forall x, G x -> G (inv x)). - -Inductive subgroup T mul one inv (H G : T -> Type) := - Subgroup - (H_group : group T mul one inv H) - (H_subset_G : forall x, H x -> G x). - -Inductive normal_subgroup T mul one inv (H G : T -> Type) := - NormalSubgroup - (H_subgroup_G : subgroup T mul one inv H G) - (H_is_G_invariant : forall x y, H x -> G y -> H (mul (inv y) (mul x y))). - -Inductive commute_mod T mul (x y : T) (H : T -> Type) := - CommuteMod (z : T) - (z_in_H : H z) - (xy_eq_zyx : equal T (mul x y) (mul z (mul y x))). - -Inductive abelian_factor T mul one inv (G H : T -> Type) := - AbelianFactor - (G_group : group T mul one inv G) - (H_normal_in_G : normal_subgroup T mul one inv H G) - (G_on_H_abelian : forall x y, G x -> G y -> commute_mod T mul x y H). - -Inductive solvable_group T mul one inv (G : T -> Type) := -| TrivialGroupSolvable - (G_trivial : forall x, equivalent (G x) (equal T x one)) -| AbelianExtensionSolvable (H : T -> Type) - (H_solvable : solvable_group T mul one inv H) - (G_on_H_abelian : abelian_factor T mul one inv G H). - -(* begin hide *) -Module InternalSkepticOddOrderProof. - -Local Notation Aeq := (equal _). -Local Notation Aadd := add. -Local Notation Adouble := double. -Local Notation Aodd := odd. -Local Notation Alt := less_than. -Local Notation Agroup := group. -Local Notation Asubgroup := subgroup. -Local Notation Anormal := normal_subgroup. -Local Notation Aabel_quo := abelian_factor. -Local Notation Asol := solvable_group. - -Import Prelude ssreflect ssrbool ssrfun eqtype ssrnat fintype finset fingroup. -Import morphism quotient action gfunctor gproduct commutator gseries nilpotent. -Import GroupScope. - -Lemma main T mul one inv G nn : - group_axioms T mul one inv -> Agroup T mul one inv G -> - finite_of_order T G nn -> Aodd nn -> - Asol T mul one inv G. -Proof. -pose fix natN n := if n is n1.+1 then Add_1_to (natN n1) else Zero. -pose fix Nnat mm := if mm is Add_1_to mm1 then (Nnat mm1).+1 else 0. -have natN_K: cancel natN Nnat by elim=> //= n ->. -have NnatK: cancel Nnat natN by elim=> //= mm ->. -have AaddE nn1 nn2: Nnat (Aadd nn1 nn2) = Nnat nn1 + Nnat nn2. - by elim: nn1 nn2 => //= nn1 IHnn nn2; rewrite IHnn addnS. -have AltE m n: Alt (natN m) (natN n) -> m < n. - by rewrite -{2}[n]natN_K => [[dd ->]]; rewrite /= ltnS AaddE natN_K leq_addr. -have AltI m n: m < n -> Alt (natN m) (natN n). - move/subnKC <-; exists (natN (n - m.+1)). - by rewrite -[Add_1_to _]NnatK /= AaddE !natN_K. -have AoddE n: Aodd (natN n) -> odd n. - by rewrite -{2}[n]natN_K => [[hh ->]]; rewrite /= AaddE addnn odd_double. -case=> mulA mul1T mulVT [mulG oneG invG] [rG inj_rG im_rG] odd_nn. -pose n := Nnat nn; have{odd_nn} odd_n: odd n by rewrite AoddE ?NnatK. -have{rG inj_rG im_rG} [gT o_gT [f [g Gf [fK gK]] [fM f1 fV]]]: - {gT : finGroupType & #|gT| = n & {f : gT -> T - & {g : _ & forall a, G (f a) & cancel f g /\ forall x, G x -> f (g x) = x} - & [/\ {morph f : a b / a * b >-> mul a b}, f 1 = one - & {morph f : a / a^-1 >-> inv a}]}}. -- pose gT := 'I_n.-1.+1; pose g x : gT := inord (Nnat (rG x)). - have ub_rG x: G x -> Nnat (rG x) < n. - move=> Gx; rewrite AltE ?NnatK //. - by have [_] := im_rG (rG x); apply; exists x. - have Dn: n.-1.+1 = n := ltn_predK (ub_rG one oneG). - have fP a: {x : T & G x * (g x = a)}%type. - have a_lt_n: Alt (natN a) nn by rewrite -(canLR NnatK Dn); apply: AltI. - have [/(_ a_lt_n)[x Gx rGx] _] := im_rG (natN a). - by exists x; split; rewrite // /g -rGx natN_K inord_val. - pose f a := tag (fP a); have Gf a: G (f a) by rewrite /f; case: (fP) => x []. - have fK: cancel f g by rewrite /f => a; case: (fP a) => x []. - have Ng x & G x: natN (g x) = rG x by rewrite inordK ?Dn ?ub_rG ?NnatK. - have{Ng} gK x: G x -> f (g x) = x. - by move=> Gx; rewrite (inj_rG (f (g x)) x) // -!Ng ?fK. - pose m a b := g (mul (f a) (f b)). - pose o := g one; pose v a := g (inv (f a)). - have fM: {morph f: a b / m a b >-> mul a b} by move=> a b; apply/gK/mulG. - have f1: f o = one by apply: gK. - have fV: {morph f: a / v a >-> inv a} by move=> a; apply/gK/invG. - have mA: associative m by move=> a b c; apply: canLR fK _; rewrite !fM mulA. - have m1: left_id o m by move=> a; apply: canLR fK _; rewrite f1 mul1T. - have mV: left_inverse o v m. - by move=> a; apply: canLR fK _; rewrite fV f1 mulVT. - pose bT := BaseFinGroupType _ (FinGroup.Mixin mA m1 mV). - exists (@FinGroupType bT mV); first by rewrite card_ord Dn. - by exists f; first exists g. -pose im (H : {group gT}) x := (G x * (g x \in H))%type. -have imG H : Agroup T mul one inv (im H). - split=> [x y [Gx Hx] [Gy Hy] | | x [Gx Hx]]; first 1 last. - - by split; rewrite // -(canRL fK f1). - - by split; [auto | rewrite -(gK x Gx) -fV fK groupV]. - by split; [auto | rewrite -(gK x Gx) -(gK y Gy) -fM fK groupM]. -pose G0 := [set: gT]%G. -have sGG0 x: G x -> im G0 x by split; rewrite ?inE. -have mulVV1 x: mul (inv (inv x)) one = x by rewrite -(mulVT x) mulA mulVT mul1T. -have{mulVV1} mulT1 x: mul x one = x by rewrite -[x]mulVV1 -mulA mul1T. -pose comm x y := mul (mul x y) (inv (mul y x)). -suffices solH: Asol T mul one inv (im G0). - right with (im G0) => //; split=> // [|x y Gx Gy]. - by split=> // [|x y [Gx _] Gy]; [split=> // x [] | apply: sGG0; auto]. - by exists (comm x y); [rewrite /comm; auto | rewrite -mulA mulVT -mulA mulT1]. -have solG0: solvable G0 by rewrite PFsection14.Feit_Thompson ?cardsT ?o_gT. -elim: _.+1 {-2}G0 (ltnSn #|G0|) => // m IHm H; rewrite ltnS => leHm. -have [-> | ntH] := eqVneq H 1%G. - left=> // x; split=> [[Gx /set1P] | ->]. - by rewrite -f1 => <-; rewrite gK. - by split; rewrite // -f1 fK. -have ltH'H: H^`(1) \proper H := sol_der1_proper solG0 (subsetT H) ntH. -right with (im H^`(1)%G); first exact: IHm (leq_trans (proper_card _) leHm). -have /andP[/subsetP sH'H /subsetP nH'H]: H^`(1) <| H := der_normal 1 H. -split=> // [|x y [Gx Hx] [Gy Hy]]. - split=> // [|x y [Gx H'x] [Gy Hy]]; first by split=> // x [Gx /sH'H]. - split; first by [auto]; rewrite -(gK x Gx) -(gK y Gy) -!(fM, fV) !fK. - by rewrite memJ_norm ?nH'H. -exists (comm x y); last by rewrite -mulA mulVT -mulA mulT1. -rewrite /comm; split; first by [auto]; rewrite -(gK x Gx) -(gK y Gy). -by rewrite -!(fM, fV) fK -[g x * g y]invgK !invMg -mulgA mem_commg ?groupV. -Qed. - -End InternalSkepticOddOrderProof. -(* end hide *) - -(* The Odd Order theorem *) - -Theorem stripped_Odd_Order T mul one inv (G : T -> Type) (n : natural) : - group_axioms T mul one inv -> group T mul one inv G -> - finite_of_order T G n -> odd n -> - solvable_group T mul one inv G. -Proof. exact (InternalSkepticOddOrderProof.main T mul one inv G n). Qed. diff --git a/mathcomp/odd_order/wielandt_fixpoint.v b/mathcomp/odd_order/wielandt_fixpoint.v deleted file mode 100644 index e5d8ad4..0000000 --- a/mathcomp/odd_order/wielandt_fixpoint.v +++ /dev/null @@ -1,659 +0,0 @@ -(* (c) Copyright 2006-2016 Microsoft Corporation and Inria. *) -(* Distributed under the terms of CeCILL-B. *) -Require Import mathcomp.ssreflect.ssreflect. -From mathcomp -Require Import ssrbool ssrfun eqtype ssrnat seq path div. -From mathcomp -Require Import fintype bigop prime binomial finset ssralg fingroup finalg. -From mathcomp -Require Import morphism perm automorphism quotient action gfunctor commutator. -From mathcomp -Require Import gproduct zmodp cyclic center pgroup gseries nilpotent sylow. -From mathcomp -Require Import finalg finmodule abelian frobenius maximal extremal hall. -From mathcomp -Require Import matrix mxalgebra mxrepresentation mxabelem BGsection1. - -(******************************************************************************) -(* This file provides the proof of the Wielandt fixpoint order formula, *) -(* which is a prerequisite for B & G, Section 3 and Peterfalvi, Section 9. *) -(******************************************************************************) - -Set Implicit Arguments. -Unset Strict Implicit. -Unset Printing Implicit Defensive. - -Local Open Scope ring_scope. -Import GroupScope GRing.Theory. -Import FinRing.Theory. - -Implicit Types (gT wT : finGroupType) (m n p q : nat). - -Lemma coprime_act_abelian_pgroup_structure gT p (A X : {group gT}) : - abelian A -> p.-group A -> p^'.-group X -> X \subset 'N(A) -> - exists2 s : {set {group gT}}, - \big[dprod/1]_(B in s) B = A - & {in s, forall B : {group gT}, - [/\ homocyclic B, X \subset 'N(B) - & acts_irreducibly X (B / 'Phi(B)) 'Q]}. -Proof. -move: {2}_.+1 (ltnSn #|A|) => m. -elim: m => // m IHm in gT A X *; rewrite ltnS => leAm cAA pA p'X nAX. -have [n1 eA]: {n | exponent A = p ^ n}%N by apply p_natP; rewrite pnat_exponent. -have [-> | ntA] := eqsVneq A 1. - by exists set0 => [|B]; rewrite ?big_set0 ?inE. -have [p_pr _ _] := pgroup_pdiv pA ntA; have p_gt1 := prime_gt1 p_pr. -case: n1 => [|n] in eA; first by rewrite trivg_exponent eA in ntA. -have nA1X: X \subset 'N('Ohm_1(A)) := gFnorm_trans _ nAX. -have sAnA1: 'Mho^n(A) \subset 'Ohm_1(A). - rewrite (MhoE n pA) (OhmE 1 pA) genS //. - apply/subsetP=> _ /imsetP[x Ax ->]; rewrite !inE groupX //. - by rewrite -expgM -expnSr -eA -order_dvdn dvdn_exponent. -have nAnX: X \subset 'N('Mho^n(A)) := gFnorm_trans _ nAX. -have [B minB sBAn]: {B : {group gT} | minnormal B X & B \subset 'Mho^n(A)}. - apply: mingroup_exists; rewrite nAnX andbT; apply/trivgPn. - have [x Ax ox] := exponent_witness (abelian_nil cAA). - exists (x ^+ (p ^ n)); first by rewrite Mho_p_elt ?(mem_p_elt pA). - by rewrite -order_dvdn -ox eA dvdn_Pexp2l ?ltnn. -have abelA1: p.-abelem 'Ohm_1(A) by rewrite Ohm1_abelem. -have sBA1: B \subset 'Ohm_1(A) := subset_trans sBAn sAnA1. -have{minB} [/andP[ntB nBX] minB] := mingroupP minB. -have{nBX sBA1} [U defA1 nUX] := Maschke_abelem abelA1 p'X sBA1 nA1X nBX. -have [_ mulBU _ tiBU] := dprodP defA1; have{mulBU} [_ sUA1] := mulG_sub mulBU. -have sUA: U \subset A := subset_trans sUA1 (Ohm_sub 1 _). -have [U1 | {defA1 minB}ntU] := eqsVneq U 1. - rewrite U1 dprodg1 /= in defA1. - have homoA: homocyclic A. - apply/(Ohm1_homocyclicP pA cAA); rewrite eA pfactorK //=. - by apply/eqP; rewrite eqEsubset sAnA1 -defA1 sBAn. - exists [set A]; rewrite ?big_set1 // => G; move/set1P->; split=> //. - have OhmMho: forall k, 'Ohm_k(A) = 'Mho^(n.+1 - k)(A). - by move=> k; rewrite (homocyclic_Ohm_Mho k pA) // eA pfactorK. - have fM: {in A &, {morph (fun x => x ^+ (p ^ n)) : x y / x * y >-> x * y}}. - by move=> x y Ax Ay /=; rewrite expgMn // /commute -(centsP cAA). - pose f := Morphism fM; have ker_f: 'ker f = 'Phi(A). - apply/setP=> z; rewrite (Phi_Mho pA cAA) -(subSnn n) -OhmMho. - by rewrite (OhmEabelian pA) ?(abelianS (Ohm_sub n A)) ?inE. - have [g injg def_g] := first_isom f; rewrite /= {}ker_f in g injg def_g. - have{f def_g} def_g: forall H, gval H \subset A -> g @* (H / _) = 'Mho^n(H). - move=> H sHA; rewrite def_g morphimEsub //. - by rewrite (MhoEabelian n (pgroupS sHA pA) (abelianS sHA cAA)). - have im_g: g @* (A / 'Phi(A)) = B by rewrite def_g // defA1 OhmMho subn1. - have defAb: A / 'Phi(A) = g @*^-1 B by rewrite -im_g injmK. - have nsPhiA: 'Phi(A) <| A := Phi_normal A. - have nPhiX: X \subset 'N('Phi(A)) := gFnorm_trans _ nAX. - rewrite defAb; apply/mingroupP; split=> [|Hb]. - by rewrite -(morphim_injm_eq1 injg) ?morphpreK /= -?defAb ?im_g ?ntB ?actsQ. - case/andP=> ntHb actsXHb /= sgHbB; have [sHbA _] := subsetIP sgHbB. - rewrite -sub_morphim_pre // in sgHbB; rewrite -(minB _ _ sgHbB) ?injmK //. - rewrite morphim_injm_eq1 // {}ntHb {actsXHb}(subset_trans actsXHb) //=. - have{sHbA} [H defHb sPhiH sHA] := inv_quotientS nsPhiA sHbA. - rewrite defHb def_g // gFnorm_trans //=. - by rewrite astabsQ ?subsetIr ?(normalS sPhiH sHA). -have nsUA: U <| A by rewrite -sub_abelian_normal. -have nUA: A \subset 'N(U) by case/andP: nsUA. -have Au_lt_m: #|A / U| < m := leq_trans (ltn_quotient ntU sUA) leAm. -have cAuAu: abelian (A / U) := quotient_abelian _ cAA. -have pAu: p.-group (A / U) := quotient_pgroup _ pA. -have p'Xu: p^'.-group (X / U) := quotient_pgroup _ p'X. -have nXAu: X / U \subset 'N(A / U) := quotient_norms _ nAX. -have{Au_lt_m p'Xu nXAu} [S defAu simS] := IHm _ _ _ Au_lt_m cAuAu pAu p'Xu nXAu. -have sSAu: forall Ku, Ku \in S -> Ku \subset A / U. - by move=> Ku S_Ku; rewrite -(bigdprodWY defAu) sub_gen // (bigcup_max Ku). -have{B ntB sBAn tiBU} [Ku S_Ku eKu]: exists2 Ku, Ku \in S & exponent Ku == (p ^ n.+1)%N. - apply/exists_inP; apply: contraR ntB; rewrite negb_exists_in -subG1 -tiBU. - move/forall_inP=> expSpn; apply/subsetP=> x Ux; rewrite inE Ux coset_idr //. - by rewrite (subsetP nUA) // (subsetP (Mho_sub n A)) // (subsetP sBAn). - have [y Ay ->]: exists2 y, y \in A & x = y ^+ (p ^ n). - by apply/imsetP; rewrite -MhoEabelian ?(subsetP sBAn). - rewrite morphX ?(subsetP nUA) // (exponentP _ _ (mem_quotient _ Ay)) //. - rewrite -sub_Ldiv -OhmEabelian ?(abelianS (Ohm_sub n _)) //=. - rewrite (OhmE n pAu) /= -(bigdprodWY defAu) genS // subsetI sub_gen //=. - apply/bigcupsP=> Ku S_Ku; rewrite sub_LdivT. - have: exponent Ku %| p ^ n.+1. - by rewrite (dvdn_trans (exponentS (sSAu _ S_Ku))) // -eA exponent_quotient. - case/dvdn_pfactor=> // k le_k_n1 expKu; rewrite expKu dvdn_exp2l //. - by rewrite -ltnS ltn_neqAle le_k_n1 -(eqn_exp2l _ _ p_gt1) -expKu expSpn. -have{sSAu} [sKuA [homoKu nKuX minKu]] := (sSAu Ku S_Ku, simS Ku S_Ku). -have [K defKu sUK sKA] := inv_quotientS nsUA sKuA. -have [cKK cKuKu] := (abelianS sKA cAA, abelianS sKuA cAuAu). -have [pK pKu] := (pgroupS sKA pA, pgroupS sKuA pAu). -have nsUK: U <| K := normalS sUK sKA nsUA; have [_ nUK] := andP nsUK. -have nKX: X \subset 'N(K). - by rewrite -(quotientSGK nUX) ?normsG ?quotient_normG // -defKu. -pose K1 := 'Mho^1(K); have nsK1K: K1 <| K := Mho_normal 1 K. -have nXKb: X / K1 \subset 'N(K / K1) by apply: quotient_norms. -pose K'u := \big[dprod/1]_(Bu in S :\ Ku) Bu. -have{S_Ku} defAu_K: K / U \x K'u = A / U by rewrite -defKu -big_setD1. -have [[_ Pu _ defK'u]] := dprodP defAu_K; rewrite defK'u => mulKPu _ tiKPu. -have [_ sPuA] := mulG_sub mulKPu. -have [P defPu sUP sPA] := inv_quotientS nsUA sPuA. -have{simS defK'u} nPX: X \subset 'N(P). - rewrite -(quotientSGK nUX) ?normsG // quotient_normG ?(normalS sUP sPA) //. - rewrite -defPu -(bigdprodWY defK'u) norms_gen ?norms_bigcup //. - by apply/bigcapsP=> Bu; case/setD1P=> _; case/simS. -have abelKb: p.-abelem (K / K1). - by rewrite -[K1](Phi_Mho pK) ?Phi_quotient_abelem. -have p'Xb: p^'.-group (X / K1) := quotient_pgroup _ p'X. -have sUKb: U / K1 \subset K / K1 := quotientS _ sUK. -have nUXb: X / K1 \subset 'N(U / K1) := quotient_norms _ nUX. -have tiUK1: U :&: K1 = 1. - apply/trivgP; apply/subsetP=> xp; case/setIP=> Uxp K1xp. - have{K1xp} [x Kx def_xp]: exists2 x, x \in K & xp = x ^+ p. - by apply/imsetP; rewrite -(MhoEabelian 1). - suffices A1x: x \in 'Ohm_1(A). - by rewrite def_xp inE; case/abelemP: abelA1 => // _ ->. - have nUx: x \in 'N(U) := subsetP nUK x Kx. - rewrite -sub1set -(quotientSGK _ sUA1) ?quotient_set1 ?sub1set //. - apply: (subsetP (quotientS U (subset_trans (MhoS n sKA) sAnA1))). - rewrite quotientE morphim_Mho //= -quotientE -defKu. - have ->: 'Mho^n(Ku) = 'Ohm_1(Ku). - by rewrite (homocyclic_Ohm_Mho 1 pKu) // (eqP eKu) pfactorK ?subn1. - rewrite (OhmE 1 pKu) ?mem_gen // !inE defKu mem_quotient //=. - by rewrite -morphX //= -def_xp coset_id. -have [Db defKb nDXb] := Maschke_abelem abelKb p'Xb sUKb nXKb nUXb. -have [_ mulUDb _ tiUDb] := dprodP defKb; have [_ sDKb] := mulG_sub mulUDb. -have [D defDb sK1D sDK] := inv_quotientS (Mho_normal 1 K) sDKb. -have nK1X: X \subset 'N(K1) := gFnorm_trans _ nKX. -have [cDU [sK1K nK1K]] := (centSS sUK sDK cKK, andP nsK1K). -have nDX: X \subset 'N(D). - rewrite -(quotientSGK nK1X) ?normsG // quotient_normG ?(normalS _ sDK) //. - by rewrite -defDb. -have{mulUDb} mulUD: U * D = K. - rewrite (centC cDU) -(mulSGid sK1D) -mulgA -(centC cDU). - rewrite -quotientK ?quotientMr ?(subset_trans _ nK1K) ?mul_subG // -defDb. - by rewrite mulUDb quotientGK. -have cKP: P \subset 'C(K) := centSS sPA sKA cAA. -have mulKP: K * P = A. - rewrite -(mulSGid sUK) -mulgA -(quotientGK nsUA) -mulKPu defPu. - by rewrite -quotientK ?quotientMr ?mul_subG ?(subset_trans _ nUA). -have defKP: K :&: P = U. - apply/eqP; rewrite eqEsubset subsetI sUK sUP !andbT. - by rewrite -quotient_sub1 ?subIset ?nUK // -tiKPu defPu quotientI. -have tiUD: U :&: D = 1. - apply/trivgP; rewrite -tiUK1 subsetI subsetIl. - rewrite -quotient_sub1; last by rewrite subIset ?(subset_trans sUK). - by rewrite -tiUDb defDb quotientI. -have tiDP: D :&: P = 1 by rewrite -(setIidPl sDK) -setIA defKP setIC. -have mulDP: D * P = A by rewrite -(mulSGid sUP) mulgA -(centC cDU) mulUD. -have sDA := subset_trans sDK sKA. -have defA: D \x P = A by rewrite dprodE // (centSS sPA sDA). -have ntD: D :!=: 1. - apply: contraNneq ntA => D1; rewrite trivg_exponent eA -(eqP eKu). - rewrite -trivg_exponent -subG1 -tiKPu defKu subsetIidl defPu quotientS //. - by rewrite -(mul1g P) -D1 mulDP. -have ltPm: #|P| < m. - by rewrite (leq_trans _ leAm) // -(dprod_card defA) ltn_Pmull ?cardG_gt1. -have [cPP pP] := (abelianS sPA cAA, pgroupS sPA pA). -have{S defAu K'u defAu_K} [S defP simS] := IHm _ _ _ ltPm cPP pP p'X nPX. -exists (D |: S) => [ | {defP}B]. - rewrite big_setU1 ?defP //=; apply: contra ntD => S_D. - by rewrite -subG1 -tiDP subsetIidl -(bigdprodWY defP) sub_gen ?(bigcup_max D). -case/setU1P=> [-> {B S simS} | ]; last exact: simS. -have [[pD cDD] nUD] := (pgroupS sDA pA, abelianS sDA cAA, subset_trans sDA nUA). -have isoD: D \isog Ku by rewrite defKu -mulUD quotientMidl quotient_isog. -rewrite {isoD}(isog_homocyclic isoD); split=> //. -have nPhiDX: X \subset 'N('Phi(D)) := gFnorm_trans _ nDX. -have [f [injf im_f act_f]]: - exists f : {morphism D / 'Phi(D) >-> coset_of 'Phi(Ku)}, - [/\ 'injm f, f @* (D / 'Phi(D)) = Ku / 'Phi(Ku) - & {in D / 'Phi(D) & X, morph_act 'Q 'Q f (coset U)}]. -- have [/= injf im_f] := isomP (quotient_isom nUD tiUD). - set f := restrm nUD (coset U) in injf im_f. - rewrite -quotientMidl mulUD -defKu in im_f. - have fPhiD: f @* 'Phi(D) = 'Phi(Ku) by rewrite -im_f (morphim_Phi _ pD). - rewrite -['Phi(Ku)]/(gval 'Phi(Ku)%G) -(group_inj fPhiD). - exists (quotm_morphism [morphism of f] (Phi_normal _)). - rewrite (injm_quotm _ injf) morphim_quotm /= -/f im_f. - split=> // yb x; case/morphimP=> y Ny Dy ->{yb} Xx. - have [nPhiDx nUx] := (subsetP nPhiDX x Xx, subsetP nUX x Xx). - have Dyx: y ^ x \in D by rewrite memJ_norm // (subsetP nDX). - rewrite quotmE // !qactE ?qact_domE ?subsetT ?astabsJ ?quotmE //=. - - by congr (coset _ _); rewrite /f /restrm morphJ // (subsetP nUD). - - by rewrite (subsetP (morphim_norm _ _)) ?mem_morphim. - rewrite morphim_restrm (setIidPr (Phi_sub _)). - by rewrite (subsetP (morphim_norm _ _)) ?mem_quotient. -apply/mingroupP; split=> [|Y /andP[ntY actsXY] sYD]. - rewrite -subG1 quotient_sub1 ?gFnorm //. - by rewrite proper_subn ?Phi_proper // actsQ. -have{minKu} [_ minKu] := mingroupP minKu. -apply: (injm_morphim_inj injf); rewrite // im_f. -apply: minKu; last by rewrite /= -im_f morphimS. -rewrite morphim_injm_eq1 // ntY. -apply/subsetP=> _ /morphimP[x Nx Xx ->]. -rewrite 2!inE /= qact_domE ?subsetT // astabsJ. -rewrite (subsetP (gFnorm_trans _ nKuX)) ?mem_quotient //=. -apply/subsetP=> _ /morphimP[y Dy Yy ->]. -by rewrite inE /= -act_f // morphimEsub // mem_imset // (acts_act actsXY). -Qed. - -CoInductive is_iso_quotient_homocyclic_sdprod gT (V G : {group gT}) m : Prop := - IsoQuotientHomocyclicSdprod wT (W D G1 : {group wT}) (f : {morphism D >-> gT}) - of homocyclic W & #|W| = (#|V| ^ m)%N - & 'ker f = 'Mho^1(W) & f @* W = V & f @* G1 = G & W ><| G1 = D. - -Lemma iso_quotient_homocyclic_sdprod gT (V G : {group gT}) p m : - minnormal V G -> coprime p #|G| -> p.-abelem V -> m > 0 -> - is_iso_quotient_homocyclic_sdprod V G m. -Proof. -move=> minV copG abelV m_gt0; pose q := (p ^ m)%N. -have [ntV nVG] := andP (mingroupp minV). -have [p_pr pVdvdn [n Vpexpn]] := pgroup_pdiv (abelem_pgroup abelV) ntV. -move/(abelem_mx_irrP abelV ntV nVG): (minV) => mx_irrV. -have dim_lt0 : 'dim V > 0 by rewrite (dim_abelemE abelV) // Vpexpn pfactorK. -have q_gt1: q > 1 by rewrite (ltn_exp2l 0) // prime_gt1. -have p_q: p.-nat q by rewrite pnat_exp pnat_id. -have p_dv_q: p %| q := dvdn_exp2l p m_gt0. -pose rG := regular_repr [comUnitRingType of 'Z_q] G; pose MR_G := ('MR rG)%gact. -have [wT [fL injL [fX injX fJ]]]: exists wT : finGroupType, - exists2 fL : {morphism setT >-> wT}, 'injm fL & - exists2 fX : {morphism G >-> wT}, 'injm fX & - {in setT & G, morph_act MR_G 'J fL fX}. -- exists (sdprod_groupType MR_G). - exists (sdpair1_morphism MR_G); first exact: injm_sdpair1. - by exists (sdpair2_morphism MR_G); [apply: injm_sdpair2 | apply: sdpair_act]. -move imfL: (fL @* [set: _])%G => L; move imfX: (fX @* G)%G => X. -have cLL: abelian L by rewrite -imfL morphim_abelian // zmod_abelian. -have pL: p.-group L. - by rewrite -imfL morphim_pgroup -?pnat_exponent ?exponent_mx_group. -have tiVG: V :&: G = 1 by rewrite coprime_TIg // Vpexpn coprime_pexpl. -have{copG} p'G: p^'.-group G by rewrite /pgroup p'natE // -prime_coprime. -have p'X: p^'.-group X by rewrite -imfX morphim_pgroup. -have nXL: X \subset 'N(L). - rewrite -imfX -imfL; apply/subsetP=> _ /morphimP[x Gx _ ->]; rewrite inE. - apply/subsetP=> _ /imsetP[_ /morphimP[v rVv _ ->] ->]. - by rewrite -fJ // mem_morphim ?in_setT. -have [/= S defL im_S] := coprime_act_abelian_pgroup_structure cLL pL p'X nXL. -pose gi (z : 'Z_q) := z%:R : 'F_p. -have giM: rmorphism gi. - split=> [z1 z2|]; last split=> // z1 z2. - apply: canRL (addrK _) _; apply: val_inj. - by rewrite -{2}(subrK z2 z1) -natrD /= !val_Fp_nat ?modn_dvdm // Zp_cast. - by apply: val_inj; rewrite -natrM /= !val_Fp_nat ?modn_dvdm // Zp_cast. -have [gL [DgL _ _ _]] := domP (invm_morphism injL) (congr_group imfL). -pose g u := map_mx (RMorphism giM) (gL u). -have gM: {in L &, {morph g : u v / u * v}}. - by move=> u v Lu Lv /=; rewrite {1}/g morphM // map_mxD. -have kerg: 'ker (Morphism gM) = 'Phi(L). - rewrite (Phi_Mho pL cLL) (MhoEabelian 1 pL cLL). - apply/setP=> u; apply/idP/imsetP=> [ | [v Lv ->{u}]]; last first. - rewrite !inE groupX //=; apply/eqP/rowP=> i; apply: val_inj. - rewrite !mxE morphX // mulmxnE Zp_mulrn /= val_Fp_nat //=. - by move: {i}(_ i); rewrite Zp_cast // => vi; rewrite modn_dvdm // modnMl. - case/morphpreP; rewrite -{1}imfL => /morphimP[v rVv _ ->{u}] /set1P /=. - rewrite /g DgL /= invmE // => /rowP vp0. - pose x := fL (map_mx (fun t : 'Z_q => (t %/ p)%:R) v). - exists x; first by rewrite -imfL mem_morphim ?inE. - rewrite -morphX ?in_setT //; congr (fL _); apply/rowP=> i. - rewrite mulmxnE -{1}(natr_Zp (v 0 i)) {1}(divn_eq (v 0 i) p) addnC. - by have:= congr1 val (vp0 i); rewrite !mxE -mulrnA /= val_Fp_nat // => ->. -have [gX [DgX KgX _ imgX]] := domP (invm_morphism injX) (congr_group imfX). -pose aG := regular_repr [fieldType of 'F_p] G. -have GgX: {in X, forall x, gX x \in G}. - by rewrite DgX -imfX => _ /morphimP[x Gx _ ->]; rewrite /= invmE. -have XfX: {in G, forall x, fX x \in X}. - by move=> x Gx; rewrite -imfX mem_morphim. -have gJ: {in L & X, forall u x, g (u ^ x) = g u *m aG (gX x)}. - rewrite -{1}imfL -{1}imfX => _ _ /morphimP[u rVu _ ->] /morphimP[x Gx _ ->]. - rewrite -fJ // /g DgL DgX /= !invmE // mx_repr_actE ?inE //. - by rewrite (map_mxM (RMorphism giM)) map_regular_mx. -pose gMx U := rowg_mx (Morphism gM @* U). -have simS: forall U, U \in S -> mxsimple aG (gMx U). - move=> U S_U; have [_ nUX irrU] := im_S U S_U. - have{irrU} [modU irrU] := mingroupP irrU; have{modU} [ntU _] := andP modU. - have sUL: U \subset L by rewrite -(bigdprodWY defL) sub_gen // (bigcup_max U). - split=> [||U2 modU2]. - - rewrite (eqmx_module _ (genmxE _)); apply/mxmoduleP=> x Gx. - apply/row_subP=> i; rewrite row_mul rowK. - have [u Lu Uu def_u] := morphimP (enum_valP i). - rewrite -(invmE injX Gx) -DgX def_u -gJ ?XfX //. - set ux := u ^ _; apply: eq_row_sub (gring_index _ (g ux)) _. - have Uux: ux \in U by rewrite memJ_norm // (subsetP nUX) ?XfX. - by rewrite rowK gring_indexK //; apply: mem_morphim; rewrite ?(subsetP sUL). - - apply: contra ntU; rewrite rowg_mx_eq0. - rewrite -subG1 sub_morphim_pre // -kerE kerg => sU_Phi. - rewrite /= quotientS1 //=; rewrite (big_setD1 U) //= in defL. - have{defL} [[_ U' _ ->] defUU' cUU' tiUU'] := dprodP defL. - have defL: U \* U' = L by rewrite cprodE. - have:= cprod_modl (Phi_cprod pL defL) (Phi_sub U). - rewrite -(setIidPl (Phi_sub U')) setIAC -setIA tiUU' setIg1 cprodg1 => ->. - by rewrite subsetIidr. - rewrite -!rowgS stable_rowg_mxK /= => [sU2gU nzU2|]; last first. - apply/subsetP=> z _; rewrite !inE /=; apply/subsetP=> u gUu. - by rewrite inE /= /scale_act -[val z]natr_Zp scaler_nat groupX. - rewrite sub_morphim_pre // -subsetIidl. - rewrite -(quotientSGK (normal_norm (Phi_normal U))) //=; last first. - rewrite subsetI Phi_sub (subset_trans (PhiS pL sUL)) //. - by rewrite -kerg ker_sub_pre. - rewrite [(U :&: _) / _]irrU //; last by rewrite quotientS ?subsetIl. - rewrite (contra _ nzU2) /=; last first. - rewrite -subG1 quotient_sub1; last first. - by rewrite subIset // normal_norm // Phi_normal. - rewrite /= -(morphpre_restrm sUL). - move/(morphimS (restrm_morphism sUL (Morphism gM))). - rewrite morphpreK ?im_restrm // morphim_restrm => s_U2_1. - rewrite -trivg_rowg -subG1 (subset_trans s_U2_1) //. - rewrite -(morphim_ker (Morphism gM)) morphimS // kerg. - by rewrite subIset ?(PhiS pL) ?orbT. - rewrite actsQ //; first by rewrite gFnorm_trans. - rewrite normsI //; apply/subsetP=> x Xx; rewrite inE. - apply/subsetP=> _ /imsetP[u g'U2u ->]. - have [Lu U2gu] := morphpreP g'U2u; rewrite mem_rowg in U2gu. - rewrite inE memJ_norm ?(subsetP nXL) // Lu /= inE gJ //. - by rewrite mem_rowg (mxmodule_trans modU2) ?GgX. -have im_g: Morphism gM @* L = [set: 'rV_#|G|]. - apply/eqP; rewrite eqEcard subsetT cardsT card_matrix card_Fp //= mul1n. - rewrite card_morphim kerg setIid (Phi_Mho pL cLL) -divgS ?Mho_sub //. - rewrite -(mul_card_Ohm_Mho_abelian 1 cLL) mulnK ?cardG_gt0 //. - rewrite (card_pgroup (pgroupS (Ohm_sub 1 L) pL)) -rank_abelian_pgroup //. - by rewrite -imfL (injm_rank injL) //= rank_mx_group mul1n. -have sumS: (\sum_(U in S) gMx U :=: 1%:M)%MS. - apply/eqmxP; rewrite submx1; apply/rV_subP=> v _. - have: v \in Morphism gM @* L by rewrite im_g inE. - case/morphimP=> u Lu _ ->{v}. - rewrite -mem_rowg -sub1set -morphim_set1 // sub_morphim_pre ?sub1set //. - have [c [Uc -> _]] := mem_bigdprod defL Lu; rewrite group_prod //= => U S_U. - have sUL: U \subset L by rewrite -(bigdprodWY defL) sub_gen // (bigcup_max U). - rewrite inE (subsetP sUL) ?Uc // inE mem_rowg (sumsmx_sup U) // -mem_rowg. - by rewrite (subsetP (sub_rowg_mx _)) // mem_morphim ?(subsetP sUL) ?Uc. -have Fp'G: [char 'F_p]^'.-group G. - by rewrite (eq_p'group _ (charf_eq (char_Fp p_pr))). -have [VK [modVK defVK]] := rsim_regular_submod mx_irrV Fp'G. -have [U S_U isoUV]: {U | U \in S & mx_iso (regular_repr _ G) (gMx U) VK}. - apply: hom_mxsemisimple_iso (scalar_mx_hom _ 1 _) _ => [|U S_U _|]; auto. - by apply/(submod_mx_irr modVK); apply: (mx_rsim_irr defVK). - by rewrite mulmx1 sumS submx1. -have simU := simS U S_U; have [modU _ _] := simU. -pose rV := abelem_repr abelV ntV nVG. -have{VK modVK defVK isoUV} [h dimU h_free hJ]: mx_rsim (submod_repr modU) rV. - by apply: mx_rsim_trans (mx_rsim_sym defVK); apply/mx_rsim_iso. -have sUL : U \subset L. - by move: defL; rewrite (big_setD1 U) //= => /dprodP[[_ U1 _ ->] /mulG_sub[]]. -pose W := [set: 'rV['Z_(p ^ m)](V)]%G. -have [homU nUX _] := im_S U S_U; have [cUU _] := andP homU. -have atypeU: abelian_type U == nseq ('dim V) (p ^ m)%N. - rewrite (big_setD1 U) //= in defL. - have [[_ U' _ defU'] defUU' _ tiUU'] := dprodP defL. - rewrite defU' in defL defUU' tiUU'. - have ->: 'dim V = 'r(U). - apply/eqP; rewrite -dimU -(eqn_exp2l _ _ (prime_gt1 p_pr)). - rewrite (rank_abelian_pgroup (pgroupS sUL pL) cUU). - rewrite -(card_pgroup (pgroupS (Ohm_sub 1 U) (pgroupS sUL pL))). - rewrite -{1}(card_Fp p_pr) -card_rowg stable_rowg_mxK; last first. - apply/subsetP=> z _; rewrite !inE; apply/subsetP=> v gUv. - by rewrite inE /= /scale_act -(natr_Zp (val z)) scaler_nat groupX. - rewrite card_morphim kerg (Phi_Mho pL cLL) (setIidPr sUL) -divgI setIC. - rewrite -(dprod_modl (Mho_dprod 1 defL) (Mho_sub 1 U)). - rewrite [_ :&: _](trivgP _); last by rewrite -tiUU' setIC setSI ?Mho_sub. - by rewrite dprodg1 -(mul_card_Ohm_Mho_abelian 1 cUU) mulnK ?cardG_gt0. - have isoL: isog L [set: 'rV['Z_q]_#|G|] by rewrite -imfL isog_sym sub_isog. - have homL: homocyclic L by rewrite (isog_homocyclic isoL) mx_group_homocyclic. - have [-> _] := abelian_type_dprod_homocyclic defL pL homL. - by rewrite (exponent_isog isoL) // exponent_mx_group. -have pU: p.-group U by rewrite (pgroupS sUL). -have isoWU: isog U W. - by rewrite eq_abelian_type_isog ?zmod_abelian // abelian_type_mx_group ?mul1n. -have {cUU atypeU} cardU : #|U| = (#|V| ^ m)%N. - rewrite card_homocyclic // (exponent_isog isoWU) exponent_mx_group //. - rewrite -size_abelian_type // (eqP atypeU) size_nseq. - by rewrite (dim_abelemE abelV) // Vpexpn pfactorK // expnAC. -pose f3 w := rVabelem abelV ntV (in_submod _ (g w) *m h). -have f3M: {in U &, {morph f3: w1 w2 / w1 * w2}}. - move=> w1 w2 Uw1 Uw2 /=; rewrite {1}/f3. - rewrite gM ?(subsetP sUL) // linearD mulmxDl. - by rewrite morphM ?mem_im_abelem_rV. -have Ugw w : w \in U -> (g w <= gMx U)%MS. - move=> Uw; rewrite -mem_rowg (subsetP (sub_rowg_mx _)) //. - by rewrite (mem_morphim (Morphism gM)) ?(subsetP sUL). -have KgU: 'ker_U (Morphism gM) = 'Mho^1(U). - rewrite kerg (Phi_Mho pL cLL); rewrite (big_setD1 U) //= in defL. - have [[_ U' _ defU'] _ _ tiUU'] := dprodP defL; rewrite defU' in defL tiUU'. - rewrite setIC -(dprod_modl (Mho_dprod 1 defL) (Mho_sub 1 U)). - by rewrite [_ :&: _](trivgP _) ?dprodg1 // -tiUU' setIC setSI ?Mho_sub. -have{KgU} Kf3: 'ker (Morphism f3M) = 'Mho^1(U). - apply/setP=> w; rewrite !inE /=. - rewrite morph_injm_eq1 ?rVabelem_injm ?mem_im_abelem_rV //=. - rewrite -[1](mul0mx _ h) (inj_eq (row_free_inj h_free)) in_submod_eq0. - case Uw: (w \in U) => /=; last first. - by apply/sym_eq; apply: contraFF Uw; apply: (subsetP (Mho_sub _ _)). - rewrite -[(_ <= _)%MS]andTb -(Ugw _ Uw) -sub_capmx capmx_compl submx0. - by rewrite -KgU !inE Uw (subsetP sUL). -have cUU: abelian U := abelianS sUL cLL. -have im_f3: Morphism f3M @* U = V. - apply/eqP; rewrite eqEcard card_morphim setIid Kf3; apply/andP; split. - by apply/subsetP=> _ /morphimP[w _ _ ->]; apply: mem_rVabelem. - rewrite -divgS ?Mho_sub // -(mul_card_Ohm_Mho_abelian 1 cUU). - rewrite mulnK ?cardG_gt0 // (card_pgroup (pgroupS (Ohm_sub 1 U) pU)). - rewrite -rank_abelian_pgroup // (isog_rank isoWU) /W. - by rewrite (dim_abelemE abelV) // rank_mx_group mul1n Vpexpn pfactorK. -have f3J: {in U & X, morph_act 'J 'J (Morphism f3M) gX}. - move=> u x Uu Xx; rewrite /f3 /= gJ ?(subsetP sUL) // in_submodJ ?Ugw //. - by rewrite -mulmxA hJ ?GgX // mulmxA rVabelemJ ?GgX. -have defUX: U ><| X = U <*> X. - rewrite norm_joinEr; last by case: (im_S _ S_U). - by rewrite sdprodE ?coprime_TIg ?(pnat_coprime pU). -pose f := sdprodm defUX f3J. -have{im_f3} fU_V: f @* U = V by rewrite morphim_sdprodml. -have fX_G: f @* X = G by rewrite morphim_sdprodmr // imgX -imfX im_invm. -suffices: 'ker f = 'Mho^1(U) by exists wT U (U <*> X)%G X [morphism of f]. -rewrite -Kf3; apply/setP=> y; apply/idP/idP; last first. - move=> /morphpreP[/= Uy /set1P f3y]. - by rewrite !inE /= sdprodmEl //= f3y (subsetP (joing_subl _ X)) /=. -rewrite ker_sdprodm => /imset2P[u t Uu /setIdP[Xt /eqP/= fu] ->{y}]. -have: f3 u \in V :&: G. - by rewrite inE -fU_V morphim_sdprodml //= mem_imset ?setIid // fu GgX. -rewrite tiVG in_set1 fu morph_injm_eq1 ?KgX ?injm_invm // => /eqP t1. -by rewrite t1 invg1 mulg1 !inE Uu /= fu t1 morph1. -Qed. - -Theorem solvable_Wielandt_fixpoint (I : finType) gT (A : I -> {group gT}) - (n m : I -> nat) (G V : {group gT}) : - (forall i, m i + n i > 0 -> A i \subset G) -> - G \subset 'N(V) -> coprime #|V| #|G| -> solvable V -> - {in G, forall a, \sum_(i | a \in A i) m i = \sum_(i | a \in A i) n i}%N -> - (\prod_i #|'C_V(A i)| ^ (m i * #|A i|) - = \prod_i #|'C_V(A i)| ^ (n i * #|A i|))%N. -Proof. -move: {2}_.+1 (ltnSn #|V|) => c leVc sA_G nVG coVG solV partG; move: leVc. -pose nz_k i := (0 < m i + n i)%N; rewrite !(bigID nz_k xpredT) /= {2 4}/nz_k. -rewrite !(big1 _ (predC _)) /= => [|i|i]; try by case: (m i) (n i) => [[]|]. -pose sum_k A_ a k := (\sum_(i | (a \in (A_ i : {set _})) && nz_k i) k i)%N. -have{partG} partG: {in G, forall a, sum_k _ A a m = sum_k _ A a n}. - move=> a /partG; rewrite !(bigID nz_k (fun i => a \in _)) -!/(sum_k _ A a _). - by rewrite /= !big1 ?addn0 /nz_k // => i /andP[_]; case: (m i) (n i) => [[]|]. -rewrite !muln1; elim: c => // c IHc in gT G A V nVG coVG solV partG sA_G *. -rewrite ltnS => leVc; have [-> | ntV] := eqsVneq V 1. - by rewrite !big1 // => i _; rewrite setI1g cards1 exp1n. -have nsVVG: V <| V <*> G by rewrite normalYl. -without loss{c leVc IHc} minV: / minnormal V (V <*> G). - have [B minB sBV]: {B : {group gT} | minnormal B (V <*> G) & B \subset V}. - by apply: mingroup_exists; rewrite ntV normal_norm. - have [nBVG ntB abB] := minnormal_solvable minB sBV solV. - have [nBV nBG] := joing_subP nBVG; have solB := solvableS sBV solV. - have [{1}<- -> // | ltBV _] := eqVproper sBV. - have ltBc: #|B| < c := leq_trans (proper_card ltBV) leVc. - have coBG: coprime #|B| #|G| := coprimeSg sBV coVG. - have factorCA_B k i: nz_k i -> - (#|'C_B(A i)| ^ (k i * #|A i|) * #|'C_(V / B)(A i / B)| ^ (k i * #|A i / B|) - = #|'C_V(A i)| ^ (k i * #|A i|))%N. - - move/sA_G => sAiG; have nBAi := subset_trans sAiG nBG. - have [coVAi coBAi] := (coprimegS sAiG coVG, coprimegS sAiG coBG). - rewrite -(card_isog (quotient_isog _ _)) ?(coprime_TIg coBAi) // -expnMn. - rewrite -coprime_quotient_cent // -{1}(setIidPr sBV) setIAC. - by rewrite card_quotient ?LagrangeI // subIset ?nBV. - rewrite -!{1}(eq_bigr _ (factorCA_B _)) {factorCA_B} !big_split /=. - pose A_B i := A i / B; congr (_ * _)%N; first exact: (IHc _ G). - have: #|V / B| < c by apply: leq_trans leVc; rewrite ltn_quotient. - have (i): nz_k i -> A i / B \subset G / B by move/sA_G/quotientS->. - apply: IHc; rewrite ?morphim_sol ?coprime_morph ?quotient_norms //. - move=> _ /morphimP[a Na Ga ->]. - suffices eqAB: sum_k _ A_B (coset B a) =1 sum_k _ A a by rewrite !eqAB partG. - move=> k; apply: eq_bigl => i; apply: andb_id2r => /sA_G sAiG. - rewrite -sub1set -quotient_set1 // quotientSK ?sub1set //. - by rewrite -{2}(mul1g (A i)) -(coprime_TIg coBG) setIC group_modr // inE Ga. -have /is_abelemP[p p_pr abelV] := minnormal_solvable_abelem minV solV. -have [p_gt1 [pV cVV _]] := (prime_gt1 p_pr, and3P abelV). -have{minV} minV: minnormal V G. - apply/mingroupP; split=> [|B nBG sBV]; first by rewrite ntV nVG. - by case/mingroupP: minV => _ -> //; rewrite join_subG (sub_abelian_norm cVV). -have co_pG: coprime p #|G|. - by have [_ _ [e oV]] := pgroup_pdiv pV ntV; rewrite oV coprime_pexpl in coVG. -have p'G: p^'.-group G by rewrite pgroupE p'natE -?prime_coprime. -pose rC i := logn p #|'C_V(A i)|. -have ErC k i: (#|'C_V(A i)| ^ (k i * #|A i|) = p ^ (rC i * k i * #|A i|))%N. - suffices /card_pgroup->: p.-group 'C_V(A i) by rewrite -expnM mulnA. - by rewrite (pgroupS (subsetIl _ _)). -rewrite !{1}(eq_bigr _ (fun i _ => ErC _ i)) {ErC} -!expn_sum; congr (_ ^ _)%N. -have eqmodX x y: (forall e, x = y %[mod p ^ e]) -> x = y. - pose e := maxn x y; move/(_ e); have:= ltn_expl e p_gt1. - by rewrite gtn_max /= => /andP[x_ltq y_ltq]; rewrite !modn_small. -apply: eqmodX => e; have [-> | e_gt0] := posnP e; first by rewrite !modn1. -set q := (p ^ e)%N; have q_gt1: q > 1 by rewrite -(exp1n e) ltn_exp2r. -have{e_gt0 co_pG} [wT W D G1 f homoW oW kerf imfW imfG1 defD] := - iso_quotient_homocyclic_sdprod minV co_pG abelV e_gt0. -have [[cWW _] [_ /mulG_sub[sWD sG1D] nWG1 tiWG1]] := (andP homoW, sdprodP defD). -have pW: p.-group W by rewrite /pgroup oW pnat_exp [p.-nat _]pV. -have rW_V: 'r(W) = 'dim V. - rewrite (rank_abelian_pgroup pW cWW) -(mulnK #|_| (cardG_gt0 'Mho^1(W))). - rewrite mul_card_Ohm_Mho_abelian // divg_normal ?Mho_normal //=. - rewrite -(setIidPr (Mho_sub 1 W)) -kerf. - by rewrite (card_isog (first_isog_loc _ _)) //= imfW (dim_abelemE abelV). -have expW: exponent W = q. - apply/eqP; rewrite -(@eqn_exp2r _ _ ('dim V)) // -{1}rW_V -expnM mulnC expnM. - by rewrite (dim_abelemE abelV) -?card_pgroup // -oW eq_sym max_card_abelian. -have{rW_V} /isogP[fW injfW im_fW]: [set: 'rV['Z_q](V)] \isog W. - rewrite eq_abelian_type_isog ?zmod_abelian // abelian_type_mx_group ?mul1n //. - by rewrite abelian_type_homocyclic // rW_V expW. -have WfW u: fW u \in W by rewrite -im_fW mem_morphim ?inE. -have [fW' [DfW' KfW' _ _]] := domP (invm_morphism injfW) im_fW. -have{KfW'} injfW': 'injm fW' by rewrite KfW' injm_invm. -have fW'K: {in W, cancel fW' fW} by move=> w Ww; rewrite DfW' invmK //= im_fW. -have toWlin a1: linear (fun u => fW' (fW u ^ val (subg G1 a1))). - move=> z /= x y; rewrite (morphM fW) /= ?in_setT // conjMg /=. - rewrite morphM ?memJ_norm ?(subsetP nWG1) ?subgP //=; congr (_ * _). - rewrite -(natr_Zp z) !scaler_nat morphX ?in_setT // conjXg morphX //. - by rewrite memJ_norm // (subsetP nWG1) ?subgP. -pose rW a1 := lin1_mx (Linear (toWlin a1)). -pose fG := restrm sG1D f; have im_fG : fG @* G1 = G by rewrite im_restrm. -have injfG: 'injm fG by rewrite -tiWG1 setIC ker_restrm kerf setIS ?Mho_sub. -pose fG' := invm injfG; have im_fG': fG' @* G = G1 by rewrite -im_fG im_invm. -pose gamma i := \sum_(a in A i) rW (fG' a). -suffices{sum_k partG} tr_rW_Ai i: nz_k i -> \tr (gamma i) = (rC i * #|A i|)%:R. - have Dtr k i: nz_k i -> (rC i * k i * #|A i|)%:R = \tr (gamma i *+ k i). - by rewrite mulnAC natrM raddfMn mulr_natr /= => /tr_rW_Ai->. - rewrite -!val_Zp_nat // !natr_sum !{1}(eq_bigr _ (Dtr _)){Dtr}; congr (val _). - rewrite -!raddf_sum -!(eq_bigr _ (fun i _ => sumrMnl _ _ _ _)); congr (\tr _). - have sA_GP i a nz_i := subsetP (sA_G i nz_i) a. - rewrite !(exchange_big_dep (mem G)) {sA_GP}//=; apply: eq_bigr => a Ga. - by rewrite !sumrMnr !(big_andbC _ _ _ nz_k) -!/(sum_k _ A a _) partG. -move/sA_G=> {sA_G} sAiG; pose Ai1 := fG' @* A i; pose rR := 'r([~: W, Ai1]). -have sAiG1: Ai1 \subset G1 by rewrite -im_fG' morphimS. -have AfG' a: a \in A i -> fG' a \in Ai1. - by move=> Aa; rewrite mem_morphim //= im_restrm imfG1 ?(subsetP sAiG). -have coWAi1: coprime #|W| #|Ai1|. - by rewrite coprime_morphr ?(coprimegS sAiG) ?(pnat_coprime pW). -suffices [Pl [Pr [Pu [Pd [PlrudK ErC ErR]]]]]: - exists Pl, exists Pr, exists Pu, exists Pd, - [/\ row_mx Pl Pr *m col_mx Pu Pd = 1%R, - {in A i, forall a, Pd *m (rW (fG' a) *m Pr) = 1%:M :> 'M_(rC i)} - & \sum_(a in A i) Pu *m (rW (fG' a) *m Pl) = 0 :> 'M_rR]. -- rewrite -(mulmx1 (gamma i)) idmxE -PlrudK mulmxA mxtrace_mulC mul_mx_row. - rewrite mul_col_row mxtrace_block !mulmx_suml !mulmx_sumr ErR mxtrace0 add0r. - by rewrite (eq_bigr _ ErC) sumr_const raddfMn /= mxtrace1 natrM mulr_natr. -have defW: [~: W, Ai1] \x 'C_W(Ai1) = W. - by rewrite coprime_abelian_cent_dprod ?(subset_trans sAiG1). -have [_ mulRCW _ tiRCW] := dprodP defW; have [sRW sCW] := mulG_sub mulRCW. -have [homoRW homoCW] := dprod_homocyclic defW pW homoW. -have [] := abelian_type_dprod_homocyclic defW pW homoW. -rewrite expW -/rR => atypeRW atypeCW. -have [[cRR _] [cCC _]] := (andP homoRW, andP homoCW). -have{cRR atypeRW} /isogP[hR injhR im_hR]: [~: W, Ai1] \isog [set: 'rV['Z_q]_rR]. - rewrite eq_abelian_type_isog ?zmod_abelian ?atypeRW //. - by rewrite abelian_type_mx_group // mul1n eqxx. -have{tiRCW} rCW : 'r('C_W(Ai1)) = rC i. - rewrite -['r(_)]rank_Ohm1; have /rank_abelem ->: p.-abelem 'Ohm_1('C_W(Ai1)). - by rewrite Ohm1_abelem ?(pgroupS (subsetIl _ _)). - congr (logn p _); transitivity #|'C_W(Ai1) : 'Mho^1('C_W(Ai1))|. - by rewrite -divgS ?Mho_sub // -(mul_card_Ohm_Mho_abelian 1 cCC) mulnK. - transitivity #|'C_W(Ai1) : 'Mho^1(W)|. - symmetry; have /dprodP[_ /= defW1 _ _] := Mho_dprod 1 defW. - rewrite -indexgI; congr #|_ : _|; rewrite /= -defW1 -group_modr ?Mho_sub //. - by rewrite [_ :&: _](trivgP _) ?mul1g //= setIC -tiRCW setSI ?Mho_sub. - suffices /card_isog ->: 'C_V(A i) \isog 'C_W(Ai1) / 'Mho^1(W). - by rewrite card_quotient // subIset // normal_norm ?Mho_normal. - rewrite coprime_quotient_cent ?Mho_sub ?abelian_sol //= -/Ai1; last first. - by rewrite (subset_trans sAiG1) // gFnorm_trans. - have ->: A i :=: fG @* Ai1. - by rewrite /Ai1 morphim_invmE morphpreK // im_restrm imfG1. - rewrite -imfW morphim_restrm (setIidPr sAiG1). - have [f1 injf1 im_f1] := first_isom f. - rewrite -!im_f1 -injm_subcent ?quotientS ?(subset_trans sAiG1) //. - by rewrite -kerf isog_sym sub_isog // subIset ?quotientS. -have{atypeCW} /isogP[hC injhC im_hC]: 'C_W(Ai1) \isog [set: 'rV['Z_q]_(rC i)]. - rewrite eq_abelian_type_isog ?zmod_abelian // atypeCW rCW. - by rewrite abelian_type_mx_group ?mul1n. -have mkMx m1 m2 (U : {group 'rV['Z_q]_m1}) (g : {morphism U >-> 'rV['Z_q]_m2}): - setT \subset 'dom g -> {Mg | mulmx^~ Mg =1 g}. -- move/subsetP=> allU; suffices lin_g: linear g. - by exists (lin1_mx (Linear lin_g)) => u; rewrite mul_rV_lin1. - move=> z u v; rewrite morphM ?allU ?in_setT //. - by rewrite -(natr_Zp z) !scaler_nat -zmodXgE morphX ?allU ?in_setT. -have /mkMx[Pu defPu]: setT \subset 'dom (invm injfW \o invm injhR). - by rewrite -sub_morphim_pre -im_hR // im_invm //= im_fW. -have /mkMx[Pd defPd]: setT \subset 'dom (invm injfW \o invm injhC). - by rewrite -sub_morphim_pre -im_hC //= im_fW im_invm subsetIl. -pose fUl := pairg1 [finGroupType of 'rV['Z_q]_(rC i)] \o hR. -pose fUr := @pair1g [finGroupType of 'rV['Z_q]_rR] _ \o hC. -have cRCW: fUr @* 'C_W(Ai1) \subset 'C(fUl @* [~: W, Ai1]). - rewrite !morphim_comp morphim_pair1g morphim_pairg1. - set UR := hR @* _; set UC := hC @* _. - by have/dprodP[] : _ = setX UR UC := setX_dprod _ _. -have /domP[fUr' [DfUr' _ _ im_fUr']]: 'dom fUr = 'C_W(Ai1). - by rewrite /dom -im_hC injmK. -have /domP[fUl' [DfUl' _ _ im_fUl']]: 'dom fUl = [~: W, Ai1]. - by rewrite /dom -im_hR injmK. -rewrite -{}im_fUr' -{}im_fUl' in cRCW; pose hW := dprodm defW cRCW. -pose fPl := @fst _ _ \o (hW \o fW); pose fPr := @snd _ _ \o (hW \o fW). -have /mkMx[/= Pl defPl]: setT \subset 'dom fPl. - by rewrite -!sub_morphim_pre ?subsetT ?im_fW. -have /mkMx[/= Pr defPr]: setT \subset 'dom fPr. - by rewrite -!sub_morphim_pre ?subsetT ?im_fW. -exists Pl, Pr, Pu, Pd; split. -- apply/row_matrixP=> j; rewrite rowE -row1 mul_row_col mulmxDr !mulmxA. - apply: (injmP injfW); rewrite ?in_setT // morphM ?in_setT //. - rewrite defPl defPr defPu defPd -/hW [hW]lock /= -lock. - have /(mem_dprod defW)[jR [jC [RjR CjC -> _]]]:= WfW (row j 1). - rewrite [hW _]dprodmE // DfUl' DfUr' /= mulg1 mul1g !invmE // -DfW'. - by rewrite !fW'K ?(subsetP sRW jR) ?(subsetP sCW). -- move=> a Aa; apply/row_matrixP=> j; pose jC := invm injhC (row j 1%:M). - rewrite rowE -row1 !mulmxA defPd defPr -/hW [hW]lock /= mul_rV_lin1 /= -lock. - have CjC: jC \in 'C_W(Ai1). - by rewrite -(im_invm injhC) mem_morphim /= ?im_hC ?inE. - have [[/fW'K id_jC /centP cA1jC] A1a] := (setIP CjC, AfG' a Aa). - rewrite -DfW' id_jC subgK ?(subsetP sAiG1) // /conjg cA1jC // mulKg id_jC. - by rewrite [hW _]dprodmEr ?DfUr' //= invmK ?im_hC ?inE. -apply/row_matrixP=> j; pose jR := invm injhR (row j 1%:M). -have RjR: jR \in [~: W, Ai1]. - by rewrite -(im_invm injhR) mem_morphim /= ?im_hR ?inE. -rewrite rowE -row1 mulmx_sumr raddf0 -/jR. -have /subsetP nRA1: Ai1 \subset 'N([~: W, Ai1]) by rewrite commg_normr. -transitivity (\sum_(a1 in Ai1) hR (jR ^ a1)). - rewrite {1}[Ai1 in rhs in _ = rhs]morphimEsub /= ?im_restrm ?imfG1 //. - rewrite big_imset /=; last first. - apply: sub_in2 (injmP (injm_invm injfG)); apply/subsetP. - by rewrite /= im_restrm imfG1. - apply: eq_bigr => a /AfG' A1a. - have RjRa: jR ^ fG' a \in [~: W, Ai1] by rewrite memJ_norm ?nRA1. - rewrite !mulmxA defPu defPl mul_rV_lin1 -/hW [hW]lock /= -lock. - rewrite subgK ?(subsetP sAiG1) // -DfW' !fW'K ?(subsetP sRW) //. - by rewrite [hW _]dprodmEl // DfUl'. -have [nf [fj Rfj ->]] := gen_prodgP RjR. -transitivity (\sum_(a1 in Ai1) (\prod_i1 hR (fj i1 ^ a1))%g). - apply: eq_bigr => a1 Aa1; rewrite conjg_prod morph_prod // => i1 _. - by rewrite memJ_norm ?mem_gen ?nRA1. -rewrite exchange_big big1 //= => i1 _; have /imset2P[w a1 Ww Aa1 ->] := Rfj i1. -apply: (addrI (\sum_(a2 in Ai1) hR [~ w, a2])). -rewrite addr0 {2}(reindex_inj (mulgI a1)) -big_split /=. -apply: eq_big => [a2 | a2 Aa2]; first by rewrite groupMl. -by rewrite commgMJ [rhs in _ = rhs]morphM ?memJ_norm ?nRA1 ?mem_commg ?groupM. -Qed. |