import Std

inductive Expr where
  | var (i : Nat)
  | op  (lhs rhs : Expr)
  deriving Inhabited, Repr

def List.getIdx : List α → Nat → α → α
  | [],    i,   u => u
  | a::as, 0,   u => a
  | a::as, i+1, u => getIdx as i u

structure Context (α : Type u) where
  op    : α → α → α
  unit  : α
  assoc : (a b c : α) → op (op a b) c = op a (op b c)
  comm  : (a b : α) → op a b = op b a
  vars  : List α

theorem Context.left_comm (ctx : Context α) (a b c : α) : ctx.op a (ctx.op b c) = ctx.op b (ctx.op a c) := by
  rw [← ctx.assoc, ctx.comm a b, ctx.assoc]

def Expr.denote (ctx : Context α) : Expr → α
  | Expr.op a b => ctx.op (denote ctx a) (denote ctx b)
  | Expr.var i  => ctx.vars.getIdx i ctx.unit

theorem Expr.denote_op (ctx : Context α) (a b : Expr) : denote ctx (Expr.op a b) = ctx.op (denote ctx a) (denote ctx b) :=
  rfl

def Expr.length : Expr → Nat
  | op a b => 1 + b.length
  | _      => 1

def Expr.sort (e : Expr) : Expr :=
  loop e.length e
where
  loop : Nat → Expr → Expr
  | fuel+1, Expr.op a e =>
    let (e₁, e₂) := swap a e
    Expr.op e₁ (loop fuel e₂)
  | _, e => e

  swap : Expr → Expr → Expr × Expr
  | Expr.var i, Expr.op (Expr.var j) e =>
    if i > j then
      let (e₁, e₂) := swap (Expr.var j) e
      (e₁, Expr.op (Expr.var i) e₂)
    else
      let (e₁, e₂) := swap (Expr.var i) e
      (e₁, Expr.op (Expr.var j) e₂)
  | Expr.var i, Expr.var j =>
    if i > j then
      (Expr.var j, Expr.var i)
    else
      (Expr.var i, Expr.var j)
  | e₁, e₂ => (e₁, e₂)

theorem Expr.denote_swap (ctx : Context α) (e₁ e₂ : Expr) : denote ctx (Expr.op (sort.swap e₁ e₂).1 (sort.swap e₁ e₂).2) = denote ctx (Expr.op e₁ e₂) := by
    induction e₂ generalizing e₁ with
    | op a b ih' ih =>
      cases e₁ with
      | var i =>
        have ih' := ih (var i)
        match h:sort.swap (var i) b with
        | (r₁, r₂) =>
          rw [denote_op _ (var i)] at ih'
          admit
      | _ => admit
    | _ => admit


/-
Copyright (c) 2022 Jeoff Lee. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeoff Lee
-/
import tactic.basic
import ring_theory.roots_of_unity
import ring_theory.polynomial.cyclotomic.basic

/-!
# The Solution of a Cubic

This file proves Theorem 37 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/).

In this file, we give the solutions to the cubic equation `a * x^3 + b * x^2 + c * x + d = 0`
over a field `K` that has characteristic neither 2 nor 3, that has a third primitive root of
unity, and in which certain other quantities admit square and cube roots.

This is based on the [Cardano's Formula](https://en.wikipedia.org/wiki/Cubic_equation#Cardano's_formula).

## Main statements

- `cubic_eq_zero_iff` : gives the roots of the cubic equation
where the discriminant `p = 3 * a * c - b^2` is nonzero.
- `cubic_eq_zero_iff_of_p_eq_zero` : gives the roots of the cubic equation
where the discriminant equals zero.

## References

