[System] You are Leanstral, a Lean 4 proof assistant. Complete the task below using the provided Lean source context. The target mathlib commit is 5e932f97dd25535344f80f9dd8da3aab83df0fe6 (module Mathlib.GroupTheory.GroupAction.SubMulAction.Combination).

[User]
Prove the following theorem. The retrieved context below may help.

```lean
theorem mulActionHom_compl_bijective :
    Function.Bijective (mulActionHom_compl G α hm)
```

## Retrieved context
-- snippet 1
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.subMulAction (L58-L61)
def subMulAction : SubMulAction G (Finset α) where
  carrier := Set.powersetCard α n
smul_mem' g s := (Finset.card_smul_finset g s).trans
```

-- snippet 2
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.coe_smul (L69-L72)
theorem coe_smul {n : ℕ} {g : G} {s : powersetCard α n} :
    ((g • s : powersetCard α n) : Finset α) = g • s :=
SubMulAction.val_smul (p := subMulAction G α n) g s
```

-- snippet 3
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.stabilizer_coe (L74-L78)
theorem stabilizer_coe {n : ℕ} (s : powersetCard α n) :
    stabilizer G s = stabilizer G (s : Set α) := by
ext g
  simp [mem_stabilizer_iff, ← Subtype.coe_inj, ← Finset.coe_inj]
```

-- snippet 4
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.addAction_faithful (L79-L98)
theorem addAction_faithful {G : Type*} [AddGroup G] [AddAction G α] {n : ℕ}
    (hn : 1 ≤ n) (hα : n < ENat.card α) {g : G} :
    AddAction.toPerm g = (1 : Perm (powersetCard α n)) ↔ AddAction.toPerm g = (1 : Perm α) := by
refine ⟨fun h ↦ ?_, fun h ↦ ?_⟩
  · contrapose h with h
    have : ∃ a, (g +ᵥ a : α) ≠ a := by simpa [Equiv.ext_iff] using h
    obtain ⟨a, ha⟩ := this
    obtain ⟨s, has, has'⟩ := exists_mem_notMem hn hα (Ne.symm ha)
    rw [Equiv.ext_iff, not_forall]
    use s
    contrapose! has'
    simp only [AddAction.toPerm_apply, coe_one, id_eq] at has'
    rw [← has']
    simpa [← mem_coe_iff]
  · simp only [Equiv.ext_iff, AddAction.toPerm_apply] at h ⊢
    simp [Subtype.ext_iff, Finset.ext_iff, mem_vadd_finset, h]

/-- If an additive group `G` acts faithfully on `α`,
then it acts faithfully on `powersetCard α n`,
provided `1 ≤ n < ENat.card α`. -/
```

-- snippet 5
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.faithfulVAdd (L99-L107)
theorem faithfulVAdd {G : Type*} [AddGroup G] [AddAction G α] {n : ℕ}
    (hn : 1 ≤ n) (hα : n < ENat.card α) [FaithfulVAdd G α] :
    FaithfulVAdd G (powersetCard α n) := by
rw [faithfulVAdd_iff]
  intro g hg
  apply AddAction.toPerm_injective (α := G) (β := α)
  rw [AddAction.toPerm_zero, ← addAction_faithful hn hα]
  exact Perm.ext_iff.mpr hg
```

-- snippet 6
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.mulAction_faithful (L108-L125)
theorem mulAction_faithful (hn : 1 ≤ n) (hα : n < ENat.card α) {g : G} :
    MulAction.toPerm g = (1 : Perm (powersetCard α n)) ↔ MulAction.toPerm g = (1 : Perm α) := by
refine ⟨fun h ↦ ?_, fun h ↦ ?_⟩
  · contrapose h with h
    have : ∃ a, (g • a : α) ≠ a := by simpa [Equiv.ext_iff] using h
    obtain ⟨a, ha⟩ := this
    obtain ⟨s, has, has'⟩ := exists_mem_notMem hn hα (Ne.symm ha)
    rw [Equiv.ext_iff, not_forall]
    use s
    contrapose! has'
    simp only [MulAction.toPerm_apply, coe_one, id_eq] at has'
    rw [← has']
    simpa only [coe_smul, smul_mem_smul_finset_iff, ← mem_coe_iff]
  · simp only [Equiv.ext_iff, MulAction.toPerm_apply] at h ⊢
    simp [Subtype.ext_iff, Finset.ext_iff, mem_smul_finset, h]

/-- If a group `G` acts faithfully on `α`, then
it acts faithfully on `powersetCard α n` provided `1 ≤ n < ENat.card α`. -/
```

-- snippet 7
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.faithfulSMul (L126-L133)
theorem faithfulSMul (hn : 1 ≤ n) (hα : n < ENat.card α) [FaithfulSMul G α] :
    FaithfulSMul G (powersetCard α n) := by
rw [faithfulSMul_iff]
  intro g hg
  apply MulAction.toPerm_injective (α := G) (β := α)
  rw [MulAction.toPerm_one, ← mulAction_faithful hn hα]
  exact Perm.ext_iff.mpr hg
```

-- snippet 8
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.mulActionHom_of_embedding (L142-L148)
def mulActionHom_of_embedding : (Fin n ↪ α) →[G] powersetCard α n where
  toFun := ofFinEmb n α
map_smul' g f := by
    rw [← Subtype.coe_inj, coe_smul, f.smul_def, val_ofFinEmb, val_ofFinEmb,
      Finset.smul_finset_def, ← Finset.map_map, Finset.map_eq_image]
    simp [toPerm]
```

-- snippet 9
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.coe_mulActionHom_of_embedding (L150-L153)
theorem coe_mulActionHom_of_embedding (f : Fin n ↪ α) :
    ↑((mulActionHom_of_embedding G α n).toFun f) = Finset.univ.map f :=
rfl
```

-- snippet 10
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.mulActionHom_of_embedding_surjective (L155-L161)
theorem mulActionHom_of_embedding_surjective :
    Function.Surjective (mulActionHom_of_embedding G α n) := by
intro ⟨s, hs⟩
  obtain ⟨f : Fin n ↪ α, hf⟩ :=
    Function.Embedding.exists_of_card_eq_finset (by rw [hs, Fintype.card_fin])
  exact ⟨f, Subtype.ext hf⟩
```

-- snippet 11
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.isPretransitive_of_isMultiplyPretransitive (L167-L170)
theorem isPretransitive_of_isMultiplyPretransitive (h : IsMultiplyPretransitive G α n) :
    IsPretransitive G (powersetCard α n) :=
IsPretransitive.of_surjective_map (mulActionHom_of_embedding_surjective G α) h
```

-- snippet 12
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.isPretransitive (L171-L181)
theorem isPretransitive : IsPretransitive (Perm α) (powersetCard α n) :=
isPretransitive_of_isMultiplyPretransitive _ (isMultiplyPretransitive α n)

section compl

variable (α)

variable [Fintype α] {m : ℕ} (hm : m + n = Fintype.card α)
include hm

/-- The complement of a combination, as an equivariant map. -/
```

-- snippet 13
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.mulActionHom_compl (L182-L186)
def mulActionHom_compl : powersetCard α n →[G] powersetCard α m where
  toFun := compl hm
map_smul' g s := by ext; simp [← Finset.inv_smul_mem_iff]

variable {hm} in
```

-- snippet 14
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.coe_mulActionHom_compl (L187-L191)
theorem coe_mulActionHom_compl {s : powersetCard α n} :
    (mulActionHom_compl G α hm s : Finset α) = (s : Finset α)ᶜ :=
rfl

variable {hm} in
```

-- snippet 15
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.mem_mulActionHom_compl (L192-L195)
theorem mem_mulActionHom_compl {s : powersetCard α n} {a : α} :
    a ∈ mulActionHom_compl G α hm s ↔ a ∉ s :=
Finset.mem_compl
```

-- snippet 16
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer_one (L279-L282)
theorem stabilizerEquivStabilizer_one :
    stabilizerEquivStabilizer (one_smul G a).symm = MulEquiv.refl (stabilizer G a) := by
ext; simp [stabilizerEquivStabilizer_apply]
```

-- snippet 17
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.orbitRel_le_snd (L232-L239)
lemma orbitRel_le_snd :
    orbitRel G (α × β) ≤ (orbitRel G β).comap Prod.snd :=
Setoid.le_def.2 snd_mem_orbit_of_mem_orbit

end Orbit

section Stabilizer
```

-- snippet 18
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizer_smul_eq_stabilizer_map_conj (L251-L259)
theorem stabilizer_smul_eq_stabilizer_map_conj (g : G) (a : α) :
    stabilizer G (g • a) = (stabilizer G a).map (MulAut.conj g).toMonoidHom := by
ext h
  rw [mem_stabilizer_iff, ← smul_left_cancel_iff g⁻¹, smul_smul, smul_smul, smul_smul,
    inv_mul_cancel, one_smul, ← mem_stabilizer_iff, Subgroup.mem_map_equiv, MulAut.conj_symm_apply]

variable {g h k : G} {a b c : α}

/-- The natural group equivalence between the stabilizers of two elements in the same orbit. -/
```

-- snippet 19
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer (L260-L264)
def stabilizerEquivStabilizer (hg : b = g • a) : stabilizer G a ≃* stabilizer G b :=
((MulAut.conj g).subgroupMap (stabilizer G a)).trans
    (MulEquiv.subgroupCongr (by
      rw [hg, stabilizer_smul_eq_stabilizer_map_conj g a, ← MulEquiv.toMonoidHom_eq_coe]))
```

-- snippet 20
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer_inv (L288-L306)
theorem stabilizerEquivStabilizer_inv (hg : b = g⁻¹ • a) :
    stabilizerEquivStabilizer hg =
      (stabilizerEquivStabilizer (inv_smul_eq_iff.mp hg.symm)).symm := by
ext; simp [stabilizerEquivStabilizer]

/-- A bijection between the stabilizers of two elements in the same orbit. -/
noncomputable def stabilizerEquivStabilizerOfOrbitRel (h : orbitRel G α a b) :
    stabilizer G a ≃* stabilizer G b :=
  (stabilizerEquivStabilizer (Classical.choose_spec h).symm).symm

end Stabilizer

end MulAction

namespace AddAction
variable {G α : Type*} [AddGroup G] [AddAction G α]

variable {g h k : G} {a b c : α}
/-- If the stabilizer of `x` is `S`, then the stabilizer of `g +ᵥ x` is `g + S + (-g)`. -/
```

-- snippet 21
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.fst_mem_orbit_of_mem_orbit (L51-L55)
lemma fst_mem_orbit_of_mem_orbit {x y : α × β} (h : x ∈ MulAction.orbit M y) :
    x.1 ∈ MulAction.orbit M y.1 := by
rcases h with ⟨g, rfl⟩
  exact mem_orbit _ _
```

-- snippet 22
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.pretransitive_iff_subsingleton_quotient (L179-L188)
theorem pretransitive_iff_subsingleton_quotient :
    IsPretransitive G α ↔ Subsingleton (orbitRel.Quotient G α) := by
refine ⟨fun _ ↦ ⟨fun a b ↦ ?_⟩, fun _ ↦ ⟨fun a b ↦ ?_⟩⟩
  · refine Quot.inductionOn a (fun x ↦ ?_)
    exact Quot.inductionOn b (fun y ↦ Quot.sound <| exists_smul_eq G y x)
  · have h : Quotient.mk (orbitRel G α) b = ⟦a⟧ := Subsingleton.elim _ _
    exact Quotient.eq''.mp h

/-- If `α` is non-empty, an action is pretransitive if and only if the quotient has exactly one
element. -/
```

-- snippet 23
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.orbitRel_subgroupOf (L155-L176)
lemma orbitRel_subgroupOf (H K : Subgroup G) :
    orbitRel (H.subgroupOf K) α = orbitRel (H ⊓ K : Subgroup G) α := by
rw [← Subgroup.subgroupOf_map_subtype]
  ext x
  simp_rw [orbitRel_apply]
  refine ⟨fun h ↦ ?_, fun h ↦ ?_⟩
  · rcases h with ⟨⟨gv, gp⟩, rfl⟩
    simp only
    refine mem_orbit _ (⟨gv, ?_⟩ : Subgroup.map K.subtype (H.subgroupOf K))
    simpa using gp
  · rcases h with ⟨⟨gv, gp⟩, rfl⟩
    simp only
    simp only [Subgroup.subgroupOf_map_subtype, Subgroup.mem_inf] at gp
    refine mem_orbit _ (⟨⟨gv, ?_⟩, ?_⟩ : H.subgroupOf K)
    · exact gp.2
    · simp only [Subgroup.mem_subgroupOf]
      exact gp.1

variable (G α)

/-- An action is pretransitive if and only if the quotient by `MulAction.orbitRel` is a
subsingleton. -/
```

-- snippet 24
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer_symm_apply (L269-L272)
theorem stabilizerEquivStabilizer_symm_apply (hg : b = g • a) (x : stabilizer G b) :
    (stabilizerEquivStabilizer hg).symm x = MulAut.conj g⁻¹ x := by
simp [stabilizerEquivStabilizer]
```

-- snippet 25
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.pretransitive_iff_unique_quotient_of_nonempty (L191-L198)
theorem pretransitive_iff_unique_quotient_of_nonempty [Nonempty α] :
    IsPretransitive G α ↔ Nonempty (Unique <| orbitRel.Quotient G α) := by
rw [unique_iff_subsingleton_and_nonempty, pretransitive_iff_subsingleton_quotient, iff_self_and]
  exact fun _ ↦ (nonempty_quotient_iff _).mpr inferInstance

variable {G α}

set_option backward.isDefEq.respectTransparency false in
```

-- snippet 26
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer_zero (L336-L339)
theorem stabilizerEquivStabilizer_zero :
    stabilizerEquivStabilizer (zero_vadd G a).symm = AddEquiv.refl (stabilizer G a) := by
ext; simp [stabilizerEquivStabilizer_apply]
```

-- snippet 27
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.orbitRel_subgroup_le (L151-L153)
lemma orbitRel_subgroup_le (H : Subgroup G) : orbitRel H α ≤ orbitRel G α :=
Setoid.le_def.2 mem_orbit_of_mem_orbit_subgroup
```

-- snippet 28
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizer_vadd_eq_stabilizer_map_conj (L307-L316)
theorem stabilizer_vadd_eq_stabilizer_map_conj (g : G) (a : α) :
    stabilizer G (g +ᵥ a) = (stabilizer G a).map (AddAut.conj g).toMul.toAddMonoidHom := by
ext h
  rw [mem_stabilizer_iff, ← vadd_left_cancel_iff (-g), vadd_vadd, vadd_vadd, vadd_vadd,
    neg_add_cancel, zero_vadd, ← mem_stabilizer_iff, AddSubgroup.mem_map_equiv,
    AddAut.conj_symm_apply]

variable {g h k : G} {a b c : α}

/-- The natural group equivalence between the stabilizers of two elements in the same orbit. -/
```

