/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Joey van Langen, Casper Putz

! This file was ported from Lean 3 source module algebra.char_p.basic
! leanprover-community/mathlib commit 05a78c9451101108e638a0f213fb1bed82483545
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Hom.Iterate
import Mathlib.Data.Int.ModEq
import Mathlib.Data.Nat.Choose.Dvd
import Mathlib.Data.Nat.Choose.Sum
import Mathlib.GroupTheory.OrderOfElement
import Mathlib.RingTheory.Nilpotent

/-!
# Characteristic of semirings
-/

universe u v

variable (R : Type u)

/-- The generator of the kernel of the unique homomorphism ℕ → R for a semiring R.

*Warning*: for a semiring `R`, `CharP R 0` and `CharZero R` need not coincide.
* `CharP R 0` asks that only `0 : ℕ` maps to `0 : R` under the map `ℕ → R`;
* `CharZero R` requires an injection `ℕ ↪ R`.

For instance, endowing `{0, 1}` with addition given by `max` (i.e. `1` is absorbing), shows that
`CharZero {0, 1}` does not hold and yet `CharP {0, 1} 0` does.
This example is formalized in `counterexamples/char_p_zero_ne_char_zero`.
 -/
@[mk_iff charP_iff]
class CharP [AddMonoidWithOne R] (p : ℕ) : Prop where
  cast_eq_zero_iff' : ∀ x : ℕ, (x : R) = 0 ↔ p ∣ x
#align char_p CharP
#align char_p_iff charP_iff

-- porting note: the field of the structure had implicit arguments where they were
-- explicit in Lean 3
theorem CharP.cast_eq_zero_iff (R : Type u) [AddMonoidWithOne R] (p : ℕ) [CharP R p] (x : ℕ) :
  (x : R) = 0 ↔ p ∣ x :=
CharP.cast_eq_zero_iff' (R := R) (p := p) x

theorem CharP.cast_eq_zero [AddMonoidWithOne R] (p : ℕ) [CharP R p] : (p : R) = 0 :=
  (CharP.cast_eq_zero_iff R p p).2 (dvd_refl p)
#align char_p.cast_eq_zero CharP.cast_eq_zero

@[simp]
theorem CharP.cast_card_eq_zero [AddGroupWithOne R] [Fintype R] : (Fintype.card R : R) = 0 := by
  rw [← nsmul_one, card_nsmul_eq_zero]
#align char_p.cast_card_eq_zero CharP.cast_card_eq_zero

theorem CharP.addOrderOf_one (R) [Semiring R] : CharP R (addOrderOf (1 : R)) :=
  ⟨fun n => by rw [← Nat.smul_one_eq_coe, addOrderOf_dvd_iff_nsmul_eq_zero]⟩
#align char_p.add_order_of_one CharP.addOrderOf_one

theorem CharP.int_cast_eq_zero_iff [AddGroupWithOne R] (p : ℕ) [CharP R p] (a : ℤ) :
    (a : R) = 0 ↔ (p : ℤ) ∣ a := by
  rcases lt_trichotomy a 0 with (h | rfl | h)
  · rw [← neg_eq_zero, ← Int.cast_neg, ← dvd_neg]
    lift -a to ℕ using neg_nonneg.mpr (le_of_lt h) with b
    rw [Int.cast_ofNat, CharP.cast_eq_zero_iff R p, Int.coe_nat_dvd]
  · simp only [Int.cast_zero, eq_self_iff_true, dvd_zero]
  · lift a to ℕ using le_of_lt h with b
    rw [Int.cast_ofNat, CharP.cast_eq_zero_iff R p, Int.coe_nat_dvd]
#align char_p.int_cast_eq_zero_iff CharP.int_cast_eq_zero_iff

theorem CharP.int_cast_eq_int_cast_iff [AddGroupWithOne R] (p : ℕ) [CharP R p] (a b : ℤ) :
    (a : R) = (b : R) ↔ a ≡ b [ZMOD p] := by
  rw [eq_comm, ← sub_eq_zero, ← Int.cast_sub, CharP.int_cast_eq_zero_iff R p, Int.modEq_iff_dvd]
#align char_p.int_coe_eq_int_coe_iff CharP.int_cast_eq_int_cast_iff

theorem CharP.eq [AddMonoidWithOne R] {p q : ℕ} (_c1 : CharP R p) (_c2 : CharP R q) : p = q :=
  Nat.dvd_antisymm ((CharP.cast_eq_zero_iff R p q).1 (CharP.cast_eq_zero _ _))
    ((CharP.cast_eq_zero_iff R q p).1 (CharP.cast_eq_zero _ _))
#align char_p.eq CharP.eq

instance CharP.ofCharZero [AddMonoidWithOne R] [CharZero R] : CharP R 0 :=
  ⟨fun x => by rw [zero_dvd_iff, ← Nat.cast_zero, Nat.cast_inj]⟩
#align char_p.of_char_zero CharP.ofCharZero

theorem CharP.exists [NonAssocSemiring R] : ∃ p, CharP R p :=
  letI := Classical.decEq R
  by_cases
    (fun H : ∀ p : ℕ, (p : R) = 0 → p = 0 =>
      ⟨0, ⟨fun x => by rw [zero_dvd_iff]; exact ⟨H x, by rintro rfl; simp⟩⟩⟩)
    fun H =>
    ⟨Nat.find (not_forall.1 H),
      ⟨fun x =>
        ⟨fun H1 =>
          Nat.dvd_of_mod_eq_zero
            (by_contradiction fun H2 =>
              Nat.find_min (not_forall.1 H)
                (Nat.mod_lt x <|
                  Nat.pos_of_ne_zero <| not_of_not_imp <| Nat.find_spec (not_forall.1 H))
                (not_imp_of_and_not
                  ⟨by
                    rwa [← Nat.mod_add_div x (Nat.find (not_forall.1 H)), Nat.cast_add,
                      Nat.cast_mul,
                      of_not_not (not_not_of_not_imp <| Nat.find_spec (not_forall.1 H)),
                      MulZeroClass.zero_mul, add_zero] at H1,
                    H2⟩)),
          fun H1 => by
          rw [← Nat.mul_div_cancel' H1, Nat.cast_mul,
            of_not_not (not_not_of_not_imp <| Nat.find_spec (not_forall.1 H)),
            MulZeroClass.zero_mul]⟩⟩⟩
#align char_p.exists CharP.exists

theorem CharP.exists_unique [NonAssocSemiring R] : ∃! p, CharP R p :=
  let ⟨c, H⟩ := CharP.exists R
  ⟨c, H, fun _y H2 => CharP.eq R H2 H⟩
#align char_p.exists_unique CharP.exists_unique

theorem CharP.congr {R : Type u} [AddMonoidWithOne R] {p : ℕ} (q : ℕ) [hq : CharP R q] (h : q = p) :
    CharP R p :=
  h ▸ hq
#align char_p.congr CharP.congr

/-- Noncomputable function that outputs the unique characteristic of a semiring. -/
noncomputable def ringChar [NonAssocSemiring R] : ℕ :=
  Classical.choose (CharP.exists_unique R)
#align ring_char ringChar

namespace ringChar

variable [NonAssocSemiring R]

theorem spec : ∀ x : ℕ, (x : R) = 0 ↔ ringChar R ∣ x := by
  letI : CharP R (ringChar R) := (Classical.choose_spec (CharP.exists_unique R)).1
  exact CharP.cast_eq_zero_iff R (ringChar R)
#align ring_char.spec ringChar.spec

theorem eq (p : ℕ) [C : CharP R p] : ringChar R = p :=
  ((Classical.choose_spec (CharP.exists_unique R)).2 p C).symm
#align ring_char.eq ringChar.eq

instance charP : CharP R (ringChar R) :=
  ⟨spec R⟩
#align ring_char.char_p ringChar.charP

variable {R}

theorem of_eq {p : ℕ} (h : ringChar R = p) : CharP R p :=
  CharP.congr (ringChar R) h
#align ring_char.of_eq ringChar.of_eq

theorem eq_iff {p : ℕ} : ringChar R = p ↔ CharP R p :=
  ⟨of_eq, @eq R _ p⟩
#align ring_char.eq_iff ringChar.eq_iff

theorem dvd {x : ℕ} (hx : (x : R) = 0) : ringChar R ∣ x :=
  (spec R x).1 hx
#align ring_char.dvd ringChar.dvd

@[simp]
theorem eq_zero [CharZero R] : ringChar R = 0 :=
  eq R 0
#align ring_char.eq_zero ringChar.eq_zero

@[simp]
theorem Nat.cast_ringChar : (ringChar R : R) = 0 := by rw [ringChar.spec]
#align ring_char.nat.cast_ring_char ringChar.Nat.cast_ringChar

end ringChar

theorem add_pow_char_of_commute [Semiring R] {p : ℕ} [Fact p.Prime] [CharP R p] (x y : R)
    (h : Commute x y) : (x + y) ^ p = x ^ p + y ^ p := by
  rw [Commute.add_pow h, Finset.sum_range_succ_comm, tsub_self, pow_zero, Nat.choose_self]
  rw [Nat.cast_one, mul_one, mul_one]; congr 1
  convert Finset.sum_eq_single (f := fun (x_1 : ℕ) => x ^ x_1 * y ^ (p - x_1) * (Nat.choose p x_1))
    (s := Finset.range p) 0
    (by
      intro b h1 h2
      suffices (p.choose b : R) = 0 by
        simp [this]
      rw [CharP.cast_eq_zero_iff R p]
      exact Nat.Prime.dvd_choose_self Fact.out h2 (Finset.mem_range.1 h1))
    (by
      intro h1
      contrapose! h1
      rw [Finset.mem_range]
      exact Nat.Prime.pos Fact.out)
  simp only [mul_one, one_mul, Nat.choose_zero_right, tsub_zero, Nat.cast_one, pow_zero]
#align add_pow_char_of_commute add_pow_char_of_commute

