(*
Copyright © 2006 Russell O’Connor

Permission is hereby granted, free of charge, to any person obtaining a copy of
this proof and associated documentation files (the "Proof"), to deal in
the Proof without restriction, including without limitation the rights to
use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
the Proof, and to permit persons to whom the Proof is furnished to do so,
subject to the following conditions:

The above copyright notice and this permission notice shall be included in all
copies or substantial portions of the Proof.

THE PROOF IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
CONNECTION WITH THE PROOF OR THE USE OR OTHER DEALINGS IN THE PROOF.
*)

Require Export CoRN.transc.InvTrigonom.
Require Import CoRN.tactics.CornTac.

(** Various properties of ArcTangent.*)

Lemma Dom_Tang_ArcTan : forall x, (Dom Tang (ArcTan x)).
Proof.
 intros x.
 apply Tang_Domain'.
 apply ArcTan_range.
Qed.

Lemma ArcTan_zero : ArcTan [0][=][0].
Proof.
 assert (Z:Dom Tang [0]).
  apply Tang_Domain'.
  split; auto with *.
 stepl (ArcTan (Tan _ Z)).
  apply ArcTan_Tan; auto with *.
 apply pfwdef.
 apply Tan_zero.
Qed.

Lemma ArcTan_one : ArcTan [1][=]Pi[/]FourNZ.
Proof.
 assert (Z:Dom Tang (Pi[/]FourNZ)).
  apply Tang_Domain'.
  split; auto with *.
 stepl (ArcTan (Tan _ Z)).
  apply ArcTan_Tan; auto with *.
 apply pfwdef.
 apply Tan_QuarterPi.
Qed.

#[global]
Hint Resolve ArcTan_zero ArcTan_one: algebra.