-- snippet 29
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer_trans (L273-L278)
theorem stabilizerEquivStabilizer_trans (hg : b = g • a) (hh : c = h • b) (hk : c = k • a)
    (H : k = h * g) :
    (stabilizerEquivStabilizer hg).trans (stabilizerEquivStabilizer hh) =
      stabilizerEquivStabilizer hk := by
ext; simp [stabilizerEquivStabilizer_apply, H]
```

-- snippet 30
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer_symm (L283-L287)
theorem stabilizerEquivStabilizer_symm (hg : b = g • a) :
    (stabilizerEquivStabilizer hg).symm =
      stabilizerEquivStabilizer (eq_inv_smul_iff.mpr hg.symm) := by
ext x; simp [stabilizerEquivStabilizer]
```

-- snippet 31
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.nontrivial_of_fixedPoints_ne_univ (L126-L133)
theorem nontrivial_of_fixedPoints_ne_univ (h : fixedPoints G α ≠ .univ) :
    Nontrivial α :=
(subsingleton_or_nontrivial α).resolve_left fun _ ↦ h fixedPoints_of_subsingleton

section Orbit

-- TODO: This proof is redoing a special case of `MulAction.IsInvariantBlock.isBlock`. Can we move
-- this lemma earlier to golf?
```

-- snippet 32
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.orbit_eq_univ (L69-L77)
theorem orbit_eq_univ [IsPretransitive M α] (a : α) : orbit M a = Set.univ :=
(surjective_smul M a).range_eq

end Orbit

section FixedPoints

variable {M α}
```

-- snippet 33
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.subsingleton_orbit_iff_mem_fixedPoints (L79-L86)
theorem subsingleton_orbit_iff_mem_fixedPoints {a : α} :
    (orbit M a).Subsingleton ↔ a ∈ fixedPoints M α := by
rw [mem_fixedPoints]
  constructor
  · exact fun h m ↦ h (mem_orbit a m) (mem_orbit_self a)
  · rintro h _ ⟨m, rfl⟩ y ⟨p, rfl⟩
    simp only [h]
```

-- snippet 34
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.mem_fixedPoints_iff_card_orbit_eq_one (L88-L93)
theorem mem_fixedPoints_iff_card_orbit_eq_one {a : α} [Fintype (orbit M a)] :
    a ∈ fixedPoints M α ↔ Fintype.card (orbit M a) = 1 := by
simp only [← subsingleton_orbit_iff_mem_fixedPoints, le_antisymm_iff,
    Fintype.card_le_one_iff_subsingleton, Nat.add_one_le_iff, Fintype.card_pos_iff,
    Set.subsingleton_coe, iff_self_and, Set.nonempty_coe_sort, nonempty_orbit, implies_true]
```

-- snippet 35
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer_apply (L265-L268)
theorem stabilizerEquivStabilizer_apply (hg : b = g • a) (x : stabilizer G a) :
    stabilizerEquivStabilizer hg x = MulAut.conj g x := by
simp [stabilizerEquivStabilizer]
```

-- snippet 36
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.smul_cancel_of_non_zero_divisor (L107-L116)
theorem smul_cancel_of_non_zero_divisor {M G : Type*} [Monoid M] [AddGroup G]
    [DistribMulAction M G] (k : M) (h : ∀ x : G, k • x = 0 → x = 0) {a b : G} (h' : k • a = k • b) :
    a = b := by
rw [← sub_eq_zero]
  refine h _ ?_
  rw [smul_sub, h', sub_self]

namespace MulAction
variable {G α β : Type*} [Group G] [MulAction G α] [MulAction G β]
```

-- snippet 37
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.snd_mem_orbit_of_mem_orbit (L57-L61)
lemma snd_mem_orbit_of_mem_orbit {x y : α × β} (h : x ∈ MulAction.orbit M y) :
    x.2 ∈ MulAction.orbit M y.2 := by
rcases h with ⟨g, rfl⟩
  exact mem_orbit _ _
```

-- snippet 38
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.orbitRel_le_fst (L227-L230)
lemma orbitRel_le_fst :
    orbitRel G (α × β) ≤ (orbitRel G α).comap Prod.fst :=
Setoid.le_def.2 fst_mem_orbit_of_mem_orbit
```

-- snippet 39
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer_neg (L345-L356)
theorem stabilizerEquivStabilizer_neg (hg : b = -g +ᵥ a) :
    stabilizerEquivStabilizer hg =
      (stabilizerEquivStabilizer (neg_vadd_eq_iff.mp hg.symm)).symm := by
ext; simp [stabilizerEquivStabilizer]

/-- A bijection between the stabilizers of two elements in the same orbit. -/
noncomputable def stabilizerEquivStabilizerOfOrbitRel (h : orbitRel G α a b) :
    stabilizer G a ≃+ stabilizer G b :=
  (stabilizerEquivStabilizer (Classical.choose_spec h).symm).symm

end AddAction
```

-- snippet 40
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.smul_orbit (L135-L141)
theorem smul_orbit (g : G) (a : α) : g • orbit G a = orbit G a :=
(smul_orbit_subset g a).antisymm <|
    calc
      orbit G a = g • g⁻¹ • orbit G a := (smul_inv_smul _ _).symm
      _ ⊆ g • orbit G a := Set.image_mono (smul_orbit_subset _ _)

/-- The action of a group on an orbit is transitive. -/
```

<s>[SYSTEM_PROMPT]You are Leanstral, a Lean 4 proof assistant. Complete the task below using the provided Lean source context. The target mathlib commit is 5e932f97dd25535344f80f9dd8da3aab83df0fe6 (module Mathlib.GroupTheory.GroupAction.SubMulAction.Combination).[/SYSTEM_PROMPT][MODEL_SETTINGS]{"reasoning_effort": "none"}[/MODEL_SETTINGS][INST]Prove the following theorem. The retrieved context below may help.

```lean
theorem mulActionHom_compl_bijective :
    Function.Bijective (mulActionHom_compl G α hm)
```

## Retrieved context
-- snippet 1
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.subMulAction (L58-L61)
def subMulAction : SubMulAction G (Finset α) where
  carrier := Set.powersetCard α n
smul_mem' g s := (Finset.card_smul_finset g s).trans
```

-- snippet 2
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.coe_smul (L69-L72)
theorem coe_smul {n : ℕ} {g : G} {s : powersetCard α n} :
    ((g • s : powersetCard α n) : Finset α) = g • s :=
SubMulAction.val_smul (p := subMulAction G α n) g s
```

-- snippet 3
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.stabilizer_coe (L74-L78)
theorem stabilizer_coe {n : ℕ} (s : powersetCard α n) :
    stabilizer G s = stabilizer G (s : Set α) := by
ext g
  simp [mem_stabilizer_iff, ← Subtype.coe_inj, ← Finset.coe_inj]
```

-- snippet 4
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.addAction_faithful (L79-L98)
theorem addAction_faithful {G : Type*} [AddGroup G] [AddAction G α] {n : ℕ}
    (hn : 1 ≤ n) (hα : n < ENat.card α) {g : G} :
    AddAction.toPerm g = (1 : Perm (powersetCard α n)) ↔ AddAction.toPerm g = (1 : Perm α) := by
refine ⟨fun h ↦ ?_, fun h ↦ ?_⟩
  · contrapose h with h
    have : ∃ a, (g +ᵥ a : α) ≠ a := by simpa [Equiv.ext_iff] using h
    obtain ⟨a, ha⟩ := this
    obtain ⟨s, has, has'⟩ := exists_mem_notMem hn hα (Ne.symm ha)
    rw [Equiv.ext_iff, not_forall]
    use s
    contrapose! has'
    simp only [AddAction.toPerm_apply, coe_one, id_eq] at has'
    rw [← has']
    simpa [← mem_coe_iff]
  · simp only [Equiv.ext_iff, AddAction.toPerm_apply] at h ⊢
    simp [Subtype.ext_iff, Finset.ext_iff, mem_vadd_finset, h]

/-- If an additive group `G` acts faithfully on `α`,
then it acts faithfully on `powersetCard α n`,
provided `1 ≤ n < ENat.card α`. -/
```

-- snippet 5
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.faithfulVAdd (L99-L107)
theorem faithfulVAdd {G : Type*} [AddGroup G] [AddAction G α] {n : ℕ}
    (hn : 1 ≤ n) (hα : n < ENat.card α) [FaithfulVAdd G α] :
    FaithfulVAdd G (powersetCard α n) := by
rw [faithfulVAdd_iff]
  intro g hg
  apply AddAction.toPerm_injective (α := G) (β := α)
  rw [AddAction.toPerm_zero, ← addAction_faithful hn hα]
  exact Perm.ext_iff.mpr hg
```

-- snippet 6
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.mulAction_faithful (L108-L125)
theorem mulAction_faithful (hn : 1 ≤ n) (hα : n < ENat.card α) {g : G} :
    MulAction.toPerm g = (1 : Perm (powersetCard α n)) ↔ MulAction.toPerm g = (1 : Perm α) := by
refine ⟨fun h ↦ ?_, fun h ↦ ?_⟩
  · contrapose h with h
    have : ∃ a, (g • a : α) ≠ a := by simpa [Equiv.ext_iff] using h
    obtain ⟨a, ha⟩ := this
    obtain ⟨s, has, has'⟩ := exists_mem_notMem hn hα (Ne.symm ha)
    rw [Equiv.ext_iff, not_forall]
    use s
    contrapose! has'
    simp only [MulAction.toPerm_apply, coe_one, id_eq] at has'
    rw [← has']
    simpa only [coe_smul, smul_mem_smul_finset_iff, ← mem_coe_iff]
  · simp only [Equiv.ext_iff, MulAction.toPerm_apply] at h ⊢
    simp [Subtype.ext_iff, Finset.ext_iff, mem_smul_finset, h]

/-- If a group `G` acts faithfully on `α`, then
it acts faithfully on `powersetCard α n` provided `1 ≤ n < ENat.card α`. -/
```

-- snippet 7
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.faithfulSMul (L126-L133)
theorem faithfulSMul (hn : 1 ≤ n) (hα : n < ENat.card α) [FaithfulSMul G α] :
    FaithfulSMul G (powersetCard α n) := by
rw [faithfulSMul_iff]
  intro g hg
  apply MulAction.toPerm_injective (α := G) (β := α)
  rw [MulAction.toPerm_one, ← mulAction_faithful hn hα]
  exact Perm.ext_iff.mpr hg
```

-- snippet 8
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.mulActionHom_of_embedding (L142-L148)
def mulActionHom_of_embedding : (Fin n ↪ α) →[G] powersetCard α n where
  toFun := ofFinEmb n α
map_smul' g f := by
    rw [← Subtype.coe_inj, coe_smul, f.smul_def, val_ofFinEmb, val_ofFinEmb,
      Finset.smul_finset_def, ← Finset.map_map, Finset.map_eq_image]
    simp [toPerm]
```

-- snippet 9
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.coe_mulActionHom_of_embedding (L150-L153)
theorem coe_mulActionHom_of_embedding (f : Fin n ↪ α) :
    ↑((mulActionHom_of_embedding G α n).toFun f) = Finset.univ.map f :=
rfl
```

-- snippet 10
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.mulActionHom_of_embedding_surjective (L155-L161)
theorem mulActionHom_of_embedding_surjective :
    Function.Surjective (mulActionHom_of_embedding G α n) := by
intro ⟨s, hs⟩
  obtain ⟨f : Fin n ↪ α, hf⟩ :=
    Function.Embedding.exists_of_card_eq_finset (by rw [hs, Fintype.card_fin])
  exact ⟨f, Subtype.ext hf⟩
```

-- snippet 11
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.isPretransitive_of_isMultiplyPretransitive (L167-L170)
theorem isPretransitive_of_isMultiplyPretransitive (h : IsMultiplyPretransitive G α n) :
    IsPretransitive G (powersetCard α n) :=
IsPretransitive.of_surjective_map (mulActionHom_of_embedding_surjective G α) h
```

-- snippet 12
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.isPretransitive (L171-L181)
theorem isPretransitive : IsPretransitive (Perm α) (powersetCard α n) :=
isPretransitive_of_isMultiplyPretransitive _ (isMultiplyPretransitive α n)

section compl

variable (α)

variable [Fintype α] {m : ℕ} (hm : m + n = Fintype.card α)
include hm

/-- The complement of a combination, as an equivariant map. -/
```

-- snippet 13
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.mulActionHom_compl (L182-L186)
def mulActionHom_compl : powersetCard α n →[G] powersetCard α m where
  toFun := compl hm
map_smul' g s := by ext; simp [← Finset.inv_smul_mem_iff]

variable {hm} in
```

-- snippet 14
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.coe_mulActionHom_compl (L187-L191)
theorem coe_mulActionHom_compl {s : powersetCard α n} :
    (mulActionHom_compl G α hm s : Finset α) = (s : Finset α)ᶜ :=
rfl

variable {hm} in
```

-- snippet 15
```lean
-- Mathlib.GroupTheory.GroupAction.SubMulAction.Combination.mem_mulActionHom_compl (L192-L195)
theorem mem_mulActionHom_compl {s : powersetCard α n} {a : α} :
    a ∈ mulActionHom_compl G α hm s ↔ a ∉ s :=
Finset.mem_compl
```

-- snippet 16
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer_one (L279-L282)
theorem stabilizerEquivStabilizer_one :
    stabilizerEquivStabilizer (one_smul G a).symm = MulEquiv.refl (stabilizer G a) := by
ext; simp [stabilizerEquivStabilizer_apply]
```

-- snippet 17
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.orbitRel_le_snd (L232-L239)
lemma orbitRel_le_snd :
    orbitRel G (α × β) ≤ (orbitRel G β).comap Prod.snd :=
Setoid.le_def.2 snd_mem_orbit_of_mem_orbit

end Orbit

section Stabilizer
```

-- snippet 18
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizer_smul_eq_stabilizer_map_conj (L251-L259)
theorem stabilizer_smul_eq_stabilizer_map_conj (g : G) (a : α) :
    stabilizer G (g • a) = (stabilizer G a).map (MulAut.conj g).toMonoidHom := by
ext h
  rw [mem_stabilizer_iff, ← smul_left_cancel_iff g⁻¹, smul_smul, smul_smul, smul_smul,
    inv_mul_cancel, one_smul, ← mem_stabilizer_iff, Subgroup.mem_map_equiv, MulAut.conj_symm_apply]

variable {g h k : G} {a b c : α}

/-- The natural group equivalence between the stabilizers of two elements in the same orbit. -/
```

-- snippet 19
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer (L260-L264)
def stabilizerEquivStabilizer (hg : b = g • a) : stabilizer G a ≃* stabilizer G b :=
((MulAut.conj g).subgroupMap (stabilizer G a)).trans
    (MulEquiv.subgroupCongr (by
      rw [hg, stabilizer_smul_eq_stabilizer_map_conj g a, ← MulEquiv.toMonoidHom_eq_coe]))
```

