/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau

! This file was ported from Lean 3 source module ring_theory.adjoin.tower
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Adjoin.Fg

/-!
# Adjoining elements and being finitely generated in an algebra tower

## Main results

 * `algebra.fg_trans'`: if `S` is finitely generated as `R`-algebra and `A` as `S`-algebra,
   then `A` is finitely generated as `R`-algebra
 * `fg_of_fg_of_fg`: **Artin--Tate lemma**: if C/B/A is a tower of rings, and A is noetherian, and
   C is algebra-finite over A, and C is module-finite over B, then B is algebra-finite over A.
-/

open Pointwise

universe u v w u₁

variable (R : Type u) (S : Type v) (A : Type w) (B : Type u₁)

namespace Algebra

theorem adjoin_algebraMap (R : Type u) (S : Type v) (A : Type w) [CommSemiring R] [CommSemiring S]
    [Semiring A] [Algebra R S] [Algebra S A] [Algebra R A] [IsScalarTower R S A] (s : Set S) :
    adjoin R (algebraMap S A '' s) = (adjoin R s).map (IsScalarTower.toAlgHom R S A) :=
  le_antisymm (adjoin_le <| Set.image_subset_iff.2 fun y hy => ⟨y, subset_adjoin hy, rfl⟩)
    (Subalgebra.map_le.2 <| adjoin_le fun y hy => subset_adjoin ⟨y, hy, rfl⟩)
#align algebra.adjoin_algebra_map Algebra.adjoin_algebraMap

theorem adjoin_restrictScalars (C D E : Type _) [CommSemiring C] [CommSemiring D] [CommSemiring E]
    [Algebra C D] [Algebra C E] [Algebra D E] [IsScalarTower C D E] (S : Set E) :
    (Algebra.adjoin D S).restrictScalars C =
      (Algebra.adjoin ((⊤ : Subalgebra C D).map (IsScalarTower.toAlgHom C D E)) S).restrictScalars
        C :=
  by
  suffices
    Set.range (algebraMap D E) =
      Set.range (algebraMap ((⊤ : Subalgebra C D).map (IsScalarTower.toAlgHom C D E)) E)
    by
    ext x
    change x ∈ Subsemiring.closure (_ ∪ S) ↔ x ∈ Subsemiring.closure (_ ∪ S)
    rw [this]
  ext x
  constructor
  · rintro ⟨y, hy⟩
    exact ⟨⟨algebraMap D E y, ⟨y, ⟨Algebra.mem_top, rfl⟩⟩⟩, hy⟩
  · rintro ⟨⟨y, ⟨z, ⟨h0, h1⟩⟩⟩, h2⟩
    exact ⟨z, Eq.trans h1 h2⟩
#align algebra.adjoin_restrict_scalars Algebra.adjoin_restrictScalars

theorem adjoin_res_eq_adjoin_res (C D E F : Type _) [CommSemiring C] [CommSemiring D]
    [CommSemiring E] [CommSemiring F] [Algebra C D] [Algebra C E] [Algebra C F] [Algebra D F]
    [Algebra E F] [IsScalarTower C D F] [IsScalarTower C E F] {S : Set D} {T : Set E}
    (hS : Algebra.adjoin C S = ⊤) (hT : Algebra.adjoin C T = ⊤) :
    (Algebra.adjoin E (algebraMap D F '' S)).restrictScalars C =
      (Algebra.adjoin D (algebraMap E F '' T)).restrictScalars C :=
  by
  rw [adjoin_restrict_scalars C E, adjoin_restrict_scalars C D, ← hS, ← hT, ← Algebra.adjoin_image,
    ← Algebra.adjoin_image, ← AlgHom.coe_toRingHom, ← AlgHom.coe_toRingHom,
    IsScalarTower.coe_toAlgHom, IsScalarTower.coe_toAlgHom, ← adjoin_union_eq_adjoin_adjoin, ←
    adjoin_union_eq_adjoin_adjoin, Set.union_comm]
#align algebra.adjoin_res_eq_adjoin_res Algebra.adjoin_res_eq_adjoin_res

end Algebra

section

open Classical

theorem Algebra.fg_trans' {R S A : Type _} [CommSemiring R] [CommSemiring S] [CommSemiring A]
    [Algebra R S] [Algebra S A] [Algebra R A] [IsScalarTower R S A] (hRS : (⊤ : Subalgebra R S).Fg)
    (hSA : (⊤ : Subalgebra S A).Fg) : (⊤ : Subalgebra R A).Fg :=
  let ⟨s, hs⟩ := hRS
  let ⟨t, ht⟩ := hSA
  ⟨s.image (algebraMap S A) ∪ t, by
    rw [Finset.coe_union, Finset.coe_image, Algebra.adjoin_union_eq_adjoin_adjoin,
      Algebra.adjoin_algebraMap, hs, Algebra.map_top, IsScalarTower.adjoin_range_toAlgHom, ht,
      Subalgebra.restrictScalars_top]⟩
#align algebra.fg_trans' Algebra.fg_trans'

end

section ArtinTate

variable (C : Type _)

section Semiring

variable [CommSemiring A] [CommSemiring B] [Semiring C]

variable [Algebra A B] [Algebra B C] [Algebra A C] [IsScalarTower A B C]

open Finset Submodule

open Classical

theorem exists_subalgebra_of_fg (hAC : (⊤ : Subalgebra A C).Fg) (hBC : (⊤ : Submodule B C).Fg) :
    ∃ B₀ : Subalgebra A B, B₀.Fg ∧ (⊤ : Submodule B₀ C).Fg :=
  by
  cases' hAC with x hx
  cases' hBC with y hy
  have := hy
  simp_rw [eq_top_iff', mem_span_finset] at this
  choose f hf
  let s : Finset B := Finset.image₂ f (x ∪ y * y) y
  have hxy :
    ∀ xi ∈ x, xi ∈ span (Algebra.adjoin A (↑s : Set B)) (↑(insert 1 y : Finset C) : Set C) :=
    fun xi hxi =>
    hf xi ▸
      sum_mem fun yj hyj =>
        smul_mem (span (Algebra.adjoin A (↑s : Set B)) (↑(insert 1 y : Finset C) : Set C))
          ⟨f xi yj, Algebra.subset_adjoin <| mem_image₂_of_mem (mem_union_left _ hxi) hyj⟩
          (subset_span <| mem_insert_of_mem hyj)
  have hyy :
    span (Algebra.adjoin A (↑s : Set B)) (↑(insert 1 y : Finset C) : Set C) *
        span (Algebra.adjoin A (↑s : Set B)) (↑(insert 1 y : Finset C) : Set C) ≤
      span (Algebra.adjoin A (↑s : Set B)) (↑(insert 1 y : Finset C) : Set C) :=
    by
    rw [span_mul_span, span_le, coe_insert]
    rintro _ ⟨yi, yj, rfl | hyi, rfl | hyj, rfl⟩
    · rw [mul_one]
      exact subset_span (Set.mem_insert _ _)
    · rw [one_mul]
      exact subset_span (Set.mem_insert_of_mem _ hyj)
    · rw [mul_one]
      exact subset_span (Set.mem_insert_of_mem _ hyi)
    · rw [← hf (yi * yj)]
      exact
        SetLike.mem_coe.2
          (sum_mem fun yk hyk =>
            smul_mem (span (Algebra.adjoin A (↑s : Set B)) (insert 1 ↑y : Set C))
              ⟨f (yi * yj) yk,
                Algebra.subset_adjoin <|
                  mem_image₂_of_mem (mem_union_right _ <| mul_mem_mul hyi hyj) hyk⟩
              (subset_span <| Set.mem_insert_of_mem _ hyk : yk ∈ _))
  refine' ⟨Algebra.adjoin A (↑s : Set B), Subalgebra.fg_adjoin_finset _, insert 1 y, _⟩
  refine' restrict_scalars_injective A _ _ _
  rw [restrict_scalars_top, eq_top_iff, ← Algebra.top_toSubmodule, ← hx, Algebra.adjoin_eq_span,
    span_le]
  refine' fun r hr =>
    Submonoid.closure_induction hr (fun c hc => hxy c hc) (subset_span <| mem_insert_self _ _)
      fun p q hp hq => hyy <| Submodule.mul_mem_mul hp hq
#align exists_subalgebra_of_fg exists_subalgebra_of_fg

end Semiring

section Ring

variable [CommRing A] [CommRing B] [CommRing C]

variable [Algebra A B] [Algebra B C] [Algebra A C] [IsScalarTower A B C]

/-- **Artin--Tate lemma**: if A ⊆ B ⊆ C is a chain of subrings of commutative rings, and
A is noetherian, and C is algebra-finite over A, and C is module-finite over B,
then B is algebra-finite over A.

References: Atiyah--Macdonald Proposition 7.8; Stacks 00IS; Altman--Kleiman 16.17. -/
theorem fg_of_fg_of_fg [IsNoetherianRing A] (hAC : (⊤ : Subalgebra A C).Fg)
    (hBC : (⊤ : Submodule B C).Fg) (hBCi : Function.Injective (algebraMap B C)) :
    (⊤ : Subalgebra A B).Fg :=
  let ⟨B₀, hAB₀, hB₀C⟩ := exists_subalgebra_of_fg A B C hAC hBC
  Algebra.fg_trans' (B₀.fg_top.2 hAB₀) <|
    Subalgebra.fg_of_submodule_fg <|
      have : IsNoetherianRing B₀ := isNoetherianRing_of_fg hAB₀
      have : IsNoetherian B₀ C := isNoetherian_of_fg_of_noetherian' hB₀C
      fg_of_injective (IsScalarTower.toAlgHom B₀ B C).toLinearMap hBCi
#align fg_of_fg_of_fg fg_of_fg_of_fg

end Ring

end ArtinTate


/-
Copyright (c) 2022 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang

! This file was ported from Lean 3 source module topology.noetherian_space
! leanprover-community/mathlib commit 34ee86e6a59d911a8e4f89b68793ee7577ae79c7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.CompactlyGenerated
import Mathbin.Topology.Sets.Closeds

/-!
# Noetherian space

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

A Noetherian space is a topological space that satisfies any of the following equivalent conditions:
- `well_founded ((>) : opens α → opens α → Prop)`
- `well_founded ((<) : closeds α → closeds α → Prop)`
- `∀ s : set α, is_compact s`
- `∀ s : opens α, is_compact s`

The first is chosen as the definition, and the equivalence is shown in
`topological_space.noetherian_space_tfae`.

Many examples of noetherian spaces come from algebraic topology. For example, the underlying space
of a noetherian scheme (e.g., the spectrum of a noetherian ring) is noetherian.

## Main Results
- `noetherian_space.set`: Every subspace of a noetherian space is noetherian.
- `noetherian_space.is_compact`: Every subspace of a noetherian space is compact.
- `noetherian_space_tfae`: Describes the equivalent definitions of noetherian spaces.
- `noetherian_space.range`: The image of a noetherian space under a continuous map is noetherian.
- `noetherian_space.Union`: The finite union of noetherian spaces is noetherian.
- `noetherian_space.discrete`: A noetherian and hausdorff space is discrete.
- `noetherian_space.exists_finset_irreducible` : Every closed subset of a noetherian space is a
  finite union of irreducible closed subsets.
- `noetherian_space.finite_irreducible_components `: The number of irreducible components of a
  noetherian space is finite.

-/

variable (α β : Type _) [TopologicalSpace α] [TopologicalSpace β]

namespace TopologicalSpace

#print TopologicalSpace.NoetherianSpace /-
/-- Type class for noetherian spaces. It is defined to be spaces whose open sets satisfies ACC. -/
@[mk_iff]
class NoetherianSpace : Prop where
  WellFounded : WellFounded ((· > ·) : Opens α → Opens α → Prop)
#align topological_space.noetherian_space TopologicalSpace.NoetherianSpace
-/

#print TopologicalSpace.noetherianSpace_iff_opens /-
theorem noetherianSpace_iff_opens : NoetherianSpace α ↔ ∀ s : Opens α, IsCompact (s : Set α) :=
  by
  rw [noetherian_space_iff, CompleteLattice.wellFounded_iff_isSupFiniteCompact,
    CompleteLattice.isSupFiniteCompact_iff_all_elements_compact]
  exact forall_congr' opens.is_compact_element_iff
#align topological_space.noetherian_space_iff_opens TopologicalSpace.noetherianSpace_iff_opens
-/

#print TopologicalSpace.NoetherianSpace.compactSpace /-
instance (priority := 100) NoetherianSpace.compactSpace [h : NoetherianSpace α] : CompactSpace α :=
  ⟨(noetherianSpace_iff_opens α).mp h ⊤⟩
#align topological_space.noetherian_space.compact_space TopologicalSpace.NoetherianSpace.compactSpace
-/

variable {α β}

#print TopologicalSpace.NoetherianSpace.isCompact /-
protected theorem NoetherianSpace.isCompact [NoetherianSpace α] (s : Set α) : IsCompact s :=
  by
  refine' isCompact_iff_finite_subcover.2 fun ι U hUo hs => _
  rcases((noetherian_space_iff_opens α).mp ‹_› ⟨⋃ i, U i, isOpen_unionᵢ hUo⟩).elim_finite_subcover U
      hUo Set.Subset.rfl with
    ⟨t, ht⟩
  exact ⟨t, hs.trans ht⟩
#align topological_space.noetherian_space.is_compact TopologicalSpace.NoetherianSpace.isCompact
-/

/- warning: topological_space.inducing.noetherian_space -> Inducing.noetherianSpace is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} α] [_inst_2 : TopologicalSpace.{u2} β] [_inst_3 : TopologicalSpace.NoetherianSpace.{u1} α _inst_1] {i : β -> α}, (Inducing.{u2, u1} β α _inst_2 _inst_1 i) -> (TopologicalSpace.NoetherianSpace.{u2} β _inst_2)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} α] [_inst_2 : TopologicalSpace.{u1} β] [_inst_3 : TopologicalSpace.NoetherianSpace.{u2} α _inst_1] {i : β -> α}, (Inducing.{u1, u2} β α _inst_2 _inst_1 i) -> (TopologicalSpace.NoetherianSpace.{u1} β _inst_2)
Case conversion may be inaccurate. Consider using '#align topological_space.inducing.noetherian_space Inducing.noetherianSpaceₓ'. -/
protected theorem Inducing.noetherianSpace [NoetherianSpace α] {i : β → α} (hi : Inducing i) :
    NoetherianSpace β :=
  (noetherianSpace_iff_opens _).2 fun s => hi.isCompact_iff.1 (NoetherianSpace.isCompact _)