Lemma ArcTan_inv : forall x, ArcTan [--]x[=][--](ArcTan x).
Proof.
 intros x.
 stepr (ArcTan [--](Tan (ArcTan x) (Dom_Tang_ArcTan x))).
  apply ArcTan_wd.
  apply un_op_wd_unfolded.
  apply Tan_ArcTan.
 assert (H:(olor ([--](Pi[/]TwoNZ)) (Pi[/]TwoNZ) [--](ArcTan x))).
  destruct (ArcTan_range x).
  split.
   apply inv_resp_less; assumption.
  rstepr ([--][--](Pi[/]TwoNZ)).
  apply inv_resp_less; assumption.
 stepr (ArcTan (Tan _ (Tang_Domain' _ H))).
  apply ArcTan_wd.
  apply eq_symmetric.
  apply Tan_inv.
 destruct H.
 apply ArcTan_Tan; assumption.
Qed.

Lemma ArcTan_resp_less : forall x y, x[<]y -> ArcTan x[<]ArcTan y.
Proof.
 intros x y H.
 unfold ArcTan.
 eapply (Derivative_imp_resp_less realline I).
     apply Derivative_ArcTan.
    assumption.
   constructor.
  constructor.
 intros contF'.
 set (F:={1/}([-C-][1]{+}FId{^}2):PartIR) in *.
 assert (Hz0:forall z:IR, [0][<][1][+][1][*]z[*]z).
  intros z.
  apply less_leEq_trans with [1].
   apply pos_one.
  apply shift_leEq_plus'.
  rstepl ([0]:IR).
  rstepr (z[^]2).
  apply sqr_nonneg.
 assert (Hz:forall z, Dom F z).
  intros z.
  repeat constructor.
  simpl.
  intros _.
  apply Greater_imp_ap.
  apply Hz0.
 set (z:=Max (AbsIR x) (AbsIR y)).
 apply less_leEq_trans with (F z (Hz z)).
  simpl.
  apply shift_less_div.
   apply Hz0.
  rstepl ([0]:IR).
  apply pos_one.
 apply leEq_glb.
 simpl.
 intros a [Ha0 Ha1] H0.
 apply recip_resp_leEq.
  apply Hz0.
 clear H0 contF' F Hz.
 apply plus_resp_leEq_lft.
 apply shift_leEq_rht.
 rstepr ((z[-]a)[*](z[-][--]a)).
 unfold z.
 apply mult_resp_nonneg; apply shift_leEq_lft; eapply leEq_transitive.
    apply Ha1.
   apply Max_leEq; (eapply leEq_transitive;[apply leEq_AbsIR|]).
    apply lft_leEq_Max.
   apply rht_leEq_Max.
  apply inv_resp_leEq.
  apply Ha0.
 unfold MIN, Min.
 rstepl (Max [--]x [--]y).
 apply Max_leEq; (eapply leEq_transitive;[apply inv_leEq_AbsIR|]).
  apply lft_leEq_Max.
 apply rht_leEq_Max.
Qed.

Lemma ArcTan_resp_leEq : forall x y, x[<=]y -> ArcTan x[<=]ArcTan y.
Proof.
 intros x y Hxy.
 rewrite -> leEq_def.
 intros H.
 apply (leEq_less_or_equal _ _ _ Hxy).
 intros H0.
 generalize H; clear H.
 change (Not (ArcTan y[<]ArcTan x)).
 rewrite <- leEq_def.
 destruct H0.
  apply less_leEq.
  apply ArcTan_resp_less.
  assumption.
 stepr (ArcTan x).
  apply leEq_reflexive.
 apply ArcTan_wd.
 assumption.
Qed.

Lemma ArcTan_pos : forall x, [0][<]x -> [0][<]ArcTan x.
Proof.
 intros x Hx.
 csetoid_rewrite_rev ArcTan_zero.
 apply ArcTan_resp_less.
 assumption.
Qed.

Lemma ArcTan_recip : forall x Hx, [0][<]x -> ArcTan ([1][/]x[//]Hx)[=]Pi[/]TwoNZ[-](ArcTan x).
Proof.
 intros x Hx Hx0.
 assert (H0:olor [--](Pi [/]TwoNZ) (Pi [/]TwoNZ) ([--](ArcTan x)[+]Pi[/]TwoNZ)).
  split.
   apply shift_less_plus.
   rstepl ([--]Pi).
   apply inv_resp_less.
   apply less_transitive_unfolded with (Pi[/]TwoNZ).
    destruct (ArcTan_range x); assumption.
   auto with *.
  apply shift_plus_less.
  rstepr ([--][0]:IR).
  apply inv_resp_less.
  apply ArcTan_pos.
  assumption.
 rstepr ([--](ArcTan x)[+]Pi[/]TwoNZ).
 stepr (ArcTan (Tan _ (Tang_Domain' _ H0))); [| now destruct H0; apply ArcTan_Tan; assumption].
 apply ArcTan_wd.
 apply eq_symmetric.
 assert (H1:Dom Tang ([--](ArcTan x))).
  apply Tang_Domain'.
  destruct (ArcTan_range x).
  split.
   apply inv_resp_less; assumption.
  rstepr ([--][--](Pi[/]TwoNZ)).
  apply inv_resp_less.
  assumption.
 assert (H2:(Tan [--](ArcTan x) H1)[#][0]).
  stepl ([--](Tan (ArcTan x) (Dom_Tang_ArcTan x))); [| now apply eq_symmetric; apply Tan_inv].
  rstepr ([--][0]:IR).
  apply inv_resp_ap.
  apply Greater_imp_ap.
  csetoid_rewrite_rev (Tan_ArcTan x (Dom_Tang_ArcTan x)).
  assumption.
 eapply eq_transitive.
  apply (Tan_plus_HalfPi _ (Tang_Domain' _ H0) H1 H2).
 apply mult_cancel_lft with (Tan [--](ArcTan x) H1).
  assumption.
 apply mult_cancel_lft with x.
  apply Greater_imp_ap; assumption.
 rstepl ([--]x:IR).
 rstepr (Tan [--](ArcTan x) H1).
 stepr ([--](Tan (ArcTan x) (Dom_Tang_ArcTan x))).
  apply un_op_wd_unfolded.
  apply Tan_ArcTan.
 apply eq_symmetric.
 apply Tan_inv.
Qed.

Lemma ArcTan_plus_ArcTan : forall x y Hxy,
 ([--][1][<=]x) -> (x[<=][1]) -> ([--][1][<=]y) -> (y[<=][1]) ->
 ArcTan x [+] ArcTan y [=] ArcTan ((x[+]y)[/]([1][-]x[*]y)[//]Hxy).
Proof.
 cut (forall x y Hxy, ([--][1][<=]x) -> (x[<=][1]) -> ([--][1][<=]y) -> (y[<][1]) ->
   ArcTan x [+] ArcTan y [=] ArcTan ((x[+]y)[/]([1][-]x[*]y)[//]Hxy)).
  intros G x y Hxy Hx0 Hx1 Hy0 Hy1.
  apply (not_ap_imp_eq).
  intros H.
  apply (leEq_less_or_equal _ _ _ Hx1).
  intros Hx1'.
  apply (leEq_less_or_equal _ _ _ Hy1).
  intros Hy1'.
  generalize H; clear H.
  apply (eq_imp_not_ap).
  clear Hy1.
  destruct Hy1' as [Hy1|Hy1].
   apply G; assumption.
  assert (Hxy':([1][-]y[*]x)[#][0]).
   rstepl ([1][-]x[*]y).
   assumption.
  rstepl (ArcTan y[+]ArcTan x).
  stepr (ArcTan ((y[+]x)[/]([1][-]y[*]x)[//]Hxy')); [| now apply ArcTan_wd; rational].
  apply G; try assumption.
   stepl ([1]:IR); [| now apply eq_symmetric; assumption].
   apply leEq_reflexive.
  destruct Hx1' as [c|c]; try assumption.
  exfalso.
  refine (eq_imp_not_ap _ _ _ _ Hxy').
  unfold cg_minus.
  csetoid_rewrite c.
  csetoid_rewrite Hy1.
  rstepl ([0]:IR).
  apply eq_reflexive.
 cut (forall x y Hxy, ([--][1][<=]x) -> (x[<=][1]) -> ([--][1][<]y) -> (y[<][1]) ->
   ArcTan x [+] ArcTan y [=] ArcTan ((x[+]y)[/]([1][-]x[*]y)[//]Hxy)).
  intros G x y Hxy Hx0 Hx1 Hy0 Hy1.
  apply (not_ap_imp_eq).
  intros H.
  apply (leEq_less_or_equal _ _ _ Hx0).
  intros Hx0'.
  apply (leEq_less_or_equal _ _ _ Hx1).
  intros Hx1'.
  apply (leEq_less_or_equal _ _ _ Hy0).
  intros Hy0'.
  generalize H; clear H.
  apply (eq_imp_not_ap).
  clear Hy0.
  destruct Hy0' as [Hy0|Hy0].
   apply G; assumption.
  assert (Hxy':([1][-]y[*]x)[#][0]).
   rstepl ([1][-]x[*]y).
   assumption.
  destruct Hx0' as [Hx0'|Hx0']; destruct Hx1' as [Hx1'|Hx1'].
     rstepl (ArcTan y[+]ArcTan x).
     stepr (ArcTan ((y[+]x)[/]([1][-]y[*]x)[//]Hxy')); [| now apply ArcTan_wd; rational].
     apply G; try assumption.
      stepr ([--][1]:IR); [| easy ].
      apply leEq_reflexive.
     stepl ([--][1]:IR); [| easy ].
     apply shift_zero_leEq_minus'.
     rstepr (Two:IR).
     apply less_leEq; apply pos_two.
    csetoid_replace (ArcTan y) ([--](ArcTan x)).
     rstepl ([0]:IR).
     stepl (ArcTan [0]); [| now apply ArcTan_zero].
     apply ArcTan_wd.
     rstepl ([0][/]([1][-]x[*]y)[//]Hxy).
     apply div_wd.
      csetoid_rewrite Hx1'.
      csetoid_rewrite_rev Hy0.
      rational.
     apply eq_reflexive.
    stepl (ArcTan ([--]x)).
     apply ArcTan_inv.
    apply ArcTan_wd.
    csetoid_rewrite Hx1'.
    assumption.
   exfalso.
   refine (eq_imp_not_ap _ _ _ _ Hxy').
   unfold cg_minus.
   csetoid_rewrite_rev Hx0'.
   csetoid_rewrite_rev Hy0.
   rational.
  exfalso.
  refine (eq_imp_not_ap _ [--][1] [1] _ _).
  1: now stepr x.
  apply ap_symmetric.
  apply zero_minus_apart.
  rstepl (Two:IR).
  apply two_ap_zero.
 intros x y Hxy Hx0 Hx1 Hy0 Hy1.
 assert (X:olor [--](Pi [/]TwoNZ) (Pi [/]TwoNZ) (ArcTan x[+]ArcTan y)).
  split.
   rstepl ([--](Pi[/]FourNZ)[+][--](Pi[/]FourNZ)).
   csetoid_rewrite_rev (ArcTan_one).
   csetoid_replace ([--](ArcTan [1])) (ArcTan ([--][1])).
    apply plus_resp_leEq_less.
     apply ArcTan_resp_leEq; assumption.
    apply ArcTan_resp_less; assumption.
   apply eq_symmetric; apply ArcTan_inv.
  rstepr ((Pi[/]FourNZ)[+](Pi[/]FourNZ)).
  csetoid_rewrite_rev (ArcTan_one).
  apply plus_resp_leEq_less.
   apply ArcTan_resp_leEq; assumption.
  apply ArcTan_resp_less; assumption.
 elim X; intros X0 X1.
 csetoid_rewrite_rev (ArcTan_Tan _ X0 X1 (Tang_Domain' _ X)).
 apply ArcTan_wd.
 assert (Y:([1][-]Tan _ (Dom_Tang_ArcTan x)[*]Tan _ (Dom_Tang_ArcTan y))[#][0]).
  unfold cg_minus.
  csetoid_rewrite_rev (Tan_ArcTan _ (Dom_Tang_ArcTan x)).
  csetoid_rewrite_rev (Tan_ArcTan _ (Dom_Tang_ArcTan y)).
  assumption.
 stepr (Tan _ (Dom_Tang_ArcTan x)[+]Tan _ (Dom_Tang_ArcTan y)[/]_[//]Y).
  apply Tan_plus.
 apply div_wd; unfold cg_minus; csetoid_rewrite_rev (Tan_ArcTan _ (Dom_Tang_ArcTan x));
   csetoid_rewrite_rev (Tan_ArcTan _ (Dom_Tang_ArcTan y)); apply eq_reflexive.
Qed.

Section ArcTan_Series.

(**
** ArcTan Series
In this section we show the convergence of ArcTan's power series.

First we show the convergence of the series for 1/(1+x^2)
*)

Lemma bellcurve_series_convergent_IR : fun_series_convergent_IR (olor ([--][1]) [1]) (fun (i:nat) => ([--][1])[^]i{**}Fid IR{^}(2*i)).
Proof.
 apply fun_series_convergent_wd_IR with (fun i => Fid IR{^}i[o]({--}(Fid IR{^}2))).
  intros n.
  FEQ.
  change ([--]([1][*]x[*]x)[^]n[=]([--][1])[^]n[*]x[^](2*n)).
  rstepl (([--][1][*](x[*]x))[^]n).
  stepl (([--][1])[^]n[*]((x[*]x)[^]n)); [| now apply eq_symmetric; apply mult_nexp].
  apply mult_wdr.
  replace (2*n)%nat with (n+n)%nat by auto with *.
  eapply eq_transitive.
   apply mult_nexp.
  apply nexp_plus.
 apply FSeries_Sum_comp_conv with (olor [--][1] [1]); [|Contin|apply fun_power_series_conv_IR].
 intros a b Hab Hinc.
 set (c:=Max (AbsIR a) (AbsIR b)).
 exists ([--](c[^]2)).
 exists (c[^]2).
 assert (X:[--](c[^]2)[<=]c[^]2).
  apply leEq_transitive with ([0]:IR).
   rstepr ([--][0]:IR).
   apply inv_resp_leEq.
   apply sqr_nonneg.
  apply sqr_nonneg.
 exists X.
 assert (A0:(c[^]2)[<][1]).
  rstepr ([1][^]2:IR).
  unfold c.
  apply nexp_resp_less.
    auto with *.
   eapply leEq_transitive.
    apply AbsIR_nonneg.
   apply lft_leEq_Max.
  apply Max_less; [destruct (Hinc _ (compact_inc_lft _ _ Hab))
    |destruct (Hinc _ (compact_inc_rht _ _ Hab))]; apply AbsIR_less; assumption.
 assert (A1:[--][1][<][--](c[^]2)).
  apply inv_resp_less.
  assumption.
 split.
  intros d [Hd0 Hd1].
  split.
   apply less_leEq_trans with ([--](c[^]2)); assumption.
  apply leEq_less_trans with (c[^]2); assumption.
 intros x Hx [Hx0 Hx1].
 simpl.
 cut (AbsSmall (c[^]2) ([--](x[^]2))).
  intros [A B]; split; assumption.
 apply inv_resp_AbsSmall.
 rstepl (c[*]c).
 rstepr (x[*]x).
 cut (AbsSmall c x).
  intros; apply mult_AbsSmall; assumption.
 unfold c.
 split.
  rstepr ([--][--]x).
  apply inv_resp_leEq.
  eapply leEq_transitive;[|apply lft_leEq_Max].
  eapply leEq_transitive;[|apply inv_leEq_AbsIR].
  apply inv_resp_leEq.
  assumption.
 eapply leEq_transitive;[|apply rht_leEq_Max].
 eapply leEq_transitive;[|apply leEq_AbsIR].
 assumption.
Qed.

Lemma bellcurve_series
     : forall (Hs:fun_series_convergent_IR (olor ([--][1]) [1]) (fun (i:nat) => ([--][1])[^]i{**}Fid IR{^}(2*i))),
       Feq (olor ([--][1]) [1]) (FSeries_Sum Hs) ({1/}([-C-][1]{+}FId{^}2)).
Proof.
 intros Hs.
 split.
  simpl.
  apply included_refl.
 split.
  apply included_trans with realline.
   intros x _; constructor.
  apply Continuous_imp_inc.
  apply ArcTan_def_lemma.
 intros c [Hc0 Hc1] D0 D1.
 assert (X:AbsIR ([--](c[^]2))[<][1]).
  csetoid_rewrite_rev (AbsIR_inv (c[^]2)).
  csetoid_rewrite (AbsIR_nexp_op 2 c).
  rstepr ([1][^]2:IR).
  apply nexp_resp_less.
    auto with *.
   apply AbsIR_nonneg.
  apply AbsIR_less; assumption.
 simpl.
 generalize (ext2 (S:=IR) (P:=Conj (fun _ : IR => True) (fun _ : IR => True))
   (R:=fun (x : IR) (_ : Conj (fun _ : IR => True) (fun _ : IR => True) x) =>
     [1][+][1][*]x[*]x[#][0]) (x:=c) D1).
 intros H.
 assert (Y:[1][-]([--](c[^]2))[#][0]).
  rstepl ([1][+][1][*]c[*]c).
  assumption.
 rstepr ([1][/]([1][-]([--](c[^]2)))[//]Y).
 stepr (series_sum (power_series [--](c[^]2)) (power_series_conv [--](c[^]2) X)); [| now
   apply (power_series_sum ([--](c[^]2)) X Y (power_series_conv _ X))].
 apply series_sum_wd.
 intros n.
 simpl.
 change ((([--][1])[^]n)[*]c[^](2*n)[=][--]([1][*]c[*]c)[^]n).
 rstepr ((([--][1])[*]c[*]c)[^]n).
 csetoid_rewrite_rev (nexp_mult _ c 2 n).
 csetoid_rewrite_rev (mult_nexp _ ([--][1]) (c[^]2) n).
 rational.
Qed.

(** Finally we show the convergence of the series for arctan.*)

(* Although the series converges on the closed interval [-1,1],
this proof only shows convergence on the open interval (-1,1).
*)

Lemma arctan_series_convergent_IR : fun_series_convergent_IR (olor ([--][1]) [1])
(fun (i:nat) => (([--][1])[^]i[/]nring (S (2*i))[//]nringS_ap_zero _ (2*i)){**}Fid IR{^}(2*i+1)).
Proof.
 intros y z Hyz Hinc.
 pose (C:=Max (AbsIR y) (AbsIR z)).
 assert (C[<][1]).
  unfold C.
  destruct (Hinc _ (compact_inc_lft _ _ Hyz)).
  destruct (Hinc _ (compact_inc_rht _ _ Hyz)).
  apply Max_less; apply AbsIR_less; assumption.
 assert ([0][<=]C).
  unfold C.
  eapply leEq_transitive.
   apply AbsIR_nonneg.
  apply lft_leEq_Max.
 apply fun_ratio_test_conv.
  intros n.
  Contin.
 exists 0.
 exists C.
  assumption.
 split.
  assumption.
 intros x Hx n _ Hx0 Hx1.
 generalize (nringS_ap_zero IR (2 * S n)).
 generalize (nringS_ap_zero IR (2 * n)).
 intros Z0 Z1.
 set (a := S (2 * S n)).
 set (b := 2*S n + 1).
 set (c:= S (2 * n)).
 set (d:= 2*n + 1).
 change (AbsIR (([--][1][^]S n[/]nring (R:=IR) a[//]Z1)[*]x[^]b)[<=]
   C[*]AbsIR (([--][1][^]n[/]nring (R:=IR) c[//]Z0)[*]x[^]d)).
 stepl (AbsIR (([--][1][^]S n[/]nring (R:=IR) a[//]Z1))[*]AbsIR (x[^]b)); [| now
   apply eq_symmetric; apply AbsIR_resp_mult].
 stepr (C[*](AbsIR (([--][1][^]n[/]nring (R:=IR) c[//]Z0))[*]AbsIR(x[^]d))); [| now
   apply mult_wdr; apply eq_symmetric; apply AbsIR_resp_mult].
 rstepr (AbsIR (([--][1][^]n[/]nring (R:=IR) c[//]Z0))[*](C[*]AbsIR(x[^]d))).
 apply mult_resp_leEq_both; try apply AbsIR_nonneg.
  stepl (AbsIR ([--][1][^]S n)[/]_[//](AbsIR_resp_ap_zero _ Z1)); [| now
    apply eq_symmetric; apply AbsIR_division].
  stepr ((AbsIR ([--][1][^]n)[/]_[//](AbsIR_resp_ap_zero _ Z0))); [| now
    apply eq_symmetric; apply AbsIR_division].
  assert (H0:forall n, AbsIR([--][1][^]n)[=][1]).
   intros i.
   csetoid_rewrite (AbsIR_nexp_op i ([--][1]:IR)).
   csetoid_rewrite_rev (AbsIR_inv [1]).
   stepl (([1]:IR)[^]i).
    apply one_nexp.
   apply nexp_wd.
   apply eq_symmetric; apply AbsIR_eq_x.
   apply less_leEq; apply pos_one.
  stepl ([1][/]AbsIR (nring (R:=IR) (S (2 * S n)))[//]
    AbsIR_resp_ap_zero (nring (R:=IR) (S (2 * S n))) Z1); [| now
      apply div_wd; try apply eq_reflexive; apply eq_symmetric; apply H0].
  stepr ([1][/]AbsIR (nring (R:=IR) (S (2 * n)))[//]
    AbsIR_resp_ap_zero (nring (R:=IR) (S (2 * n))) Z0); [| now
      apply div_wd; try apply eq_reflexive; apply eq_symmetric; apply H0].
  apply recip_resp_leEq; try (apply AbsIR_pos; assumption).
  eapply leEq_transitive;[|apply leEq_AbsIR].
  apply AbsSmall_imp_AbsIR.
  apply leEq_imp_AbsSmall.
   apply nring_nonneg.
  apply nring_leEq.
  auto with *.
 replace b with (2+d);[|unfold b, d; auto with *].
 stepl (AbsIR x[^](2+d)); [| now apply eq_symmetric; apply AbsIR_nexp_op].
 stepl (AbsIR x[^]2[*]AbsIR x[^]d); [| now apply nexp_plus].
 stepr (C[*]AbsIR x[^]d); [| now apply mult_wdr; apply eq_symmetric; apply AbsIR_nexp_op].
 apply mult_resp_leEq_rht; try (apply nexp_resp_nonneg; apply AbsIR_nonneg).
 apply leEq_transitive with (C[^]2).
  stepl (AbsIR(x[^]2)); [| now apply AbsIR_nexp_op].
  stepl (x[^]2); [| now apply eq_symmetric; apply AbsIR_eq_x; apply sqr_nonneg].
  apply shift_zero_leEq_minus'.
  rstepr ((C[-]x)[*](C[-][--]x)).
  unfold C.
  destruct Hx as [Y0 Y1].
  apply mult_resp_nonneg; apply shift_zero_leEq_minus.
   eapply leEq_transitive.
    apply Y1.
   eapply leEq_transitive.
    apply leEq_AbsIR.
   apply rht_leEq_Max.
  eapply leEq_transitive.
   apply inv_resp_leEq.
   apply Y0.
  eapply leEq_transitive.
   apply inv_leEq_AbsIR.
  apply lft_leEq_Max.
 rstepl (C[*]C).
 rstepr (C[*][1]).
 apply mult_resp_leEq_lft.
  apply less_leEq; assumption.
 assumption.
Qed.

Lemma arctan_series : forall c : IR,
       forall (Hs:fun_series_convergent_IR (olor ([--][1]) [1]) (fun (i:nat) => (([--][1])[^]i[/]nring (S (2*i))[//]nringS_ap_zero _ (2*i)){**}Fid IR{^}(2*i+1))) Hc,
       FSeries_Sum Hs c Hc[=]ArcTan c.
Proof.
 intros c Hs Hc.
 set (J:=olor [--][1] [1]).
 assert (HJ:proper J).
  simpl.
  apply shift_zero_less_minus'.
  rstepr (Two:IR).
  apply pos_nring_S.
 assert (Y0 : included J realline).
  intros a b; constructor.
 assert (Y1 : J [0]).
  split;[rstepr ([--][0]:IR);apply inv_resp_less|]; apply pos_one.
 stepl (([-S-] Included_imp_Continuous realline {1/}([-C-][1]{+}FId{^}2)
   ArcTan_def_lemma J Y0) [0] Y1 c Hc).
  apply: Integral_wd.
  apply Feq_reflexive.
  intros d Hd.
  eapply Continuous_imp_inc.
   apply ArcTan_def_lemma.
  constructor.
 apply cg_inv_unique_2.
 cut (Derivative J HJ (FSeries_Sum Hs) {1/}([-C-][1]{+}FId{^}2)).
  intros X.
  destruct (FTC2 J _ (Included_imp_Continuous _ _ ArcTan_def_lemma J Y0) [0] Y1 _ _ X) as [z Hz].
  clear X.
  apply eq_transitive with z.
   eapply eq_transitive; [|apply (Feq_imp_eq _ _ _ Hz _ Hc (Hc, Hc) I)].
   apply: bin_op_wd_unfolded;[|apply un_op_wd_unfolded]; apply pfwdef; apply eq_reflexive.
  apply eq_symmetric.
  eapply eq_transitive; [|apply (Feq_imp_eq _ _ _ Hz _ Y1 (Y1, Y1) I)].
  rstepl ([0][-][0]:IR).
  apply: cg_minus_wd.
   stepr (ArcTan [0]).
    assert (Z:Dom Tang [0]).
     repeat split; try constructor.
     intros [].
     stepl ([1]:IR).
      apply ring_non_triv.
     apply eq_symmetric.
     apply Cos_zero.
    stepl (ArcTan (Tan _ Z)).
     apply pfwdef.
     apply Tan_zero.
    apply ArcTan_Tan; [rstepr ([--][0]:IR); apply inv_resp_less|]; apply pos_HalfPi.
   unfold ArcTan, ArcTang.
   apply: Integral_wd.
   apply Feq_reflexive.
   intros d Hd.
   eapply Continuous_imp_inc.
    apply ArcTan_def_lemma.
   constructor.
  eapply eq_transitive.
   apply eq_symmetric.
   eapply (series_sum_zero conv_zero_series).
  simpl; apply series_sum_wd.
  intros n.
  eapply eq_transitive.
   apply eq_symmetric.
   apply cring_mult_zero.
  apply mult_wdr.
  apply eq_symmetric.
  apply (zero_nexp IR (2*n+1)).
  auto with *.
 clear -J.
 eapply Derivative_wdr.
  apply (bellcurve_series bellcurve_series_convergent_IR).
 apply Derivative_FSeries.
 intros n.
 rewrite plus_comm.
 simpl.
 Derivative_Help; [|apply Derivative_scal;apply Derivative_nth;Deriv..].
 FEQ.
Qed.

End ArcTan_Series.


Require Import Axioms.
Require Import Tactics.
Require Import Relation.
Require Import Sigma.
Require Import Equality.
Require Import Syntax.
Require Import Hygiene.
Require Import Reduction.
Require Import Equivalence.
Require Import MapTerm.
Require Import Ofe.
Require Import Uniform.
Require Import Urelsp.
Require Import Ordinal.
Require Import Candidate.
Require Import Intensional.
Require Import IntensionalNerect.

Definition extend_xobj (v w : ordinal) (x : xobj v) : xobj w
  :=
  match x with
  | objnone => objnone

  | objsome Q h =>
      match lt_ord_dec (level (pi1 Q)) w with
      | left h' =>
          objsome Q h'

      | right _ =>
          objnone
      end
  end.

Definition extend (v w : ordinal) (Q : obj v) : obj w
  :=
  objin (extend_xobj v w (objout Q)).

Lemma extend_none :
  forall v w,
    extend v w (objin objnone) = objin objnone.
Proof.
intros v w.
unfold extend, extend_xobj.
rewrite -> objout_objin.
reflexivity.
Qed.

Lemma extend_some :
  forall v w Q h h',
    extend v w (objin (objsome Q h))
    =
    objin (objsome Q h').
Proof.
intros v w Q h h'.
unfold extend, extend_xobj.
rewrite -> objout_objin.
rewrite -> (lt_ord_dec_is _ _ h').
reflexivity.
Qed.

Lemma extend_some_to_none :
  forall v w Q h,
    ~ level (pi1 Q) << w
    -> extend v w (objin (objsome Q h)) = objin objnone.
Proof.
intros v w Q h Hnlt.
unfold extend, extend_xobj.
rewrite -> objout_objin.
rewrite -> (lt_ord_dec_is_not _ _ Hnlt).
reflexivity.
Qed.

Lemma extend_eq_objsome_form :
  forall v w x Q h,
    extend v w x = objin (objsome Q h)
    -> exists h', x = objin (objsome Q h').
Proof.
intros v w x Q h Heq.
rewrite <- (objin_objout _ x).
unfold extend, extend_xobj in Heq.
set (X := objout x) in Heq |- *.
destruct X as [Q' h' |].
  {
  set (X := lt_ord_dec (level (pi1 Q')) w) in Heq.
  destruct X as [Hlt | Hnlt].
    {
    injection (objin_inj _ _ _ Heq).
    intros ->.
    exists h'.
    reflexivity.
    }

    {
    discriminate (objin_inj _#3 Heq).
    }
  }

  {
  discriminate (objin_inj _#3 Heq).
  }
Qed.

Lemma extend_xobj_inv :
  forall v w, v <<= w -> forall x, extend_xobj w v (extend_xobj v w x) = x.
Proof.
intros v w Hle x.
destruct x as [Q h |].
  {
  cbn.
  rewrite -> (lt_ord_dec_is _ _ (lt_le_ord_trans _#3 h Hle)).
  cbn.
  rewrite -> (lt_ord_dec_is _ _ h).
  reflexivity.
  }

  {
  cbn.
  reflexivity.
  }
Qed.

Lemma extend_xobj_inj :
  forall v w, v <<= w -> injective (extend_xobj v w).
Proof.
intros v w Hle x y Heq.
so (f_equal (extend_xobj w v) Heq) as Heq'.
rewrite -> !extend_xobj_inv in Heq'; auto.
Qed.

Lemma extend_inv :
  forall v w, v <<= w -> inverses (extend w v) (extend v w).
Proof.
intros v w H x.
rewrite <- (objin_objout _ x) at 2.
unfold extend.
f_equal.
rewrite -> objout_objin.
rewrite -> extend_xobj_inv; auto.
Qed.

Lemma extend_inj :
  forall v w, v <<= w -> injective (extend v w).
Proof.
intros v w h.
eapply inverses_impl_injective; eauto using extend_inv.
Qed.

Lemma extend_term_equiv_inj :
  forall v w, v <<= w -> forall (m n : wterm v),
    equiv (map_term (extend v w) m) (map_term (extend v w) n)
    -> equiv m n.
Proof.
intros v w h m n Heq.
eapply map_term_equiv_inj; eauto.
apply extend_inj; auto.
Qed.

Lemma extend_term_inv :
  forall v w, v <<= w -> inverses (map_term (extend w v)) (map_term (extend v w)).
Proof.
intros v w Hlt.
apply map_term_inv.
apply extend_inv; auto.
Qed.

Lemma extend_term_inj :
  forall v w, v <<= w -> injective (map_term (extend v w)).
Proof.
intros v w h.
eapply inverses_impl_injective; eauto using extend_term_inv.
Qed.

Lemma extend_id :
  forall w,
    extend w w = (fun x => x).
Proof.
intros w.
fextensionality 1.
intro x.
rewrite <- (objin_objout _ x).
set (X := objout x).
unfold extend, extend_xobj.
rewrite -> objout_objin.
destruct X as [(Q, h) |]; auto.
cbn.
erewrite -> lt_ord_dec_is; eauto.
Qed.

Lemma extend_term_id :
  forall w m,
    map_term (extend w w) m = m.
Proof.
intros w m.
rewrite -> extend_id.
apply map_term_id.
Qed.

Lemma extend_sub_id :
  forall w s,
    map_sub (extend w w) s = s.
Proof.
intros w s.
rewrite -> extend_id.
apply map_sub_id.
Qed.

Lemma extend_compose_up :
  forall u v w,
    u <<= v
    -> forall x, extend u w x = extend v w (extend u v x).
Proof.
intros u v w Huv x.
unfold extend.
f_equal.
rewrite -> objout_objin.
set (X := @objout u x).
destruct X as [Q h |]; auto.
cbn.
rewrite -> (lt_ord_dec_is _ _ (lt_le_ord_trans _#3 h Huv)).
cbn.
reflexivity.
Qed.

Lemma extend_compose_down :
  forall u v w,
    w <<= v
    -> forall x, extend u w x = extend v w (extend u v x).
Proof.
intros u v w Hwv x.
unfold extend.
f_equal.
rewrite -> objout_objin.
set (X := @objout u x).

destruct X as [Q h |]; auto.
cbn.
set (X := lt_ord_dec (level (pi1 Q)) w).
destruct X as [Hlt | Hnlt].
  {
  rewrite -> (lt_ord_dec_is _ _ (lt_le_ord_trans _#3 Hlt Hwv)).
  cbn.
  rewrite -> (lt_ord_dec_is _ _ Hlt).
  reflexivity.
  }

  {
  set (X := lt_ord_dec (level (pi1 Q)) v).
  destruct X as [Hlt |].
    {
    cbn.
    rewrite -> (lt_ord_dec_is_not _ _ Hnlt).
    reflexivity.
    }

    {
    cbn.
    reflexivity.
    }
  }
Qed.

Lemma extend_term_compose_up :
  forall u v w,
    u <<= v
    -> forall m, map_term (extend v w) (map_term (extend u v) m) = map_term (extend u w) m.
Proof.
intros u v w Hle m.
rewrite -> map_term_compose.
f_equal.
fextensionality 1.
intro x.
symmetry.
apply extend_compose_up; auto.
Qed.

Lemma extend_term_compose_down :
  forall u v w,
    w <<= v
    -> forall m, map_term (extend v w) (map_term (extend u v) m) = map_term (extend u w) m.
Proof.
intros u v w Hle m.
rewrite -> map_term_compose.
f_equal.
fextensionality 1.
intro x.
symmetry.
apply extend_compose_down; auto.
Qed.

Lemma extend_sub_compose_up :
  forall u v w,
    u <<= v
    -> forall s, map_sub (extend v w) (map_sub (extend u v) s) = map_sub (extend u w) s.
Proof.
intros u v w Hle m.
rewrite -> map_sub_compose.
f_equal.
fextensionality 1.
intro x.
symmetry.
apply extend_compose_up; auto.
Qed.

Lemma extend_sub_compose_down :
  forall u v w,
    w <<= v
    -> forall s, map_sub (extend v w) (map_sub (extend u v) s) = map_sub (extend u w) s.
Proof.
intros u v w Hle m.
rewrite -> map_sub_compose.
f_equal.
fextensionality 1.
intro x.
symmetry.
apply extend_compose_down; auto.
Qed.

Lemma extend_term_cancel :
  forall v w,
    v <<= w
    -> forall m, map_term (extend w v) (map_term (extend v w) m) = m.
Proof.
intros v w H m.
rewrite -> extend_term_compose_up; auto.
apply extend_term_id.
Qed.

Lemma extend_sub_cancel :
  forall v w,
    v <<= w
    -> forall s, map_sub (extend w v) (map_sub (extend v w) s) = s.
Proof.
intros v w H m.
rewrite -> extend_sub_compose_up; auto.
apply extend_sub_id.
Qed.

Lemma extend_uniform :
  forall v w (R : wurel v),
    uniform (obj w)
      (fun i m p => rel R i (map_term (extend w v) m) (map_term (extend w v) p)).
Proof.
intros v w R.
do2 3 split.

(* closed *)
{
intros i m n Hrel.
so (urel_closed _#5 Hrel) as (Hcldm & Hcldn).
split; eapply map_hygiene_conv; eauto.
}

(* equiv *)
{
intros i m m' p p' Hclm Hclp Hm Hp Hrel.
eapply urel_equiv; eauto using map_equiv, map_hygiene.
}

(* zigzag *)
{
intros i m n p q Hmn Hpn Hpq.
eapply urel_zigzag; eauto.
}

(* downward *)
{
intros i m n Hrel.
apply urel_downward; auto.
}
Qed.

Definition extend_urel (v w : ordinal) (R : wurel v) : wurel w
  :=
  mk_urel
    (fun i m p => rel R i (map_term (extend w v) m) (map_term (extend w v) p))
    (extend_uniform _#3).

Lemma extend_urel_nonexpansive :
  forall v w, @nonexpansive (wurel_ofe v) (wurel_ofe w) (extend_urel v w).
Proof.
intros v w i R S HRS.
intros j Hj.
cbn.
fextensionality 2.
intros m p.
rewrite -> HRS; auto.
Qed.

Definition extend_urel_ne v w : wurel_ofe v -n> wurel_ofe w
  :=
  expair
    (extend_urel v w)
    (extend_urel_nonexpansive v w).

Lemma extend_urel_inv :
  forall v w, v <<= w -> inverses (extend_urel w v) (extend_urel v w).
Proof.
intros v w Hle R.
apply urel_extensionality.
fextensionality 3.
intros i m p.
cbn.
rewrite -> !extend_term_cancel; auto.
Qed.

Lemma extend_urel_inj :
  forall v w, v <<= w -> injective (extend_urel v w).
Proof.
intros v w Hle.
eapply inverses_impl_injective; eauto using extend_urel_inv.
Qed.

Lemma extend_empty_urel :
  forall v w,
    v <<= w
    -> extend_urel v w empty_urel = empty_urel.
Proof.
intros v w Hvw.
apply urel_extensionality.
fextensionality 3.
intros i m p.
pextensionality; intro H; destruct H.
Qed.

Lemma extend_urelsp_rhs :
  forall v w,
    v <<= w
    -> forall (R : wurel v) (C : urelsp_car R),
         urelsp_car_rhs (extend_urel v w R)
         (fun i n => pi1 C i (map_term (extend w v) n)).
Proof.
intros v w Hvw R C.
destruct C as (P & i & m & p & Hmp & HP).
cbn.
exists i, (map_term (extend v w) m), (map_term (extend v w) p).
split.
  {
  cbn.
  rewrite -> !extend_term_cancel; auto.
  }
intros j n.
split.
  {
  intros Hdn.
  so (HP _ _ andel Hdn) as (Hji & Hdnp).
  split; auto.
  cbn.
  rewrite -> extend_term_cancel; auto.
  }

  {
  intros (Hji & Hnup).
  apply HP.
  split; auto.
  cbn in Hnup.
  rewrite -> extend_term_cancel in Hnup; auto.
  }
Qed.

Definition extend_urelsp {v w} (h : v <<= w) (R : wurel v) (C : car (urelsp R))
  : car (urelsp (extend_urel v w R))
  :=
  expair
    (fun i n => pi1 C i (map_term (extend w v) n))
    (extend_urelsp_rhs _ _ h R C).

Lemma extend_urelsp_nonexpansive :
  forall v w (h : v <<= w) (R : wurel v),
    nonexpansive (extend_urelsp h R).
Proof.
intros v w h R i C D Hdist.
intros j Hji.
fextensionality 1.
intros m.
cbn.
rewrite -> (Hdist j Hji).
reflexivity.
Qed.

Definition extend_urelsp_ne {v w} (h : v <<= w) (R : wurel v)
  : urelsp R -n> urelsp (extend_urel v w R)
  :=
  expair
    (extend_urelsp h R)
    (extend_urelsp_nonexpansive v w h R).

Lemma extend_urelsp_nonexpansive_dep :
  forall v w (h : v <<= w) n
    (C D : wurel v) (E : urelsp_car C) (F : urelsp_car D),
      urelsp_dist_dep C D n E F
      -> urelsp_dist_dep (extend_urel v w C) (extend_urel v w D) n
           (extend_urelsp h C E) (extend_urelsp h D F).
Proof.
intros v w h n C D E F Hdist.
intros j Hj.
cbn.
fextensionality 1.
intros m.
rewrite -> (Hdist j Hj).
reflexivity.
Qed.

Lemma deextend_urelsp_rhs :
  forall v w (R : wurel v) (C : urelsp_car (extend_urel v w R)),
    v <<= w
    -> urelsp_car_rhs R (fun i n => pi1 C i (map_term (extend v w) n)).
Proof.
intros v w R C Hvw.
destruct C as (P & i & m & p & Hmp & HP).
cbn.
exists i, (map_term (extend w v) m), (map_term (extend w v) p).
cbn in Hmp.
split; auto.
intros j n.
split.
  {
  intros Hun.
  so (HP _ _ andel Hun) as (Hji & Hndp).
  cbn in Hndp.
  rewrite -> extend_term_cancel in Hndp; auto.
  }

  {
  intros (Hji & Hndp).
  apply HP.
  split; auto.
  cbn.
  rewrite -> extend_term_cancel; auto.
  }
Qed.

Definition deextend_urelsp {v w : ordinal} (h : v <<= w) (R : wurel v) (C : urelsp_car (extend_urel v w R))
  : urelsp_car R
  :=
  expair (fun i n => pi1 C i (map_term (extend v w) n))
    (deextend_urelsp_rhs _#4 h).

Lemma deextend_urelsp_nonexpansive :
  forall v w (h : v <<= w) (R : wurel v),
    @nonexpansive (urelsp (extend_urel v w R)) (urelsp R) (deextend_urelsp h R).
Proof.
intros v w h R i C D Hdist.
intros j Hji.
fextensionality 1.
intros m.
cbn.
exact (f_equal (fun z => z (map_term (extend v w) m)) (Hdist j Hji)).
Qed.

Definition deextend_urelsp_ne {v w : ordinal} (h : v <<= w) (R : wurel v) :
  urelsp (extend_urel v w R) -n> urelsp R
  :=
  expair
    (deextend_urelsp h R)
    (deextend_urelsp_nonexpansive _ _ h R).

Lemma deextend_urelsp_nonexpansive_dep :
  forall v w (h : v <<= w) n
    (C D : wurel v) (E : urelsp_car (extend_urel v w C)) (F : urelsp_car (extend_urel v w D)),
      urelsp_dist_dep (extend_urel v w C) (extend_urel v w D) n E F
      -> urelsp_dist_dep C D n (deextend_urelsp h C E) (deextend_urelsp h D F).
Proof.
intros v w h n C D E F Hdist.
intros j Hji.
fextensionality 1.
intros m.
cbn.
exact (f_equal (fun z => z (map_term (extend v w) m)) (Hdist j Hji)).
Qed.

Lemma deextend_urelsp_urelspinj :
  forall v w (h : v <<= w) (R : wurel v) i m p (Hmp : rel (extend_urel v w R) i m p),
    deextend_urelsp h R (urelspinj (extend_urel v w R) i m p Hmp)
    =
    urelspinj R i (map_term (extend w v) m) (map_term (extend w v) p) Hmp.
Proof.
intros v w h R i m p Hmp.
apply exT_extensionality_prop.
cbn.
fextensionality 2.
intros j n.
rewrite -> map_term_inv; auto using extend_inv.
Qed.

Lemma extend_urelsp_inv :
  forall v w (h : v <<= w) (R : wurel v),
    inverses (deextend_urelsp h R) (extend_urelsp h R).
Proof.
intros v w h R C.
apply exT_extensionality_prop.
cbn.
fextensionality 2.
intros i n.
rewrite -> extend_term_cancel; auto.
Qed.

Lemma extend_urelsp_inj :
  forall v w (h : v <<= w) (R : wurel v),
    injective (extend_urelsp h R).
Proof.
intros v w h R.
eapply inverses_impl_injective; eauto.
apply extend_urelsp_inv.
Qed.

Definition extend_meta {v w} (h : v <<= w) (m : car (meta_ofe (obj v)))
  : car (meta_ofe (obj w)).
Proof.
apply
  (meta_nerect v (meta_ofe (obj w))
     (fun I => meta_nats I)
     (fun R a b => meta_fn (extend_urel v w R) (nearrow_compose b (deextend_urelsp_ne h R)))
     (fun _ x _ y => meta_pair x y)
     (fun _ x => meta_half x)
     (fun pg => meta_page pg)); eauto with meta_dist.

(* fn *)
{
intros i C D a b c d HCD Hab Hcd.
apply meta_dist_fn.
  {
  apply extend_urel_nonexpansive; auto.
  }

  {
  intros E F HEF.
  cbn.
  apply Hcd; auto.
  apply deextend_urelsp_nonexpansive_dep; auto.
  }
}

(* half *)
{
intros i p p' x x' Hp Hx.
apply meta_dist_half; auto.
}
Defined.

Lemma extend_meta_nonexpansive :
  forall v w (h : v <<= w),
    nonexpansive (extend_meta h).
Proof.
intros v w h.
unfold extend_meta.
apply meta_nerect_nonexpansive.
Qed.

Definition extend_meta_ne {v w} (h : v <<= w)
  : meta_ofe (obj v) -n> meta_ofe (obj w)
  :=
  expair (extend_meta h) (extend_meta_nonexpansive v w h).

Definition extend_iurel {v w : ordinal} (h : v <<= w) (r : wiurel v) : wiurel w
  :=
  (extend_urel v w (fst r),
   extend_meta h (snd r)).

Lemma extend_iurel_nonexpansive :
  forall v w (h : v <<= w), @nonexpansive (wiurel_ofe v) (wiurel_ofe w) (extend_iurel h).
Proof.
intros v w h.
unfold extend_iurel.
intros i x y Hxy.
destruct Hxy.
split; cbn.
  {
  apply extend_urel_nonexpansive; auto.
  }

  {
  apply extend_meta_nonexpansive; auto.
  }
Qed.

Definition extend_iurel_ne {v w : ordinal} (h : v <<= w) :
  wiurel_ofe v -n> wiurel_ofe w
  :=
  expair (extend_iurel h) (extend_iurel_nonexpansive v w h).

Lemma den_extend_iurel :
  forall v w (h : v <<= w) A,
    den (extend_iurel h A) = extend_urel v w (den A).
Proof.
intros v w h A.
reflexivity.
Qed.

Lemma extend_meta_nats :
  forall v w (h : v <<= w) I,
    extend_meta h (meta_nats I) = meta_nats I.
Proof.
intros v w h I.
unfold extend_meta.
rewrite -> meta_nerect_nats.
reflexivity.
Qed.

Lemma extend_meta_fn :
  forall v w (h : v <<= w) R g,
    extend_meta h (meta_fn R g)
    =
    meta_fn (extend_urel v w R)
      (nearrow_compose (nearrow_compose (extend_meta_ne h) g) (deextend_urelsp_ne h R)).
Proof.
intros v w h R g.
unfold extend_meta_ne.
unfold extend_meta.
rewrite -> meta_nerect_fn.
f_equal.
f_equal.
apply exT_extensionality_prop.
cbn.
reflexivity.
Qed.

Lemma extend_meta_term :
  forall v w (h : v <<= w) R C,
    extend_meta h (meta_term R C)
    =
    meta_term (extend_urel v w R) (extend_urelsp h R C).
Proof.
intros v w h R C.
unfold meta_term.
rewrite -> extend_meta_fn.
f_equal.
apply nearrow_extensionality.
intros x.
cbn.
rewrite -> extend_meta_nats.
f_equal.
so (urelsp_eta _ _ x) as (i & m & p & Hmp & ->).
rewrite -> deextend_urelsp_urelspinj.
apply exT_extensionality_prop.
fextensionality 1.
intro j.
cbn.
unfold urelsp_sim_pred.
cbn.
pextensionality.
  {
  intros (n & HCn & Hj & Hnp).
  exists (map_term (extend v w) n).
  rewrite -> extend_term_cancel; auto.
  }

  {
  intros (n & HCn & Hj & Hnp).
  exists (map_term (extend w v) n).
  auto.
  }
Qed.

Lemma extend_meta_pair :
  forall v w (h : v <<= w) m n,
    extend_meta h (meta_pair m n)
    =
    meta_pair (extend_meta h m) (extend_meta h n).
Proof.
intros v w h m n.
unfold extend_meta.
rewrite -> meta_nerect_pair.
reflexivity.
Qed.

Lemma extend_meta_half :
  forall v w (h : v <<= w) m,
    extend_meta h (meta_half m)
    =
    meta_half (extend_meta h m).
Proof.
intros v w h m.
unfold extend_meta.
rewrite -> meta_nerect_half.
reflexivity.
Qed.

Lemma extend_meta_page :
  forall v w (h : v <<= w) pg,
    extend_meta h (meta_page pg)
    =
    meta_page pg.
Proof.
intros v w h pg.
unfold extend_meta.
rewrite -> meta_nerect_page.
reflexivity.
Qed.

Lemma extend_meta_null :
  forall v w (h : v <<= w),
    extend_meta h meta_null = meta_null.
Proof.
intros v w h.
unfold meta_null.
apply extend_meta_nats.
Qed.

Lemma extend_meta_urel :
  forall v w (h : v <<= w) R,
    extend_meta h (meta_urel R) = meta_urel (extend_urel v w R).
Proof.
intros v w h R.
unfold meta_urel.
rewrite -> extend_meta_fn.
f_equal.
apply exT_extensionality_prop.
cbn.
fextensionality 1.
intros _.
rewrite -> extend_meta_null.
reflexivity.
Qed.

Lemma extend_meta_iurel :
  forall v w (h : v <<= w) R,
    extend_meta h (meta_iurel R)
    =
    meta_iurel (extend_iurel h R).
Proof.
intros v w h R.
unfold meta_iurel.
cbn.
rewrite -> extend_meta_pair.
rewrite -> extend_meta_urel.
reflexivity.
Qed.

Hint Rewrite extend_meta_nats extend_meta_fn extend_meta_term extend_meta_pair extend_meta_half extend_meta_page extend_meta_null extend_meta_urel extend_meta_iurel : extend_meta.

Ltac meta_discriminate Heq :=
  let H := fresh
  in
    so (f_equal (meta_rect _ (fun _ => nat) (fun _ => 0) (fun _ _ _ => 2) (fun _ _ _ _ => 4) (fun _ _ => 5) (fun _ => 6)) Heq) as H;
    autorewrite with meta_rect in H;
    cbn in H;
    discriminate Heq.

Lemma extend_meta_inj :
  forall v w (h : v <<= w),
    injective (extend_meta h).
Proof.
intros v w h.
intros m n Heq.
revert n Heq.
pattern m.
apply meta_rect.

(* nats *)
{
intros I n Heq.
revert Heq.
pattern n.
apply meta_rect;
try (intros;
     autorewrite with extend_meta in Heq;
     meta_discriminate Heq).
intros J Heq.
f_equal.
rewrite -> !extend_meta_nats in Heq.
eapply meta_nats_inj; eauto.
}

(* fn *)
{
intros R g IH n Heq.
revert Heq.
pattern n.
apply meta_rect;
try (intros;
     autorewrite with extend_meta in Heq;
     meta_discriminate Heq).
intros R' g' _ Heq.
rewrite -> !extend_meta_fn in Heq.
so (meta_fn_inj _#5 Heq) as Heq'.
so (extend_urel_inj _ _ h _ _ (eq_dep_impl_eq_fst _#6 Heq')).
subst R'.
f_equal.
so (eq_dep_impl_eq_snd _#5 Heq') as Heqg.
clear Heq Heq'.
apply exT_extensionality_prop.
fextensionality 1.
intro C.
so (f_equal (fun z => pi1 z (extend_urelsp h R C)) Heqg) as Heq.
cbn in Heq.
rewrite -> extend_urelsp_inv in Heq.
cbn in Heq.
exact (IH C (pi1 g' C) Heq).
}

(* pair *)
{
intros x IH1 y IH2 n Heq.
revert Heq.
pattern n.
apply meta_rect;
try (intros;
     autorewrite with extend_meta in Heq;
     meta_discriminate Heq).
intros x' _ y' _ Heq.
rewrite -> !extend_meta_pair in Heq.
so (meta_pair_inj _#5 Heq) as (Heq1 & Heq2).
f_equal; eauto.
}

(* half *)
{
intros x IH n Heq.
revert Heq.
pattern n.
apply meta_rect;
try (intros;
     autorewrite with extend_meta in Heq;
     meta_discriminate Heq).
intros x' _ Heq.
rewrite -> !extend_meta_half in Heq.
so (meta_half_inj _#3 Heq) as Heq'.
f_equal; auto.
}

(* page *)
{
intros pg n Heq.
revert Heq.
pattern n.
apply meta_rect;
try (intros;
     autorewrite with extend_meta in Heq;
     meta_discriminate Heq).
intros pg' Heq.
rewrite -> !extend_meta_page in Heq.
so (meta_page_inj _#3 Heq) as Heq'.
f_equal; auto.
}
Qed.

Lemma extend_iurel_inj :
  forall v w (h : v <<= w), injective (extend_iurel h).
Proof.
intros v w h.
intros r s Heq.
so (f_equal fst Heq) as Heq1.
so (f_equal snd Heq) as Heq2.
cbn in Heq1, Heq2.
apply prod_extensionality.
  {
  eapply extend_urel_inj; eauto.
  }

  {
  eapply (extend_meta_inj _ _ h); eauto.
  }
Qed.

Lemma extend_iubase :
  forall v w (h : v <<= w) R,
    extend_iurel h (iubase R)
    =
    iubase (extend_urel v w R).
Proof.
intros v w h R.
unfold iubase.
unfold extend_iurel, extend_urel, extend_iurel.
cbn.
rewrite -> extend_meta_null.
reflexivity.
Qed.

Lemma urel_updown :
  forall v w (A : wurel v) i m p,
    v <<= w
    -> rel A i m p
    -> rel (extend_urel v w A) i (map_term (extend v w) m) (map_term (extend v w) p).
Proof.
intros v w A i m p Hvw H.
cbn.
rewrite -> !extend_term_cancel; auto.
Qed.

Lemma extend_urel_compose_up :
  forall u v w,
    u <<= v
    -> forall R, extend_urel u w R = extend_urel v w (extend_urel u v R).
Proof.
intros u v w Hle R.
apply urel_extensionality.
unfold extend_urel.
cbn.
fextensionality 3.
intros i m p.
rewrite -> !extend_term_compose_down; auto.
Qed.

Lemma extend_urelspinj :
  forall v w (h : v <<= w) (A : wurel v) i m p Hmp Hmp',
    extend_urelsp h A (urelspinj A i m p Hmp)
    =
    urelspinj (extend_urel v w A) i (map_term (extend v w) m) (map_term (extend v w) p) Hmp'.
Proof.
intros v w h A i m p Hmp Hmp'.
apply exT_extensionality_prop.
cbn.
fextensionality 2.
intros j n.
pextensionality.
  {
  intros (Hj & Hrel).
  split; auto.
  rewrite -> extend_term_cancel; auto.
  }

  {
  intros (Hj & Hrel).
  split; auto.
  rewrite -> extend_term_cancel in Hrel; auto.
  }
Qed.

Lemma urelsp_index_extend :
  forall v w A (C : urelsp_car A) (h : v <<= w),
    urelsp_index (extend_urel v w A) (extend_urelsp h A C) = urelsp_index A C.
Proof.
intros v w A C h.
so (urelsp_eta _ _ C) as (i & m & p & Hmp & ->).
assert (rel (extend_urel v w A) i (map_term (extend v w) m) (map_term (extend v w) p)) as Hmp'.
  {
  cbn.
  rewrite -> !extend_term_cancel; auto.
  }
rewrite -> (extend_urelspinj _#8 Hmp').
rewrite -> !urelsp_index_inj.
reflexivity.
Qed.

Lemma extend_meta_compose :
  forall u v w (huv : u <<= v) (hvw : v <<= w) (huw : u <<= w) m,
    extend_meta huw m = extend_meta hvw (extend_meta huv m).
Proof.
intros u v w huv hvw huw m.
pattern m.
apply meta_rect; clear m.

(* nats *)
{
intro I.
rewrite -> !extend_meta_nats.
reflexivity.
}

(* fn *)
{
intros R f IH.
rewrite -> !extend_meta_fn.
assert (forall R R' (f : urelsp R -n> meta_ofe (obj w)) (f' : urelsp R' -n> meta_ofe (obj w)),
          eq_dep _ (fun R => urelsp R -n> meta_ofe (obj w)) R f R' f'
          -> meta_fn R f = meta_fn R' f') as H.
  {
  clear_all.
  intros R R' f f' H.
  injectionT H.
  intros <-.
  injectionT H.
  intros <-.
  reflexivity.
  }
apply H; clear H.
apply exT_extensionality_prop_eq_dep.
cbn.
apply functional_extensionality_eq_dep_dom.
  {
  apply extend_urel_compose_up; auto.
  }
intros C D Heq.
rewrite <- IH.
f_equal.
f_equal.
apply exT_extensionality_prop.
cbn.
fextensionality 2.
intros i n.
rewrite -> extend_term_compose_up; auto.
so (eq_dep_impl_eq_snd_free _#6 (eq_dep_pi1 _#7 Heq)) as Heq'.
exact (f_equal (fun z => z i (map_term (extend u w) n)) Heq').
}

(* pair *)
{
intros m IH1 n IH2.
rewrite -> !extend_meta_pair.
f_equal; auto.
}

(* half *)
{
intros m IH.
rewrite -> !extend_meta_half.
f_equal; auto.
}

(* page *)
{
intros pg.
rewrite -> !extend_meta_page.
reflexivity.
}
Qed.

Lemma extend_iurel_compose :
  forall u v w (h : u <<= v) (h' : v <<= w) R,
    extend_iurel (le_ord_trans _#3 h h') R = extend_iurel h' (extend_iurel h R).
Proof.
intros u v w h h' R.
unfold extend_iurel.
cbn.
f_equal.
  {
  apply (extend_urel_compose_up _#3 h).
  }

  {
  apply (extend_meta_compose u v w h h'(le_ord_trans _#3 h h')).
  }
Qed.

Lemma extend_urel_id :
  forall w R,
    extend_urel w w R = R.
Proof.
intros w R.
apply urel_extensionality.
unfold extend_urel.
cbn.
fextensionality 3.
intros i m p.
rewrite -> !extend_term_id; auto.
Qed.

Lemma deextend_urelsp_id :
  forall w (h : w <<= w) (R : wurel w) C,
    deextend_urelsp h R (transport (eqsymm (extend_urel_id w R)) urelsp_car C) = C.
Proof.
intros w h R C.
apply exT_extensionality_prop.
fextensionality 2.
intros i n.
cbn.
rewrite -> (pi1_transport_lift _ _ (fun z D => urelsp_car_rhs z D) _ _ (eqsymm (extend_urel_id w R))).
rewrite -> extend_term_id.
reflexivity.
Qed.

Lemma extend_meta_id :
  forall w (h : w <<= w) m,
    extend_meta h m = m.
Proof.
intros w h m.
pattern m.
apply meta_rect.

(* nats *)
{
intros I.
rewrite -> extend_meta_nats.
reflexivity.
}

(* fn *)
{
intros R f IH.
rewrite -> extend_meta_fn.
apply meta_fn_extensionality.
apply (eq_impl_eq_dep _#6 (extend_urel_id _ _)).
apply exT_extensionality_prop.
unfold nearrow.
rewrite -> (pi1_transport_dep_lift _ _ (fun z g => @nonexpansive (urelsp z) (meta_ofe (obj w)) g) _ _ (extend_urel_id w R)).
cbn.
fextensionality 1.
intro C.
rewrite -> app_transport_dom.
rewrite -> IH.
f_equal.
apply deextend_urelsp_id.
}

(* pair *)
{
intros x IH1 y IH2.
rewrite -> extend_meta_pair.
f_equal; auto.
}

(* half *)
{
intros x IH.
rewrite -> extend_meta_half.
f_equal; auto.
}

(* page *)
{
intro pg.
rewrite -> extend_meta_page.
reflexivity.
}
Qed.

Lemma extend_iurel_id :
  forall w (h : w <<= w) R,
    extend_iurel h R = R.
Proof.
intros w h R.
destruct R as (R, m).
unfold extend_iurel.
f_equal; auto using extend_urel_id, extend_meta_id.
Qed.


(* (c) Copyright Microsoft Corporation and Inria.                       *)
(* You may distribute this file under the terms of the CeCILL-B license *)
Require Import ssreflect ssrbool ssrfun eqtype ssrnat seq path div choice.
Require Import fintype tuple finfun bigop prime ssralg poly finset.
Require Import fingroup morphism perm automorphism quotient gproduct action.
Require Import finalg zmodp commutator cyclic center pgroup gseries nilpotent.
Require Import sylow maximal abelian matrix mxalgebra mxrepresentation.

(******************************************************************************)
(*   This file completes the theory developed in mxrepresentation.v with the  *)
(* construction and properties of linear representations over finite fields,  *)
(* and in particular the correspondance between internal action on a (normal) *)
(* elementary abelian p-subgroup and a linear representation on an Fp-module. *)
(*   We provide the following next constructions for a finite field F:        *)
(*        'Zm%act == the action of {unit F} on 'M[F]_(m, n).                  *)
(*         rowg A == the additive group of 'rV[F]_n spanned by the row space  *)
(*                   of the matrix A.                                         *)
(*      rowg_mx L == the partial inverse to rowg; for any 'Zm-stable group L  *)
(*                   of 'rV[F]_n we have rowg (rowg_mx L) = L.                *)
(*     GLrepr F n == the natural, faithful representation of 'GL_n[F].        *)
(*     reprGLm rG == the morphism G >-> 'GL_n[F] equivalent to the            *)
(*                   representation r of G (with rG : mx_repr r G).           *)
(*   ('MR rG)%act == the action of G on 'rV[F]_n equivalent to the            *)
(*                   representation r of G (with rG : mx_repr r G).           *)
(* The second set of constructions defines the interpretation of a normal     *)
(* non-trivial elementary abelian p-subgroup as an 'F_p module. We assume     *)
(* abelE : p.-abelem E and ntE : E != 1, throughout, as these are needed to   *)
(* build the isomorphism between E and a nontrivial 'rV['F_p]_n.              *)
(*         'rV(E) == the type of row vectors of the 'F_p module equivalent    *)
(*                   to E when E is a non-trivial p.-abelem group.            *)
(*          'M(E) == the type of matrices corresponding to E.                 *)
(*         'dim E == the width of vectors/matrices in 'rV(E) / 'M(E).         *)
(* abelem_rV abelE ntE == the one-to-one injection of E onto 'rV(E).          *)
(*  rVabelem abelE ntE == the one-to-one projection of 'rV(E) onto E.         *)
(* abelem_repr abelE ntE nEG == the representation of G on 'rV(E) that is     *)
(*                   equivalent to conjugation by G in E; here abelE, ntE are *)
(*                   as above, and G \subset 'N(E).                           *)
(* This file end with basic results on p-modular representations of p-groups, *)
(* and theorems giving the structure of the representation of extraspecial    *)
(* groups; these results use somewhat more advanced group theory than the     *)
(* rest of mxrepresentation, in particular, results of sylow.v and maximal.v. *)
(******************************************************************************)

Set Implicit Arguments.
Unset Strict Implicit.
Unset Printing Implicit Defensive.

Import GroupScope GRing.Theory FinRing.Theory.
Local Open Scope ring_scope.

(* Special results for representations on a finite field. In this case, the   *)
(* representation is equivalent to a morphism into the general linear group   *)
(* 'GL_n[F]. It is furthermore equivalent to a group action on the finite     *)
(* additive group of the corresponding row space 'rV_n. In addition, row      *)
(* spaces of matrices in 'M[F]_n correspond to subgroups of that vector group *)
(* (this is only surjective when F is a prime field 'F_p), with moduleules    *)
(* corresponding to subgroups stabilized by the external action.              *)

Section FinRingRepr.

Variable (R : finComUnitRingType) (gT : finGroupType).
Variables (G : {group gT}) (n : nat) (rG : mx_representation R G n).

Definition mx_repr_act (u : 'rV_n) x := u *m rG (val (subg G x)).

Lemma mx_repr_actE u x : x \in G -> mx_repr_act u x = u *m rG x.
Proof. by move=> Gx; rewrite /mx_repr_act /= subgK. Qed.

Fact mx_repr_is_action : is_action G mx_repr_act.
Proof.
split=> [x | u x y Gx Gy]; first exact: can_inj (repr_mxK _ (subgP _)).
by rewrite !mx_repr_actE ?groupM // -mulmxA repr_mxM.
Qed.
Canonical Structure mx_repr_action := Action mx_repr_is_action.

Fact mx_repr_is_groupAction : is_groupAction [set: 'rV[R]_n] mx_repr_action.
Proof.
move=> x Gx /=; rewrite !inE.
apply/andP; split; first by apply/subsetP=> u; rewrite !inE.
by apply/morphicP=> /= u v _ _; rewrite !actpermE /= /mx_repr_act mulmxDl.
Qed.
Canonical Structure mx_repr_groupAction := GroupAction mx_repr_is_groupAction.

End FinRingRepr.

Notation "''MR' rG" := (mx_repr_action rG)
  (at level 10, rG at level 8) : action_scope.
Notation "''MR' rG" := (mx_repr_groupAction rG) : groupAction_scope.

Section FinFieldRepr.

Variable F : finFieldType.

(* The external group action (by scaling) of the multiplicative unit group   *)
(* of the finite field, and the correspondence between additive subgroups    *)
(* of row vectors that are stable by this action, and the matrix row spaces. *)
Section ScaleAction.

Variables m n : nat.

Definition scale_act (A : 'M[F]_(m, n)) (a : {unit F}) := val a *: A.
Lemma scale_actE A a : scale_act A a = val a *: A. Proof. by []. Qed.
Fact scale_is_action : is_action setT scale_act.
Proof.
apply: is_total_action=> [A | A a b]; rewrite /scale_act ?scale1r //.
by rewrite ?scalerA mulrC.
Qed.
Canonical scale_action := Action scale_is_action.
Fact scale_is_groupAction : is_groupAction setT scale_action.
Proof.
move=> a _ /=; rewrite inE; apply/andP.
split; first by apply/subsetP=> A; rewrite !inE.
by apply/morphicP=> u A _ _ /=; rewrite !actpermE /= /scale_act scalerDr.
Qed.
Canonical scale_groupAction := GroupAction scale_is_groupAction.

Lemma astab1_scale_act A : A != 0 -> 'C[A | scale_action] = 1%g.
Proof.
rewrite -mxrank_eq0=> nzA; apply/trivgP/subsetP=> a; apply: contraLR.
rewrite !inE -val_eqE -subr_eq0 sub1set !inE => nz_a1.
by rewrite -subr_eq0 -scaleN1r -scalerDl -mxrank_eq0 eqmx_scale.
Qed.

End ScaleAction.

Local Notation "'Zm" := (scale_action _ _) (at level 8) : action_scope.

Section RowGroup.

Variable n : nat.
Local Notation rVn := 'rV[F]_n.

Definition rowg m (A : 'M[F]_(m, n)) : {set rVn} := [set u | u <= A]%MS.

Lemma mem_rowg m A v : (v \in @rowg m A) = (v <= A)%MS.
Proof. by rewrite inE. Qed.

Fact rowg_group_set m A : group_set (@rowg m A).
Proof.
by apply/group_setP; split=> [|u v]; rewrite !inE ?sub0mx //; exact: addmx_sub.
Qed.
Canonical rowg_group m A := Group (@rowg_group_set m A).

Lemma rowg_stable m (A : 'M_(m, n)) : [acts setT, on rowg A | 'Zm].
Proof. by apply/actsP=> a _ v; rewrite !inE eqmx_scale // -unitfE (valP a). Qed.

Lemma rowgS m1 m2 (A : 'M_(m1, n)) (B : 'M_(m2, n)) :
  (rowg A \subset rowg B) = (A <= B)%MS.
Proof.
apply/subsetP/idP=> sAB => [| u].
  by apply/row_subP=> i; have:= sAB (row i A); rewrite !inE row_sub => ->.
by rewrite !inE => suA; exact: submx_trans sAB.
Qed.

Lemma eq_rowg m1 m2 (A : 'M_(m1, n)) (B : 'M_(m2, n)) :
  (A :=: B)%MS -> rowg A = rowg B.
Proof. by move=> eqAB; apply/eqP; rewrite eqEsubset !rowgS !eqAB andbb. Qed.

Lemma rowg0 m : rowg (0 : 'M_(m, n)) = 1%g.
Proof. by apply/trivgP/subsetP=> v; rewrite !inE eqmx0 submx0. Qed.

Lemma rowg1 : rowg 1%:M = setT.
Proof. by apply/setP=> x; rewrite !inE submx1. Qed.

Lemma trivg_rowg m (A : 'M_(m, n)) : (rowg A == 1%g) = (A == 0).
Proof. by rewrite -submx0 -rowgS rowg0 (sameP trivgP eqP). Qed.

Definition rowg_mx (L : {set rVn}) := <<\matrix_(i < #|L|) enum_val i>>%MS.

Lemma rowgK m (A : 'M_(m, n)) : (rowg_mx (rowg A) :=: A)%MS.
Proof.
apply/eqmxP; rewrite !genmxE; apply/andP; split.
  by apply/row_subP=> i; rewrite rowK; have:= enum_valP i; rewrite /= inE.
apply/row_subP=> i; set v := row i A.
have Av: v \in rowg A by rewrite inE row_sub.
by rewrite (eq_row_sub (enum_rank_in Av v)) // rowK enum_rankK_in.
Qed.

Lemma rowg_mxS (L M : {set 'rV[F]_n}) :
  L \subset M -> (rowg_mx L <= rowg_mx M)%MS.
Proof.
move/subsetP=> sLM; rewrite !genmxE; apply/row_subP=> i.
rewrite rowK; move: (enum_val i) (sLM _ (enum_valP i)) => v Mv.
by rewrite (eq_row_sub (enum_rank_in Mv v)) // rowK enum_rankK_in.
Qed.

Lemma sub_rowg_mx (L : {set rVn}) : L \subset rowg (rowg_mx L).
Proof.
apply/subsetP=> v Lv; rewrite inE genmxE.
by rewrite (eq_row_sub (enum_rank_in Lv v)) // rowK enum_rankK_in.
Qed.

Lemma stable_rowg_mxK (L : {group rVn}) :
  [acts setT, on L | 'Zm] -> rowg (rowg_mx L) = L.
Proof.
move=> linL; apply/eqP; rewrite eqEsubset sub_rowg_mx andbT.
apply/subsetP=> v; rewrite inE genmxE => /submxP[u ->{v}].
rewrite mulmx_sum_row group_prod // => i _.
rewrite rowK; move: (enum_val i) (enum_valP i) => v Lv.
case: (eqVneq (u 0 i) 0) => [->|]; first by rewrite scale0r group1.
by rewrite -unitfE => aP; rewrite ((actsP linL) (FinRing.Unit _ aP)) ?inE.
Qed.

Lemma rowg_mx1 : rowg_mx 1%g = 0.
Proof. by apply/eqP; rewrite -submx0 -(rowg0 0) rowgK sub0mx. Qed.

Lemma rowg_mx_eq0 (L : {group rVn}) : (rowg_mx L == 0) = (L :==: 1%g).
Proof.
rewrite -trivg_rowg; apply/idP/idP=> [|/eqP->]; last by rewrite rowg_mx1 rowg0.
by rewrite !(sameP eqP trivgP); apply: subset_trans; exact: sub_rowg_mx.
Qed.

Lemma rowgI m1 m2 (A : 'M_(m1, n)) (B : 'M_(m2, n)) :
  rowg (A :&: B)%MS = rowg A :&: rowg B.
Proof. by apply/setP=> u; rewrite !inE sub_capmx. Qed.

Lemma card_rowg m (A : 'M_(m, n)) : #|rowg A| = (#|F| ^ \rank A)%N.
Proof.
rewrite -[\rank A]mul1n -card_matrix.
have injA: injective (mulmxr (row_base A)).
  have /row_freeP[A' A'K] := row_base_free A.
  by move=> ?; apply: can_inj (mulmxr A') _ => u; rewrite /= -mulmxA A'K mulmx1.
rewrite -(card_image (injA _)); apply: eq_card => v.
by rewrite inE -(eq_row_base A) (sameP submxP codomP).
Qed.

Lemma rowgD m1 m2 (A : 'M_(m1, n)) (B : 'M_(m2, n)) :
  rowg (A + B)%MS = (rowg A * rowg B)%g.
Proof.
apply/eqP; rewrite eq_sym eqEcard mulG_subG /= !rowgS.
rewrite addsmxSl addsmxSr -(@leq_pmul2r #|rowg A :&: rowg B|) ?cardG_gt0 //=.
by rewrite -mul_cardG -rowgI !card_rowg -!expnD mxrank_sum_cap.
Qed.

Lemma cprod_rowg m1 m2 (A : 'M_(m1, n)) (B : 'M_(m2, n)) :
  rowg A \* rowg B = rowg (A + B)%MS.
Proof. by rewrite rowgD cprodE // (sub_abelian_cent2 (zmod_abelian setT)). Qed.

Lemma dprod_rowg  m1 m2 (A : 'M[F]_(m1, n)) (B : 'M[F]_(m2, n)) :
  mxdirect (A + B) -> rowg A \x rowg B = rowg (A + B)%MS.
Proof.
rewrite (sameP mxdirect_addsP eqP) -trivg_rowg rowgI => /eqP tiAB.
by rewrite -cprod_rowg dprodEcp.
Qed.

Lemma bigcprod_rowg m I r (P : pred I) (A : I -> 'M[F]_n) (B : 'M[F]_(m, n)) :
    (\sum_(i <- r | P i) A i :=: B)%MS ->
  \big[cprod/1%g]_(i <- r | P i) rowg (A i) = rowg B.
Proof.
by move/eq_rowg <-; apply/esym/big_morph=> [? ?|]; rewrite (rowg0, cprod_rowg).
Qed.

Lemma bigdprod_rowg m (I : finType) (P : pred I) A (B : 'M[F]_(m, n)) :
    let S := (\sum_(i | P i) A i)%MS in (S :=: B)%MS -> mxdirect S ->
  \big[dprod/1%g]_(i | P i) rowg (A i) = rowg B.
Proof.
move=> S defS; rewrite mxdirectE defS /= => /eqP rankB.
apply: bigcprod_card_dprod (bigcprod_rowg defS) (eq_leq _).
by rewrite card_rowg rankB expn_sum; apply: eq_bigr => i _; rewrite card_rowg.
Qed.

End RowGroup.

Variables (gT : finGroupType) (G : {group gT}) (n' : nat).
Local Notation n := n'.+1.
Variable (rG : mx_representation F G n).

Fact GL_mx_repr : mx_repr 'GL_n[F] GLval. Proof. by []. Qed.
Canonical GLrepr := MxRepresentation GL_mx_repr.

Lemma GLmx_faithful : mx_faithful GLrepr.
Proof. by apply/subsetP=> A; rewrite !inE mul1mx. Qed.

Definition reprGLm x : {'GL_n[F]} := insubd (1%g : {'GL_n[F]}) (rG x).

Lemma val_reprGLm x : x \in G -> val (reprGLm x) = rG x.
Proof. by move=> Gx; rewrite val_insubd (repr_mx_unitr rG). Qed.

Lemma comp_reprGLm : {in G, GLval \o reprGLm =1 rG}.
Proof. exact: val_reprGLm. Qed.

Lemma reprGLmM : {in G &, {morph reprGLm : x y / x * y}}%g.
Proof.
by move=> x y Gx Gy; apply: val_inj; rewrite /= !val_reprGLm ?groupM ?repr_mxM.
Qed.
Canonical reprGL_morphism := Morphism reprGLmM.

Lemma ker_reprGLm : 'ker reprGLm = rker rG.
Proof.
apply/setP=> x; rewrite !inE mul1mx; apply: andb_id2l => Gx.
by rewrite -val_eqE val_reprGLm.
Qed.

Lemma astab_rowg_repr m (A : 'M_(m, n)) : 'C(rowg A | 'MR rG) = rstab rG A.
Proof.
apply/setP=> x; rewrite !inE /=; apply: andb_id2l => Gx.
apply/subsetP/eqP=> cAx => [|u]; last first.
  by rewrite !inE mx_repr_actE // => /submxP[u' ->]; rewrite -mulmxA cAx.
apply/row_matrixP=> i; apply/eqP; move/implyP: (cAx (row i A)).
by rewrite !inE row_sub mx_repr_actE //= row_mul.
Qed.

Lemma astabs_rowg_repr m (A : 'M_(m, n)) : 'N(rowg A | 'MR rG) = rstabs rG A.
Proof.
apply/setP=> x; rewrite !inE /=; apply: andb_id2l => Gx.
apply/subsetP/idP=> nAx => [|u]; last first.
  rewrite !inE mx_repr_actE // => Au; exact: (submx_trans (submxMr _ Au)).
apply/row_subP=> i; move/implyP: (nAx (row i A)).
by rewrite !inE row_sub mx_repr_actE //= row_mul.
Qed.

Lemma acts_rowg (A : 'M_n) : [acts G, on rowg A | 'MR rG] = mxmodule rG A.
Proof. by rewrite astabs_rowg_repr. Qed.

Lemma astab_setT_repr : 'C(setT | 'MR rG) = rker rG.
Proof. by rewrite -rowg1 astab_rowg_repr. Qed.

Lemma mx_repr_action_faithful :
  [faithful G, on setT | 'MR rG] = mx_faithful rG.
Proof.
by rewrite /faithful astab_setT_repr (setIidPr _) // [rker _]setIdE subsetIl.
Qed.

Lemma afix_repr (H : {set gT}) :
  H \subset G -> 'Fix_('MR rG)(H) = rowg (rfix_mx rG H).
Proof.
move/subsetP=> sHG; apply/setP=> /= u; rewrite !inE.
apply/subsetP/rfix_mxP=> cHu x Hx; have:= cHu x Hx;
  by rewrite !inE /= => /eqP; rewrite mx_repr_actE ?sHG.
Qed.

Lemma gacent_repr (H : {set gT}) :
  H \subset G -> 'C_(| 'MR rG)(H) = rowg (rfix_mx rG H).
Proof. by move=> sHG; rewrite gacentE // setTI afix_repr. Qed.

End FinFieldRepr.

Arguments Scope rowg_mx [_ _ group_scope].
Notation "''Zm'" := (scale_action _ _ _) (at level 8) : action_scope.
Notation "''Zm'" := (scale_groupAction _ _ _) : groupAction_scope.

Section MatrixGroups.

Implicit Types m n p q : nat.

Lemma exponent_mx_group m n q :
  m > 0 -> n > 0 -> q > 1 -> exponent [set: 'M['Z_q]_(m, n)] = q.
Proof.
move=> m_gt0 n_gt0 q_gt1; apply/eqP; rewrite eqn_dvd; apply/andP; split.
  apply/exponentP=> x _; apply/matrixP=> i j; rewrite mulmxnE !mxE.
  by rewrite -mulr_natr -Zp_nat_mod // modnn mulr0.
pose cmx1 := const_mx 1%R : 'M['Z_q]_(m, n).
apply: dvdn_trans (dvdn_exponent (in_setT cmx1)).
have/matrixP/(_ (Ordinal m_gt0))/(_ (Ordinal n_gt0))/eqP := expg_order cmx1.
by rewrite mulmxnE !mxE -order_dvdn order_Zp1 Zp_cast.
Qed.

Lemma rank_mx_group m n q : 'r([set: 'M['Z_q]_(m, n)]) = (m * n)%N.
Proof.
wlog q_gt1: q / q > 1 by case: q => [|[|q -> //]] /(_ 2)->.
set G := setT; have cGG: abelian G := zmod_abelian _.
have [mn0 | ] := posnP (m * n).
  by rewrite [G](card1_trivg _) ?rank1 // cardsT card_matrix mn0.
rewrite muln_gt0 => /andP[m_gt0 n_gt0].
have expG: exponent G = q := exponent_mx_group m_gt0 n_gt0 q_gt1.
apply/eqP; rewrite eqn_leq andbC -(leq_exp2l _ _ q_gt1) -{2}expG.
have ->: (q ^ (m * n))%N = #|G| by rewrite cardsT card_matrix card_ord Zp_cast.
rewrite max_card_abelian //= -grank_abelian //= -/G.
pose B : {set 'M['Z_q]_(m, n)} := [set delta_mx ij.1 ij.2 | ij : 'I_m * 'I_n].
suffices ->: G = <<B>>.
  have ->: (m * n)%N = #|{: 'I_m * 'I_n}| by rewrite card_prod !card_ord.
  exact: leq_trans (grank_min _) (leq_imset_card _ _).
apply/setP=> v; rewrite inE (matrix_sum_delta v).
rewrite group_prod // => i _; rewrite group_prod // => j _.
rewrite -[v i j]natr_Zp scaler_nat groupX // mem_gen //.
by apply/imsetP; exists (i, j).
Qed.

Lemma mx_group_homocyclic m n q : homocyclic [set: 'M['Z_q]_(m, n)].
Proof.
wlog q_gt1: q / q > 1 by case: q => [|[|q -> //]] /(_ 2)->.
set G := setT; have cGG: abelian G := zmod_abelian _.
rewrite -max_card_abelian //= rank_mx_group cardsT card_matrix card_ord -/G.
rewrite {1}Zp_cast //; have [-> // | ] := posnP (m * n).
by rewrite muln_gt0 => /andP[m_gt0 n_gt0]; rewrite exponent_mx_group.
Qed.

Lemma abelian_type_mx_group m n q :
  q > 1 -> abelian_type [set: 'M['Z_q]_(m, n)] = nseq (m * n) q.
Proof.
rewrite (abelian_type_homocyclic (mx_group_homocyclic m n q)) rank_mx_group.
have [-> // | ] := posnP (m * n); rewrite muln_gt0 => /andP[m_gt0 n_gt0] q_gt1.
by rewrite exponent_mx_group.
Qed.

End MatrixGroups.

Delimit Scope abelem_scope with Mg.
Open Scope abelem_scope.

Definition abelem_dim' (gT : finGroupType) (E : {set gT}) :=
  (logn (pdiv #|E|) #|E|).-1.
Arguments Scope abelem_dim' [_ group_scope].
Notation "''dim' E" := (abelem_dim' E).+1
  (at level 10, E at level 8, format "''dim'  E") : abelem_scope.

Notation "''rV' ( E )" := 'rV_('dim E)
  (at level 8, format "''rV' ( E )") : abelem_scope.
Notation "''M' ( E )" := 'M_('dim E)
  (at level 8, format "''M' ( E )") : abelem_scope.
Notation "''rV[' F ] ( E )" := 'rV[F]_('dim E)
  (at level 8, only parsing) : abelem_scope.
Notation "''M[' F ] ( E )" := 'M[F]_('dim E)
  (at level 8, only parsing) : abelem_scope.

Section AbelemRepr.

Section FpMatrix.

Variables p m n : nat.
Local Notation Mmn := 'M['F_p]_(m, n).

Lemma mx_Fp_abelem : prime p -> p.-abelem [set: Mmn].
Proof.
move=> p_pr; apply/abelemP=> //; rewrite zmod_abelian.
split=> //= v _; rewrite zmodXgE -scaler_nat.
by case/andP: (char_Fp p_pr) => _ /eqP->; rewrite scale0r.
Qed.

Lemma mx_Fp_stable (L : {group Mmn}) : [acts setT, on L | 'Zm].
Proof.
apply/subsetP=> a _; rewrite !inE; apply/subsetP=> A L_A.
by rewrite inE /= /scale_act -[val _]natr_Zp scaler_nat groupX.
Qed.

End FpMatrix.

Section FpRow.

Variables p n : nat.
Local Notation rVn := 'rV['F_p]_n.

Lemma rowg_mxK (L : {group rVn}) : rowg (rowg_mx L) = L.
Proof. by apply: stable_rowg_mxK; exact: mx_Fp_stable. Qed.

Lemma rowg_mxSK (L : {set rVn}) (M : {group rVn}) :
  (rowg_mx L <= rowg_mx M)%MS = (L \subset M).
Proof.
apply/idP/idP; last exact: rowg_mxS.
by rewrite -rowgS rowg_mxK; apply: subset_trans; exact: sub_rowg_mx.
Qed.

Lemma mxrank_rowg (L : {group rVn}) :
  prime p -> \rank (rowg_mx L) = logn p #|L|.
Proof.
by move=> p_pr; rewrite -{2}(rowg_mxK L) card_rowg card_Fp ?pfactorK.
Qed.

End FpRow.

Variables (p : nat) (gT : finGroupType) (E : {group gT}).
Hypotheses (abelE : p.-abelem E) (ntE : E :!=: 1%g).

Let pE : p.-group E := abelem_pgroup abelE.
Let p_pr : prime p. Proof. by have [] := pgroup_pdiv pE ntE. Qed.

Local Notation n' := (abelem_dim' (gval E)).
Local Notation n := n'.+1.
Local Notation rVn := 'rV['F_p](gval E).

Lemma dim_abelemE : n = logn p #|E|.
Proof.
rewrite /n'; have [_ _ [k ->]] :=  pgroup_pdiv pE ntE.
by rewrite /pdiv primes_exp ?primes_prime // pfactorK.
Qed.

Lemma card_abelem_rV : #|rVn| = #|E|.
Proof.
by rewrite dim_abelemE card_matrix mul1n card_Fp // -p_part part_pnat_id.
Qed.

Lemma isog_abelem_rV : E \isog [set: rVn].
Proof.
by rewrite (isog_abelem_card _ abelE) cardsT card_abelem_rV mx_Fp_abelem /=.
Qed.

Local Notation ab_rV_P := (existsP isog_abelem_rV).
Definition abelem_rV : gT -> rVn := xchoose ab_rV_P.

Local Notation ErV := abelem_rV.

Lemma abelem_rV_M : {in E &, {morph ErV : x y / (x * y)%g >-> x + y}}.
Proof. by case/misomP: (xchooseP ab_rV_P) => fM _; move/morphicP: fM. Qed.

Canonical abelem_rV_morphism := Morphism abelem_rV_M.

Lemma abelem_rV_isom : isom E setT ErV.
Proof. by case/misomP: (xchooseP ab_rV_P). Qed.

Lemma abelem_rV_injm : 'injm ErV. Proof. by case/isomP: abelem_rV_isom. Qed.

Lemma abelem_rV_inj : {in E &, injective ErV}.
Proof. by apply/injmP; exact: abelem_rV_injm. Qed.

Lemma im_abelem_rV : ErV @* E = setT. Proof. by case/isomP: abelem_rV_isom. Qed.

Lemma mem_im_abelem_rV u : u \in ErV @* E.
Proof. by rewrite im_abelem_rV inE. Qed.

Lemma sub_im_abelem_rV mA : subset mA (mem (ErV @* E)).
Proof. by rewrite unlock; apply/pred0P=> v /=; rewrite mem_im_abelem_rV. Qed.
Hint Resolve mem_im_abelem_rV sub_im_abelem_rV.

Lemma abelem_rV_1 : ErV 1 = 0%R. Proof. by rewrite morph1. Qed.

Lemma abelem_rV_X x i : x \in E -> ErV (x ^+ i) = i%:R *: ErV x.
Proof. by move=> Ex; rewrite morphX // scaler_nat. Qed.

Lemma abelem_rV_V x : x \in E -> ErV x^-1 = - ErV x.
Proof. by move=> Ex; rewrite morphV. Qed.

Definition rVabelem : rVn -> gT := invm abelem_rV_injm.
Canonical rVabelem_morphism := [morphism of rVabelem].
Local Notation rV_E := rVabelem.

Lemma rVabelem0 : rV_E 0 = 1%g. Proof. exact: morph1. Qed.

Lemma rVabelemD : {morph rV_E : u v / u + v >-> (u * v)%g}.
Proof. by move=> u v /=; rewrite -morphM. Qed.

Lemma rVabelemN : {morph rV_E: u / - u >-> (u^-1)%g}.
Proof. by move=> u /=; rewrite -morphV. Qed.

Lemma rVabelemZ (m : 'F_p) : {morph rV_E : u / m *: u >-> (u ^+ m)%g}.
Proof. by move=> u; rewrite /= -morphX -?[(u ^+ m)%g]scaler_nat ?natr_Zp. Qed.

Lemma abelem_rV_K : {in E, cancel ErV rV_E}. Proof. exact: invmE. Qed.

Lemma rVabelemK : cancel rV_E ErV. Proof. by move=> u; rewrite invmK. Qed.

Lemma rVabelem_inj : injective rV_E. Proof. exact: can_inj rVabelemK. Qed.

Lemma rVabelem_injm : 'injm rV_E. Proof. exact: injm_invm abelem_rV_injm. Qed.

Lemma im_rVabelem : rV_E @* setT = E.
Proof. by rewrite -im_abelem_rV im_invm. Qed.

Lemma mem_rVabelem u : rV_E u \in E.
Proof. by rewrite -im_rVabelem mem_morphim. Qed.

Lemma sub_rVabelem L : rV_E @* L \subset E.
Proof. by rewrite -[_ @* L]morphimIim im_invm subsetIl. Qed.
Hint Resolve mem_rVabelem sub_rVabelem.

Lemma card_rVabelem L : #|rV_E @* L| = #|L|.
Proof. by rewrite card_injm ?rVabelem_injm. Qed.

Lemma abelem_rV_mK (H : {set gT}) : H \subset E -> rV_E @* (ErV @* H) = H.
Proof. exact: morphim_invm abelem_rV_injm H. Qed.

Lemma rVabelem_mK L : ErV @* (rV_E @* L) = L.
Proof. by rewrite morphim_invmE morphpreK. Qed.

Lemma rVabelem_minj : injective (morphim (MorPhantom rV_E)).
Proof. exact: can_inj rVabelem_mK. Qed.

Lemma rVabelemS L M : (rV_E @* L \subset rV_E @* M) = (L \subset M).
Proof. by rewrite injmSK ?rVabelem_injm. Qed.

Lemma abelem_rV_S (H K : {set gT}) :
  H \subset E -> (ErV @* H \subset ErV @* K) = (H \subset K).
Proof. by move=> sHE; rewrite injmSK ?abelem_rV_injm. Qed.

Lemma sub_rVabelem_im L (H : {set gT}) :
  (rV_E @* L \subset H) = (L \subset ErV @* H).
Proof. by rewrite sub_morphim_pre ?morphpre_invm. Qed.

Lemma sub_abelem_rV_im (H : {set gT}) (L : {set 'rV['F_p]_n}) :
  H \subset E -> (ErV @* H \subset L) = (H \subset rV_E @* L).
Proof. by move=> sHE; rewrite sub_morphim_pre ?morphim_invmE. Qed.

Section OneGroup.

Variable G : {group gT}.
Definition abelem_mx_fun (g : subg_of G) v := ErV ((rV_E v) ^ val g).
Definition abelem_mx of G \subset 'N(E) :=
  fun x => lin1_mx (abelem_mx_fun (subg G x)).

Hypothesis nEG : G \subset 'N(E).
Local Notation r := (abelem_mx nEG).

Fact abelem_mx_linear_proof g : linear (abelem_mx_fun g).
Proof.
rewrite /abelem_mx_fun; case: g => x /= /(subsetP nEG) Nx /= m u v.
rewrite rVabelemD rVabelemZ conjMg conjXg.
by rewrite abelem_rV_M ?abelem_rV_X ?groupX ?memJ_norm // natr_Zp.
Qed.
Canonical abelem_mx_linear g := Linear (abelem_mx_linear_proof g).

Let rVabelemJmx v x : x \in G -> rV_E (v *m r x) = (rV_E v) ^ x.
Proof.
move=> Gx; rewrite /= mul_rV_lin1 /= /abelem_mx_fun subgK //.
by rewrite abelem_rV_K // memJ_norm // (subsetP nEG).
Qed.

Fact abelem_mx_repr : mx_repr G r.
Proof.
split=> [|x y Gx Gy]; apply/row_matrixP=> i; apply: rVabelem_inj.
  by rewrite rowE -row1 rVabelemJmx // conjg1.
by rewrite !rowE mulmxA !rVabelemJmx ?groupM // conjgM.
Qed.
Canonical abelem_repr := MxRepresentation abelem_mx_repr.
Let rG := abelem_repr.

Lemma rVabelemJ v x : x \in G -> rV_E (v *m rG x) = (rV_E v) ^ x.
Proof. exact: rVabelemJmx. Qed.

Lemma abelem_rV_J : {in E & G, forall x y, ErV (x ^ y) = ErV x *m rG y}.
Proof.
by move=> x y Ex Gy; rewrite -{1}(abelem_rV_K Ex) -rVabelemJ ?rVabelemK.
Qed.

Lemma abelem_rowgJ m (A : 'M_(m, n)) x :
  x \in G -> rV_E @* rowg (A *m rG x) = (rV_E @* rowg A) :^ x.
Proof.
move=> Gx; apply: (canRL (conjsgKV _)); apply/setP=> y.
rewrite mem_conjgV !morphim_invmE !inE memJ_norm ?(subsetP nEG) //=.
apply: andb_id2l => Ey; rewrite abelem_rV_J //.
by rewrite submxMfree // row_free_unit (repr_mx_unit rG).
Qed.

Lemma rV_abelem_sJ (L : {group gT}) x :
  x \in G -> L \subset E -> ErV @* (L :^ x) = rowg (rowg_mx (ErV @* L) *m rG x).
Proof.
move=> Gx sLE; apply: rVabelem_minj; rewrite abelem_rowgJ //.
by rewrite rowg_mxK !morphim_invm // -(normsP nEG x Gx) conjSg.
Qed.

Lemma rstab_abelem m (A : 'M_(m, n)) : rstab rG A = 'C_G(rV_E @* rowg A).
Proof.
apply/setP=> x; rewrite !inE /=; apply: andb_id2l => Gx.
apply/eqP/centP=> cAx => [_ /morphimP[u _ Au ->]|].
  move: Au; rewrite inE => /submxP[u' ->] {u}.
  by apply/esym/commgP/conjg_fixP; rewrite -rVabelemJ -?mulmxA ?cAx.
apply/row_matrixP=> i; apply: rVabelem_inj.
by rewrite row_mul rVabelemJ // /conjg -cAx ?mulKg ?mem_morphim // inE row_sub.
Qed.

Lemma rstabs_abelem m (A : 'M_(m, n)) : rstabs rG A = 'N_G(rV_E @* rowg A).
Proof.
apply/setP=> x; rewrite !inE /=; apply: andb_id2l => Gx.
by rewrite -rowgS -rVabelemS abelem_rowgJ.
Qed.

Lemma rstabs_abelemG (L : {group gT}) :
  L \subset E -> rstabs rG (rowg_mx (ErV @* L)) = 'N_G(L).
Proof. by move=> sLE; rewrite rstabs_abelem rowg_mxK morphim_invm. Qed.

Lemma mxmodule_abelem m (U : 'M['F_p]_(m, n)) :
  mxmodule rG U = (G \subset 'N(rV_E @* rowg U)).
Proof. by rewrite -subsetIidl -rstabs_abelem. Qed.

Lemma mxmodule_abelemG (L : {group gT}) :
  L \subset E -> mxmodule rG (rowg_mx (ErV @* L)) = (G \subset 'N(L)).
Proof. by move=> sLE; rewrite -subsetIidl -rstabs_abelemG. Qed.

Lemma mxsimple_abelemP (U : 'M['F_p]_n) :
  reflect (mxsimple rG U) (minnormal (rV_E @* rowg U) G).
Proof.
apply: (iffP mingroupP) => [[/andP[ntU modU] minU] | [modU ntU minU]].
  split=> [||V modV sVU ntV]; first by rewrite mxmodule_abelem.
    by apply: contraNneq ntU => ->; rewrite /= rowg0 morphim1.
  rewrite -rowgS -rVabelemS [_ @* rowg V]minU //.
    rewrite -subG1 sub_rVabelem_im morphim1 subG1 trivg_rowg ntV /=.
    by rewrite -mxmodule_abelem.
  by rewrite rVabelemS rowgS.
split=> [|D /andP[ntD nDG sDU]].
  rewrite -subG1 sub_rVabelem_im morphim1 subG1 trivg_rowg ntU /=.
  by rewrite -mxmodule_abelem.
apply/eqP; rewrite eqEsubset sDU sub_rVabelem_im /= -rowg_mxSK rowgK.
have sDE: D \subset E := subset_trans sDU (sub_rVabelem _).
rewrite minU ?mxmodule_abelemG //.
  by rewrite -rowgS rowg_mxK sub_abelem_rV_im.
by rewrite rowg_mx_eq0 (morphim_injm_eq1 abelem_rV_injm).
Qed.

Lemma mxsimple_abelemGP (L : {group gT}) :
  L \subset E -> reflect (mxsimple rG (rowg_mx (ErV @* L))) (minnormal L G).
Proof.
move/abelem_rV_mK=> {2}<-; rewrite -{2}[_ @* L]rowg_mxK.
exact: mxsimple_abelemP.
Qed.

Lemma abelem_mx_irrP : reflect (mx_irreducible rG) (minnormal E G).
Proof.
by rewrite -[E in minnormal E G]im_rVabelem -rowg1; exact: mxsimple_abelemP.
Qed.

Lemma rfix_abelem (H : {set gT}) :
  H \subset G -> (rfix_mx rG H :=: rowg_mx (ErV @* 'C_E(H)%g))%MS.
Proof.
move/subsetP=> sHG; apply/eqmxP/andP; split.
  rewrite -rowgS rowg_mxK -sub_rVabelem_im // subsetI sub_rVabelem /=.
  apply/centsP=> y /morphimP[v _]; rewrite inE => cGv ->{y} x Gx.
  by apply/commgP/conjg_fixP; rewrite /= -rVabelemJ ?sHG ?(rfix_mxP H _).
rewrite genmxE; apply/rfix_mxP=> x Hx; apply/row_matrixP=> i.
rewrite row_mul rowK; case/morphimP: (enum_valP i) => z Ez /setIP[_ cHz] ->.
by rewrite -abelem_rV_J ?sHG // conjgE (centP cHz) ?mulKg.
Qed.

Lemma rker_abelem : rker rG = 'C_G(E).
Proof. by rewrite /rker rstab_abelem rowg1 im_rVabelem. Qed.

Lemma abelem_mx_faithful : 'C_G(E) = 1%g -> mx_faithful rG.
Proof. by rewrite /mx_faithful rker_abelem => ->. Qed.

End OneGroup.

Section SubGroup.

Variables G H : {group gT}.
Hypotheses (nEG : G \subset 'N(E)) (sHG : H \subset G).
Let nEH := subset_trans sHG nEG.
Local Notation rG := (abelem_repr nEG).
Local Notation rHG := (subg_repr rG sHG).
Local Notation rH := (abelem_repr nEH).

Lemma eq_abelem_subg_repr : {in H, rHG =1 rH}.
Proof.
move=> x Hx; apply/row_matrixP=> i; rewrite !rowE !mul_rV_lin1 /=.
by rewrite /abelem_mx_fun !subgK ?(subsetP sHG).
Qed.

Lemma rsim_abelem_subg : mx_rsim rHG rH.
Proof.
exists 1%:M => // [|x Hx]; first by rewrite row_free_unit unitmx1.
by rewrite mul1mx mulmx1 eq_abelem_subg_repr.
Qed.

Lemma mxmodule_abelem_subg m (U : 'M_(m, n)) : mxmodule rHG U = mxmodule rH U.
Proof.
apply: eq_subset_r => x; rewrite !inE; apply: andb_id2l => Hx.
by rewrite eq_abelem_subg_repr.
Qed.

Lemma mxsimple_abelem_subg U : mxsimple rHG U <-> mxsimple rH U.
Proof.
have eq_modH := mxmodule_abelem_subg; rewrite /mxsimple eq_modH.
by split=> [] [-> -> minU]; split=> // V; have:= minU V; rewrite eq_modH.
Qed.

End SubGroup.

End AbelemRepr.

Section ModularRepresentation.

Variables (F : fieldType) (p : nat) (gT : finGroupType).
Hypothesis charFp : p \in [char F].
Implicit Types G H : {group gT}.

(* This is Gorenstein, Lemma 2.6.3. *)
Lemma rfix_pgroup_char G H n (rG : mx_representation F G n) :
  n > 0 -> p.-group H -> H \subset G -> rfix_mx rG H != 0.
Proof.
move=> n_gt0 pH sHG; rewrite -(rfix_subg rG sHG).
move: {2}_.+1 (ltnSn (n + #|H|)) {rG G sHG}(subg_repr _ _) => m.
elim: m gT H pH => // m IHm gT' G pG in n n_gt0 *; rewrite ltnS => le_nG_m rG.
apply/eqP=> Gregular; have irrG: mx_irreducible rG.
  apply/mx_irrP; split=> // U modU; rewrite -mxrank_eq0 -lt0n => Unz.
  rewrite /row_full eqn_leq rank_leq_col leqNgt; apply/negP=> ltUn.
  have: rfix_mx (submod_repr modU) G != 0.
    by apply: IHm => //; apply: leq_trans le_nG_m; rewrite ltn_add2r.
  by rewrite -mxrank_eq0 (rfix_submod modU) // Gregular capmx0 linear0 mxrank0.
have{m le_nG_m IHm} faithfulG: mx_faithful rG.
  apply/trivgP/eqP/idPn; set C := _ rG => ntC.
  suffices: rfix_mx (kquo_repr rG) (G / _)%g != 0.
    by rewrite -mxrank_eq0 rfix_quo // Gregular mxrank0.
  apply: (IHm _ _ (morphim_pgroup _ _)) => //.
  by apply: leq_trans le_nG_m; rewrite ltn_add2l ltn_quotient // rstab_sub.
have{Gregular} ntG: G :!=: 1%g.
  apply: contraL n_gt0; move/eqP=> G1; rewrite -leqNgt -(mxrank1 F n).
  rewrite -(mxrank0 F n n) -Gregular mxrankS //; apply/rfix_mxP=> x.
  by rewrite {1}G1 mul1mx => /set1P->; rewrite repr_mx1.
have p_pr: prime p by case/andP: charFp.
have{ntG pG} [z]: {z | z \in 'Z(G) & #[z] = p}; last case/setIP=> Gz cGz ozp.
  apply: Cauchy => //; apply: contraR ntG; rewrite -p'natE // => p'Z.
  have pZ: p.-group 'Z(G) by rewrite (pgroupS (center_sub G)).
  by rewrite (trivg_center_pgroup pG (card1_trivg (pnat_1 pZ p'Z))).
have{cGz} cGz1: centgmx rG (rG z - 1%:M).
  apply/centgmxP=> x Gx; rewrite mulmxBl mulmxBr mulmx1 mul1mx.
  by rewrite -!repr_mxM // (centP cGz).
have{irrG faithfulG cGz1} Urz1: rG z - 1%:M \in unitmx.
  apply: (mx_Schur irrG) cGz1 _; rewrite subr_eq0.
  move/implyP: (subsetP faithfulG z).
  by rewrite !inE Gz mul1mx -order_eq1 ozp -implybNN neq_ltn orbC prime_gt1.
do [case: n n_gt0 => // n' _; set n := n'.+1] in rG Urz1 *.
have charMp: p \in [char 'M[F]_n].
  exact: (rmorph_char (scalar_mx_rmorphism _ _)).
have{Urz1}: Frobenius_aut charMp (rG z - 1) \in GRing.unit by rewrite unitrX.
rewrite (Frobenius_autB_comm _ (commr1 _)) Frobenius_aut1.
by rewrite -[_ (rG z)](repr_mxX rG) // -ozp expg_order repr_mx1 subrr unitr0.
Qed.

Variables (G : {group gT}) (n : nat) (rG : mx_representation F G n).

Lemma pcore_sub_rstab_mxsimple M : mxsimple rG M -> 'O_p(G) \subset rstab rG M.
Proof.
case=> modM nzM simM; have sGpG := pcore_sub p G.
rewrite rfix_mx_rstabC //; set U := rfix_mx _ _.
have:= simM (M :&: U)%MS; rewrite sub_capmx submx_refl.
apply; rewrite ?capmxSl //.
  by rewrite capmx_module // normal_rfix_mx_module ?pcore_normal.
rewrite -(in_submodK (capmxSl _ _)) val_submod_eq0 -submx0.
rewrite -(rfix_submod modM) // submx0 rfix_pgroup_char ?pcore_pgroup //.
by rewrite lt0n mxrank_eq0.
Qed.

Lemma pcore_sub_rker_mx_irr : mx_irreducible rG -> 'O_p(G) \subset rker rG.
Proof. exact: pcore_sub_rstab_mxsimple. Qed.

(* This is Gorenstein, Lemma 3.1.3. *)
Lemma pcore_faithful_mx_irr :
  mx_irreducible rG -> mx_faithful rG -> 'O_p(G) = 1%g.
Proof.
move=> irrG ffulG; apply/trivgP; apply: subset_trans ffulG.
exact: pcore_sub_rstab_mxsimple.
Qed.

End ModularRepresentation.

Section Extraspecial.

Variables (F : fieldType) (gT : finGroupType) (S : {group gT}) (p n : nat).
Hypotheses (pS : p.-group S) (esS : extraspecial S).
Hypothesis oSpn : #|S| = (p ^ n.*2.+1)%N.
Hypotheses (splitF : group_splitting_field F S) (F'S : [char F]^'.-group S).

Let p_pr := extraspecial_prime pS esS.
Let p_gt0 := prime_gt0 p_pr.
Let p_gt1 := prime_gt1 p_pr.
Let oZp := card_center_extraspecial pS esS.

Let modIp' (i : 'I_p.-1) : (i.+1 %% p = i.+1)%N.
Proof. by case: i => i; rewrite /= -ltnS prednK //; exact: modn_small. Qed.

(* This is Aschbacher (34.9), parts (1)-(4). *)
Theorem extraspecial_repr_structure (sS : irrType F S) :
  [/\ #|linear_irr sS| = (p ^ n.*2)%N,
      exists iphi : 'I_p.-1 -> sS, let phi i := irr_repr (iphi i) in
        [/\ injective iphi,
            codom iphi =i ~: linear_irr sS,
            forall i, mx_faithful (phi i),
            forall z, z \in 'Z(S)^# ->
              exists2 w, primitive_root_of_unity p w
                       & forall i, phi i z = (w ^+ i.+1)%:M
          & forall i, irr_degree (iphi i) = (p ^ n)%N]
    & #|sS| = (p ^ n.*2 + p.-1)%N].
Proof.
have [[defPhiS defS'] prZ] := esS; set linS := linear_irr sS.
have nb_lin: #|linS| = (p ^ n.*2)%N.
  rewrite card_linear_irr // -divgS ?der_sub //=.
  by rewrite oSpn defS' oZp expnS mulKn.
have nb_irr: #|sS| = (p ^ n.*2 + p.-1)%N.
  pose Zcl := classes S ::&: 'Z(S).
  have cardZcl: #|Zcl| = p.
    transitivity #|[set [set z] | z in 'Z(S)]|; last first.
      by rewrite card_imset //; exact: set1_inj.
    apply: eq_card => zS; apply/setIdP/imsetP=> [[] | [z]].
      case/imsetP=> z Sz ->{zS} szSZ.
      have Zz: z \in 'Z(S) by rewrite (subsetP szSZ) ?class_refl.
      exists z => //; rewrite inE Sz in Zz.
      apply/eqP; rewrite eq_sym eqEcard sub1set class_refl cards1.
      by rewrite -index_cent1 (setIidPl _) ?indexgg // sub_cent1.
    case/setIP=> Sz cSz ->{zS}; rewrite sub1set inE Sz; split=> //.
    apply/imsetP; exists z; rewrite //.
    apply/eqP; rewrite eqEcard sub1set class_refl cards1.
    by rewrite -index_cent1 (setIidPl _) ?indexgg // sub_cent1.
  move/eqP: (class_formula S); rewrite (bigID (mem Zcl)) /=.
  rewrite (eq_bigr (fun _ => 1%N)) => [|zS]; last first.
    case/andP=> _ /setIdP[/imsetP[z Sz ->{zS}] /subsetIP[_ cSzS]].
    rewrite (setIidPl _) ?indexgg // sub_cent1 (subsetP cSzS) //.
    exact: mem_repr (class_refl S z).
  rewrite sum1dep_card setIdE (setIidPr _) 1?cardsE ?cardZcl; last first.
    by apply/subsetP=> zS; rewrite 2!inE => /andP[].
  have pn_gt0: p ^ n.*2 > 0 by rewrite expn_gt0 p_gt0.
  rewrite card_irr // oSpn expnS -(prednK pn_gt0) mulnS eqn_add2l.
  rewrite (eq_bigr (fun _ => p)) => [|xS]; last first.
    case/andP=> SxS; rewrite inE SxS; case/imsetP: SxS => x Sx ->{xS} notZxS.
    have [y Sy ->] := repr_class S x; apply: p_maximal_index => //.
    apply: cent1_extraspecial_maximal => //; first exact: groupJ.
    apply: contra notZxS => Zxy; rewrite -{1}(lcoset_id Sy) class_lcoset.
    rewrite ((_ ^: _ =P [set x ^ y])%g _) ?sub1set // eq_sym eqEcard.
    rewrite sub1set class_refl cards1 -index_cent1 (setIidPl _) ?indexgg //.
    by rewrite sub_cent1; apply: subsetP Zxy; exact: subsetIr.
  rewrite sum_nat_dep_const mulnC eqn_pmul2l //; move/eqP <-.
  rewrite addSnnS prednK // -cardZcl -[card _](cardsID Zcl) /= addnC.
  by congr (_ + _)%N; apply: eq_card => t; rewrite !inE andbC // andbAC andbb.
have fful_nlin i: i \in ~: linS -> mx_faithful (irr_repr i).
  rewrite !inE => nlin_phi.
  apply/trivgP; apply: (TI_center_nil (pgroup_nil pS) (rker_normal _)).
  rewrite setIC; apply: (prime_TIg prZ); rewrite /= -defS' der1_sub_rker //.
  exact: socle_irr.
have [i0 nlin_i0]: exists i0, i0 \in ~: linS.
  by apply/card_gt0P; rewrite cardsCs setCK nb_irr nb_lin addKn -subn1 subn_gt0.
have [z defZ]: exists z, 'Z(S) = <[z]> by apply/cyclicP; rewrite prime_cyclic.
have Zz: z \in 'Z(S) by [rewrite defZ cycle_id]; have [Sz cSz] := setIP Zz.
have ozp: #[z] = p by rewrite -oZp defZ.
have ntz: z != 1%g by rewrite -order_gt1 ozp.
pose phi := irr_repr i0; have irr_phi: mx_irreducible phi := socle_irr i0.
pose w := irr_mode i0 z.
have phi_z: phi z = w%:M by rewrite /phi irr_center_scalar.
have phi_ze e: phi (z ^+ e)%g = (w ^+ e)%:M.
  by rewrite /phi irr_center_scalar ?groupX ?irr_modeX.
have wp1: w ^+ p = 1 by rewrite -irr_modeX // -ozp expg_order irr_mode1.
have injw: {in 'Z(S) &, injective (irr_mode i0)}.
  move=> x y Zx Zy /= eq_xy; have [[Sx _] [Sy _]] := (setIP Zx, setIP Zy).
  apply: mx_faithful_inj (fful_nlin _ nlin_i0) _ _ Sx Sy _.
  by rewrite !{1}irr_center_scalar ?eq_xy; first by split.
have prim_w e: 0 < e < p -> p.-primitive_root (w ^+ e).
  case/andP=> e_gt0 lt_e_p; apply/andP; split=> //.
  apply/forallP=> [[d ltdp] /=]; apply/eqP; rewrite unity_rootE -exprM.
  rewrite -(irr_mode1 i0) -irr_modeX // (inj_in_eq injw) ?groupX ?group1 //.
  rewrite -order_dvdn ozp Euclid_dvdM // gtnNdvd //=.
  move: ltdp; rewrite leq_eqVlt.
  by case: eqP => [-> _ | _ ltd1p]; rewrite (dvdnn, gtnNdvd).
have /cyclicP[a defAutZ]: cyclic (Aut 'Z(S)) by rewrite Aut_prime_cyclic ?ozp.
have phi_unitP (i : 'I_p.-1): (i.+1%:R : 'Z_#[z]) \in GRing.unit.
  by rewrite unitZpE ?order_gt1 // ozp prime_coprime // -lt0n !modIp'.
pose ephi i := invm (injm_Zpm a) (Zp_unitm (FinRing.Unit _ (phi_unitP i))).
pose j : 'Z_#[z] := val (invm (injm_Zp_unitm z) a).
have co_j_p: coprime j p.
  rewrite coprime_sym /j; case: (invm _ a) => /=.
  by rewrite ozp /GRing.unit /= Zp_cast.
have [alpha Aut_alpha alphaZ] := center_aut_extraspecial pS esS co_j_p.
have alpha_i_z i: ((alpha ^+ ephi i) z = z ^+ i.+1)%g.
  transitivity ((a ^+ ephi i) z)%g.
    elim: (ephi i : nat) => // e IHe; rewrite !expgS !permM alphaZ //.
    have Aut_a: a \in Aut 'Z(S) by rewrite defAutZ cycle_id.
    rewrite -{2}[a](invmK (injm_Zp_unitm z)); last by rewrite im_Zp_unitm -defZ.
    rewrite /= autE ?cycle_id // -/j /= /cyclem.
    rewrite -(autmE (groupX _ Aut_a)) -(autmE (groupX _ Aut_alpha)).
    by rewrite !morphX //= !autmE IHe.
  rewrite [(a ^+ _)%g](invmK (injm_Zpm a)) /=; last first.
    by rewrite im_Zpm -defAutZ defZ Aut_aut.
  by rewrite autE ?cycle_id //= val_Zp_nat ozp ?modIp'.
have rphiP i: S :==: autm (groupX (ephi i) Aut_alpha) @* S by rewrite im_autm.
pose rphi i := morphim_repr (eqg_repr phi (rphiP i)) (subxx S).
have rphi_irr i: mx_irreducible (rphi i).
  by apply/morphim_mx_irr; exact/eqg_mx_irr.
have rphi_fful i: mx_faithful (rphi i).
  rewrite /mx_faithful rker_morphim rker_eqg.
  by rewrite (trivgP (fful_nlin _ nlin_i0)) morphpreIdom; exact: injm_autm.
have rphi_z i: rphi i z = (w ^+ i.+1)%:M.
  by rewrite /rphi [phi]lock /= /morphim_mx autmE alpha_i_z -lock phi_ze.
pose iphi i := irr_comp sS (rphi i); pose phi_ i := irr_repr (iphi i).
have{phi_ze} phi_ze i e: phi_ i (z ^+ e)%g = (w ^+ (e * i.+1)%N)%:M.
  rewrite /phi_ !{1}irr_center_scalar ?groupX ?irr_modeX //.
  suffices ->: irr_mode (iphi i) z = w ^+ i.+1 by rewrite mulnC exprM.
  have:= mx_rsim_sym (rsim_irr_comp sS F'S (rphi_irr i)).
  case/mx_rsim_def=> B [B' _ homB]; rewrite /irr_mode homB // rphi_z.
  rewrite -{1}scalemx1 -scalemxAr -scalemxAl -{1}(repr_mx1 (rphi i)).
  by rewrite -homB // repr_mx1 scalemx1 mxE.
have inj_iphi: injective iphi.
  move=> i1 i2 eqi12; apply/eqP.
  move/eqP: (congr1 (fun i => irr_mode i (z ^+ 1)) eqi12).
  rewrite /irr_mode !{1}[irr_repr _ _]phi_ze !{1}mxE !mul1n.
  by rewrite (eq_prim_root_expr (prim_w 1%N p_gt1)) !modIp'.
have deg_phi i: irr_degree (iphi i) = irr_degree i0.
  by case: (rsim_irr_comp sS F'S (rphi_irr i)).
have im_iphi: codom iphi =i ~: linS.
  apply/subset_cardP; last apply/subsetP=> _ /codomP[i ->].
    by rewrite card_image // card_ord cardsCs setCK nb_irr nb_lin addKn.
  by rewrite !inE /= (deg_phi i) in nlin_i0 *.
split=> //; exists iphi; rewrite -/phi_.
split=> // [i | ze | i].
- have sim_i := rsim_irr_comp sS F'S (rphi_irr i).
  by rewrite -(mx_rsim_faithful sim_i) rphi_fful.
- rewrite {1}defZ 2!inE andbC; case/andP.
  case/cyclePmin=> e; rewrite ozp => lt_e_p ->{ze}.
  case: (posnP e) => [-> | e_gt0 _]; first by rewrite eqxx.
  exists (w ^+ e) => [|i]; first by rewrite prim_w ?e_gt0.
  by rewrite phi_ze exprM.
rewrite deg_phi {i}; set d := irr_degree i0.
apply/eqP; move/eqP: (sum_irr_degree sS F'S splitF).
rewrite (bigID (mem linS)) /= -/irr_degree.
rewrite (eq_bigr (fun _ => 1%N)) => [|i]; last by rewrite !inE; move/eqP->.
rewrite sum1_card nb_lin.
rewrite (eq_bigl (mem (codom iphi))) // => [|i]; last first.
  by rewrite -in_setC -im_iphi.
rewrite (eq_bigr (fun _ => d ^ 2))%N => [|_ /codomP[i ->]]; last first.
  by rewrite deg_phi.
rewrite sum_nat_const card_image // card_ord oSpn (expnS p) -{3}[p]prednK //.
rewrite mulSn eqn_add2l eqn_pmul2l; last by rewrite -ltnS prednK.
by rewrite -muln2 expnM eqn_sqr.
Qed.

(* This is the corolloray of the above that is actually used in the proof of  *)
(* B & G, Theorem 2.5. It encapsulates the dependency on a socle of the       *)
(* regular representation.                                                    *)

Variables (m : nat) (rS : mx_representation F S m) (U : 'M[F]_m).
Hypotheses (simU :  mxsimple rS U) (ffulU : rstab rS U == 1%g).
Let sZS := center_sub S.
Let rZ := subg_repr rS sZS.

Lemma faithful_repr_extraspecial :
 \rank U = (p ^ n)%N /\
   (forall V, mxsimple rS V -> mx_iso rZ U V -> mx_iso rS U V).
Proof.
suffices IH V: mxsimple rS V -> mx_iso rZ U V ->
  [&& \rank U == (p ^ n)%N & mxsimple_iso rS U V].
- split=> [|/= V simV isoUV].
    by case/andP: (IH U simU (mx_iso_refl _ _)) => /eqP.
  by case/andP: (IH V simV isoUV) => _ /(mxsimple_isoP simU).
move=> simV isoUV; wlog sS: / irrType F S by exact: socle_exists.
have [[_ defS'] prZ] := esS.
have{prZ} ntZ: 'Z(S) :!=: 1%g by case: eqP prZ => // ->; rewrite cards1.
have [_ [iphi]] := extraspecial_repr_structure sS.
set phi := fun i => _ => [] [inj_phi im_phi _ phiZ dim_phi] _.
have [modU nzU _]:= simU; pose rU := submod_repr modU.
have nlinU: \rank U != 1%N.
  apply/eqP=> /(rker_linear rU); apply/negP; rewrite /rker rstab_submod.
  by rewrite (eqmx_rstab _ (val_submod1 _)) (eqP ffulU) defS' subG1.
have irrU: mx_irreducible rU by exact/submod_mx_irr.
have rsimU := rsim_irr_comp sS F'S irrU.
set iU := irr_comp sS rU in rsimU; have [_ degU _ _]:= rsimU.
have phiUP: iU \in codom iphi by rewrite im_phi !inE -degU.
rewrite degU -(f_iinv phiUP) dim_phi eqxx /=; apply/(mxsimple_isoP simU).
have [modV _ _]:= simV; pose rV := submod_repr modV.
have irrV: mx_irreducible rV by exact/submod_mx_irr.
have rsimV := rsim_irr_comp sS F'S irrV.
set iV := irr_comp sS rV in rsimV; have [_ degV _ _]:= rsimV.
have phiVP: iV \in codom iphi by rewrite im_phi !inE -degV -(mxrank_iso isoUV).
pose jU := iinv phiUP; pose jV := iinv phiVP.
have [z Zz ntz]:= trivgPn _ ntZ.
have [|w prim_w phi_z] := phiZ z; first by rewrite 2!inE ntz.
suffices eqjUV: jU == jV.
  apply/(mx_rsim_iso modU modV); apply: mx_rsim_trans rsimU _.
  by rewrite -(f_iinv phiUP) -/jU (eqP eqjUV) f_iinv; exact: mx_rsim_sym.
have rsimUV: mx_rsim (subg_repr (phi jU) sZS) (subg_repr (phi jV) sZS).
  have [bU _ bUfree bUhom] := mx_rsim_sym rsimU.
  have [bV _ bVfree bVhom] := rsimV.
  have modUZ := mxmodule_subg sZS modU; have modVZ := mxmodule_subg sZS modV.
  case/(mx_rsim_iso modUZ modVZ): isoUV => [bZ degZ bZfree bZhom].
  rewrite /phi !f_iinv; exists (bU *m bZ *m bV)=> [||x Zx].
  - by rewrite -degU degZ degV.
  - by rewrite /row_free !mxrankMfree.
  have Sx := subsetP sZS x Zx.
  by rewrite 2!mulmxA bUhom // -(mulmxA _ _ bZ) bZhom // -4!mulmxA bVhom.
have{rsimUV} [B [B' _ homB]] := mx_rsim_def rsimUV.
have:= eqxx (irr_mode (iphi jU) z); rewrite /irr_mode; set i0 := Ordinal _.
rewrite {2}[_ z]homB // ![_ z]phi_z mxE mulr1n -scalemx1 -scalemxAr -scalemxAl.
rewrite -(repr_mx1 (subg_repr (phi jV) sZS)) -{B B'}homB // repr_mx1 scalemx1.
by rewrite mxE (eq_prim_root_expr prim_w) !modIp'.
Qed.

End Extraspecial.