-- snippet 20
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer_inv (L288-L306)
theorem stabilizerEquivStabilizer_inv (hg : b = g⁻¹ • a) :
    stabilizerEquivStabilizer hg =
      (stabilizerEquivStabilizer (inv_smul_eq_iff.mp hg.symm)).symm := by
ext; simp [stabilizerEquivStabilizer]

/-- A bijection between the stabilizers of two elements in the same orbit. -/
noncomputable def stabilizerEquivStabilizerOfOrbitRel (h : orbitRel G α a b) :
    stabilizer G a ≃* stabilizer G b :=
  (stabilizerEquivStabilizer (Classical.choose_spec h).symm).symm

end Stabilizer

end MulAction

namespace AddAction
variable {G α : Type*} [AddGroup G] [AddAction G α]

variable {g h k : G} {a b c : α}
/-- If the stabilizer of `x` is `S`, then the stabilizer of `g +ᵥ x` is `g + S + (-g)`. -/
```

-- snippet 21
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.fst_mem_orbit_of_mem_orbit (L51-L55)
lemma fst_mem_orbit_of_mem_orbit {x y : α × β} (h : x ∈ MulAction.orbit M y) :
    x.1 ∈ MulAction.orbit M y.1 := by
rcases h with ⟨g, rfl⟩
  exact mem_orbit _ _
```

-- snippet 22
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.pretransitive_iff_subsingleton_quotient (L179-L188)
theorem pretransitive_iff_subsingleton_quotient :
    IsPretransitive G α ↔ Subsingleton (orbitRel.Quotient G α) := by
refine ⟨fun _ ↦ ⟨fun a b ↦ ?_⟩, fun _ ↦ ⟨fun a b ↦ ?_⟩⟩
  · refine Quot.inductionOn a (fun x ↦ ?_)
    exact Quot.inductionOn b (fun y ↦ Quot.sound <| exists_smul_eq G y x)
  · have h : Quotient.mk (orbitRel G α) b = ⟦a⟧ := Subsingleton.elim _ _
    exact Quotient.eq''.mp h

/-- If `α` is non-empty, an action is pretransitive if and only if the quotient has exactly one
element. -/
```

-- snippet 23
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.orbitRel_subgroupOf (L155-L176)
lemma orbitRel_subgroupOf (H K : Subgroup G) :
    orbitRel (H.subgroupOf K) α = orbitRel (H ⊓ K : Subgroup G) α := by
rw [← Subgroup.subgroupOf_map_subtype]
  ext x
  simp_rw [orbitRel_apply]
  refine ⟨fun h ↦ ?_, fun h ↦ ?_⟩
  · rcases h with ⟨⟨gv, gp⟩, rfl⟩
    simp only
    refine mem_orbit _ (⟨gv, ?_⟩ : Subgroup.map K.subtype (H.subgroupOf K))
    simpa using gp
  · rcases h with ⟨⟨gv, gp⟩, rfl⟩
    simp only
    simp only [Subgroup.subgroupOf_map_subtype, Subgroup.mem_inf] at gp
    refine mem_orbit _ (⟨⟨gv, ?_⟩, ?_⟩ : H.subgroupOf K)
    · exact gp.2
    · simp only [Subgroup.mem_subgroupOf]
      exact gp.1

variable (G α)

/-- An action is pretransitive if and only if the quotient by `MulAction.orbitRel` is a
subsingleton. -/
```

-- snippet 24
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer_symm_apply (L269-L272)
theorem stabilizerEquivStabilizer_symm_apply (hg : b = g • a) (x : stabilizer G b) :
    (stabilizerEquivStabilizer hg).symm x = MulAut.conj g⁻¹ x := by
simp [stabilizerEquivStabilizer]
```

-- snippet 25
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.pretransitive_iff_unique_quotient_of_nonempty (L191-L198)
theorem pretransitive_iff_unique_quotient_of_nonempty [Nonempty α] :
    IsPretransitive G α ↔ Nonempty (Unique <| orbitRel.Quotient G α) := by
rw [unique_iff_subsingleton_and_nonempty, pretransitive_iff_subsingleton_quotient, iff_self_and]
  exact fun _ ↦ (nonempty_quotient_iff _).mpr inferInstance

variable {G α}

set_option backward.isDefEq.respectTransparency false in
```

-- snippet 26
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer_zero (L336-L339)
theorem stabilizerEquivStabilizer_zero :
    stabilizerEquivStabilizer (zero_vadd G a).symm = AddEquiv.refl (stabilizer G a) := by
ext; simp [stabilizerEquivStabilizer_apply]
```

-- snippet 27
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.orbitRel_subgroup_le (L151-L153)
lemma orbitRel_subgroup_le (H : Subgroup G) : orbitRel H α ≤ orbitRel G α :=
Setoid.le_def.2 mem_orbit_of_mem_orbit_subgroup
```

-- snippet 28
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizer_vadd_eq_stabilizer_map_conj (L307-L316)
theorem stabilizer_vadd_eq_stabilizer_map_conj (g : G) (a : α) :
    stabilizer G (g +ᵥ a) = (stabilizer G a).map (AddAut.conj g).toMul.toAddMonoidHom := by
ext h
  rw [mem_stabilizer_iff, ← vadd_left_cancel_iff (-g), vadd_vadd, vadd_vadd, vadd_vadd,
    neg_add_cancel, zero_vadd, ← mem_stabilizer_iff, AddSubgroup.mem_map_equiv,
    AddAut.conj_symm_apply]

variable {g h k : G} {a b c : α}

/-- The natural group equivalence between the stabilizers of two elements in the same orbit. -/
```

-- snippet 29
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer_trans (L273-L278)
theorem stabilizerEquivStabilizer_trans (hg : b = g • a) (hh : c = h • b) (hk : c = k • a)
    (H : k = h * g) :
    (stabilizerEquivStabilizer hg).trans (stabilizerEquivStabilizer hh) =
      stabilizerEquivStabilizer hk := by
ext; simp [stabilizerEquivStabilizer_apply, H]
```

-- snippet 30
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer_symm (L283-L287)
theorem stabilizerEquivStabilizer_symm (hg : b = g • a) :
    (stabilizerEquivStabilizer hg).symm =
      stabilizerEquivStabilizer (eq_inv_smul_iff.mpr hg.symm) := by
ext x; simp [stabilizerEquivStabilizer]
```

-- snippet 31
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.nontrivial_of_fixedPoints_ne_univ (L126-L133)
theorem nontrivial_of_fixedPoints_ne_univ (h : fixedPoints G α ≠ .univ) :
    Nontrivial α :=
(subsingleton_or_nontrivial α).resolve_left fun _ ↦ h fixedPoints_of_subsingleton

section Orbit

-- TODO: This proof is redoing a special case of `MulAction.IsInvariantBlock.isBlock`. Can we move
-- this lemma earlier to golf?
```

-- snippet 32
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.orbit_eq_univ (L69-L77)
theorem orbit_eq_univ [IsPretransitive M α] (a : α) : orbit M a = Set.univ :=
(surjective_smul M a).range_eq

end Orbit

section FixedPoints

variable {M α}
```

-- snippet 33
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.subsingleton_orbit_iff_mem_fixedPoints (L79-L86)
theorem subsingleton_orbit_iff_mem_fixedPoints {a : α} :
    (orbit M a).Subsingleton ↔ a ∈ fixedPoints M α := by
rw [mem_fixedPoints]
  constructor
  · exact fun h m ↦ h (mem_orbit a m) (mem_orbit_self a)
  · rintro h _ ⟨m, rfl⟩ y ⟨p, rfl⟩
    simp only [h]
```

-- snippet 34
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.mem_fixedPoints_iff_card_orbit_eq_one (L88-L93)
theorem mem_fixedPoints_iff_card_orbit_eq_one {a : α} [Fintype (orbit M a)] :
    a ∈ fixedPoints M α ↔ Fintype.card (orbit M a) = 1 := by
simp only [← subsingleton_orbit_iff_mem_fixedPoints, le_antisymm_iff,
    Fintype.card_le_one_iff_subsingleton, Nat.add_one_le_iff, Fintype.card_pos_iff,
    Set.subsingleton_coe, iff_self_and, Set.nonempty_coe_sort, nonempty_orbit, implies_true]
```

-- snippet 35
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer_apply (L265-L268)
theorem stabilizerEquivStabilizer_apply (hg : b = g • a) (x : stabilizer G a) :
    stabilizerEquivStabilizer hg x = MulAut.conj g x := by
simp [stabilizerEquivStabilizer]
```