theorem add_pow_char_pow_of_commute [Semiring R] {p : ℕ} [Fact p.Prime] [CharP R p] {n : ℕ}
    (x y : R) (h : Commute x y) : (x + y) ^ p ^ n = x ^ p ^ n + y ^ p ^ n := by
  induction n with
  | zero => simp
  | succ n n_ih =>
      rw [pow_succ', pow_mul, pow_mul, pow_mul, n_ih]
      apply add_pow_char_of_commute; apply Commute.pow_pow h
#align add_pow_char_pow_of_commute add_pow_char_pow_of_commute

theorem sub_pow_char_of_commute [Ring R] {p : ℕ} [Fact p.Prime] [CharP R p] (x y : R)
    (h : Commute x y) : (x - y) ^ p = x ^ p - y ^ p := by
  rw [eq_sub_iff_add_eq, ← add_pow_char_of_commute _ _ _ (Commute.sub_left h rfl)]
  simp
#align sub_pow_char_of_commute sub_pow_char_of_commute

theorem sub_pow_char_pow_of_commute [Ring R] {p : ℕ} [Fact p.Prime] [CharP R p] {n : ℕ} (x y : R)
    (h : Commute x y) : (x - y) ^ p ^ n = x ^ p ^ n - y ^ p ^ n := by
  induction n with
  | zero => simp
  | succ n n_ih =>
      rw [pow_succ', pow_mul, pow_mul, pow_mul, n_ih]
      apply sub_pow_char_of_commute; apply Commute.pow_pow h
#align sub_pow_char_pow_of_commute sub_pow_char_pow_of_commute

theorem add_pow_char [CommSemiring R] {p : ℕ} [Fact p.Prime] [CharP R p] (x y : R) :
    (x + y) ^ p = x ^ p + y ^ p :=
  add_pow_char_of_commute _ _ _ (Commute.all _ _)
#align add_pow_char add_pow_char

theorem add_pow_char_pow [CommSemiring R] {p : ℕ} [Fact p.Prime] [CharP R p] {n : ℕ} (x y : R) :
    (x + y) ^ p ^ n = x ^ p ^ n + y ^ p ^ n :=
  add_pow_char_pow_of_commute _ _ _ (Commute.all _ _)
#align add_pow_char_pow add_pow_char_pow

theorem sub_pow_char [CommRing R] {p : ℕ} [Fact p.Prime] [CharP R p] (x y : R) :
    (x - y) ^ p = x ^ p - y ^ p :=
  sub_pow_char_of_commute _ _ _ (Commute.all _ _)
#align sub_pow_char sub_pow_char

theorem sub_pow_char_pow [CommRing R] {p : ℕ} [Fact p.Prime] [CharP R p] {n : ℕ} (x y : R) :
    (x - y) ^ p ^ n = x ^ p ^ n - y ^ p ^ n :=
  sub_pow_char_pow_of_commute _ _ _ (Commute.all _ _)
#align sub_pow_char_pow sub_pow_char_pow

theorem eq_iff_modEq_int [Ring R] (p : ℕ) [CharP R p] (a b : ℤ) : (a : R) = b ↔ a ≡ b [ZMOD p] := by
  rw [eq_comm, ← sub_eq_zero, ← Int.cast_sub, CharP.int_cast_eq_zero_iff R p, Int.modEq_iff_dvd]
#align eq_iff_modeq_int eq_iff_modEq_int

theorem CharP.neg_one_ne_one [Ring R] (p : ℕ) [CharP R p] [Fact (2 < p)] : (-1 : R) ≠ (1 : R) := by
  suffices (2 : R) ≠ 0 by
    intro h
    symm at h
    rw [← sub_eq_zero, sub_neg_eq_add] at h
    norm_num at h
    exact this h
    -- porting note: this could probably be golfed
  intro h
  rw [show (2 : R) = (2 : ℕ) by norm_cast] at h
  have := (CharP.cast_eq_zero_iff R p 2).mp h
  have := Nat.le_of_dvd (by decide) this
  rw [fact_iff] at *
  linarith
#align char_p.neg_one_ne_one CharP.neg_one_ne_one

theorem CharP.neg_one_pow_char [CommRing R] (p : ℕ) [CharP R p] [Fact p.Prime] :
    (-1 : R) ^ p = -1 := by
  rw [eq_neg_iff_add_eq_zero]
  nth_rw 2 [← one_pow p]
  rw [← add_pow_char, add_left_neg, zero_pow (Fact.out (p := Nat.Prime p)).pos]
#align char_p.neg_one_pow_char CharP.neg_one_pow_char

theorem CharP.neg_one_pow_char_pow [CommRing R] (p n : ℕ) [CharP R p] [Fact p.Prime] :
    (-1 : R) ^ p ^ n = -1 := by
  rw [eq_neg_iff_add_eq_zero]
  nth_rw 2 [← one_pow (p ^ n)]
  rw [← add_pow_char_pow, add_left_neg, zero_pow (pow_pos (Fact.out (p := Nat.Prime p)).pos _)]
#align char_p.neg_one_pow_char_pow CharP.neg_one_pow_char_pow

theorem RingHom.charP_iff_charP {K L : Type _} [DivisionRing K] [Semiring L] [Nontrivial L]
    (f : K →+* L) (p : ℕ) : CharP K p ↔ CharP L p := by
  simp only [charP_iff, ← f.injective.eq_iff, map_natCast f, f.map_zero]
#align ring_hom.char_p_iff_char_p RingHom.charP_iff_charP

section frobenius

section CommSemiring

variable [CommSemiring R] {S : Type v} [CommSemiring S] (f : R →* S) (g : R →+* S) (p : ℕ)
  [Fact p.Prime] [CharP R p] [CharP S p] (x y : R)

/-- The frobenius map that sends x to x^p -/
def frobenius : R →+* R where
  toFun x := x ^ p
  map_one' := one_pow p
  map_mul' x y := mul_pow x y p
  map_zero' := zero_pow (Fact.out (p := Nat.Prime p)).pos
  map_add' := add_pow_char R
#align frobenius frobenius

variable {R}

theorem frobenius_def : frobenius R p x = x ^ p :=
  rfl
#align frobenius_def frobenius_def

theorem iterate_frobenius (n : ℕ) : (frobenius R p^[n]) x = x ^ p ^ n := by
  induction n with
  | zero => simp
  | succ n n_ih =>
      rw [Function.iterate_succ', pow_succ', pow_mul, Function.comp_apply, frobenius_def, n_ih]
#align iterate_frobenius iterate_frobenius

theorem frobenius_mul : frobenius R p (x * y) = frobenius R p x * frobenius R p y :=
  (frobenius R p).map_mul x y
#align frobenius_mul frobenius_mul

theorem frobenius_one : frobenius R p 1 = 1 :=
  one_pow _
#align frobenius_one frobenius_one

theorem MonoidHom.map_frobenius : f (frobenius R p x) = frobenius S p (f x) :=
  f.map_pow x p
#align monoid_hom.map_frobenius MonoidHom.map_frobenius

theorem RingHom.map_frobenius : g (frobenius R p x) = frobenius S p (g x) :=
  g.map_pow x p
#align ring_hom.map_frobenius RingHom.map_frobenius

theorem MonoidHom.map_iterate_frobenius (n : ℕ) :
    f ((frobenius R p^[n]) x) = (frobenius S p^[n]) (f x) :=
  Function.Semiconj.iterate_right (f.map_frobenius p) n x
#align monoid_hom.map_iterate_frobenius MonoidHom.map_iterate_frobenius

theorem RingHom.map_iterate_frobenius (n : ℕ) :
    g ((frobenius R p^[n]) x) = (frobenius S p^[n]) (g x) :=
  g.toMonoidHom.map_iterate_frobenius p x n
#align ring_hom.map_iterate_frobenius RingHom.map_iterate_frobenius

theorem MonoidHom.iterate_map_frobenius (f : R →* R) (p : ℕ) [Fact p.Prime] [CharP R p] (n : ℕ) :
    (f^[n]) (frobenius R p x) = frobenius R p ((f^[n]) x) :=
  f.iterate_map_pow _ _ _
#align monoid_hom.iterate_map_frobenius MonoidHom.iterate_map_frobenius

theorem RingHom.iterate_map_frobenius (f : R →+* R) (p : ℕ) [Fact p.Prime] [CharP R p] (n : ℕ) :
    (f^[n]) (frobenius R p x) = frobenius R p ((f^[n]) x) :=
  f.iterate_map_pow _ _ _
#align ring_hom.iterate_map_frobenius RingHom.iterate_map_frobenius

variable (R)

theorem frobenius_zero : frobenius R p 0 = 0 :=
  (frobenius R p).map_zero
#align frobenius_zero frobenius_zero

theorem frobenius_add : frobenius R p (x + y) = frobenius R p x + frobenius R p y :=
  (frobenius R p).map_add x y
#align frobenius_add frobenius_add

theorem frobenius_nat_cast (n : ℕ) : frobenius R p n = n :=
  map_natCast (frobenius R p) n
#align frobenius_nat_cast frobenius_nat_cast

open BigOperators

variable {R}

theorem list_sum_pow_char (l : List R) : l.sum ^ p = (l.map (· ^ p : R → R)).sum :=
  (frobenius R p).map_list_sum _
#align list_sum_pow_char list_sum_pow_char

theorem multiset_sum_pow_char (s : Multiset R) : s.sum ^ p = (s.map (· ^ p : R → R)).sum :=
  (frobenius R p).map_multiset_sum _
#align multiset_sum_pow_char multiset_sum_pow_char

theorem sum_pow_char {ι : Type _} (s : Finset ι) (f : ι → R) :
    (∑ i in s, f i) ^ p = ∑ i in s, f i ^ p :=
  (frobenius R p).map_sum _ _
#align sum_pow_char sum_pow_char

end CommSemiring

section CommRing

variable [CommRing R] {S : Type v} [CommRing S] (f : R →* S) (g : R →+* S) (p : ℕ) [Fact p.Prime]
  [CharP R p] [CharP S p] (x y : R)

theorem frobenius_neg : frobenius R p (-x) = -frobenius R p x :=
  (frobenius R p).map_neg x
#align frobenius_neg frobenius_neg

theorem frobenius_sub : frobenius R p (x - y) = frobenius R p x - frobenius R p y :=
  (frobenius R p).map_sub x y
#align frobenius_sub frobenius_sub

end CommRing

end frobenius

theorem frobenius_inj [CommRing R] [IsReduced R] (p : ℕ) [Fact p.Prime] [CharP R p] :
    Function.Injective (frobenius R p) := fun x h H => by
  rw [← sub_eq_zero] at H⊢
  rw [← frobenius_sub] at H
  exact IsReduced.eq_zero _ ⟨_, H⟩
#align frobenius_inj frobenius_inj

/-- If `ringChar R = 2`, where `R` is a finite reduced commutative ring,
then every `a : R` is a square. -/
theorem isSquare_of_charTwo' {R : Type _} [Finite R] [CommRing R] [IsReduced R] [CharP R 2]
    (a : R) : IsSquare a := by
  cases nonempty_fintype R
  exact
    Exists.imp (fun b h => pow_two b ▸ Eq.symm h)
      (((Fintype.bijective_iff_injective_and_card _).mpr ⟨frobenius_inj R 2, rfl⟩).surjective a)
#align is_square_of_char_two' isSquare_of_charTwo'

namespace CharP

section

variable [NonAssocRing R]

theorem charP_to_charZero (R : Type _) [AddGroupWithOne R] [CharP R 0] : CharZero R :=
  charZero_of_inj_zero fun n h0 => eq_zero_of_zero_dvd ((cast_eq_zero_iff R 0 n).mp h0)
#align char_p.char_p_to_char_zero CharP.charP_to_charZero

theorem cast_eq_mod (p : ℕ) [CharP R p] (k : ℕ) : (k : R) = (k % p : ℕ) :=
  calc
    (k : R) = ↑(k % p + p * (k / p)) := by rw [Nat.mod_add_div]
    _ = ↑(k % p) := by simp [cast_eq_zero]

#align char_p.cast_eq_mod CharP.cast_eq_mod

/-- The characteristic of a finite ring cannot be zero. -/
theorem char_ne_zero_of_finite (p : ℕ) [CharP R p] [Finite R] : p ≠ 0 := by
  rintro rfl
  haveI : CharZero R := charP_to_charZero R
  cases nonempty_fintype R
  exact absurd Nat.cast_injective (not_injective_infinite_finite ((↑) : ℕ → R))
#align char_p.char_ne_zero_of_finite CharP.char_ne_zero_of_finite

theorem ringChar_ne_zero_of_finite [Finite R] : ringChar R ≠ 0 :=
  char_ne_zero_of_finite R (ringChar R)
#align char_p.ring_char_ne_zero_of_finite CharP.ringChar_ne_zero_of_finite

end

section CommRing

variable [CommRing R] [IsReduced R] {R}

@[simp]
theorem pow_prime_pow_mul_eq_one_iff (p k m : ℕ) [Fact p.Prime] [CharP R p] (x : R) :
    x ^ (p ^ k * m) = 1 ↔ x ^ m = 1 := by
  induction' k with k hk
  · rw [pow_zero, one_mul]
  · refine' ⟨fun h => _, fun h => _⟩
    · rw [pow_succ, mul_assoc, pow_mul', ← frobenius_def, ← frobenius_one p] at h
      exact hk.1 (frobenius_inj R p h)
    · rw [pow_mul', h, one_pow]
#align char_p.pow_prime_pow_mul_eq_one_iff CharP.pow_prime_pow_mul_eq_one_iff

end CommRing

section Semiring

open Nat

variable [NonAssocSemiring R]

theorem char_ne_one [Nontrivial R] (p : ℕ) [hc : CharP R p] : p ≠ 1 := fun hp : p = 1 =>
  have : (1 : R) = 0 := by simpa using (cast_eq_zero_iff R p 1).mpr (hp ▸ dvd_refl p)
  absurd this one_ne_zero
#align char_p.char_ne_one CharP.char_ne_one

section NoZeroDivisors

variable [NoZeroDivisors R]

theorem char_is_prime_of_two_le (p : ℕ) [hc : CharP R p] (hp : 2 ≤ p) : Nat.Prime p :=
  suffices ∀ (d) (_ : d ∣ p), d = 1 ∨ d = p from Nat.prime_def_lt''.mpr ⟨hp, this⟩
  fun (d : ℕ) (hdvd : ∃ e, p = d * e) =>
  let ⟨e, hmul⟩ := hdvd
  have : (p : R) = 0 := (cast_eq_zero_iff R p p).mpr (dvd_refl p)
  have : (d : R) * e = 0 := @cast_mul R _ d e ▸ hmul ▸ this
  Or.elim (eq_zero_or_eq_zero_of_mul_eq_zero this)
    (fun hd : (d : R) = 0 =>
      have : p ∣ d := (cast_eq_zero_iff R p d).mp hd
      show d = 1 ∨ d = p from Or.inr (dvd_antisymm ⟨e, hmul⟩ this))
    fun he : (e : R) = 0 =>
    have : p ∣ e := (cast_eq_zero_iff R p e).mp he
    have : e ∣ p := dvd_of_mul_left_eq d (Eq.symm hmul)
    have : e = p := dvd_antisymm ‹e ∣ p› ‹p ∣ e›
    have h₀ : 0 < p := two_pos.trans_le hp
    have : d * p = 1 * p := by rw [‹e = p›] at hmul; rw [one_mul]; exact Eq.symm hmul
    show d = 1 ∨ d = p from Or.inl (mul_right_cancel₀ h₀.ne' this)
#align char_p.char_is_prime_of_two_le CharP.char_is_prime_of_two_le

section Nontrivial

variable [Nontrivial R]

theorem char_is_prime_or_zero (p : ℕ) [hc : CharP R p] : Nat.Prime p ∨ p = 0 :=
  match p, hc with
  | 0, _ => Or.inr rfl
  | 1, hc => absurd (Eq.refl (1 : ℕ)) (@char_ne_one R _ _ (1 : ℕ) hc)
  | m + 2, hc => Or.inl (@char_is_prime_of_two_le R _ _ (m + 2) hc (Nat.le_add_left 2 m))
#align char_p.char_is_prime_or_zero CharP.char_is_prime_or_zero

theorem char_is_prime_of_pos (p : ℕ) [NeZero p] [CharP R p] : Fact p.Prime :=
  ⟨(CharP.char_is_prime_or_zero R _).resolve_right <| NeZero.ne p⟩
#align char_p.char_is_prime_of_pos CharP.char_is_prime_of_pos

end Nontrivial

end NoZeroDivisors

end Semiring

section Ring

variable [Ring R] [NoZeroDivisors R] [Nontrivial R] [Finite R]
-- porting note: redundant binder annotation update

theorem char_is_prime (p : ℕ) [CharP R p] : p.Prime :=
  Or.resolve_right (char_is_prime_or_zero R p) (char_ne_zero_of_finite R p)
#align char_p.char_is_prime CharP.char_is_prime

end Ring

section CharOne

variable {R} [NonAssocSemiring R]

-- see Note [lower instance priority]
instance (priority := 100) CharOne.subsingleton [CharP R 1] : Subsingleton R :=
  Subsingleton.intro <|
    suffices ∀ r : R, r = 0 from fun a b => show a = b by rw [this a, this b]
    fun r =>
    calc
      r = 1 * r := by rw [one_mul]
      _ = (1 : ℕ) * r := by rw [Nat.cast_one]
      _ = 0 * r := by rw [CharP.cast_eq_zero]
      _ = 0 := by rw [MulZeroClass.zero_mul]

theorem false_of_nontrivial_of_char_one [Nontrivial R] [CharP R 1] : False :=
  false_of_nontrivial_of_subsingleton R
#align char_p.false_of_nontrivial_of_char_one CharP.false_of_nontrivial_of_char_one

theorem ringChar_ne_one [Nontrivial R] : ringChar R ≠ 1 := by
  intro h
  apply zero_ne_one' R
  symm
  rw [← Nat.cast_one, ringChar.spec, h]
#align char_p.ring_char_ne_one CharP.ringChar_ne_one

theorem nontrivial_of_char_ne_one {v : ℕ} (hv : v ≠ 1) [hr : CharP R v] : Nontrivial R :=
  ⟨⟨(1 : ℕ), 0, fun h =>
      hv <| by rwa [CharP.cast_eq_zero_iff _ v, Nat.dvd_one] at h⟩⟩
#align char_p.nontrivial_of_char_ne_one CharP.nontrivial_of_char_ne_one

theorem ringChar_of_prime_eq_zero [Nontrivial R] {p : ℕ} (hprime : Nat.Prime p)
    (hp0 : (p : R) = 0) : ringChar R = p :=
  Or.resolve_left ((Nat.dvd_prime hprime).1 (ringChar.dvd hp0)) ringChar_ne_one
#align char_p.ring_char_of_prime_eq_zero CharP.ringChar_of_prime_eq_zero

end CharOne

end CharP

section

/-- We have `2 ≠ 0` in a nontrivial ring whose characteristic is not `2`. -/
protected theorem Ring.two_ne_zero {R : Type _} [NonAssocSemiring R] [Nontrivial R]
    (hR : ringChar R ≠ 2) : (2 : R) ≠ 0 := by
  rw [Ne.def, (by norm_cast : (2 : R) = (2 : ℕ)), ringChar.spec, Nat.dvd_prime Nat.prime_two]
  exact mt (or_iff_left hR).mp CharP.ringChar_ne_one
#align ring.two_ne_zero Ring.two_ne_zero

-- We have `CharP.neg_one_ne_one`, which assumes `[Ring R] (p : ℕ) [CharP R p] [Fact (2 < p)]`.
-- This is a version using `ringChar` instead.
/-- Characteristic `≠ 2` and nontrivial implies that `-1 ≠ 1`. -/
theorem Ring.neg_one_ne_one_of_char_ne_two {R : Type _} [NonAssocRing R] [Nontrivial R]
    (hR : ringChar R ≠ 2) : (-1 : R) ≠ 1 := fun h =>
  Ring.two_ne_zero hR (one_add_one_eq_two (α := R) ▸ neg_eq_iff_add_eq_zero.mp h)
#align ring.neg_one_ne_one_of_char_ne_two Ring.neg_one_ne_one_of_char_ne_two

/-- Characteristic `≠ 2` in a domain implies that `-a = a` iff `a = 0`. -/
theorem Ring.eq_self_iff_eq_zero_of_char_ne_two {R : Type _} [NonAssocRing R] [Nontrivial R]
    [NoZeroDivisors R] (hR : ringChar R ≠ 2) {a : R} : -a = a ↔ a = 0 :=
  ⟨fun h =>
    (mul_eq_zero.mp <| (two_mul a).trans <| neg_eq_iff_add_eq_zero.mp h).resolve_left
      (Ring.two_ne_zero hR),
    fun h => ((congr_arg (fun x => -x) h).trans neg_zero).trans h.symm⟩
#align ring.eq_self_iff_eq_zero_of_char_ne_two Ring.eq_self_iff_eq_zero_of_char_ne_two

end

section

variable [NonAssocRing R] [Fintype R] (n : ℕ)
-- porting note: redundant binder annotation update

theorem charP_of_ne_zero (hn : Fintype.card R = n) (hR : ∀ i < n, (i : R) = 0 → i = 0) :
    CharP R n :=
  { cast_eq_zero_iff' :=
      by
      have H : (n : R) = 0 := by rw [← hn, CharP.cast_card_eq_zero]
      intro k
      constructor
      · intro h
        rw [← Nat.mod_add_div k n, Nat.cast_add, Nat.cast_mul, H, MulZeroClass.zero_mul,
          add_zero] at h
        rw [Nat.dvd_iff_mod_eq_zero]
        apply hR _ (Nat.mod_lt _ _) h
        rw [← hn, gt_iff_lt, Fintype.card_pos_iff]
        exact ⟨0⟩
      · rintro ⟨k, rfl⟩
        rw [Nat.cast_mul, H, MulZeroClass.zero_mul] }
#align char_p_of_ne_zero charP_of_ne_zero

theorem charP_of_prime_pow_injective (R) [Ring R] [Fintype R] (p : ℕ) [hp : Fact p.Prime] (n : ℕ)
    (hn : Fintype.card R = p ^ n) (hR : ∀ i ≤ n, (p ^ i : R) = 0 → i = n) : CharP R (p ^ n) := by
  obtain ⟨c, hc⟩ := CharP.exists R
  skip
  have hcpn : c ∣ p ^ n := by rw [← CharP.cast_eq_zero_iff R c, ← hn, CharP.cast_card_eq_zero]
  obtain ⟨i, hi, hc⟩ : ∃ i ≤ n, c = p ^ i := by rwa [Nat.dvd_prime_pow hp.1] at hcpn
  obtain rfl : i = n := by
    apply hR i hi
    rw [← hc, CharP.cast_eq_zero]
  rwa [← hc]
#align char_p_of_prime_pow_injective charP_of_prime_pow_injective

end

section Prod

variable (S : Type v) [AddMonoidWithOne R] [AddMonoidWithOne S] (p q : ℕ) [CharP R p]

/-- The characteristic of the product of rings is the least common multiple of the
characteristics of the two rings. -/
instance Nat.lcm.charP [CharP S q] : CharP (R × S) (Nat.lcm p q) where
  cast_eq_zero_iff' := by
    simp [Prod.ext_iff, CharP.cast_eq_zero_iff R p, CharP.cast_eq_zero_iff S q, Nat.lcm_dvd_iff]

/-- The characteristic of the product of two rings of the same characteristic
  is the same as the characteristic of the rings -/
instance Prod.charP [CharP S p] : CharP (R × S) p := by
  convert Nat.lcm.charP R S p p; simp
#align prod.char_p Prod.charP

end Prod

instance ULift.charP [AddMonoidWithOne R] (p : ℕ) [CharP R p] : CharP (ULift.{v} R) p
    where cast_eq_zero_iff' n := Iff.trans (ULift.ext_iff _ _) <| CharP.cast_eq_zero_iff R p n
#align ulift.char_p ULift.charP

instance MulOpposite.charP [AddMonoidWithOne R] (p : ℕ) [CharP R p] : CharP Rᵐᵒᵖ p
    where cast_eq_zero_iff' n := MulOpposite.unop_inj.symm.trans <| CharP.cast_eq_zero_iff R p n
#align mul_opposite.char_p MulOpposite.charP

section

/-- If two integers from `{0, 1, -1}` result in equal elements in a ring `R`
that is nontrivial and of characteristic not `2`, then they are equal. -/
theorem Int.cast_injOn_of_ringChar_ne_two {R : Type _} [NonAssocRing R] [Nontrivial R]
    (hR : ringChar R ≠ 2) : ({0, 1, -1} : Set ℤ).InjOn ((↑) : ℤ → R) := by
  intro a ha b hb h
  apply eq_of_sub_eq_zero
  by_contra hf
  replace ha : a = 0 ∨ a = 1 ∨ a = -1 := ha
  replace hb : b = 0 ∨ b = 1 ∨ b = -1 := hb
  have hh : a - b = 1 ∨ b - a = 1 ∨ a - b = 2 ∨ b - a = 2 :=
    by
    rcases ha with (ha | ha | ha) <;> rcases hb with (hb | hb | hb)
    pick_goal 5
    pick_goal 9
    -- move goals with `a = b` to the front
    iterate 3 rw [ha, hb, sub_self] at hf; tauto
    -- 6 goals remain
    all_goals rw [ha, hb]; norm_num
  have h' : ((a - b : ℤ) : R) = 0 := by exact_mod_cast sub_eq_zero_of_eq h
  have h'' : ((b - a : ℤ) : R) = 0 := by exact_mod_cast sub_eq_zero_of_eq h.symm
  rcases hh with (hh | hh | hh | hh)
  · rw [hh, (by norm_cast : ((1 : ℤ) : R) = 1)] at h'
    exact one_ne_zero h'
  · rw [hh, (by norm_cast : ((1 : ℤ) : R) = 1)] at h''
    exact one_ne_zero h''
  · rw [hh, (by norm_cast : ((2 : ℤ) : R) = 2)] at h'
    exact Ring.two_ne_zero hR h'
  · rw [hh, (by norm_cast : ((2 : ℤ) : R) = 2)] at h''
    exact Ring.two_ne_zero hR h''
#align int.cast_inj_on_of_ring_char_ne_two Int.cast_injOn_of_ringChar_ne_two

end

namespace NeZero

variable [AddMonoidWithOne R] {r : R} {n p : ℕ} {a : ℕ+}
-- porting note: redundant binder annotation update

theorem of_not_dvd [CharP R p] (h : ¬p ∣ n) : NeZero (n : R) :=
  ⟨(CharP.cast_eq_zero_iff R p n).not.mpr h⟩
#align ne_zero.of_not_dvd NeZero.of_not_dvd

theorem not_char_dvd (p : ℕ) [CharP R p] (k : ℕ) [h : NeZero (k : R)] : ¬p ∣ k := by
  rwa [← CharP.cast_eq_zero_iff R p k, ← Ne.def, ← neZero_iff]
#align ne_zero.not_char_dvd NeZero.not_char_dvd

end NeZero


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import analysis.convex.function
import measure_theory.integral.set_integral

/-!
# Jensen's inequality for integrals

In this file we prove four theorems:

* `convex.smul_integral_mem`: if `μ` is a non-zero finite measure on `α`, `s` is a convex closed set
  in `E`, and `f` is an integrable function sending `μ`-a.e. points to `s`, then the average value
  of `f` belongs to `s`: `(μ univ).to_real⁻¹ • ∫ x, f x ∂μ ∈ s`. See also `convex.center_mass_mem`
  for a finite sum version of this lemma.

* `convex.integral_mem`: if `μ` is a probability measure on `α`, `s` is a convex closed set in `E`,
  and `f` is an integrable function sending `μ`-a.e. points to `s`, then the expected value of `f`
  belongs to `s`: `∫ x, f x ∂μ ∈ s`. See also `convex.sum_mem` for a finite sum version of this
  lemma.

* `convex_on.map_smul_integral_le`: Convex Jensen's inequality: If a function `g : E → ℝ` is convex
  and continuous on a convex closed set `s`, `μ` is a finite non-zero measure on `α`, and
  `f : α → E` is a function sending `μ`-a.e. points to `s`, then the value of `g` at the average
  value of `f` is less than or equal to the average value of `g ∘ f` provided that both `f` and
  `g ∘ f` are integrable. See also `convex_on.map_sum_le` for a finite sum version of this lemma.

* `convex_on.map_integral_le`: Convex Jensen's inequality: If a function `g : E → ℝ` is convex and
  continuous on a convex closed set `s`, `μ` is a probability measure on `α`, and `f : α → E` is a
  function sending `μ`-a.e. points to `s`, then the value of `g` at the expected value of `f` is
  less than or equal to the expected value of `g ∘ f` provided that both `f` and `g ∘ f` are
  integrable. See also `convex_on.map_sum_le` for a finite sum version of this lemma.

## Tags

convex, integral, center mass, Jensen's inequality
-/

open measure_theory set filter
open_locale topological_space big_operators

variables {α E : Type*} [measurable_space α] {μ : measure α}
  [normed_group E] [normed_space ℝ E] [complete_space E]
  [topological_space.second_countable_topology E] [measurable_space E] [borel_space E]

private lemma convex.smul_integral_mem_of_measurable
  [is_finite_measure μ] {s : set E} (hs : convex ℝ s) (hsc : is_closed s)
  (hμ : μ ≠ 0) {f : α → E} (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hfm : measurable f) :
  (μ univ).to_real⁻¹ • ∫ x, f x ∂μ ∈ s :=
begin
  unfreezingI { rcases eq_empty_or_nonempty s with rfl|⟨y₀, h₀⟩ },
  { refine (hμ _).elim, simpa using hfs },
  rw ← hsc.closure_eq at hfs,
  have hc : integrable (λ _, y₀) μ := integrable_const _,
  set F : ℕ → simple_func α E := simple_func.approx_on f hfm s y₀ h₀,
  have : tendsto (λ n, (F n).integral μ) at_top (𝓝 $ ∫ x, f x ∂μ),
  { simp only [simple_func.integral_eq_integral _
      (simple_func.integrable_approx_on hfm hfi h₀ hc _)],
    exact tendsto_integral_of_L1 _ hfi
      (eventually_of_forall $ simple_func.integrable_approx_on hfm hfi h₀ hc)
      (simple_func.tendsto_approx_on_L1_nnnorm hfm h₀ hfs (hfi.sub hc).2) },
  refine hsc.mem_of_tendsto (tendsto_const_nhds.smul this) (eventually_of_forall $ λ n, _),
  have : ∑ y in (F n).range, (μ ((F n) ⁻¹' {y})).to_real = (μ univ).to_real,
    by rw [← (F n).sum_range_measure_preimage_singleton, @ennreal.to_real_sum _ _
      (λ y, μ ((F n) ⁻¹' {y})) (λ _ _, (measure_ne_top _ _))],
  rw [← this, simple_func.integral],
  refine hs.center_mass_mem (λ _ _, ennreal.to_real_nonneg) _ _,
  { rw [this, ennreal.to_real_pos_iff, pos_iff_ne_zero, ne.def, measure.measure_univ_eq_zero],
    exact ⟨hμ, measure_ne_top _ _⟩ },
  { simp only [simple_func.mem_range],
    rintros _ ⟨x, rfl⟩,
    exact simple_func.approx_on_mem hfm h₀ n x }
end

/-- If `μ` is a non-zero finite measure on `α`, `s` is a convex closed set in `E`, and `f` is an
integrable function sending `μ`-a.e. points to `s`, then the average value of `f` belongs to `s`:
`(μ univ).to_real⁻¹ • ∫ x, f x ∂μ ∈ s`. See also `convex.center_mass_mem` for a finite sum version
of this lemma. -/
lemma convex.smul_integral_mem
  [is_finite_measure μ] {s : set E} (hs : convex ℝ s) (hsc : is_closed s)
  (hμ : μ ≠ 0) {f : α → E} (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) :
  (μ univ).to_real⁻¹ • ∫ x, f x ∂μ ∈ s :=
begin
  have : ∀ᵐ (x : α) ∂μ, hfi.ae_measurable.mk f x ∈ s,
  { filter_upwards [hfs, hfi.ae_measurable.ae_eq_mk],
    assume a ha h,
    rwa ← h },
  convert convex.smul_integral_mem_of_measurable hs hsc hμ this
    (hfi.congr hfi.ae_measurable.ae_eq_mk) (hfi.ae_measurable.measurable_mk) using 2,
  apply integral_congr_ae,
  exact hfi.ae_measurable.ae_eq_mk
end

/-- If `μ` is a probability measure on `α`, `s` is a convex closed set in `E`, and `f` is an
integrable function sending `μ`-a.e. points to `s`, then the expected value of `f` belongs to `s`:
`∫ x, f x ∂μ ∈ s`. See also `convex.sum_mem` for a finite sum version of this lemma. -/
lemma convex.integral_mem [is_probability_measure μ] {s : set E} (hs : convex ℝ s)
  (hsc : is_closed s) {f : α → E} (hf : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) :
  ∫ x, f x ∂μ ∈ s :=
by simpa [measure_univ] using hs.smul_integral_mem hsc (is_probability_measure.ne_zero μ) hf hfi

/-- Jensen's inequality: if a function `g : E → ℝ` is convex and continuous on a convex closed set
`s`, `μ` is a finite non-zero measure on `α`, and `f : α → E` is a function sending `μ`-a.e. points
to `s`, then the value of `g` at the average value of `f` is less than or equal to the average value
of `g ∘ f` provided that both `f` and `g ∘ f` are integrable. See also `convex.map_center_mass_le`
for a finite sum version of this lemma. -/
lemma convex_on.map_smul_integral_le [is_finite_measure μ] {s : set E} {g : E → ℝ}
  (hg : convex_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) (hμ : μ ≠ 0) {f : α → E}
  (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) :
  g ((μ univ).to_real⁻¹ • ∫ x, f x ∂μ) ≤ (μ univ).to_real⁻¹ • ∫ x, g (f x) ∂μ :=
begin
  set t := {p : E × ℝ | p.1 ∈ s ∧ g p.1 ≤ p.2},
  have ht_conv : convex ℝ t := hg.convex_epigraph,
  have ht_closed : is_closed t :=
    (hsc.preimage continuous_fst).is_closed_le (hgc.comp continuous_on_fst (subset.refl _))
      continuous_on_snd,
  have ht_mem : ∀ᵐ x ∂μ, (f x, g (f x)) ∈ t := hfs.mono (λ x hx, ⟨hx, le_rfl⟩),
  simpa [integral_pair hfi hgi]
    using (ht_conv.smul_integral_mem ht_closed hμ ht_mem (hfi.prod_mk hgi)).2
end

/-- Convex **Jensen's inequality**: if a function `g : E → ℝ` is convex and continuous on a convex
closed set `s`, `μ` is a probability measure on `α`, and `f : α → E` is a function sending `μ`-a.e.
points to `s`, then the value of `g` at the expected value of `f` is less than or equal to the
expected value of `g ∘ f` provided that both `f` and `g ∘ f` are integrable. See also
`convex_on.map_center_mass_le` for a finite sum version of this lemma. -/
lemma convex_on.map_integral_le [is_probability_measure μ] {s : set E} {g : E → ℝ}
  (hg : convex_on ℝ s g) (hgc : continuous_on g s) (hsc : is_closed s) {f : α → E}
  (hfs : ∀ᵐ x ∂μ, f x ∈ s) (hfi : integrable f μ) (hgi : integrable (g ∘ f) μ) :
  g (∫ x, f x ∂μ) ≤ ∫ x, g (f x) ∂μ :=
by simpa [measure_univ]
  using hg.map_smul_integral_le hgc hsc (is_probability_measure.ne_zero μ) hfs hfi hgi


/-
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, Johannes Hölzl

! This file was ported from Lean 3 source module algebra.order.zero_le_one
! 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.Order.Basic
import Mathbin.Algebra.NeZero

/-!
# Typeclass expressing `0 ≤ 1`.

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

variable {α : Type _}

open Function

#print ZeroLEOneClass /-
/-- Typeclass for expressing that the `0` of a type is less or equal to its `1`. -/
class ZeroLEOneClass (α : Type _) [Zero α] [One α] [LE α] where
  zero_le_one : (0 : α) ≤ 1
#align zero_le_one_class ZeroLEOneClass
-/

#print zero_le_one /-
/-- `zero_le_one` with the type argument implicit. -/
@[simp]
theorem zero_le_one [Zero α] [One α] [LE α] [ZeroLEOneClass α] : (0 : α) ≤ 1 :=
  ZeroLEOneClass.zero_le_one
#align zero_le_one zero_le_one
-/

#print zero_le_one' /-
/-- `zero_le_one` with the type argument explicit. -/
theorem zero_le_one' (α) [Zero α] [One α] [LE α] [ZeroLEOneClass α] : (0 : α) ≤ 1 :=
  zero_le_one
#align zero_le_one' zero_le_one'
-/

section

variable [Zero α] [One α] [PartialOrder α] [ZeroLEOneClass α] [NeZero (1 : α)]

#print zero_lt_one /-
/-- See `zero_lt_one'` for a version with the type explicit. -/
@[simp]
theorem zero_lt_one : (0 : α) < 1 :=
  zero_le_one.lt_of_ne (NeZero.ne' 1)
#align zero_lt_one zero_lt_one
-/

variable (α)

#print zero_lt_one' /-
/-- See `zero_lt_one` for a version with the type implicit. -/
theorem zero_lt_one' : (0 : α) < 1 :=
  zero_lt_one
#align zero_lt_one' zero_lt_one'
-/

end

alias zero_lt_one ← one_pos
#align one_pos one_pos


import tactic

namespace classes_example

universe u

class has_mul' (α : Type u) :=
  (mul : α → α → α)
  (mul_comm : ∀ (x y : α), mul x y = mul y x) -- (mul_comm (x y : α) : mul x y = mul y x)

def flip {α : Type u} := λ (f : α → α → α) {x y : α}, f y x

instance : has_mul' nat := {
  mul := λ m n, n * m, -- let's reverse order multiplication for fun!
  -- mul_comm := λ x y, nat.mul_comm y x
  mul_comm := λ x y, eq.symm $ nat.mul_comm x y
  -- mul_comm := flip nat.mul_comm -- NOT WORKS
}

class has_zero_one_and_mul (α : Type u) extends has_mul' α :=
(zero : α)
(one  : α)
(mul_zero : ∀ (x : α), mul x zero = zero)
(mul_one  : ∀ (x : α), mul x one = x)

@[instance] def instance1 : has_zero_one_and_mul nat := {
    zero := 0
  , one  := 1
  , mul_zero := λ x,
      begin
        unfold has_mul'.mul,
        apply eq.subst (nat.mul_comm 0 x),
        apply eq.refl,
      end
  , mul_one := begin apply nat.one_mul end
}

#print instance1

#print instance1._proof_1
-- not generated, but if we replace proof of mul_one with sorry then we see _proof_2
-- #print instance1._proof_2

@[instance] def instance2 : has_zero_one_and_mul nat := /- ⟨0, 1, _, _⟩ -/ -- check this
  ⟨0, 1, nat.zero_mul, nat.one_mul⟩

end classes_example

namespace proofs_about_classes

open classes_example

-- #check has_zero_and_one
universe u
variables {α : Type u}

-- how to write theorem:
/-
example (β : Type) : [has_mul β] ∧ [has_zero_and_one β] → [has_zero_and_one_and_mul β] := _
-/

local notation `mul'` := has_mul'.mul

example (x : α) [has_mul' α] : mul' x x = mul' x x := rfl

example (x y : α) [has_zero_one_and_mul α] : mul' x y = mul' y x := by {
  tactic.unfreeze_local_instances,
  rename _inst_1 i,
  type_check i.zero, -- α
  apply i.mul_comm,
}

end proofs_about_classes


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

! This file was ported from Lean 3 source module algebra.star.pointwise
! leanprover-community/mathlib commit 30413fc89f202a090a54d78e540963ed3de0056e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Star.Basic
import Mathbin.Data.Set.Finite
import Mathbin.Data.Set.Pointwise.Basic

/-!
# Pointwise star operation on sets

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

This file defines the star operation pointwise on sets and provides the basic API.
Besides basic facts about about how the star operation acts on sets (e.g., `(s ∩ t)⋆ = s⋆ ∩ t⋆`),
if `s t : set α`, then under suitable assumption on `α`, it is shown

* `(s + t)⋆ = s⋆ + t⋆`
* `(s * t)⋆ = t⋆ + s⋆`
* `(s⁻¹)⋆ = (s⋆)⁻¹`
-/

namespace Set

open Pointwise

-- mathport name: «expr ⋆»
local postfix:max "⋆" => star

variable {α : Type _} {s t : Set α} {a : α}

#print Set.star /-
/-- The set `(star s : set α)` is defined as `{x | star x ∈ s}` in locale `pointwise`.
In the usual case where `star` is involutive, it is equal to `{star s | x ∈ s}`, see
`set.image_star`. -/
protected def star [Star α] : Star (Set α) :=
  ⟨preimage Star.star⟩
#align set.has_star Set.star
-/

scoped[Pointwise] attribute [instance] Set.star

#print Set.star_empty /-
@[simp]
theorem star_empty [Star α] : (∅ : Set α)⋆ = ∅ :=
  rfl
#align set.star_empty Set.star_empty
-/

#print Set.star_univ /-
@[simp]
theorem star_univ [Star α] : (univ : Set α)⋆ = univ :=
  rfl
#align set.star_univ Set.star_univ
-/

#print Set.nonempty_star /-
@[simp]
theorem nonempty_star [InvolutiveStar α] {s : Set α} : s⋆.Nonempty ↔ s.Nonempty :=
  star_involutive.Surjective.nonempty_preimage
#align set.nonempty_star Set.nonempty_star
-/

#print Set.Nonempty.star /-
theorem Nonempty.star [InvolutiveStar α] {s : Set α} (h : s.Nonempty) : s⋆.Nonempty :=
  nonempty_star.2 h
#align set.nonempty.star Set.Nonempty.star
-/

#print Set.mem_star /-
@[simp]
theorem mem_star [Star α] : a ∈ s⋆ ↔ a⋆ ∈ s :=
  Iff.rfl
#align set.mem_star Set.mem_star
-/

#print Set.star_mem_star /-
theorem star_mem_star [InvolutiveStar α] : a⋆ ∈ s⋆ ↔ a ∈ s := by simp only [mem_star, star_star]
#align set.star_mem_star Set.star_mem_star
-/

#print Set.star_preimage /-
@[simp]
theorem star_preimage [Star α] : Star.star ⁻¹' s = s⋆ :=
  rfl
#align set.star_preimage Set.star_preimage
-/

#print Set.image_star /-
@[simp]
theorem image_star [InvolutiveStar α] : Star.star '' s = s⋆ :=
  by
  simp only [← star_preimage]
  rw [image_eq_preimage_of_inverse] <;> intro <;> simp only [star_star]
#align set.image_star Set.image_star
-/

/- warning: set.inter_star -> Set.inter_star is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {s : Set.{u1} α} {t : Set.{u1} α} [_inst_1 : Star.{u1} α], Eq.{succ u1} (Set.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α _inst_1) (Inter.inter.{u1} (Set.{u1} α) (Set.hasInter.{u1} α) s t)) (Inter.inter.{u1} (Set.{u1} α) (Set.hasInter.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α _inst_1) s) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α _inst_1) t))
but is expected to have type
  forall {α : Type.{u1}} {s : Set.{u1} α} {t : Set.{u1} α} [_inst_1 : Star.{u1} α], Eq.{succ u1} (Set.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α _inst_1) (Inter.inter.{u1} (Set.{u1} α) (Set.instInterSet.{u1} α) s t)) (Inter.inter.{u1} (Set.{u1} α) (Set.instInterSet.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α _inst_1) s) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α _inst_1) t))
Case conversion may be inaccurate. Consider using '#align set.inter_star Set.inter_starₓ'. -/
@[simp]
theorem inter_star [Star α] : (s ∩ t)⋆ = s⋆ ∩ t⋆ :=
  preimage_inter
#align set.inter_star Set.inter_star

/- warning: set.union_star -> Set.union_star is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {s : Set.{u1} α} {t : Set.{u1} α} [_inst_1 : Star.{u1} α], Eq.{succ u1} (Set.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α _inst_1) (Union.union.{u1} (Set.{u1} α) (Set.hasUnion.{u1} α) s t)) (Union.union.{u1} (Set.{u1} α) (Set.hasUnion.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α _inst_1) s) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α _inst_1) t))
but is expected to have type
  forall {α : Type.{u1}} {s : Set.{u1} α} {t : Set.{u1} α} [_inst_1 : Star.{u1} α], Eq.{succ u1} (Set.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α _inst_1) (Union.union.{u1} (Set.{u1} α) (Set.instUnionSet.{u1} α) s t)) (Union.union.{u1} (Set.{u1} α) (Set.instUnionSet.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α _inst_1) s) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α _inst_1) t))