#align topological_space.inducing.noetherian_space Inducing.noetherianSpace

#print TopologicalSpace.NoetherianSpace.set /-
instance NoetherianSpace.set [h : NoetherianSpace α] (s : Set α) : NoetherianSpace s :=
  inducing_subtype_val.NoetherianSpace
#align topological_space.noetherian_space.set TopologicalSpace.NoetherianSpace.set
-/

variable (α)

example (α : Type _) : Set α ≃o (Set α)ᵒᵈ := by refine' OrderIso.compl (Set α)

/- warning: topological_space.noetherian_space_tfae -> TopologicalSpace.noetherianSpace_TFAE is a dubious translation:
lean 3 declaration is
  forall (α : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} α], List.TFAE (List.cons.{0} Prop (TopologicalSpace.NoetherianSpace.{u1} α _inst_1) (List.cons.{0} Prop (WellFounded.{succ u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (fun (s : TopologicalSpace.Closeds.{u1} α _inst_1) (t : TopologicalSpace.Closeds.{u1} α _inst_1) => LT.lt.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (Preorder.toLT.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (SetLike.partialOrder.{u1, u1} (TopologicalSpace.Closeds.{u1} α _inst_1) α (TopologicalSpace.Closeds.setLike.{u1} α _inst_1)))) s t)) (List.cons.{0} Prop (forall (s : Set.{u1} α), IsCompact.{u1} α _inst_1 s) (List.cons.{0} Prop (forall (s : TopologicalSpace.Opens.{u1} α _inst_1), IsCompact.{u1} α _inst_1 ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (TopologicalSpace.Opens.{u1} α _inst_1) (Set.{u1} α) (HasLiftT.mk.{succ u1, succ u1} (TopologicalSpace.Opens.{u1} α _inst_1) (Set.{u1} α) (CoeTCₓ.coe.{succ u1, succ u1} (TopologicalSpace.Opens.{u1} α _inst_1) (Set.{u1} α) (SetLike.Set.hasCoeT.{u1, u1} (TopologicalSpace.Opens.{u1} α _inst_1) α (TopologicalSpace.Opens.setLike.{u1} α _inst_1)))) s)) (List.nil.{0} Prop)))))
but is expected to have type
  forall (α : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} α], List.TFAE (List.cons.{0} Prop (TopologicalSpace.NoetherianSpace.{u1} α _inst_1) (List.cons.{0} Prop (WellFounded.{succ u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (fun (s : TopologicalSpace.Closeds.{u1} α _inst_1) (t : TopologicalSpace.Closeds.{u1} α _inst_1) => LT.lt.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (Preorder.toLT.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (CompleteSemilatticeInf.toPartialOrder.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (CompleteLattice.toCompleteSemilatticeInf.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (TopologicalSpace.Closeds.instCompleteLatticeCloseds.{u1} α _inst_1))))) s t)) (List.cons.{0} Prop (forall (s : Set.{u1} α), IsCompact.{u1} α _inst_1 s) (List.cons.{0} Prop (forall (s : TopologicalSpace.Opens.{u1} α _inst_1), IsCompact.{u1} α _inst_1 (SetLike.coe.{u1, u1} (TopologicalSpace.Opens.{u1} α _inst_1) α (TopologicalSpace.Opens.instSetLikeOpens.{u1} α _inst_1) s)) (List.nil.{0} Prop)))))
Case conversion may be inaccurate. Consider using '#align topological_space.noetherian_space_tfae TopologicalSpace.noetherianSpace_TFAEₓ'. -/
theorem noetherianSpace_TFAE :
    TFAE
      [NoetherianSpace α, WellFounded fun s t : Closeds α => s < t, ∀ s : Set α, IsCompact s,
        ∀ s : Opens α, IsCompact (s : Set α)] :=
  by
  tfae_have 1 ↔ 2
  · refine' (noetherian_space_iff _).trans (Surjective.wellFounded_iff opens.compl_bijective.2 _)
    exact fun s t => (OrderIso.compl (Set α)).lt_iff_lt.symm
  tfae_have 1 ↔ 4
  · exact noetherian_space_iff_opens α
  tfae_have 1 → 3
  · exact @noetherian_space.is_compact _ _
  tfae_have 3 → 4
  · exact fun H s => H s
  tfae_finish
#align topological_space.noetherian_space_tfae TopologicalSpace.noetherianSpace_TFAE

variable {α β}

instance {α} : NoetherianSpace (CofiniteTopology α) :=
  by
  simp only [noetherian_space_iff_opens, isCompact_iff_ultrafilter_le_nhds,
    CofiniteTopology.nhds_eq, Ultrafilter.le_sup_iff]
  intro s f hs
  rcases f.le_cofinite_or_eq_pure with (hf | ⟨a, rfl⟩)
  · rcases Filter.nonempty_of_mem (Filter.le_principal_iff.1 hs) with ⟨a, ha⟩
    exact ⟨a, ha, Or.inr hf⟩
  · exact ⟨a, filter.le_principal_iff.mp hs, Or.inl le_rfl⟩

/- warning: topological_space.noetherian_space_of_surjective -> TopologicalSpace.noetherianSpace_of_surjective is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} α] [_inst_2 : TopologicalSpace.{u2} β] [_inst_3 : TopologicalSpace.NoetherianSpace.{u1} α _inst_1] (f : α -> β), (Continuous.{u1, u2} α β _inst_1 _inst_2 f) -> (Function.Surjective.{succ u1, succ u2} α β f) -> (TopologicalSpace.NoetherianSpace.{u2} β _inst_2)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} α] [_inst_2 : TopologicalSpace.{u1} β] [_inst_3 : TopologicalSpace.NoetherianSpace.{u2} α _inst_1] (f : α -> β), (Continuous.{u2, u1} α β _inst_1 _inst_2 f) -> (Function.Surjective.{succ u2, succ u1} α β f) -> (TopologicalSpace.NoetherianSpace.{u1} β _inst_2)
Case conversion may be inaccurate. Consider using '#align topological_space.noetherian_space_of_surjective TopologicalSpace.noetherianSpace_of_surjectiveₓ'. -/
theorem noetherianSpace_of_surjective [NoetherianSpace α] (f : α → β) (hf : Continuous f)
    (hf' : Function.Surjective f) : NoetherianSpace β :=
  by
  rw [noetherian_space_iff_opens]
  intro s
  obtain ⟨t, e⟩ := set.image_surjective.mpr hf' s
  exact e ▸ (noetherian_space.is_compact t).image hf
#align topological_space.noetherian_space_of_surjective TopologicalSpace.noetherianSpace_of_surjective

/- warning: topological_space.noetherian_space_iff_of_homeomorph -> TopologicalSpace.noetherianSpace_iff_of_homeomorph is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} α] [_inst_2 : TopologicalSpace.{u2} β], (Homeomorph.{u1, u2} α β _inst_1 _inst_2) -> (Iff (TopologicalSpace.NoetherianSpace.{u1} α _inst_1) (TopologicalSpace.NoetherianSpace.{u2} β _inst_2))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} α] [_inst_2 : TopologicalSpace.{u1} β], (Homeomorph.{u2, u1} α β _inst_1 _inst_2) -> (Iff (TopologicalSpace.NoetherianSpace.{u2} α _inst_1) (TopologicalSpace.NoetherianSpace.{u1} β _inst_2))
Case conversion may be inaccurate. Consider using '#align topological_space.noetherian_space_iff_of_homeomorph TopologicalSpace.noetherianSpace_iff_of_homeomorphₓ'. -/
theorem noetherianSpace_iff_of_homeomorph (f : α ≃ₜ β) : NoetherianSpace α ↔ NoetherianSpace β :=
  ⟨fun h => @noetherianSpace_of_surjective _ _ h f f.Continuous f.Surjective, fun h =>
    @noetherianSpace_of_surjective _ _ h f.symm f.symm.Continuous f.symm.Surjective⟩
#align topological_space.noetherian_space_iff_of_homeomorph TopologicalSpace.noetherianSpace_iff_of_homeomorph

