import tutorial_world.level18_by_contra --hide
open IncidencePlane --hide

/- Axiom :
existence (Ω : Type) : ∃ P Q R : Ω, P ≠ Q ∧ P ≠ R ∧ Q ≠ R ∧ R ∉ (line_through P Q)
-/

/-
# Incidence World

## Level 1: The axioms of incidence.

Just as the roof of a building cannot stand without the bricks that are glued to the floor,
neither can theorems stand without axioms. In mathematics, we need to set down some starting points
to build our knowledge, and this is why axioms should join the game. What are axioms? - you will be
wondering... Axioms are unprovable statements which are assumed to be true because of their self-evidence.
They are served as a premise for further reasoning and arguments, so that we can reach new conclusions from them.

By travelling back in time to 300 B.C., we meet the great mathematician Euclid, who suggested the very
first postulates of geometry in his well-known book **`Elements`**. Euclidean geometry can be built up from three
separate sets of axioms, each of them adding new independent notions that are needed to define the plane. These sets of axioms
were proposed by David Hilbert (1862-1943 AD), who made remarkable improvements in the foundations of geometry.
These three sets are called **incidence**, **order** and **congruence** (we might also want to add the **Parallel Axiom**).

When it comes to the first set of axioms, there are up to three axioms of incidence. These are established to define
the primitive notions of **point**, **line** and the relationship between these two concepts, which is called **incidence**. Notice
that by "incidence" we mean whatever idea that satifies the axioms of incidence. Then, you will be wondering... are the
notions of "point" and "line" referring to whatever object of reality that satisfies the axioms of incidence? Exactly!
Before the axioms of incidence, these notions are **undefined**!

In fact, if we want to verify the consistency and independency of these axioms from one another, we need to create something
called a **model**. A model consists of assigning the concepts that are mentioned in the axioms to whatever objects of reality we would like to imagine.
As long as all the `axioms of incidence` are satisfied by this model, we can then assure that this set of axioms is consistent.
Let's introduce the axioms of incidence so that we can create a model that satisfies them!

**A.1)** For every point P and for every point Q not equal to P, there exists a unique line ℓ "passing through" (= incident with) P and Q.

**A.2)** For every line ℓ, there exist two distinct points that "pass through" (= are incident with) it.

**A.3)** There exist three distinct points with the property that no line "passes through" (= is incident with) all three of them.

It might be useful for you to do a drawing in order to understand each of the axioms more clearly, but remember that mathematics
does not understand drawings but logical relationships to build new knowledge!

Let's make a model! For example, say that we have three distinct needles and thread. (**Note:** we must specify how many objects of each type
we have in order to be as rigorous as axioms are.) Then, we can define these three distinct needles as three distinct points and thread as the line ℓ.
Now, we have to check if this model satisfies the axioms of incidence. If you try by your own, you will realise that the three axioms are being
satisfied at the same time and without contradicting one another. Then, the axioms of incidence are consistent!

Now, notice that **the more axioms there exist, the more difficult it is to create a model that satisfies all of them.** For this reason,
**the objective of axiomatic geometry is establishing as less axioms as possible to create a specific model that might be beautiful or applicable to reality.**

## The axioms of incidence in Lean.

How do we make the computer understand such complex statements? By using Type Theory, it is possible to define these concepts in Lean! However,
some of them are such difficult for a computer to comprehend that they must be divided into more than one statement. For example, the first axiom is
divided into four statements:

* `line_through (P Q : Ω) : Line Ω := line_through' P Q`

* `line_through_left (P Q : Ω) : P ∈ (line_through P Q)`

* `line_through_right (P Q : Ω) : Q ∈ (line_through P Q)`

* `incidence {P Q : Ω} {ℓ : Line Ω} : P ≠ Q → P ∈ ℓ → Q ∈ ℓ → ℓ = line_through P Q`

Here it comes the second axiom of incidence in Lean:

* `line_contains_two_points (ℓ : Line Ω) : ∃ P Q : Ω, P ≠ Q ∧ ℓ = line_through P Q`

And, to finish with, the third one appears right below:

* `existence (Ω : Type) : ∃ P Q R : Ω, P ≠ Q ∧ P ≠ R ∧ Q ≠ R ∧ R ∉ (line_through P Q)`

With that being said, let's try to solve the first level of this world together!

## Let's solve this level together!

Now that we have learned the basic Lean tactics, we are ready to prove our first theorem!

The goal of this world is to prove the existence of triangles, but we will start showing that there is no line
that covers the whole plane. That is to say, every line misses at least one point.

To solve this level, we will need to use the third axiom of incidence. For this reason, the theorem statement
called `existence` has been added to the list of our theorem statements (located at the left-hand side of the game screen).
[**Remember:** Despite being in the Incidence World, we can freely use the theorem statements from the Tutorial World.]

## Step 1: Thinking of a mathematical proof!

To begin with, we are going to understand why we need to start our proof by using the third axiom of incidence. Read the lemma
of this level and do a drawing of the situation. Can you see that there is a point which is not in the line you have drawed? Now, go above and
read the first two axioms of incidence. Then, come back here. Have you noticed it? All the points which are considered in the first two axioms
pass through a line! Meanwhile, if we want to prove our lemma, we need to generate a point which is not in a line! Now, go above and read the
third axiom of incidence. Because this is the only axiom that considers a point which is not in a line, we must start by using it!

Once we've discovered how to start our proof, let's now define the objects that we are going to use! First, we need three distinct points which
will be called A, B and C. Then, we need a plane Ω that contains all of them! Now, you may be wondering if we have to define a line as well...
The answer is that we will have to define more than one line in fact, but we won't do this at the beginning of the proof because it's not necessary yet.
However, you might be asking... why can we not define a line that passes through two of the three points that we have defined and say that the line misses
one of the points? The answer is simple: that is not what we want. If you read the lemma again, you will see that it considers **every** possible line of the plane.
Then, if we define a line, we are just proving one case out of all the lines that could exist in a plane!

Because of this reason, **we must divide our proof into different cases**. That is, into different possible lines. Does this mean that we have to consider as many
cases as lines exist in a plane? Absolutely not! If that was the case, we would need infinite lifes to finish that proof! What we need to do, instead, is to
**provide as less cases as possible to prove that the lemma is true**. Then, **how do we know the minimum number of cases that are needed to prove this lemma?**
The answer to this question is **by knowing the minimum number of dimensions that are needed to satisfy the lemma**. If you try to prove this lemma in non-dimensional
or one-dimensional spaces, you will see that it is not possible. However, in two-dimensional spaces (that is, the plane) it **is** possible to prove it. And because
the minimum number of points to build the plane is three, then we can prove this lemma just by generating three points.

Now that we have divided the proof into three cases, it's time to talk about each of them. The strategy is to define a unique line for each of the cases so that
exactly one point misses that line. To define the lines, we will make use of the first axiom of incidence, which is the only one that makes it possible when we've
already generated two or more points. Because these cases don't have to follow a specific order, we will just choose an arbitrary order to step through them. In the
first case, we will define a line through the points A and B so that the line misses the point C. In the second one, we will define a line through the points A and C
so that the line misses the point B. In the third one, we will define a line through the points B and C so that the line misses the point A.

To finish with, draw the situation of these three cases separately. Then, make sure that all of them satisfy the three axioms of incidence and answer the lemma of
this level at the same time. Read this section as many times as necessary to understand it so that you can enjoy the following steps to the maximum!

## Step 2: Writing a mathematical proof in paper!

Before typing any tactic in Lean, writing the mathematical proof in paper first is a synonym of success! In this way, you will have a clear and structured strategy to
face the level you are trying to complete! Now, read the mathematical proof in paper for this lemma and try to grasp every bit of it!

**Claim:** Every line misses at least one point.

**Proof:**

By the third axiom of incidence, let A, B and C be three non-collinear points that lie on the plane Ω.

Now, we proceed with the proof by cases.

**Case 1:** By the first axiom of incidence, let ℓ be the line that is incident with the points A and B. Because of the third axiom of incidence, the line ℓ
in not incident with the point C.

**Case 2:** By the first axiom of incidence, let ℓ be the line that is incident with the points A and C. Because of the third axiom of incidence, the line ℓ
in not incident with the point B.

**Case 3:** By the first axiom of incidence, let ℓ be the line that is incident with the points B and C. Because of the third axiom of incidence, the line ℓ
in not incident with the point A.

Hence, we have shown that every line misses at least one point.

## Step 3: Writing a mathematical proof in Lean!

To begin with, we generate three non-collinear points A, B and C in the plane Ω by using the following theorem statement:

`existence (Ω : Type) : ∃ P Q R : Ω, P ≠ Q ∧ P ≠ R ∧ Q ≠ R ∧ R ∉ (line_through P Q)`

To do so, delete the `sorry` and type `rcases existence Ω with ⟨A, B, C, ⟨hAB, hAC, hBC, h⟩⟩,` where Ω is the plane, A, B and C are the points that lie on
that plane and `hAB`, `hAC`, `hBC` and `h` are the hypotheses `A ≠ B`, `A ≠ C`, `B ≠ C` and `C ∉ (line_through A B)`, respectively.