Case conversion may be inaccurate. Consider using '#align set.union_star Set.union_starₓ'. -/
@[simp]
theorem union_star [Star α] : (s ∪ t)⋆ = s⋆ ∪ t⋆ :=
  preimage_union
#align set.union_star Set.union_star

#print Set.interᵢ_star /-
@[simp]
theorem interᵢ_star {ι : Sort _} [Star α] (s : ι → Set α) : (⋂ i, s i)⋆ = ⋂ i, (s i)⋆ :=
  preimage_interᵢ
#align set.Inter_star Set.interᵢ_star
-/

#print Set.unionᵢ_star /-
@[simp]
theorem unionᵢ_star {ι : Sort _} [Star α] (s : ι → Set α) : (⋃ i, s i)⋆ = ⋃ i, (s i)⋆ :=
  preimage_unionᵢ
#align set.Union_star Set.unionᵢ_star
-/

/- warning: set.compl_star -> Set.compl_star is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {s : Set.{u1} α} [_inst_1 : Star.{u1} α], Eq.{succ u1} (Set.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α _inst_1) (HasCompl.compl.{u1} (Set.{u1} α) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} α) (Set.booleanAlgebra.{u1} α)) s)) (HasCompl.compl.{u1} (Set.{u1} α) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} α) (Set.booleanAlgebra.{u1} α)) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α _inst_1) s))
but is expected to have type
  forall {α : Type.{u1}} {s : Set.{u1} α} [_inst_1 : Star.{u1} α], Eq.{succ u1} (Set.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α _inst_1) (HasCompl.compl.{u1} (Set.{u1} α) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} α) (Set.instBooleanAlgebraSet.{u1} α)) s)) (HasCompl.compl.{u1} (Set.{u1} α) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} α) (Set.instBooleanAlgebraSet.{u1} α)) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α _inst_1) s))
