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

! This file was ported from Lean 3 source module algebra.module.localized_module
! leanprover-community/mathlib commit 831c494092374cfe9f50591ed0ac81a25efc5b86
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.GroupTheory.MonoidLocalization
import Mathbin.RingTheory.Localization.Basic
import Mathbin.Algebra.Algebra.RestrictScalars

/-!
# Localized Module

Given a commutative ring `R`, a multiplicative subset `S ⊆ R` and an `R`-module `M`, we can localize
`M` by `S`. This gives us a `localization S`-module.

## Main definitions

* `localized_module.r` : the equivalence relation defining this localization, namely
  `(m, s) ≈ (m', s')` if and only if if there is some `u : S` such that `u • s' • m = u • s • m'`.
* `localized_module M S` : the localized module by `S`.
* `localized_module.mk`  : the canonical map sending `(m, s) : M × S ↦ m/s : localized_module M S`
* `localized_module.lift_on` : any well defined function `f : M × S → α` respecting `r` descents to
  a function `localized_module M S → α`
* `localized_module.lift_on₂` : any well defined function `f : M × S → M × S → α` respecting `r`
  descents to a function `localized_module M S → localized_module M S`
* `localized_module.mk_add_mk` : in the localized module
  `mk m s + mk m' s' = mk (s' • m + s • m') (s * s')`
* `localized_module.mk_smul_mk` : in the localized module, for any `r : R`, `s t : S`, `m : M`,
  we have `mk r s • mk m t = mk (r • m) (s * t)` where `mk r s : localization S` is localized ring
  by `S`.
* `localized_module.is_module` : `localized_module M S` is a `localization S`-module.

## Future work

 * Redefine `localization` for monoids and rings to coincide with `localized_module`.
-/

namespace LocalizedModule

universe u v

variable {R : Type u} [CommSemiring R] (S : Submonoid R)

variable (M : Type v) [AddCommMonoid M] [Module R M]

/-- The equivalence relation on `M × S` where `(m1, s1) ≈ (m2, s2)` if and only if
for some (u : S), u * (s2 • m1 - s1 • m2) = 0-/
def R (a b : M × S) : Prop :=
  ∃ u : S, u • b.2 • a.1 = u • a.2 • b.1
#align localized_module.r LocalizedModule.R

theorem R.isEquiv : IsEquiv _ (R S M) :=
  { refl := fun ⟨m, s⟩ => ⟨1, by rw [one_smul]⟩
    trans := fun ⟨m1, s1⟩ ⟨m2, s2⟩ ⟨m3, s3⟩ ⟨u1, hu1⟩ ⟨u2, hu2⟩ =>
      by
      use u1 * u2 * s2
      -- Put everything in the same shape, sorting the terms using `simp`
      have hu1' := congr_arg ((· • ·) (u2 * s3)) hu1.symm
      have hu2' := congr_arg ((· • ·) (u1 * s1)) hu2.symm
      simp only [← mul_smul, smul_assoc, mul_assoc, mul_comm, mul_left_comm] at hu1' hu2'⊢
      rw [hu2', hu1']
    symm := fun ⟨m1, s1⟩ ⟨m2, s2⟩ ⟨u, hu⟩ => ⟨u, hu.symm⟩ }
#align localized_module.r.is_equiv LocalizedModule.R.isEquiv

instance R.setoid : Setoid (M × S) where
  R := R S M
  iseqv := ⟨(R.isEquiv S M).refl, (R.isEquiv S M).symm, (R.isEquiv S M).trans⟩
#align localized_module.r.setoid LocalizedModule.R.setoid