Then, we proceed with the proof by cases. First, we type `by_cases hA : A ∈ ℓ,`. This will break the proof into two cases. On the one hand, the one where the
point A is in the line ℓ. On the other hand, the one where the line ℓ misses the point A. [**Recommendation:** Write curly braces to structure the proof. See level
9 of Tutorial World in case you don't remember how to do it.]

Subsequently, and inside the first case, we type `by_cases hB : B ∈ ℓ,`. This will break the firt case into two cases. On the one hand, the one where the
points A and B are in the line ℓ. In this case, you will have to call the point C by typing `use C,`, since it is the one that satisfies the goal `⊢ ∃ (P : Ω), P ∉ ℓ`. Right
after, try to use the `incidence` theorem statement to change the goal from `⊢ C ∉ ℓ` into `⊢ C ∉ line_through A B`. On the other hand, it appears the one
where the points A and C are in the line ℓ, so that ℓ misses the point B. Because of this reason, `use B,` will close the goal automatically.

To finish with, you can finish the proof by solving the last case, which is the one where the line ℓ misses the point A. Try to follow the train of thought from the
previous cases to complete this level. In case you get stuck, click right below for a hint.

-/

/- Hint : Click here for a hint, in case you get stuck.
When using the `incidence` theorem statement, you are trying to "substitute" the line `ℓ` for the `line_through A B`. Try to find the Lean tactic that allows us
to make progress. Still bewildered? Click on "View source" (located on the top right corner of the game screen) to see the solution.
-/

variables {Ω : Type} [IncidencePlane Ω] --hide

/- Lemma :
Every line misses at least one point.
-/
lemma exists_point_not_in_line (ℓ : Line Ω) : ∃ (P : Ω), P ∉ ℓ :=
begin
  rcases existence Ω with ⟨A, B, C, ⟨hAB, hAC, hBC, h⟩⟩,
  by_cases hA : A ∈ ℓ,
  {
    by_cases hB : B ∈ ℓ,
    {
      use C,
      rw incidence hAB hA hB,
      exact h,
    },
    {
      use B,
    }
  },
  {
    use A,
  },

end


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

! This file was ported from Lean 3 source module data.mv_polynomial.funext
! leanprover-community/mathlib commit da01792ca4894d4f3a98d06b6c50455e5ed25da3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Polynomial.RingDivision
import Mathbin.Data.MvPolynomial.Rename
import Mathbin.RingTheory.Polynomial.Basic

/-!
## Function extensionality for multivariate polynomials

In this file we show that two multivariate polynomials over an infinite integral domain are equal
if they are equal upon evaluating them on an arbitrary assignment of the variables.

# Main declaration

* `mv_polynomial.funext`: two polynomials `φ ψ : mv_polynomial σ R`
  over an infinite integral domain `R` are equal if `eval x φ = eval x ψ` for all `x : σ → R`.

-/

namespace MvPolynomial

variable {R : Type _} [CommRing R] [IsDomain R] [Infinite R]

private theorem funext_fin {n : ℕ} {p : MvPolynomial (Fin n) R}
    (h : ∀ x : Fin n → R, eval x p = 0) : p = 0 :=
  by
  induction' n with n ih generalizing R
  · let e := MvPolynomial.isEmptyRingEquiv R (Fin 0)
    apply e.injective
    rw [RingEquiv.map_zero]
    convert h finZeroElim
    suffices
      (eval₂_hom (RingHom.id _) (IsEmpty.elim' Fin.isEmpty)) p =
        (eval finZeroElim : MvPolynomial (Fin 0) R →+* R) p
      by
      rw [← this]
      simp only [coe_eval₂_hom, is_empty_ring_equiv_apply, RingEquiv.trans_apply,
        aeval_eq_eval₂_hom]
      congr
    exact eval₂_hom_congr rfl (Subsingleton.elim _ _) rfl
  · let e := (finSuccEquiv R n).toRingEquiv
    apply e.injective
    simp only [RingEquiv.map_zero]
    apply Polynomial.funext
    intro q
    rw [Polynomial.eval_zero]
    apply ih
    swap
    · infer_instance
    intro x
    dsimp [e]
    rw [fin_succ_equiv_apply]
    calc
      _ = eval _ p := _
      _ = 0 := h _

    · intro i
      exact Fin.cases (eval x q) x i
    apply induction_on p
    · intro r
      simp only [eval_C, Polynomial.eval_C, RingHom.coe_comp, eval₂_hom_C]
    · intros
      simp only [*, RingHom.map_add, Polynomial.eval_add]
    · intro φ i hφ
      simp only [*, eval_X, Polynomial.eval_mul, RingHom.map_mul, eval₂_hom_X']
      congr 1
      by_cases hi : i = 0
      · subst hi
        simp only [Polynomial.eval_X, Fin.cases_zero]
      · rw [← Fin.succ_pred i hi]
        simp only [eval_X, Polynomial.eval_C, Fin.cases_succ]
    · infer_instance
#align mv_polynomial.funext_fin mv_polynomial.funext_fin

/-- Two multivariate polynomials over an infinite integral domain are equal
if they are equal upon evaluating them on an arbitrary assignment of the variables. -/
theorem funext {σ : Type _} {p q : MvPolynomial σ R} (h : ∀ x : σ → R, eval x p = eval x q) :
    p = q :=
  by
  suffices ∀ p, (∀ x : σ → R, eval x p = 0) → p = 0
    by
    rw [← sub_eq_zero, this (p - q)]
    simp only [h, RingHom.map_sub, forall_const, sub_self]
  clear h p q
  intro p h
  obtain ⟨n, f, hf, p, rfl⟩ := exists_fin_rename p
  suffices p = 0 by rw [this, AlgHom.map_zero]
  apply funext_fin
  intro x
  classical
    convert h (Function.extend f x 0)
    simp only [eval, eval₂_hom_rename, Function.extend_comp hf]
#align mv_polynomial.funext MvPolynomial.funext

theorem funext_iff {σ : Type _} {p q : MvPolynomial σ R} :
    p = q ↔ ∀ x : σ → R, eval x p = eval x q :=
  ⟨by rintro rfl <;> simp only [forall_const, eq_self_iff_true], funext⟩
#align mv_polynomial.funext_iff MvPolynomial.funext_iff

end MvPolynomial


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

! This file was ported from Lean 3 source module data.nat.units
! leanprover-community/mathlib commit 2258b40dacd2942571c8ce136215350c702dc78f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.Basic
import Mathlib.Algebra.Group.Units

/-! # The units of the natural numbers as a `Monoid` and `AddMonoid` -/

namespace Nat

theorem units_eq_one (u : ℕˣ) : u = 1 :=
  Units.ext <| Nat.eq_one_of_dvd_one ⟨u.inv, u.val_inv.symm⟩
#align nat.units_eq_one Nat.units_eq_one

theorem addUnits_eq_zero (u : AddUnits ℕ) : u = 0 :=
  AddUnits.ext <| (Nat.eq_zero_of_add_eq_zero u.val_neg).1
#align nat.add_units_eq_zero Nat.addUnits_eq_zero

@[simp]
protected theorem isUnit_iff {n : ℕ} : IsUnit n ↔ n = 1 :=
  Iff.intro
    (fun ⟨u, hu⟩ =>
      match n, u, hu, Nat.units_eq_one u with
      | _, _, rfl, rfl => rfl)
    fun h => h.symm ▸ ⟨1, rfl⟩
#align nat.is_unit_iff Nat.isUnit_iff

instance unique_units : Unique ℕˣ where
  default := 1
  uniq := Nat.units_eq_one
#align nat.unique_units Nat.unique_units

instance unique_addUnits : Unique (AddUnits ℕ) where
  default := 0
  uniq := Nat.addUnits_eq_zero
#align nat.unique_add_units Nat.unique_addUnits

end Nat


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Simon Hudon, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.to_additive
import Mathlib.tactic.basic
import Mathlib.PostPort

universes u l

namespace Mathlib

/-!
# Typeclasses for (semi)groups and monoid

In this file we define typeclasses for algebraic structures with one binary operation.
The classes are named `(add_)?(comm_)?(semigroup|monoid|group)`, where `add_` means that
the class uses additive notation and `comm_` means that the class assumes that the binary
operation is commutative.

The file does not contain any lemmas except for

* axioms of typeclasses restated in the root namespace;
* lemmas required for instances.

For basic lemmas about these classes see `algebra.group.basic`.
-/

/- Additive "sister" structures.
   Example, add_semigroup mirrors semigroup.
   These structures exist just to help automation.
   In an alternative design, we could have the binary operation as an
   extra argument for semigroup, monoid, group, etc. However, the lemmas
   would be hard to index since they would not contain any constant.
   For example, mul_assoc would be

   lemma mul_assoc {α : Type u} {op : α → α → α} [semigroup α op] :
                   ∀ a b c : α, op (op a b) c = op a (op b c) :=
    semigroup.mul_assoc

   The simplifier cannot effectively use this lemma since the pattern for
   the left-hand-side would be

        ?op (?op ?a ?b) ?c

   Remark: we use a tactic for transporting theorems from the multiplicative fragment
   to the additive one.
-/

/-- `left_mul g` denotes left multiplication by `g` -/
def left_add {G : Type u} [Add G] : G → G → G :=
  fun (g x : G) => g + x

/-- `right_mul g` denotes right multiplication by `g` -/
def right_mul {G : Type u} [Mul G] : G → G → G :=
  fun (g x : G) => x * g

/-- A semigroup is a type with an associative `(*)`. -/
class semigroup (G : Type u)
extends Mul G
where
  mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c)

/-- An additive semigroup is a type with an associative `(+)`. -/
class add_semigroup (G : Type u)
extends Add G
where
  add_assoc : ∀ (a b c : G), a + b + c = a + (b + c)

theorem mul_assoc {G : Type u} [semigroup G] (a : G) (b : G) (c : G) : a * b * c = a * (b * c) :=
  semigroup.mul_assoc

protected instance add_semigroup.to_is_associative {G : Type u} [add_semigroup G] : is_associative G Add.add :=
  is_associative.mk add_assoc

/-- A commutative semigroup is a type with an associative commutative `(*)`. -/
class comm_semigroup (G : Type u)
extends semigroup G
where
  mul_comm : ∀ (a b : G), a * b = b * a

/-- A commutative additive semigroup is a type with an associative commutative `(+)`. -/
class add_comm_semigroup (G : Type u)
extends add_semigroup G
where
  add_comm : ∀ (a b : G), a + b = b + a

theorem mul_comm {G : Type u} [comm_semigroup G] (a : G) (b : G) : a * b = b * a :=
  comm_semigroup.mul_comm

protected instance comm_semigroup.to_is_commutative {G : Type u} [comm_semigroup G] : is_commutative G Mul.mul :=
  is_commutative.mk mul_comm

/-- A `left_cancel_semigroup` is a semigroup such that `a * b = a * c` implies `b = c`. -/
class left_cancel_semigroup (G : Type u)
extends semigroup G
where
  mul_left_cancel : ∀ (a b c : G), a * b = a * c → b = c

/-- An `add_left_cancel_semigroup` is an additive semigroup such that
`a + b = a + c` implies `b = c`. -/
class add_left_cancel_semigroup (G : Type u)
extends add_semigroup G
where
  add_left_cancel : ∀ (a b c : G), a + b = a + c → b = c

theorem mul_left_cancel {G : Type u} [left_cancel_semigroup G] {a : G} {b : G} {c : G} : a * b = a * c → b = c :=
  left_cancel_semigroup.mul_left_cancel a b c

theorem mul_left_cancel_iff {G : Type u} [left_cancel_semigroup G] {a : G} {b : G} {c : G} : a * b = a * c ↔ b = c :=
  { mp := mul_left_cancel, mpr := congr_arg fun {b : G} => a * b }

theorem mul_right_injective {G : Type u} [left_cancel_semigroup G] (a : G) : function.injective (Mul.mul a) :=
  fun (b c : G) => mul_left_cancel

@[simp] theorem add_right_inj {G : Type u} [add_left_cancel_semigroup G] (a : G) {b : G} {c : G} : a + b = a + c ↔ b = c :=
  function.injective.eq_iff (add_right_injective a)

/-- A `right_cancel_semigroup` is a semigroup such that `a * b = c * b` implies `a = c`. -/
class right_cancel_semigroup (G : Type u)
extends semigroup G
where
  mul_right_cancel : ∀ (a b c : G), a * b = c * b → a = c

/-- An `add_right_cancel_semigroup` is an additive semigroup such that
`a + b = c + b` implies `a = c`. -/
class add_right_cancel_semigroup (G : Type u)
extends add_semigroup G
where
  add_right_cancel : ∀ (a b c : G), a + b = c + b → a = c

theorem mul_right_cancel {G : Type u} [right_cancel_semigroup G] {a : G} {b : G} {c : G} : a * b = c * b → a = c :=
  right_cancel_semigroup.mul_right_cancel a b c

theorem add_right_cancel_iff {G : Type u} [add_right_cancel_semigroup G] {a : G} {b : G} {c : G} : b + a = c + a ↔ b = c :=
  { mp := add_right_cancel, mpr := congr_arg fun {b : G} => b + a }

theorem add_left_injective {G : Type u} [add_right_cancel_semigroup G] (a : G) : function.injective fun (x : G) => x + a :=
  fun (b c : G) => add_right_cancel

@[simp] theorem add_left_inj {G : Type u} [add_right_cancel_semigroup G] (a : G) {b : G} {c : G} : b + a = c + a ↔ b = c :=
  function.injective.eq_iff (add_left_injective a)

/-- A `monoid` is a `semigroup` with an element `1` such that `1 * a = a * 1 = a`. -/
class monoid (M : Type u)
extends semigroup M, HasOne M
where
  one_mul : ∀ (a : M), 1 * a = a
  mul_one : ∀ (a : M), a * 1 = a

/-- An `add_monoid` is an `add_semigroup` with an element `0` such that `0 + a = a + 0 = a`. -/
class add_monoid (M : Type u)
extends HasZero M, add_semigroup M
where
  zero_add : ∀ (a : M), 0 + a = a
  add_zero : ∀ (a : M), a + 0 = a

@[simp] theorem one_mul {M : Type u} [monoid M] (a : M) : 1 * a = a :=
  monoid.one_mul

@[simp] theorem add_zero {M : Type u} [add_monoid M] (a : M) : a + 0 = a :=
  add_monoid.add_zero

protected instance monoid_to_is_left_id {M : Type u} [monoid M] : is_left_id M Mul.mul 1 :=
  is_left_id.mk monoid.one_mul

protected instance add_monoid_to_is_right_id {M : Type u} [add_monoid M] : is_right_id M Add.add 0 :=
  is_right_id.mk add_monoid.add_zero

theorem left_neg_eq_right_neg {M : Type u} [add_monoid M] {a : M} {b : M} {c : M} (hba : b + a = 0) (hac : a + c = 0) : b = c := sorry

/-- A commutative monoid is a monoid with commutative `(*)`. -/
class comm_monoid (M : Type u)
extends comm_semigroup M, monoid M
where

/-- An additive commutative monoid is an additive monoid with commutative `(+)`. -/
class add_comm_monoid (M : Type u)
extends add_comm_semigroup M, add_monoid M
where

/-- An additive monoid in which addition is left-cancellative.
Main examples are `ℕ` and groups. This is the right typeclass for many sum lemmas, as having a zero
is useful to define the sum over the empty set, so `add_left_cancel_semigroup` is not enough. -/
-- TODO: I found 1 (one) lemma assuming `[add_left_cancel_monoid]`.

class add_left_cancel_monoid (M : Type u)
extends add_left_cancel_semigroup M, add_monoid M
where

-- Should we port more lemmas to this typeclass?

/-- A monoid in which multiplication is left-cancellative. -/
class left_cancel_monoid (M : Type u)
extends left_cancel_semigroup M, monoid M
where

/-- Commutative version of add_left_cancel_monoid. -/
class add_left_cancel_comm_monoid (M : Type u)
extends add_left_cancel_monoid M, add_comm_monoid M
where

/-- Commutative version of left_cancel_monoid. -/
class left_cancel_comm_monoid (M : Type u)
extends left_cancel_monoid M, comm_monoid M
where

/-- An additive monoid in which addition is right-cancellative.
Main examples are `ℕ` and groups. This is the right typeclass for many sum lemmas, as having a zero
is useful to define the sum over the empty set, so `add_right_cancel_semigroup` is not enough. -/
class add_right_cancel_monoid (M : Type u)
extends add_monoid M, add_right_cancel_semigroup M
where

/-- A monoid in which multiplication is right-cancellative. -/
class right_cancel_monoid (M : Type u)
extends right_cancel_semigroup M, monoid M
where

/-- Commutative version of add_right_cancel_monoid. -/
class add_right_cancel_comm_monoid (M : Type u)
extends add_right_cancel_monoid M, add_comm_monoid M
where

/-- Commutative version of right_cancel_monoid. -/
class right_cancel_comm_monoid (M : Type u)
extends right_cancel_monoid M, comm_monoid M
where

/-- An additive monoid in which addition is cancellative on both sides.
Main examples are `ℕ` and groups. This is the right typeclass for many sum lemmas, as having a zero
is useful to define the sum over the empty set, so `add_right_cancel_semigroup` is not enough. -/
class add_cancel_monoid (M : Type u)
extends add_left_cancel_monoid M, add_right_cancel_monoid M
where

/-- A monoid in which multiplication is cancellative. -/
class cancel_monoid (M : Type u)
extends left_cancel_monoid M, right_cancel_monoid M
where

/-- Commutative version of add_cancel_monoid. -/
class add_cancel_comm_monoid (M : Type u)
extends add_left_cancel_comm_monoid M, add_right_cancel_comm_monoid M
where

/-- Commutative version of cancel_monoid. -/
class cancel_comm_monoid (M : Type u)
extends right_cancel_comm_monoid M, left_cancel_comm_monoid M
where

/-- `try_refl_tac` solves goals of the form `∀ a b, f a b = g a b`,
if they hold by definition. -/
/-- A `div_inv_monoid` is a `monoid` with operations `/` and `⁻¹` satisfying
`div_eq_mul_inv : ∀ a b, a / b = a * b⁻¹`.

This is the immediate common ancestor of `group` and `group_with_zero`,
in order to deduplicate the name `div_eq_mul_inv`.
The default for `div` is such that `a / b = a * b⁻¹` holds by definition.

Adding `div` as a field rather than defining `a / b := a * b⁻¹` allows us to
avoid certain classes of unification failures, for example:
Let `foo X` be a type with a `∀ X, has_div (foo X)` instance but no
`∀ X, has_inv (foo X)`, e.g. when `foo X` is a `euclidean_domain`. Suppose we
also have an instance `∀ X [cromulent X], group_with_zero (foo X)`. Then the
`(/)` coming from `group_with_zero_has_div` cannot be definitionally equal to
the `(/)` coming from `foo.has_div`.
-/
class div_inv_monoid (G : Type u)
extends Div G, monoid G, has_inv G
where
  div_eq_mul_inv : autoParam (∀ (a b : G), a / b = a * (b⁻¹))
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.try_refl_tac")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "try_refl_tac") [])

/-- A `sub_neg_monoid` is an `add_monoid` with unary `-` and binary `-` operations
satisfying `sub_eq_add_neg : ∀ a b, a - b = a + -b`.

The default for `sub` is such that `a - b = a + -b` holds by definition.

Adding `sub` as a field rather than defining `a - b := a + -b` allows us to
avoid certain classes of unification failures, for example:
Let `foo X` be a type with a `∀ X, has_sub (foo X)` instance but no
`∀ X, has_neg (foo X)`. Suppose we also have an instance
`∀ X [cromulent X], add_group (foo X)`. Then the `(-)` coming from
`add_group.has_sub` cannot be definitionally equal to the `(-)` coming from
`foo.has_sub`.
-/
class sub_neg_monoid (G : Type u)
extends Sub G, Neg G, add_monoid G
where
  sub_eq_add_neg : autoParam (∀ (a b : G), a - b = a + -b)
  (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.try_refl_tac")
    (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "try_refl_tac") [])

theorem sub_eq_add_neg {G : Type u} [sub_neg_monoid G] (a : G) (b : G) : a - b = a + -b :=
  sub_neg_monoid.sub_eq_add_neg

/-- A `group` is a `monoid` with an operation `⁻¹` satisfying `a⁻¹ * a = 1`.

There is also a division operation `/` such that `a / b = a * b⁻¹`,
with a default so that `a / b = a * b⁻¹` holds by definition.
-/
class group (G : Type u)
extends div_inv_monoid G
where
  mul_left_inv : ∀ (a : G), a⁻¹ * a = 1

/-- An `add_group` is an `add_monoid` with a unary `-` satisfying `-a + a = 0`.

There is also a binary operation `-` such that `a - b = a + -b`,
with a default so that `a - b = a + -b` holds by definition.
-/
class add_group (A : Type u)
extends sub_neg_monoid A
where
  add_left_neg : ∀ (a : A), -a + a = 0

/-- Abbreviation for `@div_inv_monoid.to_monoid _ (@group.to_div_inv_monoid _ _)`.

Useful because it corresponds to the fact that `Grp` is a subcategory of `Mon`.
Not an instance since it duplicates `@div_inv_monoid.to_monoid _ (@group.to_div_inv_monoid _ _)`.
-/
def group.to_monoid (G : Type u) [group G] : monoid G :=
  div_inv_monoid.to_monoid G

@[simp] theorem mul_left_inv {G : Type u} [group G] (a : G) : a⁻¹ * a = 1 :=
  group.mul_left_inv

theorem inv_mul_self {G : Type u} [group G] (a : G) : a⁻¹ * a = 1 :=
  mul_left_inv a

@[simp] theorem neg_add_cancel_left {G : Type u} [add_group G] (a : G) (b : G) : -a + (a + b) = b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-a + (a + b) = b)) (Eq.symm (add_assoc (-a) a b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-a + a + b = b)) (add_left_neg a)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 + b = b)) (zero_add b))) (Eq.refl b)))