Case conversion may be inaccurate. Consider using '#align set.compl_star Set.compl_starₓ'. -/
@[simp]
theorem compl_star [Star α] : (sᶜ)⋆ = s⋆ᶜ :=
  preimage_compl
#align set.compl_star Set.compl_star

@[simp]
instance [InvolutiveStar α] : InvolutiveStar (Set α)
    where
  unit := Star.star
  star_involutive s := by simp only [← star_preimage, preimage_preimage, star_star, preimage_id']

#print Set.star_subset_star /-
@[simp]
theorem star_subset_star [InvolutiveStar α] {s t : Set α} : s⋆ ⊆ t⋆ ↔ s ⊆ t :=
  Equiv.star.Surjective.preimage_subset_preimage_iff
#align set.star_subset_star Set.star_subset_star
-/

#print Set.star_subset /-
theorem star_subset [InvolutiveStar α] {s t : Set α} : s⋆ ⊆ t ↔ s ⊆ t⋆ := by
  rw [← star_subset_star, star_star]
#align set.star_subset Set.star_subset
-/

#print Set.Finite.star /-
theorem Finite.star [InvolutiveStar α] {s : Set α} (hs : s.Finite) : s⋆.Finite :=
  hs.Preimage <| star_injective.InjOn _
#align set.finite.star Set.Finite.star
-/

#print Set.star_singleton /-
theorem star_singleton {β : Type _} [InvolutiveStar β] (x : β) : ({x} : Set β)⋆ = {x⋆} :=
  by
  ext1 y
  rw [mem_star, mem_singleton_iff, mem_singleton_iff, star_eq_iff_star_eq, eq_comm]
#align set.star_singleton Set.star_singleton
-/

/- warning: set.star_mul -> Set.star_mul is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Monoid.{u1} α] [_inst_2 : StarSemigroup.{u1} α (Monoid.toSemigroup.{u1} α _inst_1)] (s : Set.{u1} α) (t : Set.{u1} α), Eq.{succ u1} (Set.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toHasStar.{u1} α (StarSemigroup.toHasInvolutiveStar.{u1} α (Monoid.toSemigroup.{u1} α _inst_1) _inst_2))) (HMul.hMul.{u1, u1, u1} (Set.{u1} α) (Set.{u1} α) (Set.{u1} α) (instHMul.{u1} (Set.{u1} α) (Set.mul.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)))) s t)) (HMul.hMul.{u1, u1, u1} (Set.{u1} α) (Set.{u1} α) (Set.{u1} α) (instHMul.{u1} (Set.{u1} α) (Set.mul.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)))) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toHasStar.{u1} α (StarSemigroup.toHasInvolutiveStar.{u1} α (Monoid.toSemigroup.{u1} α _inst_1) _inst_2))) t) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toHasStar.{u1} α (StarSemigroup.toHasInvolutiveStar.{u1} α (Monoid.toSemigroup.{u1} α _inst_1) _inst_2))) s))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : Monoid.{u1} α] [_inst_2 : StarSemigroup.{u1} α (Monoid.toSemigroup.{u1} α _inst_1)] (s : Set.{u1} α) (t : Set.{u1} α), Eq.{succ u1} (Set.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toStar.{u1} α (StarSemigroup.toInvolutiveStar.{u1} α (Monoid.toSemigroup.{u1} α _inst_1) _inst_2))) (HMul.hMul.{u1, u1, u1} (Set.{u1} α) (Set.{u1} α) (Set.{u1} α) (instHMul.{u1} (Set.{u1} α) (Set.mul.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)))) s t)) (HMul.hMul.{u1, u1, u1} (Set.{u1} α) (Set.{u1} α) (Set.{u1} α) (instHMul.{u1} (Set.{u1} α) (Set.mul.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α _inst_1)))) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toStar.{u1} α (StarSemigroup.toInvolutiveStar.{u1} α (Monoid.toSemigroup.{u1} α _inst_1) _inst_2))) t) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toStar.{u1} α (StarSemigroup.toInvolutiveStar.{u1} α (Monoid.toSemigroup.{u1} α _inst_1) _inst_2))) s))
Case conversion may be inaccurate. Consider using '#align set.star_mul Set.star_mulₓ'. -/
protected theorem star_mul [Monoid α] [StarSemigroup α] (s t : Set α) : (s * t)⋆ = t⋆ * s⋆ := by
  simp_rw [← image_star, ← image2_mul, image_image2, image2_image_left, image2_image_right,
    star_mul, image2_swap _ s t]
