/-
Copyright (c) 2020 Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller
-/
import algebra.hom.equiv
import data.zmod.basic
import tactic.group

/-!
# Racks and Quandles

This file defines racks and quandles, algebraic structures for sets
that bijectively act on themselves with a self-distributivity
property.  If `R` is a rack and `act : R → (R ≃ R)` is the self-action,
then the self-distributivity is, equivalently, that
```
act (act x y) = act x * act y * (act x)⁻¹
```
where multiplication is composition in `R ≃ R` as a group.
Quandles are racks such that `act x x = x` for all `x`.

One example of a quandle (not yet in mathlib) is the action of a Lie
algebra on itself, defined by `act x y = Ad (exp x) y`.

Quandles and racks were independently developed by multiple
mathematicians.  David Joyce introduced quandles in his thesis
[Joyce1982] to define an algebraic invariant of knot and link
complements that is analogous to the fundamental group of the
exterior, and he showed that the quandle associated to an oriented
knot is invariant up to orientation-reversed mirror image.  Racks were
used by Fenn and Rourke for framed codimension-2 knots and
links.[FennRourke1992]

The name "rack" came from wordplay by Conway and Wraith for the "wrack
and ruin" of forgetting everything but the conjugation operation for a
group.

## Main definitions

* `shelf` is a type with a self-distributive action
* `rack` is a shelf whose action for each element is invertible
* `quandle` is a rack whose action for an element fixes that element
* `quandle.conj` defines a quandle of a group acting on itself by conjugation.
* `shelf_hom` is homomorphisms of shelves, racks, and quandles.
* `rack.envel_group` gives the universal group the rack maps to as a conjugation quandle.
* `rack.opp` gives the rack with the action replaced by its inverse.

## Main statements
* `rack.envel_group` is left adjoint to `quandle.conj` (`to_envel_group.map`).
  The universality statements are `to_envel_group.univ` and `to_envel_group.univ_uniq`.

## Notation

The following notation is localized in `quandles`:

* `x ◃ y` is `shelf.act x y`
* `x ◃⁻¹ y` is `rack.inv_act x y`
* `S →◃ S'` is `shelf_hom S S'`

Use `open_locale quandles` to use these.

## Todo

* If `g` is the Lie algebra of a Lie group `G`, then `(x ◃ y) = Ad (exp x) x` forms a quandle.
* If `X` is a symmetric space, then each point has a corresponding involution that acts on `X`,
  forming a quandle.
* Alexander quandle with `a ◃ b = t * b + (1 - t) * b`, with `a` and `b` elements
  of a module over `Z[t,t⁻¹]`.