-- TODO: change `localization` to use `r'` instead of `r` so that the two types are also defeq,
-- `localization S = localized_module S R`.
example {R} [CommSemiring R] (S : Submonoid R) : ⇑(Localization.r' S) = LocalizedModule.R S R :=
  rfl

/-- If `S` is a multiplicative subset of a ring `R` and `M` an `R`-module, then
we can localize `M` by `S`.
-/
@[nolint has_nonempty_instance]
def LocalizedModule : Type max u v :=
  Quotient (R.setoid S M)
#align localized_module LocalizedModule

section

variable {M S}

/-- The canonical map sending `(m, s) ↦ m/s`-/
def mk (m : M) (s : S) : LocalizedModule S M :=
  Quotient.mk' ⟨m, s⟩
#align localized_module.mk LocalizedModule.mk

theorem mk_eq {m m' : M} {s s' : S} : mk m s = mk m' s' ↔ ∃ u : S, u • s' • m = u • s • m' :=
  Quotient.eq'
#align localized_module.mk_eq LocalizedModule.mk_eq

@[elab_as_elim]
theorem induction_on {β : LocalizedModule S M → Prop} (h : ∀ (m : M) (s : S), β (mk m s)) :
    ∀ x : LocalizedModule S M, β x := by
  rintro ⟨⟨m, s⟩⟩
  exact h m s
#align localized_module.induction_on LocalizedModule.induction_on

@[elab_as_elim]
theorem induction_on₂ {β : LocalizedModule S M → LocalizedModule S M → Prop}
    (h : ∀ (m m' : M) (s s' : S), β (mk m s) (mk m' s')) : ∀ x y, β x y :=
  by
  rintro ⟨⟨m, s⟩⟩ ⟨⟨m', s'⟩⟩
  exact h m m' s s'
#align localized_module.induction_on₂ LocalizedModule.induction_on₂

/-- If `f : M × S → α` respects the equivalence relation `localized_module.r`, then
`f` descents to a map `localized_module M S → α`.
-/
def liftOn {α : Type _} (x : LocalizedModule S M) (f : M × S → α)
    (wd : ∀ (p p' : M × S) (h1 : p ≈ p'), f p = f p') : α :=
  Quotient.liftOn x f wd
#align localized_module.lift_on LocalizedModule.liftOn

theorem liftOn_mk {α : Type _} {f : M × S → α} (wd : ∀ (p p' : M × S) (h1 : p ≈ p'), f p = f p')
    (m : M) (s : S) : liftOn (mk m s) f wd = f ⟨m, s⟩ := by convert Quotient.liftOn_mk f wd ⟨m, s⟩
#align localized_module.lift_on_mk LocalizedModule.liftOn_mk

/-- If `f : M × S → M × S → α` respects the equivalence relation `localized_module.r`, then
`f` descents to a map `localized_module M S → localized_module M S → α`.
-/
def liftOn₂ {α : Type _} (x y : LocalizedModule S M) (f : M × S → M × S → α)
    (wd : ∀ (p q p' q' : M × S) (h1 : p ≈ p') (h2 : q ≈ q'), f p q = f p' q') : α :=
  Quotient.liftOn₂ x y f wd
#align localized_module.lift_on₂ LocalizedModule.liftOn₂

theorem liftOn₂_mk {α : Type _} (f : M × S → M × S → α)
    (wd : ∀ (p q p' q' : M × S) (h1 : p ≈ p') (h2 : q ≈ q'), f p q = f p' q') (m m' : M)
    (s s' : S) : liftOn₂ (mk m s) (mk m' s') f wd = f ⟨m, s⟩ ⟨m', s'⟩ := by
  convert Quotient.liftOn₂_mk f wd _ _
#align localized_module.lift_on₂_mk LocalizedModule.liftOn₂_mk

instance : Zero (LocalizedModule S M) :=
  ⟨mk 0 1⟩

@[simp]
theorem zero_mk (s : S) : mk (0 : M) s = 0 :=
  mk_eq.mpr ⟨1, by rw [one_smul, smul_zero, smul_zero, one_smul]⟩
#align localized_module.zero_mk LocalizedModule.zero_mk

instance : Add (LocalizedModule S M)
    where add p1 p2 :=
    liftOn₂ p1 p2 (fun x y => mk (y.2 • x.1 + x.2 • y.1) (x.2 * y.2))
      fun ⟨m1, s1⟩ ⟨m2, s2⟩ ⟨m1', s1'⟩ ⟨m2', s2'⟩ ⟨u1, hu1⟩ ⟨u2, hu2⟩ =>
      mk_eq.mpr
        ⟨u1 * u2,
          by
          -- Put everything in the same shape, sorting the terms using `simp`
          have hu1' := congr_arg ((· • ·) (u2 * s2 * s2')) hu1
          have hu2' := congr_arg ((· • ·) (u1 * s1 * s1')) hu2
          simp only [smul_add, ← mul_smul, smul_assoc, mul_assoc, mul_comm, mul_left_comm] at
            hu1' hu2'⊢
          rw [hu1', hu2']⟩

theorem mk_add_mk {m1 m2 : M} {s1 s2 : S} :
    mk m1 s1 + mk m2 s2 = mk (s2 • m1 + s1 • m2) (s1 * s2) :=
  mk_eq.mpr <| ⟨1, by dsimp only <;> rw [one_smul]⟩
#align localized_module.mk_add_mk LocalizedModule.mk_add_mk

private theorem add_assoc' (x y z : LocalizedModule S M) : x + y + z = x + (y + z) :=
  by
  induction' x using LocalizedModule.induction_on with mx sx
  induction' y using LocalizedModule.induction_on with my sy
  induction' z using LocalizedModule.induction_on with mz sz
  simp only [mk_add_mk, smul_add]
  refine' mk_eq.mpr ⟨1, _⟩
  rw [one_smul, one_smul]
  congr 1
  · rw [mul_assoc]
  · rw [eq_comm, mul_comm, add_assoc, mul_smul, mul_smul, ← mul_smul sx sz, mul_comm, mul_smul]
#align localized_module.add_assoc' localized_module.add_assoc'

private theorem add_comm' (x y : LocalizedModule S M) : x + y = y + x :=
  LocalizedModule.induction_on₂ (fun m m' s s' => by rw [mk_add_mk, mk_add_mk, add_comm, mul_comm])
    x y
#align localized_module.add_comm' localized_module.add_comm'

private theorem zero_add' (x : LocalizedModule S M) : 0 + x = x :=
  induction_on
    (fun m s => by
      rw [← zero_mk s, mk_add_mk, smul_zero, zero_add, mk_eq] <;>
        exact ⟨1, by rw [one_smul, mul_smul, one_smul]⟩)
    x
#align localized_module.zero_add' localized_module.zero_add'

private theorem add_zero' (x : LocalizedModule S M) : x + 0 = x :=
  induction_on
    (fun m s => by
      rw [← zero_mk s, mk_add_mk, smul_zero, add_zero, mk_eq] <;>
        exact ⟨1, by rw [one_smul, mul_smul, one_smul]⟩)
    x
#align localized_module.add_zero' localized_module.add_zero'

instance hasNatSmul : SMul ℕ (LocalizedModule S M) where smul n := nsmulRec n
#align localized_module.has_nat_smul LocalizedModule.hasNatSmul

private theorem nsmul_zero' (x : LocalizedModule S M) : (0 : ℕ) • x = 0 :=
  LocalizedModule.induction_on (fun _ _ => rfl) x
#align localized_module.nsmul_zero' localized_module.nsmul_zero'

private theorem nsmul_succ' (n : ℕ) (x : LocalizedModule S M) : n.succ • x = x + n • x :=
  LocalizedModule.induction_on (fun _ _ => rfl) x
#align localized_module.nsmul_succ' localized_module.nsmul_succ'

instance : AddCommMonoid (LocalizedModule S M)
    where
  add := (· + ·)
  add_assoc := add_assoc'
  zero := 0
  zero_add := zero_add'
  add_zero := add_zero'
  nsmul := (· • ·)
  nsmul_zero := nsmul_zero'
  nsmul_succ := nsmul_succ'
  add_comm := add_comm'

instance {M : Type _} [AddCommGroup M] [Module R M] : AddCommGroup (LocalizedModule S M) :=
  {
    show AddCommMonoid (LocalizedModule S M) by
      infer_instance with
    neg := fun p =>
      liftOn p (fun x => LocalizedModule.mk (-x.1) x.2) fun ⟨m1, s1⟩ ⟨m2, s2⟩ ⟨u, hu⟩ =>
        by
        rw [mk_eq]
        exact ⟨u, by simpa⟩
    add_left_neg := fun p =>
      by
      obtain ⟨⟨m, s⟩, rfl : mk m s = p⟩ := Quotient.exists_rep p
      change
        ((mk m s).liftOn (fun x => mk (-x.1) x.2) fun ⟨m1, s1⟩ ⟨m2, s2⟩ ⟨u, hu⟩ =>
              by
              rw [mk_eq]
              exact ⟨u, by simpa⟩) +
            mk m s =
          0
      rw [lift_on_mk, mk_add_mk]
      simp }

theorem mk_neg {M : Type _} [AddCommGroup M] [Module R M] {m : M} {s : S} : mk (-m) s = -mk m s :=
  rfl
#align localized_module.mk_neg LocalizedModule.mk_neg

instance {A : Type _} [Semiring A] [Algebra R A] {S : Submonoid R} :
    Semiring (LocalizedModule S A) :=
  {
    show AddCommMonoid (LocalizedModule S A) by
      infer_instance with
    mul := fun m₁ m₂ =>
      liftOn₂ m₁ m₂ (fun x₁ x₂ => LocalizedModule.mk (x₁.1 * x₂.1) (x₁.2 * x₂.2))
        (by
          rintro ⟨a₁, s₁⟩ ⟨a₂, s₂⟩ ⟨b₁, t₁⟩ ⟨b₂, t₂⟩ ⟨u₁, e₁⟩ ⟨u₂, e₂⟩
          rw [mk_eq]
          use u₁ * u₂
          dsimp only at e₁ e₂⊢
          rw [eq_comm]
          trans (u₁ • t₁ • a₁) • u₂ • t₂ • a₂
          rw [e₁, e₂]; swap; rw [eq_comm]
          all_goals
            rw [smul_smul, mul_mul_mul_comm, ← smul_eq_mul, ← smul_eq_mul A, smul_smul_smul_comm,
              mul_smul, mul_smul])
    left_distrib := by
      intro x₁ x₂ x₃
      obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := Quotient.exists_rep x₁
      obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := Quotient.exists_rep x₂
      obtain ⟨⟨a₃, s₃⟩, rfl : mk a₃ s₃ = x₃⟩ := Quotient.exists_rep x₃
      apply mk_eq.mpr _
      use 1
      simp only [one_mul, smul_add, mul_add, mul_smul_comm, smul_smul, ← mul_assoc, mul_right_comm]
    right_distrib := by
      intro x₁ x₂ x₃
      obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := Quotient.exists_rep x₁
      obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := Quotient.exists_rep x₂
      obtain ⟨⟨a₃, s₃⟩, rfl : mk a₃ s₃ = x₃⟩ := Quotient.exists_rep x₃
      apply mk_eq.mpr _
      use 1
      simp only [one_mul, smul_add, add_mul, smul_smul, ← mul_assoc, smul_mul_assoc, mul_right_comm]
    zero_mul := by
      intro x
      obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := Quotient.exists_rep x
      exact mk_eq.mpr ⟨1, by simp only [MulZeroClass.zero_mul, smul_zero]⟩
    mul_zero := by
      intro x
      obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := Quotient.exists_rep x
      exact mk_eq.mpr ⟨1, by simp only [MulZeroClass.mul_zero, smul_zero]⟩
    mul_assoc := by
      intro x₁ x₂ x₃
      obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := Quotient.exists_rep x₁
      obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := Quotient.exists_rep x₂
      obtain ⟨⟨a₃, s₃⟩, rfl : mk a₃ s₃ = x₃⟩ := Quotient.exists_rep x₃
      apply mk_eq.mpr _
      use 1
      simp only [one_mul, smul_smul, ← mul_assoc, mul_right_comm]
    one := mk 1 (1 : S)
    one_mul := by
      intro x
      obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := Quotient.exists_rep x
      exact mk_eq.mpr ⟨1, by simp only [one_mul, one_smul]⟩
    mul_one := by
      intro x
      obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := Quotient.exists_rep x
      exact mk_eq.mpr ⟨1, by simp only [mul_one, one_smul]⟩ }

instance {A : Type _} [CommSemiring A] [Algebra R A] {S : Submonoid R} :
    CommSemiring (LocalizedModule S A) :=
  { show Semiring (LocalizedModule S A) by infer_instance with
    mul_comm := by
      intro x₁ x₂
      obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := Quotient.exists_rep x₁
      obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := Quotient.exists_rep x₂
      exact mk_eq.mpr ⟨1, by simp only [one_smul, mul_comm]⟩ }

instance {A : Type _} [Ring A] [Algebra R A] {S : Submonoid R} : Ring (LocalizedModule S A) :=
  { show AddCommGroup (LocalizedModule S A) by infer_instance,
    show Monoid (LocalizedModule S A) by infer_instance,
    show Distrib (LocalizedModule S A) by infer_instance with }

instance {A : Type _} [CommRing A] [Algebra R A] {S : Submonoid R} :
    CommRing (LocalizedModule S A) :=
  { show Ring (LocalizedModule S A) by infer_instance with
    mul_comm := by
      intro x₁ x₂
      obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := Quotient.exists_rep x₁
      obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := Quotient.exists_rep x₂
      exact mk_eq.mpr ⟨1, by simp only [one_smul, mul_comm]⟩ }

theorem mk_mul_mk {A : Type _} [Semiring A] [Algebra R A] {a₁ a₂ : A} {s₁ s₂ : S} :
    mk a₁ s₁ * mk a₂ s₂ = mk (a₁ * a₂) (s₁ * s₂) :=
  rfl
#align localized_module.mk_mul_mk LocalizedModule.mk_mul_mk

instance : SMul (Localization S) (LocalizedModule S M)
    where smul f x :=
    Localization.liftOn f
      (fun r s =>
        liftOn x (fun p => mk (r • p.1) (s * p.2))
          (by
            rintro ⟨m1, t1⟩ ⟨m2, t2⟩ ⟨u, h⟩
            refine' mk_eq.mpr ⟨u, _⟩
            have h' := congr_arg ((· • ·) (s • r)) h
            simp only [← mul_smul, smul_assoc, mul_comm, mul_left_comm, Submonoid.smul_def,
              Submonoid.coe_mul] at h'⊢
            rw [h']))
      (by
        induction' x using LocalizedModule.induction_on with m t
        rintro r r' s s' h
        simp only [lift_on_mk, lift_on_mk, mk_eq]
        obtain ⟨u, eq1⟩ := localization.r_iff_exists.mp h
        use u
        have eq1' := congr_arg (· • t • m) eq1
        simp only [← mul_smul, smul_assoc, Submonoid.smul_def, Submonoid.coe_mul] at eq1'⊢
        ring_nf  at eq1'⊢
        rw [eq1'])

theorem mk_smul_mk (r : R) (m : M) (s t : S) : Localization.mk r s • mk m t = mk (r • m) (s * t) :=
  by
  unfold SMul.smul
  rw [Localization.liftOn_mk, lift_on_mk]
#align localized_module.mk_smul_mk LocalizedModule.mk_smul_mk

private theorem one_smul' (m : LocalizedModule S M) : (1 : Localization S) • m = m :=
  by
  induction' m using LocalizedModule.induction_on with m s
  rw [← Localization.mk_one, mk_smul_mk, one_smul, one_mul]
#align localized_module.one_smul' localized_module.one_smul'

private theorem mul_smul' (x y : Localization S) (m : LocalizedModule S M) :
    (x * y) • m = x • y • m :=
  by
  induction' x using Localization.induction_on with data
  induction' y using Localization.induction_on with data'
  rcases data, data' with ⟨⟨r, s⟩, ⟨r', s'⟩⟩
  induction' m using LocalizedModule.induction_on with m t
  rw [Localization.mk_mul, mk_smul_mk, mk_smul_mk, mk_smul_mk, mul_smul, mul_assoc]
#align localized_module.mul_smul' localized_module.mul_smul'

private theorem smul_add' (x : Localization S) (y z : LocalizedModule S M) :
    x • (y + z) = x • y + x • z :=
  by
  induction' x using Localization.induction_on with data
  rcases data with ⟨r, u⟩
  induction' y using LocalizedModule.induction_on with m s
  induction' z using LocalizedModule.induction_on with n t
  rw [mk_smul_mk, mk_smul_mk, mk_add_mk, mk_smul_mk, mk_add_mk, mk_eq]
  use 1
  simp only [one_smul, smul_add, ← mul_smul, Submonoid.smul_def, Submonoid.coe_mul]
  ring_nf
#align localized_module.smul_add' localized_module.smul_add'

private theorem smul_zero' (x : Localization S) : x • (0 : LocalizedModule S M) = 0 :=
  by
  induction' x using Localization.induction_on with data
  rcases data with ⟨r, s⟩
  rw [← zero_mk s, mk_smul_mk, smul_zero, zero_mk, zero_mk]
#align localized_module.smul_zero' localized_module.smul_zero'

private theorem add_smul' (x y : Localization S) (z : LocalizedModule S M) :
    (x + y) • z = x • z + y • z :=
  by
  induction' x using Localization.induction_on with datax
  induction' y using Localization.induction_on with datay
  induction' z using LocalizedModule.induction_on with m t
  rcases datax, datay with ⟨⟨r, s⟩, ⟨r', s'⟩⟩
  rw [Localization.add_mk, mk_smul_mk, mk_smul_mk, mk_smul_mk, mk_add_mk, mk_eq]
  use 1
  simp only [one_smul, add_smul, smul_add, ← mul_smul, Submonoid.smul_def, Submonoid.coe_mul,
    Submonoid.coe_one]
  rw [add_comm]
  -- Commutativity of addition in the module is not applied by `ring`.
  ring_nf
#align localized_module.add_smul' localized_module.add_smul'

private theorem zero_smul' (x : LocalizedModule S M) : (0 : Localization S) • x = 0 :=
  by
  induction' x using LocalizedModule.induction_on with m s
  rw [← Localization.mk_zero s, mk_smul_mk, zero_smul, zero_mk]
#align localized_module.zero_smul' localized_module.zero_smul'

instance isModule : Module (Localization S) (LocalizedModule S M)
    where
  smul := (· • ·)
  one_smul := one_smul'
  mul_smul := mul_smul'
  smul_add := smul_add'
  smul_zero := smul_zero'
  add_smul := add_smul'
  zero_smul := zero_smul'
#align localized_module.is_module LocalizedModule.isModule

@[simp]
theorem mk_cancel_common_left (s' s : S) (m : M) : mk (s' • m) (s' * s) = mk m s :=
  mk_eq.mpr
    ⟨1, by
      simp only [mul_smul, one_smul]
      rw [smul_comm]⟩
#align localized_module.mk_cancel_common_left LocalizedModule.mk_cancel_common_left

@[simp]
theorem mk_cancel (s : S) (m : M) : mk (s • m) s = mk m 1 :=
  mk_eq.mpr ⟨1, by simp⟩
#align localized_module.mk_cancel LocalizedModule.mk_cancel

@[simp]
theorem mk_cancel_common_right (s s' : S) (m : M) : mk (s' • m) (s * s') = mk m s :=
  mk_eq.mpr ⟨1, by simp [mul_smul]⟩
#align localized_module.mk_cancel_common_right LocalizedModule.mk_cancel_common_right

instance isModule' : Module R (LocalizedModule S M) :=
  { Module.compHom (LocalizedModule S M) <| algebraMap R (Localization S) with }
#align localized_module.is_module' LocalizedModule.isModule'

theorem smul'_mk (r : R) (s : S) (m : M) : r • mk m s = mk (r • m) s := by
  erw [mk_smul_mk r m 1 s, one_mul]
#align localized_module.smul'_mk LocalizedModule.smul'_mk

instance {A : Type _} [Semiring A] [Algebra R A] : Algebra (Localization S) (LocalizedModule S A) :=
  Algebra.ofModule
    (by
      intro r x₁ x₂
      obtain ⟨y, s, rfl : IsLocalization.mk' _ y s = r⟩ := IsLocalization.mk'_surjective S r
      obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := Quotient.exists_rep x₁
      obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := Quotient.exists_rep x₂
      rw [mk_mul_mk, ← Localization.mk_eq_mk', mk_smul_mk, mk_smul_mk, mk_mul_mk, mul_assoc,
        smul_mul_assoc])
    (by
      intro r x₁ x₂
      obtain ⟨y, s, rfl : IsLocalization.mk' _ y s = r⟩ := IsLocalization.mk'_surjective S r
      obtain ⟨⟨a₁, s₁⟩, rfl : mk a₁ s₁ = x₁⟩ := Quotient.exists_rep x₁
      obtain ⟨⟨a₂, s₂⟩, rfl : mk a₂ s₂ = x₂⟩ := Quotient.exists_rep x₂
      rw [mk_mul_mk, ← Localization.mk_eq_mk', mk_smul_mk, mk_smul_mk, mk_mul_mk, mul_left_comm,
        mul_smul_comm])

theorem algebraMap_mk {A : Type _} [Semiring A] [Algebra R A] (a : R) (s : S) :
    algebraMap _ _ (Localization.mk a s) = mk (algebraMap R A a) s :=
  by
  rw [Algebra.algebraMap_eq_smul_one]
  change _ • mk _ _ = _
  rw [mk_smul_mk, Algebra.algebraMap_eq_smul_one, mul_one]
#align localized_module.algebra_map_mk LocalizedModule.algebraMap_mk

instance : IsScalarTower R (Localization S) (LocalizedModule S M) :=
  RestrictScalars.isScalarTower R (Localization S) (LocalizedModule S M)

instance algebra' {A : Type _} [Semiring A] [Algebra R A] : Algebra R (LocalizedModule S A) :=
  { (algebraMap (Localization S) (LocalizedModule S A)).comp (algebraMap R <| Localization S),
    show Module R (LocalizedModule S A) by
      infer_instance with
    commutes' := by
      intro r x
      obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := Quotient.exists_rep x
      dsimp
      rw [← Localization.mk_one_eq_algebraMap, algebra_map_mk, mk_mul_mk, mk_mul_mk, mul_comm,
        Algebra.commutes]
    smul_def' := by
      intro r x
      obtain ⟨⟨a, s⟩, rfl : mk a s = x⟩ := Quotient.exists_rep x
      dsimp
      rw [← Localization.mk_one_eq_algebraMap, algebra_map_mk, mk_mul_mk, smul'_mk,
        Algebra.smul_def, one_mul] }
#align localized_module.algebra' LocalizedModule.algebra'

section

variable (S M)

/-- The function `m ↦ m / 1` as an `R`-linear map.
-/
@[simps]
def mkLinearMap : M →ₗ[R] LocalizedModule S M
    where
  toFun m := mk m 1
  map_add' x y := by simp [mk_add_mk]
  map_smul' r x := (smul'_mk _ _ _).symm
#align localized_module.mk_linear_map LocalizedModule.mkLinearMap

end

/-- For any `s : S`, there is an `R`-linear map given by `a/b ↦ a/(b*s)`.
-/
@[simps]
def divBy (s : S) : LocalizedModule S M →ₗ[R] LocalizedModule S M
    where
  toFun p :=
    p.liftOn (fun p => mk p.1 (s * p.2)) fun ⟨a, b⟩ ⟨a', b'⟩ ⟨c, eq1⟩ =>
      mk_eq.mpr ⟨c, by rw [mul_smul, mul_smul, smul_comm c, eq1, smul_comm s] <;> infer_instance⟩
  map_add' x y :=
    x.induction_on₂
      (by
        intro m₁ m₂ t₁ t₂
        simp only [mk_add_mk, LocalizedModule.liftOn_mk, mul_smul, ← smul_add, mul_assoc,
          mk_cancel_common_left s]
        rw [show s * (t₁ * t₂) = t₁ * (s * t₂) by
            ext
            simp only [Submonoid.coe_mul]
            ring])
      y
  map_smul' r x :=
    x.inductionOn <| by
      intros
      simp [LocalizedModule.liftOn_mk, smul'_mk]
#align localized_module.div_by LocalizedModule.divBy

theorem divBy_mul_by (s : S) (p : LocalizedModule S M) :
    divBy s (algebraMap R (Module.End R (LocalizedModule S M)) s p) = p :=
  p.inductionOn
    (by
      intro m t
      simp only [LocalizedModule.liftOn_mk, Module.algebraMap_end_apply, smul'_mk, div_by_apply]
      erw [mk_cancel_common_left s t])
#align localized_module.div_by_mul_by LocalizedModule.divBy_mul_by

theorem mul_by_divBy (s : S) (p : LocalizedModule S M) :
    algebraMap R (Module.End R (LocalizedModule S M)) s (divBy s p) = p :=
  p.inductionOn
    (by
      intro m t
      simp only [LocalizedModule.liftOn_mk, div_by_apply, Module.algebraMap_end_apply, smul'_mk]
      erw [mk_cancel_common_left s t])
#align localized_module.mul_by_div_by LocalizedModule.mul_by_divBy

end

end LocalizedModule

section IsLocalizedModule

universe u v

variable {R : Type _} [CommRing R] (S : Submonoid R)

variable {M M' M'' : Type _} [AddCommMonoid M] [AddCommMonoid M'] [AddCommMonoid M'']

variable [Module R M] [Module R M'] [Module R M''] (f : M →ₗ[R] M') (g : M →ₗ[R] M'')

/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`map_units] [] -/
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`surj] [] -/
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`eq_iff_exists] [] -/
/-- The characteristic predicate for localized module.
`is_localized_module S f` describes that `f : M ⟶ M'` is the localization map identifying `M'` as
`localized_module S M`.
-/
class IsLocalizedModule : Prop where
  map_units : ∀ x : S, IsUnit (algebraMap R (Module.End R M') x)
  surj : ∀ y : M', ∃ x : M × S, x.2 • y = f x.1
  eq_iff_exists : ∀ {x₁ x₂}, f x₁ = f x₂ ↔ ∃ c : S, c • x₂ = c • x₁
#align is_localized_module IsLocalizedModule

namespace LocalizedModule

/--
If `g` is a linear map `M → M''` such that all scalar multiplication by `s : S` is invertible, then
there is a linear map `localized_module S M → M''`.
-/
noncomputable def lift' (g : M →ₗ[R] M'')
    (h : ∀ x : S, IsUnit ((algebraMap R (Module.End R M'')) x)) : LocalizedModule S M → M'' :=
  fun m =>
  m.liftOn (fun p => (h <| p.2).Unit⁻¹ <| g p.1) fun ⟨m, s⟩ ⟨m', s'⟩ ⟨c, eq1⟩ =>
    by
    generalize_proofs h1 h2
    erw [Module.End_algebraMap_isUnit_inv_apply_eq_iff, ← h2.unit⁻¹.1.map_smul]
    symm
    erw [Module.End_algebraMap_isUnit_inv_apply_eq_iff]
    dsimp
    have : c • s • g m' = c • s' • g m :=
      by
      erw [← g.map_smul, ← g.map_smul, ← g.map_smul, ← g.map_smul, eq1]
      rfl
    have : Function.Injective (h c).Unit.inv :=
      by
      rw [Function.injective_iff_hasLeftInverse]
      refine' ⟨(h c).Unit, _⟩
      intro x
      change ((h c).Unit.1 * (h c).Unit.inv) x = x
      simp only [Units.inv_eq_val_inv, IsUnit.mul_val_inv, LinearMap.one_apply]
    apply_fun (h c).Unit.inv
    erw [Units.inv_eq_val_inv, Module.End_algebraMap_isUnit_inv_apply_eq_iff, ←
      (h c).Unit⁻¹.1.map_smul]
    symm
    erw [Module.End_algebraMap_isUnit_inv_apply_eq_iff, ← g.map_smul, ← g.map_smul, ← g.map_smul, ←
      g.map_smul, eq1]
    rfl
#align localized_module.lift' LocalizedModule.lift'

theorem lift'_mk (g : M →ₗ[R] M'') (h : ∀ x : S, IsUnit ((algebraMap R (Module.End R M'')) x))
    (m : M) (s : S) : LocalizedModule.lift' S g h (LocalizedModule.mk m s) = (h s).Unit⁻¹.1 (g m) :=
  rfl
#align localized_module.lift'_mk LocalizedModule.lift'_mk

theorem lift'_add (g : M →ₗ[R] M'') (h : ∀ x : S, IsUnit ((algebraMap R (Module.End R M'')) x))
    (x y) :
    LocalizedModule.lift' S g h (x + y) =
      LocalizedModule.lift' S g h x + LocalizedModule.lift' S g h y :=
  LocalizedModule.induction_on₂
    (by
      intro a a' b b'
      erw [LocalizedModule.lift'_mk, LocalizedModule.lift'_mk, LocalizedModule.lift'_mk]
      dsimp; generalize_proofs h1 h2 h3
      erw [map_add, Module.End_algebraMap_isUnit_inv_apply_eq_iff, smul_add, ← h2.unit⁻¹.1.map_smul,
        ← h3.unit⁻¹.1.map_smul]
      congr 1 <;> symm
      erw [Module.End_algebraMap_isUnit_inv_apply_eq_iff, mul_smul, ← map_smul]; rfl
      erw [Module.End_algebraMap_isUnit_inv_apply_eq_iff, mul_comm, mul_smul, ← map_smul]; rfl)
    x y
#align localized_module.lift'_add LocalizedModule.lift'_add

theorem lift'_smul (g : M →ₗ[R] M'') (h : ∀ x : S, IsUnit ((algebraMap R (Module.End R M'')) x))
    (r : R) (m) : r • LocalizedModule.lift' S g h m = LocalizedModule.lift' S g h (r • m) :=
  m.inductionOn
    (by
      intro a b
      rw [LocalizedModule.lift'_mk, LocalizedModule.smul'_mk, LocalizedModule.lift'_mk]
      generalize_proofs h1 h2
      erw [← h1.unit⁻¹.1.map_smul, ← g.map_smul])
#align localized_module.lift'_smul LocalizedModule.lift'_smul

/--
If `g` is a linear map `M → M''` such that all scalar multiplication by `s : S` is invertible, then
there is a linear map `localized_module S M → M''`.
-/
noncomputable def lift (g : M →ₗ[R] M'')
    (h : ∀ x : S, IsUnit ((algebraMap R (Module.End R M'')) x)) : LocalizedModule S M →ₗ[R] M''
    where
  toFun := LocalizedModule.lift' S g h
  map_add' := LocalizedModule.lift'_add S g h
  map_smul' r x := by rw [LocalizedModule.lift'_smul, RingHom.id_apply]
#align localized_module.lift LocalizedModule.lift

/--
If `g` is a linear map `M → M''` such that all scalar multiplication by `s : S` is invertible, then
`lift g m s = s⁻¹ • g m`.
-/
theorem lift_mk (g : M →ₗ[R] M'') (h : ∀ x : S, IsUnit ((algebraMap R (Module.End R M'')) x))
    (m : M) (s : S) : LocalizedModule.lift S g h (LocalizedModule.mk m s) = (h s).Unit⁻¹.1 (g m) :=
  rfl
#align localized_module.lift_mk LocalizedModule.lift_mk

/--
If `g` is a linear map `M → M''` such that all scalar multiplication by `s : S` is invertible, then
there is a linear map `lift g ∘ mk_linear_map = g`.
-/
theorem lift_comp (g : M →ₗ[R] M'') (h : ∀ x : S, IsUnit ((algebraMap R (Module.End R M'')) x)) :
    (lift S g h).comp (mkLinearMap S M) = g :=
  by
  ext x; dsimp; rw [LocalizedModule.lift_mk]
  erw [Module.End_algebraMap_isUnit_inv_apply_eq_iff, one_smul]
#align localized_module.lift_comp LocalizedModule.lift_comp

/--
If `g` is a linear map `M → M''` such that all scalar multiplication by `s : S` is invertible and
`l` is another linear map `localized_module S M ⟶ M''` such that `l ∘ mk_linear_map = g` then
`l = lift g`
-/
theorem lift_unique (g : M →ₗ[R] M'') (h : ∀ x : S, IsUnit ((algebraMap R (Module.End R M'')) x))
    (l : LocalizedModule S M →ₗ[R] M'') (hl : l.comp (LocalizedModule.mkLinearMap S M) = g) :
    LocalizedModule.lift S g h = l := by
  ext x; induction' x using LocalizedModule.induction_on with m s
  rw [LocalizedModule.lift_mk]
  erw [Module.End_algebraMap_isUnit_inv_apply_eq_iff, ← hl, LinearMap.coe_comp, Function.comp_apply,
    LocalizedModule.mkLinearMap_apply, ← l.map_smul, LocalizedModule.smul'_mk]
  congr 1; rw [LocalizedModule.mk_eq]
  refine' ⟨1, _⟩; simp only [one_smul]; rfl
#align localized_module.lift_unique LocalizedModule.lift_unique

end LocalizedModule

instance localizedModuleIsLocalizedModule : IsLocalizedModule S (LocalizedModule.mkLinearMap S M)
    where
  map_units s :=
    ⟨⟨algebraMap R (Module.End R (LocalizedModule S M)) s, LocalizedModule.divBy s,
        FunLike.ext _ _ <| LocalizedModule.mul_by_divBy s,
        FunLike.ext _ _ <| LocalizedModule.divBy_mul_by s⟩,
      FunLike.ext _ _ fun p =>
        p.inductionOn <| by
          intros
          rfl⟩
  surj p :=
    p.inductionOn
      (by
        intro m t
        refine' ⟨⟨m, t⟩, _⟩
        erw [LocalizedModule.smul'_mk, LocalizedModule.mkLinearMap_apply, Submonoid.coe_subtype,
          LocalizedModule.mk_cancel t])
  eq_iff_exists m1 m2 :=
    { mp := fun eq1 => by simpa only [eq_comm, one_smul] using localized_module.mk_eq.mp eq1
      mpr := fun ⟨c, eq1⟩ =>
        LocalizedModule.mk_eq.mpr ⟨c, by simpa only [eq_comm, one_smul] using eq1⟩ }
#align localized_module_is_localized_module localizedModuleIsLocalizedModule

namespace IsLocalizedModule

variable [IsLocalizedModule S f]

/-- If `(M', f : M ⟶ M')` satisfies universal property of localized module, there is a canonical map
`localized_module S M ⟶ M'`.
-/
noncomputable def fromLocalizedModule' : LocalizedModule S M → M' := fun p =>
  p.liftOn (fun x => (IsLocalizedModule.map_units f x.2).Unit⁻¹ (f x.1))
    (by
      rintro ⟨a, b⟩ ⟨a', b'⟩ ⟨c, eq1⟩
      dsimp
      generalize_proofs h1 h2
      erw [Module.End_algebraMap_isUnit_inv_apply_eq_iff, ← h2.unit⁻¹.1.map_smul,
        Module.End_algebraMap_isUnit_inv_apply_eq_iff', ← LinearMap.map_smul, ← LinearMap.map_smul]
      exact (IsLocalizedModule.eq_iff_exists S f).mpr ⟨c, eq1⟩)
#align is_localized_module.from_localized_module' IsLocalizedModule.fromLocalizedModule'

@[simp]
theorem fromLocalizedModule'_mk (m : M) (s : S) :
    fromLocalizedModule' S f (LocalizedModule.mk m s) =
      (IsLocalizedModule.map_units f s).Unit⁻¹ (f m) :=
  rfl
#align is_localized_module.from_localized_module'_mk IsLocalizedModule.fromLocalizedModule'_mk

theorem fromLocalizedModule'_add (x y : LocalizedModule S M) :
    fromLocalizedModule' S f (x + y) = fromLocalizedModule' S f x + fromLocalizedModule' S f y :=
  LocalizedModule.induction_on₂
    (by
      intro a a' b b'
      simp only [LocalizedModule.mk_add_mk, from_localized_module'_mk]
      generalize_proofs h1 h2 h3
      erw [Module.End_algebraMap_isUnit_inv_apply_eq_iff, smul_add, ← h2.unit⁻¹.1.map_smul, ←
        h3.unit⁻¹.1.map_smul, map_add]
      congr 1
      all_goals erw [Module.End_algebraMap_isUnit_inv_apply_eq_iff']
      · dsimp
        erw [mul_smul, f.map_smul]
        rfl
      · dsimp
        erw [mul_comm, f.map_smul, mul_smul]
        rfl)
    x y
#align is_localized_module.from_localized_module'_add IsLocalizedModule.fromLocalizedModule'_add

theorem fromLocalizedModule'_smul (r : R) (x : LocalizedModule S M) :
    r • fromLocalizedModule' S f x = fromLocalizedModule' S f (r • x) :=
  LocalizedModule.induction_on
    (by
      intro a b
      rw [from_localized_module'_mk, LocalizedModule.smul'_mk, from_localized_module'_mk]
      generalize_proofs h1; erw [f.map_smul, h1.unit⁻¹.1.map_smul]; rfl)
    x
#align is_localized_module.from_localized_module'_smul IsLocalizedModule.fromLocalizedModule'_smul

/-- If `(M', f : M ⟶ M')` satisfies universal property of localized module, there is a canonical map
`localized_module S M ⟶ M'`.
-/
noncomputable def fromLocalizedModule : LocalizedModule S M →ₗ[R] M'
    where
  toFun := fromLocalizedModule' S f
  map_add' := fromLocalizedModule'_add S f
  map_smul' r x := by rw [from_localized_module'_smul, RingHom.id_apply]
#align is_localized_module.from_localized_module IsLocalizedModule.fromLocalizedModule

theorem fromLocalizedModule_mk (m : M) (s : S) :
    fromLocalizedModule S f (LocalizedModule.mk m s) =
      (IsLocalizedModule.map_units f s).Unit⁻¹ (f m) :=
  rfl
#align is_localized_module.from_localized_module_mk IsLocalizedModule.fromLocalizedModule_mk

theorem fromLocalizedModule.inj : Function.Injective <| fromLocalizedModule S f := fun x y eq1 =>
  by
  induction' x using LocalizedModule.induction_on with a b
  induction' y using LocalizedModule.induction_on with a' b'
  simp only [from_localized_module_mk] at eq1
  generalize_proofs h1 h2  at eq1
  erw [Module.End_algebraMap_isUnit_inv_apply_eq_iff, ← LinearMap.map_smul,
    Module.End_algebraMap_isUnit_inv_apply_eq_iff'] at eq1
  erw [LocalizedModule.mk_eq, ← IsLocalizedModule.eq_iff_exists S f, f.map_smul, f.map_smul, eq1]
  rfl
#align is_localized_module.from_localized_module.inj IsLocalizedModule.fromLocalizedModule.inj

theorem fromLocalizedModule.surj : Function.Surjective <| fromLocalizedModule S f := fun x =>
  let ⟨⟨m, s⟩, eq1⟩ := IsLocalizedModule.surj S f x
  ⟨LocalizedModule.mk m s,
    by
    rw [from_localized_module_mk, Module.End_algebraMap_isUnit_inv_apply_eq_iff, ← eq1]
    rfl⟩
#align is_localized_module.from_localized_module.surj IsLocalizedModule.fromLocalizedModule.surj

theorem fromLocalizedModule.bij : Function.Bijective <| fromLocalizedModule S f :=
  ⟨fromLocalizedModule.inj _ _, fromLocalizedModule.surj _ _⟩
#align is_localized_module.from_localized_module.bij IsLocalizedModule.fromLocalizedModule.bij

/--
If `(M', f : M ⟶ M')` satisfies universal property of localized module, then `M'` is isomorphic to
`localized_module S M` as an `R`-module.
-/
@[simps]
noncomputable def iso : LocalizedModule S M ≃ₗ[R] M' :=
  { fromLocalizedModule S f,
    Equiv.ofBijective (fromLocalizedModule S f) <| fromLocalizedModule.bij _ _ with }
#align is_localized_module.iso IsLocalizedModule.iso

theorem iso_apply_mk (m : M) (s : S) :
    iso S f (LocalizedModule.mk m s) = (IsLocalizedModule.map_units f s).Unit⁻¹ (f m) :=
  rfl
#align is_localized_module.iso_apply_mk IsLocalizedModule.iso_apply_mk

theorem iso_symm_apply_aux (m : M') :
    (iso S f).symm m =
      LocalizedModule.mk (IsLocalizedModule.surj S f m).some.1
        (IsLocalizedModule.surj S f m).some.2 :=
  by
  generalize_proofs _ h2
  apply_fun iso S f using LinearEquiv.injective _
  rw [LinearEquiv.apply_symm_apply]
  simp only [iso_apply, LinearMap.toFun_eq_coe, from_localized_module_mk]
  erw [Module.End_algebraMap_isUnit_inv_apply_eq_iff', h2.some_spec]
#align is_localized_module.iso_symm_apply_aux IsLocalizedModule.iso_symm_apply_aux

theorem iso_symm_apply' (m : M') (a : M) (b : S) (eq1 : b • m = f a) :
    (iso S f).symm m = LocalizedModule.mk a b :=
  (iso_symm_apply_aux S f m).trans <|
    LocalizedModule.mk_eq.mpr <| by
      generalize_proofs h1
      erw [← IsLocalizedModule.eq_iff_exists S f, f.map_smul, f.map_smul, ← h1.some_spec, ←
        mul_smul, mul_comm, mul_smul, eq1]
#align is_localized_module.iso_symm_apply' IsLocalizedModule.iso_symm_apply'

theorem iso_symm_comp : (iso S f).symm.toLinearMap.comp f = LocalizedModule.mkLinearMap S M :=
  by
  ext m; rw [LinearMap.comp_apply, LocalizedModule.mkLinearMap_apply]
  change (iso S f).symm _ = _; rw [iso_symm_apply']; exact one_smul _ _
#align is_localized_module.iso_symm_comp IsLocalizedModule.iso_symm_comp

/--
If `M'` is a localized module and `g` is a linear map `M' → M''` such that all scalar multiplication
by `s : S` is invertible, then there is a linear map `M' → M''`.
-/
noncomputable def lift (g : M →ₗ[R] M'')
    (h : ∀ x : S, IsUnit ((algebraMap R (Module.End R M'')) x)) : M' →ₗ[R] M'' :=
  (LocalizedModule.lift S g h).comp (iso S f).symm.toLinearMap
#align is_localized_module.lift IsLocalizedModule.lift

theorem lift_comp (g : M →ₗ[R] M'') (h : ∀ x : S, IsUnit ((algebraMap R (Module.End R M'')) x)) :
    (lift S f g h).comp f = g :=
  by
  dsimp only [IsLocalizedModule.lift]
  rw [LinearMap.comp_assoc]
  convert LocalizedModule.lift_comp S g h
  exact iso_symm_comp _ _
#align is_localized_module.lift_comp IsLocalizedModule.lift_comp

theorem lift_unique (g : M →ₗ[R] M'') (h : ∀ x : S, IsUnit ((algebraMap R (Module.End R M'')) x))
    (l : M' →ₗ[R] M'') (hl : l.comp f = g) : lift S f g h = l :=
  by
  dsimp only [IsLocalizedModule.lift]
  rw [LocalizedModule.lift_unique S g h (l.comp (iso S f).toLinearMap), LinearMap.comp_assoc,
    show (iso S f).toLinearMap.comp (iso S f).symm.toLinearMap = LinearMap.id from _,
    LinearMap.comp_id]
  · rw [LinearEquiv.comp_toLinearMap_symm_eq, LinearMap.id_comp]
  · rw [LinearMap.comp_assoc, ← hl]
    congr 1
    ext x
    erw [from_localized_module_mk, Module.End_algebraMap_isUnit_inv_apply_eq_iff, one_smul]
#align is_localized_module.lift_unique IsLocalizedModule.lift_unique

/-- Universal property from localized module:
If `(M', f : M ⟶ M')` is a localized module then it satisfies the following universal property:
For every `R`-module `M''` which every `s : S`-scalar multiplication is invertible and for every
`R`-linear map `g : M ⟶ M''`, there is a unique `R`-linear map `l : M' ⟶ M''` such that
`l ∘ f = g`.
```
M -----f----> M'
|           /
|g       /
|     /   l
v   /
M''
```
-/
theorem is_universal :
    ∀ (g : M →ₗ[R] M'') (map_unit : ∀ x : S, IsUnit ((algebraMap R (Module.End R M'')) x)),
      ∃! l : M' →ₗ[R] M'', l.comp f = g :=
  fun g h => ⟨lift S f g h, lift_comp S f g h, fun l hl => (lift_unique S f g h l hl).symm⟩
#align is_localized_module.is_universal IsLocalizedModule.is_universal

theorem ringHom_ext (map_unit : ∀ x : S, IsUnit ((algebraMap R (Module.End R M'')) x))
    ⦃j k : M' →ₗ[R] M''⦄ (h : j.comp f = k.comp f) : j = k :=
  by
  rw [← lift_unique S f (k.comp f) map_unit j h, lift_unique]
  rfl
#align is_localized_module.ring_hom_ext IsLocalizedModule.ringHom_ext

/-- If `(M', f)` and `(M'', g)` both satisfy universal property of localized module, then `M', M''`
are isomorphic as `R`-module
-/
noncomputable def linearEquiv [IsLocalizedModule S g] : M' ≃ₗ[R] M'' :=
  (iso S f).symm.trans (iso S g)
#align is_localized_module.linear_equiv IsLocalizedModule.linearEquiv

variable {S}

theorem smul_injective (s : S) : Function.Injective fun m : M' => s • m :=
  ((Module.End_isUnit_iff _).mp (IsLocalizedModule.map_units f s)).Injective
#align is_localized_module.smul_injective IsLocalizedModule.smul_injective

theorem smul_inj (s : S) (m₁ m₂ : M') : s • m₁ = s • m₂ ↔ m₁ = m₂ :=
  (smul_injective f s).eq_iff
#align is_localized_module.smul_inj IsLocalizedModule.smul_inj

/-- `mk' f m s` is the fraction `m/s` with respect to the localization map `f`. -/
noncomputable def mk' (m : M) (s : S) : M' :=
  fromLocalizedModule S f (LocalizedModule.mk m s)
#align is_localized_module.mk' IsLocalizedModule.mk'

theorem mk'_smul (r : R) (m : M) (s : S) : mk' f (r • m) s = r • mk' f m s :=
  by
  delta mk'
  rw [← LocalizedModule.smul'_mk, LinearMap.map_smul]
#align is_localized_module.mk'_smul IsLocalizedModule.mk'_smul

theorem mk'_add_mk' (m₁ m₂ : M) (s₁ s₂ : S) :
    mk' f m₁ s₁ + mk' f m₂ s₂ = mk' f (s₂ • m₁ + s₁ • m₂) (s₁ * s₂) :=
  by
  delta mk'
  rw [← map_add, LocalizedModule.mk_add_mk]
#align is_localized_module.mk'_add_mk' IsLocalizedModule.mk'_add_mk'

@[simp]
theorem mk'_zero (s : S) : mk' f 0 s = 0 := by rw [← zero_smul R (0 : M), mk'_smul, zero_smul]
#align is_localized_module.mk'_zero IsLocalizedModule.mk'_zero

variable (S)

@[simp]
theorem mk'_one (m : M) : mk' f m (1 : S) = f m :=
  by
  delta mk'
  rw [from_localized_module_mk, Module.End_algebraMap_isUnit_inv_apply_eq_iff, Submonoid.coe_one,
    one_smul]
#align is_localized_module.mk'_one IsLocalizedModule.mk'_one

variable {S}

@[simp]
theorem mk'_cancel (m : M) (s : S) : mk' f (s • m) s = f m :=
  by
  delta mk'
  rw [LocalizedModule.mk_cancel, ← mk'_one S f]
  rfl
#align is_localized_module.mk'_cancel IsLocalizedModule.mk'_cancel

@[simp]
theorem mk'_cancel' (m : M) (s : S) : s • mk' f m s = f m := by
  rw [Submonoid.smul_def, ← mk'_smul, ← Submonoid.smul_def, mk'_cancel]
#align is_localized_module.mk'_cancel' IsLocalizedModule.mk'_cancel'

@[simp]
theorem mk'_cancel_left (m : M) (s₁ s₂ : S) : mk' f (s₁ • m) (s₁ * s₂) = mk' f m s₂ :=
  by
  delta mk'
  rw [LocalizedModule.mk_cancel_common_left]
#align is_localized_module.mk'_cancel_left IsLocalizedModule.mk'_cancel_left

@[simp]
theorem mk'_cancel_right (m : M) (s₁ s₂ : S) : mk' f (s₂ • m) (s₁ * s₂) = mk' f m s₁ :=
  by
  delta mk'
  rw [LocalizedModule.mk_cancel_common_right]
#align is_localized_module.mk'_cancel_right IsLocalizedModule.mk'_cancel_right

theorem mk'_add (m₁ m₂ : M) (s : S) : mk' f (m₁ + m₂) s = mk' f m₁ s + mk' f m₂ s := by
  rw [mk'_add_mk', ← smul_add, mk'_cancel_left]
#align is_localized_module.mk'_add IsLocalizedModule.mk'_add

theorem mk'_eq_mk'_iff (m₁ m₂ : M) (s₁ s₂ : S) :
    mk' f m₁ s₁ = mk' f m₂ s₂ ↔ ∃ s : S, s • s₁ • m₂ = s • s₂ • m₁ :=
  by
  delta mk'
  rw [(from_localized_module.inj S f).eq_iff, LocalizedModule.mk_eq]
  simp_rw [eq_comm]
#align is_localized_module.mk'_eq_mk'_iff IsLocalizedModule.mk'_eq_mk'_iff

theorem mk'_neg {M M' : Type _} [AddCommGroup M] [AddCommGroup M'] [Module R M] [Module R M']
    (f : M →ₗ[R] M') [IsLocalizedModule S f] (m : M) (s : S) : mk' f (-m) s = -mk' f m s :=
  by
  delta mk'
  rw [LocalizedModule.mk_neg, map_neg]
#align is_localized_module.mk'_neg IsLocalizedModule.mk'_neg

theorem mk'_sub {M M' : Type _} [AddCommGroup M] [AddCommGroup M'] [Module R M] [Module R M']
    (f : M →ₗ[R] M') [IsLocalizedModule S f] (m₁ m₂ : M) (s : S) :
    mk' f (m₁ - m₂) s = mk' f m₁ s - mk' f m₂ s := by
  rw [sub_eq_add_neg, sub_eq_add_neg, mk'_add, mk'_neg]
#align is_localized_module.mk'_sub IsLocalizedModule.mk'_sub

theorem mk'_sub_mk' {M M' : Type _} [AddCommGroup M] [AddCommGroup M'] [Module R M] [Module R M']
    (f : M →ₗ[R] M') [IsLocalizedModule S f] (m₁ m₂ : M) (s₁ s₂ : S) :
    mk' f m₁ s₁ - mk' f m₂ s₂ = mk' f (s₂ • m₁ - s₁ • m₂) (s₁ * s₂) := by
  rw [sub_eq_add_neg, ← mk'_neg, mk'_add_mk', smul_neg, ← sub_eq_add_neg]
#align is_localized_module.mk'_sub_mk' IsLocalizedModule.mk'_sub_mk'

theorem mk'_mul_mk'_of_map_mul {M M' : Type _} [Semiring M] [Semiring M'] [Module R M]
    [Algebra R M'] (f : M →ₗ[R] M') (hf : ∀ m₁ m₂, f (m₁ * m₂) = f m₁ * f m₂)
    [IsLocalizedModule S f] (m₁ m₂ : M) (s₁ s₂ : S) :
    mk' f m₁ s₁ * mk' f m₂ s₂ = mk' f (m₁ * m₂) (s₁ * s₂) :=
  by
  symm
  apply (Module.End_algebraMap_isUnit_inv_apply_eq_iff _ _ _).mpr
  simp_rw [Submonoid.coe_mul, ← smul_eq_mul]
  rw [smul_smul_smul_comm, ← mk'_smul, ← mk'_smul]
  simp_rw [← Submonoid.smul_def, mk'_cancel, smul_eq_mul, hf]
#align is_localized_module.mk'_mul_mk'_of_map_mul IsLocalizedModule.mk'_mul_mk'_of_map_mul

theorem mk'_mul_mk' {M M' : Type _} [Semiring M] [Semiring M'] [Algebra R M] [Algebra R M']
    (f : M →ₐ[R] M') [IsLocalizedModule S f.toLinearMap] (m₁ m₂ : M) (s₁ s₂ : S) :
    mk' f.toLinearMap m₁ s₁ * mk' f.toLinearMap m₂ s₂ = mk' f.toLinearMap (m₁ * m₂) (s₁ * s₂) :=
  mk'_mul_mk'_of_map_mul f.toLinearMap f.map_mul m₁ m₂ s₁ s₂
#align is_localized_module.mk'_mul_mk' IsLocalizedModule.mk'_mul_mk'

variable {f}

@[simp]
theorem mk'_eq_iff {m : M} {s : S} {m' : M'} : mk' f m s = m' ↔ f m = s • m' := by
  rw [← smul_inj f s, Submonoid.smul_def, ← mk'_smul, ← Submonoid.smul_def, mk'_cancel]
#align is_localized_module.mk'_eq_iff IsLocalizedModule.mk'_eq_iff

@[simp]
theorem mk'_eq_zero {m : M} (s : S) : mk' f m s = 0 ↔ f m = 0 := by rw [mk'_eq_iff, smul_zero]
#align is_localized_module.mk'_eq_zero IsLocalizedModule.mk'_eq_zero

variable (f)

theorem mk'_eq_zero' {m : M} (s : S) : mk' f m s = 0 ↔ ∃ s' : S, s' • m = 0 := by
  simp_rw [← mk'_zero f (1 : S), mk'_eq_mk'_iff, smul_zero, one_smul, eq_comm]
#align is_localized_module.mk'_eq_zero' IsLocalizedModule.mk'_eq_zero'

theorem mk_eq_mk' (s : S) (m : M) :
    LocalizedModule.mk m s = mk' (LocalizedModule.mkLinearMap S M) m s := by
  rw [eq_comm, mk'_eq_iff, Submonoid.smul_def, LocalizedModule.smul'_mk, ← Submonoid.smul_def,
    LocalizedModule.mk_cancel, LocalizedModule.mkLinearMap_apply]
#align is_localized_module.mk_eq_mk' IsLocalizedModule.mk_eq_mk'

variable (S)

theorem eq_zero_iff {m : M} : f m = 0 ↔ ∃ s' : S, s' • m = 0 :=
  (mk'_eq_zero (1 : S)).symm.trans (mk'_eq_zero' f _)
#align is_localized_module.eq_zero_iff IsLocalizedModule.eq_zero_iff

theorem mk'_surjective : Function.Surjective (Function.uncurry <| mk' f : M × S → M') :=
  by
  intro x
  obtain ⟨⟨m, s⟩, e : s • x = f m⟩ := IsLocalizedModule.surj S f x
  exact ⟨⟨m, s⟩, mk'_eq_iff.mpr e.symm⟩
#align is_localized_module.mk'_surjective IsLocalizedModule.mk'_surjective

section Algebra

theorem mkOfAlgebra {R S S' : Type _} [CommRing R] [CommRing S] [CommRing S'] [Algebra R S]
    [Algebra R S'] (M : Submonoid R) (f : S →ₐ[R] S') (h₁ : ∀ x ∈ M, IsUnit (algebraMap R S' x))
    (h₂ : ∀ y, ∃ x : S × M, x.2 • y = f x.1) (h₃ : ∀ x, f x = 0 → ∃ m : M, m • x = 0) :
    IsLocalizedModule M f.toLinearMap :=
  by
  replace h₃ := fun x =>
    Iff.intro (h₃ x) fun ⟨⟨m, hm⟩, e⟩ =>
      (h₁ m hm).mul_left_cancel <| by
        rw [← Algebra.smul_def]
        simpa [Submonoid.smul_def] using f.congr_arg e
  constructor
  · intro x
    rw [Module.End_isUnit_iff]
    constructor
    · rintro a b (e : x • a = x • b)
      simp_rw [Submonoid.smul_def, Algebra.smul_def] at e
      exact (h₁ x x.2).mul_left_cancel e
    · intro a
      refine' ⟨((h₁ x x.2).Unit⁻¹ : _) * a, _⟩
      change (x : R) • (_ * a) = _
      rw [Algebra.smul_def, ← mul_assoc, IsUnit.mul_val_inv, one_mul]
  · exact h₂
  · intros
    dsimp
    rw [eq_comm, ← sub_eq_zero, ← map_sub, h₃]
    simp_rw [smul_sub, sub_eq_zero]
#align is_localized_module.mk_of_algebra IsLocalizedModule.mkOfAlgebra

end Algebra

end IsLocalizedModule

end IsLocalizedModule


/-
Copyright (c) 2021 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth, Eric Wieser
-/
import analysis.normed_space.basic
import analysis.normed_space.pi_Lp
import analysis.inner_product_space.pi_L2

/-!
# Matrices as a normed space

In this file we provide the following non-instances for norms on matrices:

* The elementwise norm:

  * `matrix.seminormed_add_comm_group`
  * `matrix.normed_add_comm_group`
  * `matrix.normed_space`

* The Frobenius norm:

  * `matrix.frobenius_seminormed_add_comm_group`
  * `matrix.frobenius_normed_add_comm_group`
  * `matrix.frobenius_normed_space`
  * `matrix.frobenius_normed_ring`
  * `matrix.frobenius_normed_algebra`

* The $L^\infty$ operator norm:

  * `matrix.linfty_op_seminormed_add_comm_group`
  * `matrix.linfty_op_normed_add_comm_group`
  * `matrix.linfty_op_normed_space`
  * `matrix.linfty_op_non_unital_semi_normed_ring`
  * `matrix.linfty_op_semi_normed_ring`
  * `matrix.linfty_op_non_unital_normed_ring`
  * `matrix.linfty_op_normed_ring`
  * `matrix.linfty_op_normed_algebra`

These are not declared as instances because there are several natural choices for defining the norm
of a matrix.
-/

noncomputable theory

open_locale big_operators nnreal matrix

namespace matrix

variables {R l m n α β : Type*} [fintype l] [fintype m] [fintype n]

/-! ### The elementwise supremum norm -/

section linf_linf

section seminormed_add_comm_group
variables [seminormed_add_comm_group α] [seminormed_add_comm_group β]

/-- Seminormed group instance (using sup norm of sup norm) for matrices over a seminormed group. Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
protected def seminormed_add_comm_group : seminormed_add_comm_group (matrix m n α) :=
pi.seminormed_add_comm_group

local attribute [instance] matrix.seminormed_add_comm_group

lemma norm_le_iff {r : ℝ} (hr : 0 ≤ r) {A : matrix m n α} :
  ‖A‖ ≤ r ↔ ∀ i j, ‖A i j‖ ≤ r :=
by simp [pi_norm_le_iff_of_nonneg hr]

lemma nnnorm_le_iff {r : ℝ≥0} {A : matrix m n α} :
  ‖A‖₊ ≤ r ↔ ∀ i j, ‖A i j‖₊ ≤ r :=
by simp [pi_nnnorm_le_iff]

lemma norm_lt_iff {r : ℝ} (hr : 0 < r) {A : matrix m n α} :
  ‖A‖ < r ↔ ∀ i j, ‖A i j‖ < r :=
by simp [pi_norm_lt_iff hr]

lemma nnnorm_lt_iff {r : ℝ≥0} (hr : 0 < r) {A : matrix m n α} :
  ‖A‖₊ < r ↔ ∀ i j, ‖A i j‖₊ < r :=
by simp [pi_nnnorm_lt_iff hr]

lemma norm_entry_le_entrywise_sup_norm (A : matrix m n α) {i : m} {j : n} :
  ‖A i j‖ ≤ ‖A‖ :=
(norm_le_pi_norm (A i) j).trans (norm_le_pi_norm A i)

lemma nnnorm_entry_le_entrywise_sup_nnnorm (A : matrix m n α) {i : m} {j : n} :
  ‖A i j‖₊ ≤ ‖A‖₊ :=
(nnnorm_le_pi_nnnorm (A i) j).trans (nnnorm_le_pi_nnnorm A i)

@[simp] lemma nnnorm_map_eq (A : matrix m n α) (f : α → β) (hf : ∀ a, ‖f a‖₊ = ‖a‖₊) :
  ‖A.map f‖₊ = ‖A‖₊ :=
by simp_rw [pi.nnnorm_def, matrix.map_apply, hf]
@[simp] lemma norm_map_eq (A : matrix m n α) (f : α → β) (hf : ∀ a, ‖f a‖ = ‖a‖) :
  ‖A.map f‖ = ‖A‖ :=
(congr_arg (coe : ℝ≥0 → ℝ) $ nnnorm_map_eq A f $ λ a, subtype.ext $ hf a : _)

@[simp] lemma nnnorm_transpose (A : matrix m n α) : ‖Aᵀ‖₊ = ‖A‖₊ :=
by { simp_rw [pi.nnnorm_def], exact finset.sup_comm _ _ _ }
@[simp] lemma norm_transpose (A : matrix m n α) : ‖Aᵀ‖ = ‖A‖ := congr_arg coe $ nnnorm_transpose A

@[simp] lemma nnnorm_conj_transpose [star_add_monoid α] [normed_star_group α] (A : matrix m n α) :
  ‖Aᴴ‖₊ = ‖A‖₊ :=
(nnnorm_map_eq _ _ nnnorm_star).trans A.nnnorm_transpose
@[simp] lemma norm_conj_transpose [star_add_monoid α] [normed_star_group α] (A : matrix m n α) :
  ‖Aᴴ‖ = ‖A‖ :=
congr_arg coe $ nnnorm_conj_transpose A

instance [star_add_monoid α] [normed_star_group α] : normed_star_group (matrix m m α) :=
⟨norm_conj_transpose⟩

@[simp] lemma nnnorm_col (v : m → α) : ‖col v‖₊ = ‖v‖₊ := by simp [pi.nnnorm_def]
@[simp] lemma norm_col (v : m → α) : ‖col v‖ = ‖v‖ := congr_arg coe $ nnnorm_col v

@[simp] lemma nnnorm_row (v : n → α) : ‖row v‖₊ = ‖v‖₊ := by simp [pi.nnnorm_def]
@[simp] lemma norm_row (v : n → α) : ‖row v‖ = ‖v‖ := congr_arg coe $ nnnorm_row v

@[simp] lemma nnnorm_diagonal [decidable_eq n] (v : n → α) : ‖diagonal v‖₊ = ‖v‖₊ :=
begin
  simp_rw pi.nnnorm_def,
  congr' 1 with i : 1,
  refine le_antisymm (finset.sup_le $ λ j hj, _) _,
  { obtain rfl | hij := eq_or_ne i j,
    { rw diagonal_apply_eq },
    { rw [diagonal_apply_ne _ hij, nnnorm_zero],
      exact zero_le _ }, },
  { refine eq.trans_le _ (finset.le_sup (finset.mem_univ i)),
    rw diagonal_apply_eq }
end

@[simp] lemma norm_diagonal [decidable_eq n] (v : n → α) : ‖diagonal v‖ = ‖v‖ :=
congr_arg coe $ nnnorm_diagonal v

/-- Note this is safe as an instance as it carries no data. -/
@[nolint fails_quickly]
instance [nonempty n] [decidable_eq n] [has_one α] [norm_one_class α] :
  norm_one_class (matrix n n α) :=
⟨(norm_diagonal _).trans $ norm_one⟩

end seminormed_add_comm_group

/-- Normed group instance (using sup norm of sup norm) for matrices over a normed group.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
protected def normed_add_comm_group [normed_add_comm_group α] :
  normed_add_comm_group (matrix m n α) :=
pi.normed_add_comm_group

section normed_space
local attribute [instance] matrix.seminormed_add_comm_group

variables [normed_field R] [seminormed_add_comm_group α] [normed_space R α]

/-- Normed space instance (using sup norm of sup norm) for matrices over a normed space.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
protected def normed_space : normed_space R (matrix m n α) :=
pi.normed_space

end normed_space

end linf_linf

/-! ### The $L_\infty$ operator norm

This section defines the matrix norm $\|A\|_\infty = \operatorname{sup}_i (\sum_j \|A_{ij}\|)$.

Note that this is equivalent to the operator norm, considering $A$ as a linear map between two
$L^\infty$ spaces.
-/
section linfty_op

/-- Seminormed group instance (using sup norm of L1 norm) for matrices over a seminormed group. Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
local attribute [instance]
protected def linfty_op_seminormed_add_comm_group [seminormed_add_comm_group α] :
  seminormed_add_comm_group (matrix m n α) :=
(by apply_instance : seminormed_add_comm_group (m → pi_Lp 1 (λ j : n, α)))

/-- Normed group instance (using sup norm of L1 norm) for matrices over a normed ring.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
local attribute [instance]
protected def linfty_op_normed_add_comm_group [normed_add_comm_group α] :
  normed_add_comm_group (matrix m n α) :=
(by apply_instance : normed_add_comm_group (m → pi_Lp 1 (λ j : n, α)))

/-- Normed space instance (using sup norm of L1 norm) for matrices over a normed space.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
local attribute [instance]
protected def linfty_op_normed_space [normed_field R] [seminormed_add_comm_group α]
  [normed_space R α] :
  normed_space R (matrix m n α) :=
(by apply_instance : normed_space R (m → pi_Lp 1 (λ j : n, α)))

section seminormed_add_comm_group
variables [seminormed_add_comm_group α]

lemma linfty_op_norm_def (A : matrix m n α) :
  ‖A‖ = ((finset.univ : finset m).sup (λ i : m, ∑ j : n, ‖A i j‖₊) : ℝ≥0) :=
by simp [pi.norm_def, pi_Lp.nnnorm_eq_sum ennreal.one_ne_top]

lemma linfty_op_nnnorm_def (A : matrix m n α) :
  ‖A‖₊ = (finset.univ : finset m).sup (λ i : m, ∑ j : n, ‖A i j‖₊) :=
subtype.ext $ linfty_op_norm_def A

@[simp] lemma linfty_op_nnnorm_col (v : m → α) :
  ‖col v‖₊ = ‖v‖₊ :=
begin
  rw [linfty_op_nnnorm_def, pi.nnnorm_def],
  simp,
end

@[simp] lemma linfty_op_norm_col (v : m → α) :
  ‖col v‖ = ‖v‖ :=
congr_arg coe $ linfty_op_nnnorm_col v

@[simp] lemma linfty_op_nnnorm_row (v : n → α) :
  ‖row v‖₊ = ∑ i, ‖v i‖₊ :=
by simp [linfty_op_nnnorm_def]

@[simp] lemma linfty_op_norm_row (v : n → α) :
  ‖row v‖ = ∑ i, ‖v i‖ :=
(congr_arg coe $ linfty_op_nnnorm_row v).trans $ by simp [nnreal.coe_sum]

@[simp]
lemma linfty_op_nnnorm_diagonal [decidable_eq m] (v : m → α) :
  ‖diagonal v‖₊ = ‖v‖₊ :=
begin
  rw [linfty_op_nnnorm_def, pi.nnnorm_def],
  congr' 1 with i : 1,
  refine (finset.sum_eq_single_of_mem _ (finset.mem_univ i) $ λ j hj hij, _).trans _,
  { rw [diagonal_apply_ne' _ hij, nnnorm_zero] },
  { rw [diagonal_apply_eq] },
end

@[simp]
lemma linfty_op_norm_diagonal [decidable_eq m] (v : m → α) :
  ‖diagonal v‖ = ‖v‖ :=
congr_arg coe $ linfty_op_nnnorm_diagonal v

end seminormed_add_comm_group

section non_unital_semi_normed_ring
variables [non_unital_semi_normed_ring α]

lemma linfty_op_nnnorm_mul (A : matrix l m α) (B : matrix m n α) : ‖A ⬝ B‖₊ ≤ ‖A‖₊ * ‖B‖₊ :=
begin
  simp_rw [linfty_op_nnnorm_def, matrix.mul_apply],
  calc finset.univ.sup (λ i, ∑ k, ‖∑ j, A i j * B j k‖₊)
      ≤ finset.univ.sup (λ i, ∑ k j, ‖A i j‖₊ * ‖B j k‖₊) :
    finset.sup_mono_fun $ λ i hi, finset.sum_le_sum $ λ k hk, nnnorm_sum_le_of_le _ $ λ j hj,
      nnnorm_mul_le _ _
  ... = finset.univ.sup (λ i, ∑ j, (‖A i j‖₊ * ∑ k, ‖B j k‖₊)) :
    by simp_rw [@finset.sum_comm _ m n, finset.mul_sum]
  ... ≤ finset.univ.sup (λ i, ∑ j, ‖A i j‖₊ * finset.univ.sup (λ i, ∑ j, ‖B i j‖₊)) :
    finset.sup_mono_fun $ λ i hi, finset.sum_le_sum $ λ j hj,
      mul_le_mul_of_nonneg_left (finset.le_sup hj) (zero_le _)
  ... ≤ finset.univ.sup (λ i, ∑ j, ‖A i j‖₊) * finset.univ.sup (λ i, ∑ j, ‖B i j‖₊) :
    by simp_rw [←finset.sum_mul, ←nnreal.finset_sup_mul],
end

lemma linfty_op_norm_mul (A : matrix l m α) (B : matrix m n α) : ‖A ⬝ B‖ ≤ ‖A‖ * ‖B‖ :=
linfty_op_nnnorm_mul _ _

lemma linfty_op_nnnorm_mul_vec (A : matrix l m α) (v : m → α) : ‖A.mul_vec v‖₊ ≤ ‖A‖₊ * ‖v‖₊ :=
begin
  rw [←linfty_op_nnnorm_col (A.mul_vec v), ←linfty_op_nnnorm_col v],
  exact linfty_op_nnnorm_mul A (col v),
end

lemma linfty_op_norm_mul_vec (A : matrix l m α) (v : m → α) : ‖matrix.mul_vec A v‖ ≤ ‖A‖ * ‖v‖ :=
linfty_op_nnnorm_mul_vec _ _

end non_unital_semi_normed_ring

/-- Seminormed non-unital ring instance (using sup norm of L1 norm) for matrices over a semi normed
non-unital ring. Not declared as an instance because there are several natural choices for defining
the norm of a matrix. -/
local attribute [instance]
protected def linfty_op_non_unital_semi_normed_ring [non_unital_semi_normed_ring α] :
  non_unital_semi_normed_ring (matrix n n α) :=
{ norm_mul := linfty_op_norm_mul,
  .. matrix.linfty_op_seminormed_add_comm_group,
  .. matrix.non_unital_ring }

/-- The `L₁-L∞` norm preserves one on non-empty matrices. Note this is safe as an instance, as it
carries no data. -/
instance linfty_op_norm_one_class [semi_normed_ring α] [norm_one_class α] [decidable_eq n]
  [nonempty n] : norm_one_class (matrix n n α) :=
{ norm_one := (linfty_op_norm_diagonal _).trans norm_one }

/-- Seminormed ring instance (using sup norm of L1 norm) for matrices over a semi normed ring.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
local attribute [instance]
protected def linfty_op_semi_normed_ring [semi_normed_ring α] [decidable_eq n] :
  semi_normed_ring (matrix n n α) :=
{ .. matrix.linfty_op_non_unital_semi_normed_ring,
  .. matrix.ring }

/-- Normed non-unital ring instance (using sup norm of L1 norm) for matrices over a normed
non-unital ring. Not declared as an instance because there are several natural choices for defining
the norm of a matrix. -/
local attribute [instance]
protected def linfty_op_non_unital_normed_ring [non_unital_normed_ring α] :
  non_unital_normed_ring (matrix n n α) :=
{ ..matrix.linfty_op_non_unital_semi_normed_ring }

/-- Normed ring instance (using sup norm of L1 norm) for matrices over a normed ring.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
local attribute [instance]
protected def linfty_op_normed_ring [normed_ring α] [decidable_eq n] :
  normed_ring (matrix n n α) :=
{ ..matrix.linfty_op_semi_normed_ring }

/-- Normed algebra instance (using sup norm of L1 norm) for matrices over a normed algebra. Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
local attribute [instance]
protected def linfty_op_normed_algebra [normed_field R] [semi_normed_ring α] [normed_algebra R α]
  [decidable_eq n] :
  normed_algebra R (matrix n n α) :=
{ ..matrix.linfty_op_normed_space }

end linfty_op

/-! ### The Frobenius norm

This is defined as $\|A\| = \sqrt{\sum_{i,j} \|A_{ij}\|^2}$.
When the matrix is over the real or complex numbers, this norm is submultiplicative.
-/

section frobenius

open_locale matrix big_operators

/-- Seminormed group instance (using frobenius norm) for matrices over a seminormed group. Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
local attribute [instance]
def frobenius_seminormed_add_comm_group [seminormed_add_comm_group α] :
  seminormed_add_comm_group (matrix m n α) :=
(by apply_instance : seminormed_add_comm_group (pi_Lp 2 (λ i : m, pi_Lp 2 (λ j : n, α))))

/-- Normed group instance (using frobenius norm) for matrices over a normed group.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
local attribute [instance]
def frobenius_normed_add_comm_group [normed_add_comm_group α] :
  normed_add_comm_group (matrix m n α) :=
(by apply_instance : normed_add_comm_group (pi_Lp 2 (λ i : m, pi_Lp 2 (λ j : n, α))))

/-- Normed space instance (using frobenius norm) for matrices over a normed space.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
local attribute [instance]
def frobenius_normed_space [normed_field R] [seminormed_add_comm_group α] [normed_space R α] :
  normed_space R (matrix m n α) :=
(by apply_instance : normed_space R (pi_Lp 2 (λ i : m, pi_Lp 2 (λ j : n, α))))

section seminormed_add_comm_group
variables [seminormed_add_comm_group α] [seminormed_add_comm_group β]

lemma frobenius_nnnorm_def (A : matrix m n α) :
  ‖A‖₊ = (∑ i j, ‖A i j‖₊ ^ (2 : ℝ)) ^ (1/2 : ℝ) :=
by simp_rw [pi_Lp.nnnorm_eq_of_L2, nnreal.sq_sqrt, nnreal.sqrt_eq_rpow, nnreal.rpow_two]

lemma frobenius_norm_def (A : matrix m n α) :
  ‖A‖ = (∑ i j, ‖A i j‖ ^ (2 : ℝ)) ^ (1/2 : ℝ) :=
(congr_arg coe (frobenius_nnnorm_def A)).trans $ by simp [nnreal.coe_sum]

@[simp] lemma frobenius_nnnorm_map_eq (A : matrix m n α) (f : α → β) (hf : ∀ a, ‖f a‖₊ = ‖a‖₊) :
  ‖A.map f‖₊ = ‖A‖₊ :=
by simp_rw [frobenius_nnnorm_def, matrix.map_apply, hf]
@[simp] lemma frobenius_norm_map_eq (A : matrix m n α) (f : α → β) (hf : ∀ a, ‖f a‖ = ‖a‖) :
  ‖A.map f‖ = ‖A‖ :=
(congr_arg (coe : ℝ≥0 → ℝ) $ frobenius_nnnorm_map_eq A f $ λ a, subtype.ext $ hf a : _)

@[simp] lemma frobenius_nnnorm_transpose (A : matrix m n α) : ‖Aᵀ‖₊ = ‖A‖₊ :=
by { rw [frobenius_nnnorm_def, frobenius_nnnorm_def, finset.sum_comm], refl }
@[simp] lemma frobenius_norm_transpose (A : matrix m n α) : ‖Aᵀ‖ = ‖A‖ :=
congr_arg coe $ frobenius_nnnorm_transpose A

@[simp] lemma frobenius_nnnorm_conj_transpose [star_add_monoid α] [normed_star_group α]
  (A : matrix m n α) : ‖Aᴴ‖₊ = ‖A‖₊ :=
(frobenius_nnnorm_map_eq _ _ nnnorm_star).trans A.frobenius_nnnorm_transpose
@[simp]

instance frobenius_normed_star_group [star_add_monoid α] [normed_star_group α] :
  normed_star_group (matrix m m α) :=
⟨frobenius_norm_conj_transpose⟩

@[simp] lemma frobenius_norm_row (v : m → α) : ‖row v‖ = ‖(pi_Lp.equiv 2 _).symm v‖ :=
begin
  rw [frobenius_norm_def, fintype.sum_unique, pi_Lp.norm_eq_of_L2, real.sqrt_eq_rpow],
  simp only [row_apply, real.rpow_two, pi_Lp.equiv_symm_apply],
end
@[simp] lemma frobenius_nnnorm_row (v : m → α) : ‖row v‖₊ = ‖(pi_Lp.equiv 2 _).symm v‖₊ :=
subtype.ext $ frobenius_norm_row v

@[simp] lemma frobenius_norm_col (v : n → α) : ‖col v‖ = ‖(pi_Lp.equiv 2 _).symm v‖ :=
begin
  simp_rw [frobenius_norm_def, fintype.sum_unique, pi_Lp.norm_eq_of_L2, real.sqrt_eq_rpow],
  simp only [col_apply, real.rpow_two, pi_Lp.equiv_symm_apply]
end
@[simp] lemma frobenius_nnnorm_col (v : n → α) : ‖col v‖₊ = ‖(pi_Lp.equiv 2 _).symm v‖₊ :=
subtype.ext $ frobenius_norm_col v

@[simp] lemma frobenius_nnnorm_diagonal [decidable_eq n] (v : n → α) :
  ‖diagonal v‖₊ = ‖(pi_Lp.equiv 2 _).symm v‖₊ :=
begin
  simp_rw [frobenius_nnnorm_def, ←finset.sum_product', finset.univ_product_univ,
    pi_Lp.nnnorm_eq_of_L2],
  let s := (finset.univ : finset n).map ⟨λ i : n, (i, i), λ i j h, congr_arg prod.fst h⟩,
  rw ←finset.sum_subset (finset.subset_univ s) (λ i hi his, _),
  { rw [finset.sum_map, nnreal.sqrt_eq_rpow],
    dsimp,
    simp_rw [diagonal_apply_eq, nnreal.rpow_two] },
  { suffices : i.1 ≠ i.2,
    { rw [diagonal_apply_ne _ this, nnnorm_zero, nnreal.zero_rpow two_ne_zero], },
    intro h,
    exact finset.mem_map.not.mp his ⟨i.1, finset.mem_univ _, prod.ext rfl h⟩ }
end
@[simp] lemma frobenius_norm_diagonal [decidable_eq n] (v : n → α) :
  ‖diagonal v‖ = ‖(pi_Lp.equiv 2 _).symm v‖ :=
(congr_arg coe $ frobenius_nnnorm_diagonal v : _).trans rfl

end seminormed_add_comm_group

lemma frobenius_nnnorm_one [decidable_eq n] [seminormed_add_comm_group α] [has_one α] :
  ‖(1 : matrix n n α)‖₊ = nnreal.sqrt (fintype.card n) * ‖(1 : α)‖₊:=
begin
  refine (frobenius_nnnorm_diagonal _).trans _,
  simp_rw [pi_Lp.nnnorm_equiv_symm_const ennreal.two_ne_top, nnreal.sqrt_eq_rpow],
  simp only [ennreal.to_real_div, ennreal.one_to_real, ennreal.to_real_bit0],
end

section is_R_or_C
variables [is_R_or_C α]

lemma frobenius_nnnorm_mul (A : matrix l m α) (B : matrix m n α) : ‖A ⬝ B‖₊ ≤ ‖A‖₊ * ‖B‖₊ :=
begin
  simp_rw [frobenius_nnnorm_def, matrix.mul_apply],
  rw [←nnreal.mul_rpow, @finset.sum_comm _ n m, finset.sum_mul_sum, finset.sum_product],
  refine nnreal.rpow_le_rpow _ one_half_pos.le,
  refine finset.sum_le_sum (λ i hi, finset.sum_le_sum $ λ j hj, _),
  rw [← nnreal.rpow_le_rpow_iff one_half_pos, ← nnreal.rpow_mul,
    mul_div_cancel' (1 : ℝ) two_ne_zero, nnreal.rpow_one, nnreal.mul_rpow],
  dsimp only,
  have := @nnnorm_inner_le_nnnorm α _ _ _ _
    ((pi_Lp.equiv 2 (λ i, α)).symm (λ j, star (A i j)))
    ((pi_Lp.equiv 2 (λ i, α)).symm (λ k, B k j)),
  simpa only [pi_Lp.equiv_symm_apply, pi_Lp.inner_apply,
      is_R_or_C.inner_apply, star_ring_end_apply, pi.nnnorm_def, pi_Lp.nnnorm_eq_of_L2,
      star_star, nnnorm_star, nnreal.sqrt_eq_rpow, nnreal.rpow_two] using this,
end

lemma frobenius_norm_mul (A : matrix l m α) (B : matrix m n α) : ‖A ⬝ B‖ ≤ ‖A‖ * ‖B‖ :=
frobenius_nnnorm_mul A B

/-- Normed ring instance (using frobenius norm) for matrices over `ℝ` or `ℂ`.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
local attribute [instance]
def frobenius_normed_ring [decidable_eq m] : normed_ring (matrix m m α) :=
{ norm := has_norm.norm,
  norm_mul := frobenius_norm_mul,
  ..matrix.frobenius_seminormed_add_comm_group }

/-- Normed algebra instance (using frobenius norm) for matrices over `ℝ` or `ℂ`.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
local attribute [instance]
def frobenius_normed_algebra [decidable_eq m] [normed_field R] [normed_algebra R α] :
  normed_algebra R (matrix m m α) :=
{ ..matrix.frobenius_normed_space }

end is_R_or_C

end frobenius

end matrix


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro

! This file was ported from Lean 3 source module algebra.order.ring.cone
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Order.Ring.Defs

/-!
# Constructing an ordered ring from a ring with a specified positive cone.

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

-/

/-! ### Positive cones -/

variable {α : Type _} [Ring α] [Nontrivial α]

namespace Ring

#print Ring.PositiveCone /-
/-- A positive cone in a ring consists of a positive cone in underlying `add_comm_group`,
which contains `1` and such that the positive elements are closed under multiplication. -/
@[nolint has_nonempty_instance]
structure PositiveCone (α : Type _) [Ring α] extends AddCommGroup.PositiveCone α where
  one_nonneg : nonneg 1
  mul_pos : ∀ a b, Pos a → Pos b → Pos (a * b)
#align ring.positive_cone Ring.PositiveCone
-/

/-- Forget that a positive cone in a ring respects the multiplicative structure. -/
add_decl_doc positive_cone.to_positive_cone

#print Ring.TotalPositiveCone /-
/-- A total positive cone in a nontrivial ring induces a linear order. -/
@[nolint has_nonempty_instance]
structure TotalPositiveCone (α : Type _) [Ring α] extends PositiveCone α,
  AddCommGroup.TotalPositiveCone α
#align ring.total_positive_cone Ring.TotalPositiveCone
-/

/-- Forget that a `total_positive_cone` in a ring is total. -/
add_decl_doc total_positive_cone.to_positive_cone

/-- Forget that a `total_positive_cone` in a ring respects the multiplicative structure. -/
add_decl_doc total_positive_cone.to_total_positive_cone

/- warning: ring.positive_cone.one_pos -> Ring.PositiveCone.one_pos is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Ring.{u1} α] [_inst_2 : Nontrivial.{u1} α] (C : Ring.PositiveCone.{u1} α _inst_1), Ring.PositiveCone.Pos.{u1} α _inst_1 C (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (AddMonoidWithOne.toOne.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (Ring.toAddCommGroupWithOne.{u1} α _inst_1)))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : Ring.{u1} α] [_inst_2 : Nontrivial.{u1} α] (C : Ring.PositiveCone.{u1} α _inst_1), AddCommGroup.PositiveCone.pos.{u1} α (Ring.toAddCommGroup.{u1} α _inst_1) (Ring.PositiveCone.toPositiveCone.{u1} α _inst_1 C) (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (NonAssocRing.toOne.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1))))
Case conversion may be inaccurate. Consider using '#align ring.positive_cone.one_pos Ring.PositiveCone.one_posₓ'. -/
theorem PositiveCone.one_pos (C : PositiveCone α) : C.Pos 1 :=
  (C.pos_iff _).2 ⟨C.one_nonneg, fun h => one_ne_zero <| C.nonneg_antisymm C.one_nonneg h⟩
#align ring.positive_cone.one_pos Ring.PositiveCone.one_pos

end Ring

open Ring

#print StrictOrderedRing.mkOfPositiveCone /-
/-- Construct a `strict_ordered_ring` by designating a positive cone in an existing `ring`. -/
def StrictOrderedRing.mkOfPositiveCone (C : PositiveCone α) : StrictOrderedRing α :=
  { ‹Ring α›,
    OrderedAddCommGroup.mkOfPositiveCone
      C.toPositiveCone with
    exists_pair_ne := ⟨0, 1, fun h => by simpa [← h, C.pos_iff] using C.one_pos⟩
    zero_le_one := by
      change C.nonneg (1 - 0)
      convert C.one_nonneg
      simp
    mul_pos := fun x y xp yp => by
      change C.pos (x * y - 0)
      convert C.mul_pos x y
          (by
            convert xp
            simp)
          (by
            convert yp
            simp)
      simp }
#align strict_ordered_ring.mk_of_positive_cone StrictOrderedRing.mkOfPositiveCone
-/

#print LinearOrderedRing.mkOfPositiveCone /-
/-- Construct a `linear_ordered_ring` by
designating a positive cone in an existing `ring`. -/
def LinearOrderedRing.mkOfPositiveCone (C : TotalPositiveCone α) : LinearOrderedRing α :=
  { StrictOrderedRing.mkOfPositiveCone C.toPositiveCone,
    LinearOrderedAddCommGroup.mkOfPositiveCone C.toTotalPositiveCone with }
#align linear_ordered_ring.mk_of_positive_cone LinearOrderedRing.mkOfPositiveCone
-/


import data.nat.prime
import field_theory.finite.basic

/-!
# Fermat Pseudoprimes

In this file we define Fermat pseudoprimes: composite numbers that pass the Fermat primality test.
A natural number n passes the Fermat primality test to base b (and is therefore deemed a "probable
prime") if n divides `b^(n - 1) - 1`. n is a Fermat pseudoprime to base b if n is a composite number
that passes the Fermat primality test to base b and is coprime with b.

Fermat pseudoprimes can also be seen as composite numbers for which Fermat's little theorem holds
true.

## Main Results

The main definitions for this file are

- `fermat_psp.probable_prime`: A number n is a probable prime to base b if it passes the Fermat
  primality test; that is, b divides b^(n - 1) - 1
- `fermat_psp`: A number n is a pseudoprime to base b if it is a probable prime to base b, is
  composite, and is coprime with b

Note that all composite numbers n ≥ 4 are pseudoprimes to base 1, and that the way probable_prime
is set up implies that all numbers are probable primes to bases 0 and 1, and 0 and 1 are probable
prime to any base.

The main theorems are

- `fermat_psp.exists_infinite_pseudoprimes`: there are infinite pseudoprimes to any base b ≥ 1

-/

/--
`n` is a probable prime to base `b` if `n` passes the Fermat primality test; that is, `n` divides
`b^(n - 1) - 1`.
This definition implies that all numbers are probable primes to base 0 or 1, and that 0 and 1 are
probable primes to any base.
-/
def fermat_psp.probable_prime (n : ℕ) (b : ℕ) : Prop := n ∣ b^(n - 1) - 1

/--
`n` is a fermat pseudoprime to base `b` if `n` is coprime with `b`, is a probable prime to base `b`,
and is composite. All composite natural numbers are pseudoprimes to base 1. This definition also
permits `n` to be less than `b`, so that 4 is a pseudoprime to base 5, for example.
-/
def fermat_psp (n : ℕ) (b : ℕ) : Prop :=
fermat_psp.probable_prime n b ∧ ¬nat.prime n ∧ 1 < n

namespace fermat_psp

instance decidable_probable_prime (n : ℕ) (b : ℕ) : decidable (probable_prime n b) :=
nat.decidable_dvd _ _

instance decidable_psp (n : ℕ) (b : ℕ) : decidable (fermat_psp n b) := and.decidable

/--
If `n` passes the Fermat primality test to base `b`, then `n` is coprime with `b`, assuming that
`n` and `b` are both positive.
-/
lemma coprime_of_probable_prime (n b : ℕ) (h : probable_prime n b) (h₁ : 1 ≤ n) (h₂ : 1 ≤ b)
  : nat.coprime n b :=
begin
  unfold probable_prime at h,
  by_cases h₃ : 2 ≤ n,

  { -- To prove that `n` is coprime with `b`, we we need to show that for all prime factors of `n`,
    -- we can derive a contradiction if `n` divides `b`.
    refine nat.coprime_of_dvd _,
    intros k hk hn hb,

    -- If `k` is a prime number that divides both `n` and `b`, then we know that `n = m * k` and
    -- `b = j * k` for some natural numbers `m` and `j`. We substitute these into the hypothesis.
    generalize hm : n / k = m,
    generalize hj : b / k = j,
    have : m * k ∣ b ^ (n - 1) - 1 := by rwa [←hm, nat.div_mul_cancel hn],
    have : m * k ∣ (j * k) ^ (n - 1) - 1 := by rwa [←hj, nat.div_mul_cancel hb],

    -- Inequalities that will be useful later in the proof
    have q₁ : 1 ≤ j * k,
    { rw [←hj, nat.div_mul_cancel]; assumption },
    have q₂ : 1 ≤ (j * k) ^ (n - 1) := one_le_pow_of_one_le q₁ (n - 1),
    have q₃ : 1 ≤ n - 1,
    { have : n - 1 + 1 = n := nat.sub_add_cancel (show 1 ≤ n, by linarith),
      linarith },
    have q₄ : (n - 1) - 1 + 1 = n - 1 := nat.sub_add_cancel q₃,

    -- Follows from the fact that `m * k ∣ (j * k) ^ (n - 1) - 1`
    have : k ∣ (j * k) ^ (n - 1) - 1 := dvd_of_mul_left_dvd this,

    -- Follows from the fact that `2 ≤ n`
    have q : k ∣ (j * k) ^ (n - 1),
    { rw mul_pow,
      apply dvd_mul_of_dvd_right,
      rw [←q₄, pow_succ],
      exact dvd.intro _ rfl },

    -- Since we know that `k` divides both `(j * k) ^ (n - 1)` and `(j * k) ^ (n - 1) - 1`,
    -- it must divide their difference, so `k ∣ 1`. This contradicts the assumption that `k` is a
    -- prime.
    have : k ∣ (j * k) ^ (n - 1) - ((j * k) ^ (n - 1) - 1) := nat.dvd_sub' q this,
    rw nat.sub_sub_self q₂ at this,
    exact nat.prime.not_dvd_one hk this },

  -- If n = 1, then it follows trivially that n is coprime with b.
  { have : n = 1 := by linarith,
    rw this,
    norm_num }
end

lemma probable_prime_iff_modeq (n : ℕ) {b : ℕ} (h : 1 ≤ b) : probable_prime n b ↔ b^(n - 1) ≡ 1 [MOD n] :=
begin
  have : 1 ≤ b ^ (n - 1) := one_le_pow_of_one_le h (n - 1), -- For exact_mod_cast
  split,
  { intro h₁,
    apply nat.modeq_of_dvd,
    have h₂ : ↑n ∣ ↑(b ^ (n - 1)) - (1 : ℤ) := by exact_mod_cast h₁,
    have h₃ : - (↑(b ^ (n - 1)) - (1 : ℤ)) = ((↑1 : ℤ) - ↑(b ^ (n - 1))) := by simp,
    exact h₃ ▸ (dvd_neg _ _).mpr h₂ },
  { intro h₁,
    have h₂ : ↑n ∣ ↑(b ^ (n - 1)) - (1 : ℤ) := nat.modeq.dvd h₁.symm,
    exact_mod_cast h₂ }
end

/--
If `n` passes the Fermat primality test to base `b`, then `n` is coprime with `b`, assuming that
`n` and `b` are both positive.

This lemma is a small wrapper based on `coprime_of_probable_prime`
-/
lemma coprime_of_fermat_psp (n b : ℕ) (h : fermat_psp n b) (h₁ : 1 ≤ b) : nat.coprime n b :=
begin
  cases h with hp hn,
  cases hn with hn₁ hn₂,
  exact coprime_of_probable_prime n b hp (by linarith) h₁,
end

/--
All composite numbers are fermat pseudoprimes to base 1.
-/
lemma pseudoprime_of_base_one (n : ℕ) (h₁ : 1 < n) (h₂ : ¬nat.prime n) : fermat_psp n 1 :=
begin
  split,
  { have h : 0 = 1^(n - 1) - 1 := by norm_num,
    show n ∣ 1^(n - 1) - 1, from h ▸ (dvd_zero n) },
  { exact ⟨h₂, h₁⟩ }
end

private lemma odd_of_prime_gt_two (p : ℕ) (h : nat.prime p) (hp : 2 < p) : odd p :=
begin
  rw [nat.odd_iff_not_even, even_iff_two_dvd],
  rw nat.prime_dvd_prime_iff_eq nat.prime_two h,
  exact ne_of_lt hp
end

private lemma odd_pow_lem (a : ℤ) (n k : ℕ) (h₁ : k ∣ n) (h₂ : odd (n / k)) : a^k + 1 ∣ a^n + 1 :=
begin
  -- Let m be the natural number such that k * m = n. Then (-1)^m = -1 since m is odd by hypothesis.
  generalize h₃ : n / k = m,
  have hm : k * m = n := by { rw [←h₃, mul_comm], exact nat.div_mul_cancel h₁ },
  have hm₁ : (-1 : ℤ)^m = -1 := odd.neg_one_pow (h₃ ▸ h₂),

  -- a^k ≡ -1 (mod a^k + 1)
  have hk : a^k + 1 ∣ a^k + 1 - 1 -(-1) := by norm_num,
  have hk₁ : a^k + 1 - 1 ≡ -1 [ZMOD a^k + 1] := (int.modeq_of_dvd hk).symm,
  have hk₂ : a^k ≡ -1 [ZMOD a^k + 1] := by rwa int.add_sub_cancel at hk₁,

  -- a^n = (a^k)^m ≡ (-1)^m = -1 (mod a^k + 1)
  have ha : a^n = (a^k)^m := by rw [←pow_mul, hm],
  have ha₂ : (a^k)^m ≡ (-1)^m [ZMOD a^k + 1] := int.modeq.pow m hk₂,
  have ha₃ : a^n ≡ (-1)^m [ZMOD a^k + 1] := (eq.symm ha) ▸ ha₂,
  have ha₄ : a^n ≡ (-1) [ZMOD a^k + 1] := hm₁ ▸ ha₃,

  -- Therefore, a^k + 1 divides a^n + 1
  show a^k + 1 ∣ a^n + 1, from (int.modeq.symm ha₄).dvd
end

private lemma sub_one_dvd_pow_sub_one (a n : ℕ) (h : a ≥ 1) : a - 1 ∣ a^n - 1 :=
begin
  induction n with n ih,
  { simp },
  { have h₁ : a - 1 ∣ a * (a^n - 1) := dvd_mul_of_dvd_right ih _,
    have h₂ : 0 < a := by linarith,
    have h₃ : 1 ≤ a ^ n := nat.one_le_pow n a h₂,
    have : a ≤ a * a ^ n := (le_mul_iff_one_le_right h₂).mpr h₃,
    rw calc a ^ (n.succ) - 1 = a ^ (n + 1) - 1 : rfl
                         ... = a * a ^ n - 1 : by rw pow_succ
                         ... = a * a ^ n - a + a - 1 : by rw nat.sub_add_cancel this
                         ... = a * a ^ n - a * 1 + a - 1 : by simp
                         ... = a * (a ^ n - 1) + a - 1 : by rw nat.mul_sub_left_distrib
                         ... = a * (a ^ n - 1) + (a - 1) : by rw nat.add_sub_assoc h,
    exact dvd_add h₁ (dvd_refl _),
  }
end

private lemma pow_gt_base (a b : ℕ) (ha : 1 < a) (hb : 1 < b) : a < a^b :=
begin
  have ha₁ : 0 < a := pos_of_gt ha,
  have hb₁ : 1 ≤ b := le_of_lt hb,

  rw [←nat.sub_add_cancel hb₁, pow_succ a (b - 1)],
  nth_rewrite_lhs 0 ←mul_one a,
  suffices h : 1 < (a^(b - 1)),
  { exact mul_lt_mul_of_pos_left h ha₁ },
  have : 0 < (b - 1) := tsub_pos_of_lt hb,
  exact (b - 1).one_lt_pow a this ha
end

private lemma pow_gt_exponent (a b : ℕ) (h : 2 ≤ a) : b < a^b :=
begin
  induction b with b hb,
  { rw pow_zero,
    norm_num },
  { have q : 1 ≤ b.succ := nat.succ_le_succ (zero_le b),
    have q₁ : 1 ≤ a := nat.le_of_succ_le h,
    have q₂ : 0 < (a - 1)*(b + 1) := begin
      have : 1 ≤ a - 1 := (le_tsub_iff_left q₁).mpr h,
      have hpos₁ : 0 < a - 1 := nat.succ_le_iff.mp this,
      have hpos₂ : 0 < b + 1 := nat.succ_pos b,
      exact mul_pos hpos₁ hpos₂
    end,
    have hb₁ : b + 1 ≤ a ^ b := nat.succ_le_iff.mpr hb,
    rw pow_succ,
    calc a * a ^ b ≥ a * (b + 1)               : mul_le_mul_left' hb₁ a
               ... = (a - 1 + 1)*(b + 1)       : by rwa nat.sub_add_cancel q₁
               ... = (a - 1)*(b + 1) + (b + 1) : by rw [add_mul, one_mul]
               ... > b + 1                     : by linarith }
end

private lemma a_id_helper (a b : ℕ) (ha : 1 < a) (hb : 1 < b) : 1 < (a^b - 1)/(a - 1) :=
begin
  have ha₁ : 1 ≤ a := by linarith,

  -- It suffices to show that a - 1 < a^b - 1
  suffices h : 1*(a - 1) < (a^b - 1)/(a - 1)*(a - 1),
  { exact lt_of_mul_lt_mul_right' h },
  have h₁ : a - 1 ∣ a^b - 1 := sub_one_dvd_pow_sub_one _ _ (show 1 ≤ a, by linarith),
  rw nat.div_mul_cancel h₁,
  rw one_mul,

  -- Since a < a^b, a - 1 ≤ a^b - 1
  have h₂ : a < a^b := pow_gt_base a b ha hb,
  show a - 1 < a^b - 1, from (tsub_lt_tsub_iff_right ha₁).mpr h₂,
end

private lemma b_id_helper (a b : ℕ) (ha : 1 < a) (hb : 2 < b) : 1 < (a^b + 1)/(a + 1) :=
begin
  have ha₁ : 2 ≤ a := nat.succ_le_iff.mpr ha,
  have hb₁ : 1 ≤ b := nat.one_le_of_lt hb,

  -- To show that 1 < (a^b + 1) / (a + 1), we only need to show that 2*a + 2 ≤ (a^b + 1)
  suffices h : 2 ≤ (a^b + 1) / (a + 1),
  { exact nat.succ_le_iff.mp h },
  suffices h : 2*(a + 1) ≤ (a ^ b + 1),
  { have h₁ : 2*(a + 1)/(a + 1) ≤ (a ^ b + 1)/(a + 1) := nat.div_le_div_right h,
    have h₂ : 0 < a + 1 := nat.succ_pos a,
    rwa nat.mul_div_cancel _ h₂ at h₁ },
  rw [mul_add, mul_one],

  -- Because 2 ≤ a and 2 < b, 3 ≤ a^(b - 1)
  have h₁ : 3 ≤ a^(b - 1),
  { have : 2 ≤ b - 1 := nat.le_pred_of_lt hb,
    calc a^(b - 1) ≥ a^2 : (pow_le_pow_iff ha).mpr this
               ... ≥ 2^2 : pow_le_pow_of_le_left' ha₁ 2
               ... ≥ 3   : by norm_num },

  -- Since we know that 3 ≤ a ^ (b - 1), if we want to show 2 * a + 1 ≤ a ^ b then it suffices to
  -- show that 2 * a + 1 ≤ 3 * a because then 2 * a + 1 ≤ a * 3 ≤ a * a^(b - 1) = a ^ b
  rw [←nat.sub_add_cancel hb₁, pow_succ],
  suffices h : 2 * a + 1 ≤ a * a^(b - 1),
  { exact nat.succ_le_succ h },
  suffices h : 2 * a + 1 ≤ a * 3,
  { exact le_mul_of_le_mul_left h h₁ },
  rw mul_comm a 3,

  -- Because 1 ≤ a, a + 1 ≤ 3 * a
  have : 3 * a = 2 * a + a := add_one_mul 2 a,
  rw this,
  have h : 1 ≤ a := le_of_lt ha,
  exact add_le_add_left h (2 * a)
end

private lemma AB_id_helper (b p : ℕ) (hb : 2 ≤ b) (hp : odd p)
  : ((b ^ p - 1) / (b - 1)) * ((b ^ p + 1) / (b + 1)) = ((b ^ (2*p)) - 1) / (b^2 - 1) :=
have q₁ : (b - 1) ∣ (b ^ p - 1) := sub_one_dvd_pow_sub_one _ _ (show 1 ≤ b, by linarith),
have q₂ : (b + 1) ∣ (b ^ p + 1) := begin
  have : odd (p / 1) := eq.symm (nat.div_one p) ▸ hp,
  have h := odd_pow_lem ↑b p 1 (one_dvd p) this,
  rw pow_one at h,
  exact_mod_cast h,
end,
have q₃ : 1 ≤ (b^p) := nat.one_le_pow p b (show 0 < b, by linarith),
calc ((b ^ p - 1) / (b - 1)) * ((b ^ p + 1) / (b + 1)) = ((b ^ p - 1) * (b ^ p + 1)) / ((b - 1) * (b + 1)) : nat.div_mul_div_comm q₁ q₂
  ... = ((b ^ p + 1) * (b ^ p - 1)) / ((b - 1) * (b + 1)) : by rw mul_comm
  ... = ((b ^ p)^2 - 1^2) / ((b - 1) * (b + 1))           : by rw nat.sq_sub_sq
  ... = ((b ^ (p*2)) - 1^2) / ((b - 1) * (b + 1))         : by rw pow_mul
  ... = ((b ^ (2*p)) - 1^2) / ((b - 1) * (b + 1))         : by rw mul_comm
  ... = ((b ^ (2*p)) - 1^2) / ((b + 1) * (b - 1))         : by rw mul_comm (b + 1)
  ... = ((b ^ (2*p)) - 1^2) / (b^2 - 1^2)                 : by rw nat.sq_sub_sq
  ... = ((b ^ (2*p)) - 1) / (b^2 - 1)                     : by rw one_pow

/--
Given a prime `p` which does not divide `b*(b^2 - 1)`, we can produce a number `n` which is larger
than `p` and pseudoprime to base `b`. We do this by defining
`n = ((b^p - 1)/(b - 1)) * ((b^p + 1)/(b + 1))`

The primary purpose of this definition is to help prove `exists_infinite_pseudoprimes`. For a proof
that `n` is actually pseudoprime to base `b`, see `psp_from_prime_psp`, and for a proof that `n` is
greater than `p`, see `psp_from_prime_gt_p`.
-/
private def psp_from_prime (b : ℕ) (b_ge_two : 2 ≤ b) (p : ℕ) (p_prime : nat.prime p) (p_gt_two : 2 < p)
  (not_dvd : ¬p ∣ b*(b^2 - 1)) : ℕ :=
  have A : ℕ := (b^p - 1)/(b - 1),
  have B : ℕ := (b^p + 1)/(b + 1),
  A * B

/--
This is a proof that the number produced using `psp_from_prime` is actually pseudoprime to base `b`.
The primary purpose of this lemma is to help prove `exists_infinite_pseudoprimes`.

We use <https://primes.utm.edu/notes/proofs/a_pseudoprimes.html> as a rough outline of the proof.
-/
private lemma psp_from_prime_psp (b : ℕ) (b_ge_two : 2 ≤ b) (p : ℕ) (p_prime : nat.prime p) (p_gt_two : 2 < p) (not_dvd : ¬p ∣ b*(b^2 - 1)) :
  fermat_psp (psp_from_prime b b_ge_two p p_prime p_gt_two not_dvd) b :=
begin
  unfold psp_from_prime,
  generalize A_id : (b^p - 1)/(b - 1) = A,
  generalize B_id : (b^p + 1)/(b + 1) = B,

  -- Inequalities
  have hi_A : 1 < A,
  { rw ←A_id,
    refine a_id_helper b p _ _,
    { exact nat.succ_le_iff.mp b_ge_two },
    { exact nat.prime.one_lt p_prime } },
  have hi_B : 1 < B,
  { rw ←B_id,
    refine b_id_helper b p _ p_gt_two,
    { exact nat.succ_le_iff.mp b_ge_two } },
  have hi_AB : 1 < (A * B) := one_lt_mul'' hi_A hi_B,
  have hi_b : 0 < b := by linarith,
  have hi_p : 1 ≤ p := nat.one_le_of_lt p_gt_two,
  have hi_bsquared : 1 ≤ (b^2) := nat.one_le_pow _ _ hi_b,
  have hi_bpowtwop : 1 ≤ (b^(2*p)) := nat.one_le_pow (2*p) b hi_b,
  have hi_bpowp_ge_b : (b ≤ b^p),
  { have : 1 ≤ b^(p - 1) := (p - 1).one_le_pow b hi_b,
    calc b^p = b*b^(p - 1) : nat.sub_add_cancel hi_p ▸ pow_succ b (p - 1)
         ... ≥ b*1         : mul_le_mul_left' this b
         ... = b           : by rw mul_one },
  have hi_bsquared₁ : 0 < (b^2 - 1) := by nlinarith,
  have hi_bpowpsubone : 1 ≤ b ^ (p - 1) := nat.one_le_pow (p - 1) b hi_b,

  -- Other useful facts
  have p_odd : odd p := odd_of_prime_gt_two p p_prime p_gt_two,
  have AB_not_prime : ¬(nat.prime (A * B)) := nat.not_prime_mul hi_A hi_B,
  have AB_id : (A*B) = (b^(2*p) - 1)/(b^2 - 1),
  { rw ←A_id,
    rw ←B_id,
    exact AB_id_helper _ _ b_ge_two p_odd },
  have hd : (b^2 - 1) ∣ (b^(2*p) - 1),
  { have : b^2 - 1 ∣ (b ^ 2) ^ p - 1 := sub_one_dvd_pow_sub_one _ _ (show 1 ≤ b ^ 2, by linarith),
    rwa ←pow_mul at this },

  have AB_probable_prime : probable_prime (A * B) b, {
    unfold probable_prime,

    -- Rewrite AB_id. Used to prove that `2*p*(b^2 - 1) ∣ (b^2 - 1)*(A*B - 1)`.
    have ha₁ : (b^2 - 1) * ((A*B) - 1) = b*(b^(p-1) - 1)*(b^p + b), {
      apply_fun (λx, x*(b^2 - 1)) at AB_id,
      rw nat.div_mul_cancel hd at AB_id,
      apply_fun (λx, x - (b^2 - 1)) at AB_id,
      nth_rewrite 1 ←one_mul (b^2 - 1) at AB_id,
      rw [←nat.mul_sub_right_distrib, mul_comm] at AB_id,
      calc (b^2 - 1) * (A * B - 1) = b ^ (2 * p) - 1 - (b^2 - 1) : AB_id
        ... = b ^ (2 * p) - (1 + (b^2 - 1))           : by rw nat.sub_sub
        ... = b ^ (2 * p) - (1 + b^2 - 1)             : by rw nat.add_sub_assoc hi_bsquared
        ... = b ^ (2 * p) - (b^2)                     : by rw nat.add_sub_cancel_left
        ... = b ^ (p * 2) - (b^2)                     : by rw mul_comm
        ... = (b ^ p) ^ 2 - (b^2)                     : by rw pow_mul
        ... = (b ^ p + b) * (b ^ p - b)               : by rw nat.sq_sub_sq
        ... = (b ^ p - b) * (b ^ p + b)               : by rw mul_comm
        ... = (b ^ (p - 1 + 1) - b) * (b ^ p + b)     : by rw nat.sub_add_cancel hi_p
        ... = (b * b ^ (p - 1) - b) * (b ^ p + b)     : by rw pow_succ
        ... = (b * b ^ (p - 1) - b * 1) * (b ^ p + b) : by rw mul_one
        ... = b * (b ^ (p - 1) - 1) * (b ^ p + b)     : by rw nat.mul_sub_left_distrib
    },
    -- If `b` is even, then `b^p` is also even, so `2 ∣ b^p + b`
    -- If `b` is odd, then `b^p` is also odd, so `2 ∣ b^p + b`
    have ha₂ : 2 ∣ b^p + b,
    { apply @decidable.by_cases (even b),
      { intro h,
        replace h : 2 ∣ b := even_iff_two_dvd.mp h,
        have : p ≠ 0 := by linarith,
        have : 2 ∣ b^p := dvd_pow h this,
        exact dvd_add this h },
      { intro h,
        have h : odd b := nat.odd_iff_not_even.mpr h,
        have : prime 2 := nat.prime_iff.mp (by norm_num),
        have : odd (b^p) := odd.pow h,
        have : even ((b^p) + b) := odd.add_odd this h,
        exact even_iff_two_dvd.mp this } },
    -- Since b isn't divisible by p, we can use Fermat's Little Theorem to prove this
    have ha₃ : p ∣ (b^(p - 1) - 1),
    { have : ¬p ∣ b := mt (assume h : p ∣ b, dvd_mul_of_dvd_left h _) not_dvd,
      have : (b : zmod p) ≠ 0 := assume h, absurd ((zmod.nat_coe_zmod_eq_zero_iff_dvd b p).mp h) this,
      -- by Fermat's Little Theorem, b^(p - 1) ≡ 1 (mod p)
      have q := @zmod.pow_card_sub_one_eq_one _ (fact.mk p_prime) (↑b) this,
      apply_fun (λ x, x - 1) at q,
      rw sub_self at q,
      apply (zmod.nat_coe_zmod_eq_zero_iff_dvd (b^(p - 1) - 1) p).mp,
      have : 1 ≤ b ^ (p - 1) := hi_bpowpsubone, -- needed for norm_cast
      norm_cast at q,
      exact q },
    -- This follows from the fact that `p - 1` is even
    have ha₄ : ((b^2) - 1) ∣ (b^(p - 1) - 1),
    { unfold odd at p_odd,
      cases p_odd with k hk,
      have : 2 ∣ p - 1,
      { rw hk,
        rw nat.add_sub_cancel,
        exact dvd.intro k rfl },
      unfold has_dvd.dvd at this,
      cases this with c hc,
      have : ((b^2) - 1) ∣ ((b^2)^c - 1) := sub_one_dvd_pow_sub_one _ _ (show 1 ≤ b ^ 2, by linarith),
      have : ((b^2) - 1) ∣ (b^(2*c) - 1) := by rwa ←pow_mul at this,
      rwa ← hc at this },
    -- Used to prove that `2*p` divides `A*B - 1`
    have ha₅ : 2*p*(b^2 - 1) ∣ (b^2 - 1)*(A*B - 1),
    { suffices q : 2*p*(b^2 - 1) ∣ b*(b^(p-1) - 1)*(b^p + b),
      { rwa ha₁ },
      -- We already proved that `b^2 - 1 ∣ b^(p - 1) - 1`.
      -- Since `2 ∣ b^p + b` and `p ∣ b^p + b`, if we show that 2 and p are coprime, then we
      -- know that `2 * p ∣ b^p + b`
      have q₁ : nat.coprime p (b^2 - 1),
      { have q₂ : ¬p ∣ (b^2 - 1),
        { rw mul_comm at not_dvd,
          exact mt (assume h : p ∣ b ^ 2 - 1, dvd_mul_of_dvd_left h _) not_dvd },
        exact (nat.prime.coprime_iff_not_dvd p_prime).mpr q₂ },
      have q₂ : p*(b^2 - 1) ∣ b^(p - 1) - 1 := nat.coprime.mul_dvd_of_dvd_of_dvd q₁ ha₃ ha₄,
      have q₃ : p*(b^2 - 1)*2 ∣ (b^(p - 1) - 1) * (b ^ p + b) := mul_dvd_mul q₂ ha₂,
      have q₄ : p*(b^2 - 1)*2 ∣ b * ((b^(p - 1) - 1) * (b ^ p + b)) := dvd_mul_of_dvd_right q₃ _,
      rwa [mul_assoc, mul_comm, mul_assoc b] },
    have ha₆ : 2*p ∣ A*B - 1,
    { rw mul_comm at ha₅,
      exact nat.dvd_of_mul_dvd_mul_left hi_bsquared₁ ha₅ },
    -- Multiply both sides of `AB_id` by `a^2 - 1` then add 1
    have ha₇ : b^(2*p) = 1 + A*B*(b^2 - 1),
    { have q : A*B * (b^2-1) = (b^(2*p)-1)/(b^2-1)*(b^2-1) := congr_arg (λx : ℕ, x * (b^2 - 1)) AB_id,
      rw nat.div_mul_cancel hd at q,
      apply_fun (λ x : ℕ, x + 1) at q,
      rw nat.sub_add_cancel hi_bpowtwop at q,
      rw add_comm at q,
      exact q.symm },
    have ha₈ : A*B ∣ b^(2*p) - 1,
    { unfold has_dvd.dvd,
      use (b^2 - 1),
      exact norm_num.sub_nat_pos (b ^ (2 * p)) 1 (A * B * (b ^ 2 - 1)) (eq.symm ha₇) },
    -- Since `2*p ∣ A*B - 1`, there is a number (which we call `q`) such that `2*p*q = A*B - 1`.
    -- Since `2*p*q` is divisible by `2*p`, we know that `b^(2*p) - 1 ∣ b^(2*p*q) - 1`.
    -- This means that `b^(2*p) - 1 ∣ b^(A*B - 1) - 1`.
    -- We already proved that `A*B ∣ b^(2*p) - 1`, implying that `A*B ∣ b^(A*B - 1) - 1`
    generalize ha₉ : (A*B - 1) / (2*p) = q,
    have ha₁₀ : q * (2*p) = (A*B - 1) := by rw [←ha₉, nat.div_mul_cancel ha₆],
    have ha₁₁ : b^(2*p) - 1 ∣ (b^(2*p))^q - 1 := sub_one_dvd_pow_sub_one _ _ (show 1 ≤ b^(2*p), by linarith),
    rw ← pow_mul at ha₁₁,
    rw mul_comm (2*p) at ha₁₁,
    rw ha₁₀ at ha₁₁,
    exact dvd_trans ha₈ ha₁₁
  },
  exact ⟨AB_probable_prime, AB_not_prime, hi_AB⟩
end

/--
This is a proof that the number produced using `psp_from_prime` is greater than the prime `p` used
to create it. The primary purpose of this lemma is to help prove `exists_infinite_pseudoprimes`.
-/
private lemma psp_from_prime_gt_p (b : ℕ) (b_ge_two : 2 ≤ b) (p : ℕ) (p_prime : nat.prime p) (p_gt_two : 2 < p) (not_dvd : ¬p ∣ b*(b^2 - 1))
  : p < psp_from_prime b b_ge_two p p_prime p_gt_two not_dvd :=
begin
    unfold psp_from_prime,
    generalize A_id : (b^p - 1)/(b - 1) = A,
    generalize B_id : (b^p + 1)/(b + 1) = B,
    have AB_id : (A*B) = (b^(2*p) - 1)/(b^2 - 1),
    { rw ←A_id,
      rw ←B_id,
      have p_odd : odd p := odd_of_prime_gt_two p p_prime p_gt_two,
      exact AB_id_helper _ _ b_ge_two p_odd },
    have AB_dvd : (b^2 - 1) ∣ (b^(2*p) - 1),
    { have : b^2 - 1 ∣ (b ^ 2) ^ p - 1 := sub_one_dvd_pow_sub_one _ _ (show 1 ≤ b ^ 2, by nlinarith),
      rwa ←pow_mul at this },
    rw AB_id,
    suffices h : p * (b ^ 2 - 1) < b ^ (2 * p) - 1,
    { have h₁ : (p * (b ^ 2 - 1)) / (b ^ 2 - 1) < (b ^ (2 * p) - 1) / (b ^ 2 - 1),
      { exact nat.div_lt_div_of_lt_of_dvd AB_dvd h },
      have h₂ : 0 < b ^ 2 - 1,
      { have : 4 ≤ b ^ 2 := by nlinarith,
        have : 3 ≤ b ^ 2 - 1 := le_tsub_of_add_le_left this,
        linarith },
      rwa nat.mul_div_cancel _ h₂ at h₁ },
    rw [nat.mul_sub_left_distrib, mul_one],
    rw pow_mul,
    nth_rewrite_rhs 0 ←nat.sub_add_cancel (show 1 ≤ p, by linarith),
    rw pow_succ (b ^ 2),
    suffices h : p * b ^ 2 < b ^ 2 * (b ^ 2) ^ (p - 1),
    { apply gt_of_ge_of_gt,
      { exact tsub_le_tsub_left (show 1 ≤ p, by linarith) (b ^ 2 * (b ^ 2) ^ (p - 1)) },
      { have : p ≤ p * b ^ 2 := nat.le_mul_of_pos_right (show 0 < b ^ 2, by nlinarith),
        exact tsub_lt_tsub_right_of_le this h } },

    suffices h : p < (b ^ 2) ^ (p - 1),
    { rw mul_comm (b ^ 2),
      have : 4 ≤ b^2 := by nlinarith,
      have : 0 < b^2 := by linarith,
      exact mul_lt_mul_of_pos_right h this },

    rw ←pow_mul,
    rw nat.mul_sub_left_distrib,
    rw mul_one,

    have h₁ : 2 ≤ 2*p - 2,
    { have q : 4 ≤ 2*p := by linarith,
      exact le_tsub_of_add_le_left q },

    have : 2 + p ≤ 2 * p := by linarith,
    have : p ≤ 2 * p - 2 := le_tsub_of_add_le_left this,
    have q : (2*p - 2) < b^(2*p - 2) := pow_gt_exponent _ _ b_ge_two,

    exact nat.lt_of_le_of_lt this q
end

/--
For all bases greater than 1, there exist infinite pseudoprimes to that base.
Given in this form: for all numbers `b ≥ 1` and `m`, there exists a pseudoprime n to base b such
that `m ≤ n`. This form is similar to `nat.exists_infinite_primes`.
-/
theorem exists_infinite_pseudoprimes (b : ℕ) (h : 1 ≤ b) (m : ℕ) : ∃ n : ℕ, fermat_psp n b ∧ m ≤ n :=
begin
  by_cases b_ge_two : 2 ≤ b,
  -- If `2 ≤ b`, then because there exist infinite prime numbers, there is a prime number p such
  -- `m ≤ p` and `¬p ∣ b*(b^2 - 1)`. We pick a prime number `b*(b^2 - 1) + 1 + m ≤ p` because we
  -- automatically know that p is greater than m and that it does not divide `b*(b^2 - 1)`
  -- (because p can't divide a number less than p).
  -- From p, we can use the lemmas we proved earlier to show that
  -- `((b^p - 1)/(b - 1)) * ((b^p + 1)/(b + 1))` is a pseudoprime to base b.
  { have h := nat.exists_infinite_primes ((b*(b^2 - 1)) + 1 + m),
    cases h with p hp,
    cases hp with hp₁ hp₂,
    have h₁ : 0 < b := pos_of_gt (nat.succ_le_iff.mp b_ge_two),
    have h₂ : 4 ≤ b^2 := pow_le_pow_of_le_left' b_ge_two 2,
    have h₃ : 0 < (b^2 - 1) := tsub_pos_of_lt (gt_of_ge_of_gt h₂ (by norm_num)),
    have h₄ : 0 < (b*(b^2 - 1)) := mul_pos h₁ h₃,
    have h₁ : (b*(b^2 - 1)) < p := by linarith,
    have h₂ : ¬p ∣ (b*(b^2 - 1)) := nat.not_dvd_of_pos_of_lt h₄ h₁,
    have h₅ : b ≤ b*(b^2 - 1) := nat.le_mul_of_pos_right h₃,
    have h₆ : 2 ≤ b*(b^2 - 1) := le_trans b_ge_two h₅,
    have h₇ : 2 < p := gt_of_gt_of_ge h₁ h₆,
    have h₈ := psp_from_prime_gt_p b b_ge_two p hp₂ h₇ h₂,
    use psp_from_prime b b_ge_two p hp₂ h₇ h₂,
    split,
    { exact psp_from_prime_psp b b_ge_two p hp₂ h₇ h₂ },
    { exact le_trans (show m ≤ p, by linarith) (le_of_lt h₈) } },
  -- If `¬2 ≤ b`, then `b = 1`. Since all composite numbers are pseudoprimes to base 1, we can pick
  -- any composite number greater than m. We choose 2 * (m + 2) because it is greater than m and is
  -- composite for all natural numbers m.
  { have h₁ : b = 1 := by linarith,
    rw h₁,
    use 2 * (m + 2),
    have : ¬nat.prime (2 * (m + 2)) := nat.not_prime_mul (by norm_num) (by norm_num),
    exact ⟨pseudoprime_of_base_one _ (by linarith) this, by linarith⟩ }
end

end fermat_psp