#align set.star_mul Set.star_mul

/- warning: set.star_add -> Set.star_add is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : AddMonoid.{u1} α] [_inst_2 : StarAddMonoid.{u1} α _inst_1] (s : Set.{u1} α) (t : Set.{u1} α), Eq.{succ u1} (Set.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toHasStar.{u1} α (StarAddMonoid.toHasInvolutiveStar.{u1} α _inst_1 _inst_2))) (HAdd.hAdd.{u1, u1, u1} (Set.{u1} α) (Set.{u1} α) (Set.{u1} α) (instHAdd.{u1} (Set.{u1} α) (Set.add.{u1} α (AddZeroClass.toHasAdd.{u1} α (AddMonoid.toAddZeroClass.{u1} α _inst_1)))) s t)) (HAdd.hAdd.{u1, u1, u1} (Set.{u1} α) (Set.{u1} α) (Set.{u1} α) (instHAdd.{u1} (Set.{u1} α) (Set.add.{u1} α (AddZeroClass.toHasAdd.{u1} α (AddMonoid.toAddZeroClass.{u1} α _inst_1)))) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toHasStar.{u1} α (StarAddMonoid.toHasInvolutiveStar.{u1} α _inst_1 _inst_2))) s) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toHasStar.{u1} α (StarAddMonoid.toHasInvolutiveStar.{u1} α _inst_1 _inst_2))) t))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : AddMonoid.{u1} α] [_inst_2 : StarAddMonoid.{u1} α _inst_1] (s : Set.{u1} α) (t : Set.{u1} α), Eq.{succ u1} (Set.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toStar.{u1} α (StarAddMonoid.toInvolutiveStar.{u1} α _inst_1 _inst_2))) (HAdd.hAdd.{u1, u1, u1} (Set.{u1} α) (Set.{u1} α) (Set.{u1} α) (instHAdd.{u1} (Set.{u1} α) (Set.add.{u1} α (AddZeroClass.toAdd.{u1} α (AddMonoid.toAddZeroClass.{u1} α _inst_1)))) s t)) (HAdd.hAdd.{u1, u1, u1} (Set.{u1} α) (Set.{u1} α) (Set.{u1} α) (instHAdd.{u1} (Set.{u1} α) (Set.add.{u1} α (AddZeroClass.toAdd.{u1} α (AddMonoid.toAddZeroClass.{u1} α _inst_1)))) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toStar.{u1} α (StarAddMonoid.toInvolutiveStar.{u1} α _inst_1 _inst_2))) s) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toStar.{u1} α (StarAddMonoid.toInvolutiveStar.{u1} α _inst_1 _inst_2))) t))
Case conversion may be inaccurate. Consider using '#align set.star_add Set.star_addₓ'. -/
protected theorem star_add [AddMonoid α] [StarAddMonoid α] (s t : Set α) : (s + t)⋆ = s⋆ + t⋆ := by
  simp_rw [← image_star, ← image2_add, image_image2, image2_image_left, image2_image_right,
    star_add]