Originally ported from Isabelle/HOL. The
[original file](https://isabelle.in.tum.de/dist/library/HOL/HOL-ex/Cubic_Quartic.html) was written by Amine Chaieb.

## Tags

polynomial, cubic, root
-/

section field

open polynomial

variables {K : Type*} [field K]
variables [invertible (2 : K)] [invertible (3 : K)]
variables (a b c d : K)
variables {ω p q r s t : K}

lemma cube_root_of_unity_sum (hω : is_primitive_root ω 3) : 1 + ω + ω^2 = 0 :=
begin
  convert is_root_cyclotomic (nat.succ_pos _) hω,
  rw [cyclotomic_eq_geom_sum nat.prime_three, eval_geom_sum],
  simp only [geom_sum_succ, geom_sum_zero],
  ring,
end

/-- The roots of a monic cubic whose quadratic term is zero and whose discriminant is nonzero. -/
lemma cubic_basic_eq_zero_iff
  (hω : is_primitive_root ω 3)
  (hp_nonzero : p ≠ 0)
  (hr : r^2 = q^2 + p^3)
  (hs3 : s^3 = q + r)
  (ht : t * s = p)
  (x : K) :
  x^3 + 3 * p * x - 2 * q = 0 ↔
    x = s       - t        ∨
    x = s * ω   - t * ω^2  ∨
    x = s * ω^2 - t * ω    :=
begin
  have h₁ : ∀ x a₁ a₂ a₃ : K, x = a₁ ∨ x = a₂ ∨ x = a₃ ↔ (x - a₁) * (x - a₂) * (x - a₃) = 0,
  { intros, simp only [mul_eq_zero, sub_eq_zero, or.assoc] },
  rw h₁,
  suffices : x ^ 3 + 3 * p * x - 2 * q
    = (x - (s - t)) * (x - (s * ω - t * ω^2)) * (x - (s * ω^2 - t * ω)),
  { rw this, },
  have hc : s^3 - t^3 = 2 * q,
  { have : s ≠ 0 := λ h, by { apply hp_nonzero, rw [h, mul_zero] at ht, exact ht.symm },
    have h_nonzero: q + r ≠ 0 := by { rw ← hs3, exact pow_ne_zero _ this },
    have hp3 : p^3 = r^2 - q^2 := by { rw hr, ring },
    calc    s^3 - t^3
          = s^3 - p^3/s^3 : by { rw [← ht], field_simp, ring }
      ... = (q+r) - (r^2-q^2)/(q+r) : by rw [hs3, hp3]
      ... = (q+r) + (q-r) * ((q+r) / (q+r)) : by ring
      ... = 2 * q : by { rw div_self h_nonzero, ring } },
  symmetry,
  calc (x - (s - t)) * (x - (s * ω - t * ω^2)) * (x - (s * ω^2 - t * ω))
      = x^3 - (s-t) * (1+ω+ω^2) * x^2
        + ((s^2+t^2)*ω*(1+ω+ω^2) - s*t*(-3 + 3*(1+ω+ω^2) + ω*(ω^3-1))) * x
        - (s^3-t^3)*ω^3 + s*t*(s-t)*ω^2*(1+ω+ω^2) : by ring
  ... = x^3 + 3*(t*s)*x - (s^3-t^3)
    : by { rw [hω.pow_eq_one, cube_root_of_unity_sum hω], ring }
  ... = x^3 + 3*p*x - 2*q : by rw [ht, hc]
end

/-- Roots of a monic cubic whose discriminant is nonzero. -/
lemma cubic_monic_eq_zero_iff
  (hω : is_primitive_root ω 3)
  (hp : p = (3 * c - b^2) / 9)
  (hp_nonzero : p ≠ 0)
  (hq : q = (9 * b * c - 2 * b^3 - 27 * d) / 54)
  (hr : r^2 = q^2 + p^3)
  (hs3 : s^3 = q + r)
  (ht : t * s = p)
  (x : K) :
  x^3 + b * x^2 + c * x + d = 0 ↔
    x = s       - t       - b / 3 ∨
    x = s * ω   - t * ω^2 - b / 3 ∨
    x = s * ω^2 - t * ω   - b / 3 :=
begin
  let y := x + b / 3,
  have hi2 : (2 : K) ≠ 0 := nonzero_of_invertible _,
  have hi3 : (3 : K) ≠ 0 := nonzero_of_invertible _,
  have h9 : (9 : K) = 3^2 := by norm_num,
  have h54 : (54 : K) = 2*3^3 := by norm_num,
  have h₁ : x^3 + b * x^2 + c * x + d = y^3 + 3 * p * y - 2 * q,
  { dsimp only [y],
    rw [hp, hq],
    field_simp [h9, h54], ring, },
  rw [h₁, cubic_basic_eq_zero_iff hω hp_nonzero hr hs3 ht y],
  dsimp only [y],
  simp_rw [eq_sub_iff_add_eq],
end

/-- **The Solution of Cubic**.
  The roots of a cubic polynomial whose discriminant is nonzero. -/
theorem cubic_eq_zero_iff (ha : a ≠ 0)
  (hω : is_primitive_root ω 3)
  (hp : p = (3 * a * c - b^2) / (9 * a^2))
  (hp_nonzero : p ≠ 0)
  (hq : q = (9 * a * b * c - 2 * b^3 - 27 * a^2 * d) / (54 * a^3))
  (hr : r^2 = q^2 + p^3)
  (hs3 : s^3 = q + r)
  (ht : t * s = p)
  (x : K) :
  a * x^3 + b * x^2 + c * x + d = 0 ↔
    x = s       - t       - b / (3 * a) ∨
    x = s * ω   - t * ω^2 - b / (3 * a) ∨
    x = s * ω^2 - t * ω   - b / (3 * a) :=
begin
  have hi2 : (2 : K) ≠ 0 := nonzero_of_invertible _,
  have hi3 : (3 : K) ≠ 0 := nonzero_of_invertible _,
  have h9 : (9 : K) = 3^2 := by norm_num,
  have h54 : (54 : K) = 2*3^3 := by norm_num,
  have h₁ : a * x^3 + b * x^2 + c * x + d = a * (x^3 + b/a * x^2 + c/a * x + d/a),
  { field_simp, ring },
  have h₂ : ∀ x, a * x = 0 ↔ x = 0, { intros x, simp [ha], },
  have hp' : p = (3 * (c/a) - (b/a) ^ 2) / 9, { field_simp [hp, h9], ring_nf },
  have hq' : q = (9 * (b/a) * (c/a) - 2 * (b/a) ^ 3 - 27 * (d/a)) / 54,
  { field_simp [hq, h54], ring_nf },
  rw [h₁, h₂, cubic_monic_eq_zero_iff (b/a) (c/a) (d/a) hω hp' hp_nonzero hq' hr hs3 ht x],
  have h₄ := calc b / a / 3 = b / (a * 3) : by { field_simp [ha] }
                        ... = b / (3 * a) : by rw mul_comm,
  rw [h₄],
end

/-- the solution of the cubic equation when p equals zero. -/
lemma cubic_eq_zero_iff_of_p_eq_zero (ha : a ≠ 0)
  (hω : is_primitive_root ω 3)
  (hpz : 3 * a * c - b^2 = 0)
  (hq : q = (9 * a * b * c - 2 * b^3 - 27 * a^2 * d) / (54 * a^3))
  (hs3 : s^3 = 2 * q)
  (x : K) :
  a * x^3 + b * x^2 + c * x + d = 0 ↔
    x = s       - b / (3 * a) ∨
    x = s * ω   - b / (3 * a) ∨
    x = s * ω^2 - b / (3 * a) :=
begin
  have h₁ : ∀ x a₁ a₂ a₃ : K, x = a₁ ∨ x = a₂ ∨ x = a₃ ↔ (x - a₁) * (x - a₂) * (x - a₃) = 0,
  { intros, simp only [mul_eq_zero, sub_eq_zero, or.assoc] },
  have hi2 : (2 : K) ≠ 0 := nonzero_of_invertible _,
  have hi3 : (3 : K) ≠ 0 := nonzero_of_invertible _,
  have h54 : (54 : K) = 2*3^3 := by norm_num,
  have hb2 : b^2 = 3 * a * c, { rw sub_eq_zero at hpz, rw hpz },
  have hb3 : b^3 = 3 * a * b * c, { rw [pow_succ, hb2], ring },
  have h₂ :=
    calc  a * x^3 + b * x^2 + c * x + d
        = a * (x + b/(3*a))^3 + (c - b^2/(3*a)) * x + (d - b^3*a/(3*a)^3)
          : by { field_simp, ring }
    ... = a * (x + b/(3*a))^3 + (d - (9*a*b*c-2*b^3)*a/(3*a)^3)
          : by { simp only [hb2, hb3], field_simp, ring }
    ... = a * ((x + b/(3*a))^3 - s^3)
          : by { rw [hs3, hq], field_simp [h54], ring, },
  have h₃ : ∀ x, a * x = 0 ↔ x = 0, { intro x, simp [ha] },
  have h₄ : ∀ x : K, x^3 - s^3 = (x - s) * (x - s * ω) * (x - s * ω^2),
  { intro x,
    calc  x^3 - s^3
        = (x - s) * (x^2 + x*s + s^2) : by ring
    ... = (x - s) * (x^2 - (ω+ω^2)*x*s + (1+ω+ω^2)*x*s + s^2) : by ring
    ... = (x - s) * (x^2 - (ω+ω^2)*x*s + ω^3*s^2)
        : by { rw [hω.pow_eq_one, cube_root_of_unity_sum hω], simp, }
    ... = (x - s) * (x - s * ω) * (x - s * ω^2) : by ring },
  rw [h₁, h₂, h₃, h₄ (x + b/(3*a))],
  ring_nf,
end

end field


import tactic.abel
variables {α : Type*} {a b : α}

example [add_comm_monoid α] : a + (b + a) = a + a + b := by abel
example [add_comm_group α] : (a + b) - ((b + a) + a) = -a := by abel
example [add_comm_group α] (x : α) : x - 0 = x := by abel
example [add_comm_monoid α] (x : α) : (3 : ℕ) • a = a + (2 : ℕ) • a := by abel
example [add_comm_group α] : (3 : ℤ) • a = a + (2 : ℤ) • a := by abel
example [add_comm_group α] (a b : α) : a-2•b = a -2•b := by abel

-- `abel!` should see through terms that are definitionally equal,
def id' (x : α) := x
example [add_comm_group α] : a + b - b - id' a = 0 :=
begin
  success_if_fail { abel; done },
  abel!
end


/-
Copyright (c) 2021 Jordan Brown, Thomas Browning and Patrick Lutz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jordan Brown, Thomas Browning and Patrick Lutz
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.abelianization
import Mathlib.data.bracket
import Mathlib.PostPort

universes u_1 u_2 l

namespace Mathlib

/-!
# Solvable Groups

In this file we introduce the notion of a solvable group. We define a solvable group as one whose
derived series is eventually trivial. This requires defining the commutator of two subgroups and
the derived series of a group.

## Main definitions

* `general_commutator H₁ H₂` : the commutator of the subgroups `H₁` and `H₂`
* `derived_series G n` : the `n`th term in the derived series of `G`, defined by iterating
  `general_commutator` starting with the top subgroup
* `is_solvable G` : the group `G` is solvable
-/

/-- The commutator of two subgroups `H₁` and `H₂`. -/
protected instance general_commutator {G : Type u_1} [group G] : has_bracket (subgroup G) (subgroup G) :=
  has_bracket.mk
    fun (H₁ H₂ : subgroup G) =>
      subgroup.closure
        (set_of fun (x : G) => ∃ (p : G), ∃ (H : p ∈ H₁), ∃ (q : G), ∃ (H : q ∈ H₂), p * q * (p⁻¹) * (q⁻¹) = x)

theorem general_commutator_def {G : Type u_1} [group G] (H₁ : subgroup G) (H₂ : subgroup G) : has_bracket.bracket H₁ H₂ =
  subgroup.closure
    (set_of fun (x : G) => ∃ (p : G), ∃ (H : p ∈ H₁), ∃ (q : G), ∃ (H : q ∈ H₂), p * q * (p⁻¹) * (q⁻¹) = x) :=
  rfl

protected instance general_commutator_normal {G : Type u_1} [group G] (H₁ : subgroup G) (H₂ : subgroup G) [h₁ : subgroup.normal H₁] [h₂ : subgroup.normal H₂] : subgroup.normal (has_bracket.bracket H₁ H₂) := sorry

theorem general_commutator_mono {G : Type u_1} [group G] {H₁ : subgroup G} {H₂ : subgroup G} {K₁ : subgroup G} {K₂ : subgroup G} (h₁ : H₁ ≤ K₁) (h₂ : H₂ ≤ K₂) : has_bracket.bracket H₁ H₂ ≤ has_bracket.bracket K₁ K₂ := sorry

theorem general_commutator_def' {G : Type u_1} [group G] (H₁ : subgroup G) (H₂ : subgroup G) [subgroup.normal H₁] [subgroup.normal H₂] : has_bracket.bracket H₁ H₂ =
  subgroup.normal_closure
    (set_of fun (x : G) => ∃ (p : G), ∃ (H : p ∈ H₁), ∃ (q : G), ∃ (H : q ∈ H₂), p * q * (p⁻¹) * (q⁻¹) = x) := sorry

theorem general_commutator_le {G : Type u_1} [group G] (H₁ : subgroup G) (H₂ : subgroup G) (K : subgroup G) : has_bracket.bracket H₁ H₂ ≤ K ↔ ∀ (p : G), p ∈ H₁ → ∀ (q : G), q ∈ H₂ → p * q * (p⁻¹) * (q⁻¹) ∈ K := sorry

theorem general_commutator_comm {G : Type u_1} [group G] (H₁ : subgroup G) (H₂ : subgroup G) : has_bracket.bracket H₁ H₂ = has_bracket.bracket H₂ H₁ := sorry

theorem general_commutator_le_right {G : Type u_1} [group G] (H₁ : subgroup G) (H₂ : subgroup G) [h : subgroup.normal H₂] : has_bracket.bracket H₁ H₂ ≤ H₂ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (has_bracket.bracket H₁ H₂ ≤ H₂)) (propext (general_commutator_le H₁ H₂ H₂))))
    fun (p : G) (hp : p ∈ H₁) (q : G) (hq : q ∈ H₂) =>
      subgroup.mul_mem H₂ (subgroup.normal.conj_mem h q hq p) (subgroup.inv_mem H₂ hq)

theorem general_commutator_le_left {G : Type u_1} [group G] (H₁ : subgroup G) (H₂ : subgroup G) [h : subgroup.normal H₁] : has_bracket.bracket H₁ H₂ ≤ H₁ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (has_bracket.bracket H₁ H₂ ≤ H₁)) (general_commutator_comm H₁ H₂)))
    (general_commutator_le_right H₂ H₁)

@[simp] theorem general_commutator_bot {G : Type u_1} [group G] (H : subgroup G) : has_bracket.bracket H ⊥ = ⊥ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (has_bracket.bracket H ⊥ = ⊥)) (propext eq_bot_iff))) (general_commutator_le_right H ⊥)

@[simp] theorem bot_general_commutator {G : Type u_1} [group G] (H : subgroup G) : has_bracket.bracket ⊥ H = ⊥ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (has_bracket.bracket ⊥ H = ⊥)) (propext eq_bot_iff))) (general_commutator_le_left ⊥ H)

theorem general_commutator_le_inf {G : Type u_1} [group G] (H₁ : subgroup G) (H₂ : subgroup G) [subgroup.normal H₁] [subgroup.normal H₂] : has_bracket.bracket H₁ H₂ ≤ H₁ ⊓ H₂ := sorry

/-- The derived series of the group `G`, obtained by starting from the subgroup `⊤` and repeatedly
  taking the commutator of the previous subgroup with itself for `n` times. -/
def derived_series (G : Type u_1) [group G] : ℕ → subgroup G :=
  sorry

@[simp] theorem derived_series_zero (G : Type u_1) [group G] : derived_series G 0 = ⊤ :=
  rfl

@[simp] theorem derived_series_succ (G : Type u_1) [group G] (n : ℕ) : derived_series G (n + 1) = has_bracket.bracket (derived_series G n) (derived_series G n) :=
  rfl

theorem derived_series_normal (G : Type u_1) [group G] (n : ℕ) : subgroup.normal (derived_series G n) := sorry

@[simp] theorem general_commutator_eq_commutator (G : Type u_1) [group G] : has_bracket.bracket ⊤ ⊤ = commutator G := sorry

theorem commutator_def' (G : Type u_1) [group G] : commutator G = subgroup.closure (set_of fun (x : G) => ∃ (p : G), ∃ (q : G), p * q * (p⁻¹) * (q⁻¹) = x) := sorry

@[simp] theorem derived_series_one (G : Type u_1) [group G] : derived_series G 1 = commutator G :=
  general_commutator_eq_commutator G