* If `G` is a group, `H` a subgroup, and `z` in `H`, then there is a quandle `(G/H;z)` defined by
  `yH ◃ xH = yzy⁻¹xH`.  Every homogeneous quandle (i.e., a quandle `Q` whose automorphism group acts
  transitively on `Q` as a set) is isomorphic to such a quandle.
  There is a generalization to this arbitrary quandles in [Joyce's paper (Theorem 7.2)][Joyce1982].

## Tags

rack, quandle
-/
open mul_opposite

universes u v

/--
A *shelf* is a structure with a self-distributive binary operation.
The binary operation is regarded as a left action of the type on itself.
-/
class shelf (α : Type u) :=
(act : α → α → α)
(self_distrib : ∀ {x y z : α}, act x (act y z) = act (act x y) (act x z))

/--
The type of homomorphisms between shelves.
This is also the notion of rack and quandle homomorphisms.
-/
@[ext]
structure shelf_hom (S₁ : Type*) (S₂ : Type*) [shelf S₁] [shelf S₂] :=
(to_fun : S₁ → S₂)
(map_act' : ∀ {x y : S₁}, to_fun (shelf.act x y) = shelf.act (to_fun x) (to_fun y))

/--
A *rack* is an automorphic set (a set with an action on itself by
bijections) that is self-distributive.  It is a shelf such that each
element's action is invertible.

The notations `x ◃ y` and `x ◃⁻¹ y` denote the action and the
inverse action, respectively, and they are right associative.
-/
class rack (α : Type u) extends shelf α :=
(inv_act : α → α → α)
(left_inv : ∀ x, function.left_inverse (inv_act x) (act x))
(right_inv : ∀ x, function.right_inverse (inv_act x) (act x))

localized "infixr ` ◃ `:65 := shelf.act" in quandles
localized "infixr ` ◃⁻¹ `:65 := rack.inv_act" in quandles
localized "infixr ` →◃ `:25 := shelf_hom" in quandles

open_locale quandles

namespace rack
variables {R : Type*} [rack R]

lemma self_distrib {x y z : R} : x ◃ (y ◃ z) = (x ◃ y) ◃ (x ◃ z) :=
shelf.self_distrib

/--
A rack acts on itself by equivalences.
-/
def act (x : R) : R ≃ R :=
{ to_fun := shelf.act x,
  inv_fun := inv_act x,
  left_inv := left_inv x,
  right_inv := right_inv x }

@[simp] lemma act_apply (x y : R) : act x y = x ◃ y := rfl
@[simp] lemma act_symm_apply (x y : R) : (act x).symm y = x ◃⁻¹ y := rfl
@[simp] lemma inv_act_apply (x y : R) : (act x)⁻¹ y = x ◃⁻¹ y := rfl

@[simp] lemma inv_act_act_eq (x y : R) : x ◃⁻¹ x ◃ y = y := left_inv x y
@[simp] lemma act_inv_act_eq (x y : R) : x ◃ x ◃⁻¹ y = y := right_inv x y

lemma left_cancel (x : R) {y y' : R} : x ◃ y = x ◃ y' ↔ y = y' :=
by { split, apply (act x).injective, rintro rfl, refl }

lemma left_cancel_inv (x : R) {y y' : R} : x ◃⁻¹ y = x ◃⁻¹ y' ↔ y = y' :=
by { split, apply (act x).symm.injective, rintro rfl, refl }

lemma self_distrib_inv {x y z : R} : x ◃⁻¹ y ◃⁻¹ z = (x ◃⁻¹ y) ◃⁻¹ (x ◃⁻¹ z) :=
begin
  rw [←left_cancel (x ◃⁻¹ y), right_inv, ←left_cancel x, right_inv, self_distrib],
  repeat {rw right_inv },
end

/--
The *adjoint action* of a rack on itself is `op'`, and the adjoint
action of `x ◃ y` is the conjugate of the action of `y` by the action
of `x`. It is another way to understand the self-distributivity axiom.

This is used in the natural rack homomorphism `to_conj` from `R` to
`conj (R ≃ R)` defined by `op'`.
-/
lemma ad_conj {R : Type*} [rack R] (x y : R) :
  act (x ◃ y) = act x * act y * (act x)⁻¹ :=
begin
  apply @mul_right_cancel _ _ _ (act x), ext z,
  simp only [inv_mul_cancel_right],
  apply self_distrib.symm,
end

/--
The opposite rack, swapping the roles of `◃` and `◃⁻¹`.
-/
instance opposite_rack : rack Rᵐᵒᵖ :=
{ act := λ x y, op (inv_act (unop x) (unop y)),
  self_distrib := mul_opposite.rec $ λ x, mul_opposite.rec $ λ y, mul_opposite.rec $ λ z, begin
    simp only [unop_op, op_inj],
    exact self_distrib_inv,
  end,
  inv_act := λ x y, op (shelf.act (unop x) (unop y)),
  left_inv := mul_opposite.rec $ λ x, mul_opposite.rec $ λ y, by simp,
  right_inv := mul_opposite.rec $ λ x, mul_opposite.rec $ λ y, by simp }

@[simp] lemma op_act_op_eq {x y : R} : (op x) ◃ (op y) = op (x ◃⁻¹ y) := rfl
@[simp] lemma op_inv_act_op_eq {x y : R} : (op x) ◃⁻¹ (op y) = op (x ◃ y) := rfl

@[simp]
lemma self_act_act_eq {x y : R} : (x ◃ x) ◃ y = x ◃ y :=
by { rw [←right_inv x y, ←self_distrib] }

@[simp]
lemma self_inv_act_inv_act_eq {x y : R} : (x ◃⁻¹ x) ◃⁻¹ y = x ◃⁻¹ y :=
by { have h := @self_act_act_eq _ _ (op x) (op y), simpa using h }

@[simp]
lemma self_act_inv_act_eq {x y : R} : (x ◃ x) ◃⁻¹ y = x ◃⁻¹ y :=
by { rw ←left_cancel (x ◃ x), rw right_inv, rw self_act_act_eq, rw right_inv }

@[simp]
lemma self_inv_act_act_eq {x y : R} : (x ◃⁻¹ x) ◃ y = x ◃ y :=
by { have h := @self_act_inv_act_eq _ _ (op x) (op y), simpa using h }

lemma self_act_eq_iff_eq {x y : R} : x ◃ x = y ◃ y ↔ x = y :=
begin
  split, swap, rintro rfl, refl,
  intro h,
  transitivity (x ◃ x) ◃⁻¹ (x ◃ x),
  rw [←left_cancel (x ◃ x), right_inv, self_act_act_eq],
  rw [h, ←left_cancel (y ◃ y), right_inv, self_act_act_eq],
end

lemma self_inv_act_eq_iff_eq {x y : R} : x ◃⁻¹ x = y ◃⁻¹ y ↔ x = y :=
by { have h := @self_act_eq_iff_eq _ _ (op x) (op y), simpa using h }

/--
The map `x ↦ x ◃ x` is a bijection.  (This has applications for the
regular isotopy version of the Reidemeister I move for knot diagrams.)
-/
def self_apply_equiv (R : Type*) [rack R] : R ≃ R :=
{ to_fun := λ x, x ◃ x,
  inv_fun := λ x, x ◃⁻¹ x,
  left_inv := λ x, by simp,
  right_inv := λ x, by simp }

/--
An involutory rack is one for which `rack.op R x` is an involution for every x.
-/
def is_involutory (R : Type*) [rack R] : Prop := ∀ x : R, function.involutive (shelf.act x)

lemma involutory_inv_act_eq_act {R : Type*} [rack R] (h : is_involutory R) (x y : R) :
  x ◃⁻¹ y = x ◃ y :=
begin
  rw [←left_cancel x, right_inv],
  exact ((h x).left_inverse y).symm,
end

/--
An abelian rack is one for which the mediality axiom holds.
-/
def is_abelian (R : Type*) [rack R] : Prop :=
∀ (x y z w : R), (x ◃ y) ◃ (z ◃ w) = (x ◃ z) ◃ (y ◃ w)

/--
Associative racks are uninteresting.
-/
lemma assoc_iff_id {R : Type*} [rack R] {x y z : R} :
  x ◃ y ◃ z = (x ◃ y) ◃ z ↔ x ◃ z = z :=
by { rw self_distrib, rw left_cancel }

end rack

namespace shelf_hom
variables {S₁ : Type*} {S₂ : Type*} {S₃ : Type*} [shelf S₁] [shelf S₂] [shelf S₃]

instance : has_coe_to_fun (S₁ →◃ S₂) (λ _, S₁ → S₂) := ⟨shelf_hom.to_fun⟩

@[simp] lemma to_fun_eq_coe (f : S₁ →◃ S₂) : f.to_fun = f := rfl

@[simp] lemma map_act (f : S₁ →◃ S₂) {x y : S₁} : f (x ◃ y) = f x ◃ f y := map_act' f

/-- The identity homomorphism -/
def id (S : Type*) [shelf S] : S →◃ S :=
{ to_fun := id,
  map_act' := by simp }

instance inhabited (S : Type*) [shelf S] : inhabited (S →◃ S) :=
⟨id S⟩

/-- The composition of shelf homomorphisms -/
def comp (g : S₂ →◃ S₃) (f : S₁ →◃ S₂) : S₁ →◃ S₃ :=
{ to_fun := g.to_fun ∘ f.to_fun,
  map_act' := by simp }

@[simp]
lemma comp_apply (g : S₂ →◃ S₃) (f : S₁ →◃ S₂) (x : S₁) :
  (g.comp f) x = g (f x) := rfl

end shelf_hom

/--
A quandle is a rack such that each automorphism fixes its corresponding element.
-/
class quandle (α : Type*) extends rack α :=
(fix : ∀ {x : α}, act x x = x)

namespace quandle
open rack
variables {Q : Type*} [quandle Q]

attribute [simp] fix

@[simp]
lemma fix_inv {x : Q} : x ◃⁻¹ x = x :=
by { rw ←left_cancel x, simp }

instance opposite_quandle : quandle Qᵐᵒᵖ :=
{ fix := λ x, by { induction x using mul_opposite.rec, simp } }

/--
The conjugation quandle of a group.  Each element of the group acts by
the corresponding inner automorphism.
-/
@[nolint has_inhabited_instance]
def conj (G : Type*) := G

instance conj.quandle (G : Type*) [group G] : quandle (conj G) :=
{ act := (λ x, @mul_aut.conj G _ x),
  self_distrib := λ x y z, begin
    dsimp only [mul_equiv.coe_to_equiv, mul_aut.conj_apply, conj],
    group,
  end,
  inv_act := (λ x, (@mul_aut.conj G _ x).symm),
  left_inv := λ x y, by { dsimp [act, conj], group },
  right_inv := λ x y, by { dsimp [act, conj], group },
  fix := λ x, by simp }

@[simp]
lemma conj_act_eq_conj {G : Type*} [group G] (x y : conj G) :
  x ◃ y = ((x : G) * (y : G) * (x : G)⁻¹ : G) := rfl

lemma conj_swap {G : Type*} [group G] (x y : conj G) :
  x ◃ y = y ↔ y ◃ x = x :=
begin
  dsimp [conj] at *, split,
  repeat { intro h, conv_rhs { rw eq_mul_inv_of_mul_eq (eq_mul_inv_of_mul_eq h) }, simp, },
end

/--
`conj` is functorial
-/
def conj.map {G : Type*} {H : Type*} [group G] [group H] (f : G →* H) : conj G →◃ conj H :=
{ to_fun := f,
  map_act' := by simp }

instance {G : Type*} {H : Type*} [group G] [group H] : has_lift (G →* H) (conj G →◃ conj H) :=
{ lift := conj.map }

/--
The dihedral quandle. This is the conjugation quandle of the dihedral group restrict to flips.

Used for Fox n-colorings of knots.
-/
@[nolint has_inhabited_instance]
def dihedral (n : ℕ) := zmod n

/--
The operation for the dihedral quandle.  It does not need to be an equivalence
because it is an involution (see `dihedral_act.inv`).
-/
def dihedral_act (n : ℕ) (a : zmod n) : zmod n → zmod n :=
λ b, 2 * a - b

lemma dihedral_act.inv (n : ℕ) (a : zmod n) : function.involutive (dihedral_act n a) :=
by { intro b, dsimp [dihedral_act], ring }

instance (n : ℕ) : quandle (dihedral n) :=
{ act := dihedral_act n,
  self_distrib := λ x y z, begin
    dsimp [dihedral_act], ring,
  end,
  inv_act := dihedral_act n,
  left_inv := λ x, (dihedral_act.inv n x).left_inverse,
  right_inv := λ x, (dihedral_act.inv n x).right_inverse,
  fix := λ x, begin
    dsimp [dihedral_act], ring,
  end }

end quandle

namespace rack

/--
This is the natural rack homomorphism to the conjugation quandle of the group `R ≃ R`
that acts on the rack.
-/
def to_conj (R : Type*) [rack R] : R →◃ quandle.conj (R ≃ R) :=
{ to_fun := act,
  map_act' := ad_conj }

section envel_group

/-!
### Universal enveloping group of a rack

The universal enveloping group `envel_group R` of a rack `R` is the
universal group such that every rack homomorphism `R →◃ conj G` is
induced by a unique group homomorphism `envel_group R →* G`.
For quandles, Joyce called this group `AdConj R`.

The `envel_group` functor is left adjoint to the `conj` forgetful
functor, and the way we construct the enveloping group is via a
technique that should work for left adjoints of forgetful functors in
general.  It involves thinking a little about 2-categories, but the
payoff is that the map `envel_group R →* G` has a nice description.

Let's think of a group as being a one-object category.  The first step
is to define `pre_envel_group`, which gives formal expressions for all
the 1-morphisms and includes the unit element, elements of `R`,
multiplication, and inverses.  To introduce relations, the second step
is to define `pre_envel_group_rel'`, which gives formal expressions
for all 2-morphisms between the 1-morphisms.  The 2-morphisms include
associativity, multiplication by the unit, multiplication by inverses,
compatibility with multiplication and inverses (`congr_mul` and
`congr_inv`), the axioms for an equivalence relation, and,
importantly, the relationship between conjugation and the rack action
(see `rack.ad_conj`).

None of this forms a 2-category yet, for example due to lack of
associativity of `trans`.  The `pre_envel_group_rel` relation is a
`Prop`-valued version of `pre_envel_group_rel'`, and making it
`Prop`-valued essentially introduces enough 3-isomorphisms so that
every pair of compatible 2-morphisms is isomorphic.  Now, while
composition in `pre_envel_group` does not strictly satisfy the category
axioms, `pre_envel_group` and `pre_envel_group_rel'` do form a weak
2-category.

Since we just want a 1-category, the last step is to quotient
`pre_envel_group` by `pre_envel_group_rel'`, and the result is the
group `envel_group`.

For a homomorphism `f : R →◃ conj G`, how does
`envel_group.map f : envel_group R →* G` work?  Let's think of `G` as
being a 2-category with one object, a 1-morphism per element of `G`,
and a single 2-morphism called `eq.refl` for each 1-morphism.  We
define the map using a "higher `quotient.lift`" -- not only do we
evaluate elements of `pre_envel_group` as expressions in `G` (this is
`to_envel_group.map_aux`), but we evaluate elements of
`pre_envel_group'` as expressions of 2-morphisms of `G` (this is
`to_envel_group.map_aux.well_def`).  That is to say,
`to_envel_group.map_aux.well_def` recursively evaluates formal
expressions of 2-morphisms as equality proofs in `G`.  Now that all
morphisms are accounted for, the map descends to a homomorphism
`envel_group R →* G`.

Note: `Type`-valued relations are not common.  The fact it is
`Type`-valued is what makes `to_envel_group.map_aux.well_def` have
well-founded recursion.
-/

/--
Free generators of the enveloping group.
-/
inductive pre_envel_group (R : Type u) : Type u
| unit : pre_envel_group
| incl (x : R) : pre_envel_group
| mul (a b : pre_envel_group) : pre_envel_group
| inv (a : pre_envel_group) : pre_envel_group

instance pre_envel_group.inhabited (R : Type u) : inhabited (pre_envel_group R) :=
⟨pre_envel_group.unit⟩

open pre_envel_group

/--
Relations for the enveloping group. This is a type-valued relation because
`to_envel_group.map_aux.well_def` inducts on it to show `to_envel_group.map`
is well-defined.  The relation `pre_envel_group_rel` is the `Prop`-valued version,
which is used to define `envel_group` itself.
-/
inductive pre_envel_group_rel' (R : Type u) [rack R] :
  pre_envel_group R → pre_envel_group R → Type u
| refl {a : pre_envel_group R} : pre_envel_group_rel' a a
| symm {a b : pre_envel_group R} (hab : pre_envel_group_rel' a b) : pre_envel_group_rel' b a
| trans {a b c : pre_envel_group R}
  (hab : pre_envel_group_rel' a b) (hbc : pre_envel_group_rel' b c) : pre_envel_group_rel' a c
| congr_mul {a b a' b' : pre_envel_group R}
  (ha : pre_envel_group_rel' a a') (hb : pre_envel_group_rel' b b') :
  pre_envel_group_rel' (mul a b) (mul a' b')
| congr_inv {a a' : pre_envel_group R} (ha : pre_envel_group_rel' a a') :
  pre_envel_group_rel' (inv a) (inv a')
| assoc (a b c : pre_envel_group R) : pre_envel_group_rel' (mul (mul a b) c) (mul a (mul b c))
| one_mul (a : pre_envel_group R) : pre_envel_group_rel' (mul unit a) a
| mul_one (a : pre_envel_group R) : pre_envel_group_rel' (mul a unit) a
| mul_left_inv (a : pre_envel_group R) : pre_envel_group_rel' (mul (inv a) a) unit
| act_incl (x y : R) :
  pre_envel_group_rel' (mul (mul (incl x) (incl y)) (inv (incl x))) (incl (x ◃ y))

instance pre_envel_group_rel'.inhabited (R : Type u) [rack R] :
  inhabited (pre_envel_group_rel' R unit unit) :=
⟨pre_envel_group_rel'.refl⟩

/--
The `pre_envel_group_rel` relation as a `Prop`.  Used as the relation for `pre_envel_group.setoid`.
-/
inductive pre_envel_group_rel (R : Type u) [rack R] : pre_envel_group R → pre_envel_group R → Prop
| rel {a b : pre_envel_group R} (r : pre_envel_group_rel' R a b) : pre_envel_group_rel a b

/--
A quick way to convert a `pre_envel_group_rel'` to a `pre_envel_group_rel`.
-/
lemma pre_envel_group_rel'.rel {R : Type u} [rack R] {a b : pre_envel_group R} :
  pre_envel_group_rel' R a b → pre_envel_group_rel R a b :=
pre_envel_group_rel.rel

@[refl]
lemma pre_envel_group_rel.refl {R : Type u} [rack R] {a : pre_envel_group R} :
  pre_envel_group_rel R a a :=
pre_envel_group_rel.rel pre_envel_group_rel'.refl

@[symm]
lemma pre_envel_group_rel.symm {R : Type u} [rack R] {a b : pre_envel_group R} :
  pre_envel_group_rel R a b → pre_envel_group_rel R b a
| ⟨r⟩ := r.symm.rel

@[trans]
lemma pre_envel_group_rel.trans {R : Type u} [rack R] {a b c : pre_envel_group R} :
  pre_envel_group_rel R a b → pre_envel_group_rel R b c → pre_envel_group_rel R a c
| ⟨rab⟩ ⟨rbc⟩ := (rab.trans rbc).rel

instance pre_envel_group.setoid (R : Type*) [rack R] : setoid (pre_envel_group R) :=
{ r := pre_envel_group_rel R,
  iseqv := begin
    split, apply pre_envel_group_rel.refl,
    split, apply pre_envel_group_rel.symm,
    apply pre_envel_group_rel.trans
  end }

/--
The universal enveloping group for the rack R.
-/
def envel_group (R : Type*) [rack R] := quotient (pre_envel_group.setoid R)

-- Define the `group` instances in two steps so `inv` can be inferred correctly.
-- TODO: is there a non-invasive way of defining the instance directly?
instance (R : Type*) [rack R] : div_inv_monoid (envel_group R) :=
{ mul := λ a b, quotient.lift_on₂ a b
                  (λ a b, ⟦pre_envel_group.mul a b⟧)
                  (λ a b a' b' ⟨ha⟩ ⟨hb⟩,
                    quotient.sound (pre_envel_group_rel'.congr_mul ha hb).rel),
  one := ⟦unit⟧,
  inv := λ a, quotient.lift_on a
                (λ a, ⟦pre_envel_group.inv a⟧)
                (λ a a' ⟨ha⟩,
                  quotient.sound (pre_envel_group_rel'.congr_inv ha).rel),
  mul_assoc := λ a b c,
    quotient.induction_on₃ a b c (λ a b c, quotient.sound (pre_envel_group_rel'.assoc a b c).rel),
  one_mul := λ a,
    quotient.induction_on a (λ a, quotient.sound (pre_envel_group_rel'.one_mul a).rel),
  mul_one := λ a,
    quotient.induction_on a (λ a, quotient.sound (pre_envel_group_rel'.mul_one a).rel),}

instance (R : Type*) [rack R] : group (envel_group R) :=
{ mul_left_inv := λ a,
    quotient.induction_on a (λ a, quotient.sound (pre_envel_group_rel'.mul_left_inv a).rel),
  .. envel_group.div_inv_monoid _ }

instance envel_group.inhabited (R : Type*) [rack R] : inhabited (envel_group R) := ⟨1⟩

/--
The canonical homomorphism from a rack to its enveloping group.
Satisfies universal properties given by `to_envel_group.map` and `to_envel_group.univ`.
-/
def to_envel_group (R : Type*) [rack R] : R →◃ quandle.conj (envel_group R) :=
{ to_fun := λ x, ⟦incl x⟧,
  map_act' := λ x y, quotient.sound (pre_envel_group_rel'.act_incl x y).symm.rel }

/--
The preliminary definition of the induced map from the enveloping group.
See `to_envel_group.map`.
-/
def to_envel_group.map_aux {R : Type*} [rack R] {G : Type*} [group G]
  (f : R →◃ quandle.conj G) : pre_envel_group R → G
| unit := 1
| (incl x) := f x
| (mul a b) := to_envel_group.map_aux a * to_envel_group.map_aux b
| (inv a) := (to_envel_group.map_aux a)⁻¹

namespace to_envel_group.map_aux
open pre_envel_group_rel'

/--
Show that `to_envel_group.map_aux` sends equivalent expressions to equal terms.
-/
lemma well_def {R : Type*} [rack R] {G : Type*} [group G] (f : R →◃ quandle.conj G) :
  Π {a b : pre_envel_group R}, pre_envel_group_rel' R a b →
  to_envel_group.map_aux f a = to_envel_group.map_aux f b
| a b refl := rfl
| a b (symm h) := (well_def h).symm
| a b (trans hac hcb) := eq.trans (well_def hac) (well_def hcb)
| _ _ (congr_mul ha hb) := by { simp [to_envel_group.map_aux, well_def ha, well_def hb] }
| _ _ (congr_inv ha) := by { simp [to_envel_group.map_aux, well_def ha] }
| _ _ (assoc a b c) := by { apply mul_assoc }
| _ _ (one_mul a) := by { simp [to_envel_group.map_aux] }
| _ _ (mul_one a) := by { simp [to_envel_group.map_aux] }
| _ _ (mul_left_inv a) := by { simp [to_envel_group.map_aux] }
| _ _ (act_incl x y) := by { simp [to_envel_group.map_aux] }

end to_envel_group.map_aux

/--
Given a map from a rack to a group, lift it to being a map from the enveloping group.
More precisely, the `envel_group` functor is left adjoint to `quandle.conj`.
-/
def to_envel_group.map {R : Type*} [rack R] {G : Type*} [group G] :
  (R →◃ quandle.conj G) ≃ (envel_group R →* G) :=
{ to_fun := λ f,
  { to_fun := λ x, quotient.lift_on x (to_envel_group.map_aux f)
                    (λ a b ⟨hab⟩, to_envel_group.map_aux.well_def f hab),
    map_one' := begin
      change quotient.lift_on ⟦rack.pre_envel_group.unit⟧ (to_envel_group.map_aux f) _ = 1,
      simp [to_envel_group.map_aux],
    end,
    map_mul' := λ x y, quotient.induction_on₂ x y (λ x y, begin
      change quotient.lift_on ⟦mul x y⟧ (to_envel_group.map_aux f) _ = _,
      simp [to_envel_group.map_aux],
    end) },
  inv_fun := λ F, (quandle.conj.map F).comp (to_envel_group R),
  left_inv := λ f, by { ext, refl },
  right_inv := λ F, monoid_hom.ext $ λ x, quotient.induction_on x $ λ x, begin
    induction x,
    { exact F.map_one.symm, },
    { refl, },
    { have hm : ⟦x_a.mul x_b⟧ = @has_mul.mul (envel_group R) _ ⟦x_a⟧ ⟦x_b⟧ := rfl,
      rw [hm, F.map_mul, monoid_hom.map_mul, ←x_ih_a, ←x_ih_b] },
    { have hm : ⟦x_a.inv⟧ = @has_inv.inv (envel_group R) _ ⟦x_a⟧ := rfl,
      rw [hm, F.map_inv, monoid_hom.map_inv, x_ih], }
  end, }

/--
Given a homomorphism from a rack to a group, it factors through the enveloping group.
-/
lemma to_envel_group.univ (R : Type*) [rack R] (G : Type*) [group G]
  (f : R →◃ quandle.conj G) :
  (quandle.conj.map (to_envel_group.map f)).comp (to_envel_group R) = f :=
to_envel_group.map.symm_apply_apply f

/--
The homomorphism `to_envel_group.map f` is the unique map that fits into the commutative
triangle in `to_envel_group.univ`.
-/
lemma to_envel_group.univ_uniq (R : Type*) [rack R] (G : Type*) [group G]
  (f : R →◃ quandle.conj G)
  (g : envel_group R →* G) (h : f = (quandle.conj.map g).comp (to_envel_group R)) :
  g = to_envel_group.map f :=
h.symm ▸ (to_envel_group.map.apply_symm_apply g).symm

/--
The induced group homomorphism from the enveloping group into bijections of the rack,
using `rack.to_conj`. Satisfies the property `envel_action_prop`.

This gives the rack `R` the structure of an augmented rack over `envel_group R`.
-/
def envel_action {R : Type*} [rack R] : envel_group R →* (R ≃ R) :=
to_envel_group.map (to_conj R)

@[simp]

end envel_group

end rack


/-
Copyright (c) 2019 The Flypitch Project. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Authors: Jesse Han, Floris van Doorn
-/
import .fol

open fol

local notation h :: t  := dvector.cons h t
local notation `[]` := dvector.nil
local notation `[` l:(foldr `, ` (h t, dvector.cons h t) dvector.nil `]`) := l

namespace abel
section

/- The language of abelian groups -/
inductive abel_functions : ℕ → Type
| zero : abel_functions 0
| plus : abel_functions 2

def L_abel : Language := ⟨abel_functions, λn, pempty⟩

def L_abel_plus {n} (t₁ t₂ : bounded_term L_abel n) : bounded_term L_abel n :=
@bounded_term_of_function L_abel 2 n abel_functions.plus t₁ t₂

def zero {n} : bounded_term L_abel n := bd_const abel_functions.zero

local infix ` +' `:100 := _root_.abel.L_abel_plus

def a_assoc : sentence L_abel := ∀' ∀' ∀' (((&2 +' &1) +' &0) ≃ (&2 +' (&1 +' &0)))

def a_zero_right : sentence L_abel := ∀' (&0 +' zero ≃ &0)

def a_zero_left : sentence L_abel := ∀'(zero +' &0 ≃ &0)

def a_inv : sentence L_abel := ∀' ∃' (&1 +' &0 ≃ zero ⊓ &0 +' &1 ≃ zero)

def a_comm : sentence L_abel := ∀' ∀' (&1 +' &0 ≃ &0 +' &1)

/- axioms of abelian groups -/
def T_ab : Theory L_abel := {a_assoc, a_zero_right, a_zero_left, a_inv, a_comm}

def L_abel_structure_of_int : Structure L_abel :=
begin
  refine ⟨ℤ,_,_⟩,
  {intros n f, induction f,
    exact λ v, 0,
    exact λ v, (v.nth 0 (by repeat{constructor})) + (v.nth 1 (by repeat{constructor}))},
  {intros, cases a}
end

notation `ℤ'` := _root_.abel.L_abel_structure_of_int

@[simp]lemma ℤ'_ℤ : ↥(ℤ') = ℤ := by refl

@[reducible]instance has_zero_ℤ' : has_zero ℤ' := ⟨(0 : ℤ)⟩

@[reducible]instance has_add_ℤ' : has_add ℤ' := ⟨λx y, (x + y : ℤ)⟩

@[reducible]instance nonempty_ℤ' : nonempty ℤ' := by simp

@[simp]lemma zero_is_zero : @realize_bounded_term L_abel ℤ' _ [] _ zero [] = (0 : ℤ) := by refl

@[simp]lemma plus_is_plus_l : ∀ x y : ℤ', realize_bounded_term ([x,y]) (&0 +' &1) [] = x + y := by {intros, refl}

@[simp]lemma plus_is_plus_r : ∀ x y : ℤ', realize_bounded_term ([x,y]) (&1 +' &0) [] = y + x := by {intros, refl}

-- instance has_add_Structure_L_abel {S : Structure L_abel} : has_add S :=
--   ⟨λ x y, realize_bounded_term ([x,y]) (&0 +' &1) []⟩

-- @[simp]lemma plus_is_plus {S : Structure L_abel} {n} {t₁ t₂ : bounded_term L_abel n} {v : dvector S n} : realize_bounded_term v (t₁ +' t₂) [] = (realize_bounded_term v t₁ []) + (realize_bounded_term v t₂ []) := by refl

/- Note: the above seems to confuse the elaborator when proving the theorem below. Probably because ℤ has an existing has_add instance. -/

def presburger_arithmetic : Theory L_abel := Th ℤ'

theorem ℤ'_is_abelian_group : T_ab ⊆ presburger_arithmetic :=
begin
  intros a H, repeat{cases H},
  {intros x y, simp},
  {intros x H, dsimp at H, unfold realize_bounded_formula, have : ∃ y : ℤ, x + y = 0,
  by {refine ⟨-x, _⟩, simp}, rcases this with ⟨y, hy⟩, apply H y, simp[hy], refl},
  {intro x, change 0 + x = x, rw[zero_add]},
  {intro x, change x + 0 = x, rw[add_zero]},
  {intros x y z, change x + y + z = x + (y + z), rw[add_assoc]}
end

end
end abel


/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson
-/
import computability.DFA
import data.set.functor

/-!
# Nondeterministic Finite Automata
This file contains the definition of a Nondeterministic Finite Automaton (NFA), a state machine
which determines whether a string (implemented as a list over an arbitrary alphabet) is in a regular
set by evaluating the string over every possible path.
We show that DFA's are equivalent to NFA's however the construction from NFA to DFA uses an
exponential number of states.
Note that this definition allows for Automaton with infinite states, a `fintype` instance must be
supplied for true NFA's.
-/

open set

universes u v

/-- An NFA is a set of states (`σ`), a transition function from state to state labelled by the
  alphabet (`step`), a starting state (`start`) and a set of acceptance states (`accept`).
  Note the transition function sends a state to a `set` of states. These are the states that it
  may be sent to. -/
structure NFA (α : Type u) (σ : Type v) :=
(step : σ → α → set σ)
(start : set σ)
(accept : set σ)

variables {α : Type u} {σ σ' : Type v} (M : NFA α σ)

namespace NFA

instance : inhabited (NFA α σ) := ⟨ NFA.mk (λ _ _, ∅) ∅ ∅ ⟩

/-- `M.step_set S a` is the union of `M.step s a` for all `s ∈ S`. -/
def step_set (S : set σ) (a : α) : set σ := ⋃ s ∈ S, M.step s a

lemma mem_step_set (s : σ) (S : set σ) (a : α) : s ∈ M.step_set S a ↔ ∃ t ∈ S, s ∈ M.step t a :=
mem_Union₂

@[simp] lemma step_set_empty (a : α) : M.step_set ∅ a = ∅ :=
by simp_rw [step_set, Union_false, Union_empty]

/-- `M.eval_from S x` computes all possible paths though `M` with input `x` starting at an element
  of `S`. -/
def eval_from (start : set σ) : list α → set σ :=
list.foldl M.step_set start

@[simp] lemma eval_from_nil (S : set σ) : M.eval_from S [] = S := rfl
@[simp] lemma eval_from_singleton (S : set σ) (a : α) : M.eval_from S [a] = M.step_set S a := rfl
@[simp] lemma eval_from_append_singleton (S : set σ) (x : list α) (a : α) :
  M.eval_from S (x ++ [a]) = M.step_set (M.eval_from S x) a :=
by simp only [eval_from, list.foldl_append, list.foldl_cons, list.foldl_nil]

/-- `M.eval x` computes all possible paths though `M` with input `x` starting at an element of
  `M.start`. -/
def eval : list α → set σ := M.eval_from M.start

@[simp] lemma eval_nil : M.eval [] = M.start := rfl
@[simp] lemma eval_singleton (a : α) : M.eval [a] = M.step_set M.start a := rfl
@[simp] lemma eval_append_singleton (x : list α) (a : α) :
  M.eval (x ++ [a]) = M.step_set (M.eval x) a :=
eval_from_append_singleton _ _ _ _

/-- `M.accepts` is the language of `x` such that there is an accept state in `M.eval x`. -/
def accepts : language α :=
λ x, ∃ S ∈ M.accept, S ∈ M.eval x

/-- `M.to_DFA` is an `DFA` constructed from a `NFA` `M` using the subset construction. The
  states is the type of `set`s of `M.state` and the step function is `M.step_set`. -/
def to_DFA : DFA α (set σ) :=
{ step := M.step_set,
  start := M.start,
  accept := {S | ∃ s ∈ S, s ∈ M.accept} }

@[simp] lemma to_DFA_correct :
  M.to_DFA.accepts = M.accepts :=
begin
  ext x,
  rw [accepts, DFA.accepts, eval, DFA.eval],
  change list.foldl _ _ _ ∈ {S | _} ↔ _,
  split; { exact λ ⟨w, h2, h3⟩, ⟨w, h3, h2⟩ },
end

lemma pumping_lemma [fintype σ] {x : list α} (hx : x ∈ M.accepts)
  (hlen : fintype.card (set σ) ≤ list.length x) :
  ∃ a b c, x = a ++ b ++ c ∧ a.length + b.length ≤ fintype.card (set σ) ∧ b ≠ [] ∧
  {a} * language.star {b} * {c} ≤ M.accepts :=
begin
  rw ←to_DFA_correct at hx ⊢,
  exact M.to_DFA.pumping_lemma hx hlen
end

end NFA

namespace DFA

/-- `M.to_NFA` is an `NFA` constructed from a `DFA` `M` by using the same start and accept
  states and a transition function which sends `s` with input `a` to the singleton `M.step s a`. -/
def to_NFA (M : DFA α σ') : NFA α σ' :=
{ step := λ s a, {M.step s a},
  start := {M.start},
  accept := M.accept }

@[simp] lemma to_NFA_eval_from_match (M : DFA α σ) (start : σ) (s : list α) :
  M.to_NFA.eval_from {start} s = {M.eval_from start s} :=
begin
  change list.foldl M.to_NFA.step_set {start} s = {list.foldl M.step start s},
  induction s with a s ih generalizing start,
  { tauto },
  { rw [list.foldl, list.foldl,
        show M.to_NFA.step_set {start} a = {M.step start a}, by simpa [NFA.step_set]],
    tauto }
end

@[simp] lemma to_NFA_correct (M : DFA α σ) :
  M.to_NFA.accepts = M.accepts :=
begin
  ext x,
  change (∃ S H, S ∈ M.to_NFA.eval_from {M.start} x) ↔ _,
  rw to_NFA_eval_from_match,
  split,
  { rintro ⟨ S, hS₁, hS₂ ⟩,
    rwa set.mem_singleton_iff.mp hS₂ at hS₁ },
  { exact λ h, ⟨M.eval x, h, rfl⟩ }
end

end DFA


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# Logic in Lean, example sheet 3 : "not" (`¬`)

We learn about how to manipulate `¬ P` in Lean.

# Important : the definition of `¬ P`

In Lean, `¬ P` is *defined* to mean `P → false`. So `¬ P` and `P → false`
are *definitionally equal*. Check out the explanation of definitional
equality in the "equality" section of Part B of the course notes.

## Tactics

You'll need to know about the tactics from the previous sheets,
and the following tactics may also be useful:

* `change`
* `by_contra`
* `by_cases`

-/

-- Throughout this sheet, `P`, `Q` and `R` will denote propositions.

variables (P Q R : Prop)

example : ¬ true → false :=
begin
  sorry
end

example : false → ¬ true :=
begin
  sorry
end

example : ¬ false → true :=
begin
  sorry
end

example : true → ¬ false :=
begin
  sorry
end

example : false → ¬ P :=
begin
  sorry
end

example : P → ¬ P → false :=
begin
  sorry
end

example : P → ¬ (¬ P) :=
begin
  sorry
end

example : (P → Q) → (¬ Q → ¬ P) :=
begin
  sorry
end

example : ¬ ¬ false → false :=
begin
  sorry
end

example : ¬ ¬ P → P :=
begin
  sorry
end

example : (¬ Q → ¬ P) → (P → Q) :=
begin
  sorry,
end


import analysis.inner_product_space.basic
import analysis.inner_product_space.pi_L2
import analysis.normed_space.pi_Lp

variables {F M m : Type*}
[is_R_or_C F]
[fintype m]
[decidable_eq m]

def std_basis (F m : Type*) [is_R_or_C F] [fintype m] [decidable_eq m]: m → (euclidean_space F m) := λ (i : m), (λ (j : m), ite (i = j) 1 0)

lemma std_basis_on : orthonormal F (std_basis F m) :=
begin
  rw std_basis,
  rw orthonormal,
  split,
  {
    intro i,
    rw euclidean_space.norm_eq,
    simp,
    have : (λ (i_1 : m), ∥ ite (i = i_1) (1:F) (0 : F) ∥^2) = λ (i_1 : m), ite (i = i_1) 1 0 :=
    begin
      ext,
      split_ifs,
      simp,
      simp,
    end,
    rw this,
    rw finset.sum_ite,
    simp,
    have : (finset.filter (eq i) finset.univ).card = 1 :=
    begin
      rw finset.card_eq_one,
      use i,
      ext,
      split,
      intro h,
      have : a = i :=
      begin
        simp at h,
        rw h,
      end,
      rw this,
      simp,
      intro h,
      simp at h,
      simp,
      rw h,
    end,
    rw this,
    simp,
  },
  {
    intros i_1 i_2 hij,
    unfold inner,
    simp,
    exact hij,
  }
end


/-
Copyright (c) 2020 Devon Tuma. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Devon Tuma
-/
import ring_theory.ideal.operations
import ring_theory.polynomial.basic

/-!
# Jacobson radical

The Jacobson radical of a ring `R` is defined to be the intersection of all maximal ideals of `R`.
This is similar to how the nilradical is equal to the intersection of all prime ideals of `R`.

We can extend the idea of the nilradical to ideals of `R`,
by letting the radical of an ideal `I` be the intersection of prime ideals containing `I`.
Under this extension, the original nilradical is the radical of the zero ideal `⊥`.
Here we define the Jacobson radical of an ideal `I` in a similar way,
as the intersection of maximal ideals containing `I`.

## Main definitions

Let `R` be a commutative ring, and `I` be an ideal of `R`

* `jacobson I` is the jacobson radical, i.e. the infimum of all maximal ideals containing I.

* `is_local I` is the proposition that the jacobson radical of `I` is itself a maximal ideal

## Main statements

* `mem_jacobson_iff` gives a characterization of members of the jacobson of I

* `is_local_of_is_maximal_radical`: if the radical of I is maximal then so is the jacobson radical

## Tags

Jacobson, Jacobson radical, Local Ideal

-/

universes u v

namespace ideal
variables {R : Type u} [comm_ring R] {I : ideal R}
variables {S : Type v} [comm_ring S]

section jacobson

/-- The Jacobson radical of `I` is the infimum of all maximal ideals containing `I`. -/
def jacobson (I : ideal R) : ideal R :=
Inf {J : ideal R | I ≤ J ∧ is_maximal J}

lemma le_jacobson : I ≤ jacobson I :=
λ x hx, mem_Inf.mpr (λ J hJ, hJ.left hx)

@[simp] lemma jacobson_idem : jacobson (jacobson I) = jacobson I :=
le_antisymm (Inf_le_Inf (λ J hJ, ⟨Inf_le hJ, hJ.2⟩)) le_jacobson

lemma radical_le_jacobson : radical I ≤ jacobson I :=
le_Inf (λ J hJ, (radical_eq_Inf I).symm ▸ Inf_le ⟨hJ.left, is_maximal.is_prime hJ.right⟩)

lemma eq_radical_of_eq_jacobson : jacobson I = I → radical I = I :=
λ h, le_antisymm (le_trans radical_le_jacobson (le_of_eq h)) le_radical

@[simp] lemma jacobson_top : jacobson (⊤ : ideal R) = ⊤ :=
eq_top_iff.2 le_jacobson

@[simp] theorem jacobson_eq_top_iff : jacobson I = ⊤ ↔ I = ⊤ :=
⟨λ H, classical.by_contradiction $ λ hi, let ⟨M, hm, him⟩ := exists_le_maximal I hi in
  lt_top_iff_ne_top.1
    (lt_of_le_of_lt (show jacobson I ≤ M, from Inf_le ⟨him, hm⟩) $
      lt_top_iff_ne_top.2 hm.ne_top) H,
λ H, eq_top_iff.2 $ le_Inf $ λ J ⟨hij, hj⟩, H ▸ hij⟩

lemma jacobson_eq_bot : jacobson I = ⊥ → I = ⊥ :=
λ h, eq_bot_iff.mpr (h ▸ le_jacobson)

lemma jacobson_eq_self_of_is_maximal [H : is_maximal I] : I.jacobson = I :=
le_antisymm (Inf_le ⟨le_of_eq rfl, H⟩) le_jacobson

@[priority 100]
instance jacobson.is_maximal [H : is_maximal I] : is_maximal (jacobson I) :=
⟨⟨λ htop, H.1.1 (jacobson_eq_top_iff.1 htop),
  λ J hJ, H.1.2 _ (lt_of_le_of_lt le_jacobson hJ)⟩⟩

theorem mem_jacobson_iff {x : R} : x ∈ jacobson I ↔ ∀ y, ∃ z, x * y * z + z - 1 ∈ I :=
⟨λ hx y, classical.by_cases
  (assume hxy : I ⊔ span {x * y + 1} = ⊤,
    let ⟨p, hpi, q, hq, hpq⟩ := submodule.mem_sup.1 ((eq_top_iff_one _).1 hxy) in
    let ⟨r, hr⟩ := mem_span_singleton.1 hq in
    ⟨r, by rw [← one_mul r, ← mul_assoc, ← add_mul, mul_one, ← hr, ← hpq, ← neg_sub,
               add_sub_cancel]; exact I.neg_mem hpi⟩)
  (assume hxy : I ⊔ span {x * y + 1} ≠ ⊤,
    let ⟨M, hm1, hm2⟩ := exists_le_maximal _ hxy in
    suffices x ∉ M, from (this $ mem_Inf.1 hx ⟨le_trans le_sup_left hm2, hm1⟩).elim,
    λ hxm, hm1.1.1 $ (eq_top_iff_one _).2 $ add_sub_cancel' (x * y) 1 ▸ M.sub_mem
      (le_trans le_sup_right hm2 $ mem_span_singleton.2 $ dvd_refl _)
      (M.mul_mem_right _ hxm)),
λ hx, mem_Inf.2 $ λ M ⟨him, hm⟩, classical.by_contradiction $ λ hxm,
  let ⟨y, hy⟩ := hm.exists_inv hxm, ⟨z, hz⟩ := hx (-y) in
  hm.1.1 $ (eq_top_iff_one _).2 $ sub_sub_cancel (x * -y * z + z) 1 ▸ M.sub_mem
    (by { rw [← one_mul z, ← mul_assoc, ← add_mul, mul_one, mul_neg_eq_neg_mul_symm, neg_add_eq_sub,
        ← neg_sub, neg_mul_eq_neg_mul_symm, neg_mul_eq_mul_neg, mul_comm x y, mul_comm _ (- z)],
      rcases hy with ⟨i, hi, df⟩,
      rw [← (sub_eq_iff_eq_add.mpr df.symm), sub_sub, add_comm, ← sub_sub, sub_self, zero_sub],
      refine M.mul_mem_left (-z) ((neg_mem_iff _).mpr hi) }) (him hz)⟩

/-- An ideal equals its Jacobson radical iff it is the intersection of a set of maximal ideals.
Allowing the set to include ⊤ is equivalent, and is included only to simplify some proofs. -/
theorem eq_jacobson_iff_Inf_maximal :
  I.jacobson = I ↔ ∃ M : set (ideal R), (∀ J ∈ M, is_maximal J ∨ J = ⊤) ∧ I = Inf M :=
begin
  use λ hI, ⟨{J : ideal R | I ≤ J ∧ J.is_maximal}, ⟨λ _ hJ, or.inl hJ.right, hI.symm⟩⟩,
  rintros ⟨M, hM, hInf⟩,
  refine le_antisymm (λ x hx, _) le_jacobson,
  rw [hInf, mem_Inf],
  intros I hI,
  cases hM I hI with is_max is_top,
  { exact (mem_Inf.1 hx) ⟨le_Inf_iff.1 (le_of_eq hInf) I hI, is_max⟩ },
  { exact is_top.symm ▸ submodule.mem_top }
end

theorem eq_jacobson_iff_Inf_maximal' :
  I.jacobson = I ↔ ∃ M : set (ideal R), (∀ (J ∈ M) (K : ideal R), J < K → K = ⊤) ∧ I = Inf M :=
eq_jacobson_iff_Inf_maximal.trans
  ⟨λ h, let ⟨M, hM⟩ := h in ⟨M, ⟨λ J hJ K hK, or.rec_on (hM.1 J hJ) (λ h, h.1.2 K hK)
    (λ h, eq_top_iff.2 (le_of_lt (h ▸ hK))), hM.2⟩⟩,
  λ h, let ⟨M, hM⟩ := h in ⟨M, ⟨λ J hJ, or.rec_on (classical.em (J = ⊤)) (λ h, or.inr h)
    (λ h, or.inl ⟨⟨h, hM.1 J hJ⟩⟩), hM.2⟩⟩⟩

/-- An ideal `I` equals its Jacobson radical if and only if every element outside `I`
also lies outside of a maximal ideal containing `I`. -/
lemma eq_jacobson_iff_not_mem :
  I.jacobson = I ↔ ∀ x ∉ I, ∃ M : ideal R, (I ≤ M ∧ M.is_maximal) ∧ x ∉ M :=
begin
  split,
  { intros h x hx,
    erw [← h, mem_Inf] at hx,
    push_neg at hx,
    exact hx },
  { refine λ h, le_antisymm (λ x hx, _) le_jacobson,
    contrapose hx,
    erw mem_Inf,
    push_neg,
    exact h x hx }
end

theorem map_jacobson_of_surjective {f : R →+* S} (hf : function.surjective f) :
  ring_hom.ker f ≤ I → map f (I.jacobson) = (map f I).jacobson :=
begin
  intro h,
  unfold ideal.jacobson,
  have : ∀ J ∈ {J : ideal R | I ≤ J ∧ J.is_maximal}, f.ker ≤ J := λ J hJ, le_trans h hJ.left,
  refine trans (map_Inf hf this) (le_antisymm _ _),
  { refine Inf_le_Inf (λ J hJ, ⟨comap f J, ⟨⟨le_comap_of_map_le hJ.1, _⟩,
    map_comap_of_surjective f hf J⟩⟩),
    haveI : J.is_maximal := hJ.right,
    exact comap_is_maximal_of_surjective f hf },
  { refine Inf_le_Inf_of_subset_insert_top (λ j hj, hj.rec_on (λ J hJ, _)),
    rw ← hJ.2,
    cases map_eq_top_or_is_maximal_of_surjective f hf hJ.left.right with htop hmax,
    { exact htop.symm ▸ set.mem_insert ⊤ _ },
    { exact set.mem_insert_of_mem ⊤ ⟨map_mono hJ.1.1, hmax⟩ } },
end

lemma map_jacobson_of_bijective {f : R →+* S} (hf : function.bijective f) :
  map f (I.jacobson) = (map f I).jacobson :=
map_jacobson_of_surjective hf.right
  (le_trans (le_of_eq (f.injective_iff_ker_eq_bot.1 hf.left)) bot_le)

lemma comap_jacobson {f : R →+* S} {K : ideal S} :
  comap f (K.jacobson) = Inf (comap f '' {J : ideal S | K ≤ J ∧ J.is_maximal}) :=
trans (comap_Inf' f _) (Inf_eq_infi).symm

theorem comap_jacobson_of_surjective {f : R →+* S} (hf : function.surjective f) {K : ideal S} :
  comap f (K.jacobson) = (comap f K).jacobson :=
begin
  unfold ideal.jacobson,
  refine le_antisymm _ _,
  { refine le_trans (comap_mono (le_of_eq (trans top_inf_eq.symm Inf_insert.symm))) _,
    rw [comap_Inf', Inf_eq_infi],
    refine infi_le_infi_of_subset (λ J hJ, _),
    have : comap f (map f J) = J := trans (comap_map_of_surjective f hf J)
      (le_antisymm (sup_le_iff.2 ⟨le_of_eq rfl, le_trans (comap_mono bot_le) hJ.left⟩) le_sup_left),
    cases map_eq_top_or_is_maximal_of_surjective _ hf hJ.right with htop hmax,
    { refine ⟨⊤, ⟨set.mem_insert ⊤ _, htop ▸ this⟩⟩ },
    { refine ⟨map f J, ⟨set.mem_insert_of_mem _
        ⟨le_map_of_comap_le_of_surjective f hf hJ.1, hmax⟩, this⟩⟩ } },
  { rw comap_Inf,
    refine le_infi_iff.2 (λ J, (le_infi_iff.2 (λ hJ, _))),
    haveI : J.is_maximal := hJ.right,
    refine Inf_le ⟨comap_mono hJ.left, comap_is_maximal_of_surjective _ hf⟩ }
end

lemma mem_jacobson_bot {x : R} : x ∈ jacobson (⊥ : ideal R) ↔ ∀ y, is_unit (x * y + 1) :=
⟨λ hx y, let ⟨z, hz⟩ := (mem_jacobson_iff.1 hx) y in
  is_unit_iff_exists_inv.2 ⟨z, by rwa [add_mul, one_mul, ← sub_eq_zero]⟩,
λ h, mem_jacobson_iff.mpr (λ y, (let ⟨b, hb⟩ := is_unit_iff_exists_inv.1 (h y) in
  ⟨b, (submodule.mem_bot R).2 (hb ▸ (by ring))⟩))⟩

/-- An ideal `I` of `R` is equal to its Jacobson radical if and only if
the Jacobson radical of the quotient ring `R/I` is the zero ideal -/
theorem jacobson_eq_iff_jacobson_quotient_eq_bot :
  I.jacobson = I ↔ jacobson (⊥ : ideal (I.quotient)) = ⊥ :=
begin
  have hf : function.surjective (quotient.mk I) := submodule.quotient.mk_surjective I,
  split,
  { intro h,
    replace h := congr_arg (map (quotient.mk I)) h,
    rw map_jacobson_of_surjective hf (le_of_eq mk_ker) at h,
    simpa using h },
  { intro h,
    replace h := congr_arg (comap (quotient.mk I)) h,
    rw [comap_jacobson_of_surjective hf, ← (quotient.mk I).ker_eq_comap_bot] at h,
    simpa using h }
end

/-- The standard radical and Jacobson radical of an ideal `I` of `R` are equal if and only if
the nilradical and Jacobson radical of the quotient ring `R/I` coincide -/
theorem radical_eq_jacobson_iff_radical_quotient_eq_jacobson_bot :
  I.radical = I.jacobson ↔ radical (⊥ : ideal (I.quotient)) = jacobson ⊥ :=
begin
  have hf : function.surjective (quotient.mk I) := submodule.quotient.mk_surjective I,
  split,
  { intro h,
    have := congr_arg (map (quotient.mk I)) h,
    rw [map_radical_of_surjective hf (le_of_eq mk_ker),
      map_jacobson_of_surjective hf (le_of_eq mk_ker)] at this,
    simpa using this },
  { intro h,
    have := congr_arg (comap (quotient.mk I)) h,
    rw [comap_radical, comap_jacobson_of_surjective hf, ← (quotient.mk I).ker_eq_comap_bot] at this,
    simpa using this }
end

@[mono] lemma jacobson_mono {I J : ideal R} : I ≤ J → I.jacobson ≤ J.jacobson :=
begin
  intros h x hx,
  erw mem_Inf at ⊢ hx,
  exact λ K ⟨hK, hK_max⟩, hx ⟨trans h hK, hK_max⟩
end

lemma jacobson_radical_eq_jacobson :
  I.radical.jacobson = I.jacobson :=
le_antisymm (le_trans (le_of_eq (congr_arg jacobson (radical_eq_Inf I)))
  (Inf_le_Inf (λ J hJ, ⟨Inf_le ⟨hJ.1, hJ.2.is_prime⟩, hJ.2⟩))) (jacobson_mono le_radical)

end jacobson

section polynomial
open polynomial

lemma jacobson_bot_polynomial_le_Inf_map_maximal :
  jacobson (⊥ : ideal (polynomial R)) ≤ Inf (map C '' {J : ideal R | J.is_maximal}) :=
begin
  refine le_Inf (λ J, exists_imp_distrib.2 (λ j hj, _)),
  haveI : j.is_maximal := hj.1,
  refine trans (jacobson_mono bot_le) (le_of_eq _ : J.jacobson ≤ J),
  suffices : (⊥ : ideal (polynomial j.quotient)).jacobson = ⊥,
  { rw [← hj.2, jacobson_eq_iff_jacobson_quotient_eq_bot],
    replace this :=
    congr_arg (map (polynomial_quotient_equiv_quotient_polynomial j).to_ring_hom) this,
    rwa [map_jacobson_of_bijective _, map_bot] at this,
    exact (ring_equiv.bijective (polynomial_quotient_equiv_quotient_polynomial j)) },
  refine eq_bot_iff.2 (λ f hf, _),
  simpa [(λ hX, by simpa using congr_arg (λ f, coeff f 1) hX : (X : polynomial j.quotient) ≠ 0)]
    using eq_C_of_degree_eq_zero (degree_eq_zero_of_is_unit ((mem_jacobson_bot.1 hf) X)),
end

lemma jacobson_bot_polynomial_of_jacobson_bot (h : jacobson (⊥ : ideal R) = ⊥) :
  jacobson (⊥ : ideal (polynomial R)) = ⊥ :=
begin
  refine eq_bot_iff.2 (le_trans jacobson_bot_polynomial_le_Inf_map_maximal _),
  refine (λ f hf, ((submodule.mem_bot _).2 (polynomial.ext (λ n, trans _ (coeff_zero n).symm)))),
  suffices : f.coeff n ∈ ideal.jacobson ⊥, by rwa [h, submodule.mem_bot] at this,
  exact mem_Inf.2 (λ j hj, (mem_map_C_iff.1 ((mem_Inf.1 hf) ⟨j, ⟨hj.2, rfl⟩⟩)) n),
end

end polynomial

section is_local

/-- An ideal `I` is local iff its Jacobson radical is maximal. -/
class is_local (I : ideal R) : Prop := (out : is_maximal (jacobson I))

theorem is_local_iff {I : ideal R} : is_local I ↔ is_maximal (jacobson I) :=
⟨λ h, h.1, λ h, ⟨h⟩⟩

theorem is_local_of_is_maximal_radical {I : ideal R} (hi : is_maximal (radical I)) : is_local I :=
⟨have radical I = jacobson I,
from le_antisymm (le_Inf $ λ M ⟨him, hm⟩, hm.is_prime.radical_le_iff.2 him)
  (Inf_le ⟨le_radical, hi⟩),
show is_maximal (jacobson I), from this ▸ hi⟩

theorem is_local.le_jacobson {I J : ideal R} (hi : is_local I) (hij : I ≤ J) (hj : J ≠ ⊤) :
  J ≤ jacobson I :=
let ⟨M, hm, hjm⟩ := exists_le_maximal J hj in
le_trans hjm $ le_of_eq $ eq.symm $ hi.1.eq_of_le hm.1.1 $ Inf_le ⟨le_trans hij hjm, hm⟩

theorem is_local.mem_jacobson_or_exists_inv {I : ideal R} (hi : is_local I) (x : R) :
  x ∈ jacobson I ∨ ∃ y, y * x - 1 ∈ I :=
classical.by_cases
  (assume h : I ⊔ span {x} = ⊤,
    let ⟨p, hpi, q, hq, hpq⟩ := submodule.mem_sup.1 ((eq_top_iff_one _).1 h) in
    let ⟨r, hr⟩ := mem_span_singleton.1 hq in
    or.inr ⟨r, by rw [← hpq, mul_comm, ← hr, ← neg_sub, add_sub_cancel]; exact I.neg_mem hpi⟩)
  (assume h : I ⊔ span {x} ≠ ⊤,
    or.inl $ le_trans le_sup_right (hi.le_jacobson le_sup_left h) $ mem_span_singleton.2 $
      dvd_refl x)

end is_local

theorem is_primary_of_is_maximal_radical {I : ideal R} (hi : is_maximal (radical I)) :
  is_primary I :=
have radical I = jacobson I,
from le_antisymm (le_Inf $ λ M ⟨him, hm⟩, hm.is_prime.radical_le_iff.2 him)
  (Inf_le ⟨le_radical, hi⟩),
⟨ne_top_of_lt $ lt_of_le_of_lt le_radical (lt_top_iff_ne_top.2 hi.1.1),
λ x y hxy, ((is_local_of_is_maximal_radical hi).mem_jacobson_or_exists_inv y).symm.imp
  (λ ⟨z, hz⟩, by rw [← mul_one x, ← sub_sub_cancel (z * y) 1, mul_sub, mul_left_comm]; exact
    I.sub_mem (I.mul_mem_left _ hxy) (I.mul_mem_left _ hz))
  (this ▸ id)⟩

end ideal


import M4R.Logic

namespace Nat

  @[simp] theorem pred_zero : pred 0 = 0 := rfl
  @[simp] theorem pred_succ (n : Nat) : pred (succ n) = n := rfl

  protected theorem lt_one {n : Nat} (hn : n < 1) : n = 0 :=
    Nat.eq_zero_of_le_zero (Nat.le_of_succ_le_succ hn)

  protected theorem ne_of_lt {m n : Nat} : m < n → m ≠ n :=
    fun h h' => Nat.lt_irrefl n (by rw [h'] at h; exact h)

  protected theorem le_or_lt (m n : Nat) : m ≤ n ∨ n < m :=
    Or.elim (Nat.lt_or_ge n m) Or.inr Or.inl

  protected theorem lt_or_eq_of_le {m n : Nat} (h : m ≤ n) : m < n ∨ m = n :=
    Or.elim (Nat.lt_or_ge m n) Or.inl (fun h' => Or.inr (Nat.le_antisymm h h'))

  protected theorem le_of_add_le_add_left {k n m : Nat} (h : k + n ≤ k + m) : n ≤ m :=
    match le.dest h with
    | ⟨w, hw⟩ => @le.intro _ _ w (by rw [Nat.add_assoc] at hw; exact Nat.add_left_cancel hw)

  protected theorem le_of_add_le_add_right {k n m : Nat} : n + k ≤ m + k → n ≤ m := by
    rw [Nat.add_comm _ k, Nat.add_comm _ k]
    exact Nat.le_of_add_le_add_left

  protected theorem lt_of_add_lt_add_left {k n m : Nat} (h : k + n < k + m) : n < m :=
    Nat.lt_of_le_and_ne (Nat.le_of_add_le_add_left (Nat.le_of_lt h))
      (fun heq => Nat.lt_irrefl (k + m) (by rw [heq] at h; exact h))

  protected theorem lt_of_add_lt_add_right {a b c : Nat} (h : a + b < c + b) : a < c :=
    have : b + a < b + c := by rw [Nat.add_comm b a, Nat.add_comm b c]; exact h
    Nat.lt_of_add_lt_add_left this

  protected theorem le_iff_eq_or_lt {a b : Nat} : a ≤ b ↔ a = b ∨ a < b :=
    ⟨fun h => (Nat.lt_or_eq_of_le h).comm, fun h => Or.elim h (· ▸ Nat.le.refl) (Nat.le_of_lt)⟩

  protected theorem lt_succ_if_le {a b : Nat} : a < b.succ ↔ a ≤ b :=
    ⟨le_of_lt_succ, lt_succ_of_le⟩

  theorem succ_ne_self : ∀ n : Nat, succ n ≠ n
  | 0  , h => absurd h (Nat.succ_ne_zero 0)
  | n+1, h => succ_ne_self n (Nat.succ.inj h)

  theorem lt_add_right (n m k : Nat) (h : n < m) : n < m + k := by
    induction k with
    | zero      => rw [Nat.add_zero]; exact h
    | succ k ih => rw [Nat.add_succ]; exact Nat.lt_succ_of_le (Nat.le_of_lt ih)

  theorem lt_add_left (n m k : Nat) (h : n < m) : n < k + m := by
    rw [Nat.add_comm]; exact lt_add_right n m k h

  @[simp] theorem zero_sub : ∀ a : Nat, 0 - a = 0
  | 0     => rfl
  | (a+1) => congrArg pred (zero_sub a)

  theorem succ_pred_eq_of_pos : ∀ {n : Nat}, n > 0 → n.pred.succ = n
  | 0, h      => absurd h (Nat.lt_irrefl 0)
  | succ k, h => rfl

  protected theorem add_left_cancel' {n m k : Nat} : n + m = n + k ↔ m = k :=
    ⟨Nat.add_left_cancel, congrArg (n + ·)⟩

  protected theorem add_right_cancel' {n m k : Nat} : n + m = k + m ↔ n = k :=
    ⟨Nat.add_right_cancel, congrArg (· + m)⟩

  theorem add_sub_add_right : ∀ (n k m : Nat), (n + k) - (m + k) = n - m
  | n, 0     , m => by rw [add_zero, add_zero]
  | n, succ k, m => by rw [add_succ, add_succ, succ_sub_succ, add_sub_add_right n k m]

  theorem add_sub_add_left (k n m : Nat) : (k + n) - (k + m) = n - m := by
    rw [Nat.add_comm k n, Nat.add_comm k m, add_sub_add_right]

  theorem add_sub_cancel (n m : Nat) : n + m - m = n := by
    have : n + m - (0 + m) = n := by
      rw [add_sub_add_right, Nat.sub_zero]
    rw [Nat.zero_add] at this
    exact this

  theorem sub_self_add (n m : Nat) : n - (n + m) = 0 :=
    have : (n + 0) - (n + m) = 0 := by rw [add_sub_add_left, Nat.zero_sub]
    this

  theorem sub_eq_zero_of_le {n m : Nat} (h : n ≤ m) : n - m = 0 := by
    let ⟨k, hk⟩ := le.dest h
    rw [←hk, Nat.sub_self_add]

  theorem le_of_sub_eq_zero : ∀ {n m : Nat}, n - m = 0 → n ≤ m
  | n    , 0    , H => by rw [Nat.sub_zero] at H; rw [H]; exact Nat.le_refl 0
  | 0    , (m+1), H => zero_le _
  | (n+1), (m+1), H => Nat.add_le_add_right (le_of_sub_eq_zero (by simp only [add_sub_add_right] at H; exact H )) _

  @[simp] theorem sub_eq_zero_iff_le (a b : Nat) : a - b = 0 ↔ a ≤ b :=
    ⟨le_of_sub_eq_zero, sub_eq_zero_of_le⟩

  theorem add_sub_cancel_left (n m : Nat) : n + m - n = m :=
    have : n + m - (n + 0) = m :=
      by rw [add_sub_add_left, Nat.sub_zero]
    this

  theorem sub_sub : ∀ (n m k : Nat), n - m - k = n - (m + k)
  | n, m, zero   => by rw [add_zero, Nat.sub_zero]
  | n, m, succ k => by rw [add_succ, sub_succ, sub_succ, sub_sub n m k]

  theorem add_sub_of_le {n m : Nat} (h : n ≤ m) : n + (m - n) = m := by
    let ⟨k, hk⟩ := le.dest h
    rw [← hk, add_sub_cancel_left]

  theorem sub_add_cancel {n m : Nat} (h : n ≥ m) : n - m + m = n := by
    rw [Nat.add_comm, add_sub_of_le h]

  theorem add_sub_assoc {m k : Nat} (h : k ≤ m) (n : Nat) : n + m - k = n + (m - k) := by
    rw [←Classical.choose_spec (le.dest h), add_sub_cancel_left, Nat.add_comm k, ←Nat.add_assoc, add_sub_cancel]

  theorem succ_sub {m n : Nat} (h : m ≥ n) : m.succ - n = (m - n).succ := by
    let ⟨k, hk⟩ := le.dest h
    rw [←hk, add_sub_cancel_left, ←add_succ, add_sub_cancel_left]

  theorem sub_pos_of_lt {m n : Nat} (h : m < n) : n - m > 0 :=
    have : 0 + m < n - m + m := by rw [Nat.zero_add, sub_add_cancel (Nat.le_of_lt h)]; exact h
    Nat.lt_of_add_lt_add_right this

  theorem sub_pred {m n : Nat} (h₁ : 0 < n) (h₂ : n ≤ m) : m - n.pred = (m - n).succ := by
    cases n with
    | zero   => contradiction
    | succ n =>
      rw [Nat.pred_succ, Nat.sub_succ, Nat.succ_pred_eq_of_pos (Nat.sub_pos_of_lt h₂)]

  theorem lt_of_sub_eq_succ {m n l : Nat} (H : m - n = succ l) : n < m :=
    gt_of_not_le (mt (@sub_eq_zero_of_le m n) (fun h => by rw [h] at H; contradiction))

  theorem sub_eq_iff_eq_add {a b c : Nat} (ab : b ≤ a) : a - b = c ↔ a = c + b :=
    ⟨fun h => by rw [←h, sub_add_cancel ab], fun h => by rw [h, add_sub_cancel]⟩

  theorem eq_sub_iff_add_eq {a b c : Nat} (bc : c ≤ b) : a = b - c ↔ a + c = b :=
    ⟨fun h => ((sub_eq_iff_eq_add bc).mp h.symm).symm, fun h => ((sub_eq_iff_eq_add bc).mpr h.symm).symm⟩

  theorem mul_pred_left : ∀ (n m : Nat), n.pred * m = n * m - m
  | zero  , m => by simp
  | succ n, m => by rw [pred_succ, succ_mul, add_sub_cancel]

  theorem mul_sub_right_distrib : ∀ (n m k : Nat), (n - m) * k = n * k - m * k
  | n, zero  , k => by simp
  | n, succ m, k => by rw [sub_succ, mul_pred_left, mul_sub_right_distrib, succ_mul, sub_sub]

  theorem mul_sub_left_distrib (n m k : Nat) : n * (m - k) = n * m - n * k := by
    rw [Nat.mul_comm, mul_sub_right_distrib, Nat.mul_comm m n, Nat.mul_comm n k]

  theorem pos_iff_ne_zero {n : Nat} : 0 < n ↔ n ≠ 0 :=
    ⟨fun h => (Nat.ne_of_lt h).symm,
    fun h => Nat.lt_of_le_and_ne (Nat.zero_le n) h.symm⟩

  theorem ge_one_iff_ne_zero {n : Nat} : 1 ≤ n ↔ n ≠ 0 := by
    rw [←pos_iff_ne_zero]; exact Iff.rfl

  protected theorem sub_one (n : Nat) : n - 1 = pred n := rfl

  theorem one_add (n : Nat) : 1 + n = succ n :=
    (Nat.add_comm 1 n).trans (add_one n)

  theorem pred_sub (n m : Nat) : pred n - m = pred (n - m) := by
    rw [←Nat.sub_one, sub_sub, one_add, sub_succ]

  theorem le_of_not_ge {a b : Nat} : ¬ a ≥ b → a ≤ b :=
    Or.resolve_left (Nat.le_total b a)

  theorem le_of_not_le {a b : Nat} : ¬ a ≤ b → b ≤ a :=
    Or.resolve_left (Nat.le_total a b)

  theorem lt_trichotomy (a b : Nat) : a < b ∨ a = b ∨ b < a :=
    Or.elim (Nat.le_total a b)
      (fun h : a ≤ b => Or.elim (Nat.lt_or_eq_of_le h)
        (fun h : a < b => Or.inl h)
        (fun h : a = b => Or.inr (Or.inl h)))
      (fun h : b ≤ a => Or.elim (Nat.lt_or_eq_of_le h)
        (fun h : b < a => Or.inr (Or.inr h))
        (fun h : b = a => Or.inr (Or.inl h.symm)))

  theorem le_of_not_lt {a b : Nat} (h : ¬ b < a) : a ≤ b := by
    cases lt_trichotomy a b with
    | inl hlt => exact Nat.le_of_lt hlt
    | inr h =>
      cases h with
      | inl heq => exact heq ▸ Nat.le_refl a
      | inr hgt => exact absurd hgt h

  theorem le_of_not_gt {a b : Nat} : ¬ a > b → a ≤ b := le_of_not_lt

  theorem not_lt_of_ge {a b : Nat} (h : a ≥ b) : ¬ a < b :=
    fun hab => Nat.not_le_of_gt hab h

  @[simp] theorem not_lt {a b : Nat} : ¬ a < b ↔ b ≤ a :=
    ⟨le_of_not_gt, not_lt_of_ge⟩

  theorem not_lt_of_gt {a b : Nat} : a > b → ¬ a ≤ b :=
    fun h₁ h₂ => absurd h₁ (not_lt_of_ge h₂)

  @[simp] theorem not_le {a b : Nat} : ¬ a ≤ b ↔ b < a :=
    ⟨gt_of_not_le, not_lt_of_gt⟩

  theorem add_eq_zero {a b : Nat} : a + b = 0 ↔ a = 0 ∧ b = 0 :=
    ⟨fun h => by
      induction a with
      | zero => rw [Nat.zero_add] at h; exact ⟨rfl, h⟩
      | succ k ih => rw [succ_add] at h; exact absurd h (succ_ne_zero (k+b)),
    fun ⟨ha, hb⟩ => by rw [ha, hb]⟩

  theorem add_eq_one {a b : Nat} : a + b = 1 ↔ (a = 1 ∧ b = 0) ∨ (a = 0 ∧ b = 1) := by
    cases a with
    | zero   =>
      simp only [Nat.zero_eq, Nat.zero_add, false_and, false_or, true_and]; exact Iff.rfl
    | succ a =>
      simp only [false_and, or_false]
      cases a with
      | zero   =>
        conv => lhs rhs rw [←Nat.add_zero 1]
        rw [Nat.add_left_cancel']; simp only [true_and]; exact Iff.rfl
      | succ a =>
        have : ∀ n : Nat, ¬ n.succ.succ = 1 := fun n h => absurd (Nat.succ.inj h) (Nat.succ_ne_zero n)
        simp only [Nat.succ_add, this, false_and]

  theorem mul_eq_zero (a b : Nat) : a * b = 0 ↔ a = 0 ∨ b = 0 :=
    ⟨fun h => by
      induction a with
      | zero      => exact Or.inl rfl
      | succ k ih => rw [succ_mul, add_eq_zero] at h; exact Or.inr h.right,
    fun h => by
      cases h with
      | inl h => rw [h, Nat.zero_mul]
      | inr h => rw [h, Nat.mul_zero]⟩

  theorem mul_neq_zero (a b : Nat) : a * b ≠ 0 ↔ a ≠ 0 ∧ b ≠ 0 := by
    rw [←M4R.not_or_iff_and_not, M4R.not_iff_not]; exact mul_eq_zero a b

  theorem add_le {a b : Nat} : a + b ≤ a ↔ b = 0 :=
    ⟨fun h => by
      conv at h => rhs rw [←Nat.add_zero a]
      exact Nat.eq_zero_of_le_zero (Nat.le_of_add_le_add_left h),
    fun h => by rw [h, Nat.add_zero]; exact Nat.le_refl a⟩

  theorem lt_not_symm {a b : Nat} : ¬(a < b ∧ b < a) := by
    rw [M4R.not_and_iff_or_not, Nat.not_lt, Nat.not_lt]; exact Nat.le_total b a

  theorem add_sub_comm {a b c : Nat} (h : c ≤ a) : a + b - c = a - c + b := by
    induction b with
    | zero      => rw [Nat.add_zero, Nat.add_zero]
    | succ b ih =>
      rw [Nat.add_succ, Nat.add_succ, ←ih, Nat.succ_sub]
      exact Nat.add_zero _ ▸ Nat.add_le_add h (Nat.zero_le b)

  section choose

    protected def choose : Nat → Nat → Nat
    | _    ,     0 => 1
    | 0    , k + 1 => 0
    | n + 1, k + 1 => Nat.choose n k + Nat.choose n (k + 1)

    @[simp] theorem choose_zero_right (n : Nat) : n.choose 0 = 1 := by
      cases n; rfl; rfl

    theorem choose_zero_right_succ (n : Nat) : n.choose 0 = n.succ.choose 0 := by
      rw [choose_zero_right, choose_zero_right]

    @[simp] theorem choose_zero_succ (k : Nat) : (0 : Nat).choose k.succ = 0 := rfl

    theorem choose_succ_succ (n k : Nat) : n.succ.choose k.succ = n.choose k + n.choose (succ k) := rfl

    theorem choose_eq_zero_of_lt : ∀ {n k : Nat}, n < k → n.choose k = 0
    | _    ,     0, hk => absurd hk (Nat.not_lt_zero _)
    | 0    , k + 1, hk => choose_zero_succ _
    | n + 1, k + 1, hk => by
      rw [choose_succ_succ, choose_eq_zero_of_lt (lt_of_succ_lt_succ hk),
        choose_eq_zero_of_lt (lt_of_succ_lt hk)]

    @[simp] theorem choose_self (n : Nat) : n.choose n = 1 := by
      induction n with
      | zero      => rfl
      | succ n ih => simp only [Nat.choose]; rw [ih, choose_eq_zero_of_lt (lt_succ_self n)]

    theorem choose_self_succ (n : Nat) : n.choose n = n.succ.choose n.succ := by
      rw [choose_self, choose_self]

    @[simp] theorem choose_succ_self (n : Nat) : n.choose n.succ = 0 :=
      choose_eq_zero_of_lt (lt_succ_self _)

    @[simp] theorem choose_one_right (n : Nat) : n.choose 1 = n := by
      induction n with
      | zero => rfl
      | succ n ih => simp only [Nat.choose]; rw [ih, choose_zero_right, one_add]

    theorem choose_pred {n k : Nat} (h : 0 < k) : n.choose k + n.choose k.pred = n.succ.choose k := by
      cases k with
      | zero => contradiction
      | succ k => rw [Nat.pred_succ, Nat.add_comm]; rfl

  end choose

  theorem le_succ_pred (n : Nat) : n ≤ n.pred.succ := by
    byCases h : n > 0
    { exact Nat.le_of_eq (succ_pred_eq_of_pos h).symm }
    { exact Nat.eq_zero_of_le_zero (Nat.le_of_not_gt h) ▸ Nat.zero_le _ }

  theorem pred_le_iff {n m : Nat} : n.pred ≤ m ↔ n ≤ m.succ :=
    ⟨fun h => Nat.le_trans (le_succ_pred n) (succ_le_succ h),
     fun h => by cases n with
      | zero   => exact Nat.zero_le m
      | succ n => exact Nat.le_of_succ_le_succ h⟩

  theorem le_pred_iff {n m : Nat} (hm : m > 0) : n ≤ m.pred ↔ n.succ ≤ m :=
    ⟨fun h => succ_pred_eq_of_pos hm ▸ Nat.succ_le_succ h,
     fun h => by cases m with
      | zero   => exact absurd hm (Nat.lt_irrefl 0)
      | succ m => exact Nat.le_of_succ_le_succ h⟩

  theorem sub_le_iff_right {a b c : Nat} : a - c ≤ b ↔ a ≤ b + c := by
    induction c generalizing b with
    | zero      => rw [Nat.sub_zero, Nat.add_zero]; exact Iff.rfl
    | succ c ih => rw [sub_succ, add_succ, ←succ_add, pred_le_iff]; exact ih

  theorem le_zero {n : Nat} : n ≤ 0 ↔ n = 0 :=
    ⟨Nat.eq_zero_of_le_zero, (· ▸ Nat.le_refl n)⟩

  theorem le_sub_iff_right {a b c : Nat} (h : c ≤ b) : a ≤ b - c ↔ a + c ≤ b := by
    induction c generalizing a with
    | zero      => rw [Nat.sub_zero, Nat.add_zero]; exact Iff.rfl
    | succ c ih =>
      rw [sub_succ, add_succ, ←succ_add, le_pred_iff (sub_pos_of_lt h)]
      exact ih (Nat.le_trans (Nat.le_succ c) h)

  theorem sub_le_sub {a b c : Nat} (ha : a ≤ c) (hb : b ≤ c) : a ≤ b ↔ c - b ≤ c - a := by
    rw [sub_le_iff_right, Nat.add_comm, ←add_sub_assoc ha, le_sub_iff_right
      (Nat.le_trans ha (Nat.le_add_left c b)), Nat.add_comm]
    exact ⟨(Nat.add_le_add_right · c), Nat.le_of_add_le_add_right⟩

  theorem lt_sub_iff_right {a b c : Nat} (h : c ≤ b) : a < b - c ↔ a + c < b :=
    ⟨fun h' => Nat.lt_of_le_and_ne ((le_sub_iff_right h).mp (Nat.le_of_lt h'))
      (fun h'' => absurd ((eq_sub_iff_add_eq h).mpr h'') (Nat.ne_of_lt h')),
    fun h' => Nat.lt_of_le_and_ne ((le_sub_iff_right h).mpr (Nat.le_of_lt h'))
      (fun h'' => absurd ((eq_sub_iff_add_eq h).mp h'') (Nat.ne_of_lt h'))⟩

  theorem sub_lt_iff_right {a b c : Nat} (h : c ≤ a) : a - c < b ↔ a < b + c := by
    apply M4R.not_iff_not.mp
    simp only [Nat.not_lt]
    exact le_sub_iff_right h

  theorem zero_lt_iff_neq_zero {n : Nat} : 0 < n ↔ n ≠ 0 :=
    ⟨fun h₁ h₂ => absurd (h₂ ▸ h₁) (Nat.lt_irrefl 0), fun h => by
      cases n; contradiction; exact Nat.zero_lt_succ _⟩

  theorem lt.dest {m n : Nat} (h : m < n) : ∃ k, k ≠ 0 ∧ m + k = n :=
    let ⟨k, hk⟩ := le.dest (Nat.le_of_lt h)
    ⟨k, fun h' => absurd ((h' ▸ hk : m + 0 = n) ▸ h) (Nat.lt_irrefl n), hk⟩

  theorem ne_zero_dest {m : Nat} (h : m ≠ 0) : ∃ k, m = k + 1 :=
    ⟨m.pred, (succ_pred_eq_of_pos (pos_iff_ne_zero.mpr h)).symm⟩

  theorem of_lt_add_left {n m : Nat} (h : n < m + n) : 0 < m :=
    Nat.sub_self n ▸ (sub_lt_iff_right (Nat.le_refl n)).mpr h

  theorem of_lt_add_right {n m : Nat} (h : n < n + m) : 0 < m :=
    of_lt_add_left (Nat.add_comm n m ▸ h : n < m + n)

  theorem lt_add_pos_left (n : Nat) {m : Nat} (h : m ≠ 0) : n < m + n :=
    Nat.lt_of_le_and_ne (le_add_left n m)
      (fun h' => absurd (Nat.sub_self n ▸ (sub_eq_iff_eq_add (Nat.le_refl n)).mpr h') h.symm)

  theorem lt_add_pos_right (n : Nat) {m : Nat} (h : m ≠ 0) : n < n + m :=
    Nat.add_comm n m ▸ lt_add_pos_left n h

  theorem sub_pos_iff_lt {m n : Nat} : 0 < m - n ↔ n < m :=
    (pos_iff_ne_zero.trans (M4R.not_iff_not.mpr (sub_eq_zero_iff_le m n))).trans Nat.not_le

  theorem strong_induction (p : Nat → Prop) (ih : ∀ n, (∀ m, m < n → p m) → p n) (n : Nat) : p n :=
    ih n fun m hm => by
      induction n generalizing m with
      | zero       => contradiction
      | succ n ih' => exact (Nat.lt_or_eq_of_le (Nat.le_of_succ_le_succ hm)).elim (ih' m) (fun h => ih m (h ▸ ih'))

end Nat

namespace Int

  /- Helper "packing" theorems -/
  @[simp] theorem zero_eq : ofNat 0 = 0 := rfl
  @[simp] theorem one_eq : ofNat 1 = 1 := rfl
  @[simp] theorem add_eq : Int.add x y = x + y := rfl
  @[simp] theorem sub_eq : Int.sub x y = x - y := rfl
  @[simp] theorem mul_eq : Int.mul x y = x * y := rfl
  @[simp] theorem neg_eq : Int.neg x = - x := rfl
  @[simp] theorem lt_eq : Int.lt x y = (x < y) := rfl
  @[simp] theorem le_eq : Int.le x y = (x ≤ y) := rfl

  @[simp] theorem negOfNat_of_succ (n : Nat) : -(ofNat n.succ) = negSucc n := rfl
  @[simp] theorem ofNat_add_ofNat (m n : Nat) : ofNat m + ofNat n = ofNat (m + n) := rfl
  @[simp] theorem ofNat_add_negSucc_ofNat (m n : Nat) :
                  ofNat m + negSucc n = subNatNat m (n.succ) := rfl
  @[simp] theorem negSucc_ofNat_add_ofNat (m n : Nat) :
                  negSucc m + ofNat n = subNatNat n (m.succ) := rfl
  @[simp] theorem negSucc_ofNat_add_negSucc_ofNat (m n : Nat) :
                  negSucc m + negSucc n = negSucc (m + n).succ := rfl

  @[simp] theorem ofNat_mul_ofNat (m n : Nat) : ofNat m * ofNat n = ofNat (m * n) := rfl
  @[simp] theorem ofNat_mul_negSucc_ofNat (m n : Nat) :
                  ofNat m * negSucc n = negOfNat (m * n.succ) := rfl
  @[simp] theorem negSucc_ofNat_ofNat (m n : Nat) :
                  negSucc m * ofNat n = negOfNat (m.succ * n) := rfl
  @[simp] theorem mul_negSucc_ofNat_negSucc_ofNat (m n : Nat) :
                negSucc m * negSucc n = ofNat (m.succ * n.succ) := rfl

  @[simp] protected theorem neg_zero : - (0 : Int) = 0 := rfl
  @[simp] protected theorem negOfNat_zero : negOfNat 0 = 0 := rfl

  @[simp] theorem subNatNat_self: ∀ n : Nat, subNatNat n n = 0
  | 0            => rfl
  | (Nat.succ m) => by simp only [subNatNat, Nat.sub_self]

  @[simp] protected theorem add_neg : ∀ n : Int, n + -n = 0
  | ofNat 0 => rfl
  | ofNat (Nat.succ k) => by
    simp only [Neg.neg, Int.neg, negOfNat, HAdd.hAdd, Add.add, Int.add, subNatNat_self]
  | negSucc k => by
    simp only [Neg.neg, Int.neg, negOfNat, HAdd.hAdd, Add.add, Int.add, subNatNat_self]

  protected theorem add_comm : ∀ m n : Int, m + n = n + m
  | ofNat   m', ofNat   n' => by simp [Nat.add_comm]
  | ofNat   m', negSucc n' => rfl
  | negSucc m', ofNat   n' => rfl
  | negSucc m', negSucc n' => by simp [Nat.add_comm]

  @[simp] protected theorem add_zero : ∀ n : Int, n + 0 = n
  | ofNat   k => rfl
  | negSucc k => rfl

  @[simp] protected theorem zero_add : ∀ n : Int, 0 + n = n :=
    fun n => by rw [Int.add_comm, Int.add_zero]

  theorem subNatNat_elim (m n : Nat) (P : Nat → Nat → Int → Prop)
    (hp : ∀ i n : Nat, P (n + i) n (ofNat i))
    (hn : ∀ i m : Nat, P m (m + i + 1) (negSucc i)) :
    P m n (subNatNat m n) := by
      have H : ∀ k : Nat, n - m = k → P m n (subNatNat m n) := by
        intro k; simp only [subNatNat]; cases k with
        | zero =>
          intro e; simp only [e]
          cases (Nat.le.dest (Nat.le_of_sub_eq_zero e)) with
          | intro k h =>
            rw [h.symm, Nat.add_sub_cancel_left]
            exact hp k n
        | succ k' =>
          intro heq; simp only [heq]
          have h : m ≤ n := Nat.le_of_lt (Nat.lt_of_sub_eq_succ heq)
          rw [Nat.sub_eq_iff_eq_add h] at heq
          rw [heq, Nat.add_comm]
          exact hn k' m
      exact H (n - m) rfl

  theorem subNatNat_add_left {m n : Nat} : subNatNat (m + n) m = ofNat n := by
    simp only [subNatNat]
    rw [Nat.sub_eq_zero_of_le, Nat.add_sub_cancel_left]
    exact Nat.le_add_right m n

  theorem subNatNat_add_right {m n : Nat} : subNatNat m (m + n + 1) = negSucc n := by
    simp only [subNatNat, Nat.add_assoc, Nat.add_sub_cancel_left]; rfl

  theorem subNatNat_add_add (m n k : Nat) : subNatNat (m + k) (n + k) = subNatNat m n :=
    subNatNat_elim m n (fun m n i => subNatNat (m + k) (n + k) = i)
      (fun i n => by
        have : n + i + k = (n + k) + i := by simp only [Nat.add_comm, Nat.add_left_comm]
        simp only [this]; exact subNatNat_add_left)
      (fun i m => by
        have : m + i + 1 + k = (m + k) + i + 1 := by simp only [Nat.add_comm, Nat.add_left_comm]
        simp only [this]; exact subNatNat_add_right)

  theorem subNatNat_of_sub_eq_zero {m n : Nat} (h : n - m = 0) : subNatNat m n = ofNat (m - n) := by
    simp only [subNatNat, h]

  theorem subNatNat_of_sub_eq_succ {m n k : Nat} (h : n - m = k.succ) : subNatNat m n = negSucc k := by
    simp only [subNatNat, h]

  theorem subNatNat_of_ge {m n : Nat} (h : m ≥ n) : subNatNat m n = ofNat (m - n) :=
    subNatNat_of_sub_eq_zero (Nat.sub_eq_zero_of_le h)

  theorem subNatNat_of_lt {m n : Nat} (h : m < n) : subNatNat m n = negSucc (n - m).pred := by
    rw [subNatNat_of_sub_eq_succ]
    exact Eq.symm (Nat.succ_pred_eq_of_pos (Nat.sub_pos_of_lt h))

  theorem subNatNat_sub {m n : Nat} (h : m ≥ n) (k : Nat) : subNatNat (m - n) k = subNatNat m (k + n) := by
      rw [←subNatNat_add_add (m-n) k n, Nat.sub_add_cancel h]

  theorem subNatNat_add (m n k : Nat) : subNatNat (m + n) k = ofNat m + subNatNat n k := by
    cases Nat.le_or_lt k n with
    | inl h =>
      rw [subNatNat_of_ge h]
      have h₂ : k ≤ m + n := (Nat.le_trans h (Nat.le_add_left _ _))
      simp [subNatNat_of_ge h₂, Nat.add_sub_assoc h]
    | inr h =>
      rw [subNatNat_of_lt h, ofNat_add_negSucc_ofNat, Nat.succ_pred_eq_of_pos (Nat.sub_pos_of_lt h)]
      have := subNatNat_add_add m (k - n) n
      rw [Nat.sub_add_cancel (Nat.le_of_lt h)] at this
      exact this

  theorem subNatNat_add_negSucc_ofNat (m n k : Nat) : subNatNat m n + negSucc k = subNatNat m (n + k.succ) := by
    cases Nat.le_or_lt n m with
    | inl h => rw [subNatNat_of_ge h, ofNat_add_negSucc_ofNat, subNatNat_sub h, Nat.add_comm]
    | inr h =>
      have h₂ : m < n + k.succ := Nat.lt_of_lt_of_le h (Nat.le_add_right _ _)
      have h₃ : m ≤ n + k := Nat.le_of_succ_le_succ h₂
      rw [subNatNat_of_lt h, subNatNat_of_lt h₂]; simp; rw [Nat.add_comm, ←Nat.add_succ,
        Nat.succ_pred_eq_of_pos (Nat.sub_pos_of_lt h), Nat.add_succ, Nat.succ_sub h₃,
        Nat.pred_succ, Nat.add_comm n, Nat.add_sub_assoc (Nat.le_of_lt h)]

  private theorem add_assoc₁ (a b : Nat) : ∀ c : Int, ofNat a + ofNat b + c = ofNat a + (ofNat b + c)
  | ofNat   c => by simp [Nat.add_assoc]
  | negSucc c => by simp [subNatNat_add]

  private theorem add_assoc₂ (a b c : Nat) : negSucc a + negSucc b + ofNat c = negSucc a + (negSucc b + ofNat c) := by
    rw [negSucc_ofNat_add_negSucc_ofNat, Int.add_comm, ofNat_add_negSucc_ofNat,
      Int.add_comm (negSucc b), ofNat_add_negSucc_ofNat, Int.add_comm, subNatNat_add_negSucc_ofNat,
      Nat.add_succ, Nat.succ_add, Nat.add_comm]

  protected theorem add_assoc : ∀ a b c : Int, a + b + c = a + (b + c)
  | ofNat   a, ofNat   b,         c => add_assoc₁ a b c
  | ofNat   a,         b, ofNat   c => by
    rw [Int.add_comm, ←add_assoc₁, Int.add_comm (ofNat c), add_assoc₁, Int.add_comm b]
  |         a, ofNat   b, ofNat   c => by
    rw [Int.add_comm, Int.add_comm a, ←add_assoc₁, Int.add_comm a, Int.add_comm (ofNat c)]
  | negSucc a, negSucc b, ofNat   c => add_assoc₂ a b c
  | negSucc a, ofNat   b, negSucc c => by
    rw [Int.add_comm, ←add_assoc₂, Int.add_comm (ofNat b), ←add_assoc₂, Int.add_comm (negSucc a)]
  | ofNat   a, negSucc b, negSucc c => by
    rw [Int.add_comm, Int.add_comm (ofNat a), Int.add_comm (ofNat a), ←add_assoc₂, Int.add_comm (negSucc c)]
  | negSucc a, negSucc b, negSucc c => by
    simp [Nat.succ_eq_add_one] rw [Nat.add_right_comm b, ←Nat.add_assoc, ←Nat.add_assoc]

  protected theorem mul_comm : ∀ a b : Int, a * b = b * a
  | ofNat   a, ofNat   b => by simp [Nat.mul_comm]
  | ofNat   a, negSucc b => by simp [Nat.mul_comm]
  | negSucc a, ofNat   b => by simp [Nat.mul_comm]
  | negSucc a, negSucc b => by simp [Nat.mul_comm]

  @[simp] protected theorem mul_one : ∀ a : Int, a * 1 = a
  | ofNat   a => by simp [HMul.hMul, Mul.mul, Int.mul]; exact Nat.mul_one a
  | negSucc a => by simp [HMul.hMul, Mul.mul, Int.mul, negOfNat]; rw [Nat.mul_one a.succ]

  @[simp] protected theorem one_mul : ∀ a : Int, 1 * a = a :=
    fun a => Int.mul_comm a 1 ▸ Int.mul_one a

  @[simp] protected theorem mul_zero : ∀ a : Int, a * 0 = 0
  | ofNat   m => rfl
  | negSucc m => rfl

  @[simp] protected theorem zero_mul : ∀ a : Int, 0 * a = 0 :=
    fun a => Int.mul_comm a 0 ▸ Int.mul_zero a

  theorem negOfNat_eq_subNatNat_zero : ∀ n, negOfNat n = subNatNat 0 n
  | Nat.zero   => rfl
  | Nat.succ n => rfl

  @[simp] theorem ofNat_mul_negOfNat (m : Nat) : ∀n, ofNat m * negOfNat n = negOfNat (m * n)
  | Nat.zero   => rfl
  | Nat.succ n => by simp [negOfNat]

  @[simp] theorem negOfNat_mul_ofNat (m n : Nat) : negOfNat m * ofNat n = negOfNat (m * n) := by
    rw [Int.mul_comm]; simp only [ofNat_mul_negOfNat, Nat.mul_comm]

  @[simp] theorem negSucc_ofNat_mul_negOfNat (m : Nat) : ∀ n, negSucc m * negOfNat n = ofNat (m.succ * n)
  | Nat.zero   => rfl
  | Nat.succ n => by simp [negOfNat]

  @[simp] theorem negOfNat_mul_negSucc_ofNat (m n : Nat) : negOfNat n * negSucc m = ofNat (n * m.succ) := by
    rw [Int.mul_comm]; simp [negSucc_ofNat_mul_negOfNat, Nat.mul_comm]

  @[simp] theorem ofNat_mul_subNatNat (m n k : Nat) : ofNat m * subNatNat n k = subNatNat (m * n) (m * k) := by
    cases Nat.eq_zero_or_pos m with
    | inl h => simp [h]
    | inr h =>
      cases Nat.lt_or_ge n k with
      | inl h' =>
        have : m * n < m * k := Nat.mul_lt_mul_of_pos_left h' h
        rw [subNatNat_of_lt h', subNatNat_of_lt this]; simp
        rw [Nat.succ_pred_eq_of_pos (Nat.sub_pos_of_lt h'),
          ←negOfNat_of_succ, Nat.mul_sub_left_distrib,
          Nat.succ_pred_eq_of_pos (Nat.sub_pos_of_lt this)]; rfl
      | inr h' =>
        have : m * k ≤ m * n := Nat.mul_le_mul_left _ h'
        rw [subNatNat_of_ge h', subNatNat_of_ge this]; simp
        rw [Nat.mul_sub_left_distrib]

  @[simp] theorem negOfNat_add : ∀ (m n : Nat), negOfNat m + negOfNat n = negOfNat (m + n)
  | Nat.zero  ,          n   => by simp
  | Nat.succ m,          0 => by simp
  | Nat.succ m, Nat.succ n => by simp [Nat.succ_add]; rfl

  @[simp] theorem negSucc_ofNat_mul_subNatNat (m n k : Nat) :
    negSucc m * subNatNat n k = subNatNat (m.succ * k) (m.succ * n) := by
      cases Nat.lt_or_ge n k with
      | inl h =>
        have h' : m.succ * n < m.succ * k := Nat.mul_lt_mul_of_pos_left h (Nat.succ_pos m)
        rw [subNatNat_of_lt h, subNatNat_of_ge (Nat.le_of_lt h')]
        simp [Nat.succ_pred_eq_of_pos (Nat.sub_pos_of_lt h), Nat.mul_sub_left_distrib]
      | inr h =>
        cases Nat.lt_or_eq_of_le h with
        | inl h' =>
          have h₁ : m.succ * n > m.succ * k := Nat.mul_lt_mul_of_pos_left h' (Nat.succ_pos m)
          rw [subNatNat_of_ge h, subNatNat_of_lt h₁]; simp [Nat.mul_sub_left_distrib, Nat.mul_comm]
          rw [Nat.mul_comm k, Nat.mul_comm n, ←Nat.succ_pred_eq_of_pos (Nat.sub_pos_of_lt h₁),
              ←negOfNat_of_succ]; rfl
        | inr h' => rw [h']; simp

  protected theorem mul_assoc : ∀ a b c : Int, (a * b) * c = a * (b * c)
  | ofNat   a, ofNat   b, ofNat   c => by simp [Nat.mul_assoc]
  | ofNat   a, ofNat   b, negSucc c => by simp [Nat.mul_assoc]
  | ofNat   a, negSucc b, ofNat   c => by simp [Nat.mul_assoc]
  | ofNat   a, negSucc b, negSucc c => by simp [Nat.mul_assoc]
  | negSucc a, ofNat   b, ofNat   c => by simp [Nat.mul_assoc]
  | negSucc a, ofNat   b, negSucc c => by simp [Nat.mul_assoc]
  | negSucc a, negSucc b, ofNat   c => by simp [Nat.mul_assoc]
  | negSucc a, negSucc b, negSucc c => by simp [Nat.mul_assoc]

  protected theorem mul_distrib_left : ∀ a b c : Int, a * (b + c) = a * b + a * c
  | ofNat   a, ofNat   b, ofNat   c => by simp [Nat.left_distrib]
  | ofNat   a, ofNat   b, negSucc c => by simp [negOfNat_eq_subNatNat_zero]; rw [←subNatNat_add]; rfl
  | ofNat   a, negSucc b, ofNat   c => by simp [negOfNat_eq_subNatNat_zero]; rw [Int.add_comm, ←subNatNat_add]; rfl
  | ofNat   a, negSucc b, negSucc c => by simp; rw [←Nat.left_distrib, Nat.succ_add, Nat.add_succ]
  | negSucc a, ofNat   b, ofNat   c => by simp [Nat.mul_comm]; rw [←Nat.right_distrib, Nat.mul_comm]
  | negSucc a, ofNat   b, negSucc c => by simp [negOfNat_eq_subNatNat_zero]; rw [Int.add_comm, ←subNatNat_add]; rfl
  | negSucc a, negSucc b, ofNat   c => by simp [negOfNat_eq_subNatNat_zero]; rw [←subNatNat_add]; rfl
  | negSucc a, negSucc b, negSucc c => by simp; rw [←Nat.left_distrib, Nat.succ_add, Nat.add_succ]

  protected theorem mul_distrib_right : ∀ a b c : Int, (a + b) * c = a * c + b * c := fun a b c => by
    rw [Int.mul_comm, Int.mul_distrib_left]; simp [Int.mul_comm]

end Int