/- warning: topological_space.noetherian_space.range -> TopologicalSpace.NoetherianSpace.range is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} α] [_inst_2 : TopologicalSpace.{u2} β] [_inst_3 : TopologicalSpace.NoetherianSpace.{u1} α _inst_1] (f : α -> β), (Continuous.{u1, u2} α β _inst_1 _inst_2 f) -> (TopologicalSpace.NoetherianSpace.{u2} (coeSort.{succ u2, succ (succ u2)} (Set.{u2} β) Type.{u2} (Set.hasCoeToSort.{u2} β) (Set.range.{u2, succ u1} β α f)) (Subtype.topologicalSpace.{u2} β (fun (x : β) => Membership.Mem.{u2, u2} β (Set.{u2} β) (Set.hasMem.{u2} β) x (Set.range.{u2, succ u1} β α f)) _inst_2))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} α] [_inst_2 : TopologicalSpace.{u1} β] [_inst_3 : TopologicalSpace.NoetherianSpace.{u2} α _inst_1] (f : α -> β), (Continuous.{u2, u1} α β _inst_1 _inst_2 f) -> (TopologicalSpace.NoetherianSpace.{u1} (Set.Elem.{u1} β (Set.range.{u1, succ u2} β α f)) (instTopologicalSpaceSubtype.{u1} β (fun (x : β) => Membership.mem.{u1, u1} β (Set.{u1} β) (Set.instMembershipSet.{u1} β) x (Set.range.{u1, succ u2} β α f)) _inst_2))
Case conversion may be inaccurate. Consider using '#align topological_space.noetherian_space.range TopologicalSpace.NoetherianSpace.rangeₓ'. -/
theorem NoetherianSpace.range [NoetherianSpace α] (f : α → β) (hf : Continuous f) :
    NoetherianSpace (Set.range f) :=
  noetherianSpace_of_surjective (Set.codRestrict f _ Set.mem_range_self) (by continuity)
    fun ⟨a, b, h⟩ => ⟨b, Subtype.ext h⟩