#align set.star_add Set.star_add

@[simp]
instance [Star α] [TrivialStar α] : TrivialStar (Set α)
    where star_trivial s := by
    rw [← star_preimage]
    ext1
    simp [star_trivial]

/- warning: set.star_inv -> Set.star_inv is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Group.{u1} α] [_inst_2 : StarSemigroup.{u1} α (Monoid.toSemigroup.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1)))] (s : Set.{u1} α), Eq.{succ u1} (Set.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toHasStar.{u1} α (StarSemigroup.toHasInvolutiveStar.{u1} α (Monoid.toSemigroup.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1))) _inst_2))) (Inv.inv.{u1} (Set.{u1} α) (Set.inv.{u1} α (DivInvMonoid.toHasInv.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1))) s)) (Inv.inv.{u1} (Set.{u1} α) (Set.inv.{u1} α (DivInvMonoid.toHasInv.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1))) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toHasStar.{u1} α (StarSemigroup.toHasInvolutiveStar.{u1} α (Monoid.toSemigroup.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1))) _inst_2))) s))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : Group.{u1} α] [_inst_2 : StarSemigroup.{u1} α (Monoid.toSemigroup.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1)))] (s : Set.{u1} α), Eq.{succ u1} (Set.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toStar.{u1} α (StarSemigroup.toInvolutiveStar.{u1} α (Monoid.toSemigroup.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1))) _inst_2))) (Inv.inv.{u1} (Set.{u1} α) (Set.inv.{u1} α (InvOneClass.toInv.{u1} α (DivInvOneMonoid.toInvOneClass.{u1} α (DivisionMonoid.toDivInvOneMonoid.{u1} α (Group.toDivisionMonoid.{u1} α _inst_1))))) s)) (Inv.inv.{u1} (Set.{u1} α) (Set.inv.{u1} α (InvOneClass.toInv.{u1} α (DivInvOneMonoid.toInvOneClass.{u1} α (DivisionMonoid.toDivInvOneMonoid.{u1} α (Group.toDivisionMonoid.{u1} α _inst_1))))) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toStar.{u1} α (StarSemigroup.toInvolutiveStar.{u1} α (Monoid.toSemigroup.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1))) _inst_2))) s))
Case conversion may be inaccurate. Consider using '#align set.star_inv Set.star_invₓ'. -/
protected theorem star_inv [Group α] [StarSemigroup α] (s : Set α) : s⁻¹⋆ = s⋆⁻¹ :=
  by
  ext
  simp only [mem_star, mem_inv, star_inv]