theorem map_commutator_eq_commutator_map {G : Type u_1} [group G] {G' : Type u_2} [group G'] {f : G →* G'} (H₁ : subgroup G) (H₂ : subgroup G) : subgroup.map f (has_bracket.bracket H₁ H₂) = has_bracket.bracket (subgroup.map f H₁) (subgroup.map f H₂) := sorry

theorem commutator_le_map_commutator {G : Type u_1} [group G] {G' : Type u_2} [group G'] {f : G →* G'} {H₁ : subgroup G} {H₂ : subgroup G} {K₁ : subgroup G'} {K₂ : subgroup G'} (h₁ : K₁ ≤ subgroup.map f H₁) (h₂ : K₂ ≤ subgroup.map f H₂) : has_bracket.bracket K₁ K₂ ≤ subgroup.map f (has_bracket.bracket H₁ H₂) := sorry

theorem map_derived_series_le_derived_series {G : Type u_1} [group G] {G' : Type u_2} [group G'] (f : G →* G') (n : ℕ) : subgroup.map f (derived_series G n) ≤ derived_series G' n := sorry

theorem derived_series_le_map_derived_series {G : Type u_1} [group G] {G' : Type u_2} [group G'] {f : G →* G'} (hf : function.surjective ⇑f) (n : ℕ) : derived_series G' n ≤ subgroup.map f (derived_series G n) := sorry

theorem map_derived_series_eq {G : Type u_1} [group G] {G' : Type u_2} [group G'] {f : G →* G'} (hf : function.surjective ⇑f) (n : ℕ) : subgroup.map f (derived_series G n) = derived_series G' n :=
  le_antisymm (map_derived_series_le_derived_series f n) (derived_series_le_map_derived_series hf n)

/-- A group `G` is solvable if its derived series is eventually trivial. We use this definition
  because it's the most convenient one to work with. -/
class is_solvable (G : Type u_1) [group G]
where
  solvable : ∃ (n : ℕ), derived_series G n = ⊥

theorem is_solvable_def (G : Type u_1) [group G] : is_solvable G ↔ ∃ (n : ℕ), derived_series G n = ⊥ :=
  { mp := fun (h : is_solvable G) => is_solvable.solvable,
    mpr := fun (h : ∃ (n : ℕ), derived_series G n = ⊥) => is_solvable.mk h }

protected instance is_solvable_of_comm {G : Type u_1} [comm_group G] : is_solvable G :=
  is_solvable.mk
    (Exists.intro 1
      (id
        (eq.mpr (id (Eq._oldrec (Eq.refl (derived_series G 1 = ⊥)) (propext eq_bot_iff)))
          (eq.mpr (id (Eq._oldrec (Eq.refl (derived_series G 1 ≤ ⊥)) (derived_series_one G)))
            (trans_rel_left LessEq (abelianization.commutator_subset_ker (monoid_hom.id G)) rfl)))))

theorem is_solvable_of_top_eq_bot (G : Type u_1) [group G] (h : ⊤ = ⊥) : is_solvable G := sorry

protected instance is_solvable_of_subsingleton (G : Type u_1) [group G] [subsingleton G] : is_solvable G :=
  is_solvable_of_top_eq_bot G
    (subgroup.ext
      fun (x : G) =>
        eq.mpr
          (id
            (Eq.trans
              ((fun (a a_1 : Prop) (e_1 : a = a_1) (b b_1 : Prop) (e_2 : b = b_1) => congr (congr_arg Iff e_1) e_2)
                (x ∈ ⊤) True (propext ((fun {G : Type u_1} (x : G) => iff_true_intro (subgroup.mem_top x)) x)) (x ∈ ⊥)
                True (Eq.trans (propext subgroup.mem_bot) (propext (eq_iff_true_of_subsingleton x 1))))
              (propext (iff_self True))))
          trivial)

theorem solvable_of_solvable_injective {G : Type u_1} [group G] {G' : Type u_2} [group G'] {f : G →* G'} (hf : function.injective ⇑f) [h : is_solvable G'] : is_solvable G := sorry

protected instance subgroup_solvable_of_solvable {G : Type u_1} [group G] (H : subgroup G) [h : is_solvable G] : is_solvable ↥H :=
  solvable_of_solvable_injective ((fun (this : function.injective ⇑(subgroup.subtype H)) => this) subtype.val_injective)

theorem solvable_of_surjective {G : Type u_1} [group G] {G' : Type u_2} [group G'] {f : G →* G'} (hf : function.surjective ⇑f) [h : is_solvable G] : is_solvable G' := sorry

protected instance solvable_quotient_of_solvable {G : Type u_1} [group G] (H : subgroup G) [subgroup.normal H] [h : is_solvable G] : is_solvable (quotient_group.quotient H) :=
  solvable_of_surjective
    ((fun (this : function.surjective ⇑(quotient_group.mk' H)) => this)
      (id
        fun (b : quotient_group.quotient H) =>
          quot.rec (fun (b : G) => Exists.intro b (Eq.refl (coe_fn (quotient_group.mk' H) b)))
            (fun (b_a b_b : G) (b_p : setoid.r b_a b_b) =>
              Eq.refl (Eq._oldrec (Exists.intro b_a (Eq.refl (coe_fn (quotient_group.mk' H) b_a))) (quot.sound b_p)))
            b))


/-
Copyright (c) 2021 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa

! This file was ported from Lean 3 source module algebra.smul_with_zero
! leanprover-community/mathlib commit dc17b6ac53b111affde68d96e5e7a0726816e2cf
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.GroupPower.Basic
import Mathbin.Algebra.Ring.Opposite
import Mathbin.GroupTheory.GroupAction.Opposite
import Mathbin.GroupTheory.GroupAction.Prod

/-!
# Introduce `smul_with_zero`

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

In analogy with the usual monoid action on a Type `M`, we introduce an action of a
`monoid_with_zero` on a Type with `0`.

In particular, for Types `R` and `M`, both containing `0`, we define `smul_with_zero R M` to
be the typeclass where the products `r • 0` and `0 • m` vanish for all `r : R` and all `m : M`.

Moreover, in the case in which `R` is a `monoid_with_zero`, we introduce the typeclass
`mul_action_with_zero R M`, mimicking group actions and having an absorbing `0` in `R`.
Thus, the action is required to be compatible with

* the unit of the monoid, acting as the identity;
* the zero of the monoid_with_zero, acting as zero;
* associativity of the monoid.

We also add an `instance`:

* any `monoid_with_zero` has a `mul_action_with_zero R R` acting on itself.

## Main declarations

* `smul_monoid_with_zero_hom`: Scalar multiplication bundled as a morphism of monoids with zero.
-/

variable {R R' M M' : Type _}

section Zero

variable (R M)

#print SMulWithZero /-
/-- `smul_with_zero` is a class consisting of a Type `R` with `0 ∈ R` and a scalar multiplication
of `R` on a Type `M` with `0`, such that the equality `r • m = 0` holds if at least one among `r`
or `m` equals `0`. -/
class SMulWithZero [Zero R] [Zero M] extends SMulZeroClass R M where
  zero_smul : ∀ m : M, (0 : R) • m = 0
#align smul_with_zero SMulWithZero
-/

/- warning: mul_zero_class.to_smul_with_zero -> MulZeroClass.toSMulWithZero is a dubious translation:
lean 3 declaration is
  forall (R : Type.{u1}) [_inst_1 : MulZeroClass.{u1} R], SMulWithZero.{u1, u1} R R (MulZeroClass.toHasZero.{u1} R _inst_1) (MulZeroClass.toHasZero.{u1} R _inst_1)
but is expected to have type
  forall (R : Type.{u1}) [_inst_1 : MulZeroClass.{u1} R], SMulWithZero.{u1, u1} R R (MulZeroClass.toZero.{u1} R _inst_1) (MulZeroClass.toZero.{u1} R _inst_1)
Case conversion may be inaccurate. Consider using '#align mul_zero_class.to_smul_with_zero MulZeroClass.toSMulWithZeroₓ'. -/
instance MulZeroClass.toSMulWithZero [MulZeroClass R] : SMulWithZero R R
    where
  smul := (· * ·)
  smul_zero := MulZeroClass.mul_zero
  zero_smul := MulZeroClass.zero_mul
#align mul_zero_class.to_smul_with_zero MulZeroClass.toSMulWithZero

/- warning: mul_zero_class.to_opposite_smul_with_zero -> MulZeroClass.toOppositeSMulWithZero is a dubious translation:
lean 3 declaration is
  forall (R : Type.{u1}) [_inst_1 : MulZeroClass.{u1} R], SMulWithZero.{u1, u1} (MulOpposite.{u1} R) R (MulOpposite.hasZero.{u1} R (MulZeroClass.toHasZero.{u1} R _inst_1)) (MulZeroClass.toHasZero.{u1} R _inst_1)
but is expected to have type
  forall (R : Type.{u1}) [_inst_1 : MulZeroClass.{u1} R], SMulWithZero.{u1, u1} (MulOpposite.{u1} R) R (MulOpposite.zero.{u1} R (MulZeroClass.toZero.{u1} R _inst_1)) (MulZeroClass.toZero.{u1} R _inst_1)
Case conversion may be inaccurate. Consider using '#align mul_zero_class.to_opposite_smul_with_zero MulZeroClass.toOppositeSMulWithZeroₓ'. -/
/-- Like `mul_zero_class.to_smul_with_zero`, but multiplies on the right. -/
instance MulZeroClass.toOppositeSMulWithZero [MulZeroClass R] : SMulWithZero Rᵐᵒᵖ R
    where
  smul := (· • ·)
  smul_zero r := MulZeroClass.zero_mul _
  zero_smul := MulZeroClass.mul_zero
#align mul_zero_class.to_opposite_smul_with_zero MulZeroClass.toOppositeSMulWithZero

variable (R) {M} [Zero R] [Zero M] [SMulWithZero R M]

#print zero_smul /-
@[simp]
theorem zero_smul (m : M) : (0 : R) • m = 0 :=
  SMulWithZero.zero_smul m
#align zero_smul zero_smul
-/

variable {R} {a : R} {b : M}

/- warning: smul_eq_zero_of_left -> smul_eq_zero_of_left is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} {M : Type.{u2}} [_inst_1 : Zero.{u1} R] [_inst_2 : Zero.{u2} M] [_inst_3 : SMulWithZero.{u1, u2} R M _inst_1 _inst_2] {a : R}, (Eq.{succ u1} R a (OfNat.ofNat.{u1} R 0 (OfNat.mk.{u1} R 0 (Zero.zero.{u1} R _inst_1)))) -> (forall (b : M), Eq.{succ u2} M (SMul.smul.{u1, u2} R M (SMulZeroClass.toHasSmul.{u1, u2} R M _inst_2 (SMulWithZero.toSmulZeroClass.{u1, u2} R M _inst_1 _inst_2 _inst_3)) a b) (OfNat.ofNat.{u2} M 0 (OfNat.mk.{u2} M 0 (Zero.zero.{u2} M _inst_2))))
but is expected to have type
  forall {R : Type.{u2}} {M : Type.{u1}} [_inst_1 : Zero.{u2} R] [_inst_2 : Zero.{u1} M] [_inst_3 : SMulWithZero.{u2, u1} R M _inst_1 _inst_2] {a : R}, (Eq.{succ u2} R a (OfNat.ofNat.{u2} R 0 (Zero.toOfNat0.{u2} R _inst_1))) -> (forall (b : M), Eq.{succ u1} M (HSMul.hSMul.{u2, u1, u1} R M M (instHSMul.{u2, u1} R M (SMulZeroClass.toSMul.{u2, u1} R M _inst_2 (SMulWithZero.toSMulZeroClass.{u2, u1} R M _inst_1 _inst_2 _inst_3))) a b) (OfNat.ofNat.{u1} M 0 (Zero.toOfNat0.{u1} M _inst_2)))
Case conversion may be inaccurate. Consider using '#align smul_eq_zero_of_left smul_eq_zero_of_leftₓ'. -/
theorem smul_eq_zero_of_left (h : a = 0) (b : M) : a • b = 0 :=
  h.symm ▸ zero_smul _ b
#align smul_eq_zero_of_left smul_eq_zero_of_left

#print smul_eq_zero_of_right /-
theorem smul_eq_zero_of_right (a : R) (h : b = 0) : a • b = 0 :=
  h.symm ▸ smul_zero a
#align smul_eq_zero_of_right smul_eq_zero_of_right
-/

#print left_ne_zero_of_smul /-
theorem left_ne_zero_of_smul : a • b ≠ 0 → a ≠ 0 :=
  mt fun h => smul_eq_zero_of_left h b
#align left_ne_zero_of_smul left_ne_zero_of_smul
-/

#print right_ne_zero_of_smul /-
theorem right_ne_zero_of_smul : a • b ≠ 0 → b ≠ 0 :=
  mt <| smul_eq_zero_of_right a
#align right_ne_zero_of_smul right_ne_zero_of_smul
-/

variable {R M} [Zero R'] [Zero M'] [SMul R M']

#print Function.Injective.smulWithZero /-
/-- Pullback a `smul_with_zero` structure along an injective zero-preserving homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def Function.Injective.smulWithZero (f : ZeroHom M' M) (hf : Function.Injective f)
    (smul : ∀ (a : R) (b), f (a • b) = a • f b) : SMulWithZero R M'
    where
  smul := (· • ·)
  zero_smul a := hf <| by simp [smul]
  smul_zero a := hf <| by simp [smul]
#align function.injective.smul_with_zero Function.Injective.smulWithZero
-/

#print Function.Surjective.smulWithZero /-
/-- Pushforward a `smul_with_zero` structure along a surjective zero-preserving homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def Function.Surjective.smulWithZero (f : ZeroHom M M') (hf : Function.Surjective f)
    (smul : ∀ (a : R) (b), f (a • b) = a • f b) : SMulWithZero R M'
    where
  smul := (· • ·)
  zero_smul m := by
    rcases hf m with ⟨x, rfl⟩
    simp [← smul]
  smul_zero c := by simp only [← f.map_zero, ← smul, smul_zero]
#align function.surjective.smul_with_zero Function.Surjective.smulWithZero
-/

variable (M)

#print SMulWithZero.compHom /-
/-- Compose a `smul_with_zero` with a `zero_hom`, with action `f r' • m` -/
def SMulWithZero.compHom (f : ZeroHom R' R) : SMulWithZero R' M
    where
  smul := (· • ·) ∘ f
  smul_zero m := by simp
  zero_smul m := by simp
#align smul_with_zero.comp_hom SMulWithZero.compHom
-/

end Zero

/- warning: add_monoid.nat_smul_with_zero -> AddMonoid.natSMulWithZero is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : AddMonoid.{u1} M], SMulWithZero.{0, u1} Nat M Nat.hasZero (AddZeroClass.toHasZero.{u1} M (AddMonoid.toAddZeroClass.{u1} M _inst_1))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : AddMonoid.{u1} M], SMulWithZero.{0, u1} Nat M (Zero.ofOfNat0.{0} Nat (instOfNatNat 0)) (AddMonoid.toZero.{u1} M _inst_1)
Case conversion may be inaccurate. Consider using '#align add_monoid.nat_smul_with_zero AddMonoid.natSMulWithZeroₓ'. -/
instance AddMonoid.natSMulWithZero [AddMonoid M] : SMulWithZero ℕ M
    where
  smul_zero := nsmul_zero
  zero_smul := zero_nsmul
#align add_monoid.nat_smul_with_zero AddMonoid.natSMulWithZero

/- warning: add_group.int_smul_with_zero -> AddGroup.intSMulWithZero is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : AddGroup.{u1} M], SMulWithZero.{0, u1} Int M Int.hasZero (AddZeroClass.toHasZero.{u1} M (AddMonoid.toAddZeroClass.{u1} M (SubNegMonoid.toAddMonoid.{u1} M (AddGroup.toSubNegMonoid.{u1} M _inst_1))))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : AddGroup.{u1} M], SMulWithZero.{0, u1} Int M (Zero.ofOfNat0.{0} Int (instOfNatInt 0)) (NegZeroClass.toZero.{u1} M (SubNegZeroMonoid.toNegZeroClass.{u1} M (SubtractionMonoid.toSubNegZeroMonoid.{u1} M (AddGroup.toSubtractionMonoid.{u1} M _inst_1))))
Case conversion may be inaccurate. Consider using '#align add_group.int_smul_with_zero AddGroup.intSMulWithZeroₓ'. -/
instance AddGroup.intSMulWithZero [AddGroup M] : SMulWithZero ℤ M
    where
  smul_zero := zsmul_zero
  zero_smul := zero_zsmul
#align add_group.int_smul_with_zero AddGroup.intSMulWithZero

section MonoidWithZero

variable [MonoidWithZero R] [MonoidWithZero R'] [Zero M]

variable (R M)

#print MulActionWithZero /-
/-- An action of a monoid with zero `R` on a Type `M`, also with `0`, extends `mul_action` and
is compatible with `0` (both in `R` and in `M`), with `1 ∈ R`, and with associativity of
multiplication on the monoid `M`. -/
class MulActionWithZero extends MulAction R M where
  -- these fields are copied from `smul_with_zero`, as `extends` behaves poorly
  smul_zero : ∀ r : R, r • (0 : M) = 0
  zero_smul : ∀ m : M, (0 : R) • m = 0
#align mul_action_with_zero MulActionWithZero
-/

/- warning: mul_action_with_zero.to_smul_with_zero -> MulActionWithZero.toSMulWithZero is a dubious translation:
lean 3 declaration is
  forall (R : Type.{u1}) (M : Type.{u2}) [_inst_1 : MonoidWithZero.{u1} R] [_inst_3 : Zero.{u2} M] [m : MulActionWithZero.{u1, u2} R M _inst_1 _inst_3], SMulWithZero.{u1, u2} R M (MulZeroClass.toHasZero.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R _inst_1))) _inst_3
but is expected to have type
  forall (R : Type.{u1}) (M : Type.{u2}) [_inst_1 : MonoidWithZero.{u1} R] [_inst_3 : Zero.{u2} M] [m : MulActionWithZero.{u1, u2} R M _inst_1 _inst_3], SMulWithZero.{u1, u2} R M (MonoidWithZero.toZero.{u1} R _inst_1) _inst_3
Case conversion may be inaccurate. Consider using '#align mul_action_with_zero.to_smul_with_zero MulActionWithZero.toSMulWithZeroₓ'. -/
-- see Note [lower instance priority]
instance (priority := 100) MulActionWithZero.toSMulWithZero [m : MulActionWithZero R M] :
    SMulWithZero R M :=
  { m with }
#align mul_action_with_zero.to_smul_with_zero MulActionWithZero.toSMulWithZero

/- warning: monoid_with_zero.to_mul_action_with_zero -> MonoidWithZero.toMulActionWithZero is a dubious translation:
lean 3 declaration is
  forall (R : Type.{u1}) [_inst_1 : MonoidWithZero.{u1} R], MulActionWithZero.{u1, u1} R R _inst_1 (MulZeroClass.toHasZero.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R _inst_1)))
but is expected to have type
  forall (R : Type.{u1}) [_inst_1 : MonoidWithZero.{u1} R], MulActionWithZero.{u1, u1} R R _inst_1 (MonoidWithZero.toZero.{u1} R _inst_1)
Case conversion may be inaccurate. Consider using '#align monoid_with_zero.to_mul_action_with_zero MonoidWithZero.toMulActionWithZeroₓ'. -/
/-- See also `semiring.to_module` -/
instance MonoidWithZero.toMulActionWithZero : MulActionWithZero R R :=
  { MulZeroClass.toSMulWithZero R, Monoid.toMulAction R with }
#align monoid_with_zero.to_mul_action_with_zero MonoidWithZero.toMulActionWithZero

/- warning: monoid_with_zero.to_opposite_mul_action_with_zero -> MonoidWithZero.toOppositeMulActionWithZero is a dubious translation:
lean 3 declaration is
  forall (R : Type.{u1}) [_inst_1 : MonoidWithZero.{u1} R], MulActionWithZero.{u1, u1} (MulOpposite.{u1} R) R (MulOpposite.monoidWithZero.{u1} R _inst_1) (MulZeroClass.toHasZero.{u1} R (MulZeroOneClass.toMulZeroClass.{u1} R (MonoidWithZero.toMulZeroOneClass.{u1} R _inst_1)))
but is expected to have type
  forall (R : Type.{u1}) [_inst_1 : MonoidWithZero.{u1} R], MulActionWithZero.{u1, u1} (MulOpposite.{u1} R) R (MulOpposite.monoidWithZero.{u1} R _inst_1) (MonoidWithZero.toZero.{u1} R _inst_1)
Case conversion may be inaccurate. Consider using '#align monoid_with_zero.to_opposite_mul_action_with_zero MonoidWithZero.toOppositeMulActionWithZeroₓ'. -/
/-- Like `monoid_with_zero.to_mul_action_with_zero`, but multiplies on the right. See also
`semiring.to_opposite_module` -/
instance MonoidWithZero.toOppositeMulActionWithZero : MulActionWithZero Rᵐᵒᵖ R :=
  { MulZeroClass.toOppositeSMulWithZero R, Monoid.toOppositeMulAction R with }
#align monoid_with_zero.to_opposite_mul_action_with_zero MonoidWithZero.toOppositeMulActionWithZero

/- warning: mul_action_with_zero.subsingleton -> MulActionWithZero.subsingleton is a dubious translation:
lean 3 declaration is
  forall (R : Type.{u1}) (M : Type.{u2}) [_inst_1 : MonoidWithZero.{u1} R] [_inst_3 : Zero.{u2} M] [_inst_4 : MulActionWithZero.{u1, u2} R M _inst_1 _inst_3] [_inst_5 : Subsingleton.{succ u1} R], Subsingleton.{succ u2} M
but is expected to have type
  forall (R : Type.{u2}) (M : Type.{u1}) [_inst_1 : MonoidWithZero.{u2} R] [_inst_3 : Zero.{u1} M] [_inst_4 : MulActionWithZero.{u2, u1} R M _inst_1 _inst_3] [_inst_5 : Subsingleton.{succ u2} R], Subsingleton.{succ u1} M
Case conversion may be inaccurate. Consider using '#align mul_action_with_zero.subsingleton MulActionWithZero.subsingletonₓ'. -/
protected theorem MulActionWithZero.subsingleton [MulActionWithZero R M] [Subsingleton R] :
    Subsingleton M :=
  ⟨fun x y => by
    rw [← one_smul R x, ← one_smul R y, Subsingleton.elim (1 : R) 0, zero_smul, zero_smul]⟩
#align mul_action_with_zero.subsingleton MulActionWithZero.subsingleton

/- warning: mul_action_with_zero.nontrivial -> MulActionWithZero.nontrivial is a dubious translation:
lean 3 declaration is
  forall (R : Type.{u1}) (M : Type.{u2}) [_inst_1 : MonoidWithZero.{u1} R] [_inst_3 : Zero.{u2} M] [_inst_4 : MulActionWithZero.{u1, u2} R M _inst_1 _inst_3] [_inst_5 : Nontrivial.{u2} M], Nontrivial.{u1} R
but is expected to have type
  forall (R : Type.{u2}) (M : Type.{u1}) [_inst_1 : MonoidWithZero.{u2} R] [_inst_3 : Zero.{u1} M] [_inst_4 : MulActionWithZero.{u2, u1} R M _inst_1 _inst_3] [_inst_5 : Nontrivial.{u1} M], Nontrivial.{u2} R
Case conversion may be inaccurate. Consider using '#align mul_action_with_zero.nontrivial MulActionWithZero.nontrivialₓ'. -/
protected theorem MulActionWithZero.nontrivial [MulActionWithZero R M] [Nontrivial M] :
    Nontrivial R :=
  (subsingleton_or_nontrivial R).resolve_left fun hR =>
    not_subsingleton M <| MulActionWithZero.subsingleton R M
#align mul_action_with_zero.nontrivial MulActionWithZero.nontrivial

variable {R M} [MulActionWithZero R M] [Zero M'] [SMul R M']

#print Function.Injective.mulActionWithZero /-
/-- Pullback a `mul_action_with_zero` structure along an injective zero-preserving homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def Function.Injective.mulActionWithZero (f : ZeroHom M' M) (hf : Function.Injective f)
    (smul : ∀ (a : R) (b), f (a • b) = a • f b) : MulActionWithZero R M' :=
  { hf.MulAction f smul, hf.SMulWithZero f smul with }
#align function.injective.mul_action_with_zero Function.Injective.mulActionWithZero
-/

#print Function.Surjective.mulActionWithZero /-
/-- Pushforward a `mul_action_with_zero` structure along a surjective zero-preserving homomorphism.
See note [reducible non-instances]. -/
@[reducible]
protected def Function.Surjective.mulActionWithZero (f : ZeroHom M M') (hf : Function.Surjective f)
    (smul : ∀ (a : R) (b), f (a • b) = a • f b) : MulActionWithZero R M' :=
  { hf.MulAction f smul, hf.SMulWithZero f smul with }
#align function.surjective.mul_action_with_zero Function.Surjective.mulActionWithZero
-/

variable (M)

#print MulActionWithZero.compHom /-
/-- Compose a `mul_action_with_zero` with a `monoid_with_zero_hom`, with action `f r' • m` -/
def MulActionWithZero.compHom (f : R' →*₀ R) : MulActionWithZero R' M :=
  { SMulWithZero.compHom M f.toZeroHom with
    smul := (· • ·) ∘ f
    mul_smul := fun r s m => by simp [mul_smul]
    one_smul := fun m => by simp }
#align mul_action_with_zero.comp_hom MulActionWithZero.compHom
-/

end MonoidWithZero

section GroupWithZero

variable {α β : Type _} [GroupWithZero α] [GroupWithZero β] [MulActionWithZero α β]

/- warning: smul_inv₀ -> smul_inv₀ is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : GroupWithZero.{u1} α] [_inst_2 : GroupWithZero.{u2} β] [_inst_3 : MulActionWithZero.{u1, u2} α β (GroupWithZero.toMonoidWithZero.{u1} α _inst_1) (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2))))] [_inst_4 : SMulCommClass.{u1, u2, u2} α β β (SMulZeroClass.toHasSmul.{u1, u2} α β (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2)))) (SMulWithZero.toSmulZeroClass.{u1, u2} α β (MulZeroClass.toHasZero.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α (GroupWithZero.toMonoidWithZero.{u1} α _inst_1)))) (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2)))) (MulActionWithZero.toSMulWithZero.{u1, u2} α β (GroupWithZero.toMonoidWithZero.{u1} α _inst_1) (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2)))) _inst_3))) (Mul.toSMul.{u2} β (MulZeroClass.toHasMul.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2)))))] [_inst_5 : IsScalarTower.{u1, u2, u2} α β β (SMulZeroClass.toHasSmul.{u1, u2} α β (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2)))) (SMulWithZero.toSmulZeroClass.{u1, u2} α β (MulZeroClass.toHasZero.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α (GroupWithZero.toMonoidWithZero.{u1} α _inst_1)))) (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2)))) (MulActionWithZero.toSMulWithZero.{u1, u2} α β (GroupWithZero.toMonoidWithZero.{u1} α _inst_1) (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2)))) _inst_3))) (Mul.toSMul.{u2} β (MulZeroClass.toHasMul.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2))))) (SMulZeroClass.toHasSmul.{u1, u2} α β (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2)))) (SMulWithZero.toSmulZeroClass.{u1, u2} α β (MulZeroClass.toHasZero.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α (GroupWithZero.toMonoidWithZero.{u1} α _inst_1)))) (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2)))) (MulActionWithZero.toSMulWithZero.{u1, u2} α β (GroupWithZero.toMonoidWithZero.{u1} α _inst_1) (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2)))) _inst_3)))] (c : α) (x : β), Eq.{succ u2} β (Inv.inv.{u2} β (DivInvMonoid.toHasInv.{u2} β (GroupWithZero.toDivInvMonoid.{u2} β _inst_2)) (SMul.smul.{u1, u2} α β (SMulZeroClass.toHasSmul.{u1, u2} α β (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2)))) (SMulWithZero.toSmulZeroClass.{u1, u2} α β (MulZeroClass.toHasZero.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α (GroupWithZero.toMonoidWithZero.{u1} α _inst_1)))) (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2)))) (MulActionWithZero.toSMulWithZero.{u1, u2} α β (GroupWithZero.toMonoidWithZero.{u1} α _inst_1) (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2)))) _inst_3))) c x)) (SMul.smul.{u1, u2} α β (SMulZeroClass.toHasSmul.{u1, u2} α β (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2)))) (SMulWithZero.toSmulZeroClass.{u1, u2} α β (MulZeroClass.toHasZero.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α (GroupWithZero.toMonoidWithZero.{u1} α _inst_1)))) (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2)))) (MulActionWithZero.toSMulWithZero.{u1, u2} α β (GroupWithZero.toMonoidWithZero.{u1} α _inst_1) (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β (MonoidWithZero.toMulZeroOneClass.{u2} β (GroupWithZero.toMonoidWithZero.{u2} β _inst_2)))) _inst_3))) (Inv.inv.{u1} α (DivInvMonoid.toHasInv.{u1} α (GroupWithZero.toDivInvMonoid.{u1} α _inst_1)) c) (Inv.inv.{u2} β (DivInvMonoid.toHasInv.{u2} β (GroupWithZero.toDivInvMonoid.{u2} β _inst_2)) x))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : GroupWithZero.{u2} α] [_inst_2 : GroupWithZero.{u1} β] [_inst_3 : MulActionWithZero.{u2, u1} α β (GroupWithZero.toMonoidWithZero.{u2} α _inst_1) (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2))] [_inst_4 : SMulCommClass.{u2, u1, u1} α β β (SMulZeroClass.toSMul.{u2, u1} α β (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) (SMulWithZero.toSMulZeroClass.{u2, u1} α β (MonoidWithZero.toZero.{u2} α (GroupWithZero.toMonoidWithZero.{u2} α _inst_1)) (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) (MulActionWithZero.toSMulWithZero.{u2, u1} α β (GroupWithZero.toMonoidWithZero.{u2} α _inst_1) (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) _inst_3))) (SMulZeroClass.toSMul.{u1, u1} β β (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) (SMulWithZero.toSMulZeroClass.{u1, u1} β β (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) (MulZeroClass.toSMulWithZero.{u1} β (MulZeroOneClass.toMulZeroClass.{u1} β (MonoidWithZero.toMulZeroOneClass.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2))))))] [_inst_5 : IsScalarTower.{u2, u1, u1} α β β (SMulZeroClass.toSMul.{u2, u1} α β (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) (SMulWithZero.toSMulZeroClass.{u2, u1} α β (MonoidWithZero.toZero.{u2} α (GroupWithZero.toMonoidWithZero.{u2} α _inst_1)) (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) (MulActionWithZero.toSMulWithZero.{u2, u1} α β (GroupWithZero.toMonoidWithZero.{u2} α _inst_1) (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) _inst_3))) (SMulZeroClass.toSMul.{u1, u1} β β (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) (SMulWithZero.toSMulZeroClass.{u1, u1} β β (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) (MulZeroClass.toSMulWithZero.{u1} β (MulZeroOneClass.toMulZeroClass.{u1} β (MonoidWithZero.toMulZeroOneClass.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)))))) (SMulZeroClass.toSMul.{u2, u1} α β (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) (SMulWithZero.toSMulZeroClass.{u2, u1} α β (MonoidWithZero.toZero.{u2} α (GroupWithZero.toMonoidWithZero.{u2} α _inst_1)) (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) (MulActionWithZero.toSMulWithZero.{u2, u1} α β (GroupWithZero.toMonoidWithZero.{u2} α _inst_1) (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) _inst_3)))] (c : α) (x : β), Eq.{succ u1} β (Inv.inv.{u1} β (GroupWithZero.toInv.{u1} β _inst_2) (HSMul.hSMul.{u2, u1, u1} α β β (instHSMul.{u2, u1} α β (SMulZeroClass.toSMul.{u2, u1} α β (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) (SMulWithZero.toSMulZeroClass.{u2, u1} α β (MonoidWithZero.toZero.{u2} α (GroupWithZero.toMonoidWithZero.{u2} α _inst_1)) (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) (MulActionWithZero.toSMulWithZero.{u2, u1} α β (GroupWithZero.toMonoidWithZero.{u2} α _inst_1) (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) _inst_3)))) c x)) (HSMul.hSMul.{u2, u1, u1} α β β (instHSMul.{u2, u1} α β (SMulZeroClass.toSMul.{u2, u1} α β (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) (SMulWithZero.toSMulZeroClass.{u2, u1} α β (MonoidWithZero.toZero.{u2} α (GroupWithZero.toMonoidWithZero.{u2} α _inst_1)) (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) (MulActionWithZero.toSMulWithZero.{u2, u1} α β (GroupWithZero.toMonoidWithZero.{u2} α _inst_1) (MonoidWithZero.toZero.{u1} β (GroupWithZero.toMonoidWithZero.{u1} β _inst_2)) _inst_3)))) (Inv.inv.{u2} α (GroupWithZero.toInv.{u2} α _inst_1) c) (Inv.inv.{u1} β (GroupWithZero.toInv.{u1} β _inst_2) x))
Case conversion may be inaccurate. Consider using '#align smul_inv₀ smul_inv₀ₓ'. -/
theorem smul_inv₀ [SMulCommClass α β β] [IsScalarTower α β β] (c : α) (x : β) :
    (c • x)⁻¹ = c⁻¹ • x⁻¹ := by
  obtain rfl | hc := eq_or_ne c 0
  · simp only [inv_zero, zero_smul]
  obtain rfl | hx := eq_or_ne x 0
  · simp only [inv_zero, smul_zero]
  · refine' inv_eq_of_mul_eq_one_left _
    rw [smul_mul_smul, inv_mul_cancel hc, inv_mul_cancel hx, one_smul]