@[simp] theorem inv_eq_of_mul_eq_one {G : Type u} [group G] {a : G} {b : G} (h : a * b = 1) : a⁻¹ = b :=
  left_inv_eq_right_inv (inv_mul_self a) h

@[simp] theorem inv_inv {G : Type u} [group G] (a : G) : a⁻¹⁻¹ = a :=
  inv_eq_of_mul_eq_one (mul_left_inv a)

@[simp] theorem add_right_neg {G : Type u} [add_group G] (a : G) : a + -a = 0 :=
  (fun (this : --a + -a = 0) => eq.mp (Eq._oldrec (Eq.refl ( --a + -a = 0)) (neg_neg a)) this) (add_left_neg (-a))

theorem add_neg_self {G : Type u} [add_group G] (a : G) : a + -a = 0 :=
  add_right_neg a

@[simp] theorem mul_inv_cancel_right {G : Type u} [group G] (a : G) (b : G) : a * b * (b⁻¹) = a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b * (b⁻¹) = a)) (mul_assoc a b (b⁻¹))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * (b * (b⁻¹)) = a)) (mul_right_inv b)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a * 1 = a)) (mul_one a))) (Eq.refl a)))

protected instance add_group.to_cancel_add_monoid {G : Type u} [add_group G] : add_cancel_monoid G :=
  add_cancel_monoid.mk add_group.add add_group.add_assoc sorry add_group.zero add_group.zero_add add_group.add_zero sorry

/-- A commutative group is a group with commutative `(*)`. -/
/-- An additive commutative group is an additive group with commutative `(+)`. -/
class comm_group (G : Type u)
extends group G, comm_monoid G
where

class add_comm_group (G : Type u)
extends add_group G, add_comm_monoid G
where

protected instance comm_group.to_cancel_comm_monoid {G : Type u} [comm_group G] : cancel_comm_monoid G :=
  cancel_comm_monoid.mk comm_group.mul comm_group.mul_assoc sorry comm_group.one comm_group.one_mul comm_group.mul_one
    comm_group.mul_comm sorry


/-
Copyright (c) 2021 Thomas Browning. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning
-/
import group_theory.submonoid.center

/-!
# Centralizers of magmas and monoids

## Main definitions

* `set.centralizer`: the center of a magma
* `submonoid.centralizer`: the center of a monoid
* `set.add_centralizer`: the center of an additive magma
* `add_submonoid.centralizer`: the center of an additive monoid

We provide `subgroup.centralizer`, `add_subgroup.centralizer` in other files.
-/

variables {M : Type*} {S T : set M}

namespace set

variables (S)

/-- The centralizer of a subset of a magma. -/
@[to_additive add_centralizer /-" The centralizer of a subset of an additive magma. "-/]
def centralizer [has_mul M] : set M := {c | ∀ m ∈ S, m * c = c * m}

variables {S}

@[to_additive mem_add_centralizer]
lemma mem_centralizer_iff [has_mul M] {c : M} : c ∈ centralizer S ↔ ∀ m ∈ S, m * c = c * m :=
iff.rfl

@[to_additive decidable_mem_add_centralizer]
instance decidable_mem_centralizer [has_mul M] [decidable_eq M] [fintype M]
  [decidable_pred (∈ S)] : decidable_pred (∈ centralizer S) :=
λ _, decidable_of_iff' _ (mem_centralizer_iff)

variables (S)

@[simp, to_additive zero_mem_add_centralizer]
lemma one_mem_centralizer [mul_one_class M] : (1 : M) ∈ centralizer S :=
by simp [mem_centralizer_iff]

@[simp]
lemma zero_mem_centralizer [mul_zero_class M] : (0 : M) ∈ centralizer S :=
by simp [mem_centralizer_iff]

variables {S} {a b : M}

@[simp, to_additive add_mem_add_centralizer]
lemma mul_mem_centralizer [semigroup M] (ha : a ∈ centralizer S) (hb : b ∈ centralizer S) :
  a * b ∈ centralizer S :=
λ g hg, by rw [mul_assoc, ←hb g hg, ← mul_assoc, ha g hg, mul_assoc]

@[simp, to_additive neg_mem_add_centralizer]
lemma inv_mem_centralizer [group M] (ha : a ∈ centralizer S) : a⁻¹ ∈ centralizer S :=
λ g hg, by rw [mul_inv_eq_iff_eq_mul, mul_assoc, eq_inv_mul_iff_mul_eq, ha g hg]

@[simp]
lemma add_mem_centralizer [distrib M] (ha : a ∈ centralizer S) (hb : b ∈ centralizer S) :
  a + b ∈ centralizer S :=
λ c hc, by rw [add_mul, mul_add, ha c hc, hb c hc]

@[simp]
lemma neg_mem_centralizer [has_mul M] [has_distrib_neg M] (ha : a ∈ centralizer S) :
  -a ∈ centralizer S :=
λ c hc, by rw [mul_neg, ha c hc, neg_mul]

@[simp]
lemma inv_mem_centralizer₀ [group_with_zero M] (ha : a ∈ centralizer S) : a⁻¹ ∈ centralizer S :=
(eq_or_ne a 0).elim (λ h, by { rw [h, inv_zero], exact zero_mem_centralizer S })
  (λ ha0 c hc, by rw [mul_inv_eq_iff_eq_mul₀ ha0, mul_assoc, eq_inv_mul_iff_mul_eq₀ ha0, ha c hc])

@[simp, to_additive sub_mem_add_centralizer]
lemma div_mem_centralizer [group M] (ha : a ∈ centralizer S) (hb : b ∈ centralizer S) :
  a / b ∈ centralizer S :=
begin
  rw [div_eq_mul_inv],
  exact mul_mem_centralizer ha (inv_mem_centralizer hb),
end

@[simp]
lemma div_mem_centralizer₀ [group_with_zero M] (ha : a ∈ centralizer S) (hb : b ∈ centralizer S) :
  a / b ∈ centralizer S :=
begin
  rw div_eq_mul_inv,
  exact mul_mem_centralizer ha (inv_mem_centralizer₀ hb),
end

@[to_additive add_centralizer_subset]
lemma centralizer_subset [has_mul M] (h : S ⊆ T) : centralizer T ⊆ centralizer S :=
λ t ht s hs, ht s (h hs)

variables (M)