#align set.star_inv Set.star_inv

/- warning: set.star_inv' -> Set.star_inv' is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DivisionSemiring.{u1} α] [_inst_2 : StarRing.{u1} α (Semiring.toNonUnitalSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1))] (s : Set.{u1} α), Eq.{succ u1} (Set.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toHasStar.{u1} α (StarAddMonoid.toHasInvolutiveStar.{u1} α (AddCommMonoid.toAddMonoid.{u1} α (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} α (NonUnitalSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonUnitalSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1))))) (StarRing.toStarAddMonoid.{u1} α (Semiring.toNonUnitalSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)) _inst_2)))) (Inv.inv.{u1} (Set.{u1} α) (Set.inv.{u1} α (DivInvMonoid.toHasInv.{u1} α (GroupWithZero.toDivInvMonoid.{u1} α (DivisionSemiring.toGroupWithZero.{u1} α _inst_1)))) s)) (Inv.inv.{u1} (Set.{u1} α) (Set.inv.{u1} α (DivInvMonoid.toHasInv.{u1} α (GroupWithZero.toDivInvMonoid.{u1} α (DivisionSemiring.toGroupWithZero.{u1} α _inst_1)))) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toHasStar.{u1} α (StarAddMonoid.toHasInvolutiveStar.{u1} α (AddCommMonoid.toAddMonoid.{u1} α (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} α (NonUnitalSemiring.toNonUnitalNonAssocSemiring.{u1} α (Semiring.toNonUnitalSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1))))) (StarRing.toStarAddMonoid.{u1} α (Semiring.toNonUnitalSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)) _inst_2)))) s))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DivisionSemiring.{u1} α] [_inst_2 : StarRing.{u1} α (Semiring.toNonUnitalSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1))] (s : Set.{u1} α), Eq.{succ u1} (Set.{u1} α) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toStar.{u1} α (StarAddMonoid.toInvolutiveStar.{u1} α (AddMonoidWithOne.toAddMonoid.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1))))) (StarRing.toStarAddMonoid.{u1} α (Semiring.toNonUnitalSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)) _inst_2)))) (Inv.inv.{u1} (Set.{u1} α) (Set.inv.{u1} α (DivisionSemiring.toInv.{u1} α _inst_1)) s)) (Inv.inv.{u1} (Set.{u1} α) (Set.inv.{u1} α (DivisionSemiring.toInv.{u1} α _inst_1)) (Star.star.{u1} (Set.{u1} α) (Set.star.{u1} α (InvolutiveStar.toStar.{u1} α (StarAddMonoid.toInvolutiveStar.{u1} α (AddMonoidWithOne.toAddMonoid.{u1} α (AddCommMonoidWithOne.toAddMonoidWithOne.{u1} α (NonAssocSemiring.toAddCommMonoidWithOne.{u1} α (Semiring.toNonAssocSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1))))) (StarRing.toStarAddMonoid.{u1} α (Semiring.toNonUnitalSemiring.{u1} α (DivisionSemiring.toSemiring.{u1} α _inst_1)) _inst_2)))) s))
Case conversion may be inaccurate. Consider using '#align set.star_inv' Set.star_inv'ₓ'. -/
protected theorem star_inv' [DivisionSemiring α] [StarRing α] (s : Set α) : s⁻¹⋆ = s⋆⁻¹ :=
  by
  ext
  simp only [mem_star, mem_inv, star_inv']
#align set.star_inv' Set.star_inv'

end Set


import tactic

namespace modal_logic

class has_acc (World : Type*) :=
  (acc : World → World → Prop)

infix ` ≺ `:80 := has_acc.acc

/--
`world` provides a definition of `World` and `MProp`.
An instance can be created to work with a specific type,
or it can be used as a parameter, when the type of `World` does not matter.
-/

class world :=
  (World : Type*)

def World [world] := world.World
def MProp [world] := World → Prop

/--
`modal_frame` provides a definition of `≺`.
-/

class modal_frame extends world, has_acc World

variables [_modal_frame : modal_frame] (w : World) (p q : MProp)

def sat : Prop := p w
infix ` ⊩ `:29 := sat
def not : MProp := λ w, ¬(w ⊩ p)
prefix `¬` := not
def imp : MProp := λ w, w ⊩ p → w ⊩ q
infixr ` ⇒ ` := imp
def iff : MProp := λ w, w ⊩ p ↔ w ⊩ q
infixr ` ⇔ `:39 := iff
def and : MProp := λ w, (w ⊩ p) ∧ (w ⊩ q)
infixr ` ∧ ` := and
def or : MProp := λ w, (w ⊩ p) ∨ (w ⊩ q)
infixr ` ∨ ` := or
def nec : MProp := λ w, ∀ v, w ≺ v → v ⊩ p
prefix `□`:90 := nec
def poss : MProp := λ w, ∃ v, w ≺ v ∧ (v ⊩ p)
prefix `◇`:90 := poss

@[ext] lemma mpropext [modal_frame] {p q : MProp} : (∀ w : World, w ⊩ p ⇔ q) → p = q :=
begin
  intros h,
  ext w,
  apply h,
end

end modal_logic


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

/-!
# Definitions of group actions

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

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

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

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

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

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

## Notation

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

## Implementation details

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

## Tags

group action
-/

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

open function (injective surjective)

/-!
### Faithful actions
-/

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

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

export has_faithful_smul (eq_of_smul_eq_smul) has_faithful_vadd (eq_of_vadd_eq_vadd)

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

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

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

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

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

/-!
### (Pre)transitive action

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

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

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

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

namespace mul_action

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

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

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

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

end mul_action

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

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

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

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

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

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

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

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

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

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

/-- An instance of `vadd_assoc_class M N α` states that the additive action of `M` on `α` is
determined by the additive actions of `M` on `N` and `N` on `α`. -/
class vadd_assoc_class (M N α : Type*) [has_vadd M N] [has_vadd N α] [has_vadd M α] : Prop :=
(vadd_assoc : ∀ (x : M) (y : N) (z : α), (x +ᵥ y) +ᵥ z = x +ᵥ (y +ᵥ z))

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

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

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

/-- A typeclass indicating that the right (aka `add_opposite`) and left actions by `M` on `α` are
equal, that is that `M` acts centrally on `α`. This can be thought of as a version of commutativity
for `+ᵥ`. -/
class is_central_vadd (M α : Type*) [has_vadd M α] [has_vadd Mᵃᵒᵖ α] : Prop :=
(op_vadd_eq_vadd : ∀ (m : M) (a : α), add_opposite.op m +ᵥ a = m +ᵥ a)

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

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

export is_central_vadd (op_vadd_eq_vadd unop_vadd_eq_vadd)
export is_central_scalar (op_smul_eq_smul unop_smul_eq_smul)

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

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

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

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

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

namespace has_smul
variables [has_smul M α]

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

variables (α)

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

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

variables {α}

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

This cannot be an instance because it can cause infinite loops whenever the `has_smul` arguments
are still metavariables.
-/
@[priority 100, to_additive "Given a tower of additive actions `M → α → β`, if we use
`has_smul.comp` to pull back both of `M`'s actions by a map `g : N → M`, then we obtain a new tower
of scalar actions `N → α → β`.

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

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

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

end has_smul

section

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

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

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

variables [has_smul M α]

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

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

end

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

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

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

end ite

section
variables [monoid M] [mul_action M α]

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

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

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

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

variables {M}

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

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

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

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

section

variables (M)

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

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

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

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

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

variables {M}

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

end

namespace mul_action

variables (M α)

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

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

variables {M α}

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

variable (α)

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

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

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

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

end mul_action

end

section compatible_scalar

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

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

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

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

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

/-- If the multiplicative action of `M` on `N` is compatible with multiplication on `N`, then
`λ x, x • 1` is a monoid homomorphism from `M` to `N`. -/
@[to_additive "If the additive action of `M` on `N` is compatible with addition on `N`, then
`λ x, x +ᵥ 0` is an additive monoid homomorphism from `M` to `N`.", simps]
def smul_one_hom {M N} [monoid M] [monoid N] [mul_action M N] [is_scalar_tower M N N] :
  M →* N :=
{ to_fun := λ x, x • 1,
  map_one' := one_smul _ _,
  map_mul' := λ x y, by rw [smul_one_mul, smul_smul] }

end compatible_scalar

/-- Typeclass for scalar multiplication that preserves `0` on the right. -/
class smul_zero_class (M A : Type*) [has_zero A] extends has_smul M A :=
(smul_zero : ∀ (a : M), a • (0 : A) = 0)

section smul_zero

variables [has_zero A] [smul_zero_class M A]

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

/-- Pullback a zero-preserving scalar multiplication along an injective zero-preserving map.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.smul_zero_class [has_zero B] [has_smul M B] (f : zero_hom B A)
  (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  smul_zero_class M B :=
{ smul := (•),
  smul_zero := λ c, hf $ by simp only [smul, map_zero, smul_zero] }

/-- Pushforward a zero-preserving scalar multiplication along a zero-preserving map.
See note [reducible non-instances]. -/
@[reducible]
protected def zero_hom.smul_zero_class [has_zero B] [has_smul M B] (f : zero_hom A B)
  (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  smul_zero_class M B :=
{ smul := (•),
  smul_zero := λ c, by simp only [← map_zero f, ← smul, smul_zero] }

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

See also `function.surjective.distrib_mul_action_left`.
-/
@[reducible]
def function.surjective.smul_zero_class_left {R S M : Type*} [has_zero M] [smul_zero_class R M]
  [has_smul S M] (f : R → S) (hf : function.surjective f) (hsmul : ∀ c (x : M), f c • x = c • x) :
  smul_zero_class S M :=
{ smul := (•),
  smul_zero := hf.forall.mpr $ λ c, by rw [hsmul, smul_zero] }

variable (A)

/-- Compose a `smul_zero_class` with a function, with scalar multiplication `f r' • m`.
See note [reducible non-instances]. -/
@[reducible] def smul_zero_class.comp_fun (f : N → M) :
  smul_zero_class N A :=
{ smul := has_smul.comp.smul f,
  smul_zero := λ x, smul_zero (f x) }

/-- Each element of the scalars defines a zero-preserving map. -/
@[simps]
def smul_zero_class.to_zero_hom (x : M) : zero_hom A A :=
{ to_fun := (•) x,
  map_zero' := smul_zero x }

end smul_zero

/-- Typeclass for scalar multiplication that preserves `0` and `+` on the right.

This is exactly `distrib_mul_action` without the `mul_action` part.
-/
@[ext] class distrib_smul (M A : Type*) [add_zero_class A]
  extends smul_zero_class M A :=
(smul_add : ∀ (a : M) (x y : A), a • (x + y) = a • x + a • y)

section distrib_smul

variables [add_zero_class A] [distrib_smul M A]

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

/-- Pullback a distributive scalar multiplication along an injective additive monoid
homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.injective.distrib_smul [add_zero_class B] [has_smul M B] (f : B →+ A)
  (hf : injective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  distrib_smul M B :=
{ smul := (•),
  smul_add := λ c x y, hf $ by simp only [smul, map_add, smul_add],
  .. hf.smul_zero_class f.to_zero_hom smul }

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

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

See also `function.surjective.distrib_mul_action_left`.
-/
@[reducible]
def function.surjective.distrib_smul_left {R S M : Type*} [add_zero_class M] [distrib_smul R M]
  [has_smul S M] (f : R → S) (hf : function.surjective f) (hsmul : ∀ c (x : M), f c • x = c • x) :
  distrib_smul S M :=
{ smul := (•),
  smul_add := hf.forall.mpr $ λ c x y, by simp only [hsmul, smul_add],
  .. hf.smul_zero_class_left f hsmul }

variable (A)

/-- Compose a `distrib_smul` with a function, with scalar multiplication `f r' • m`.
See note [reducible non-instances]. -/
@[reducible] def distrib_smul.comp_fun (f : N → M) :
  distrib_smul N A :=
{ smul := has_smul.comp.smul f,
  smul_add := λ x, smul_add (f x),
  .. smul_zero_class.comp_fun A f }

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

end distrib_smul

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

section

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

@[priority 100] -- See note [lower instance priority]
instance distrib_mul_action.to_distrib_smul : distrib_smul M A :=
{ ..‹distrib_mul_action M A› }

/-! Since Lean 3 does not have definitional eta for structures, we have to make sure
that the definition of `distrib_mul_action.to_distrib_smul` was done correctly,
and the two paths from `distrib_mul_action` to `has_smul` are indeed definitionally equal. -/
example : (distrib_mul_action.to_mul_action.to_has_smul : has_smul M A) =
  distrib_mul_action.to_distrib_smul.to_has_smul := rfl

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

/-- Pushforward a distributive multiplicative action along a surjective additive monoid
homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def function.surjective.distrib_mul_action [add_monoid B] [has_smul M B] (f : A →+ B)
  (hf : surjective f) (smul : ∀ (c : M) x, f (c • x) = c • f x) :
  distrib_mul_action M B :=
{ smul := (•),
  .. hf.distrib_smul f smul,
  .. hf.mul_action f smul }

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

See also `function.surjective.mul_action_left` and `function.surjective.module_left`.
-/
@[reducible]
def function.surjective.distrib_mul_action_left {R S M : Type*} [monoid R] [add_monoid M]
  [distrib_mul_action R M] [monoid S] [has_smul S M]
  (f : R →* S) (hf : function.surjective f) (hsmul : ∀ c (x : M), f c • x = c • x) :
  distrib_mul_action S M :=
{ smul := (•),
  .. hf.distrib_smul_left f hsmul,
  .. hf.mul_action_left f hsmul }

variable (A)

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

/-- Each element of the monoid defines a additive monoid homomorphism. -/
@[simps]
def distrib_mul_action.to_add_monoid_hom (x : M) : A →+ A :=
distrib_smul.to_add_monoid_hom A x

variables (M)

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

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

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

end

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

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

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

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

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

end

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

export mul_distrib_mul_action (smul_one)

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

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

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

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

variable (A)

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

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

variable {A}

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

variables (M A)

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

end

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

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

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

end

variable (α)

/-- The monoid of endomorphisms.

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

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

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

variable {α}

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

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

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

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

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

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

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

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

/-- The monoid hom representing a monoid action.

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

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

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

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

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

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

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

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

/-! ### `additive`, `multiplicative` -/

section

open additive multiplicative

instance additive.has_vadd [has_smul α β] : has_vadd (additive α) β := ⟨λ a, (•) (to_mul a)⟩
instance multiplicative.has_smul [has_vadd α β] : has_smul (multiplicative α) β :=
⟨λ a, (+ᵥ) (to_add a)⟩

@[simp] lemma to_mul_smul [has_smul α β] (a) (b : β) : (to_mul a : α) • b = a +ᵥ b := rfl
@[simp] lemma of_mul_vadd [has_smul α β] (a : α) (b : β) : of_mul a +ᵥ b = a • b := rfl
@[simp] lemma to_add_vadd [has_vadd α β] (a) (b : β) : (to_add a : α) +ᵥ b = a • b := rfl
@[simp] lemma of_add_smul [has_vadd α β] (a : α) (b : β) : of_add a • b = a +ᵥ b := rfl

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

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

instance additive.add_action_is_pretransitive [monoid α] [mul_action α β]
  [mul_action.is_pretransitive α β] : add_action.is_pretransitive (additive α) β :=
⟨@mul_action.exists_smul_eq α _ _ _⟩

instance multiplicative.add_action_is_pretransitive [add_monoid α] [add_action α β]
  [add_action.is_pretransitive α β] : mul_action.is_pretransitive (multiplicative α) β :=
⟨@add_action.exists_vadd_eq α _ _ _⟩

instance additive.vadd_comm_class [has_smul α γ] [has_smul β γ] [smul_comm_class α β γ] :
  vadd_comm_class (additive α) (additive β) γ :=
⟨@smul_comm α β _ _ _ _⟩

instance multiplicative.smul_comm_class [has_vadd α γ] [has_vadd β γ] [vadd_comm_class α β γ] :
  smul_comm_class (multiplicative α) (multiplicative β) γ :=
⟨@vadd_comm α β _ _ _ _⟩

end