-- snippet 36
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.smul_cancel_of_non_zero_divisor (L107-L116)
theorem smul_cancel_of_non_zero_divisor {M G : Type*} [Monoid M] [AddGroup G]
    [DistribMulAction M G] (k : M) (h : ∀ x : G, k • x = 0 → x = 0) {a b : G} (h' : k • a = k • b) :
    a = b := by
rw [← sub_eq_zero]
  refine h _ ?_
  rw [smul_sub, h', sub_self]

namespace MulAction
variable {G α β : Type*} [Group G] [MulAction G α] [MulAction G β]
```

-- snippet 37
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.snd_mem_orbit_of_mem_orbit (L57-L61)
lemma snd_mem_orbit_of_mem_orbit {x y : α × β} (h : x ∈ MulAction.orbit M y) :
    x.2 ∈ MulAction.orbit M y.2 := by
rcases h with ⟨g, rfl⟩
  exact mem_orbit _ _
```

-- snippet 38
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.orbitRel_le_fst (L227-L230)
lemma orbitRel_le_fst :
    orbitRel G (α × β) ≤ (orbitRel G α).comap Prod.fst :=
Setoid.le_def.2 fst_mem_orbit_of_mem_orbit
```

-- snippet 39
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.stabilizerEquivStabilizer_neg (L345-L356)
theorem stabilizerEquivStabilizer_neg (hg : b = -g +ᵥ a) :
    stabilizerEquivStabilizer hg =
      (stabilizerEquivStabilizer (neg_vadd_eq_iff.mp hg.symm)).symm := by
ext; simp [stabilizerEquivStabilizer]

/-- A bijection between the stabilizers of two elements in the same orbit. -/
noncomputable def stabilizerEquivStabilizerOfOrbitRel (h : orbitRel G α a b) :
    stabilizer G a ≃+ stabilizer G b :=
  (stabilizerEquivStabilizer (Classical.choose_spec h).symm).symm

end AddAction
```

-- snippet 40
```lean
-- Mathlib.GroupTheory.GroupAction.Basic.smul_orbit (L135-L141)
theorem smul_orbit (g : G) (a : α) : g • orbit G a = orbit G a :=
(smul_orbit_subset g a).antisymm <|
    calc
      orbit G a = g • g⁻¹ • orbit G a := (smul_inv_smul _ _).symm
      _ ⊆ g • orbit G a := Set.image_mono (smul_orbit_subset _ _)

/-- The action of a group on an orbit is transitive. -/
```
[/INST]


[System] You are Leanstral, a Lean 4 proof assistant. Complete the task below using the provided Lean source context. The target mathlib commit is 5e932f97dd25535344f80f9dd8da3aab83df0fe6 (module Mathlib.LinearAlgebra.RootSystem.RootPositive).

[User]
Prove the following theorem. The retrieved context below may help.

```lean
lemma apply_reflection_reflection (x y : M) :
    B.form (P.reflection i x) (P.reflection i y) = B.form x y
```

## Retrieved context
-- snippet 1
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.apply_root_ne_zero (L61-L63)
lemma apply_root_ne_zero : B.form (P.root i) ≠ 0 :=
fun contra ↦ B.ne_zero i <| by simp [contra]
```

-- snippet 2
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.two_mul_apply_root_root (L64-L70)
lemma two_mul_apply_root_root :
    2 * B.form (P.root i) (P.root j) = P.pairing i j * B.form (P.root j) (P.root j) := by
rw [two_mul, ← eq_sub_iff_add_eq]
  nth_rw 1 [← B.isOrthogonal_reflection j]
  rw [reflection_apply, reflection_apply_self, root_coroot'_eq_pairing, LinearMap.map_sub₂,
    LinearMap.map_smul₂, smul_eq_mul, map_neg, map_neg, mul_neg, neg_sub_neg]
```

-- snippet 3
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.pairing_mul_eq_pairing_mul_swap (L71-L76)
lemma pairing_mul_eq_pairing_mul_swap :
    P.pairing j i * B.form (P.root i) (P.root i) =
    P.pairing i j * B.form (P.root j) (P.root j) := by
rw [← B.two_mul_apply_root_root i j, ← B.two_mul_apply_root_root j i, ← B.symm.eq,
    RingHom.id_apply]
```

-- snippet 4
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.apply_root_root_zero_iff (L83-L108)
lemma apply_root_root_zero_iff [IsDomain R] [NeZero (2 : R)] :
    B.form (P.root i) (P.root j) = 0 ↔ P.pairing i j = 0 := by
calc B.form (P.root i) (P.root j) = 0
      ↔ 2 * B.form (P.root i) (P.root j) = 0 := by simp [two_ne_zero]
    _ ↔ P.pairing i j * B.form (P.root j) (P.root j) = 0 := by rw [B.two_mul_apply_root_root i j]
    _ ↔ P.pairing i j = 0 := by simp [B.ne_zero j]

end InvariantForm

variable (S) in
/-- Given a root pairing, this is an invariant symmetric bilinear form satisfying a positivity
condition. -/
structure RootPositiveForm (P : RootPairing ι R M N) [P.IsValuedIn S] where
  /-- The bilinear form bundled inside a `RootPositiveForm`. -/
  form : LinearMap.BilinForm R M
  symm : form.IsSymm
  isOrthogonal_reflection (i : ι) : form.IsOrthogonal (P.reflection i)
  exists_eq (i j : ι) : ∃ s, algebraMap S R s = form (P.root i) (P.root j)
  exists_pos_eq (i : ι) : ∃ s > 0, algebraMap S R s = form (P.root i) (P.root i)

variable {P : RootPairing ι R M N} [P.IsValuedIn S] (B : P.RootPositiveForm S) (i j : ι)
  [FaithfulSMul S R] [Module S M] [IsScalarTower S R M]

namespace RootPositiveForm

omit [Module S M] [IsScalarTower S R M] in
```

-- snippet 5
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.form_apply_root_ne_zero (L109-L115)
lemma form_apply_root_ne_zero (i : ι) :
    B.form (P.root i) (P.root i) ≠ 0 := by
obtain ⟨s, hs, hs'⟩ := B.exists_pos_eq i
  simpa [← hs'] using hs.ne'

/-- Forgetting the positivity condition, we may regard a `RootPositiveForm` as an `InvariantForm`.
-/
```

-- snippet 6
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.two_mul_apply_root_root (L123-L128)
lemma two_mul_apply_root_root :
    2 * B.form (P.root i) (P.root j) = P.pairing i j * B.form (P.root j) (P.root j) :=
B.toInvariantForm.two_mul_apply_root_root i j

/-- Given a root-positive form associated to a root pairing with coefficients in `R` but taking
values in `S`, this is the associated `S`-bilinear form on the `S`-span of the roots. -/
```

-- snippet 7
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.posForm (L129-L141)
def posForm :
    LinearMap.BilinForm S (span S (range P.root)) :=
LinearMap.restrictScalarsRange₂ (span S (range P.root)).subtype (span S (range P.root)).subtype
  (Algebra.linearMap S R) (FaithfulSMul.algebraMap_injective S R) B.form
  (fun ⟨x, hx⟩ ⟨y, hy⟩ ↦ by
    apply LinearMap.BilinMap.apply_apply_mem_of_mem_span
      (s := range P.root) (t := range P.root)
      (B := (LinearMap.restrictScalarsₗ S R _ _ _).comp (B.form.restrictScalars S))
    · rintro - ⟨i, rfl⟩ - ⟨j, rfl⟩
      simpa using B.exists_eq i j
    · simpa
    · simpa)
```

-- snippet 8
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.algebraMap_apply_eq_form_iff (L147-L150)
lemma algebraMap_apply_eq_form_iff {x y : span S (range P.root)} {s : S} :
    algebraMap S R s = B.form x y ↔ s = B.posForm x y := by
simp [RootPositiveForm.posForm]
```

-- snippet 9
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.zero_lt_posForm_iff (L151-L156)
lemma zero_lt_posForm_iff {x y : span S (range P.root)} :
    0 < B.posForm x y ↔ ∃ s > 0, algebraMap S R s = B.form x y := by
refine ⟨fun h ↦ ⟨B.posForm x y, h, by simp⟩, fun ⟨s, h, h'⟩ ↦ ?_⟩
  rw [← B.algebraMap_posForm] at h'
  rwa [← FaithfulSMul.algebraMap_injective S R h']
```

-- snippet 10
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.zero_lt_posForm_apply_root (L157-L161)
lemma zero_lt_posForm_apply_root (i : ι)
    (hi : P.root i ∈ span S (range P.root) := subset_span (mem_range_self i)) :
0 < B.posForm ⟨P.root i, hi⟩ ⟨P.root i, hi⟩ := by
  simpa only [zero_lt_posForm_iff] using B.exists_pos_eq i
```

-- snippet 11
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.isSymm_posForm (L162-L168)
lemma isSymm_posForm :
    B.posForm.IsSymm where
  eq x y := by
apply FaithfulSMul.algebraMap_injective S R
    simpa using B.symm.eq x y

/-- The length of the `i`-th root w.r.t. a root-positive form taking values in `S`. -/
```

-- snippet 12
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.rootLength (L169-L171)
def rootLength (i : ι) : S :=
B.posForm (P.rootSpanMem S i) (P.rootSpanMem S i)
```

-- snippet 13
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.rootLength_pos (L172-L174)
lemma rootLength_pos (i : ι) : 0 < B.rootLength i := by
simpa using B.zero_lt_posForm_apply_root i
```

-- snippet 14
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.rootLength_reflectionPerm_self (L176-L179)
lemma rootLength_reflectionPerm_self (i : ι) :
    B.rootLength (P.reflectionPerm i i) = B.rootLength i := by
simp [rootLength, rootSpanMem_reflectionPerm_self]
```

-- snippet 15
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.pairingIn_mul_eq_pairingIn_mul_swap (L184-L189)
lemma pairingIn_mul_eq_pairingIn_mul_swap :
    P.pairingIn S j i * B.rootLength i = P.pairingIn S i j * B.rootLength j := by
simpa only [← (algebraMap_injective S R).eq_iff, algebraMap_pairingIn, map_mul,
    B.algebraMap_rootLength] using B.toInvariantForm.pairing_mul_eq_pairing_mul_swap i j

set_option linter.style.whitespace false in -- manual alignment is not recognised
```

-- snippet 16
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.toCoweightBasis (L313-L316)
def toCoweightBasis :
    Basis b.support R N :=
Base.toWeightBasis (P := P.flip) b.flip
```

-- snippet 17
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.pos_or_neg_of_sum_smul_root_mem (L199-L231)
lemma pos_or_neg_of_sum_smul_root_mem (f : ι → ℤ)
    (hf : ∑ j ∈ b.support, f j • P.root j ∈ range P.root) (hf₀ : f.support ⊆ b.support) :
    0 < f ∨ f < 0 := by
suffices ∀ (f : ι → ℤ)
      (hf : ∑ j ∈ b.support, f j • P.root j ∈ AddSubmonoid.closure (P.root '' b.support))
      (hf₀ : f.support ⊆ b.support) (hf' : f ≠ 0), 0 < f by
    obtain ⟨k, hk⟩ := hf
    have hf' : f ≠ 0 := by rintro rfl; exact P.ne_zero k <| by simp [hk]
    rcases b.root_mem_or_neg_mem k with hk' | hk' <;> rw [hk] at hk'
    · left; exact this f hk' hf₀ hf'
    · right; simpa using this (-f) (by convert hk'; simp) (by simpa only [support_neg]) (by simpa)
  intro f hf hf₀ hf'
  let f' : b.support → ℤ := fun i ↦ f i
  replace hf : ∑ j, f' j • P.root j ∈ AddSubmonoid.closure (P.root '' b.support) := by
    suffices ∑ j, f' j • P.root j = ∑ j ∈ b.support, f j • P.root j by rwa [this]
    rw [← b.support.sum_finset_coe]; rfl
  rw [← span_nat_eq_addSubmonoidClosure, mem_toAddSubmonoid,
    Fintype.mem_span_image_iff_exists_fun] at hf
  obtain ⟨c, hc⟩ := hf
  replace hc (i : b.support) : c i = f' i := Fintype.linearIndependent_iffₛ.mp
    (b.linearIndepOn_root.restrict_scalars' ℤ) (Int.ofNat ∘ c) f' (by simpa) i
  have aux : 0 ≤ f := by
    intro i
    by_cases hi : i ∈ b.support
    · change 0 ≤ f' ⟨i, hi⟩
      simp [← hc]
    · replace hi : i ∉ f.support := by contrapose! hi; exact hf₀ hi
      simp_all
  refine Pi.lt_def.mpr ⟨aux, ?_⟩
  by_contra! contra
  replace contra : f = 0 := le_antisymm contra aux
  contradiction
```

-- snippet 18
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.chainTopCoeff_eq_of_ne (L286-L297)
lemma chainTopCoeff_eq_of_ne (hij : i ≠ j) :
    P.chainTopCoeff i j = -P.pairingIn ℤ j i := by
rw [← chainTopCoeff_sub_chainBotCoeff (b.linearIndependent_pair_of_ne hij)]
  simp

end RootPairing

section RootSystem

variable {P : RootPairing ι R M N} (b : P.Base) [P.IsRootSystem]

/-- A base of a root system yields a basis of the root space. -/
```

-- snippet 19
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.height_ne_zero (L392-L411)
lemma height_ne_zero (i : ι) :
    b.height i ≠ 0 := by
obtain ⟨f, hf₀, hf₁, hf₂⟩ := b.exists_root_eq_sum_int i
  rw [height_eq_sum hf₂]
  rcases hf₁ with pos | neg
  · refine (Finset.sum_pos' (fun i _ ↦ pos.le i) ?_).ne'
    by_contra! contra
    replace contra (j : ι) : f j = 0 := by
      by_cases hj : j ∈ f.support
      · exact le_antisymm (contra j (hf₀ hj)) (pos.le j)
      · simpa using hj
    exact P.ne_zero i <| by simp [hf₂, contra]
  · refine (Finset.sum_neg' (fun i _ ↦ neg.le i) ?_).ne
    by_contra! contra
    replace contra (j : ι) : f j = 0 := by
      by_cases hj : j ∈ f.support
      · exact le_antisymm (neg.le j) (contra j (hf₀ hj))
      · simpa using hj
    exact P.ne_zero i <| by simp [hf₂, contra]
```

-- snippet 20
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.span_int_root_support (L131-L136)
lemma span_int_root_support :
    span ℤ (P.root '' b.support) = span ℤ (range P.root) := by
refine le_antisymm (span_mono <| image_subset_range _ _) (span_le.mpr ?_)
  rintro - ⟨i, rfl⟩
  exact b.root_mem_span_int i
```

-- snippet 21
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.height (L375-L378)
def height (i : ι) : ℤ :=
∑ j ∈ b.support, (b.exists_root_eq_sum_int i).choose j

variable {b} in
```

-- snippet 22
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.root_ne_neg_of_ne (L101-L109)
lemma root_ne_neg_of_ne [Nontrivial R] {i j : ι}
    (hi : i ∈ b.support) (hj : j ∈ b.support) (hij : i ≠ j) :
    P.root i ≠ -P.root j := by
classical
  intro contra
  have := linearIndepOn_iff'.mp b.linearIndepOn_root ({i, j} : Finset ι) 1
    (by simp [Set.insert_subset_iff, hi, hj]) (by simp [Finset.sum_pair hij, contra])
  simp_all
```

-- snippet 23
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.not_nonpos_iff_pos_of_sum_mem_range_root (L232-L242)
lemma not_nonpos_iff_pos_of_sum_mem_range_root (f : ι → ℤ)
    (hf : ∑ j ∈ b.support, f j • P.root j ∈ range P.root) (hf₀ : f.support ⊆ b.support) :
    (¬ f ≤ 0) ↔ 0 < f := by
rw [Pi.lt_def]
  refine ⟨fun h ↦ ⟨?_, ?_⟩, fun ⟨h, ⟨i, hi⟩⟩ contra ↦ by simp [le_antisymm contra h] at hi⟩
  · rcases b.pos_or_neg_of_sum_smul_root_mem f hf hf₀ with h' | h'
    · exact le_of_lt h'
    · exfalso
      exact h (le_of_lt h')
  · contrapose! h; exact h
```

-- snippet 24
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.span_coroot_support (L148-L152)
lemma span_coroot_support :
    span R (P.coroot '' b.support) = P.corootSpan R :=
b.flip.span_root_support

open Finsupp in
```

-- snippet 25
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.not_nonneg_iff_neg_of_sum_mem_range_root (L243-L250)
lemma not_nonneg_iff_neg_of_sum_mem_range_root (f : ι → ℤ)
    (hf : ∑ j ∈ b.support, f j • P.root j ∈ range P.root) (hf₀ : f.support ⊆ b.support) :
    (¬ 0 ≤ f) ↔ f < 0 := by
replace hf : ∑ j ∈ b.support, (-f) j • P.root j ∈ range P.root := by
    rw [← neg_mem_range_root_iff]; simpa
  have := b.not_nonpos_iff_pos_of_sum_mem_range_root (-f) hf (by simpa)
  simp_all
```

-- snippet 26
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.toWeightBasis (L298-L303)
def toWeightBasis :
    Basis b.support R M :=
Basis.mk b.linearIndepOn_root <| by
    change ⊤ ≤ span R (range <| P.root ∘ ((↑) : b.support → ι))
    simp [range_comp]
```

-- snippet 27
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.support_nonempty (L86-L91)
lemma support_nonempty [Nonempty ι] [NeZero (2 : R)] : b.support.Nonempty := by
by_contra! contra
  inhabit ι
  simpa [P.ne_zero default, contra] using b.root_mem_or_neg_mem default

/-- Interchanging roots and coroots, one still has a base of a root pairing. -/
```

-- snippet 28
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.coroot_mem_span_int (L126-L129)
lemma coroot_mem_span_int (i : ι) :
    P.coroot i ∈ span ℤ (P.coroot '' b.support) :=
b.flip.root_mem_span_int i
```

-- snippet 29
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.span_int_coroot_support (L138-L141)
lemma span_int_coroot_support :
    span ℤ (P.coroot '' b.support) = span ℤ (range P.coroot) :=
b.flip.span_int_root_support
```

-- snippet 30
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.pairingIn_le_zero_of_ne (L273-L281)
lemma pairingIn_le_zero_of_ne [IsDomain R] [P.IsCrystallographic] [Finite ι]
    {i j} (hij : i ≠ j) (hi : i ∈ b.support) (hj : j ∈ b.support) :
    P.pairingIn ℤ i j ≤ 0 := by
by_contra! h
  exact b.sub_notMem_range_root hi hj <| P.root_sub_root_mem_of_pairingIn_pos h hij

variable {b}
variable [IsDomain R] [P.IsCrystallographic] [Finite ι] {i j : b.support}
```

-- snippet 31
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.eq_one_or_neg_one_of_mem_support_of_smul_mem_aux (L153-L179)
lemma eq_one_or_neg_one_of_mem_support_of_smul_mem_aux [Finite ι]
    [IsAddTorsionFree M] [IsAddTorsionFree N]
    (i : ι) (h : i ∈ b.support) (t : R) (ht : t • P.root i ∈ range P.root) :
    ∃ z : ℤ, z * t = 1 := by
classical
  obtain ⟨j, hj⟩ := ht
  obtain ⟨f, hf⟩ : ∃ f : b.support → ℤ, P.coroot i = ∑ i, (t * f i) • P.coroot i := by
    have : P.coroot j ∈ span ℤ (P.coroot '' b.support) := b.coroot_mem_span_int j
    rw [image_eq_range, mem_span_range_iff_exists_fun] at this
    refine this.imp fun f hf ↦ ?_
    simp only [Finset.coe_sort_coe] at hf
    simp_rw [mul_smul, ← Finset.smul_sum, Int.cast_smul_eq_zsmul, hf,
      coroot_eq_smul_coroot_iff.mpr hj]
  use f ⟨i, h⟩
  replace hf : P.coroot i = linearCombination R (fun k : b.support ↦ P.coroot k)
      (t • (linearEquivFunOnFinite R _ _).symm (fun x ↦ (f x : R))) := by
    rw [map_smul, linearCombination_eq_fintype_linearCombination_apply,
      Fintype.linearCombination_apply, hf]
    simp_rw [mul_smul, ← Finset.smul_sum]
  let g : b.support →₀ R := single ⟨i, h⟩ 1
  have hg : P.coroot i = linearCombination R (fun k : b.support ↦ P.coroot k) g := by simp [g]
  rw [hg] at hf
  have : Injective (linearCombination R fun k : b.support ↦ P.coroot k) := b.linearIndepOn_coroot
  simpa [g, linearEquivFunOnFinite, mul_comm t] using (DFunLike.congr_fun (this hf) ⟨i, h⟩).symm

variable [CharZero R]
```

-- snippet 32
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.span_root_support (L143-L146)
lemma span_root_support :
    span R (P.root '' b.support) = P.rootSpan R := by
rw [← span_span_of_tower (R := ℤ), span_int_root_support, span_span_of_tower]
```

-- snippet 33
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.sub_notMem_range_root (L251-L267)
lemma sub_notMem_range_root
    {i j : ι} (hi : i ∈ b.support) (hj : j ∈ b.support) :
    P.root i - P.root j ∉ range P.root := by
rcases eq_or_ne j i with rfl | hij
  · simpa only [sub_self, mem_range, not_exists] using fun k ↦ P.ne_zero k
  classical
  let f : ι → ℤ := fun k ↦ if k = i then 1 else if k = j then -1 else 0
  have hf : ∑ k ∈ b.support, f k • P.root k = P.root i - P.root j := by
    have : {i, j} ⊆ b.support := by aesop (add simp Finset.insert_subset_iff)
    rw [← Finset.sum_subset (s₁ := {i, j}) (s₂ := b.support) (by lia) (by aesop),
      Finset.sum_insert (by grind), Finset.sum_singleton]
    simp [f, hij, sub_eq_add_neg]
  intro contra
  rcases b.pos_or_neg_of_sum_smul_root_mem f (by rwa [hf]) (by aesop) with pos | neg
  · simpa [hij, f] using le_of_lt pos j
  · simpa [hij, f] using le_of_lt neg i
```

-- snippet 34
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.exists_root_eq_sum_int (L355-L374)
lemma exists_root_eq_sum_int [CharZero R] (i : ι) :
    ∃ f : ι → ℤ, f.support ⊆ b.support ∧ (0 < f ∨ f < 0) ∧
      P.root i = ∑ j ∈ b.support, f j • P.root j := by
obtain ⟨f, hf, hf' | hf'⟩ := b.exists_root_eq_sum_nat_or_neg i
  · refine ⟨Nat.cast ∘ f, by simpa, Or.inl <| Pi.lt_def.mpr ⟨fun _ ↦ by simp, ?_⟩, by simp [hf']⟩
    by_contra! contra
    replace contra : f = 0 := by ext i; simpa using contra i
    exact P.ne_zero i <| by simp [hf', contra]
  · refine ⟨-Nat.cast ∘ f, by simpa, Or.inr <| Pi.lt_def.mpr ⟨fun _ ↦ by simp, ?_⟩, by simp [hf']⟩
    by_contra! contra
    replace contra : f = 0 := by ext i; simpa using contra i
    exact P.ne_zero i <| by simp [hf', contra]

end RootPairing

section PositiveRoots

variable {P : RootPairing ι R M N} (b : P.Base) [CharZero R]

/-- Given a base `α₁, α₂, …`, the height of a root `∑ zᵢαᵢ` relative to this base is `∑ zᵢ`. -/
```

-- snippet 35
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.eq_one_or_neg_one_of_mem_support_of_smul_mem (L180-L198)
lemma eq_one_or_neg_one_of_mem_support_of_smul_mem [Finite ι]
    [IsAddTorsionFree M] [IsAddTorsionFree N]
    (i : ι) (h : i ∈ b.support) (t : R) (ht : t • P.root i ∈ range P.root) :
    t = 1 ∨ t = -1 := by
obtain ⟨z, hz⟩ := b.eq_one_or_neg_one_of_mem_support_of_smul_mem_aux i h t ht
  replace ht : (z : R) • P.coroot i ∈ range P.coroot := by
    obtain ⟨j, hj⟩ := ht
    simpa only [coroot_eq_smul_coroot_iff.mpr hj, smul_smul, hz, one_smul] using mem_range_self j
  obtain ⟨w, hw⟩ := b.flip.eq_one_or_neg_one_of_mem_support_of_smul_mem_aux i h _ ht
  have : (z : R) * w = 1 := by
    simpa [mul_mul_mul_comm _ t, mul_comm t, mul_comm _ (z : R), hz] using congr_arg₂ (· * ·) hz hw
  suffices z = 1 ∨ z = -1 by
    rcases this with rfl | rfl
    · left; simpa using hz
    · right; simpa [neg_eq_iff_eq_neg] using hz
  norm_cast at this
  rw [Int.mul_eq_one_iff_eq_one_or_neg_one] at this
  tauto
```

-- snippet 36
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.root_mem_span_int (L116-L125)
lemma root_mem_span_int (i : ι) :
    P.root i ∈ span ℤ (P.root '' b.support) := by
have := b.root_mem_or_neg_mem i
  simp only [← span_nat_eq_addSubmonoidClosure, mem_toAddSubmonoid] at this
  rw [← span_span_of_tower (R := ℕ)]
  rcases this with hi | hi
  · exact subset_span hi
  · rw [← neg_mem_iff]
    exact subset_span hi
```

-- snippet 37
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.sub_notMem_range_coroot (L268-L272)
lemma sub_notMem_range_coroot
    {i j : ι} (hi : i ∈ b.support) (hj : j ∈ b.support) :
    P.coroot i - P.coroot j ∉ range P.coroot :=
b.flip.sub_notMem_range_root hi hj
```

-- snippet 38
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.height_eq_sum (L379-L391)
lemma height_eq_sum {i : ι} {f : ι → ℤ} (heq : P.root i = ∑ j ∈ b.support, f j • P.root j) :
    b.height i = ∑ j ∈ b.support, f j := by
suffices ∀ j ∈ b.support, (b.exists_root_eq_sum_int i).choose j = f j from
    Finset.sum_congr rfl this
  intro j hj
  obtain ⟨-, -, h⟩ := (b.exists_root_eq_sum_int i).choose_spec
  rw [h, b.support.sum_subtype (p := (· ∈ b.support)) (by simp) (F := inferInstance),
    b.support.sum_subtype (p := (· ∈ b.support)) (by simp) (F := inferInstance)] at heq
  have aux (j : b.support) := Fintype.linearIndependent_iffₛ.mp
      (b.linearIndepOn_root.restrict_scalars' ℤ) ((b.exists_root_eq_sum_int i).choose ∘ (↑))
      (f ∘ (↑)) (by simpa) j
  simpa using aux ⟨j, hj⟩
```

-- snippet 39
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.exists_root_eq_sum_nat_or_neg (L334-L354)
lemma exists_root_eq_sum_nat_or_neg (i : ι) :
    ∃ f : ι → ℕ, f.support ⊆ b.support ∧
      (P.root i =   ∑ j ∈ b.support, f j • P.root j ∨
       P.root i = - ∑ j ∈ b.support, f j • P.root j) := by
classical
  simp_rw [← neg_eq_iff_eq_neg]
  suffices ∀ m ∈ AddSubmonoid.closure (P.root '' b.support),
    ∃ f : ι → ℕ, f.support ⊆ b.support ∧ m = ∑ j ∈ b.support, f j • P.root j by
    rcases b.root_mem_or_neg_mem i with hi | hi
    · obtain ⟨f, hf, hf'⟩ := this _ hi
      exact ⟨f, hf, Or.inl hf'⟩
    · obtain ⟨f, hf, hf'⟩ := this _ hi
      exact ⟨f, hf, Or.inr hf'⟩
  intro m hm
  refine AddSubmonoid.closure_induction ?_ ⟨0, by simp⟩ ?_ hm
  · rintro - ⟨j, hj, rfl⟩
    exact ⟨Pi.single j 1, by simpa, by aesop (add simp Pi.single_apply)⟩
  · intro _ _ _ _ ⟨f, hf, hf'⟩ ⟨g, hg, hg'⟩
    refine ⟨f + g, ?_, by simp [hf', hg', add_smul, Finset.sum_add_distrib]⟩
    exact (support_add f g).trans <| union_subset_iff.mpr ⟨hf, hg⟩
```

-- snippet 40
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.linearIndependent_pair_of_ne (L110-L115)
lemma linearIndependent_pair_of_ne {i j : b.support} (hij : i ≠ j) :
    LinearIndependent R ![P.root i, P.root j] := by
have : ({(j : ι), (i : ι)} : Set ι) ⊆ b.support := by simp [pair_subset_iff]
  rw [← linearIndepOn_id_range_iff (by simp_all)]
  simpa [image_pair] using LinearIndepOn.id_image <| b.linearIndepOn_root.mono this
```

<s>[SYSTEM_PROMPT]You are Leanstral, a Lean 4 proof assistant. Complete the task below using the provided Lean source context. The target mathlib commit is 5e932f97dd25535344f80f9dd8da3aab83df0fe6 (module Mathlib.LinearAlgebra.RootSystem.RootPositive).[/SYSTEM_PROMPT][MODEL_SETTINGS]{"reasoning_effort": "none"}[/MODEL_SETTINGS][INST]Prove the following theorem. The retrieved context below may help.

```lean
lemma apply_reflection_reflection (x y : M) :
    B.form (P.reflection i x) (P.reflection i y) = B.form x y
```

## Retrieved context
-- snippet 1
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.apply_root_ne_zero (L61-L63)
lemma apply_root_ne_zero : B.form (P.root i) ≠ 0 :=
fun contra ↦ B.ne_zero i <| by simp [contra]
```

-- snippet 2
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.two_mul_apply_root_root (L64-L70)
lemma two_mul_apply_root_root :
    2 * B.form (P.root i) (P.root j) = P.pairing i j * B.form (P.root j) (P.root j) := by
rw [two_mul, ← eq_sub_iff_add_eq]
  nth_rw 1 [← B.isOrthogonal_reflection j]
  rw [reflection_apply, reflection_apply_self, root_coroot'_eq_pairing, LinearMap.map_sub₂,
    LinearMap.map_smul₂, smul_eq_mul, map_neg, map_neg, mul_neg, neg_sub_neg]
```

-- snippet 3
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.pairing_mul_eq_pairing_mul_swap (L71-L76)
lemma pairing_mul_eq_pairing_mul_swap :
    P.pairing j i * B.form (P.root i) (P.root i) =
    P.pairing i j * B.form (P.root j) (P.root j) := by
rw [← B.two_mul_apply_root_root i j, ← B.two_mul_apply_root_root j i, ← B.symm.eq,
    RingHom.id_apply]
```

-- snippet 4
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.apply_root_root_zero_iff (L83-L108)
lemma apply_root_root_zero_iff [IsDomain R] [NeZero (2 : R)] :
    B.form (P.root i) (P.root j) = 0 ↔ P.pairing i j = 0 := by
calc B.form (P.root i) (P.root j) = 0
      ↔ 2 * B.form (P.root i) (P.root j) = 0 := by simp [two_ne_zero]
    _ ↔ P.pairing i j * B.form (P.root j) (P.root j) = 0 := by rw [B.two_mul_apply_root_root i j]
    _ ↔ P.pairing i j = 0 := by simp [B.ne_zero j]

end InvariantForm

variable (S) in
/-- Given a root pairing, this is an invariant symmetric bilinear form satisfying a positivity
condition. -/
structure RootPositiveForm (P : RootPairing ι R M N) [P.IsValuedIn S] where
  /-- The bilinear form bundled inside a `RootPositiveForm`. -/
  form : LinearMap.BilinForm R M
  symm : form.IsSymm
  isOrthogonal_reflection (i : ι) : form.IsOrthogonal (P.reflection i)
  exists_eq (i j : ι) : ∃ s, algebraMap S R s = form (P.root i) (P.root j)
  exists_pos_eq (i : ι) : ∃ s > 0, algebraMap S R s = form (P.root i) (P.root i)

variable {P : RootPairing ι R M N} [P.IsValuedIn S] (B : P.RootPositiveForm S) (i j : ι)
  [FaithfulSMul S R] [Module S M] [IsScalarTower S R M]

namespace RootPositiveForm

omit [Module S M] [IsScalarTower S R M] in
```

-- snippet 5
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.form_apply_root_ne_zero (L109-L115)
lemma form_apply_root_ne_zero (i : ι) :
    B.form (P.root i) (P.root i) ≠ 0 := by
obtain ⟨s, hs, hs'⟩ := B.exists_pos_eq i
  simpa [← hs'] using hs.ne'

/-- Forgetting the positivity condition, we may regard a `RootPositiveForm` as an `InvariantForm`.
-/
```

-- snippet 6
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.two_mul_apply_root_root (L123-L128)
lemma two_mul_apply_root_root :
    2 * B.form (P.root i) (P.root j) = P.pairing i j * B.form (P.root j) (P.root j) :=
B.toInvariantForm.two_mul_apply_root_root i j

/-- Given a root-positive form associated to a root pairing with coefficients in `R` but taking
values in `S`, this is the associated `S`-bilinear form on the `S`-span of the roots. -/
```

-- snippet 7
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.posForm (L129-L141)
def posForm :
    LinearMap.BilinForm S (span S (range P.root)) :=
LinearMap.restrictScalarsRange₂ (span S (range P.root)).subtype (span S (range P.root)).subtype
  (Algebra.linearMap S R) (FaithfulSMul.algebraMap_injective S R) B.form
  (fun ⟨x, hx⟩ ⟨y, hy⟩ ↦ by
    apply LinearMap.BilinMap.apply_apply_mem_of_mem_span
      (s := range P.root) (t := range P.root)
      (B := (LinearMap.restrictScalarsₗ S R _ _ _).comp (B.form.restrictScalars S))
    · rintro - ⟨i, rfl⟩ - ⟨j, rfl⟩
      simpa using B.exists_eq i j
    · simpa
    · simpa)
```

-- snippet 8
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.algebraMap_apply_eq_form_iff (L147-L150)
lemma algebraMap_apply_eq_form_iff {x y : span S (range P.root)} {s : S} :
    algebraMap S R s = B.form x y ↔ s = B.posForm x y := by
simp [RootPositiveForm.posForm]
```

-- snippet 9
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.zero_lt_posForm_iff (L151-L156)
lemma zero_lt_posForm_iff {x y : span S (range P.root)} :
    0 < B.posForm x y ↔ ∃ s > 0, algebraMap S R s = B.form x y := by
refine ⟨fun h ↦ ⟨B.posForm x y, h, by simp⟩, fun ⟨s, h, h'⟩ ↦ ?_⟩
  rw [← B.algebraMap_posForm] at h'
  rwa [← FaithfulSMul.algebraMap_injective S R h']
```

-- snippet 10
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.zero_lt_posForm_apply_root (L157-L161)
lemma zero_lt_posForm_apply_root (i : ι)
    (hi : P.root i ∈ span S (range P.root) := subset_span (mem_range_self i)) :
0 < B.posForm ⟨P.root i, hi⟩ ⟨P.root i, hi⟩ := by
  simpa only [zero_lt_posForm_iff] using B.exists_pos_eq i
```

-- snippet 11
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.isSymm_posForm (L162-L168)
lemma isSymm_posForm :
    B.posForm.IsSymm where
  eq x y := by
apply FaithfulSMul.algebraMap_injective S R
    simpa using B.symm.eq x y

/-- The length of the `i`-th root w.r.t. a root-positive form taking values in `S`. -/
```

-- snippet 12
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.rootLength (L169-L171)
def rootLength (i : ι) : S :=
B.posForm (P.rootSpanMem S i) (P.rootSpanMem S i)
```

-- snippet 13
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.rootLength_pos (L172-L174)
lemma rootLength_pos (i : ι) : 0 < B.rootLength i := by
simpa using B.zero_lt_posForm_apply_root i
```

-- snippet 14
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.rootLength_reflectionPerm_self (L176-L179)
lemma rootLength_reflectionPerm_self (i : ι) :
    B.rootLength (P.reflectionPerm i i) = B.rootLength i := by
simp [rootLength, rootSpanMem_reflectionPerm_self]
```

-- snippet 15
```lean
-- Mathlib.LinearAlgebra.RootSystem.RootPositive.pairingIn_mul_eq_pairingIn_mul_swap (L184-L189)
lemma pairingIn_mul_eq_pairingIn_mul_swap :
    P.pairingIn S j i * B.rootLength i = P.pairingIn S i j * B.rootLength j := by
simpa only [← (algebraMap_injective S R).eq_iff, algebraMap_pairingIn, map_mul,
    B.algebraMap_rootLength] using B.toInvariantForm.pairing_mul_eq_pairing_mul_swap i j

set_option linter.style.whitespace false in -- manual alignment is not recognised
```

-- snippet 16
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.toCoweightBasis (L313-L316)
def toCoweightBasis :
    Basis b.support R N :=
Base.toWeightBasis (P := P.flip) b.flip
```

-- snippet 17
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.pos_or_neg_of_sum_smul_root_mem (L199-L231)
lemma pos_or_neg_of_sum_smul_root_mem (f : ι → ℤ)
    (hf : ∑ j ∈ b.support, f j • P.root j ∈ range P.root) (hf₀ : f.support ⊆ b.support) :
    0 < f ∨ f < 0 := by
suffices ∀ (f : ι → ℤ)
      (hf : ∑ j ∈ b.support, f j • P.root j ∈ AddSubmonoid.closure (P.root '' b.support))
      (hf₀ : f.support ⊆ b.support) (hf' : f ≠ 0), 0 < f by
    obtain ⟨k, hk⟩ := hf
    have hf' : f ≠ 0 := by rintro rfl; exact P.ne_zero k <| by simp [hk]
    rcases b.root_mem_or_neg_mem k with hk' | hk' <;> rw [hk] at hk'
    · left; exact this f hk' hf₀ hf'
    · right; simpa using this (-f) (by convert hk'; simp) (by simpa only [support_neg]) (by simpa)
  intro f hf hf₀ hf'
  let f' : b.support → ℤ := fun i ↦ f i
  replace hf : ∑ j, f' j • P.root j ∈ AddSubmonoid.closure (P.root '' b.support) := by
    suffices ∑ j, f' j • P.root j = ∑ j ∈ b.support, f j • P.root j by rwa [this]
    rw [← b.support.sum_finset_coe]; rfl
  rw [← span_nat_eq_addSubmonoidClosure, mem_toAddSubmonoid,
    Fintype.mem_span_image_iff_exists_fun] at hf
  obtain ⟨c, hc⟩ := hf
  replace hc (i : b.support) : c i = f' i := Fintype.linearIndependent_iffₛ.mp
    (b.linearIndepOn_root.restrict_scalars' ℤ) (Int.ofNat ∘ c) f' (by simpa) i
  have aux : 0 ≤ f := by
    intro i
    by_cases hi : i ∈ b.support
    · change 0 ≤ f' ⟨i, hi⟩
      simp [← hc]
    · replace hi : i ∉ f.support := by contrapose! hi; exact hf₀ hi
      simp_all
  refine Pi.lt_def.mpr ⟨aux, ?_⟩
  by_contra! contra
  replace contra : f = 0 := le_antisymm contra aux
  contradiction
```

-- snippet 18
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.chainTopCoeff_eq_of_ne (L286-L297)
lemma chainTopCoeff_eq_of_ne (hij : i ≠ j) :
    P.chainTopCoeff i j = -P.pairingIn ℤ j i := by
rw [← chainTopCoeff_sub_chainBotCoeff (b.linearIndependent_pair_of_ne hij)]
  simp

end RootPairing

section RootSystem

variable {P : RootPairing ι R M N} (b : P.Base) [P.IsRootSystem]

/-- A base of a root system yields a basis of the root space. -/
```

-- snippet 19
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.height_ne_zero (L392-L411)
lemma height_ne_zero (i : ι) :
    b.height i ≠ 0 := by
obtain ⟨f, hf₀, hf₁, hf₂⟩ := b.exists_root_eq_sum_int i
  rw [height_eq_sum hf₂]
  rcases hf₁ with pos | neg
  · refine (Finset.sum_pos' (fun i _ ↦ pos.le i) ?_).ne'
    by_contra! contra
    replace contra (j : ι) : f j = 0 := by
      by_cases hj : j ∈ f.support
      · exact le_antisymm (contra j (hf₀ hj)) (pos.le j)
      · simpa using hj
    exact P.ne_zero i <| by simp [hf₂, contra]
  · refine (Finset.sum_neg' (fun i _ ↦ neg.le i) ?_).ne
    by_contra! contra
    replace contra (j : ι) : f j = 0 := by
      by_cases hj : j ∈ f.support
      · exact le_antisymm (neg.le j) (contra j (hf₀ hj))
      · simpa using hj
    exact P.ne_zero i <| by simp [hf₂, contra]
```

-- snippet 20
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.span_int_root_support (L131-L136)
lemma span_int_root_support :
    span ℤ (P.root '' b.support) = span ℤ (range P.root) := by
refine le_antisymm (span_mono <| image_subset_range _ _) (span_le.mpr ?_)
  rintro - ⟨i, rfl⟩
  exact b.root_mem_span_int i
```

-- snippet 21
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.height (L375-L378)
def height (i : ι) : ℤ :=
∑ j ∈ b.support, (b.exists_root_eq_sum_int i).choose j

variable {b} in
```

-- snippet 22
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.root_ne_neg_of_ne (L101-L109)
lemma root_ne_neg_of_ne [Nontrivial R] {i j : ι}
    (hi : i ∈ b.support) (hj : j ∈ b.support) (hij : i ≠ j) :
    P.root i ≠ -P.root j := by
classical
  intro contra
  have := linearIndepOn_iff'.mp b.linearIndepOn_root ({i, j} : Finset ι) 1
    (by simp [Set.insert_subset_iff, hi, hj]) (by simp [Finset.sum_pair hij, contra])
  simp_all
```

-- snippet 23
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.not_nonpos_iff_pos_of_sum_mem_range_root (L232-L242)
lemma not_nonpos_iff_pos_of_sum_mem_range_root (f : ι → ℤ)
    (hf : ∑ j ∈ b.support, f j • P.root j ∈ range P.root) (hf₀ : f.support ⊆ b.support) :
    (¬ f ≤ 0) ↔ 0 < f := by
rw [Pi.lt_def]
  refine ⟨fun h ↦ ⟨?_, ?_⟩, fun ⟨h, ⟨i, hi⟩⟩ contra ↦ by simp [le_antisymm contra h] at hi⟩
  · rcases b.pos_or_neg_of_sum_smul_root_mem f hf hf₀ with h' | h'
    · exact le_of_lt h'
    · exfalso
      exact h (le_of_lt h')
  · contrapose! h; exact h
```

-- snippet 24
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.span_coroot_support (L148-L152)
lemma span_coroot_support :
    span R (P.coroot '' b.support) = P.corootSpan R :=
b.flip.span_root_support

open Finsupp in
```

-- snippet 25
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.not_nonneg_iff_neg_of_sum_mem_range_root (L243-L250)
lemma not_nonneg_iff_neg_of_sum_mem_range_root (f : ι → ℤ)
    (hf : ∑ j ∈ b.support, f j • P.root j ∈ range P.root) (hf₀ : f.support ⊆ b.support) :
    (¬ 0 ≤ f) ↔ f < 0 := by
replace hf : ∑ j ∈ b.support, (-f) j • P.root j ∈ range P.root := by
    rw [← neg_mem_range_root_iff]; simpa
  have := b.not_nonpos_iff_pos_of_sum_mem_range_root (-f) hf (by simpa)
  simp_all
```

-- snippet 26
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.toWeightBasis (L298-L303)
def toWeightBasis :
    Basis b.support R M :=
Basis.mk b.linearIndepOn_root <| by
    change ⊤ ≤ span R (range <| P.root ∘ ((↑) : b.support → ι))
    simp [range_comp]
```

-- snippet 27
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.support_nonempty (L86-L91)
lemma support_nonempty [Nonempty ι] [NeZero (2 : R)] : b.support.Nonempty := by
by_contra! contra
  inhabit ι
  simpa [P.ne_zero default, contra] using b.root_mem_or_neg_mem default

/-- Interchanging roots and coroots, one still has a base of a root pairing. -/
```

-- snippet 28
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.coroot_mem_span_int (L126-L129)
lemma coroot_mem_span_int (i : ι) :
    P.coroot i ∈ span ℤ (P.coroot '' b.support) :=
b.flip.root_mem_span_int i
```

-- snippet 29
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.span_int_coroot_support (L138-L141)
lemma span_int_coroot_support :
    span ℤ (P.coroot '' b.support) = span ℤ (range P.coroot) :=
b.flip.span_int_root_support
```

-- snippet 30
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.pairingIn_le_zero_of_ne (L273-L281)
lemma pairingIn_le_zero_of_ne [IsDomain R] [P.IsCrystallographic] [Finite ι]
    {i j} (hij : i ≠ j) (hi : i ∈ b.support) (hj : j ∈ b.support) :
    P.pairingIn ℤ i j ≤ 0 := by
by_contra! h
  exact b.sub_notMem_range_root hi hj <| P.root_sub_root_mem_of_pairingIn_pos h hij

variable {b}
variable [IsDomain R] [P.IsCrystallographic] [Finite ι] {i j : b.support}
```

-- snippet 31
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.eq_one_or_neg_one_of_mem_support_of_smul_mem_aux (L153-L179)
lemma eq_one_or_neg_one_of_mem_support_of_smul_mem_aux [Finite ι]
    [IsAddTorsionFree M] [IsAddTorsionFree N]
    (i : ι) (h : i ∈ b.support) (t : R) (ht : t • P.root i ∈ range P.root) :
    ∃ z : ℤ, z * t = 1 := by
classical
  obtain ⟨j, hj⟩ := ht
  obtain ⟨f, hf⟩ : ∃ f : b.support → ℤ, P.coroot i = ∑ i, (t * f i) • P.coroot i := by
    have : P.coroot j ∈ span ℤ (P.coroot '' b.support) := b.coroot_mem_span_int j
    rw [image_eq_range, mem_span_range_iff_exists_fun] at this
    refine this.imp fun f hf ↦ ?_
    simp only [Finset.coe_sort_coe] at hf
    simp_rw [mul_smul, ← Finset.smul_sum, Int.cast_smul_eq_zsmul, hf,
      coroot_eq_smul_coroot_iff.mpr hj]
  use f ⟨i, h⟩
  replace hf : P.coroot i = linearCombination R (fun k : b.support ↦ P.coroot k)
      (t • (linearEquivFunOnFinite R _ _).symm (fun x ↦ (f x : R))) := by
    rw [map_smul, linearCombination_eq_fintype_linearCombination_apply,
      Fintype.linearCombination_apply, hf]
    simp_rw [mul_smul, ← Finset.smul_sum]
  let g : b.support →₀ R := single ⟨i, h⟩ 1
  have hg : P.coroot i = linearCombination R (fun k : b.support ↦ P.coroot k) g := by simp [g]
  rw [hg] at hf
  have : Injective (linearCombination R fun k : b.support ↦ P.coroot k) := b.linearIndepOn_coroot
  simpa [g, linearEquivFunOnFinite, mul_comm t] using (DFunLike.congr_fun (this hf) ⟨i, h⟩).symm

variable [CharZero R]
```

-- snippet 32
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.span_root_support (L143-L146)
lemma span_root_support :
    span R (P.root '' b.support) = P.rootSpan R := by
rw [← span_span_of_tower (R := ℤ), span_int_root_support, span_span_of_tower]
```

-- snippet 33
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.sub_notMem_range_root (L251-L267)
lemma sub_notMem_range_root
    {i j : ι} (hi : i ∈ b.support) (hj : j ∈ b.support) :
    P.root i - P.root j ∉ range P.root := by
rcases eq_or_ne j i with rfl | hij
  · simpa only [sub_self, mem_range, not_exists] using fun k ↦ P.ne_zero k
  classical
  let f : ι → ℤ := fun k ↦ if k = i then 1 else if k = j then -1 else 0
  have hf : ∑ k ∈ b.support, f k • P.root k = P.root i - P.root j := by
    have : {i, j} ⊆ b.support := by aesop (add simp Finset.insert_subset_iff)
    rw [← Finset.sum_subset (s₁ := {i, j}) (s₂ := b.support) (by lia) (by aesop),
      Finset.sum_insert (by grind), Finset.sum_singleton]
    simp [f, hij, sub_eq_add_neg]
  intro contra
  rcases b.pos_or_neg_of_sum_smul_root_mem f (by rwa [hf]) (by aesop) with pos | neg
  · simpa [hij, f] using le_of_lt pos j
  · simpa [hij, f] using le_of_lt neg i
```

-- snippet 34
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.exists_root_eq_sum_int (L355-L374)
lemma exists_root_eq_sum_int [CharZero R] (i : ι) :
    ∃ f : ι → ℤ, f.support ⊆ b.support ∧ (0 < f ∨ f < 0) ∧
      P.root i = ∑ j ∈ b.support, f j • P.root j := by
obtain ⟨f, hf, hf' | hf'⟩ := b.exists_root_eq_sum_nat_or_neg i
  · refine ⟨Nat.cast ∘ f, by simpa, Or.inl <| Pi.lt_def.mpr ⟨fun _ ↦ by simp, ?_⟩, by simp [hf']⟩
    by_contra! contra
    replace contra : f = 0 := by ext i; simpa using contra i
    exact P.ne_zero i <| by simp [hf', contra]
  · refine ⟨-Nat.cast ∘ f, by simpa, Or.inr <| Pi.lt_def.mpr ⟨fun _ ↦ by simp, ?_⟩, by simp [hf']⟩
    by_contra! contra
    replace contra : f = 0 := by ext i; simpa using contra i
    exact P.ne_zero i <| by simp [hf', contra]

end RootPairing

section PositiveRoots

variable {P : RootPairing ι R M N} (b : P.Base) [CharZero R]

/-- Given a base `α₁, α₂, …`, the height of a root `∑ zᵢαᵢ` relative to this base is `∑ zᵢ`. -/
```

-- snippet 35
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.eq_one_or_neg_one_of_mem_support_of_smul_mem (L180-L198)
lemma eq_one_or_neg_one_of_mem_support_of_smul_mem [Finite ι]
    [IsAddTorsionFree M] [IsAddTorsionFree N]
    (i : ι) (h : i ∈ b.support) (t : R) (ht : t • P.root i ∈ range P.root) :
    t = 1 ∨ t = -1 := by
obtain ⟨z, hz⟩ := b.eq_one_or_neg_one_of_mem_support_of_smul_mem_aux i h t ht
  replace ht : (z : R) • P.coroot i ∈ range P.coroot := by
    obtain ⟨j, hj⟩ := ht
    simpa only [coroot_eq_smul_coroot_iff.mpr hj, smul_smul, hz, one_smul] using mem_range_self j
  obtain ⟨w, hw⟩ := b.flip.eq_one_or_neg_one_of_mem_support_of_smul_mem_aux i h _ ht
  have : (z : R) * w = 1 := by
    simpa [mul_mul_mul_comm _ t, mul_comm t, mul_comm _ (z : R), hz] using congr_arg₂ (· * ·) hz hw
  suffices z = 1 ∨ z = -1 by
    rcases this with rfl | rfl
    · left; simpa using hz
    · right; simpa [neg_eq_iff_eq_neg] using hz
  norm_cast at this
  rw [Int.mul_eq_one_iff_eq_one_or_neg_one] at this
  tauto
```

-- snippet 36
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.root_mem_span_int (L116-L125)
lemma root_mem_span_int (i : ι) :
    P.root i ∈ span ℤ (P.root '' b.support) := by
have := b.root_mem_or_neg_mem i
  simp only [← span_nat_eq_addSubmonoidClosure, mem_toAddSubmonoid] at this
  rw [← span_span_of_tower (R := ℕ)]
  rcases this with hi | hi
  · exact subset_span hi
  · rw [← neg_mem_iff]
    exact subset_span hi
```

-- snippet 37
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.sub_notMem_range_coroot (L268-L272)
lemma sub_notMem_range_coroot
    {i j : ι} (hi : i ∈ b.support) (hj : j ∈ b.support) :
    P.coroot i - P.coroot j ∉ range P.coroot :=
b.flip.sub_notMem_range_root hi hj
```

-- snippet 38
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.height_eq_sum (L379-L391)
lemma height_eq_sum {i : ι} {f : ι → ℤ} (heq : P.root i = ∑ j ∈ b.support, f j • P.root j) :
    b.height i = ∑ j ∈ b.support, f j := by
suffices ∀ j ∈ b.support, (b.exists_root_eq_sum_int i).choose j = f j from
    Finset.sum_congr rfl this
  intro j hj
  obtain ⟨-, -, h⟩ := (b.exists_root_eq_sum_int i).choose_spec
  rw [h, b.support.sum_subtype (p := (· ∈ b.support)) (by simp) (F := inferInstance),
    b.support.sum_subtype (p := (· ∈ b.support)) (by simp) (F := inferInstance)] at heq
  have aux (j : b.support) := Fintype.linearIndependent_iffₛ.mp
      (b.linearIndepOn_root.restrict_scalars' ℤ) ((b.exists_root_eq_sum_int i).choose ∘ (↑))
      (f ∘ (↑)) (by simpa) j
  simpa using aux ⟨j, hj⟩
```

-- snippet 39
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.exists_root_eq_sum_nat_or_neg (L334-L354)
lemma exists_root_eq_sum_nat_or_neg (i : ι) :
    ∃ f : ι → ℕ, f.support ⊆ b.support ∧
      (P.root i =   ∑ j ∈ b.support, f j • P.root j ∨
       P.root i = - ∑ j ∈ b.support, f j • P.root j) := by
classical
  simp_rw [← neg_eq_iff_eq_neg]
  suffices ∀ m ∈ AddSubmonoid.closure (P.root '' b.support),
    ∃ f : ι → ℕ, f.support ⊆ b.support ∧ m = ∑ j ∈ b.support, f j • P.root j by
    rcases b.root_mem_or_neg_mem i with hi | hi
    · obtain ⟨f, hf, hf'⟩ := this _ hi
      exact ⟨f, hf, Or.inl hf'⟩
    · obtain ⟨f, hf, hf'⟩ := this _ hi
      exact ⟨f, hf, Or.inr hf'⟩
  intro m hm
  refine AddSubmonoid.closure_induction ?_ ⟨0, by simp⟩ ?_ hm
  · rintro - ⟨j, hj, rfl⟩
    exact ⟨Pi.single j 1, by simpa, by aesop (add simp Pi.single_apply)⟩
  · intro _ _ _ _ ⟨f, hf, hf'⟩ ⟨g, hg, hg'⟩
    refine ⟨f + g, ?_, by simp [hf', hg', add_smul, Finset.sum_add_distrib]⟩
    exact (support_add f g).trans <| union_subset_iff.mpr ⟨hf, hg⟩
```

-- snippet 40
```lean
-- Mathlib.LinearAlgebra.RootSystem.Base.linearIndependent_pair_of_ne (L110-L115)
lemma linearIndependent_pair_of_ne {i j : b.support} (hij : i ≠ j) :
    LinearIndependent R ![P.root i, P.root j] := by
have : ({(j : ι), (i : ι)} : Set ι) ⊆ b.support := by simp [pair_subset_iff]
  rw [← linearIndepOn_id_range_iff (by simp_all)]
  simpa [image_pair] using LinearIndepOn.id_image <| b.linearIndepOn_root.mono this
```
[/INST]

mistral-common:Tekken v15 (Mistral chat template, [INST]/[SYSTEM_PROMPT])


[System] You are Leanstral, a Lean 4 proof assistant. Complete the task below using the provided Lean source context. The target mathlib commit is 5e932f97dd25535344f80f9dd8da3aab83df0fe6 (module Mathlib.Algebra.Category.Grp.Basic).

[User]
Prove the following theorem. The retrieved context below may help.

```lean
def commGroupIsoToMulEquiv {X Y : CommGrpCat} (i : X ≅ Y) : X ≃* Y
```

## Retrieved context
-- snippet 1
```lean
-- Mathlib.Algebra.Category.Grp.Basic.of (L59-L63)
abbrev of (M : Type u) [Group M] : GrpCat := ⟨M⟩
end GrpCat

/-- The type of morphisms in `AddGrpCat R`. -/
```

-- snippet 2
```lean
-- Mathlib.Algebra.Category.Grp.Basic.Hom (L97-L100)
abbrev Hom.hom {X Y : GrpCat.{u}} (f : Hom X Y) :=
ConcreteCategory.hom (C := GrpCat) f

/-- Typecheck a `MonoidHom` as a morphism in `GrpCat`. -/
```

-- snippet 3
```lean
-- Mathlib.Algebra.Category.Grp.Basic.ofHom (L102-L106)
abbrev ofHom {X Y : Type u} [Group X] [Group Y] (f : X →* Y) : of X ⟶ of Y :=
ConcreteCategory.ofHom (C := GrpCat) f

variable {R} in
/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/
```

-- snippet 4
```lean
-- Mathlib.Algebra.Category.Grp.Basic.Hom (L107-L116)
def Hom.Simps.hom (X Y : GrpCat.{u}) (f : Hom X Y) :=
f.hom

initialize_simps_projections Hom (hom' → hom)
initialize_simps_projections AddGrpCat.Hom (hom' → hom)

/-!
The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`.
-/
```

-- snippet 5
```lean
-- Mathlib.Algebra.Category.Grp.Basic.coe_id (L118-L119)
lemma coe_id {X : GrpCat} : (𝟙 X : X → X) = id := rfl
```

-- snippet 6
```lean
-- Mathlib.Algebra.Category.Grp.Basic.coe_comp (L121-L122)
lemma coe_comp {X Y Z : GrpCat} {f : X ⟶ Y} {g : Y ⟶ Z} : (f ≫ g : X → Z) = g ∘ f := rfl
```

-- snippet 7
```lean
-- Mathlib.Algebra.Category.Grp.Basic.ext (L126-L128)
lemma ext {X Y : GrpCat} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g :=
ConcreteCategory.hom_ext _ _ w
```

-- snippet 8
```lean
-- Mathlib.Algebra.Category.Grp.Basic.coe_of (L131-L133)
theorem coe_of (R : Type u) [Group R] : ↑(GrpCat.of R) = R :=
rfl
```

-- snippet 9
```lean
-- Mathlib.Algebra.Category.Grp.Basic.hom_id (L135-L137)
lemma hom_id {X : GrpCat} : (𝟙 X : X ⟶ X).hom = MonoidHom.id X := rfl
/- Provided for rewriting. -/
```

-- snippet 10
```lean
-- Mathlib.Algebra.Category.Grp.Basic.id_apply (L139-L141)
lemma id_apply (X : GrpCat) (x : X) :
    (𝟙 X : X ⟶ X) x = x := by simp
```

-- snippet 11
```lean
-- Mathlib.Algebra.Category.Grp.Basic.hom_comp (L143-L146)
lemma hom_comp {X Y T : GrpCat} (f : X ⟶ Y) (g : Y ⟶ T) :
    (f ≫ g).hom = g.hom.comp f.hom := rfl
/- Provided for rewriting. -/
```

-- snippet 12
```lean
-- Mathlib.Algebra.Category.Grp.Basic.comp_apply (L148-L150)
lemma comp_apply {X Y T : GrpCat} (f : X ⟶ Y) (g : Y ⟶ T) (x : X) :
    (f ≫ g) x = g (f x) := by simp
```

-- snippet 13
```lean
-- Mathlib.Algebra.Category.Grp.Basic.hom_ext (L152-L154)
lemma hom_ext {X Y : GrpCat} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g :=
Hom.ext hf
```

-- snippet 14
```lean
-- Mathlib.Algebra.Category.Grp.Basic.hom_ofHom (L156-L157)
lemma hom_ofHom {R S : Type u} [Group R] [Group S] (f : R →* S) : (ofHom f).hom = f := rfl
```

-- snippet 15
```lean
-- Mathlib.Algebra.Category.Grp.Basic.ofHom_hom (L159-L161)
lemma ofHom_hom {X Y : GrpCat} (f : X ⟶ Y) :
    ofHom (Hom.hom f) = f := rfl
```

-- snippet 16
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.hom_inv_apply (L145-L147)
lemma hom_inv_apply {A B : AlgCat.{v} R} (e : A ≅ B) (x : B) : e.hom (e.inv x) = x := by
simp
```

-- snippet 17
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.Hom (L83-L87)
abbrev Hom.hom {A B : AlgCat.{v} R} (f : Hom A B) :=
ConcreteCategory.hom (C := AlgCat R) f

variable {R} in
/-- Typecheck an `AlgHom` as a morphism in `AlgCat`. -/
```

-- snippet 18
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.of (L53-L55)
abbrev of (X : Type v) [Ring X] [Algebra R X] : AlgCat.{v} R :=
⟨X⟩
```

-- snippet 19
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.ofHom_comp (L134-L138)
lemma ofHom_comp {X Y Z : Type v} [Ring X] [Ring Y] [Ring Z] [Algebra R X] [Algebra R Y]
    [Algebra R Z] (f : X →ₐ[R] Y) (g : Y →ₐ[R] Z) :
    ofHom (g.comp f) = ofHom f ≫ ofHom g :=
rfl
```

-- snippet 20
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.comp_apply (L115-L117)
lemma comp_apply {A B C : AlgCat.{v} R} (f : A ⟶ B) (g : B ⟶ C) (a : A) :
    (f ≫ g) a = g (f a) := by simp
```

-- snippet 21
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.forget_map (L153-L156)
lemma forget_map {A B : AlgCat.{v} R} (f : A ⟶ B) :
    (forget (AlgCat.{v} R)).map f = (f : _ → _) :=
rfl
```

-- snippet 22
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.coe_of (L56-L61)
lemma coe_of (X : Type v) [Ring X] [Algebra R X] : (of R X : Type v) = X :=
rfl

variable {R} in
set_option backward.privateInPublic true in
/-- The type of morphisms in `AlgCat R`. -/
```

-- snippet 23
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.ofHom_hom (L127-L129)
lemma ofHom_hom {A B : AlgCat.{v} R} (f : A ⟶ B) :
    ofHom (Hom.hom f) = f := rfl
```

-- snippet 24
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.hasForgetToModule (L168-L172)
instance hasForgetToModule : HasForget₂ (AlgCat.{v} R) (ModuleCat.{v} R) where
  forget₂ :=
{ obj := fun M => ModuleCat.of R M
      map := fun f => ModuleCat.ofHom f.hom.toLinearMap }
```

-- snippet 25
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.ofHom_apply (L139-L141)
lemma ofHom_apply {R : Type u} [CommRing R] {X Y : Type v} [Ring X] [Algebra R X] [Ring Y]
    [Algebra R Y] (f : X →ₐ[R] Y) (x : X) : ofHom f x = f x := rfl
```

-- snippet 26
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.free (L185-L190)
def free : Type u ⥤ AlgCat.{u} R where
  obj S := of R (FreeAlgebra R S)
map f := ofHom <| FreeAlgebra.lift _ <| FreeAlgebra.ι _ ∘ f

set_option backward.isDefEq.respectTransparency false in
/-- The free/forget adjunction for `R`-algebras. -/
```

-- snippet 27
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.ofHom_id (L131-L132)
lemma ofHom_id {X : Type v} [Ring X] [Algebra R X] : ofHom (AlgHom.id R X) = 𝟙 (of R X) := rfl
```

-- snippet 28
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.AlgEquiv (L208-L215)
def AlgEquiv.toAlgebraIso {g₁ : Ring X₁} {g₂ : Ring X₂} {m₁ : Algebra R X₁} {m₂ : Algebra R X₂}
    (e : X₁ ≃ₐ[R] X₂) : AlgCat.of R X₁ ≅ AlgCat.of R X₂ where
  hom := AlgCat.ofHom (e : X₁ →ₐ[R] X₂)
inv := AlgCat.ofHom (e.symm : X₂ →ₐ[R] X₁)

namespace CategoryTheory.Iso

/-- Build an `AlgEquiv` from an isomorphism in the category `AlgCat R`. -/
```

-- snippet 29
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.id_apply (L107-L109)
lemma id_apply (A : AlgCat.{v} R) (a : A) :
    (𝟙 A : A ⟶ A) a = a := by simp
```

-- snippet 30
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.hom_id (L104-L106)
lemma hom_id {A : AlgCat.{v} R} : (𝟙 A : A ⟶ A).hom = AlgHom.id R A := rfl
/- Provided for rewriting. -/
```

-- snippet 31
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.hom_ofHom (L123-L125)
lemma hom_ofHom {R : Type u} [CommRing R] {X Y : Type v} [Ring X] [Algebra R X] [Ring Y]
    [Algebra R Y] (f : X →ₐ[R] Y) : (ofHom f).hom = f := rfl
```

-- snippet 32
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.forget₂_module_map (L179-L183)
lemma forget₂_module_map {X Y : AlgCat.{v} R} (f : X ⟶ Y) :
    (forget₂ (AlgCat.{v} R) (ModuleCat.{v} R)).map f = ModuleCat.ofHom f.hom.toLinearMap :=
rfl

/-- The "free algebra" functor, sending a type `S` to the free algebra on `S`. -/
```

-- snippet 33
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.forget_obj (L151-L152)
lemma forget_obj {A : AlgCat.{v} R} : (forget (AlgCat.{v} R)).obj A = A := rfl
```

-- snippet 34
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.inv_hom_apply (L142-L144)
lemma inv_hom_apply {A B : AlgCat.{v} R} (e : A ≅ B) (x : A) : e.inv (e.hom x) = x := by
simp
```

-- snippet 35
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.hom_comp (L111-L114)
lemma hom_comp {A B C : AlgCat.{v} R} (f : A ⟶ B) (g : B ⟶ C) :
    (f ≫ g).hom = g.hom.comp f.hom := rfl
/- Provided for rewriting. -/
```

-- snippet 36
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.ofHom (L88-L93)
abbrev ofHom {A B : Type v} [Ring A] [Ring B] [Algebra R A] [Algebra R B] (f : A →ₐ[R] B) :
    of R A ⟶ of R B :=
ConcreteCategory.ofHom (C := AlgCat R) f

variable {R} in
/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/
```

-- snippet 37
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.hom_ext (L119-L121)
lemma hom_ext {A B : AlgCat.{v} R} {f g : A ⟶ B} (hf : f.hom = g.hom) : f = g :=
Hom.ext hf
```

-- snippet 38
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.adj (L191-L198)
def adj : free.{u} R ⊣ forget (AlgCat.{u} R) :=
Adjunction.mkOfHomEquiv
    { homEquiv := fun _ _ =>
        { toFun := fun f ↦ (FreeAlgebra.lift _).symm f.hom
          invFun := fun f ↦ ofHom <| (FreeAlgebra.lift _) f
          left_inv := fun f ↦ by aesop
          right_inv := fun f ↦ by simp [forget_obj] } }
```

-- snippet 39
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.hasForgetToRing (L163-L167)
instance hasForgetToRing : HasForget₂ (AlgCat.{v} R) RingCat.{v} where
  forget₂ :=
{ obj := fun A => RingCat.of A
      map := fun f => RingCat.ofHom f.hom.toRingHom }
```

-- snippet 40
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.forget₂_module_obj (L174-L177)
lemma forget₂_module_obj (X : AlgCat.{v} R) :
    (forget₂ (AlgCat.{v} R) (ModuleCat.{v} R)).obj X = ModuleCat.of R X :=
rfl
```

<s>[SYSTEM_PROMPT]You are Leanstral, a Lean 4 proof assistant. Complete the task below using the provided Lean source context. The target mathlib commit is 5e932f97dd25535344f80f9dd8da3aab83df0fe6 (module Mathlib.Algebra.Category.Grp.Basic).[/SYSTEM_PROMPT][MODEL_SETTINGS]{"reasoning_effort": "none"}[/MODEL_SETTINGS][INST]Prove the following theorem. The retrieved context below may help.

```lean
def commGroupIsoToMulEquiv {X Y : CommGrpCat} (i : X ≅ Y) : X ≃* Y
```

## Retrieved context
-- snippet 1
```lean
-- Mathlib.Algebra.Category.Grp.Basic.of (L59-L63)
abbrev of (M : Type u) [Group M] : GrpCat := ⟨M⟩
end GrpCat

/-- The type of morphisms in `AddGrpCat R`. -/
```

-- snippet 2
```lean
-- Mathlib.Algebra.Category.Grp.Basic.Hom (L97-L100)
abbrev Hom.hom {X Y : GrpCat.{u}} (f : Hom X Y) :=
ConcreteCategory.hom (C := GrpCat) f

/-- Typecheck a `MonoidHom` as a morphism in `GrpCat`. -/
```

-- snippet 3
```lean
-- Mathlib.Algebra.Category.Grp.Basic.ofHom (L102-L106)
abbrev ofHom {X Y : Type u} [Group X] [Group Y] (f : X →* Y) : of X ⟶ of Y :=
ConcreteCategory.ofHom (C := GrpCat) f

variable {R} in
/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/
```

-- snippet 4
```lean
-- Mathlib.Algebra.Category.Grp.Basic.Hom (L107-L116)
def Hom.Simps.hom (X Y : GrpCat.{u}) (f : Hom X Y) :=
f.hom

initialize_simps_projections Hom (hom' → hom)
initialize_simps_projections AddGrpCat.Hom (hom' → hom)

/-!
The results below duplicate the `ConcreteCategory` simp lemmas, but we can keep them for `dsimp`.
-/
```

-- snippet 5
```lean
-- Mathlib.Algebra.Category.Grp.Basic.coe_id (L118-L119)
lemma coe_id {X : GrpCat} : (𝟙 X : X → X) = id := rfl
```

-- snippet 6
```lean
-- Mathlib.Algebra.Category.Grp.Basic.coe_comp (L121-L122)
lemma coe_comp {X Y Z : GrpCat} {f : X ⟶ Y} {g : Y ⟶ Z} : (f ≫ g : X → Z) = g ∘ f := rfl
```

-- snippet 7
```lean
-- Mathlib.Algebra.Category.Grp.Basic.ext (L126-L128)
lemma ext {X Y : GrpCat} {f g : X ⟶ Y} (w : ∀ x : X, f x = g x) : f = g :=
ConcreteCategory.hom_ext _ _ w
```

-- snippet 8
```lean
-- Mathlib.Algebra.Category.Grp.Basic.coe_of (L131-L133)
theorem coe_of (R : Type u) [Group R] : ↑(GrpCat.of R) = R :=
rfl
```

-- snippet 9
```lean
-- Mathlib.Algebra.Category.Grp.Basic.hom_id (L135-L137)
lemma hom_id {X : GrpCat} : (𝟙 X : X ⟶ X).hom = MonoidHom.id X := rfl
/- Provided for rewriting. -/
```

-- snippet 10
```lean
-- Mathlib.Algebra.Category.Grp.Basic.id_apply (L139-L141)
lemma id_apply (X : GrpCat) (x : X) :
    (𝟙 X : X ⟶ X) x = x := by simp
```

-- snippet 11
```lean
-- Mathlib.Algebra.Category.Grp.Basic.hom_comp (L143-L146)
lemma hom_comp {X Y T : GrpCat} (f : X ⟶ Y) (g : Y ⟶ T) :
    (f ≫ g).hom = g.hom.comp f.hom := rfl
/- Provided for rewriting. -/
```

-- snippet 12
```lean
-- Mathlib.Algebra.Category.Grp.Basic.comp_apply (L148-L150)
lemma comp_apply {X Y T : GrpCat} (f : X ⟶ Y) (g : Y ⟶ T) (x : X) :
    (f ≫ g) x = g (f x) := by simp
```

-- snippet 13
```lean
-- Mathlib.Algebra.Category.Grp.Basic.hom_ext (L152-L154)
lemma hom_ext {X Y : GrpCat} {f g : X ⟶ Y} (hf : f.hom = g.hom) : f = g :=
Hom.ext hf
```

-- snippet 14
```lean
-- Mathlib.Algebra.Category.Grp.Basic.hom_ofHom (L156-L157)
lemma hom_ofHom {R S : Type u} [Group R] [Group S] (f : R →* S) : (ofHom f).hom = f := rfl
```

-- snippet 15
```lean
-- Mathlib.Algebra.Category.Grp.Basic.ofHom_hom (L159-L161)
lemma ofHom_hom {X Y : GrpCat} (f : X ⟶ Y) :
    ofHom (Hom.hom f) = f := rfl
```

-- snippet 16
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.hom_inv_apply (L145-L147)
lemma hom_inv_apply {A B : AlgCat.{v} R} (e : A ≅ B) (x : B) : e.hom (e.inv x) = x := by
simp
```

-- snippet 17
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.Hom (L83-L87)
abbrev Hom.hom {A B : AlgCat.{v} R} (f : Hom A B) :=
ConcreteCategory.hom (C := AlgCat R) f

variable {R} in
/-- Typecheck an `AlgHom` as a morphism in `AlgCat`. -/
```

-- snippet 18
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.of (L53-L55)
abbrev of (X : Type v) [Ring X] [Algebra R X] : AlgCat.{v} R :=
⟨X⟩
```

-- snippet 19
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.ofHom_comp (L134-L138)
lemma ofHom_comp {X Y Z : Type v} [Ring X] [Ring Y] [Ring Z] [Algebra R X] [Algebra R Y]
    [Algebra R Z] (f : X →ₐ[R] Y) (g : Y →ₐ[R] Z) :
    ofHom (g.comp f) = ofHom f ≫ ofHom g :=
rfl
```

-- snippet 20
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.comp_apply (L115-L117)
lemma comp_apply {A B C : AlgCat.{v} R} (f : A ⟶ B) (g : B ⟶ C) (a : A) :
    (f ≫ g) a = g (f a) := by simp
```

-- snippet 21
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.forget_map (L153-L156)
lemma forget_map {A B : AlgCat.{v} R} (f : A ⟶ B) :
    (forget (AlgCat.{v} R)).map f = (f : _ → _) :=
rfl
```

-- snippet 22
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.coe_of (L56-L61)
lemma coe_of (X : Type v) [Ring X] [Algebra R X] : (of R X : Type v) = X :=
rfl

variable {R} in
set_option backward.privateInPublic true in
/-- The type of morphisms in `AlgCat R`. -/
```

-- snippet 23
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.ofHom_hom (L127-L129)
lemma ofHom_hom {A B : AlgCat.{v} R} (f : A ⟶ B) :
    ofHom (Hom.hom f) = f := rfl
```

-- snippet 24
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.hasForgetToModule (L168-L172)
instance hasForgetToModule : HasForget₂ (AlgCat.{v} R) (ModuleCat.{v} R) where
  forget₂ :=
{ obj := fun M => ModuleCat.of R M
      map := fun f => ModuleCat.ofHom f.hom.toLinearMap }
```

-- snippet 25
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.ofHom_apply (L139-L141)
lemma ofHom_apply {R : Type u} [CommRing R] {X Y : Type v} [Ring X] [Algebra R X] [Ring Y]
    [Algebra R Y] (f : X →ₐ[R] Y) (x : X) : ofHom f x = f x := rfl
```

-- snippet 26
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.free (L185-L190)
def free : Type u ⥤ AlgCat.{u} R where
  obj S := of R (FreeAlgebra R S)
map f := ofHom <| FreeAlgebra.lift _ <| FreeAlgebra.ι _ ∘ f

set_option backward.isDefEq.respectTransparency false in
/-- The free/forget adjunction for `R`-algebras. -/
```

-- snippet 27
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.ofHom_id (L131-L132)
lemma ofHom_id {X : Type v} [Ring X] [Algebra R X] : ofHom (AlgHom.id R X) = 𝟙 (of R X) := rfl
```

-- snippet 28
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.AlgEquiv (L208-L215)
def AlgEquiv.toAlgebraIso {g₁ : Ring X₁} {g₂ : Ring X₂} {m₁ : Algebra R X₁} {m₂ : Algebra R X₂}
    (e : X₁ ≃ₐ[R] X₂) : AlgCat.of R X₁ ≅ AlgCat.of R X₂ where
  hom := AlgCat.ofHom (e : X₁ →ₐ[R] X₂)
inv := AlgCat.ofHom (e.symm : X₂ →ₐ[R] X₁)

namespace CategoryTheory.Iso

/-- Build an `AlgEquiv` from an isomorphism in the category `AlgCat R`. -/
```

-- snippet 29
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.id_apply (L107-L109)
lemma id_apply (A : AlgCat.{v} R) (a : A) :
    (𝟙 A : A ⟶ A) a = a := by simp
```

-- snippet 30
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.hom_id (L104-L106)
lemma hom_id {A : AlgCat.{v} R} : (𝟙 A : A ⟶ A).hom = AlgHom.id R A := rfl
/- Provided for rewriting. -/
```

-- snippet 31
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.hom_ofHom (L123-L125)
lemma hom_ofHom {R : Type u} [CommRing R] {X Y : Type v} [Ring X] [Algebra R X] [Ring Y]
    [Algebra R Y] (f : X →ₐ[R] Y) : (ofHom f).hom = f := rfl
```

-- snippet 32
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.forget₂_module_map (L179-L183)
lemma forget₂_module_map {X Y : AlgCat.{v} R} (f : X ⟶ Y) :
    (forget₂ (AlgCat.{v} R) (ModuleCat.{v} R)).map f = ModuleCat.ofHom f.hom.toLinearMap :=
rfl

/-- The "free algebra" functor, sending a type `S` to the free algebra on `S`. -/
```

-- snippet 33
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.forget_obj (L151-L152)
lemma forget_obj {A : AlgCat.{v} R} : (forget (AlgCat.{v} R)).obj A = A := rfl
```

-- snippet 34
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.inv_hom_apply (L142-L144)
lemma inv_hom_apply {A B : AlgCat.{v} R} (e : A ≅ B) (x : A) : e.inv (e.hom x) = x := by
simp
```

-- snippet 35
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.hom_comp (L111-L114)
lemma hom_comp {A B C : AlgCat.{v} R} (f : A ⟶ B) (g : B ⟶ C) :
    (f ≫ g).hom = g.hom.comp f.hom := rfl
/- Provided for rewriting. -/
```

-- snippet 36
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.ofHom (L88-L93)
abbrev ofHom {A B : Type v} [Ring A] [Ring B] [Algebra R A] [Algebra R B] (f : A →ₐ[R] B) :
    of R A ⟶ of R B :=
ConcreteCategory.ofHom (C := AlgCat R) f

variable {R} in
/-- Use the `ConcreteCategory.hom` projection for `@[simps]` lemmas. -/
```

-- snippet 37
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.hom_ext (L119-L121)
lemma hom_ext {A B : AlgCat.{v} R} {f g : A ⟶ B} (hf : f.hom = g.hom) : f = g :=
Hom.ext hf
```

-- snippet 38
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.adj (L191-L198)
def adj : free.{u} R ⊣ forget (AlgCat.{u} R) :=
Adjunction.mkOfHomEquiv
    { homEquiv := fun _ _ =>
        { toFun := fun f ↦ (FreeAlgebra.lift _).symm f.hom
          invFun := fun f ↦ ofHom <| (FreeAlgebra.lift _) f
          left_inv := fun f ↦ by aesop
          right_inv := fun f ↦ by simp [forget_obj] } }
```

-- snippet 39
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.hasForgetToRing (L163-L167)
instance hasForgetToRing : HasForget₂ (AlgCat.{v} R) RingCat.{v} where
  forget₂ :=
{ obj := fun A => RingCat.of A
      map := fun f => RingCat.ofHom f.hom.toRingHom }
```

-- snippet 40
```lean
-- Mathlib.Algebra.Category.AlgCat.Basic.forget₂_module_obj (L174-L177)
lemma forget₂_module_obj (X : AlgCat.{v} R) :
    (forget₂ (AlgCat.{v} R) (ModuleCat.{v} R)).obj X = ModuleCat.of R X :=
rfl
```
[/INST]