@[simp, to_additive add_centralizer_univ]
lemma centralizer_univ [has_mul M] : centralizer univ = center M :=
subset.antisymm (λ a ha b, ha b (set.mem_univ b)) (λ a ha b hb, ha b)

variables {M} (S)

@[simp, to_additive add_centralizer_eq_univ]
lemma centralizer_eq_univ [comm_semigroup M] : centralizer S = univ :=
subset.antisymm (subset_univ _) $ λ x hx y hy, mul_comm y x

end set

namespace submonoid
section
variables {M} [monoid M] (S)

/-- The centralizer of a subset of a monoid `M`. -/
@[to_additive "The centralizer of a subset of an additive monoid."]
def centralizer : submonoid M :=
{ carrier := S.centralizer,
  one_mem' := S.one_mem_centralizer,
  mul_mem' := λ a b, set.mul_mem_centralizer }

@[simp, norm_cast, to_additive] lemma coe_centralizer : ↑(centralizer S) = S.centralizer := rfl

variables {S}

@[to_additive] lemma mem_centralizer_iff {z : M} : z ∈ centralizer S ↔ ∀ g ∈ S, g * z = z * g :=
iff.rfl

@[to_additive] instance decidable_mem_centralizer [decidable_eq M] [fintype M]
  [decidable_pred (∈ S)] : decidable_pred (∈ centralizer S) :=
λ _, decidable_of_iff' _ mem_centralizer_iff

@[to_additive]
lemma centralizer_le (h : S ⊆ T) : centralizer T ≤ centralizer S :=
set.centralizer_subset h

variables (M)

@[simp, to_additive]
lemma centralizer_univ : centralizer set.univ = center M :=
set_like.ext' (set.centralizer_univ M)

end

end submonoid


/-
Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Violeta Hernández Palacios
-/

import set_theory.ordinal.fixed_point

/-!
### Principal ordinals

We define principal or indecomposable ordinals, and we prove the standard properties about them.

### Main definitions and results
* `principal`: A principal or indecomposable ordinal under some binary operation. We include 0 and
  any other typically excluded edge cases for simplicity.
* `unbounded_principal`: Principal ordinals are unbounded.
* `principal_add_iff_zero_or_omega_opow`: The main characterization theorem for additive principal
  ordinals.
* `principal_mul_iff_le_two_or_omega_opow_opow`: The main characterization theorem for
  multiplicative principal ordinals.

### Todo
* Prove that exponential principal ordinals are 0, 1, 2, ω, or epsilon numbers, i.e. fixed points
  of `λ x, ω ^ x`.
-/

universe u

noncomputable theory

open order

namespace ordinal
local infixr ^ := @pow ordinal ordinal ordinal.has_pow

/-! ### Principal ordinals -/

/-- An ordinal `o` is said to be principal or indecomposable under an operation when the set of
ordinals less than it is closed under that operation. In standard mathematical usage, this term is
almost exclusively used for additive and multiplicative principal ordinals.

For simplicity, we break usual convention and regard 0 as principal. -/
def principal (op : ordinal → ordinal → ordinal) (o : ordinal) : Prop :=
∀ ⦃a b⦄, a < o → b < o → op a b < o

theorem principal_iff_principal_swap {op : ordinal → ordinal → ordinal} {o : ordinal} :
  principal op o ↔ principal (function.swap op) o :=
by split; exact λ h a b ha hb, h hb ha

theorem principal_zero {op : ordinal → ordinal → ordinal} : principal op 0 :=
λ a _ h, (ordinal.not_lt_zero a h).elim

@[simp] theorem principal_one_iff {op : ordinal → ordinal → ordinal} :
  principal op 1 ↔ op 0 0 = 0 :=
begin
  refine ⟨λ h, _, λ h a b ha hb, _⟩,
  { rwa ←lt_one_iff_zero,
    exact h zero_lt_one zero_lt_one },
  { rwa [lt_one_iff_zero, ha, hb] at * }
end

theorem principal.iterate_lt {op : ordinal → ordinal → ordinal} {a o : ordinal} (hao : a < o)
  (ho : principal op o) (n : ℕ) : (op a)^[n] a < o :=
begin
  induction n with n hn,
  { rwa function.iterate_zero },
  { rw function.iterate_succ', exact ho hao hn }
end

theorem op_eq_self_of_principal {op : ordinal → ordinal → ordinal} {a o : ordinal.{u}}
  (hao : a < o) (H : is_normal (op a)) (ho : principal op o) (ho' : is_limit o) : op a o = o :=
begin
  refine le_antisymm _ (H.self_le _),
  rw [←is_normal.bsup_eq.{u u} H ho', bsup_le_iff],
  exact λ b hbo, (ho hao hbo).le
end

theorem nfp_le_of_principal {op : ordinal → ordinal → ordinal}
  {a o : ordinal} (hao : a < o) (ho : principal op o) : nfp (op a) a ≤ o :=
nfp_le $ λ n, (ho.iterate_lt hao n).le

/-! ### Principal ordinals are unbounded -/

/-- The least strict upper bound of `op` applied to all pairs of ordinals less than `o`. This is
essentially a two-argument version of `ordinal.blsub`. -/
def blsub₂ (op : ordinal → ordinal → ordinal) (o : ordinal) : ordinal :=
lsub (λ x : o.out.α × o.out.α, op (typein (<) x.1) (typein (<) x.2))

theorem lt_blsub₂ (op : ordinal → ordinal → ordinal) {o : ordinal} {a b : ordinal} (ha : a < o)
  (hb : b < o) : op a b < blsub₂ op o :=
begin
  convert lt_lsub _ (prod.mk (enum (<) a (by rwa type_lt)) (enum (<) b (by rwa type_lt))),
  simp only [typein_enum]
end

theorem principal_nfp_blsub₂ (op : ordinal → ordinal → ordinal) (o : ordinal) :
  principal op (nfp (blsub₂.{u u} op) o) :=
λ a b ha hb, begin
  rw lt_nfp at *,
  cases ha with m hm,
  cases hb with n hn,
  cases le_total ((blsub₂.{u u} op)^[m] o) ((blsub₂.{u u} op)^[n] o) with h h,
  { use n + 1,
    rw function.iterate_succ',
    exact lt_blsub₂ op (hm.trans_le h) hn },
  { use m + 1,
    rw function.iterate_succ',
    exact lt_blsub₂ op hm (hn.trans_le h) },
end

theorem unbounded_principal (op : ordinal → ordinal → ordinal) :
  set.unbounded (<) {o | principal op o} :=
λ o, ⟨_, principal_nfp_blsub₂ op o, (le_nfp _ o).not_lt⟩

/-! #### Additive principal ordinals -/

theorem principal_add_one : principal (+) 1 :=
principal_one_iff.2 $ zero_add 0

theorem principal_add_of_le_one {o : ordinal} (ho : o ≤ 1) : principal (+) o :=
begin
  rcases le_one_iff.1 ho with rfl | rfl,
  { exact principal_zero },
  { exact principal_add_one }
end

theorem principal_add_is_limit {o : ordinal} (ho₁ : 1 < o) (ho : principal (+) o) :
  o.is_limit :=
begin
  refine ⟨λ ho₀, _, λ a hao, _⟩,
  { rw ho₀ at ho₁,
    exact not_lt_of_gt ordinal.zero_lt_one ho₁ },
  { cases eq_or_ne a 0 with ha ha,
    { rw [ha, succ_zero],
      exact ho₁ },
    { refine lt_of_le_of_lt _ (ho hao hao),
      rwa [←add_one_eq_succ, add_le_add_iff_left, one_le_iff_ne_zero] } }
end

theorem principal_add_iff_add_left_eq_self {o : ordinal} :
  principal (+) o ↔ ∀ a < o, a + o = o :=
begin
  refine ⟨λ ho a hao, _, λ h a b hao hbo, _⟩,
  { cases lt_or_le 1 o with ho₁ ho₁,
    { exact op_eq_self_of_principal hao (add_is_normal a) ho (principal_add_is_limit ho₁ ho) },
    { rcases le_one_iff.1 ho₁ with rfl | rfl,
      { exact (ordinal.not_lt_zero a hao).elim },
      { rw lt_one_iff_zero at hao,
        rw [hao, zero_add] }}},
  { rw ←h a hao,
    exact (add_is_normal a).strict_mono hbo }
end

theorem exists_lt_add_of_not_principal_add {a} (ha : ¬ principal (+) a) :
  ∃ (b c) (hb : b < a) (hc : c < a), b + c = a :=
begin
  unfold principal at ha,
  push_neg at ha,
  rcases ha with ⟨b, c, hb, hc, H⟩,
  refine ⟨b, _, hb, lt_of_le_of_ne (sub_le_self a b) (λ hab, _),
    ordinal.add_sub_cancel_of_le hb.le⟩,
  rw [←sub_le, hab] at H,
  exact H.not_lt hc
end

theorem principal_add_iff_add_lt_ne_self {a} :
  principal (+) a ↔ ∀ ⦃b c⦄, b < a → c < a → b + c ≠ a :=
⟨λ ha b c hb hc, (ha hb hc).ne, λ H, begin
  by_contra' ha,
  rcases exists_lt_add_of_not_principal_add ha with ⟨b, c, hb, hc, rfl⟩,
  exact (H hb hc).irrefl
end⟩

theorem add_omega {a : ordinal} (h : a < omega) : a + omega = omega :=
begin
  rcases lt_omega.1 h with ⟨n, rfl⟩,
  clear h, induction n with n IH,
  { rw [nat.cast_zero, zero_add] },
  { rwa [nat.cast_succ, add_assoc, one_add_of_omega_le (le_refl _)] }
end

theorem principal_add_omega : principal (+) omega :=
principal_add_iff_add_left_eq_self.2 (λ a, add_omega)

theorem add_omega_opow {a b : ordinal} (h : a < omega ^ b) : a + omega ^ b = omega ^ b :=
begin
  refine le_antisymm _ (le_add_left _ _),
  revert h, refine limit_rec_on b (λ h, _) (λ b _ h, _) (λ b l IH h, _),
  { rw [opow_zero, ← succ_zero, lt_succ_iff, ordinal.le_zero] at h,
    rw [h, zero_add] },
  { rw opow_succ at h,
    rcases (lt_mul_of_limit omega_is_limit).1 h with ⟨x, xo, ax⟩,
    refine le_trans (add_le_add_right (le_of_lt ax) _) _,
    rw [opow_succ, ← mul_add, add_omega xo] },
  { rcases (lt_opow_of_limit omega_ne_zero l).1 h with ⟨x, xb, ax⟩,
    exact (((add_is_normal a).trans (opow_is_normal one_lt_omega)).limit_le l).2 (λ y yb,
      (add_le_add_left (opow_le_opow_right omega_pos (le_max_right _ _)) _).trans
      (le_trans (IH _ (max_lt xb yb) (ax.trans_le $ opow_le_opow_right omega_pos (le_max_left _ _)))
      (opow_le_opow_right omega_pos $ le_of_lt $ max_lt xb yb))) }
end

theorem principal_add_omega_opow (o : ordinal) : principal (+) (omega ^ o) :=
principal_add_iff_add_left_eq_self.2 (λ a, add_omega_opow)

/-- The main characterization theorem for additive principal ordinals. -/
theorem principal_add_iff_zero_or_omega_opow {o : ordinal} :
  principal (+) o ↔ o = 0 ∨ ∃ a, o = omega ^ a :=
begin
  rcases eq_or_ne o 0 with rfl | ho,
  { simp only [principal_zero, or.inl] },
  { rw [principal_add_iff_add_left_eq_self],
    simp only [ho, false_or],
    refine ⟨λ H, ⟨_, ((lt_or_eq_of_le (opow_log_le_self _ (ordinal.pos_iff_ne_zero.2 ho)))
        .resolve_left $ λ h, _).symm⟩, λ ⟨b, e⟩, e.symm ▸ λ a, add_omega_opow⟩,
    have := H _ h,
    have := lt_opow_succ_log_self one_lt_omega o,
    rw [opow_succ, lt_mul_of_limit omega_is_limit] at this,
    rcases this with ⟨a, ao, h'⟩,
    rcases lt_omega.1 ao with ⟨n, rfl⟩, clear ao,
    revert h', apply not_lt_of_le,
    suffices e : omega ^ log omega o * ↑n + o = o,
    { simpa only [e] using le_add_right (omega ^ log omega o * ↑n) o },
    induction n with n IH, {simp only [nat.cast_zero, mul_zero, zero_add]},
    simp only [nat.cast_succ, mul_add_one, add_assoc, this, IH] }
end

theorem opow_principal_add_of_principal_add {a} (ha : principal (+) a) (b : ordinal) :
  principal (+) (a ^ b) :=
begin
  rcases principal_add_iff_zero_or_omega_opow.1 ha with rfl | ⟨c, rfl⟩,
  { rcases eq_or_ne b 0 with rfl | hb,
    { rw opow_zero, exact principal_add_one },
    { rwa zero_opow hb } },
  { rw ←opow_mul, exact principal_add_omega_opow _ }
end

theorem add_absorp {a b c : ordinal} (h₁ : a < omega ^ b) (h₂ : omega ^ b ≤ c) : a + c = c :=
by rw [← ordinal.add_sub_cancel_of_le h₂, ← add_assoc, add_omega_opow h₁]

theorem mul_principal_add_is_principal_add (a : ordinal.{u}) {b : ordinal.{u}} (hb₁ : b ≠ 1)
  (hb : principal (+) b) : principal (+) (a * b) :=
begin
  rcases eq_zero_or_pos a with rfl | ha,
  { rw zero_mul,
    exact principal_zero },
  { rcases eq_zero_or_pos b with rfl | hb₁',
    { rw mul_zero,
      exact principal_zero },
    { rw [← succ_le_iff, succ_zero] at hb₁',
      intros c d hc hd,
      rw lt_mul_of_limit (principal_add_is_limit (lt_of_le_of_ne hb₁' hb₁.symm) hb) at *,
      { rcases hc with ⟨x, hx, hx'⟩,
        rcases hd with ⟨y, hy, hy'⟩,
        use [x + y, hb hx hy],
        rw mul_add,
        exact left.add_lt_add hx' hy' },
      assumption' } }
end

/-! #### Multiplicative principal ordinals -/

theorem principal_mul_one : principal (*) 1 :=
by { rw principal_one_iff, exact zero_mul _ }

theorem principal_mul_two : principal (*) 2 :=
λ a b ha hb, begin
  have h₂ : succ (1 : ordinal) = 2 := rfl,
  rw [←h₂, lt_succ_iff] at *,
  convert mul_le_mul' ha hb,
  exact (mul_one 1).symm
end

theorem principal_mul_of_le_two {o : ordinal} (ho : o ≤ 2) : principal (*) o :=
begin
  rcases lt_or_eq_of_le ho with ho | rfl,
  { have h₂ : succ (1 : ordinal) = 2 := rfl,
    rw [←h₂, lt_succ_iff] at ho,
    rcases lt_or_eq_of_le ho with ho | rfl,
    { rw lt_one_iff_zero.1 ho,
      exact principal_zero },
    { exact principal_mul_one } },
  { exact principal_mul_two }
end

theorem principal_add_of_principal_mul {o : ordinal} (ho : principal (*) o) (ho₂ : o ≠ 2) :
  principal (+) o :=
begin
  cases lt_or_gt_of_ne ho₂ with ho₁ ho₂,
  { change o < succ 1 at ho₁,
    rw lt_succ_iff at ho₁,
    exact principal_add_of_le_one ho₁ },
  { refine λ a b hao hbo, lt_of_le_of_lt _ (ho (max_lt hao hbo) ho₂),
    rw mul_two,
    exact add_le_add (le_max_left a b) (le_max_right a b) }
end

theorem principal_mul_is_limit {o : ordinal.{u}} (ho₂ : 2 < o) (ho : principal (*) o) :
  o.is_limit :=
principal_add_is_limit
  ((lt_succ 1).trans ho₂)
  (principal_add_of_principal_mul ho (ne_of_gt ho₂))

theorem principal_mul_iff_mul_left_eq {o : ordinal} :
  principal (*) o ↔ ∀ a, 0 < a → a < o → a * o = o :=
begin
  refine ⟨λ h a ha₀ hao, _, λ h a b hao hbo, _⟩,
  { cases le_or_gt o 2 with ho ho,
    { convert one_mul o,
      apply le_antisymm,
      { have : a < succ 1 := hao.trans_le ho,
        rwa lt_succ_iff at this },
      { rwa [←succ_le_iff, succ_zero] at ha₀ } },
    { exact op_eq_self_of_principal hao (mul_is_normal ha₀) h (principal_mul_is_limit ho h) } },
  { rcases eq_or_ne a 0 with rfl | ha, { rwa zero_mul },
    rw ←ordinal.pos_iff_ne_zero at ha,
    rw ←h a ha hao,
    exact (mul_is_normal ha).strict_mono hbo }
end

theorem principal_mul_omega : principal (*) omega :=
λ a b ha hb, match a, b, lt_omega.1 ha, lt_omega.1 hb with
| _, _, ⟨m, rfl⟩, ⟨n, rfl⟩ := by { rw [← nat_cast_mul], apply nat_lt_omega }
end

theorem mul_omega {a : ordinal} (a0 : 0 < a) (ha : a < omega) : a * omega = omega :=
principal_mul_iff_mul_left_eq.1 (principal_mul_omega) a a0 ha

theorem mul_lt_omega_opow {a b c : ordinal}
  (c0 : 0 < c) (ha : a < omega ^ c) (hb : b < omega) : a * b < omega ^ c :=
begin
  rcases zero_or_succ_or_limit c with rfl|⟨c,rfl⟩|l,
  { exact (lt_irrefl _).elim c0 },
  { rw opow_succ at ha,
    rcases ((mul_is_normal $ opow_pos _ omega_pos).limit_lt
      omega_is_limit).1 ha with ⟨n, hn, an⟩,
    apply (mul_le_mul_right' (le_of_lt an) _).trans_lt,
    rw [opow_succ, mul_assoc, mul_lt_mul_iff_left (opow_pos _ omega_pos)],
    exact principal_mul_omega hn hb },
  { rcases ((opow_is_normal one_lt_omega).limit_lt l).1 ha with ⟨x, hx, ax⟩,
    refine (mul_le_mul' (le_of_lt ax) (le_of_lt hb)).trans_lt _,
    rw [← opow_succ, opow_lt_opow_iff_right one_lt_omega],
    exact l.2 _ hx }
end

theorem mul_omega_opow_opow {a b : ordinal} (a0 : 0 < a) (h : a < omega ^ omega ^ b) :
  a * omega ^ omega ^ b = omega ^ omega ^ b :=
begin
  by_cases b0 : b = 0, {rw [b0, opow_zero, opow_one] at h ⊢, exact mul_omega a0 h},
  refine le_antisymm _
    (by simpa only [one_mul] using mul_le_mul_right' (one_le_iff_pos.2 a0) (omega ^ omega ^ b)),
  rcases (lt_opow_of_limit omega_ne_zero (opow_is_limit_left omega_is_limit b0)).1 h
    with ⟨x, xb, ax⟩,
  apply (mul_le_mul_right' (le_of_lt ax) _).trans,
  rw [← opow_add, add_omega_opow xb]
end

theorem principal_mul_omega_opow_opow (o : ordinal) : principal (*) (omega ^ omega ^ o) :=
principal_mul_iff_mul_left_eq.2 (λ a, mul_omega_opow_opow)

theorem principal_add_of_principal_mul_opow {o b : ordinal} (hb : 1 < b)
  (ho : principal (*) (b ^ o)) : principal (+) o :=
λ x y hx hy, begin
  have := ho ((opow_lt_opow_iff_right hb).2 hx) ((opow_lt_opow_iff_right hb).2 hy),
  rwa [←opow_add, opow_lt_opow_iff_right hb] at this
end

/-- The main characterization theorem for multiplicative principal ordinals. -/
theorem principal_mul_iff_le_two_or_omega_opow_opow {o : ordinal} :
  principal (*) o ↔ o ≤ 2 ∨ ∃ a, o = omega ^ omega ^ a :=
begin
  refine ⟨λ ho, _, _⟩,
  { cases le_or_lt o 2 with ho₂ ho₂,
    { exact or.inl ho₂ },
    rcases principal_add_iff_zero_or_omega_opow.1 (principal_add_of_principal_mul ho ho₂.ne')
      with rfl | ⟨a, rfl⟩,
    { exact (ordinal.not_lt_zero 2 ho₂).elim },
    rcases principal_add_iff_zero_or_omega_opow.1
      (principal_add_of_principal_mul_opow one_lt_omega ho) with rfl | ⟨b, rfl⟩,
    { rw opow_zero at ho₂,
      exact ((lt_succ 1).not_le ho₂.le).elim },
    exact or.inr ⟨b, rfl⟩ },
  { rintro (ho₂ | ⟨a, rfl⟩),
    { exact principal_mul_of_le_two ho₂ },
    { exact principal_mul_omega_opow_opow a } }
end

theorem mul_eq_opow_log_succ {a b : ordinal.{u}} (ha : 0 < a) (hb : principal (*) b) (hb₂ : 2 < b) :
  a * b = b ^ succ (log b a) :=
begin
  apply le_antisymm,
  { have hbl := principal_mul_is_limit hb₂ hb,
    rw [←is_normal.bsup_eq.{u u} (mul_is_normal ha) hbl, bsup_le_iff],
    intros c hcb,
    have hb₁ : 1 < b := (lt_succ 1).trans hb₂,
    have hbo₀ : b ^ b.log a ≠ 0 := ordinal.pos_iff_ne_zero.1 (opow_pos _ (zero_lt_one.trans hb₁)),
    apply le_trans (mul_le_mul_right' (le_of_lt (lt_mul_succ_div a hbo₀)) c),
    rw [mul_assoc, opow_succ],
    refine mul_le_mul_left' (le_of_lt (hb (hbl.2 _ _) hcb)) _,
    rw [div_lt hbo₀, ←opow_succ],
    exact lt_opow_succ_log_self hb₁ _ },
  { rw opow_succ,
    exact mul_le_mul_right' (opow_log_le_self b ha) b }
end

/-! #### Exponential principal ordinals -/

theorem principal_opow_omega : principal (^) omega :=
λ a b ha hb, match a, b, lt_omega.1 ha, lt_omega.1 hb with
| _, _, ⟨m, rfl⟩, ⟨n, rfl⟩ := by { simp_rw ←nat_cast_opow, apply nat_lt_omega }
end

theorem opow_omega {a : ordinal} (a1 : 1 < a) (h : a < omega) : a ^ omega = omega :=
le_antisymm
  ((opow_le_of_limit (one_le_iff_ne_zero.1 $ le_of_lt a1) omega_is_limit).2
    (λ b hb, (principal_opow_omega h hb).le))
  (right_le_opow _ a1)

end ordinal


import tactic
import data.real.sqrt
import analysis.specific_limits.basic
import analysis.specific_limits.normed
import data.complex.exponential
import data.real.irrational

open filter real
open_locale topological_space
open_locale big_operators

theorem liebeck_23_1_i :
  tendsto (λ n : ℕ, n / (n + 5) : ℕ → ℝ) at_top (𝓝 1) :=
begin
  sorry
end

theorem liebeck_23_1_ii :
  tendsto (λ n : ℕ, 1 / sqrt (n + 5)) at_top (𝓝 0) :=
begin
  sorry
end

theorem liebeck_23_1_iii :
  tendsto (λ n : ℕ, ↑n * sqrt n / (n + 5)) at_top at_top :=
begin
  sorry
end

theorem liebeck_23_1_iv :
  tendsto (λ n : ℕ, ((-1)^n * sin n) / sqrt n ) at_top (𝓝 0) :=
begin
  sorry
end

theorem liebeck_23_1_v :
  tendsto (λ n : ℕ, (↑n^3 - 2*sqrt n + 7) / (2 - ↑n^2 - 5*↑n^3)) at_top (𝓝 (-1/5)) :=
begin
  sorry
end

theorem liebeck_23_1_vi (n : ℕ) :
  ¬∃ l : ℝ, tendsto (λ n, (1 - (-1)^n * n) / n : ℕ → ℝ) at_top (𝓝 l) :=
begin
  sorry
end

theorem liebeck_23_1_vii :
  tendsto (λ n : ℕ, sqrt (n + 1) - sqrt n) at_top (𝓝 0) :=
begin
  sorry
end

theorem leibeck_23_2 (X : Type*) [topological_space X] (a : ℕ → X) (l₁ l₂ : X)
  (h₁ : tendsto a at_top (𝓝 l₁)) (h₂ : tendsto a at_top (𝓝 l₂)) :
  l₁ = l₂ :=
begin
  sorry
end

theorem leibeck_23_3 (S : set ℝ) (c : ℝ) (hc : is_lub S c) :
  ∃ (f : ℕ → ℝ), (∀ n, f n ∈ S) ∧ tendsto f at_top (𝓝 c) :=
begin
  sorry
end

theorem leibeck_23_4_i_a :
  ∃ b : ℝ, ∀ n, abs (n^3 / (n^3 - 1) : ℝ) ≤ b :=
begin
  sorry,
end

theorem leibeck_23_4_i_c (n : ℕ) :
  (n : ℝ)^3 / (n^3 - 1) ≥ (n + 1)^3 / ((n + 1)^3 - 1) :=
begin
  sorry,
end

theorem leibeck_23_4_i_d (a : ℕ → ℝ) (h : ∀ n : ℕ, a n = n^3 / (n^3 - 1)) :
  ∃ l : ℝ, tendsto a at_top (𝓝 l) :=
begin
  sorry
end

theorem leibeck_23_4_ii_a :
  ∃ M : ℝ, ∀ m : ℕ, abs (2 ^ (1 / m)) ≤ M :=
begin
  sorry
end

theorem leibeck_23_4_ii_c (n : ℕ) :
  2^(1/n) ≥ 2^(1/(n+1)) :=
begin
  sorry
end

theorem leibeck_23_4_ii_d (a : ℕ → ℝ) (h : ∀ n : ℕ, a n = 2 ^ (1 / n)) :
  ∃ l : ℝ, tendsto a at_top (𝓝 l) :=
begin
  sorry
end

theorem leibeck_23_4_iii_a :
  ∃ b : ℝ, ∀ n : ℕ, abs (1 - (-1)^n / ↑n) ≤ b :=
begin
  sorry
end

theorem leibeck_23_4_iii_b (n : ℕ) :
  ¬ (∀ n : ℕ, (1 : ℝ) - (-1)^n / n ≤ 1 - (-1)^(n+1) / (n+1)) :=
begin
  sorry
end

theorem leibeck_23_4_iii_c (n : ℕ) :
  ¬ (∀ m : ℕ, (1 - (-1)^n / n.cast : ℝ) ≥ (1 - (-1)^(n+m) / (n+m).cast : ℝ)) :=
begin
  sorry
end

theorem leibeck_23_4_iii_d (f : ℕ → ℝ) (hf : ∀ n : ℕ, f n = 1 - (-1)^n / n) :
  ∃ r : ℝ, tendsto f at_top (𝓝 r) :=
begin
  sorry
end

theorem leibeck_23_4_iv_a :
  ∀ m : ℕ, ∃ N : ℕ, ∀ n ≥ N, abs (5*n - n^2 : ℝ) ≥ m :=
begin
  sorry
end

theorem leibeck_23_4_iv_b :
  ¬ (∀ n : ℕ, abs (5*n - n^2 : ℝ) ≤ abs (5*(n+1) - (n+1)^2 : ℝ)) :=
begin
  sorry
end

theorem leibeck_23_4_iv_c :
  ¬ (∀ n : ℕ, abs (5*n - n^2 : ℝ) ≥ abs (5*(n+1) - (n+1)^2 : ℝ)) :=
begin
  sorry
end

theorem leibeck_23_4_iv_d :
  tendsto (λ n : ℕ, abs (5*n - n^2 : ℝ)) at_top at_top :=
begin
  sorry
end

theorem leibeck_23_5 (a : ℝ) (f : ℕ → ℝ) :
  (∃ N, ∀ ε > 0, ∀ n ≥ N, abs (f n - a) < ε) ↔ (∃ N, ∀ n ≥ N, f n = a) :=
begin
  sorry
end

theorem leibeck_23_6 (f : ℕ → ℝ) (hf : ∀ n, f (n + 1) ≤ f n)
  (hf_bdd : ∃ a, ∀ n, f n ≤ a) :
  ∃ a, tendsto f at_top (𝓝 a) :=
begin
  sorry
end

theorem leibeck_23_7_i_a (a : ℕ → ℝ) (h1 : a 1 = 1)
  (h2 : ∀ n : ℕ, a (n + 1) = (a n ^ 2 + 2) / (2 * a n)) :
  ∃ M : ℝ, ∀ n : ℕ, abs (a n) ≤ M :=
begin
  sorry
end

theorem liebeck_23_7_i_b (a : ℕ → ℝ) (h1 : a 1 = 1) (h2 : ∀ n, a (n+1) = (a n ^ 2 + 2) / (2 * a n)) :
  ∀ n, n ≥ 2 → a n ≥ a (n+1) :=
begin
  sorry
end

theorem liebeck_23_7_ii (a : ℕ → ℝ) (h1 : a 1 = 1) (h2 : ∀ n, a (n+1) = (a n ^ 2 + 2) / (2 * a n)) :
  tendsto a at_top (𝓝 2) :=
begin
  sorry
end

noncomputable def e : ℕ → ℝ := λ n, ∑ i in finset.range(n+1), 1 / (nat.factorial i)

theorem leibeck_23_8_a (n : ℕ) :
  ∃ p : ℕ, e n = p / (nat.factorial n) :=
begin
  sorry
end

theorem leibeck_23_8_b (n : ℕ) :
  0 < exp 1 - e n ∧ exp 1 - e n < 1 / (n * nat.factorial n) :=
begin
  sorry
end

theorem leibeck_23_8_c :
  ∃ p : ℕ → ℝ, ∀ n : ℕ, 0 < exp 1 * nat.factorial n - e n ∧
  exp 1 * nat.factorial n - e n < 1 / (n * nat.factorial n) :=
begin
  sorry
end

-- Assume e is rational, then show n!e ∈ ℤ for some n.
theorem leibeck_23_8_d :
  irrational (exp 1) :=
begin
  sorry
end

variable a : ℕ → ℝ

theorem leibeck_23_9_a :
  ¬ (∀ l : ℝ, tendsto a at_top (𝓝 l)) ↔ tendsto a at_top at_top :=
begin
  sorry
end

theorem leibeck_23_9_c :
  (∀ R > 0, ∃ N : ℕ, ∀ n ≥ N, a n > R) ↔ (tendsto a at_top at_top) :=
begin
  sorry
end

theorem leibeck_23_9_d :
  ¬ (∀ L : ℝ, ∀ ε : ℝ, ∃ N : ℕ, ∀ n ≥ N, abs (a n - L) > ε) ↔ (tendsto a at_top at_top) :=
begin
  sorry
end

theorem leibeck_23_9_e :
  (∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, a n > 1 / ε) ↔ (tendsto a at_top at_top) :=
begin
  sorry
end

theorem leibeck_23_9_f :
  ¬ (∀ n : ℕ, a (n+1) > a n) ↔ (tendsto a at_top at_top) :=
begin
  sorry
end

theorem leibeck_23_9_g :
  ¬ (∃ N : ℕ, ∀ R > 0, ∀ n ≥ N, a n > R) ↔ (tendsto a at_top at_top) :=
begin
  sorry
end

theorem leibeck_23_10_g :
  ¬ (∀ R : ℝ, ∃ n : ℕ, a n > R) ↔ (tendsto a at_top at_top) :=
begin
  sorry
end


/-
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

/-!

# Sets in Lean, sheet 5 : equality of sets

Sets are extensional objects to mathematicians, which means that
if two sets have the same elements, then they are equal.

## Tactics

Tactics you will need to know for this sheet:

* `ext`

### The `ext` tactic

If the goal is `⊢ A = B` where `A` and `B` are subsets of `X`, then
the tactic `ext x,` will create a hypothesis `x : X` and change
the goal to `x ∈ A ↔ x ∈ B`.

-/

open set

variables
  (X : Type) -- Everything will be a subset of `X`
  (A B C D E : set X) -- A,B,C,D,E are subsets of `X`
  (x y z : X) -- x,y,z are elements of `X` or, more precisely, terms of type `X`

example : A ∪ A = A :=
begin
  sorry
end

example : A ∩ A = A :=
begin
  sorry
end

example : A ∩ ∅ = ∅ :=
begin
  sorry
end

example : A ∪ univ = univ :=
begin
  sorry
end

example : A ⊆ B → B ⊆ A → A = B :=
begin
  sorry
end

example : A ∩ B = B ∩ A :=
begin
  sorry
end

example : A ∩ (B ∩ C) = (A ∩ B) ∩ C :=
begin
  sorry
end

example : A ∪ (B ∪ C) = (A ∪ B) ∪ C :=
begin
  sorry
end

example : A ∪ (B ∩ C) = (A ∪ B) ∩ (A ∪ C) :=
begin
  sorry,
end

example : A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
begin
  sorry,
end


import data.real.basic

variables a b c : ℝ

#check add_le_add_left
#check add_le_add_right
#check le_antisymm
#check le_min
#check min_le_left
#check min_le_right

-- BEGIN

lemma aux : min a b + c ≤ min (a + c) (b + c) :=
begin
  apply le_min,
   show min a b + c ≤ a + c,
    have h : min a b ≤ a,
    apply min_le_left,
    apply add_le_add_right h,
   show min a b + c ≤ b + c,
    have h' : min a b ≤ b,
    apply min_le_right,
    apply add_le_add_right h',
end

example : min a b + c = min (a + c) (b + c) :=
begin
  apply le_antisymm,
  exact aux a b c,
  have ha : min (a + c) (b + c) - c <= a := by linarith [min_le_left (a + c) (b + c)],
  have hb : min (a + c) (b + c) - c <= b := by linarith [min_le_right (a + c) (b + c)],
  have h : min (a + c) (b + c) - c <= min a b := le_min ha hb,
  linarith only [h],
end
-- END


import data.nat.prime
import number_theory.padics.padic_norm
import data.pnat.factors

-- ERIC'S CODE
@[simp]
lemma prime_multiset.coe_add (m n : prime_multiset) : ↑(m + n) = (m + n : multiset ℕ) :=
is_add_monoid_hom.map_add _ _ _

attribute [simp] pnat.coe_nat_factor_multiset

lemma factors_mul {p q : ℕ} (hp : 0 < p) (hq : 0 < q) : (p * q).factors ~ p.factors ++ q.factors :=
begin
  rw ←multiset.coe_eq_coe,
  have := pnat.factor_multiset_mul ⟨p, hp⟩ ⟨q, hq⟩,
  rw ←prime_multiset.coe_nat_injective.eq_iff at this,
  simpa using this,
end

--MY CODE
lemma factors_prime_pow_eq_repeat_prime_pow (p y : ℕ) (hprime : p.prime) : list.repeat p y = (p ^ y).factors :=
begin
  haveI : fact p.prime := ⟨hprime⟩,
  induction y,
  { simp [pow_zero, nat.factors_one] },
  { apply list.repeat_perm.1 (list.perm.trans _ (factors_mul (nat.prime.pos hprime) (pow_pos (nat.prime.pos hprime) y_n)).symm),
    simp [nat.factors_prime hprime, y_ih] }
end

lemma padic_val_nat.prime_pow_eq_pow {p y : ℕ} (hp : p.prime) : y = padic_val_nat p (p ^ y) :=
begin
  haveI : fact p.prime := ⟨hp⟩,
  rw [padic_val_nat_eq_factors_count p, ← @factors_prime_pow_eq_repeat_prime_pow p y hp, ← (list.count_repeat p y).symm],
end


/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland, Yury Kudryashov
-/
import algebra.group.semiconj

/-!
# Commuting pairs of elements in monoids

We define the predicate `commute a b := a * b = b * a` and provide some operations on terms `(h :
commute a b)`. E.g., if `a`, `b`, and c are elements of a semiring, and that `hb : commute a b` and
`hc : commute a c`.  Then `hb.pow_left 5` proves `commute (a ^ 5) b` and `(hb.pow_right 2).add_right
(hb.mul_right hc)` proves `commute a (b ^ 2 + b * c)`.

Lean does not immediately recognise these terms as equations, so for rewriting we need syntax like
`rw [(hb.pow_left 5).eq]` rather than just `rw [hb.pow_left 5]`.

This file defines only a few operations (`mul_left`, `inv_right`, etc).  Other operations
(`pow_right`, field inverse etc) are in the files that define corresponding notions.

## Implementation details

Most of the proofs come from the properties of `semiconj_by`.
-/

/-- Two elements commute if `a * b = b * a`. -/
@[to_additive add_commute "Two elements additively commute if `a + b = b + a`"]
def commute {S : Type*} [has_mul S] (a b : S) : Prop := semiconj_by a b b

namespace commute

section has_mul

variables {S : Type*} [has_mul S]

/-- Equality behind `commute a b`; useful for rewriting. -/
@[to_additive] protected theorem eq {a b : S} (h : commute a b) : a * b = b * a := h

/-- Any element commutes with itself. -/
@[refl, simp, to_additive] protected theorem refl (a : S) : commute a a := eq.refl (a * a)

/-- If `a` commutes with `b`, then `b` commutes with `a`. -/
@[symm, to_additive] protected theorem symm {a b : S} (h : commute a b) : commute b a :=
eq.symm h

@[to_additive] protected theorem semiconj_by {a b : S} (h : commute a b) : semiconj_by a b b := h

@[to_additive]
protected theorem symm_iff {a b : S} : commute a b ↔ commute b a :=
⟨commute.symm, commute.symm⟩

end has_mul

section semigroup

variables {S : Type*} [semigroup S] {a b c : S}

/-- If `a` commutes with both `b` and `c`, then it commutes with their product. -/
@[simp, to_additive] theorem mul_right (hab : commute a b) (hac : commute a c) :
  commute a (b * c) :=
hab.mul_right hac

/-- If both `a` and `b` commute with `c`, then their product commutes with `c`. -/
@[simp, to_additive] theorem mul_left (hac : commute a c) (hbc : commute b c) :
  commute (a * b) c :=
hac.mul_left hbc

@[to_additive] protected lemma right_comm (h : commute b c) (a : S) :
  a * b * c = a * c * b :=
by simp only [mul_assoc, h.eq]

@[to_additive] protected lemma left_comm (h : commute a b) (c) :
  a * (b * c) = b * (a * c) :=
by simp only [← mul_assoc, h.eq]

end semigroup

@[to_additive]
protected

section mul_one_class

variables {M : Type*} [mul_one_class M]

@[simp, to_additive] theorem one_right (a : M) : commute a 1 := semiconj_by.one_right a
@[simp, to_additive] theorem one_left (a : M) : commute 1 a := semiconj_by.one_left a

end mul_one_class

section monoid

variables {M : Type*} [monoid M] {a b : M} {u u₁ u₂ : units M}

@[simp, to_additive]
theorem pow_right (h : commute a b) (n : ℕ) : commute a (b ^ n) := h.pow_right n
@[simp, to_additive]
theorem pow_left (h : commute a b) (n : ℕ) : commute (a ^ n) b := (h.symm.pow_right n).symm
@[simp, to_additive]
theorem pow_pow (h : commute a b) (m n : ℕ) : commute (a ^ m) (b ^ n) :=
(h.pow_left m).pow_right n

@[simp, to_additive]
theorem self_pow (a : M) (n : ℕ) : commute a (a ^ n) := (commute.refl a).pow_right n
@[simp, to_additive]
theorem pow_self (a : M) (n : ℕ) : commute (a ^ n) a := (commute.refl a).pow_left n
@[simp, to_additive]
theorem pow_pow_self (a : M) (m n : ℕ) : commute (a ^ m) (a ^ n) :=
(commute.refl a).pow_pow m n

@[to_additive succ_nsmul'] theorem _root_.pow_succ' (a : M) (n : ℕ) : a ^ (n + 1) = a ^ n * a :=
(pow_succ a n).trans (self_pow _ _)

@[to_additive] theorem units_inv_right : commute a u → commute a ↑u⁻¹ :=
semiconj_by.units_inv_right

@[simp, to_additive] theorem units_inv_right_iff :
  commute a ↑u⁻¹ ↔ commute a u :=
semiconj_by.units_inv_right_iff

@[to_additive] theorem units_inv_left : commute ↑u a → commute ↑u⁻¹ a :=
semiconj_by.units_inv_symm_left

@[simp, to_additive]
theorem units_inv_left_iff: commute ↑u⁻¹ a ↔ commute ↑u a :=
semiconj_by.units_inv_symm_left_iff

@[to_additive]
theorem units_coe : commute u₁ u₂ → commute (u₁ : M) u₂ := semiconj_by.units_coe
@[to_additive]
theorem units_of_coe : commute (u₁ : M) u₂ → commute u₁ u₂ := semiconj_by.units_of_coe
@[simp, to_additive]
theorem units_coe_iff : commute (u₁ : M) u₂ ↔ commute u₁ u₂ := semiconj_by.units_coe_iff

@[to_additive] lemma is_unit_mul_iff (h : commute a b) :
  is_unit (a * b) ↔ is_unit a ∧ is_unit b :=
begin
  refine ⟨_, λ H, H.1.mul H.2⟩,
  rintro ⟨u, hu⟩,
  have : b * ↑u⁻¹ * a = 1,
  { have : commute a u := hu.symm ▸ (commute.refl _).mul_right h,
    rw [← this.units_inv_right.right_comm, ← h.eq, ← hu, u.mul_inv] },
  split,
  { refine ⟨⟨a, b * ↑u⁻¹, _, this⟩, rfl⟩,
    rw [← mul_assoc, ← hu, u.mul_inv] },
  { rw mul_assoc at this,
    refine ⟨⟨b, ↑u⁻¹ * a, this, _⟩, rfl⟩,
    rw [mul_assoc, ← hu, u.inv_mul] }
end

@[simp, to_additive] lemma _root_.is_unit_mul_self_iff :
  is_unit (a * a) ↔ is_unit a :=
(commute.refl a).is_unit_mul_iff.trans (and_self _)

end monoid

section group

variables {G : Type*} [group G] {a b : G}

@[to_additive]
theorem inv_right : commute a b → commute a b⁻¹ := semiconj_by.inv_right
@[simp, to_additive]
theorem inv_right_iff : commute a b⁻¹ ↔ commute a b := semiconj_by.inv_right_iff

@[to_additive] theorem inv_left :  commute a b → commute a⁻¹ b := semiconj_by.inv_symm_left
@[simp, to_additive]
theorem inv_left_iff : commute a⁻¹ b ↔ commute a b := semiconj_by.inv_symm_left_iff

@[to_additive]
theorem inv_inv : commute a b → commute a⁻¹ b⁻¹ := semiconj_by.inv_inv_symm
@[simp, to_additive]
theorem inv_inv_iff : commute a⁻¹ b⁻¹ ↔ commute a b := semiconj_by.inv_inv_symm_iff

@[to_additive]
protected theorem inv_mul_cancel (h : commute a b) : a⁻¹ * b * a = b :=
by rw [h.inv_left.eq, inv_mul_cancel_right]

@[to_additive]
theorem inv_mul_cancel_assoc (h : commute a b) : a⁻¹ * (b * a) = b :=
by rw [← mul_assoc, h.inv_mul_cancel]

@[to_additive]
protected theorem mul_inv_cancel (h : commute a b) : a * b * a⁻¹ = b :=
by rw [h.eq, mul_inv_cancel_right]

@[to_additive]
theorem mul_inv_cancel_assoc (h : commute a b) : a * (b * a⁻¹) = b :=
by rw [← mul_assoc, h.mul_inv_cancel]

end group

end commute

section comm_group

variables {G : Type*} [comm_group G] (a b : G)

@[simp, to_additive] lemma mul_inv_cancel_comm : a * b * a⁻¹ = b :=
(commute.all a b).mul_inv_cancel

@[simp, to_additive] lemma mul_inv_cancel_comm_assoc : a * (b * a⁻¹) = b :=
(commute.all a b).mul_inv_cancel_assoc

@[simp, to_additive] lemma inv_mul_cancel_comm : a⁻¹ * b * a = b :=
(commute.all a b).inv_mul_cancel

@[simp, to_additive] lemma inv_mul_cancel_comm_assoc : a⁻¹ * (b * a) = b :=
(commute.all a b).inv_mul_cancel_assoc

end comm_group


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker
-/
import data.polynomial.eval
import algebra.iterate_hom

/-!
# The derivative map on polynomials

## Main definitions
 * `polynomial.derivative`: The formal derivative of polynomials, expressed as a linear map.

-/

noncomputable theory
local attribute [instance, priority 100] classical.prop_decidable

open finsupp finset
open_locale big_operators

namespace polynomial
universes u v w y z
variables {R : Type u} {S : Type v} {T : Type w} {ι : Type y} {A : Type z} {a b : R} {n : ℕ}

section derivative

section semiring
variables [semiring R]

/-- `derivative p` is the formal derivative of the polynomial `p` -/
def derivative : polynomial R →ₗ[R] polynomial R :=
finsupp.total ℕ (polynomial R) R (λ n, C ↑n * X^(n - 1))

lemma derivative_apply (p : polynomial R) :
  derivative p = p.sum (λn a, C (a * n) * X^(n - 1)) :=
begin
  rw [derivative, total_apply],
  apply congr rfl,
  ext,
  simp [mul_assoc, coeff_C_mul],
end

lemma coeff_derivative (p : polynomial R) (n : ℕ) :
  coeff (derivative p) n = coeff p (n + 1) * (n + 1) :=
begin
  rw [derivative_apply],
  simp only [coeff_X_pow, coeff_sum, coeff_C_mul],
  rw [sum_def, finset.sum_eq_single (n + 1)],
  simp only [nat.add_succ_sub_one, add_zero, mul_one, if_true, eq_self_iff_true], norm_cast,
  swap,
  { rw [if_pos (nat.add_sub_cancel _ _).symm, mul_one, nat.cast_add, nat.cast_one, mem_support_iff],
    intro h, push_neg at h, simp [h], },
  { assume b, cases b,
    { intros, rw [nat.cast_zero, mul_zero, zero_mul], },
    { intros _ H, rw [nat.succ_sub_one b, if_neg (mt (congr_arg nat.succ) H.symm), mul_zero] } }
end

@[simp]
lemma derivative_zero : derivative (0 : polynomial R) = 0 :=
derivative.map_zero

@[simp]
lemma iterate_derivative_zero {k : ℕ} : derivative^[k] (0 : polynomial R) = 0 :=
begin
  induction k with k ih,
  { simp, },
  { simp [ih], },
end

@[simp]
lemma derivative_monomial (a : R) (n : ℕ) : derivative (monomial n a) = monomial (n - 1) (a * n) :=
(derivative_apply _).trans ((sum_single_index $ by simp).trans (C_mul_X_pow_eq_monomial _ _))

lemma derivative_C_mul_X_pow (a : R) (n : ℕ) : derivative (C a * X ^ n) = C (a * n) * X^(n - 1) :=
by rw [C_mul_X_pow_eq_monomial, C_mul_X_pow_eq_monomial, derivative_monomial]

@[simp] lemma derivative_X_pow (n : ℕ) :
  derivative (X ^ n : polynomial R) = (n : polynomial R) * X ^ (n - 1) :=
by convert derivative_C_mul_X_pow (1 : R) n; simp

@[simp] lemma derivative_C {a : R} : derivative (C a) = 0 :=
by simp [derivative_apply]

@[simp] lemma derivative_X : derivative (X : polynomial R) = 1 :=
(derivative_monomial _ _).trans $ by simp

@[simp] lemma derivative_one : derivative (1 : polynomial R) = 0 :=
derivative_C

@[simp] lemma derivative_bit0 {a : polynomial R} : derivative (bit0 a) = bit0 (derivative a) :=
by simp [bit0]

@[simp] lemma derivative_bit1 {a : polynomial R} : derivative (bit1 a) = bit0 (derivative a) :=
by simp [bit1]

@[simp] lemma derivative_add {f g : polynomial R} :
  derivative (f + g) = derivative f + derivative g :=
derivative.map_add f g

@[simp] lemma iterate_derivative_add {f g : polynomial R} {k : ℕ} :
  derivative^[k] (f + g) = (derivative^[k] f) + (derivative^[k] g) :=
derivative.to_add_monoid_hom.iterate_map_add _ _ _

@[simp] lemma derivative_neg {R : Type*} [ring R] (f : polynomial R) :
  derivative (-f) = - derivative f :=
linear_map.map_neg derivative f

@[simp] lemma iterate_derivative_neg {R : Type*} [ring R] {f : polynomial R} {k : ℕ} :
  derivative^[k] (-f) = - (derivative^[k] f) :=
(@derivative R _).to_add_monoid_hom.iterate_map_neg _ _

@[simp] lemma derivative_sub {R : Type*} [ring R] {f g : polynomial R} :
  derivative (f - g) = derivative f - derivative g :=
linear_map.map_sub derivative f g

@[simp] lemma iterate_derivative_sub {R : Type*} [ring R] {k : ℕ} {f g : polynomial R} :
  derivative^[k] (f - g) = (derivative^[k] f) - (derivative^[k] g) :=
begin
  induction k with k ih generalizing f g,
  { simp [nat.iterate], },
  { simp [nat.iterate, ih], }
end

@[simp] lemma derivative_sum {s : finset ι} {f : ι → polynomial R} :
  derivative (∑ b in s, f b) = ∑ b in s, derivative (f b) :=
derivative.map_sum

@[simp] lemma derivative_smul (r : R) (p : polynomial R) : derivative (r • p) = r • derivative p :=
derivative.map_smul _ _

@[simp] lemma iterate_derivative_smul (r : R) (p : polynomial R) (k : ℕ) :
  derivative^[k] (r • p) = r • (derivative^[k] p) :=
begin
  induction k with k ih generalizing p,
  { simp, },
  { simp [ih], },
end

/-- We can't use `derivative_mul` here because
we want to prove this statement also for noncommutative rings.-/
@[simp]
lemma derivative_C_mul (a : R) (p : polynomial R) : derivative (C a * p) = C a * derivative p :=
by convert derivative_smul a p; apply C_mul'

@[simp]
lemma iterate_derivative_C_mul (a : R) (p : polynomial R) (k : ℕ) :
  derivative^[k] (C a * p) = C a * (derivative^[k] p) :=
by convert iterate_derivative_smul a p k; apply C_mul'

end semiring

section comm_semiring
variables [comm_semiring R]

lemma derivative_eval (p : polynomial R) (x : R) :
  p.derivative.eval x = p.sum (λ n a, (a * n)*x^(n-1)) :=
by simp only [derivative_apply, eval_sum, eval_pow, eval_C, eval_X, eval_nat_cast, eval_mul]

@[simp] lemma derivative_mul {f g : polynomial R} :
  derivative (f * g) = derivative f * g + f * derivative g :=
calc derivative (f * g) = f.sum (λn a, g.sum (λm b, C ((a * b) * (n + m : ℕ)) * X^((n + m) - 1))) :
  begin
    transitivity, exact derivative_sum,
    transitivity, { apply finset.sum_congr rfl, assume x hx, exact derivative_sum },
    apply finset.sum_congr rfl, assume n hn, apply finset.sum_congr rfl, assume m hm,
    transitivity,
    { apply congr_arg, exact single_eq_C_mul_X },
    exact derivative_C_mul_X_pow _ _
  end
  ... = f.sum (λn a, g.sum (λm b,
      (C (a * n) * X^(n - 1)) * (C b * X^m) + (C a * X^n) * (C (b * m) * X^(m - 1)))) :
    sum_congr rfl $ assume n hn, sum_congr rfl $ assume m hm,
      by simp only [nat.cast_add, mul_add, add_mul, C_add, C_mul];
      cases n; simp only [nat.succ_sub_succ, pow_zero];
      cases m; simp only [nat.cast_zero, C_0, nat.succ_sub_succ, zero_mul, mul_zero,
        nat.sub_zero, pow_zero, pow_add, one_mul, pow_succ, mul_comm, mul_left_comm]
  ... = derivative f * g + f * derivative g :
    begin
      conv { to_rhs, congr,
        { rw [← sum_C_mul_X_eq g] },
        { rw [← sum_C_mul_X_eq f] } },
      simp only [finsupp.sum, sum_add_distrib, finset.mul_sum, finset.sum_mul, derivative_apply]
    end

theorem derivative_pow_succ (p : polynomial R) (n : ℕ) :
  (p ^ (n + 1)).derivative = (n + 1) * (p ^ n) * p.derivative :=
nat.rec_on n (by rw [pow_one, nat.cast_zero, zero_add, one_mul, pow_zero, one_mul]) $ λ n ih,
by rw [pow_succ', derivative_mul, ih, mul_right_comm, ← add_mul,
    add_mul (n.succ : polynomial R), one_mul, pow_succ', mul_assoc, n.cast_succ]

theorem derivative_pow (p : polynomial R) (n : ℕ) :
  (p ^ n).derivative = n * (p ^ (n - 1)) * p.derivative :=
nat.cases_on n (by rw [pow_zero, derivative_one, nat.cast_zero, zero_mul, zero_mul]) $ λ n,
by rw [p.derivative_pow_succ n, n.succ_sub_one, n.cast_succ]

lemma derivative_comp (p q : polynomial R) :
  (p.comp q).derivative = q.derivative * p.derivative.comp q :=
begin
  apply polynomial.induction_on' p,
  { intros p₁ p₂ h₁ h₂, simp [h₁, h₂, mul_add], },
  { intros n r,
    simp only [derivative_pow, derivative_mul, monomial_comp, derivative_monomial, derivative_C,
      zero_mul, C_eq_nat_cast, zero_add, ring_hom.map_mul],
    -- is there a tactic for this? (a multiplicative `abel`):
    rw [mul_comm (derivative q)],
    simp only [mul_assoc], }
end

@[simp]
theorem derivative_map [comm_semiring S] (p : polynomial R) (f : R →+* S) :
  (p.map f).derivative = p.derivative.map f :=
polynomial.induction_on p
  (λ r, by rw [map_C, derivative_C, derivative_C, map_zero])
  (λ p q ihp ihq, by rw [map_add, derivative_add, ihp, ihq, derivative_add, map_add])
  (λ n r ih, by rw [map_mul, map_C, map_pow, map_X,
      derivative_mul, derivative_pow_succ, derivative_C, zero_mul, zero_add, derivative_X, mul_one,
      derivative_mul, derivative_pow_succ, derivative_C, zero_mul, zero_add, derivative_X, mul_one,
      map_mul, map_C, map_mul, map_pow, map_add, map_nat_cast, map_one, map_X])

@[simp]
theorem iterate_derivative_map [comm_semiring S] (p : polynomial R) (f : R →+* S) (k : ℕ):
  polynomial.derivative^[k] (p.map f) = (polynomial.derivative^[k] p).map f :=
begin
  induction k with k ih generalizing p,
  { simp, },
  { simp [ih], },
end

/-- Chain rule for formal derivative of polynomials. -/
theorem derivative_eval₂_C (p q : polynomial R) :
  (p.eval₂ C q).derivative = p.derivative.eval₂ C q * q.derivative :=
polynomial.induction_on p
  (λ r, by rw [eval₂_C, derivative_C, eval₂_zero, zero_mul])
  (λ p₁ p₂ ih₁ ih₂, by rw [eval₂_add, derivative_add, ih₁, ih₂, derivative_add, eval₂_add, add_mul])
  (λ n r ih, by rw [pow_succ', ← mul_assoc, eval₂_mul, eval₂_X, derivative_mul, ih,
      @derivative_mul _ _ _ X, derivative_X, mul_one, eval₂_add, @eval₂_mul _ _ _ _ X, eval₂_X,
      add_mul, mul_right_comm])

theorem of_mem_support_derivative {p : polynomial R} {n : ℕ} (h : n ∈ p.derivative.support) :
  n + 1 ∈ p.support :=
finsupp.mem_support_iff.2 $ λ (h1 : p.coeff (n+1) = 0), finsupp.mem_support_iff.1 h $
show p.derivative.coeff n = 0, by rw [coeff_derivative, h1, zero_mul]

theorem degree_derivative_lt {p : polynomial R} (hp : p ≠ 0) : p.derivative.degree < p.degree :=
(finset.sup_lt_iff $ bot_lt_iff_ne_bot.2 $ mt degree_eq_bot.1 hp).2 $ λ n hp, lt_of_lt_of_le
(with_bot.some_lt_some.2 n.lt_succ_self) $ finset.le_sup $ of_mem_support_derivative hp

theorem nat_degree_derivative_lt {p : polynomial R} (hp : p.derivative ≠ 0) :
  p.derivative.nat_degree < p.nat_degree :=
have hp1 : p ≠ 0, from λ h, hp $ by rw [h, derivative_zero],
with_bot.some_lt_some.1 $
begin
  rw [nat_degree, option.get_or_else_of_ne_none $ mt degree_eq_bot.1 hp, nat_degree,
    option.get_or_else_of_ne_none $ mt degree_eq_bot.1 hp1],
  exact degree_derivative_lt hp1
end

theorem degree_derivative_le {p : polynomial R} : p.derivative.degree ≤ p.degree :=
if H : p = 0 then le_of_eq $ by rw [H, derivative_zero] else le_of_lt $ degree_derivative_lt H

/-- The formal derivative of polynomials, as linear homomorphism. -/
def derivative_lhom (R : Type*) [comm_ring R] : polynomial R →ₗ[R] polynomial R :=
{ to_fun    := derivative,
  map_add'  := λ p q, derivative_add,
  map_smul' := λ r p, derivative_smul r p }

@[simp] lemma derivative_lhom_coe {R : Type*} [comm_ring R] :
  (polynomial.derivative_lhom R : polynomial R → polynomial R) = polynomial.derivative :=
rfl

@[simp] lemma derivative_cast_nat {n : ℕ} : derivative (n : polynomial R) = 0 :=
begin
  rw ← C.map_nat_cast n,
  exact derivative_C,
end

@[simp] lemma iterate_derivative_cast_nat_mul {n k : ℕ} {f : polynomial R} :
  derivative^[k] (n * f) = n * (derivative^[k] f) :=
begin
  induction k with k ih generalizing f,
  { simp [nat.iterate], },
  { simp [nat.iterate, ih], }
end

end comm_semiring

section comm_ring
variables [comm_ring R]

lemma derivative_comp_one_sub_X (p : polynomial R) :
  (p.comp (1-X)).derivative = -p.derivative.comp (1-X) :=
by simp [derivative_comp]

@[simp]
lemma iterate_derivative_comp_one_sub_X (p : polynomial R) (k : ℕ) :
  derivative^[k] (p.comp (1-X)) = (-1)^k * (derivative^[k] p).comp (1-X) :=
begin
  induction k with k ih generalizing p,
  { simp, },
  { simp [ih p.derivative, iterate_derivative_neg, derivative_comp, pow_succ], },
end

end comm_ring

section domain
variables [integral_domain R]

lemma mem_support_derivative [char_zero R] (p : polynomial R) (n : ℕ) :
  n ∈ (derivative p).support ↔ n + 1 ∈ p.support :=
suffices (¬(coeff p (n + 1) = 0 ∨ ((n + 1:ℕ) : R) = 0)) ↔ coeff p (n + 1) ≠ 0,
  by simpa only [mem_support_iff, coeff_derivative, ne.def, mul_eq_zero],
by { rw [nat.cast_eq_zero], simp only [nat.succ_ne_zero, or_false] }

@[simp] lemma degree_derivative_eq [char_zero R] (p : polynomial R) (hp : 0 < nat_degree p) :
  degree (derivative p) = (nat_degree p - 1 : ℕ) :=
begin
  have h0 : p ≠ 0,
  { contrapose! hp,
    simp [hp] },
  apply le_antisymm,
  { rw derivative_apply,
    apply le_trans (degree_sum_le _ _) (sup_le (λ n hn, _)),
    apply le_trans (degree_C_mul_X_pow_le _ _) (with_bot.coe_le_coe.2 (nat.sub_le_sub_right _ _)),
    apply le_nat_degree_of_mem_supp _ hn },
  { refine le_sup _,
    rw [mem_support_derivative, nat.sub_add_cancel, mem_support_iff],
    { show ¬ leading_coeff p = 0,
      rw [leading_coeff_eq_zero],
      assume h, rw [h, nat_degree_zero] at hp,
      exact lt_irrefl 0 (lt_of_le_of_lt (zero_le _) hp), },
    exact hp }
end

theorem nat_degree_eq_zero_of_derivative_eq_zero
  [char_zero R] {f : polynomial R} (h : f.derivative = 0) :
  f.nat_degree = 0 :=
begin
  by_cases hf : f = 0,
  { exact (congr_arg polynomial.nat_degree hf).trans rfl },
  { rw nat_degree_eq_zero_iff_degree_le_zero,
    by_contra absurd,
    have f_nat_degree_pos : 0 < f.nat_degree,
    { rwa [not_le, ←nat_degree_pos_iff_degree_pos] at absurd },
    let m := f.nat_degree - 1,
    have hm : m + 1 = f.nat_degree := nat.sub_add_cancel f_nat_degree_pos,
    have h2 := coeff_derivative f m,
    rw polynomial.ext_iff at h,
    rw [h m, coeff_zero, zero_eq_mul] at h2,
    cases h2,
    { rw [hm, ←leading_coeff, leading_coeff_eq_zero] at h2,
      exact hf h2, },
    { norm_cast at h2 } }
end

end domain

end derivative
end polynomial