#align smul_inv₀ smul_inv₀

end GroupWithZero

/- warning: smul_monoid_with_zero_hom -> smulMonoidWithZeroHom is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : MonoidWithZero.{u1} α] [_inst_2 : MulZeroOneClass.{u2} β] [_inst_3 : MulActionWithZero.{u1, u2} α β _inst_1 (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β _inst_2))] [_inst_4 : IsScalarTower.{u1, u2, u2} α β β (SMulZeroClass.toHasSmul.{u1, u2} α β (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β _inst_2)) (SMulWithZero.toSmulZeroClass.{u1, u2} α β (MulZeroClass.toHasZero.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α _inst_1))) (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β _inst_2)) (MulActionWithZero.toSMulWithZero.{u1, u2} α β _inst_1 (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β _inst_2)) _inst_3))) (Mul.toSMul.{u2} β (MulZeroClass.toHasMul.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β _inst_2))) (SMulZeroClass.toHasSmul.{u1, u2} α β (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β _inst_2)) (SMulWithZero.toSmulZeroClass.{u1, u2} α β (MulZeroClass.toHasZero.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α _inst_1))) (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β _inst_2)) (MulActionWithZero.toSMulWithZero.{u1, u2} α β _inst_1 (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β _inst_2)) _inst_3)))] [_inst_5 : SMulCommClass.{u1, u2, u2} α β β (SMulZeroClass.toHasSmul.{u1, u2} α β (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β _inst_2)) (SMulWithZero.toSmulZeroClass.{u1, u2} α β (MulZeroClass.toHasZero.{u1} α (MulZeroOneClass.toMulZeroClass.{u1} α (MonoidWithZero.toMulZeroOneClass.{u1} α _inst_1))) (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β _inst_2)) (MulActionWithZero.toSMulWithZero.{u1, u2} α β _inst_1 (MulZeroClass.toHasZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β _inst_2)) _inst_3))) (Mul.toSMul.{u2} β (MulZeroClass.toHasMul.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β _inst_2)))], MonoidWithZeroHom.{max u1 u2, u2} (Prod.{u1, u2} α β) β (Prod.mulZeroOneClass.{u1, u2} α β (MonoidWithZero.toMulZeroOneClass.{u1} α _inst_1) _inst_2) _inst_2
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : MonoidWithZero.{u1} α] [_inst_2 : MulZeroOneClass.{u2} β] [_inst_3 : MulActionWithZero.{u1, u2} α β _inst_1 (MulZeroOneClass.toZero.{u2} β _inst_2)] [_inst_4 : IsScalarTower.{u1, u2, u2} α β β (SMulZeroClass.toSMul.{u1, u2} α β (MulZeroOneClass.toZero.{u2} β _inst_2) (SMulWithZero.toSMulZeroClass.{u1, u2} α β (MonoidWithZero.toZero.{u1} α _inst_1) (MulZeroOneClass.toZero.{u2} β _inst_2) (MulActionWithZero.toSMulWithZero.{u1, u2} α β _inst_1 (MulZeroOneClass.toZero.{u2} β _inst_2) _inst_3))) (SMulZeroClass.toSMul.{u2, u2} β β (MulZeroOneClass.toZero.{u2} β _inst_2) (SMulWithZero.toSMulZeroClass.{u2, u2} β β (MulZeroOneClass.toZero.{u2} β _inst_2) (MulZeroOneClass.toZero.{u2} β _inst_2) (MulZeroClass.toSMulWithZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β _inst_2)))) (SMulZeroClass.toSMul.{u1, u2} α β (MulZeroOneClass.toZero.{u2} β _inst_2) (SMulWithZero.toSMulZeroClass.{u1, u2} α β (MonoidWithZero.toZero.{u1} α _inst_1) (MulZeroOneClass.toZero.{u2} β _inst_2) (MulActionWithZero.toSMulWithZero.{u1, u2} α β _inst_1 (MulZeroOneClass.toZero.{u2} β _inst_2) _inst_3)))] [_inst_5 : SMulCommClass.{u1, u2, u2} α β β (SMulZeroClass.toSMul.{u1, u2} α β (MulZeroOneClass.toZero.{u2} β _inst_2) (SMulWithZero.toSMulZeroClass.{u1, u2} α β (MonoidWithZero.toZero.{u1} α _inst_1) (MulZeroOneClass.toZero.{u2} β _inst_2) (MulActionWithZero.toSMulWithZero.{u1, u2} α β _inst_1 (MulZeroOneClass.toZero.{u2} β _inst_2) _inst_3))) (SMulZeroClass.toSMul.{u2, u2} β β (MulZeroOneClass.toZero.{u2} β _inst_2) (SMulWithZero.toSMulZeroClass.{u2, u2} β β (MulZeroOneClass.toZero.{u2} β _inst_2) (MulZeroOneClass.toZero.{u2} β _inst_2) (MulZeroClass.toSMulWithZero.{u2} β (MulZeroOneClass.toMulZeroClass.{u2} β _inst_2))))], MonoidWithZeroHom.{max u2 u1, u2} (Prod.{u1, u2} α β) β (Prod.instMulZeroOneClassProd.{u1, u2} α β (MonoidWithZero.toMulZeroOneClass.{u1} α _inst_1) _inst_2) _inst_2
Case conversion may be inaccurate. Consider using '#align smul_monoid_with_zero_hom smulMonoidWithZeroHomₓ'. -/
/-- Scalar multiplication as a monoid homomorphism with zero. -/
@[simps]
def smulMonoidWithZeroHom {α β : Type _} [MonoidWithZero α] [MulZeroOneClass β]
    [MulActionWithZero α β] [IsScalarTower α β β] [SMulCommClass α β β] : α × β →*₀ β :=
  { smulMonoidHom with map_zero' := smul_zero _ }
#align smul_monoid_with_zero_hom smulMonoidWithZeroHom


-- import data.finset
-- import tactic.linarith

-- section examples

-- variables {ι : Type*} [linear_order ι] -- [is_well_order ι ((≤) : ι → ι → Prop)]

-- namespace finset

-- def erase_nth (s : finset ι) {k : ℕ} (h : s.card = k) (m : fin k) : finset ι :=
-- s.erase (s.order_emb_of_fin h m)

-- lemma mem_erase_nth (s : finset ι) {k : ℕ} (h : s.card = k) (m : fin k) (i : ι) :
--   i ∈ s.erase_nth h m ↔ i ≠ s.order_emb_of_fin h m ∧ i ∈ s :=
-- begin
--   unfold erase_nth,
--   rw mem_erase,
-- end

-- lemma erase_nth_card (s : finset ι) {k : ℕ} (h : s.card = k) (m : fin k) :
--   (s.erase_nth h m).card = k.pred :=
-- begin
--   unfold erase_nth,
--   rw finset.card_erase_eq_ite,
--   split_ifs with h2,
--   { rw h,
--     exact nat.pred_eq_sub_one _, },
--   { exfalso,
--     apply h2,
--     apply finset.order_emb_of_fin_mem },
-- end

-- def erase_order_emb_of_fin' (s : finset ι) {k : ℕ} (h : s.card = k) (m : fin k) :
--   fin k.pred ↪o ι :=
-- { to_fun := λ n,
--     if (n.1 < m.1)
--     then s.order_emb_of_fin h ⟨n.1, lt_trans n.2 $ nat.pred_lt $ λ r, by rw r at m; exact fin_zero_elim m⟩
--     else s.order_emb_of_fin h ⟨n.1.succ, by { convert nat.succ_lt_succ n.2, rw nat.succ_pred_eq_of_pos, apply nat.pos_of_ne_zero (λ r, _), rw r at m, exact fin_zero_elim m } ⟩,
--   inj' := λ x y H, begin
--     dsimp only at H,
--     split_ifs at H with hx hy;
--     have := (s.order_emb_of_fin h).inj' H;
--     rw subtype.ext_iff_val at this ⊢,
--     { exact this, },
--     { rw this at *,
--       exfalso,
--       apply hy,
--       exact lt_trans (lt_add_one _) hx, },
--     { rw ← this at *,
--       exfalso,
--       apply hx,
--       exact lt_trans (lt_add_one _) (by assumption) },
--     { apply_fun nat.succ using nat.succ_injective,
--       exact this },
--   end,
--   map_rel_iff' := λ a b, begin
--     split,
--     { intro H,
--       simp only [function.embedding.coe_fn_mk] at H,
--       split_ifs at H with h1 h2 h3,
--       { rw order_embedding.le_iff_le (s.order_emb_of_fin h) at H,
--         convert H },
--       { rw order_embedding.le_iff_le (s.order_emb_of_fin h) at H,
--         change a.1 ≤ b.1.succ at H,
--         change a.1 ≤ b.1,
--         linarith },
--       { rw order_embedding.le_iff_le (s.order_emb_of_fin h) at H,
--         change a.1.succ ≤ b.1 at H,
--         change a.1 ≤ b.1,
--         exfalso,
--         apply h1,
--         transitivity a.1.succ,
--         { exact lt_add_one _ },
--         { exact lt_of_le_of_lt H h3 } },
--       { rw order_embedding.le_iff_le (s.order_emb_of_fin h) at H,
--         change a.1.succ ≤ b.1.succ at H,
--         rw nat.succ_le_succ_iff at H,
--         convert H, } },
--     { intro H,
--       change a.1 ≤ b.1 at H,
--       simp only [function.embedding.coe_fn_mk],
--       split_ifs with h1 h2 h3;
--       rw order_embedding.le_iff_le (s.order_emb_of_fin h),
--       { change a.1 ≤ b.1,
--         exact H },
--       { change a.1 ≤ b.1.succ,
--         transitivity b.1,
--         { exact H },
--         { exact le_of_lt (lt_add_one _) } },
--       { change a.1.succ ≤ b.1,
--         contrapose! h1,
--         rw nat.lt_succ_iff_lt_or_eq at h1,
--         cases h1,
--         { linarith },
--         { rwa h1 at h3 }, },
--       { change a.1.succ ≤ b.1.succ,
--         rwa nat.succ_le_succ_iff } }
--   end }

-- lemma erase_order_emb_of_fin'_mem (s : finset ι) {k : ℕ} (h : s.card = k) (m : fin k) (x : fin k.pred) :
--   s.erase_order_emb_of_fin' h m x ∈ s.erase_nth h m :=
-- begin
--   unfold erase_order_emb_of_fin',
--   simp only [rel_embedding.coe_fn_mk, function.embedding.coe_fn_mk],
--   unfold erase_nth,
--   split_ifs with h2,
--   { rw mem_erase,
--     refine ⟨λ r, _, order_emb_of_fin_mem s h _⟩,
--     replace r := (s.order_emb_of_fin h).inj' r,
--     rw subtype.ext_iff_val at r,
--     linarith, },
--   { rw mem_erase,
--     refine ⟨λ r, _, order_emb_of_fin_mem s h _⟩,
--     replace r := (s.order_emb_of_fin h).inj' r,
--     rw subtype.ext_iff_val at r,
--     rw ← r at h2,
--     change ¬ x.1 < x.1.succ at h2,
--     apply h2,
--     exact lt_add_one _, },
-- end

-- theorem erase_order_emb_of_fin'_eq (s : finset ι) {k : ℕ} (h : s.card = k) (m : fin k) :
--   (s.erase_nth h m).order_emb_of_fin (s.erase_nth_card h m) =
--   s.erase_order_emb_of_fin' h m :=
-- begin
--   symmetry,
--   have := finset.order_emb_of_fin_unique (s.erase_nth_card h m) begin
--     intros x,
--     apply erase_order_emb_of_fin'_mem,
--   end (order_embedding.strict_mono (s.erase_order_emb_of_fin' h m)),
--   ext x,
--   rw this,
-- end

-- end finset

-- end examples


/-
Copyright (c) 2021 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz
-/
import category_theory.category.basic
import category_theory.equivalence
import category_theory.filtered

/-!
# Basic API for ulift

This file contains a very basic API for working with the categorical
instance on `ulift C` where `C` is a type with a category instance.

1. `category_theory.ulift.up` is the functorial version of the usual `ulift.up`.
2. `category_theory.ulift.down` is the functorial version of the usual `ulift.down`.
3. `category_theory.ulift.equivalence` is the categorical equivalence between
  `C` and `ulift C`.

# ulift_hom

Given a type `C : Type u`, `ulift_hom.{w} C` is just an alias for `C`.
If we have `category.{v} C`, then `ulift_hom.{w} C` is endowed with a category instance
whose morphisms are obtained by applying `ulift.{w}` to the morphisms from `C`.

This is a category equivalent to `C`. The forward direction of the equivalence is `ulift_hom.up`,
the backward direction is `ulift_hom.donw` and the equivalence is `ulift_hom.equiv`.

# as_small

This file also contains a construction which takes a type `C : Type u` with a
category instance `category.{v} C` and makes a small category
`as_small.{w} C : Type (max w v u)` equivalent to `C`.

The forward direction of the equivalence, `C ⥤ as_small C`, is denoted `as_small.up`
and the backward direction is `as_small.down`. The equivalence itself is `as_small.equiv`.
-/

universes w₁ v₁ v₂ u₁ u₂

namespace category_theory

variables {C : Type u₁} [category.{v₁} C]

/-- The functorial version of `ulift.up`. -/
@[simps]
def ulift.up_functor : C ⥤ (ulift.{u₂} C) :=
{ obj := ulift.up,
  map := λ X Y f, f }

/-- The functorial version of `ulift.down`. -/
@[simps]
def ulift.down_functor : (ulift.{u₂} C) ⥤ C :=
{ obj := ulift.down,
  map := λ X Y f, f }

/-- The categorical equivalence between `C` and `ulift C`. -/
@[simps]
def ulift.equivalence : C ≌ (ulift.{u₂} C) :=
{ functor := ulift.up_functor,
  inverse := ulift.down_functor,
  unit_iso :=
  { hom := 𝟙 _,
    inv := 𝟙 _ },
  counit_iso :=
  { hom :=
    { app := λ X, 𝟙 _,
      naturality' := λ X Y f, by {change f ≫ 𝟙 _ = 𝟙 _ ≫ f, simp} },
    inv :=
    { app := λ X, 𝟙 _,
      naturality' := λ X Y f, by {change f ≫ 𝟙 _ = 𝟙 _ ≫ f, simp} },
  hom_inv_id' := by {ext, change (𝟙 _) ≫ (𝟙 _) = 𝟙 _, simp},
  inv_hom_id' := by {ext, change (𝟙 _) ≫ (𝟙 _) = 𝟙 _, simp} },
  functor_unit_iso_comp' := λ X, by {change (𝟙 X) ≫ (𝟙 X) = 𝟙 X, simp} }

instance [is_filtered C] : is_filtered (ulift.{u₂} C) :=
is_filtered.of_equivalence ulift.equivalence

instance [is_cofiltered C] : is_cofiltered (ulift.{u₂} C) :=
is_cofiltered.of_equivalence ulift.equivalence

section ulift_hom

/-- `ulift_hom.{w} C` is an alias for `C`, which is endowed with a category instance
  whose morphisms are obtained by applying `ulift.{w}` to the morphisms from `C`.
-/
def {w u} ulift_hom (C : Type u) := C

instance {C} [inhabited C] : inhabited (ulift_hom C) := ⟨(arbitrary C : C)⟩

/-- The obvious function `ulift_hom C → C`. -/
def ulift_hom.obj_down {C} (A : ulift_hom C) : C := A

/-- The obvious function `C → ulift_hom C`. -/
def ulift_hom.obj_up {C} (A : C) : ulift_hom C := A

@[simp] lemma obj_down_obj_up {C} (A : C) : (ulift_hom.obj_up A).obj_down = A := rfl
@[simp] lemma obj_up_obj_down {C} (A : ulift_hom C) : ulift_hom.obj_up A.obj_down = A := rfl

instance : category.{max v₂ v₁} (ulift_hom.{v₂} C) :=
{ hom := λ A B, ulift.{v₂} $ A.obj_down ⟶ B.obj_down,
  id := λ A, ⟨𝟙 _⟩,
  comp := λ A B C f g, ⟨f.down ≫ g.down⟩}

/-- One half of the quivalence between `C` and `ulift_hom C`. -/
@[simps]
def ulift_hom.up : C ⥤ ulift_hom C :=
{ obj := ulift_hom.obj_up,
  map := λ X Y f, ⟨f⟩ }

/-- One half of the quivalence between `C` and `ulift_hom C`. -/
@[simps]
def ulift_hom.down : ulift_hom C ⥤ C :=
{ obj := ulift_hom.obj_down,
  map := λ X Y f, f.down }

/-- The equivalence between `C` and `ulift_hom C`. -/
def ulift_hom.equiv : C ≌ ulift_hom C :=
{ functor := ulift_hom.up,
  inverse := ulift_hom.down,
  unit_iso := nat_iso.of_components (λ A, eq_to_iso rfl) (by tidy),
  counit_iso := nat_iso.of_components (λ A, eq_to_iso rfl) (by tidy) }

instance [is_filtered C] : is_filtered (ulift_hom C) :=
is_filtered.of_equivalence ulift_hom.equiv

instance [is_cofiltered C] : is_cofiltered (ulift_hom C) :=
is_cofiltered.of_equivalence ulift_hom.equiv

end ulift_hom

/-- `as_small C` is a small category equivalent to `C`.
  More specifically, if `C : Type u` is endowed with `category.{v} C`, then
  `as_small.{w} C : Type (max w v u)` is endowed with an instance of a small category.

  The objects and morphisms of `as_small C` are defined by applying `ulift` to the
  objects and morphisms of `C`.

  Note: We require a category instance for this definition in order to have direct
  access to the universe level `v`.
-/
@[nolint unused_arguments]
def {w v u} as_small (C : Type u) [category.{v} C] := ulift.{max w v} C

instance : small_category (as_small.{w₁} C) :=
{ hom := λ X Y, ulift.{(max w₁ u₁)} $ X.down ⟶ Y.down,
  id := λ X, ⟨𝟙 _⟩,
  comp := λ X Y Z f g, ⟨f.down ≫ g.down⟩ }

/-- One half of the equivalence between `C` and `as_small C`. -/
@[simps]
def as_small.up : C ⥤ as_small C :=
{ obj := λ X, ⟨X⟩,
  map := λ X Y f, ⟨f⟩ }

/-- One half of the equivalence between `C` and `as_small C`. -/
@[simps]
def as_small.down : as_small C ⥤ C :=
{ obj := λ X, X.down,
  map := λ X Y f, f.down }

/-- The equivalence between `C` and `as_small C`. -/
@[simps]
def as_small.equiv : C ≌ as_small C :=
{ functor := as_small.up,
  inverse := as_small.down,
  unit_iso := nat_iso.of_components (λ X, eq_to_iso rfl) (by tidy),
  counit_iso := nat_iso.of_components (λ X, eq_to_iso $ by { ext, refl }) (by tidy) }

instance [inhabited C] : inhabited (as_small C) := ⟨⟨arbitrary _⟩⟩

instance [is_filtered C] : is_filtered (as_small C) :=
is_filtered.of_equivalence as_small.equiv

instance [is_cofiltered C] : is_cofiltered (as_small C) :=
is_cofiltered.of_equivalence as_small.equiv

/-- The equivalence between `C` and `ulift_hom (ulift C)`. -/
def {v' u' v u} ulift_hom_ulift_category.equiv (C : Type u) [category.{v} C] :
  C ≌ ulift_hom.{v'} (ulift.{u'} C) :=
ulift.equivalence.trans ulift_hom.equiv

end category_theory


partial def f (x : Nat) : Nat → Nat
  | 0   => x + 1
  | i+1 => h i + 2
where
  g y := f x y
  h y := g y + 1

def reverse (as : List α) : List α :=
  loop as []
where
  loop : List α → List α → List α
    | [],    acc => acc
    | a::as, acc => loop as (a::acc)

theorem ex : reverse [1, 2, 3] = [3, 2, 1] :=
  rfl

theorem lengthReverse (as : List α) : (reverse as).length = as.length :=
  revLoop as []
where
  revLoop (as bs : List α) : (reverse.loop as bs).length = as.length + bs.length := by
    induction as generalizing bs with
    | nil => simp [reverse.loop]
    | cons a as ih =>
      show (reverse.loop as (a::bs)).length = (a :: as).length + bs.length
      simp [ih, Nat.add_succ, Nat.succ_add]

def h : Nat -> Nat
  | 0    => g 0
  | x+1 => g (h x)
where
  g x := x + 1


import algebra.order.archimedean tactic.positivity

/-! # IMO 2014 A2 -/

namespace IMOSL
namespace IMO2014A2

open function
open_locale classical

section extra

variables {R : Type*} [linear_ordered_ring R]

lemma inverse_pos (x : R) [invertible x] : 0 < ⅟ x ↔ 0 < x :=
  pos_iff_pos_of_mul_pos (by rw inv_of_mul_self; exact one_pos)

lemma inverse_two_pos [invertible (2 : R)] : 0 < ⅟ (2 : R) :=
  by rw inverse_pos; exact two_pos

end extra

variables {R : Type*} [linear_ordered_comm_ring R] [archimedean R] [invertible (2 : R)]

def f (x : R) := ite (x < ⅟ 2) (x + ⅟ 2) (x ^ 2)

private lemma lem1 {x : R} (h : 0 < x ∧ x < 1) (n : ℕ) : 0 < (f^[n] x) ∧ (f^[n] x) < 1 :=
begin
  induction n with n n_ih,
  rwa iterate_zero,
  rw [iterate_succ', comp_app, f],
  cases n_ih with h0 h1,
  by_cases h2 : (f^[n] x) < (⅟ 2),
  rw if_pos h2; exact ⟨add_pos h0 (lt_trans h0 h2),
    lt_of_lt_of_eq (add_lt_add_right h2 (⅟ 2)) inv_of_two_add_inv_of_two⟩,
  rw if_neg h2; exact ⟨pow_pos h0 2, pow_lt_one (le_of_lt h0) h1 two_ne_zero⟩
end

private lemma lem2 {x y : R} (hx : x < ⅟ 2) (hy : y < ⅟ 2) : f x - f y = x - y :=
 by rw [f, if_pos hx, f, if_pos hy, add_sub_add_right_eq_sub]

private lemma lem3 {x y : R} (hx : ¬x < ⅟ 2) (hy : ¬y < ⅟ 2) :
  (1 + |x - y|) * |x - y| ≤ |f x - f y| :=
begin
  rw [f, if_neg hx, f, if_neg hy, sq_sub_sq, abs_mul],
  refine mul_le_mul_of_nonneg_right _ (abs_nonneg (x - y)),
  obtain ⟨u, rfl⟩ : ∃ u : R, x = u + ⅟ 2 := ⟨x - ⅟ 2, by rw sub_add_cancel⟩,
  obtain ⟨v, rfl⟩ : ∃ v : R, y = v + ⅟ 2 := ⟨y - ⅟ 2, by rw sub_add_cancel⟩,
  rw [not_lt, le_add_iff_nonneg_left] at hx hy,
  have h := add_nonneg (add_nonneg hx hy) zero_le_one,
  rw [add_add_add_comm, inv_of_two_add_inv_of_two, add_sub_add_right_eq_sub,
      abs_eq_self.mpr h, add_comm, add_le_add_iff_right],
  convert abs_sub u v; rw abs_eq_self.mpr; assumption
end

private lemma lem4 {x y : R} (hx : 0 < x ∧ x < 1) (hy : 0 < y ∧ y < 1) (h : x < ⅟ 2 ↔ y < ⅟ 2)
  (h0 : f x < ⅟ 2 ↔ f y < ⅟ 2) : (1 + |x - y|) * |x - y| ≤ |f (f x) - f (f y)| :=
begin
  by_cases h1 : y < ⅟ 2,
  { rw ← lem2 (by rwa h) h1,
    suffices : ¬ f y < ⅟ 2,
      exact lem3 (by rwa h0) this,
    rw [f, if_pos h1, not_lt, le_add_iff_nonneg_left],
    exact le_of_lt hy.left },
  { refine le_trans (lem3 (by rwa h) h1) _,
    by_cases h2 : f y < ⅟ 2,
    rw lem2 (by rwa h0) h2,
    refine le_trans _ (lem3 (by rwa h0) h2),
    rw [one_add_mul, ← sq, le_add_iff_nonneg_right],
    exact sq_nonneg _ }
end

private lemma lem5 {x y : R} (hx : 0 < x ∧ x < 1) (hy : 0 < y ∧ y < 1)
  (h : ∀ n : ℕ, f^[n] x < ⅟ 2 ↔ (f^[n] y) < ⅟ 2) : x = y :=
begin
  refine eq_of_abs_sub_eq_zero (eq_of_ge_of_not_gt (abs_nonneg _) (λ h0, _)),
  replace h : ∀ n : ℕ, (1 + |x - y|) ^ n * |x - y| ≤ |(f^[2 * n] x) - (f^[2 * n] y)| :=
  begin
    intros n; induction n with n n_ih,
    rw [pow_zero, one_mul, mul_zero, iterate_zero, id_def],
    rw [nat.mul_succ, add_comm _ 2, iterate_add, comp_app, iterate_succ,
        iterate_one, comp_app, comp_app, comp_app, pow_succ, mul_assoc],
    refine le_trans _ (lem4 (lem1 hx _) (lem1 hy _) (h _) _),
    work_on_goal 2 { convert (h (2 * n + 1)); rw iterate_succ' },
    refine mul_le_mul _ n_ih _ _; try { positivity },
    rw add_le_add_iff_left; refine le_trans _ n_ih,
    rw [← sub_nonneg, ← sub_one_mul],
    refine mul_nonneg _ (abs_nonneg _),
    rw sub_nonneg; refine one_le_pow_of_one_le _ n,
    rw le_add_iff_nonneg_right; exact abs_nonneg _
  end,

  obtain ⟨N, h1⟩ : ∃ N : ℕ, 1 < (1 + |x - y|) ^ N * |x - y| :=
  begin
    cases archimedean.arch 1 h0 with c h1,
    rw nsmul_eq_mul at h1,
    cases add_one_pow_unbounded_of_pos (c : R) h0 with N h2,
    rw add_comm at h2,
    exact ⟨N, lt_of_le_of_lt h1 ((mul_lt_mul_right h0).mpr h2)⟩
  end,

  replace h1 := lt_of_lt_of_le h1 (h N),
  replace hx := lem1 hx (2 * N),
  replace hy := lem1 hy (2 * N),
  revert h1; refine lt_asymm _,
  rw abs_sub_lt_iff; split,
  convert sub_lt_sub hx.right hy.left; rw sub_zero,
  convert sub_lt_sub hy.right hx.left; rw sub_zero
end

private lemma lem6 {x : R} (h : f x = x) : x = 1 :=
begin
  by_cases h0 : x < ⅟ 2,
  rw [f, if_pos h0, add_right_eq_self] at h,
  exfalso; exact ne_of_gt inverse_two_pos h,
  rw [f, if_neg h0, sq, ← sub_eq_zero, ← mul_sub_one, mul_eq_zero, sub_eq_zero] at h,
  rcases h with rfl | rfl,
  exfalso; exact h0 inverse_two_pos,
  refl
end

private lemma lem7 {x : R} (h : x < 1) : x < f x ↔ x < ⅟ 2 :=
begin
  by_cases h0 : x < ⅟ 2,
  simp only [f, h0, if_true, iff_true, lt_add_iff_pos_right],
  exact inverse_two_pos,
  simp only [f, h0, if_false, iff_false, sq, not_lt],
  rw [← sub_nonneg, ← one_sub_mul],
  refine mul_nonneg _ _,
  rw sub_nonneg; exact le_of_lt h,
  rw not_lt at h0; exact le_trans (le_of_lt inverse_two_pos) h0
end

/- Final solution -/
theorem final_solution {x y : R} (hx : 0 < x ∧ x < 1) (hy : 0 < y ∧ y < 1)
  (h : ∀ n : ℕ, 0 ≤ (f^[n + 1] x - (f^[n] x)) * (f^[n + 1] y - (f^[n] y))) : x = y :=
begin
  refine lem5 hx hy _; intros n,
  rw [← lem7 (lem1 hx n).right, ← lem7 (lem1 hy n).right],
  replace h := eq_or_lt_of_le (h n),
  rw [iterate_succ', comp_app, comp_app, zero_eq_mul, sub_eq_zero, sub_eq_zero] at h,
  rcases h with (h | h) | h,
  exfalso; exact ne_of_lt (lem1 hx n).right (lem6 h),
  exfalso; exact ne_of_lt (lem1 hy n).right (lem6 h),
  replace h := pos_iff_pos_of_mul_pos h,
  rwa [sub_pos, sub_pos] at h
end

end IMO2014A2
end IMOSL