#align topological_space.noetherian_space.range TopologicalSpace.NoetherianSpace.range

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (t «expr ⊆ » s) -/
#print TopologicalSpace.noetherianSpace_set_iff /-
theorem noetherianSpace_set_iff (s : Set α) : NoetherianSpace s ↔ ∀ (t) (_ : t ⊆ s), IsCompact t :=
  by
  rw [(noetherian_space_tfae s).out 0 2]
  constructor
  · intro H t ht
    have := embedding_subtype_coe.is_compact_iff_is_compact_image.mp (H (coe ⁻¹' t))
    simpa [set.inter_eq_left_iff_subset.mpr ht] using this
  · intro H t
    refine' embedding_subtype_coe.is_compact_iff_is_compact_image.mpr (H (coe '' t) _)
    simp
#align topological_space.noetherian_space_set_iff TopologicalSpace.noetherianSpace_set_iff
-/

#print TopologicalSpace.noetherian_univ_iff /-
@[simp]
theorem noetherian_univ_iff : NoetherianSpace (Set.univ : Set α) ↔ NoetherianSpace α :=
  noetherianSpace_iff_of_homeomorph (Homeomorph.Set.univ α)
#align topological_space.noetherian_univ_iff TopologicalSpace.noetherian_univ_iff
-/

#print TopologicalSpace.NoetherianSpace.unionᵢ /-
theorem NoetherianSpace.unionᵢ {ι : Type _} (f : ι → Set α) [Finite ι]
    [hf : ∀ i, NoetherianSpace (f i)] : NoetherianSpace (⋃ i, f i) :=
  by
  cases nonempty_fintype ι
  simp_rw [noetherian_space_set_iff] at hf⊢
  intro t ht
  rw [← set.inter_eq_left_iff_subset.mpr ht, Set.inter_unionᵢ]
  exact isCompact_unionᵢ fun i => hf i _ (Set.inter_subset_right _ _)
#align topological_space.noetherian_space.Union TopologicalSpace.NoetherianSpace.unionᵢ
-/

#print TopologicalSpace.NoetherianSpace.discrete /-
-- This is not an instance since it makes a loop with `t2_space_discrete`.
theorem NoetherianSpace.discrete [NoetherianSpace α] [T2Space α] : DiscreteTopology α :=
  ⟨eq_bot_iff.mpr fun U _ => isClosed_compl_iff.mp (NoetherianSpace.isCompact _).IsClosed⟩
#align topological_space.noetherian_space.discrete TopologicalSpace.NoetherianSpace.discrete
-/

attribute [local instance] noetherian_space.discrete

#print TopologicalSpace.NoetherianSpace.finite /-
/-- Spaces that are both Noetherian and Hausdorff is finite. -/
theorem NoetherianSpace.finite [NoetherianSpace α] [T2Space α] : Finite α :=
  by
  letI : Fintype α :=
    Set.fintypeOfFiniteUniv (noetherian_space.is_compact Set.univ).finite_of_discrete
  infer_instance
#align topological_space.noetherian_space.finite TopologicalSpace.NoetherianSpace.finite
-/

#print TopologicalSpace.Finite.to_noetherianSpace /-
instance (priority := 100) Finite.to_noetherianSpace [Finite α] : NoetherianSpace α :=
  ⟨Finite.wellFounded_of_trans_of_irrefl _⟩
#align topological_space.finite.to_noetherian_space TopologicalSpace.Finite.to_noetherianSpace
-/

/- warning: topological_space.noetherian_space.exists_finset_irreducible -> TopologicalSpace.NoetherianSpace.exists_finset_irreducible is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} α] [_inst_3 : TopologicalSpace.NoetherianSpace.{u1} α _inst_1] (s : TopologicalSpace.Closeds.{u1} α _inst_1), Exists.{succ u1} (Finset.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) (fun (S : Finset.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) => And (forall (k : coeSort.{succ u1, succ (succ u1)} (Finset.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) Type.{u1} (Finset.hasCoeToSort.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) S), IsIrreducible.{u1} α _inst_1 ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (coeSort.{succ u1, succ (succ u1)} (Finset.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) Type.{u1} (Finset.hasCoeToSort.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) S) (Set.{u1} α) (HasLiftT.mk.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Finset.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) Type.{u1} (Finset.hasCoeToSort.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) S) (Set.{u1} α) (CoeTCₓ.coe.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Finset.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) Type.{u1} (Finset.hasCoeToSort.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) S) (Set.{u1} α) (coeTrans.{succ u1, succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Finset.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) Type.{u1} (Finset.hasCoeToSort.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) S) (TopologicalSpace.Closeds.{u1} α _inst_1) (Set.{u1} α) (SetLike.Set.hasCoeT.{u1, u1} (TopologicalSpace.Closeds.{u1} α _inst_1) α (TopologicalSpace.Closeds.setLike.{u1} α _inst_1)) (coeSubtype.{succ u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (fun (x : TopologicalSpace.Closeds.{u1} α _inst_1) => Membership.Mem.{u1, u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (Finset.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) (Finset.hasMem.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) x S))))) k)) (Eq.{succ u1} (TopologicalSpace.Closeds.{u1} α _inst_1) s (Finset.sup.{u1, u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (TopologicalSpace.Closeds.{u1} α _inst_1) (Lattice.toSemilatticeSup.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (ConditionallyCompleteLattice.toLattice.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (CompleteLattice.toConditionallyCompleteLattice.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (TopologicalSpace.Closeds.completeLattice.{u1} α _inst_1)))) (BoundedOrder.toOrderBot.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (Preorder.toLE.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (SemilatticeSup.toPartialOrder.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (Lattice.toSemilatticeSup.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (ConditionallyCompleteLattice.toLattice.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (CompleteLattice.toConditionallyCompleteLattice.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (TopologicalSpace.Closeds.completeLattice.{u1} α _inst_1))))))) (CompleteLattice.toBoundedOrder.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (TopologicalSpace.Closeds.completeLattice.{u1} α _inst_1))) S (id.{succ u1} (TopologicalSpace.Closeds.{u1} α _inst_1)))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} α] [_inst_3 : TopologicalSpace.NoetherianSpace.{u1} α _inst_1] (s : TopologicalSpace.Closeds.{u1} α _inst_1), Exists.{succ u1} (Finset.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) (fun (S : Finset.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) => And (forall (k : Subtype.{succ u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (fun (x : TopologicalSpace.Closeds.{u1} α _inst_1) => Membership.mem.{u1, u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (Finset.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) (Finset.instMembershipFinset.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) x S)), IsIrreducible.{u1} α _inst_1 (SetLike.coe.{u1, u1} (TopologicalSpace.Closeds.{u1} α _inst_1) α (TopologicalSpace.Closeds.instSetLikeCloseds.{u1} α _inst_1) (Subtype.val.{succ u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (fun (x : TopologicalSpace.Closeds.{u1} α _inst_1) => Membership.mem.{u1, u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (Finset.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) (Finset.instMembershipFinset.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1)) x S) k))) (Eq.{succ u1} (TopologicalSpace.Closeds.{u1} α _inst_1) s (Finset.sup.{u1, u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (TopologicalSpace.Closeds.{u1} α _inst_1) (Lattice.toSemilatticeSup.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (ConditionallyCompleteLattice.toLattice.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (CompleteLattice.toConditionallyCompleteLattice.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (TopologicalSpace.Closeds.instCompleteLatticeCloseds.{u1} α _inst_1)))) (BoundedOrder.toOrderBot.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (Preorder.toLE.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (PartialOrder.toPreorder.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (SemilatticeSup.toPartialOrder.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (Lattice.toSemilatticeSup.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (ConditionallyCompleteLattice.toLattice.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (CompleteLattice.toConditionallyCompleteLattice.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (TopologicalSpace.Closeds.instCompleteLatticeCloseds.{u1} α _inst_1))))))) (CompleteLattice.toBoundedOrder.{u1} (TopologicalSpace.Closeds.{u1} α _inst_1) (TopologicalSpace.Closeds.instCompleteLatticeCloseds.{u1} α _inst_1))) S (id.{succ u1} (TopologicalSpace.Closeds.{u1} α _inst_1)))))
Case conversion may be inaccurate. Consider using '#align topological_space.noetherian_space.exists_finset_irreducible TopologicalSpace.NoetherianSpace.exists_finset_irreducibleₓ'. -/
theorem NoetherianSpace.exists_finset_irreducible [NoetherianSpace α] (s : Closeds α) :
    ∃ S : Finset (Closeds α), (∀ k : S, IsIrreducible (k : Set α)) ∧ s = S.sup id := by
  classical
    have := ((noetherian_space_tfae α).out 0 1).mp inferInstance
    apply WellFounded.induction this s
    clear s
    intro s H
    by_cases h₁ : IsPreirreducible s.1
    cases h₂ : s.1.eq_empty_or_nonempty
    · use ∅
      refine' ⟨fun k => k.2.elim, _⟩
      rw [Finset.sup_empty]
      ext1
      exact h
    · use {s}
      simp only [coe_coe, Finset.sup_singleton, id.def, eq_self_iff_true, and_true_iff]
      rintro ⟨k, hk⟩
      cases finset.mem_singleton.mp hk
      exact ⟨h, h₁⟩
    · rw [isPreirreducible_iff_closed_union_closed] at h₁
      push_neg  at h₁
      obtain ⟨z₁, z₂, hz₁, hz₂, h, hz₁', hz₂'⟩ := h₁
      obtain ⟨S₁, hS₁, hS₁'⟩ := H (s ⊓ ⟨z₁, hz₁⟩) (inf_lt_left.2 hz₁')
      obtain ⟨S₂, hS₂, hS₂'⟩ := H (s ⊓ ⟨z₂, hz₂⟩) (inf_lt_left.2 hz₂')
      refine' ⟨S₁ ∪ S₂, fun k => _, _⟩
      · cases' finset.mem_union.mp k.2 with h' h'
        exacts[hS₁ ⟨k, h'⟩, hS₂ ⟨k, h'⟩]
      · rwa [Finset.sup_union, ← hS₁', ← hS₂', ← inf_sup_left, left_eq_inf]
#align topological_space.noetherian_space.exists_finset_irreducible TopologicalSpace.NoetherianSpace.exists_finset_irreducible

#print TopologicalSpace.NoetherianSpace.finite_irreducibleComponents /-
theorem NoetherianSpace.finite_irreducibleComponents [NoetherianSpace α] :
    (irreducibleComponents α).Finite := by
  classical
    obtain ⟨S, hS₁, hS₂⟩ := noetherian_space.exists_finset_irreducible (⊤ : closeds α)
    suffices irreducibleComponents α ⊆ coe '' (S : Set <| closeds α) by
      exact Set.Finite.subset ((Set.Finite.intro inferInstance).image _) this
    intro K hK
    obtain ⟨z, hz, hz'⟩ : ∃ (z : Set α)(H : z ∈ Finset.image coe S), K ⊆ z :=
      by
      convert is_irreducible_iff_sUnion_closed.mp hK.1 (S.image coe) _ _
      · simp only [Finset.mem_image, exists_prop, forall_exists_index, and_imp]
        rintro _ z hz rfl
        exact z.2
      · exact (Set.subset_univ _).trans ((congr_arg coe hS₂).trans <| by simp).Subset
    obtain ⟨s, hs, e⟩ := finset.mem_image.mp hz
    rw [← e] at hz'
    refine' ⟨s, hs, _⟩
    symm
    suffices K ≤ s by exact this.antisymm (hK.2 (hS₁ ⟨s, hs⟩) this)
    simpa
#align topological_space.noetherian_space.finite_irreducible_components TopologicalSpace.NoetherianSpace.finite_irreducibleComponents
-/

end TopologicalSpace


/-
Copyright (c) 2021 Shing Tak Lam. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Shing Tak Lam
-/
import linear_algebra.general_linear_group
import linear_algebra.matrix.to_lin
import linear_algebra.matrix.nonsingular_inverse
import algebra.star.unitary

/-!
# The Unitary Group

This file defines elements of the unitary group `unitary_group n α`, where `α` is a `star_ring`.
This consists of all `n` by `n` matrices with entries in `α` such that the star-transpose is its
inverse. In addition, we define the group structure on `unitary_group n α`, and the embedding into
the general linear group `general_linear_group α (n → α)`.

We also define the orthogonal group `orthogonal_group n β`, where `β` is a `comm_ring`.

## Main Definitions

 * `matrix.unitary_group` is the type of matrices where the star-transpose is the inverse
 * `matrix.unitary_group.group` is the group structure (under multiplication)
 * `matrix.unitary_group.embedding_GL` is the embedding `unitary_group n α → GLₙ(α)`
 * `matrix.orthogonal_group` is the type of matrices where the transpose is the inverse

## References

 * https://en.wikipedia.org/wiki/Unitary_group

## Tags

matrix group, group, unitary group, orthogonal group

-/

universes u v

namespace matrix
open linear_map
open_locale matrix

section

variables (n : Type u) [decidable_eq n] [fintype n]
variables (α : Type v) [comm_ring α] [star_ring α]

/--
`unitary_group n` is the group of `n` by `n` matrices where the star-transpose is the inverse.
-/
abbreviation unitary_group := unitary (matrix n n α)

end

variables {n : Type u} [decidable_eq n] [fintype n]
variables {α : Type v} [comm_ring α] [star_ring α]

lemma mem_unitary_group_iff {A : matrix n n α} :
  A ∈ matrix.unitary_group n α ↔ A * star A = 1 :=
begin
  refine ⟨and.right, λ hA, ⟨_, hA⟩⟩,
  simpa only [mul_eq_mul, mul_eq_one_comm] using hA
end

lemma mem_unitary_group_iff' {A : matrix n n α} :
  A ∈ matrix.unitary_group n α ↔ star A * A = 1 :=
begin
  refine ⟨and.left, λ hA, ⟨hA, _⟩⟩,
  rwa [mul_eq_mul, mul_eq_one_comm] at hA,
end

lemma det_of_mem_unitary {A : matrix n n α} (hA : A ∈ matrix.unitary_group n α) :
  A.det ∈ unitary α :=
begin
  split,
  { simpa [star, det_transpose] using congr_arg det hA.1 },
  { simpa [star, det_transpose] using congr_arg det hA.2 },
end

namespace unitary_group

instance coe_matrix : has_coe (unitary_group n α) (matrix n n α) := ⟨subtype.val⟩

instance coe_fun : has_coe_to_fun (unitary_group n α) (λ _, n → n → α) :=
{ coe := λ A, A.val }

/--
`to_lin' A` is matrix multiplication of vectors by `A`, as a linear map.

After the group structure on `unitary_group n` is defined,
we show in `to_linear_equiv` that this gives a linear equivalence.
-/
def to_lin' (A : unitary_group n α) := matrix.to_lin' A

lemma ext_iff (A B : unitary_group n α) : A = B ↔ ∀ i j, A i j = B i j :=
subtype.ext_iff_val.trans ⟨(λ h i j, congr_fun (congr_fun h i) j), matrix.ext⟩

@[ext] lemma ext (A B : unitary_group n α) : (∀ i j, A i j = B i j) → A = B :=
(unitary_group.ext_iff A B).mpr

@[simp]

section coe_lemmas

variables (A B : unitary_group n α)

@[simp] lemma inv_val : ↑(A⁻¹) = (star A : matrix n n α) := rfl

@[simp] lemma inv_apply : ⇑(A⁻¹) = (star A : matrix n n α) := rfl

@[simp] lemma mul_val : ↑(A * B) = A ⬝ B := rfl

@[simp] lemma mul_apply : ⇑(A * B) = (A ⬝ B) := rfl

@[simp] lemma one_val : ↑(1 : unitary_group n α) = (1 : matrix n n α) := rfl

@[simp] lemma one_apply : ⇑(1 : unitary_group n α) = (1 : matrix n n α) := rfl

@[simp] lemma to_lin'_mul :
  to_lin' (A * B) = (to_lin' A).comp (to_lin' B) :=
matrix.to_lin'_mul A B

@[simp] lemma to_lin'_one :
  to_lin' (1 : unitary_group n α) = linear_map.id :=
matrix.to_lin'_one

end coe_lemmas

/-- `to_linear_equiv A` is matrix multiplication of vectors by `A`, as a linear equivalence. -/
def to_linear_equiv (A : unitary_group n α) : (n → α) ≃ₗ[α] (n → α) :=
{ inv_fun := to_lin' A⁻¹,
  left_inv := λ x, calc
    (to_lin' A⁻¹).comp (to_lin' A) x
        = (to_lin' (A⁻¹ * A)) x : by rw [←to_lin'_mul]
    ... = x : by rw [mul_left_inv, to_lin'_one, id_apply],
  right_inv := λ x, calc
    (to_lin' A).comp (to_lin' A⁻¹) x
        = to_lin' (A * A⁻¹) x : by rw [←to_lin'_mul]
    ... = x : by rw [mul_right_inv, to_lin'_one, id_apply],
  ..matrix.to_lin' A }

/-- `to_GL` is the map from the unitary group to the general linear group -/
def to_GL (A : unitary_group n α) : general_linear_group α (n → α) :=
general_linear_group.of_linear_equiv (to_linear_equiv A)

lemma coe_to_GL (A : unitary_group n α) :
  ↑(to_GL A) = to_lin' A :=
rfl

@[simp]
lemma to_GL_one : to_GL (1 : unitary_group n α) = 1 :=
by { ext1 v i, rw [coe_to_GL, to_lin'_one], refl }

@[simp]
lemma to_GL_mul (A B : unitary_group n α) :
  to_GL (A * B) = to_GL A * to_GL B :=
by { ext1 v i, rw [coe_to_GL, to_lin'_mul], refl }

/-- `unitary_group.embedding_GL` is the embedding from `unitary_group n α`
to `general_linear_group n α`. -/
def embedding_GL : unitary_group n α →* general_linear_group α (n → α) :=
⟨λ A, to_GL A, by simp, by simp⟩

end unitary_group

section orthogonal_group

variables (n) (β : Type v) [comm_ring β]

local attribute [instance] star_ring_of_comm
/--
`orthogonal_group n` is the group of `n` by `n` matrices where the transpose is the inverse.
-/
abbreviation orthogonal_group := unitary_group n β

lemma mem_orthogonal_group_iff {A : matrix n n β} :
  A ∈ matrix.orthogonal_group n β ↔ A * star A = 1 :=
begin
  refine ⟨and.right, λ hA, ⟨_, hA⟩⟩,
  simpa only [mul_eq_mul, mul_eq_one_comm] using hA
end

lemma mem_orthogonal_group_iff' {A : matrix n n β} :
  A ∈ matrix.orthogonal_group n β ↔ star A * A = 1 :=
begin
  refine ⟨and.left, λ hA, ⟨hA, _⟩⟩,
  rwa [mul_eq_mul, mul_eq_one_comm] at hA,
end

end orthogonal_group

end matrix


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Yury Kudryashov
-/
import algebra.group.type_tags
import algebra.hom.group
import algebra.opposites
import logic.embedding

/-!
# Definitions of group actions

This file defines a hierarchy of group action type-classes on top of the previously defined
notation classes `has_smul` and its additive version `has_vadd`:

* `mul_action M α` and its additive version `add_action G P` are typeclasses used for
  actions of multiplicative and additive monoids and groups; they extend notation classes
  `has_smul` and `has_vadd` that are defined in `algebra.group.defs`;
* `distrib_mul_action M A` is a typeclass for an action of a multiplicative monoid on
  an additive monoid such that `a • (b + c) = a • b + a • c` and `a • 0 = 0`.

The hierarchy is extended further by `module`, defined elsewhere.

Also provided are typeclasses for faithful and transitive actions, and typeclasses regarding the
interaction of different group actions,

* `smul_comm_class M N α` and its additive version `vadd_comm_class M N α`;
* `is_scalar_tower M N α` (no additive version).
* `is_central_scalar M α` (no additive version).

## Notation

- `a • b` is used as notation for `has_smul.smul a b`.
- `a +ᵥ b` is used as notation for `has_vadd.vadd a b`.

## Implementation details

This file should avoid depending on other parts of `group_theory`, to avoid import cycles.
More sophisticated lemmas belong in `group_theory.group_action`.

## Tags

group action
-/

variables {M N G A B α β γ δ : Type*}

open function (injective surjective)

/-!
### Faithful actions
-/

/-- Typeclass for faithful actions. -/
class has_faithful_vadd (G : Type*) (P : Type*) [has_vadd G P] : Prop :=
(eq_of_vadd_eq_vadd : ∀ {g₁ g₂ : G}, (∀ p : P, g₁ +ᵥ p = g₂ +ᵥ p) → g₁ = g₂)

/-- Typeclass for faithful actions. -/
@[to_additive]
class has_faithful_smul (M : Type*) (α : Type*) [has_smul M α] : Prop :=
(eq_of_smul_eq_smul : ∀ {m₁ m₂ : M}, (∀ a : α, m₁ • a = m₂ • a) → m₁ = m₂)

export has_faithful_smul (eq_of_smul_eq_smul) has_faithful_vadd (eq_of_vadd_eq_vadd)

@[to_additive]
lemma smul_left_injective' [has_smul M α] [has_faithful_smul M α] :
  function.injective ((•) : M → α → α) :=
λ m₁ m₂ h, has_faithful_smul.eq_of_smul_eq_smul (congr_fun h)

/-- See also `monoid.to_mul_action` and `mul_zero_class.to_smul_with_zero`. -/
@[priority 910, to_additive] -- see Note [lower instance priority]
instance has_mul.to_has_smul (α : Type*) [has_mul α] : has_smul α α := ⟨(*)⟩

@[simp, to_additive] lemma smul_eq_mul (α : Type*) [has_mul α] {a a' : α} : a • a' = a * a' := rfl

/-- Type class for additive monoid actions. -/
@[ext, protect_proj] class add_action (G : Type*) (P : Type*) [add_monoid G] extends has_vadd G P :=
(zero_vadd : ∀ p : P, (0 : G) +ᵥ p = p)
(add_vadd : ∀ (g₁ g₂ : G) (p : P), (g₁ + g₂) +ᵥ p = g₁ +ᵥ (g₂ +ᵥ p))

/-- Typeclass for multiplicative actions by monoids. This generalizes group actions. -/
@[ext, protect_proj, to_additive]
class mul_action (α : Type*) (β : Type*) [monoid α] extends has_smul α β :=
(one_smul : ∀ b : β, (1 : α) • b = b)
(mul_smul : ∀ (x y : α) (b : β), (x * y) • b = x • y • b)

instance additive.add_action [monoid α] [mul_action α β] : add_action (additive α) β :=
{ vadd := (•) ∘ additive.to_mul,
  zero_vadd := mul_action.one_smul,
  add_vadd := mul_action.mul_smul }

@[simp] lemma additive.of_mul_vadd [monoid α] [mul_action α β] (a : α) (b : β) :
  additive.of_mul a +ᵥ b = a • b :=
rfl

instance multiplicative.mul_action [add_monoid α] [add_action α β] :
  mul_action (multiplicative α) β :=
{ smul := (+ᵥ) ∘ multiplicative.to_add,
  one_smul := add_action.zero_vadd,
  mul_smul := add_action.add_vadd }

@[simp] lemma multiplicative.of_add_smul [add_monoid α] [add_action α β] (a : α) (b : β) :
  multiplicative.of_add a • b = a +ᵥ b :=
rfl

/-!
### (Pre)transitive action

`M` acts pretransitively on `α` if for any `x y` there is `g` such that `g • x = y` (or `g +ᵥ x = y`
for an additive action). A transitive action should furthermore have `α` nonempty.

In this section we define typeclasses `mul_action.is_pretransitive` and
`add_action.is_pretransitive` and provide `mul_action.exists_smul_eq`/`add_action.exists_vadd_eq`,
`mul_action.surjective_smul`/`add_action.surjective_vadd` as public interface to access this
property. We do not provide typeclasses `*_action.is_transitive`; users should assume
`[mul_action.is_pretransitive M α] [nonempty α]` instead. -/

/-- `M` acts pretransitively on `α` if for any `x y` there is `g` such that `g +ᵥ x = y`.
  A transitive action should furthermore have `α` nonempty. -/
class add_action.is_pretransitive (M α : Type*) [has_vadd M α] : Prop :=
(exists_vadd_eq : ∀ x y : α, ∃ g : M, g +ᵥ x = y)

/-- `M` acts pretransitively on `α` if for any `x y` there is `g` such that `g • x = y`.
  A transitive action should furthermore have `α` nonempty. -/
@[to_additive] class mul_action.is_pretransitive (M α : Type*) [has_smul M α] : Prop :=
(exists_smul_eq : ∀ x y : α, ∃ g : M, g • x = y)

namespace mul_action

variables (M) {α} [has_smul M α] [is_pretransitive M α]

@[to_additive] lemma exists_smul_eq (x y : α) : ∃ m : M, m • x = y :=
is_pretransitive.exists_smul_eq x y

@[to_additive] lemma surjective_smul (x : α) : surjective (λ c : M, c • x) := exists_smul_eq M x

/-- The regular action of a group on itself is transitive. -/
@[to_additive] instance regular.is_pretransitive [group G] : is_pretransitive G G :=
⟨λ x y, ⟨y * x⁻¹, inv_mul_cancel_right _ _⟩⟩

end mul_action

/-!
### Scalar tower and commuting actions
-/

/-- A typeclass mixin saying that two additive actions on the same space commute. -/
class vadd_comm_class (M N α : Type*) [has_vadd M α] [has_vadd N α] : Prop :=
(vadd_comm : ∀ (m : M) (n : N) (a : α), m +ᵥ (n +ᵥ a) = n +ᵥ (m +ᵥ a))

/-- A typeclass mixin saying that two multiplicative actions on the same space commute. -/
@[to_additive] class smul_comm_class (M N α : Type*) [has_smul M α] [has_smul N α] : Prop :=
(smul_comm : ∀ (m : M) (n : N) (a : α), m • n • a = n • m • a)

export mul_action (mul_smul) add_action (add_vadd) smul_comm_class (smul_comm)
  vadd_comm_class (vadd_comm)

/--
Frequently, we find ourselves wanting to express a bilinear map `M →ₗ[R] N →ₗ[R] P` or an
equivalence between maps `(M →ₗ[R] N) ≃ₗ[R] (M' →ₗ[R] N')` where the maps have an associated ring
`R`. Unfortunately, using definitions like these requires that `R` satisfy `comm_semiring R`, and
not just `semiring R`. Using `M →ₗ[R] N →+ P` and `(M →ₗ[R] N) ≃+ (M' →ₗ[R] N')` avoids this
problem, but throws away structure that is useful for when we _do_ have a commutative (semi)ring.

To avoid making this compromise, we instead state these definitions as `M →ₗ[R] N →ₗ[S] P` or
`(M →ₗ[R] N) ≃ₗ[S] (M' →ₗ[R] N')` and require `smul_comm_class S R` on the appropriate modules. When
the caller has `comm_semiring R`, they can set `S = R` and `smul_comm_class_self` will populate the
instance. If the caller only has `semiring R` they can still set either `R = ℕ` or `S = ℕ`, and
`add_comm_monoid.nat_smul_comm_class` or `add_comm_monoid.nat_smul_comm_class'` will populate
the typeclass, which is still sufficient to recover a `≃+` or `→+` structure.

An example of where this is used is `linear_map.prod_equiv`.
-/
library_note "bundled maps over different rings"

/-- Commutativity of actions is a symmetric relation. This lemma can't be an instance because this
would cause a loop in the instance search graph. -/
@[to_additive] lemma smul_comm_class.symm (M N α : Type*) [has_smul M α] [has_smul N α]
  [smul_comm_class M N α] : smul_comm_class N M α :=
⟨λ a' a b, (smul_comm a a' b).symm⟩

/-- Commutativity of additive actions is a symmetric relation. This lemma can't be an instance
because this would cause a loop in the instance search graph. -/
add_decl_doc vadd_comm_class.symm

@[to_additive] instance smul_comm_class_self (M α : Type*) [comm_monoid M] [mul_action M α] :
  smul_comm_class M M α :=
⟨λ a a' b, by rw [← mul_smul, mul_comm, mul_smul]⟩

/-- An instance of `is_scalar_tower M N α` states that the multiplicative
action of `M` on `α` is determined by the multiplicative actions of `M` on `N`
and `N` on `α`. -/
class is_scalar_tower (M N α : Type*) [has_smul M N] [has_smul N α] [has_smul M α] : Prop :=
(smul_assoc : ∀ (x : M) (y : N) (z : α), (x • y) • z = x • (y • z))

@[simp] lemma smul_assoc {M N} [has_smul M N] [has_smul N α] [has_smul M α]
  [is_scalar_tower M N α] (x : M) (y : N) (z : α) :
  (x • y) • z = x • y • z :=
is_scalar_tower.smul_assoc x y z

instance semigroup.is_scalar_tower [semigroup α] : is_scalar_tower α α α := ⟨mul_assoc⟩

/-- A typeclass indicating that the right (aka `mul_opposite`) and left actions by `M` on `α` are
equal, that is that `M` acts centrally on `α`. This can be thought of as a version of commutativity
for `•`. -/
class is_central_scalar (M α : Type*) [has_smul M α] [has_smul Mᵐᵒᵖ α] : Prop :=
(op_smul_eq_smul : ∀ (m : M) (a : α), mul_opposite.op m • a = m • a)

lemma is_central_scalar.unop_smul_eq_smul {M α : Type*} [has_smul M α] [has_smul Mᵐᵒᵖ α]
  [is_central_scalar M α] (m : Mᵐᵒᵖ) (a : α) : (mul_opposite.unop m) • a = m • a :=
mul_opposite.rec (by exact λ m, (is_central_scalar.op_smul_eq_smul _ _).symm) m

export is_central_scalar (op_smul_eq_smul unop_smul_eq_smul)

-- these instances are very low priority, as there is usually a faster way to find these instances

@[priority 50]
instance smul_comm_class.op_left [has_smul M α] [has_smul Mᵐᵒᵖ α]
  [is_central_scalar M α] [has_smul N α] [smul_comm_class M N α] : smul_comm_class Mᵐᵒᵖ N α :=
⟨λ m n a, by rw [←unop_smul_eq_smul m (n • a), ←unop_smul_eq_smul m a, smul_comm]⟩

@[priority 50]
instance smul_comm_class.op_right [has_smul M α] [has_smul N α] [has_smul Nᵐᵒᵖ α]
  [is_central_scalar N α] [smul_comm_class M N α] : smul_comm_class M Nᵐᵒᵖ α :=
⟨λ m n a, by rw [←unop_smul_eq_smul n (m • a), ←unop_smul_eq_smul n a, smul_comm]⟩

@[priority 50]
instance is_scalar_tower.op_left
  [has_smul M α] [has_smul Mᵐᵒᵖ α] [is_central_scalar M α]
  [has_smul M N] [has_smul Mᵐᵒᵖ N] [is_central_scalar M N]
  [has_smul N α] [is_scalar_tower M N α] : is_scalar_tower Mᵐᵒᵖ N α :=
⟨λ m n a, by rw [←unop_smul_eq_smul m (n • a), ←unop_smul_eq_smul m n, smul_assoc]⟩

@[priority 50]
instance is_scalar_tower.op_right [has_smul M α] [has_smul M N]
  [has_smul N α] [has_smul Nᵐᵒᵖ α] [is_central_scalar N α]
  [is_scalar_tower M N α] : is_scalar_tower M Nᵐᵒᵖ α :=
⟨λ m n a, by rw [←unop_smul_eq_smul n a, ←unop_smul_eq_smul (m • n) a, mul_opposite.unop_smul,
                 smul_assoc]⟩

namespace has_smul
variables [has_smul M α]

/-- Auxiliary definition for `has_smul.comp`, `mul_action.comp_hom`,
`distrib_mul_action.comp_hom`, `module.comp_hom`, etc. -/
@[simp, to_additive  /-" Auxiliary definition for `has_vadd.comp`, `add_action.comp_hom`, etc. "-/]
def comp.smul (g : N → M) (n : N) (a : α) : α :=
g n • a

variables (α)

/-- An action of `M` on `α` and a function `N → M` induces an action of `N` on `α`.

See note [reducible non-instances]. Since this is reducible, we make sure to go via
`has_smul.comp.smul` to prevent typeclass inference unfolding too far. -/
@[reducible, to_additive /-" An additive action of `M` on `α` and a function `N → M` induces
  an additive action of `N` on `α` "-/]
def comp (g : N → M) : has_smul N α :=
{ smul := has_smul.comp.smul g }

variables {α}

/-- Given a tower of scalar actions `M → α → β`, if we use `has_smul.comp`
to pull back both of `M`'s actions by a map `g : N → M`, then we obtain a new
tower of scalar actions `N → α → β`.

This cannot be an instance because it can cause infinite loops whenever the `has_smul` arguments
are still metavariables.
-/
@[priority 100]
lemma comp.is_scalar_tower [has_smul M β] [has_smul α β] [is_scalar_tower M α β]
  (g : N → M) :
  (by haveI := comp α g; haveI := comp β g; exact is_scalar_tower N α β) :=
by exact {smul_assoc := λ n, @smul_assoc _ _ _ _ _ _ _ (g n) }

/--
This cannot be an instance because it can cause infinite loops whenever the `has_smul` arguments
are still metavariables.
-/
@[priority 100]
lemma comp.smul_comm_class [has_smul β α] [smul_comm_class M β α] (g : N → M) :
  (by haveI := comp α g; exact smul_comm_class N β α) :=
by exact {smul_comm := λ n, @smul_comm _ _ _ _ _ _ (g n) }

/--
This cannot be an instance because it can cause infinite loops whenever the `has_smul` arguments
are still metavariables.
-/
@[priority 100]
lemma comp.smul_comm_class' [has_smul β α] [smul_comm_class β M α] (g : N → M) :
  (by haveI := comp α g; exact smul_comm_class β N α) :=
by exact {smul_comm := λ _ n, @smul_comm _ _ _ _ _ _ _ (g n) }

end has_smul

section

/-- Note that the `smul_comm_class α β β` typeclass argument is usually satisfied by `algebra α β`.
-/
@[to_additive]
lemma mul_smul_comm [has_mul β] [has_smul α β] [smul_comm_class α β β] (s : α) (x y : β) :
  x * (s • y) = s • (x * y) :=
(smul_comm s x y).symm

/-- Note that the `is_scalar_tower α β β` typeclass argument is usually satisfied by `algebra α β`.
-/
lemma smul_mul_assoc [has_mul β] [has_smul α β] [is_scalar_tower α β β] (r : α) (x y : β)  :
  (r • x) * y = r • (x * y) :=
smul_assoc r x y

lemma smul_smul_smul_comm [has_smul α β] [has_smul α γ] [has_smul β δ] [has_smul α δ]
  [has_smul γ δ] [is_scalar_tower α β δ] [is_scalar_tower α γ δ] [smul_comm_class β γ δ]
  (a : α) (b : β) (c : γ) (d : δ) : (a • b) • (c • d) = (a • c) • b • d :=
by { rw [smul_assoc, smul_assoc, smul_comm b], apply_instance }

variables [has_smul M α]

lemma commute.smul_right [has_mul α] [smul_comm_class M α α] [is_scalar_tower M α α]
  {a b : α} (h : commute a b) (r : M) :
  commute a (r • b) :=
(mul_smul_comm _ _ _).trans ((congr_arg _ h).trans $ (smul_mul_assoc _ _ _).symm)

lemma commute.smul_left [has_mul α] [smul_comm_class M α α] [is_scalar_tower M α α]
  {a b : α} (h : commute a b) (r : M) :
  commute (r • a) b :=
(h.symm.smul_right r).symm

end

section ite
variables [has_smul M α] (p : Prop) [decidable p]

@[to_additive] lemma ite_smul (a₁ a₂ : M) (b : α) : (ite p a₁ a₂) • b = ite p (a₁ • b) (a₂ • b) :=
by split_ifs; refl

@[to_additive] lemma smul_ite (a : M) (b₁ b₂ : α) : a • (ite p b₁ b₂) = ite p (a • b₁) (a • b₂) :=
by split_ifs; refl

end ite

section
variables [monoid M] [mul_action M α]

@[to_additive] lemma smul_smul (a₁ a₂ : M) (b : α) : a₁ • a₂ • b = (a₁ * a₂) • b :=
(mul_smul _ _ _).symm

variable (M)
@[simp, to_additive] theorem one_smul (b : α) : (1 : M) • b = b := mul_action.one_smul _

/-- `has_smul` version of `one_mul_eq_id` -/
@[to_additive]
lemma one_smul_eq_id : ((•) (1 : M) : α → α) = id := funext $ one_smul _

/-- `has_smul` version of `comp_mul_left` -/
@[to_additive]
lemma comp_smul_left (a₁ a₂ : M) : (•) a₁ ∘ (•) a₂ = ((•) (a₁ * a₂) : α → α) :=
funext $ λ _, (mul_smul _ _ _).symm

variables {M}

/-- Pullback a multiplicative action along an injective map respecting `•`.
See note [reducible non-instances]. -/
@[reducible, to_additive "Pullback an additive action along an injective map respecting `+ᵥ`."]
protected def function.injective.mul_action [has_smul M β] (f : β → α)
  (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  mul_action M β :=
{ smul := (•),
  one_smul := λ x, hf $ (smul _ _).trans $ one_smul _ (f x),
  mul_smul := λ c₁ c₂ x, hf $ by simp only [smul, mul_smul] }

/-- Pushforward a multiplicative action along a surjective map respecting `•`.
See note [reducible non-instances]. -/
@[reducible, to_additive "Pushforward an additive action along a surjective map respecting `+ᵥ`."]
protected def function.surjective.mul_action [has_smul M β] (f : α → β) (hf : surjective f)
  (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  mul_action M β :=
{ smul := (•),
  one_smul := λ y, by { rcases hf y with ⟨x, rfl⟩, rw [← smul, one_smul] },
  mul_smul := λ c₁ c₂ y, by { rcases hf y with ⟨x, rfl⟩, simp only [← smul, mul_smul] } }

/-- Push forward the action of `R` on `M` along a compatible surjective map `f : R →* S`.

See also `function.surjective.distrib_mul_action_left` and `function.surjective.module_left`.
-/
@[reducible, to_additive "Push forward the action of `R` on `M` along a compatible
surjective map `f : R →+ S`."]
def function.surjective.mul_action_left {R S M : Type*} [monoid R] [mul_action R M]
  [monoid S] [has_smul S M]
  (f : R →* S) (hf : function.surjective f) (hsmul : ∀ c (x : M), f c • x = c • x) :
  mul_action S M :=
{ smul := (•),
  one_smul := λ b, by rw [← f.map_one, hsmul, one_smul],
  mul_smul := hf.forall₂.mpr $ λ a b x, by simp only [← f.map_mul, hsmul, mul_smul] }

section

variables (M)

/-- The regular action of a monoid on itself by left multiplication.

This is promoted to a module by `semiring.to_module`. -/
@[priority 910, to_additive] -- see Note [lower instance priority]
instance monoid.to_mul_action : mul_action M M :=
{ smul := (*),
  one_smul := one_mul,
  mul_smul := mul_assoc }

/-- The regular action of a monoid on itself by left addition.

This is promoted to an `add_torsor` by `add_group_is_add_torsor`. -/
add_decl_doc add_monoid.to_add_action

instance is_scalar_tower.left : is_scalar_tower M M α :=
⟨λ x y z, mul_smul x y z⟩

variables {M}

/-- Note that the `is_scalar_tower M α α` and `smul_comm_class M α α` typeclass arguments are
usually satisfied by `algebra M α`. -/
lemma smul_mul_smul [has_mul α] (r s : M) (x y : α)
  [is_scalar_tower M α α] [smul_comm_class M α α] :
  (r • x) * (s • y) = (r * s) • (x * y) :=
by rw [smul_mul_assoc, mul_smul_comm, ← smul_assoc, smul_eq_mul]

end

namespace mul_action

variables (M α)

/-- Embedding of `α` into functions `M → α` induced by a multiplicative action of `M` on `α`. -/
@[to_additive] def to_fun : α ↪ (M → α) :=
⟨λ y x, x • y, λ y₁ y₂ H, one_smul M y₁ ▸ one_smul M y₂ ▸ by convert congr_fun H 1⟩

/-- Embedding of `α` into functions `M → α` induced by an additive action of `M` on `α`. -/
add_decl_doc add_action.to_fun

variables {M α}

@[simp, to_additive] lemma to_fun_apply (x : M) (y : α) : mul_action.to_fun M α y x = x • y :=
rfl

variable (α)

/-- A multiplicative action of `M` on `α` and a monoid homomorphism `N → M` induce
a multiplicative action of `N` on `α`.

See note [reducible non-instances]. -/
@[reducible, to_additive] def comp_hom [monoid N] (g : N →* M) :
  mul_action N α :=
{ smul := has_smul.comp.smul g,
  one_smul := by simp [g.map_one, mul_action.one_smul],
  mul_smul := by simp [g.map_mul, mul_action.mul_smul] }

/-- An additive action of `M` on `α` and an additive monoid homomorphism `N → M` induce
an additive action of `N` on `α`.

See note [reducible non-instances]. -/
add_decl_doc add_action.comp_hom

end mul_action

end

section compatible_scalar

@[simp] lemma smul_one_smul {M} (N) [monoid N] [has_smul M N] [mul_action N α] [has_smul M α]
  [is_scalar_tower M N α] (x : M) (y : α) :
  (x • (1 : N)) • y = x • y :=
by rw [smul_assoc, one_smul]

@[simp] lemma smul_one_mul {M N} [mul_one_class N] [has_smul M N] [is_scalar_tower M N N] (x : M)
  (y : N) : (x • 1) * y = x • y :=
by rw [smul_mul_assoc, one_mul]

@[simp, to_additive] lemma mul_smul_one
  {M N} [mul_one_class N] [has_smul M N] [smul_comm_class M N N] (x : M) (y : N) :
  y * (x • 1) = x • y :=
by rw [← smul_eq_mul, ← smul_comm, smul_eq_mul, mul_one]

lemma is_scalar_tower.of_smul_one_mul {M N} [monoid N] [has_smul M N]
  (h : ∀ (x : M) (y : N), (x • (1 : N)) * y = x • y) :
  is_scalar_tower M N N :=
⟨λ x y z, by rw [← h, smul_eq_mul, mul_assoc, h, smul_eq_mul]⟩

@[to_additive] lemma smul_comm_class.of_mul_smul_one {M N} [monoid N] [has_smul M N]
  (H : ∀ (x : M) (y : N), y * (x • (1 : N)) = x • y) : smul_comm_class M N N :=
⟨λ x y z, by rw [← H x z, smul_eq_mul, ← H, smul_eq_mul, mul_assoc]⟩

end compatible_scalar

/-- Typeclass for multiplicative actions on additive structures. This generalizes group modules. -/
@[ext] class distrib_mul_action (M : Type*) (A : Type*) [monoid M] [add_monoid A]
  extends mul_action M A :=
(smul_add : ∀(r : M) (x y : A), r • (x + y) = r • x + r • y)
(smul_zero : ∀(r : M), r • (0 : A) = 0)

section
variables [monoid M] [add_monoid A] [distrib_mul_action M A]

theorem smul_add (a : M) (b₁ b₂ : A) : a • (b₁ + b₂) = a • b₁ + a • b₂ :=
distrib_mul_action.smul_add _ _ _

@[simp] theorem smul_zero (a : M) : a • (0 : A) = 0 :=
distrib_mul_action.smul_zero _

/-- Pullback a distributive multiplicative action along an injective additive monoid
homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.distrib_mul_action [add_monoid B] [has_smul M B] (f : B →+ A)
  (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  distrib_mul_action M B :=
{ smul := (•),
  smul_add := λ c x y, hf $ by simp only [smul, f.map_add, smul_add],
  smul_zero := λ c, hf $ by simp only [smul, f.map_zero, smul_zero],
  .. hf.mul_action f smul }

/-- Pushforward a distributive multiplicative action along a surjective additive monoid
homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.distrib_mul_action [add_monoid B] [has_smul M B] (f : A →+ B)
  (hf : surjective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  distrib_mul_action M B :=
{ smul := (•),
  smul_add := λ c x y, by { rcases hf x with ⟨x, rfl⟩, rcases hf y with ⟨y, rfl⟩,
    simp only [smul_add, ← smul, ← f.map_add] },
  smul_zero := λ c, by simp only [← f.map_zero, ← smul, smul_zero],
  .. hf.mul_action f smul }

/-- Push forward the action of `R` on `M` along a compatible surjective map `f : R →* S`.

See also `function.surjective.mul_action_left` and `function.surjective.module_left`.
-/
@[reducible]
def function.surjective.distrib_mul_action_left {R S M : Type*} [monoid R] [add_monoid M]
  [distrib_mul_action R M] [monoid S] [has_smul S M]
  (f : R →* S) (hf : function.surjective f) (hsmul : ∀ c (x : M), f c • x = c • x) :
  distrib_mul_action S M :=
{ smul := (•),
  smul_zero := hf.forall.mpr $ λ c, by rw [hsmul, smul_zero],
  smul_add := hf.forall.mpr $ λ c x y, by simp only [hsmul, smul_add],
  .. hf.mul_action_left f hsmul }

variable (A)

/-- Compose a `distrib_mul_action` with a `monoid_hom`, with action `f r' • m`.
See note [reducible non-instances]. -/
@[reducible] def distrib_mul_action.comp_hom [monoid N] (f : N →* M) :
  distrib_mul_action N A :=
{ smul := has_smul.comp.smul f,
  smul_zero := λ x, smul_zero (f x),
  smul_add := λ x, smul_add (f x),
  .. mul_action.comp_hom A f }

/-- Each element of the monoid defines a additive monoid homomorphism. -/
@[simps]
def distrib_mul_action.to_add_monoid_hom (x : M) : A →+ A :=
{ to_fun := (•) x,
  map_zero' := smul_zero x,
  map_add' := smul_add x }

variables (M)

/-- Each element of the monoid defines an additive monoid homomorphism. -/
@[simps]
def distrib_mul_action.to_add_monoid_End : M →* add_monoid.End A :=
{ to_fun := distrib_mul_action.to_add_monoid_hom A,
  map_one' := add_monoid_hom.ext $ one_smul M,
  map_mul' := λ x y, add_monoid_hom.ext $ mul_smul x y }

instance add_monoid.nat_smul_comm_class : smul_comm_class ℕ M A :=
{ smul_comm := λ n x y, ((distrib_mul_action.to_add_monoid_hom A x).map_nsmul y n).symm }

-- `smul_comm_class.symm` is not registered as an instance, as it would cause a loop
instance add_monoid.nat_smul_comm_class' : smul_comm_class M ℕ A :=
smul_comm_class.symm _ _ _

end

section
variables [monoid M] [add_group A] [distrib_mul_action M A]

instance add_group.int_smul_comm_class : smul_comm_class ℤ M A :=
{ smul_comm := λ n x y, ((distrib_mul_action.to_add_monoid_hom A x).map_zsmul y n).symm }

-- `smul_comm_class.symm` is not registered as an instance, as it would cause a loop
instance add_group.int_smul_comm_class' : smul_comm_class M ℤ A :=
smul_comm_class.symm _ _ _

@[simp] theorem smul_neg (r : M) (x : A) : r • (-x) = -(r • x) :=
eq_neg_of_add_eq_zero_left $ by rw [← smul_add, neg_add_self, smul_zero]

theorem smul_sub (r : M) (x y : A) : r • (x - y) = r • x - r • y :=
by rw [sub_eq_add_neg, sub_eq_add_neg, smul_add, smul_neg]

end

/-- Typeclass for multiplicative actions on multiplicative structures. This generalizes
conjugation actions. -/
@[ext] class mul_distrib_mul_action (M : Type*) (A : Type*) [monoid M] [monoid A]
  extends mul_action M A :=
(smul_mul : ∀ (r : M) (x y : A), r • (x * y) = (r • x) * (r • y))
(smul_one : ∀ (r : M), r • (1 : A) = 1)

export mul_distrib_mul_action (smul_one)

section
variables [monoid M] [monoid A] [mul_distrib_mul_action M A]

theorem smul_mul' (a : M) (b₁ b₂ : A) : a • (b₁ * b₂) = (a • b₁) * (a • b₂) :=
mul_distrib_mul_action.smul_mul _ _ _

/-- Pullback a multiplicative distributive multiplicative action along an injective monoid
homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.mul_distrib_mul_action [monoid B] [has_smul M B] (f : B →* A)
  (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  mul_distrib_mul_action M B :=
{ smul := (•),
  smul_mul := λ c x y, hf $ by simp only [smul, f.map_mul, smul_mul'],
  smul_one := λ c, hf $ by simp only [smul, f.map_one, smul_one],
  .. hf.mul_action f smul }

/-- Pushforward a multiplicative distributive multiplicative action along a surjective monoid
homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.mul_distrib_mul_action [monoid B] [has_smul M B] (f : A →* B)
  (hf : surjective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  mul_distrib_mul_action M B :=
{ smul := (•),
  smul_mul := λ c x y, by { rcases hf x with ⟨x, rfl⟩, rcases hf y with ⟨y, rfl⟩,
    simp only [smul_mul', ← smul, ← f.map_mul] },
  smul_one := λ c, by simp only [← f.map_one, ← smul, smul_one],
  .. hf.mul_action f smul }

variable (A)

/-- Compose a `mul_distrib_mul_action` with a `monoid_hom`, with action `f r' • m`.
See note [reducible non-instances]. -/
@[reducible] def mul_distrib_mul_action.comp_hom [monoid N] (f : N →* M) :
  mul_distrib_mul_action N A :=
{ smul := has_smul.comp.smul f,
  smul_one := λ x, smul_one (f x),
  smul_mul := λ x, smul_mul' (f x),
  .. mul_action.comp_hom A f }

/-- Scalar multiplication by `r` as a `monoid_hom`. -/
def mul_distrib_mul_action.to_monoid_hom (r : M) : A →* A :=
{ to_fun := (•) r,
  map_one' := smul_one r,
  map_mul' := smul_mul' r }

variable {A}

@[simp] lemma mul_distrib_mul_action.to_monoid_hom_apply (r : M) (x : A) :
  mul_distrib_mul_action.to_monoid_hom A r x = r • x := rfl

variables (M A)

/-- Each element of the monoid defines a monoid homomorphism. -/
@[simps]
def mul_distrib_mul_action.to_monoid_End : M →* monoid.End A :=
{ to_fun := mul_distrib_mul_action.to_monoid_hom A,
  map_one' := monoid_hom.ext $ one_smul M,
  map_mul' := λ x y, monoid_hom.ext $ mul_smul x y }

end

section
variables [monoid M] [group A] [mul_distrib_mul_action M A]

@[simp] theorem smul_inv' (r : M) (x : A) : r • (x⁻¹) = (r • x)⁻¹ :=
(mul_distrib_mul_action.to_monoid_hom A r).map_inv x

theorem smul_div' (r : M) (x y : A) : r • (x / y) = (r • x) / (r • y) :=
(mul_distrib_mul_action.to_monoid_hom A r).map_div x y

end

variable (α)

/-- The monoid of endomorphisms.

Note that this is generalized by `category_theory.End` to categories other than `Type u`. -/
protected def function.End := α → α

instance : monoid (function.End α) :=
{ one := id,
  mul := (∘),
  mul_assoc := λ f g h, rfl,
  mul_one := λ f, rfl,
  one_mul := λ f, rfl, }

instance : inhabited (function.End α) := ⟨1⟩

variable {α}

/-- The tautological action by `function.End α` on `α`.

This is generalized to bundled endomorphisms by:
* `equiv.perm.apply_mul_action`
* `add_monoid.End.apply_distrib_mul_action`
* `add_aut.apply_distrib_mul_action`
* `mul_aut.apply_mul_distrib_mul_action`
* `ring_hom.apply_distrib_mul_action`
* `linear_equiv.apply_distrib_mul_action`
* `linear_map.apply_module`
* `ring_hom.apply_mul_semiring_action`
* `alg_equiv.apply_mul_semiring_action`
-/
instance function.End.apply_mul_action : mul_action (function.End α) α :=
{ smul := ($),
  one_smul := λ _, rfl,
  mul_smul := λ _ _ _, rfl }

@[simp] lemma function.End.smul_def (f : function.End α) (a : α) : f • a = f a := rfl

/-- `function.End.apply_mul_action` is faithful. -/
instance function.End.apply_has_faithful_smul : has_faithful_smul (function.End α) α :=
⟨λ x y, funext⟩

/-- The tautological action by `add_monoid.End α` on `α`.

This generalizes `function.End.apply_mul_action`. -/
instance add_monoid.End.apply_distrib_mul_action [add_monoid α] :
  distrib_mul_action (add_monoid.End α) α :=
{ smul := ($),
  smul_zero := add_monoid_hom.map_zero,
  smul_add := add_monoid_hom.map_add,
  one_smul := λ _, rfl,
  mul_smul := λ _ _ _, rfl }

@[simp] lemma add_monoid.End.smul_def [add_monoid α] (f : add_monoid.End α) (a : α) :
  f • a = f a := rfl

/-- `add_monoid.End.apply_distrib_mul_action` is faithful. -/
instance add_monoid.End.apply_has_faithful_smul [add_monoid α] :
  has_faithful_smul (add_monoid.End α) α :=
⟨add_monoid_hom.ext⟩

/-- The monoid hom representing a monoid action.

When `M` is a group, see `mul_action.to_perm_hom`. -/
def mul_action.to_End_hom [monoid M] [mul_action M α] : M →* function.End α :=
{ to_fun := (•),
  map_one' := funext (one_smul M),
  map_mul' := λ x y, funext (mul_smul x y) }

/-- The monoid action induced by a monoid hom to `function.End α`

See note [reducible non-instances]. -/
@[reducible]
def mul_action.of_End_hom [monoid M] (f : M →* function.End α) : mul_action M α :=
mul_action.comp_hom α f

/-- The tautological additive action by `additive (function.End α)` on `α`. -/
instance add_action.function_End : add_action (additive (function.End α)) α :=
{ vadd := ($),
  zero_vadd := λ _, rfl,
  add_vadd := λ _ _ _, rfl }

/-- The additive monoid hom representing an additive monoid action.

When `M` is a group, see `add_action.to_perm_hom`. -/
def add_action.to_End_hom [add_monoid M] [add_action M α] : M →+ additive (function.End α) :=
{ to_fun := (+ᵥ),
  map_zero' := funext (zero_vadd M),
  map_add' := λ x y, funext (add_vadd x y) }

/-- The additive action induced by a hom to `additive (function.End α)`

See note [reducible non-instances]. -/
@[reducible]
def add_action.of_End_hom [add_monoid M] (f : M →+ additive (function.End α)) : add_action M α :=
add_action.comp_hom α f


/-
Copyright (c) 2022 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov

! This file was ported from Lean 3 source module data.countable.basic
! leanprover-community/mathlib commit 63f84d91dd847f50bae04a01071f3a5491934e36
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Logic.Equiv.Nat
import Mathbin.Logic.Equiv.Fin
import Mathbin.Data.Countable.Defs

/-!
# Countable types

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

In this file we provide basic instances of the `countable` typeclass defined elsewhere.
-/

universe u v w

open Function

instance : Countable ℤ :=
  Countable.of_equiv ℕ Equiv.intEquivNat.symm

/-!
### Definition in terms of `function.embedding`
-/

section Embedding

variable {α : Sort u} {β : Sort v}

#print countable_iff_nonempty_embedding /-
theorem countable_iff_nonempty_embedding : Countable α ↔ Nonempty (α ↪ ℕ) :=
  ⟨fun ⟨⟨f, hf⟩⟩ => ⟨⟨f, hf⟩⟩, fun ⟨f⟩ => ⟨⟨f, f.2⟩⟩⟩
#align countable_iff_nonempty_embedding countable_iff_nonempty_embedding
-/

#print nonempty_embedding_nat /-
theorem nonempty_embedding_nat (α) [Countable α] : Nonempty (α ↪ ℕ) :=
  countable_iff_nonempty_embedding.1 ‹_›
#align nonempty_embedding_nat nonempty_embedding_nat
-/

#print Function.Embedding.countable /-
protected theorem Function.Embedding.countable [Countable β] (f : α ↪ β) : Countable α :=
  f.Injective.Countable
#align function.embedding.countable Function.Embedding.countable
-/

end Embedding

/-!
### Operations on `Type*`s
-/

section Type

variable {α : Type u} {β : Type v} {π : α → Type w}

instance [Countable α] [Countable β] : Countable (Sum α β) :=
  by
  rcases exists_injective_nat α with ⟨f, hf⟩
  rcases exists_injective_nat β with ⟨g, hg⟩
  exact (equiv.nat_sum_nat_equiv_nat.injective.comp <| hf.sum_map hg).Countable

instance [Countable α] : Countable (Option α) :=
  Countable.of_equiv _ (Equiv.optionEquivSumPUnit α).symm

instance [Countable α] [Countable β] : Countable (α × β) :=
  by
  rcases exists_injective_nat α with ⟨f, hf⟩
  rcases exists_injective_nat β with ⟨g, hg⟩
  exact (nat.mkpair_equiv.injective.comp <| hf.prod_map hg).Countable

instance [Countable α] [∀ a, Countable (π a)] : Countable (Sigma π) :=
  by
  rcases exists_injective_nat α with ⟨f, hf⟩
  choose g hg using fun a => exists_injective_nat (π a)
  exact ((Equiv.sigmaEquivProd ℕ ℕ).Injective.comp <| hf.sigma_map hg).Countable

end Type

section Sort

variable {α : Sort u} {β : Sort v} {π : α → Sort w}

/-!
### Operations on and `Sort*`s
-/

#print SetCoe.countable /-
instance (priority := 500) SetCoe.countable {α} [Countable α] (s : Set α) : Countable s :=
  Subtype.countable
#align set_coe.countable SetCoe.countable
-/

instance [Countable α] [Countable β] : Countable (PSum α β) :=
  Countable.of_equiv (Sum (PLift α) (PLift β)) (Equiv.plift.sumPSum Equiv.plift)

instance [Countable α] [Countable β] : Countable (PProd α β) :=
  Countable.of_equiv (PLift α × PLift β) (Equiv.plift.prodPProd Equiv.plift)

instance [Countable α] [∀ a, Countable (π a)] : Countable (PSigma π) :=
  Countable.of_equiv (Σa : PLift α, PLift (π a.down)) (Equiv.psigmaEquivSigmaPLift π).symm

instance [Finite α] [∀ a, Countable (π a)] : Countable (∀ a, π a) :=
  by
  have : ∀ n, Countable (Fin n → ℕ) := by
    intro n
    induction' n with n ihn
    · infer_instance
    · exact Countable.of_equiv _ (Equiv.piFinSucc _ _).symm
  rcases Finite.exists_equiv_fin α with ⟨n, ⟨e⟩⟩
  have f := fun a => (nonempty_embedding_nat (π a)).some
  exact ((embedding.Pi_congr_right f).trans (Equiv.piCongrLeft' _ e).toEmbedding).Countable

end Sort


/-
Copyright (c) 2022 Sina Hazratpour. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
----------------

# Definitions, Lemmas, and Theorems .
Sina Hazratpour
Introduction to Proof
MATH 301, Johns Hopkins University, Fall 2022
-/
import ..prooflab
import lectures.lec0_intro

set_option pp.beta true
set_option pp.generalized_field_notation false
-- set_option pp.all true

/-
In this lesson, we learn how to define stuff in Lean. We also learn to state and use lemmas and theorems in Lean to prove some basic arithmetic equalities in combination with the tactics `refl`, `exact`, `rw`, and `change` we learned in the previous lesson.
-/

namespace PROOFS

/-! ## Definitions, Lemmas, Theorems -/

section
/-
We can __define__ new stuff in Lean: A __definition__ assigns an expression to a keyword and puts it in the environment.
  def keyword : type := expression
In below, we define `foo` as the natural number `5`.
-/

def foo : nat := 5

#check foo
#print foo
#check foo + 7

/-
We can similarly state a __lemma__ or a __theorem__. A lemma or a theorem is written the same way as `example` except that we give name to our lemmas and theorems for further use.

- A genral __term style__ form of a `lemma` or a `theorem` is as follows:

lemma name_of_lemma (context_of_our_assumptions) :
  statement_of_lemma
:= proof_of_lemma

- A general form of a `lemma` in __tactic style__:

lemma name_of_lemma (context_of_our_assumptions) :
  statement_we_wanna_prove :=
begin
  tactic_1 [...],
  tactic_2 [...],
  ⋮
  tactic_n [...],
end

For instance, in below, we have a __term-style__ of the lemma `bar`:
- `bar` is the __name_of_lemma__ which we can invoke later.
- `(m n : ℤ)` is th __context__ of the lemma: these are the parameters which are used in the statement of the lemma. Think of context as a way of telling to Lean "let x, y, z, and n be natural numbers".
- `2 + n + m = n + 2 + m` is the __statement__ of the lemma: i.e. the thing we want to prove. The statement is usually a proposition which makes sense only in a given context. For instance, the contexts
` m : ℕ `, and ` m n : ℕ ` would not work. Try!
-/

lemma bar (m n : ℤ) :
  2 + n - m = n + 2 - m :=
congr_arg (λ x, x - m) (add_comm 2 n) -- you do not need to understand this proof now

#check bar
#check (bar 2 : ∀ (n : ℤ), 2 + n - 2 = n + 2 - 2)
#check (bar 2 5 : 2 + 5 - 2 = 5 + 2 - 2)

/- In below,
-`flt` is the __name_of_theorem__ which we can invoke later.
- `(x y z n : ℕ)` is th __context__ of the theorem:
- `n > 2 → x * y * z ≠ 0 → x^n + y^n ≠ z^n` is the __statement__ of the theorem:
-`sorry` is a way of telling Lean that we are going to supply a __proof__ later.

-/
theorem flt (x y z n : ℕ) :
  n > 2 → x * y * z ≠ 0 → x^n + y^n ≠ z^n :=
sorry

theorem goldbach : ∀ n, 2 < n → n % 2 = 0 →
  ∃ p q : ℕ, p.prime ∧ q.prime ∧ n = p + q :=
sorry

/-
If we do not want to refer to the result we are proving we can simply declare it as `example`. It works the same way as theorem declaration, but without a name.
-/
example :
  2 + 3 = 5 :=
rfl

end --end of the section

/-
Here we are going to a state a lemma which says that equality in a type `X` is symmetric, i.e. if `x = y` in X then `y = x`. We are going to call this lemma `symme_of_eq`, but you could as well chosen a different name.
Here's a proof of the lemma `symm_of_eq` (symmetry of equality) for any type `X` in the tactic style.
-/

lemma symm_of_eq {X : Type} (x y : X) (h₁ : x = y) :
  y = x :=
begin
  rw h₁,
end

/-
Here's a proof of the lemma `trans_of_eq` (transitivity of equality) for any type `X` in the tactic style.
-/

lemma trans_of_eq {X : Type} (x y z : X) (h₁ : x = y) (h₂ : y = z) :
  x = z :=
begin
  rw h₁,
  rw h₂,
end

/-! ### Using definitions, lemmas, theorems -/

/-
We prove the lemma `bar` above, and we would like to use it to prove
  `2 + n - 1 = n + 2 - 1` :=
which is a special case of `bar` when `m =1`. We do this by the expression `bar 1 n`.
-/
example (n : ℤ) :
  2 + n - 1 = n + 2 - 1 :=
bar 1 n

#check eq.symm -- a lemma in lean library
example (m n : ℕ) (e : m^2 = n) :
  n = m^2 :=
begin
 exact (eq.symm e), -- here's how we use the lemma `eq.symm`.
end

#check eq.subst
example (m n : ℕ) (h : n + 1 = 7) (e : m = n) : m + 1 = 7 :=
begin
 exact eq.subst (eq.symm e) h,
end

#check (zero_mul : ∀ x : ℝ, 0 * x = 0) -- this lemma says that for all real numbers `x`, multiplying `x` by zero on the left yields zero.

example (x y : ℕ) (h₁ : x = 0) (h₂ : y = 0) :
  x * y = 0 :=
begin
  rw h₁, -- we substitute `0` for `x` in the goal
  rw h₂, -- we substitute `0` for `y` in the goal
  exact zero_mul 0, -- we apply lemma `zero_mul` to `0` to prove that `0 * 0 = 0`.
end

-- another proof of the same statement
example (x y : ℕ) (h₁ : x = 0) (h₂ : y = 0) :
  x * y = 0 :=
begin
  rw h₂,
  exact zero_mul y, -- this time we apply lemma `zero_mul` to `y`, to prove that `0 * y = 0`.
end

-- yet another proof of the same statement
example (x y : ℕ) (h₁ : x = 0) (h₂ : y = 0) :
  x * y = 0 :=
begin
  rw h₁,
  rw h₂,
  exact mul_zero 0, -- `mul_zero` isntead of `zero_mul`.
end

/-
remember the example below from previos lecture? we had the problem of applying `rw` directly to `h₁` (since `x + 0` is not a subexpression of the goal), so we applied the tactic `change`. But we could also use the lemma `add_zero : ∀ (a : ℕ), a + 0 = a` to first repalce `x + 0` by `x` in hypothesis `h₁` to obtain a new `h₁ : x = y`, and then replace `x` by `y` in the goal using `rw h₁`. The new goal is now `y = z`. Finally, we finish the proof by copying `h₂`.
-/
example (x y z : ℕ)
  (h₁ : x + 0 = y) (h₂ : y = z) : x = z :=
begin
--  rw h, -- fails because rw works up to syntactic equality
  rw add_zero at h₁, -- would also work; note that the proof of `add_zero` is `refl`.
  rw h₁, -- now it works
  exact h₂,
end

-- maybe seach_library or suggest?
lemma add_sub_left (x y z : ℕ) :
x + y - x = y :=
begin
rw add_comm,
-- seach_library
-- suggest
exact nat.add_sub_cancel y x,
end

#lint

example (x y z : ℕ) :
x + y - x = y :=
begin
rw add_comm,
refine nat.add_sub_cancel _ _, -- use show_term to get the exact term
end

/-
In the following exercises, we will use the following two lemmas:
  ` mul_assoc a b c : a * b * c = a * (b * c) `
  ` mul_comm a b : a * b = b * a `

Hence the command
  `rw mul_assoc a b c`,
will replace `a * b * c` by `a * (b * c)` in the current goal.

In order to replace backward, we use
  ` rw ← mul_assoc a b c`,
replacing `a * ( b * c )` by `a * b * c` in the current goal.
-/

example (a b c : ℝ) :
  (a * b) * c = b * (a * c) :=
begin
  rw mul_comm a b,
  rw mul_assoc b a c,
end

example (a b c : ℝ) : a * (b * c) = b * (a * c) :=
begin
  rw ← mul_assoc a b c,
  nth_rewrite 1 mul_comm,
  rw mul_assoc,
end

/-
Now let's return to the preceding example to experiment with what happens if we don't give arguments to `mul_assoc` or `mul_comm`. For instance, you can start the next proof with
  `rw ← mul_assoc`,
Try to figure out what happens.
-/

example (a b c : ℝ) :
  a * (b * c) = b * (a * c) :=
begin
  rw ← mul_assoc,
  nth_rewrite 1 mul_comm,
  rw mul_assoc,
end

example (a b c : ℝ) :
  a * (b * c) = b * (a * c) :=
begin
  rw mul_comm,
  rw mul_assoc,
  nth_rewrite 1 mul_comm,
end

/- We can also perform _rewriting in an assumption_ of the local context, using for instance
  `rw mul_comm a b at h`,
in order to replace `a * b` by `b * a` in assumption `h`.

The next example will use a third lemma:
  `two_mul a : 2 * a = a + a`
-/

example (a b c d : ℝ) (h₁ : c = d * a + b) (h₂ : b = a * d) : c = 2 * a * d :=
begin
  rw h₂ at h₁,
  rw mul_comm at h₁,
  rw ← two_mul (a * d) at h₁,
  rw ← mul_assoc at h₁,
  exact h₁,
end

end PROOFS