import tactic

/-!

# Groups

Definition and basic properties of a group.

-/

-- Technical note: We work in a namespace `xena` because Lean already has groups.
namespace xena
-- Now our definition of a group will really be called `xena.group`.

/-

## Definition of a group

The `group` class will extend `has_mul`, `has_one` and `has_inv`.

`has_mul G` means that `G` has a multiplication `* : G → G → G`
`has_one G` means that `G` has a `1 : G`
`has_inv G` means that `G` has an `⁻¹ : G → G`

All of `*`, `1` and `⁻¹` are just notation for functions -- no axioms yet.

A `group` has all of this notation, and the group axioms too.
Let's now define the group class.
-/

/-- A `group` structure on a type `G` is multiplication, identity and inverse,
plus the usual axioms -/
class group (G : Type) extends has_mul G, has_one G, has_inv G :=
(mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c))
(one_mul : ∀ (a : G), 1 * a = a)
(mul_left_inv : ∀ (a : G), a⁻¹ * a = 1)

/-

Formally, a term of type `group G` is now the following data:
a multiplication, 1, and inverse function,
and proofs that the group axioms are satisfied.

The way to say "let G be a group" is now `(G : Type) [group G]`

The square bracket notation is the notation used for classes.
Formally, it means "put a term of type `group G` into the type class
inference system". In practice this just means "you can use group
notation and axioms in proofs, and Lean will figure out why they're true"

We have been extremely mean with our axioms. Some authors also add
the axioms `mul_one : ∀ (a : G), a * 1 = a`
and `mul_right_inv : ∀ (a : G), a * a⁻¹ = 1`.

But these follow from the three axioms we used. Our first job is
to prove them. As you might imagine, mathematically this is pretty
much the trickiest part, because we have to be careful not to
accidentally assume these axioms when we're proving them.

Here are the four lemmas we will prove next.

`mul_left_cancel : ∀ (a b c : G), a * b = a * c → b = c`
`mul_eq_of_eq_inv_mul {a x y : G} : x = a⁻¹ * y → a * x = y`
`mul_one (a : G) : a * 1 = a`
`mul_right_inv (a : G) : a * a⁻¹ = 1`
-/

-- We're proving things about groups so let's work in the `group` namespace
-- (really this is `xena.group`)

namespace group

-- let `G` be a group.
variables {G : Type} [group G]

/-
We start by proving `mul_left_cancel : ∀ a b c, a * b = a * c → b = c`.
We assume `Habac : a * b = a * c` and deduce `b = c`. I've written
down the maths proof. Your job is to supply the rewrites that are
necessary to justify each step. Each rewrite is either one of
the axioms of a group, or an assumption. A reminder of the axioms:

`mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c)`
`one_mul : ∀ (a : G), 1 * a = a`
`mul_left_inv : ∀ (a : G), a⁻¹ * a = 1`

This proof could be done using rewrites, but I will take this opportunity
to introduce the `calc` tactic.
-/
lemma mul_left_cancel (a b c : G) (Habac : a * b = a * c) : b = c :=
begin
 calc b = 1 * b         : by rw one_mul
    ... = (a⁻¹ * a) * b : by rw mul_left_inv
    ... = a⁻¹ * (a * b) : by rw mul_assoc
    ... = a⁻¹ * (a * c) : by rw Habac
    ... = (a⁻¹ * a) * c : by rw mul_assoc
    ... = 1 * c         : by rw mul_left_inv
    ... = c             : by rw one_mul
end

/-
Next we prove that if `x = a⁻¹ * y` then `a * x = y`. Remember we are still
missing `mul_one` and `mul_right_inv`. A proof that avoids them is
the following: we want `a * x = y`. Now `apply`ing the previous lemma, it
suffices to prove that `a⁻¹ * (a * x) = a⁻¹ * y.`
Now use associativity and left cancellation on on the left, to reduce
to `h`.

Note that `mul_left_cancel` is a function, and its first input is
called `a`, but you had better give it `a⁻¹` instead.
-/

lemma mul_eq_of_eq_inv_mul {a x y : G} (h : x = a⁻¹ * y) : a * x = y :=
begin
  apply mul_left_cancel a⁻¹,
  rw ←mul_assoc,
  rw mul_left_inv,
  rwa one_mul, -- `rwa` is "rewrite, then assumption"
end

-- It's a bore to keep introducing variable names.

-- Let `a,b,c,x,y` be elements of `G`.
variables (a b c x y : G)

/-
We can use `mul_eq_of_eq_inv_mul` to prove the two "missing" axioms `mul_one`
and `mul_right_inv`, and then our lives will be much easier. Try `apply`ing it
in the theorems below.
-/

@[simp] theorem mul_one : a * 1 = a :=
begin
  apply mul_eq_of_eq_inv_mul,
  rw mul_left_inv,
end

@[simp] theorem mul_right_inv : a * a⁻¹ = 1 :=
begin
  apply mul_eq_of_eq_inv_mul,
  rw mul_one,
end

-- Now let's talk about what that `@[simp]` means.

/-

## Lean's simplifier

A human sees `a * a⁻¹` in group theory, and instantly replaces it with `1`.
We are going to train a simple AI called `simp` to do the same thing.

Lean's simplifier `simp` is a "term rewriting system". This means
that if you teach it a bunch of theorems of the form `A = B` or
`P ↔ Q` (by tagging them with the `@[simp]` attribute) and then give
it a complicated goal, like

`example : (a * b) * 1⁻¹⁻¹ * b⁻¹ * (a⁻¹ * a⁻¹⁻¹⁻¹) * a = 1`

then it will try to use the `rw` tactic as much as it can, using the lemmas
it has been taught, in an attempt to simplify the goal. If it manages
to solve it completely, then great! If it does not, but you feel like
it should have done, you might want to tag more lemmas with `@[simp]`.
`simp` should only be used to completely close goals. We are now
going to train the simplifier to solve the example above (indeed, we are
going to train it to reduce an arbitrary element of a free group into
a unique normal form, so it will solve any equalities which are true
for all groups, like the example above).

## Important note

Lean's simplifier does a series of rewrites, each one replacing something
with something else. But the simplifier will always rewrite from left to right!
If you tell it that `A = B` is a `simp` lemma then it will replace `A`s with
`B`s, but it will never replace `B`s with `A`s. If you tag a proof
of `A = B` with `@[simp]` and you also tag a proof of `B = A` with
`@[simp]`, then the simplifier will get stuck in an infinite loop when
it runs into an `A`! Equality should not be thought of as symmetric here.

Because the simplifier works from left to right, an important
rule of thumb is that if `A = B` is a `simp` lemma, then `B` should
probably be simpler than `A`! In particular, equality should not be
thought of as symmetric here. It is not a coincidence that in
the theorems below

`@[simp] theorem mul_one (a : G) : a * 1 = a`
`@[simp] theorem mul_right_inv (a : G) : a * a⁻¹ = 1`

the right hand side is simpler than the left hand side. It would be a
disaster to tag `a = a * 1` with the `@[simp]` tag -- can you see why?

Let's train Lean's simplifier! Let's teach it the axioms of a group next.
We have already done the axioms, so we have to retrospectively tag
them with the `@[simp]` attribute.

-/

attribute [simp] one_mul mul_left_inv mul_assoc

/-
Now let's teach the simplifier the following five lemmas:

`inv_mul_cancel_left : a⁻¹ * (a * b) = b`
`mul_inv_cancel_left : a * (a⁻¹ * b) = b`
`inv_mul : (a * b)⁻¹ = b⁻¹ * a⁻¹`
`one_inv : (1 : G)⁻¹ = 1`
`inv_inv : (a⁻¹)⁻¹ = a`

Note that in each case, the right hand side is simpler
than the left hand side.

Try using the simplifier in your proofs! I will do the
first one for you.

-/

@[simp] lemma inv_mul_cancel_left : a⁻¹ * (a * b) = b :=
begin
  rw ← mul_assoc, -- the simplifier will not rewrite that way...
  simp -- ...but from here on it can manage.
end

@[simp] lemma mul_inv_cancel_left : a * (a⁻¹ * b) = b :=
begin
  rw ←mul_assoc,
  simp
end

@[simp] lemma inv_mul : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
begin
  apply mul_left_cancel (a * b),
  rw mul_right_inv,
  simp,
end

@[simp] lemma one_inv : (1 : G)⁻¹ = 1 :=
begin
  apply mul_left_cancel (1 : G),
  rw mul_right_inv,
  simp,
end

@[simp] lemma inv_inv : (a ⁻¹) ⁻¹ = a :=
begin
  apply mul_left_cancel a⁻¹,
  simp,
end

/-

The reason I choose these five lemmas in particular, is that
term rewriting systems are very well understood by computer
scientists, and in particular there is something called the
Knuth-Bendix algorithm, which, given as input the three axioms
for a group which we used, produces a "confluent and noetherian
term rewrite system" that transforms every term into a unique
normal form. The system it produces is precisely the `simp`
lemmas which we haven proven above! See

https://en.wikipedia.org/wiki/Word_problem_(mathematics)#Example:_A_term_rewriting_system_to_decide_the_word_problem_in_the_free_group

for more information. I won't talk any more about the Knuth-Bendix
algorithm because it's really computer science, and I don't really
understand it, but apparently if you apply it to polynomial rings
then you get Buchberger's algorithm for computing Gröbner bases.

-/

-- Now let's try our example...
example : (a * b) * 1⁻¹⁻¹ * b⁻¹ * (a⁻¹ * a⁻¹⁻¹⁻¹) * a = 1 := by simp -- short for begin simp end

-- The simplifier solves it!

-- try your own identities. `simp` will solve them all!

/-
This is everything I wanted to show you about groups and the simplifier today.
You can now either go on to subgroups in Part B, or practice your group
theory skills by proving the lemmas below.
-/

/-
We already proved `mul_eq_of_eq_inv_mul` but there are several other
similar-looking, but slightly different, versions of this. Here
is one.
-/

lemma eq_mul_inv_of_mul_eq {a b c : G} (h : a * c = b) : a = b * c⁻¹ :=
begin
  rw ← h,
  simp,
end

lemma eq_inv_mul_of_mul_eq {a b c : G} (h : b * a = c) : a = b⁻¹ * c :=
begin
  rw ← h,
  simp,
end

lemma mul_left_eq_self {a b : G} : a * b = b ↔ a = 1 :=
begin
  split,
  { intro h,
    replace h := eq_mul_inv_of_mul_eq h,
    simp [h] }, -- use h as well as the simp lemmas
  { intro h,
    rw [h, one_mul] }
end

lemma mul_right_eq_self {a b : G} : a * b = a ↔ b = 1 :=
begin
  split,
  { intro h,
    replace h := eq_inv_mul_of_mul_eq h,
    simp [h] },
  { rintro rfl, -- let's define `b` to be 1
    simp },
end

lemma eq_inv_of_mul_eq_one {a b : G} (h : a * b = 1) : a = b⁻¹ :=
begin
  convert eq_mul_inv_of_mul_eq h, -- `convert x` means "I claim the goal is x;
                                  -- now show me the parts where it isn't".
  simp,
end

-- Another useful lemma for the interface
lemma inv_eq_of_mul_eq_one {a b : G} (h : a * b = 1) : a⁻¹ = b :=
begin
  -- we can change hypotheses with the `replace` tactic.
  -- h implies a = 1 * b⁻¹
  replace h := eq_mul_inv_of_mul_eq h,
  simp [h],
end

-- you don't even need `begin / end` to do a `calc`.
lemma unique_left_id {e : G} (h : ∀ x : G, e * x = x) : e = 1 :=
calc e = e * 1 : by rw mul_one
  ...  = 1 : by rw h 1

lemma unique_right_inv {a b : G} (h : a * b = 1) : b = a⁻¹ :=
begin
  apply mul_left_cancel a,
  simp [h],
end

lemma mul_left_cancel_iff (a x y : G) : a * x = a * y ↔ x = y :=
begin
  split,
  { apply mul_left_cancel },
  { intro hxy,
    rwa hxy }
end

lemma mul_right_cancel (a x y : G) (Habac : x * a = y * a) : x = y :=
calc x = x * 1 : by rw mul_one
  ...  = x * (a * a⁻¹) : by rw mul_right_inv
  ...  = x * a * a⁻¹ : by rw mul_assoc
  ...  = y * a * a⁻¹ : by rw Habac
  ...  = y * (a * a⁻¹) : by rw mul_assoc
  ...  = y * 1 : by rw mul_right_inv
  ...  = y : by rw mul_one

-- `↔` lemmas are good simp lemmas too.
@[simp] theorem inv_inj_iff {a b : G}: a⁻¹ = b⁻¹ ↔ a = b :=
begin
  split,
  { intro h,
    rw [← inv_inv a, h, inv_inv b] },
  { rintro rfl, -- define b to be a
    refl }
end

theorem inv_eq {a b : G}: a⁻¹ = b ↔ b⁻¹ = a :=
begin
  split;
  { rintro rfl,
    rw inv_inv }
end

end group

end xena


import tactic
import data.real.basic

/- Tacics you may consider
-intro
-rw
-apply
-exact
-cases
-rcases
-split
-contrapose!
-push_neg
-/

#check le_trans
#check lt_trans
#check @lt_iff_le_not_le

-- BEGIN
variables {α : Type*} [preorder α]
variables a b c : α

example : ¬ a < a :=
begin
  rw lt_iff_le_not_le,
  push_neg,
  intro h,
  exact h,
end

example : a < b → b < c → a < c :=
begin
  simp only [lt_iff_le_not_le],
  intros h h',
  cases h with h1 h2,
  cases h' with h'1 h'2,
  split,
  apply le_trans h1 h'1,
  contrapose! h'2,
  apply le_trans h'2,
  exact h1,
end

example (x y : ℝ) : (∃ z : ℝ, x < z ∧ z < y) → x < y :=
begin
  intro z,
  cases z with z hz,
  cases hz with xltz zlty,
  exact lt_trans xltz zlty,
end

/- Alternatively, using the rcases tactic leads to a shorter proof -/
example (x y : ℝ) : (∃ z : ℝ, x < z ∧ z < y) → x < y :=
begin
  rintros ⟨z, xltz, zlty⟩,
  exact lt_trans xltz zlty,
end

example (x y : ℝ) : (∃ z : ℝ, x < z ∧ z < y) → x < y :=
λ ⟨z, xltz, zlty⟩, lt_trans xltz zlty
-- END


/-
If P and Q are arbitrary propositions, then to prove
P ∧ Q, you need to prove P and to prove Q and then to
form the pair of these proofs to construct a proof of
P ∧ Q.
-/

-- Suppose P and Q are arbitrary propositions
axioms (P Q : Prop)

-- Suppose you have proofs of P and of Q
axioms (p : P) (q : Q)

-- You can now construct a proof of P ∧ Q

#check and.intro p q

/-
Note: Lean provides a nice notation for
and.intro. Use backslash left and right
angle brackets. This notation emphasizes
that a proof of a conjunctions is formed
as a pair of proofs.
-/
lemma pq : P ∧ Q := ⟨ p, q ⟩

/-
The elimination rules for and allow you
to deduce from a proof of P ∧ Q that there
is a proof of P and a proof of Q.
-/

#check pq.left
#check pq.right


import MyNat.Definition
namespace MyNat
open MyNat

/-!
# Function World

## Level 4: the `apply` tactic.

Let's do the same level again a different way:

![diagram](../assets/function_diag.svg)

We are given  `p  ∈ P ` and our goal is to find an element of  `U `, or
in other words to find a path through the maze that links  `P ` to  `U `.
In level 3 we solved this by using `have`s to move forward, from  `P `
to  `Q ` to  `T ` to  `U `.
Using the [apply tactic](../Tactics/apply.lean.md) we can instead construct
the path backwards, moving from  `U ` to  `T ` to  `Q ` to  `P `.

Our goal is to construct an element of the set  `U `. But  `l:T → U ` is
a function, so it would suffice to construct an element of  `T `. Tell
Lean this by starting the proof below with

`apply l`

and notice that our assumptions don't change but *the goal changes*
from `⊢ U` to `⊢ T`.

Keep `apply`ing functions until your goal is `P`, and try not
to get lost! Now solve this goal
with `exact p`. Note: you will need to learn the difference between
`exact p` (which works) and `exact P` (which doesn't, because  `P ` is
not an element of  `P `).

## Definition
Given an element of  `P ` we can define an element of  `U `.
-/
example (P Q R S T U: Type)
(p : P)
(h : P → Q)
(i : Q → R)
(j : Q → T)
(k : S → T)
(l : T → U)
: U := by
  apply l
  apply j
  apply h
  exact p

/-!

Next up [Level 5](./Level5.lean.md)
-/


-- Proves infinitude of prime numbers using Fermat numbers.
-- There are infinite Fermat numbers and they have no common factors.

import data.nat.basic
import data.nat.pow
import data.nat.prime

def fermat_num (n : ℕ) := 2^(2^n) + 1

def fermat_prod : ℕ → ℕ
| 0 := 1
| (n+1) := fermat_num n * fermat_prod n

lemma two_lt_fermat_num (n : ℕ) : 2 < fermat_num n :=
begin
  rw fermat_num,
  apply lt_of_le_of_lt' _ (nat.lt_succ_self 2),
  rw nat.succ_le_succ_iff,
  apply le_self_pow,
    simp,
  apply pow_ne_zero,
  simp,
end

lemma odd_iff {n : ℕ} : ¬ 2 ∣ n ↔ n % 2 = 1 :=
begin
  rw nat.dvd_iff_mod_eq_zero,
  apply iff.intro,
    intro h',
    cases (nat.mod_two_eq_zero_or_one n),
      contradiction,
    assumption,
  cases (nat.mod_two_eq_zero_or_one n),
    rw h,
    contradiction,
  rw h,
  simp,
end

lemma fermat_num_odd (n : ℕ) : ¬ 2 ∣ fermat_num n :=
begin
  rw odd_iff,
  have h := nat.mod_two_eq_zero_or_one,
  rw fermat_num,
  cases n, simp,
  simp [nat.add_mod, nat.pow_mod],
end

-- The main result on which the proof depends.
theorem prod_add_two_eq_num {n : ℕ} :
  fermat_prod n + 2 = fermat_num n :=
begin
  rw fermat_num,
  induction n with k hk,
    rw fermat_prod, simp,
  rw fermat_prod,
  rw fermat_num,
  simp [add_mul],
  rw add_assoc,
  rw hk,
  rw ← add_assoc,
  rw nat.succ.inj_eq,
  rw pow_succ,
  rw mul_comm 2 _,  -- Ensure we get (2^2^k)^2 rather than (2^2)^(2^k).
  rw pow_mul,
  rw ← nat.mul_succ,
  rw pow_two,
  simp,
  apply nat.succ.inj,
  exact hk,
end

lemma fermat_num_dvd_prod {k n : ℕ} : k < n → fermat_num k ∣ fermat_prod n :=
begin
  cases n,
    simp,
  intro hkn,
  cases nat.le.dest (nat.le_of_lt_succ hkn) with d hd,
  rw ← hd, clear hkn hd,
  induction d with i hi,
    simp,
    rw fermat_prod, simp,
  rw nat.add_succ,
  rw fermat_prod,
  apply dvd_trans hi,
  simp,
end

lemma fermat_dvd_fermat_sub_two {k n : ℕ} :
  k < n → fermat_num k ∣ fermat_num n - 2 :=
begin
  cases n,
    simp,
  intro hkn,
  rw ← @prod_add_two_eq_num n.succ, simp,
  apply fermat_num_dvd_prod hkn,
end

-- Lazy proof of a simple result.
lemma dvd_two_iff {m : ℕ} : m ∣ 2 ↔ m = 1 ∨ m = 2 :=
begin
  apply iff.intro,
    cases m, simp,
    cases m, simp,
    cases m, simp,
    intro h,
    exfalso,
    have h_le := nat.le_of_dvd (dec_trivial) h,
    revert h_le,
    dec_trivial,
  intro h,
  cases h,
    rw h, dec_trivial,
  rw h,
end

-- Cannot apply dvd_add_right to ℕ (needs non_unital_ring).
-- From (m ∣ x) and (m ∣ x-2), we have that (m ∣ 2), hence m = 1 or 2.
lemma nat_dvd_add_right {a b c : ℕ} : (a ∣ b) → (a ∣ b + c) → a ∣ c :=
begin
  rw nat.dvd_iff_mod_eq_zero,
  rw nat.dvd_iff_mod_eq_zero,
  rw nat.dvd_iff_mod_eq_zero,
  rw ← nat.mod_add_mod,
  intro ha, rw ha, simp,
end

-- Didn't need this in the end. May be useful in the future.
theorem nat_sub_sub {x y z : ℕ} : x ≤ y → y ≤ z → z - (y - x) = x + (z - y) :=
begin
  intro hxy,
  intro hyz,
  have hxz := le_trans hxy hyz,
  have hy_z : y ≤ z + x := nat.add_le_add hyz (nat.zero_le _),
  have hy_z : y - x ≤ z := _,
    rw nat.sub_eq_iff_eq_add hy_z,
    rw add_assoc, rw add_comm (z-y) (y-x), rw ← add_assoc,
    rw ← nat.add_sub_assoc hxy, simp,
    rw ← nat.add_sub_assoc hyz, simp,
  have hx_z : x ≤ z + x := nat.add_le_add hxz (nat.zero_le _),
  rw ← nat.add_sub_cancel z x,
  rw nat.sub_le_sub_iff_right hx_z, assumption,
end

-- Like nat_dvd_add_right but for (valid) sub.
lemma nat_dvd_sub_right {a b c : ℕ} : c ≤ b → (a ∣ b) → (a ∣ b - c) → a ∣ c :=
begin
  intro h_le,
  rw le_iff_exists_add at h_le,
  cases h_le with d hd,
  rw hd, simp,
  rw add_comm,
  intro ha,
  intro hb,
  apply nat_dvd_add_right hb ha,
end

-- All fermat numbers are co-prime.
theorem fermat_coprime {k n : ℕ} :
  k < n → ∀ (m : ℕ), (m ∣ fermat_num k) → (m ∣ fermat_num n) → m = 1 :=
begin
  intro hkn,
  intro m,
  intro hfk,
  intro hfn,
  have h_dvd_sub_two := dvd_trans hfk (fermat_dvd_fermat_sub_two hkn),
  -- Combine the two dvd results to obtain constraint on m.
  have h := nat_dvd_sub_right _ hfn h_dvd_sub_two,
    rw dvd_two_iff at h,
    cases h, assumption,
    -- m cannot be 2 since all Fermat numbers are odd.
    exfalso,
    apply fermat_num_odd k,
    rw h at hfk, exact hfk,
  apply le_of_lt,
  apply two_lt_fermat_num,
end

-- Function that maps any number to a novel prime number.
def make_prime (n : ℕ) := (fermat_num n).min_fac

lemma make_prime_is_prime (n : ℕ) : nat.prime (make_prime n) :=
begin
  rw make_prime,
  apply nat.min_fac_prime,
  rw fermat_num,
  simp,
end

lemma not_make_prime_eq_one {n : ℕ} : ¬ make_prime n = 1 :=
begin
  intro h',
  apply nat.not_prime_one,
  have h := make_prime_is_prime n,
  rw h' at h,
  exact h,
end

-- Prove that make_prime n generates a new prime number for any n.
theorem infinite_primes (n : ℕ) :
  nat.prime (make_prime n) ∧ ∀ (k : ℕ), k < n → make_prime k ≠ make_prime n :=
begin
  cases n, simp,
    apply nat.min_fac_prime,
    rw fermat_num, simp,
  apply and.intro (make_prime_is_prime _),
  intro k,
  intro hk,
  have h_prime := make_prime_is_prime k,
  simp, intro h_eq,
  have h := fermat_coprime hk (make_prime k),  -- but we know that make_prime k ≠ 1
  apply not_make_prime_eq_one,
  apply h,
    rw make_prime,
    apply nat.min_fac_dvd,
  rw h_eq,
  rw make_prime,
  apply nat.min_fac_dvd,
end


/-
Copyright (c) 2022 Bolton Bailey. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bolton Bailey, Patrick Stevens, Thomas Browning
-/

import data.nat.choose.central
import number_theory.padics.padic_norm
import data.nat.multiplicity

/-!
# Factorization of Binomial Coefficients

This file contains a few results on the multiplicity of prime factors within certain size
bounds in binomial coefficients. These include:

* `nat.factorization_choose_le_log`: a logarithmic upper bound on the multiplicity of a prime in
  a binomial coefficient.
* `nat.factorization_choose_le_one`: Primes above `sqrt n` appear at most once
  in the factorization of `n` choose `k`.
* `nat.factorization_central_binom_of_two_mul_self_lt_three_mul`: Primes from `2 * n / 3` to `n`
do not appear in the factorization of the `n`th central binomial coefficient.
* `nat.factorization_choose_eq_zero_of_lt`: Primes greater than `n` do not
  appear in the factorization of `n` choose `k`.

These results appear in the [Erdős proof of Bertrand's postulate](aigner1999proofs).
-/

namespace nat

variables {p n k : ℕ}

/--
A logarithmic upper bound on the multiplicity of a prime in a binomial coefficient.
-/
lemma factorization_choose_le_log : (choose n k).factorization p ≤ log p n :=
begin
  by_cases h : (choose n k).factorization p = 0, { simp [h] },
  have hp : p.prime := not.imp_symm (choose n k).factorization_eq_zero_of_non_prime h,
  have hkn : k ≤ n, { refine le_of_not_lt (λ hnk, h _), simp [choose_eq_zero_of_lt hnk] },
  rw [←@padic_val_nat_eq_factorization p _ ⟨hp⟩, @padic_val_nat_def _ ⟨hp⟩ _ (choose_pos hkn)],
  simp only [hp.multiplicity_choose hkn (lt_add_one _), enat.get_coe],
  refine (finset.card_filter_le _ _).trans (le_of_eq (nat.card_Ico _ _)),
end

/--
A `pow` form of `nat.factorization_choose_le`
-/
lemma pow_factorization_choose_le (hn : 0 < n) : p ^ (choose n k).factorization p ≤ n :=
begin
  cases le_or_lt p 1,
  { exact (pow_le_pow_of_le h).trans ((le_of_eq (one_pow _)).trans hn) },
  { exact (pow_le_iff_le_log h hn).mpr factorization_choose_le_log },
end

/--
Primes greater than about `sqrt n` appear only to multiplicity 0 or 1 in the binomial coefficient.
-/
lemma factorization_choose_le_one (p_large : n < p ^ 2) : (choose n k).factorization p ≤ 1 :=
begin
  apply factorization_choose_le_log.trans,
  rcases n.eq_zero_or_pos with rfl | hn0, { simp },
  refine lt_succ_iff.1 ((lt_pow_iff_log_lt _ hn0).1 p_large),
  contrapose! hn0,
  exact lt_succ_iff.1 (lt_of_lt_of_le p_large (pow_le_one' hn0 2)),
end

lemma factorization_choose_of_lt_three_mul
  (hp' : p ≠ 2) (hk : p ≤ k) (hk' : p ≤ n - k) (hn : n < 3 * p) :
  (choose n k).factorization p = 0 :=
begin
  cases em' p.prime with hp hp,
  { exact factorization_eq_zero_of_non_prime (choose n k) hp },
  cases lt_or_le n k with hnk hkn,
  { simp [choose_eq_zero_of_lt hnk] },
  rw [←@padic_val_nat_eq_factorization p _ ⟨hp⟩, @padic_val_nat_def _ ⟨hp⟩ _ (choose_pos hkn)],
  simp only [hp.multiplicity_choose hkn (lt_add_one _), enat.get_coe,
    finset.card_eq_zero, finset.filter_eq_empty_iff, not_le],
  intros i hi,
  rcases eq_or_lt_of_le (finset.mem_Ico.mp hi).1 with rfl | hi,
  { rw [pow_one, ←add_lt_add_iff_left (2 * p), ←succ_mul, two_mul, add_add_add_comm],
    exact lt_of_le_of_lt (add_le_add
      (add_le_add_right (le_mul_of_one_le_right' ((one_le_div_iff hp.pos).mpr hk)) (k % p))
      (add_le_add_right (le_mul_of_one_le_right' ((one_le_div_iff hp.pos).mpr hk')) ((n - k) % p)))
      (by rwa [div_add_mod, div_add_mod, add_tsub_cancel_of_le hkn]) },
  { replace hn : n < p ^ i,
    { calc n < 3 * p : hn
      ... ≤ p * p : mul_le_mul_right' (lt_of_le_of_ne hp.two_le hp'.symm) p
      ... = p ^ 2 : (sq p).symm
      ... ≤ p ^ i : pow_le_pow hp.one_lt.le hi },
    rwa [mod_eq_of_lt (lt_of_le_of_lt hkn hn), mod_eq_of_lt (lt_of_le_of_lt tsub_le_self hn),
      add_tsub_cancel_of_le hkn] },
end

/--
Primes greater than about `2 * n / 3` and less than `n` do not appear in the factorization of
`central_binom n`.
-/
lemma factorization_central_binom_of_two_mul_self_lt_three_mul
  (n_big : 2 < n) (p_le_n : p ≤ n) (big : 2 * n < 3 * p) :
  (central_binom n).factorization p = 0 :=
begin
  refine factorization_choose_of_lt_three_mul _ p_le_n (p_le_n.trans _) big,
  { rintro rfl, linarith },
  { rw [two_mul, add_tsub_cancel_left] },
end

lemma factorization_factorial_eq_zero_of_lt (h : n < p) :
  (factorial n).factorization p = 0 :=
begin
  induction n with n hn, { simp },
  rw [factorial_succ, factorization_mul n.succ_ne_zero n.factorial_ne_zero, finsupp.coe_add,
      pi.add_apply, hn (lt_of_succ_lt h), add_zero, factorization_eq_zero_of_lt h],
end

lemma factorization_choose_eq_zero_of_lt (h : n < p) :
  (choose n k).factorization p = 0 :=
begin
  by_cases hnk : n < k, { simp [choose_eq_zero_of_lt hnk] },
  rw [choose_eq_factorial_div_factorial (le_of_not_lt hnk),
      factorization_div (factorial_mul_factorial_dvd_factorial (le_of_not_lt hnk)),
      finsupp.coe_tsub, pi.sub_apply, factorization_factorial_eq_zero_of_lt h, zero_tsub],
end

/--
If a prime `p` has positive multiplicity in the `n`th central binomial coefficient,
`p` is no more than `2 * n`
-/
lemma factorization_central_binom_eq_zero_of_two_mul_lt (h : 2 * n < p) :
  (central_binom n).factorization p = 0 :=
factorization_choose_eq_zero_of_lt h

/--
Contrapositive form of `nat.factorization_central_binom_eq_zero_of_two_mul_lt`
-/
lemma le_two_mul_of_factorization_central_binom_pos
  (h_pos : 0 < (central_binom n).factorization p) : p ≤ 2 * n :=
le_of_not_lt (pos_iff_ne_zero.mp h_pos ∘ factorization_central_binom_eq_zero_of_two_mul_lt)

end nat


/-
Copyright (c) 2022 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Daniel Selsam
-/
import data.nat.basic
import data.nat.digits
import data.finset.basic

-- `f` is the collatz function
def f (n : ℕ) : ℕ :=
  if 2 ∣ n then n / 2 else 3 * n + 1

def simulate : Π (k : ℕ) (n : ℕ), list ℕ
  | _ 1     := [1]
  | 0 n     := [n]
  | (k+1) n := n :: simulate k (f n)

example : simulate 6 7 = [7, 22, 11, 34, 17, 52, 26] := rfl

@[reducible]
def gcond (n : ℕ) : Prop :=
  3 ∣ (n-1) ∧ ¬ (2 ∣ ((n - 1)/3))

-- `g` is the inverse of `f`
-- f (2 * n) = n
-- f ((n-1)/3) = n ↔ (n-1)/3 is an odd integer
def g (n : ℕ) : finset ℕ :=
  if gcond n then { 2 * n, (n - 1) / 3 } else { 2 * n }

lemma not_gcond (n : ℕ) : ¬ gcond n → (¬ (3 ∣ (n-1)) ∨ 2 ∣ ((n - 1)/3)) :=
begin
  unfold gcond,
  intro h_ngcond,
  simp at h_ngcond,
  by_cases h : 3 ∣ (n-1),
  simp [h_ngcond h],
  simp [h]
end

lemma cancel_shift {d n k : ℕ} : d ∣ (n - k) → k ≤ n → d * ((n - k) / d) + k = n :=
begin
  intros h_div h_le,
  suffices h_goal : d * ((n - k) / d) = n - k,
  { simp [h_goal], apply nat.sub_add_cancel h_le,  },
  { rw [mul_comm], apply nat.div_mul_cancel h_div },
end

lemma g_inv_f : ∀ (n : ℕ), 1 ≤ n → ∀ (k : ℕ), k ∈ g n ↔ f k = n :=
begin
  intros n h_ge1 k,
  split,
  -- k ∈ g n → f k = n
  {
    intro hk_gn,
    dunfold g at hk_gn,
    by_cases h_cond : gcond n,
    -- case 1: can reach n from two different positions
    {
      simp [h_cond] at hk_gn,
      cases hk_gn ; subst hk_gn,
      -- f (2 * n) = n
      { simp [f], },
      -- f ((n-1)/3) = n
      {
        unfold gcond at h_cond,
        simp [f, h_cond.2, cancel_shift h_cond.1 h_ge1],
      },
    },
    -- case 2: can only reach n from above
    {
      simp [h_cond] at hk_gn,
      simp [f, hk_gn],
    },
  },
  -- f k = n → k ∈ g n
  {
    intro h_fk,
    subst h_fk,
    simp [g],
    by_cases h_gcond : gcond (f k),
    -- case 1: gcond (f k)
    {
      simp [h_gcond],
      unfold gcond at h_gcond,
      unfold f at *,
      by_cases h_2k : 2 ∣ k,
      { simp [h_2k], left, rw [mul_comm, nat.div_mul_cancel h_2k] },
      { simp [h_2k] }
    },
    -- case 2: ¬ gcond (f k)
    {
      simp [h_gcond],
      unfold f at *,
      by_cases h_2k : 2 ∣ k,
      { simp [h_2k], rw [mul_comm, nat.div_mul_cancel h_2k] },
      { simp [h_2k] at h_gcond, contradiction }
    }
  }
end

def iterate {α : Type} (f : α → α) : ℕ → α → α
| 0 x := x
| (steps+1) x := iterate steps (f x)

def finset.iterate {α : Type} [decidable_eq α] (g : α → finset α) : ℕ → α → finset α
| 0 x := {x}
| (steps+1) x := (finset.iterate steps x).bUnion g

theorem iterate_g_ge1 : ∀ {steps x : ℕ}, x ∈ finset.iterate g steps 1 → 1 ≤ x
| 0 x h :=
begin
  clear iterate_g_ge1,
  simp [finset.iterate, g, gcond] at h,
  subst h
end
| (steps+1) x₀ h :=
begin
  simp [finset.iterate, g] at h,
  obtain ⟨x, hx, hy⟩ := h,
  have hx_ge1 : 1 ≤ x := iterate_g_ge1 hx,
  have one_le2x : 1 ≤ 2 * x,
  {
    transitivity x,
    exact hx_ge1,
    exact nat.le_mul_of_pos_left (nat.zero_lt_succ 1)
  },
  by_cases h_cond : (gcond x),
  -- case 1: 2 possibilities
  {
    simp [h_cond] at hy,
    cases hy,
    -- easy case
    {
      subst hy,
      exact one_le2x
    },
    -- hard (3) case
    {
      subst hy,
      simp [gcond] at h_cond,
      --obtain ⟨⟨z3, h_z3⟩, h_x2⟩ := h_cond,
      obtain ⟨h_x3, h_x2⟩ := h_cond,
      -- We first rule out 0-3
      cases x, { norm_num at h_x2 },
      cases x, { norm_num at h_x2 },
      cases x, { norm_num at h_x2 },
      cases x, { norm_num at h_x2 },
      show 1 ≤ (x+3) / 3,
      norm_num,
      show 1 ≤ (x/3) + 1,
      exact nat.le_add_left _ _
    }
  },
  -- gcond=false
  {
    simp [h_cond] at hy,
    subst hy,
    exact one_le2x
  }
end

theorem iterate_f_ge1 : ∀ {steps x : ℕ}, iterate f steps x = 1 → x ≥ 1
| 0 x h_f := by { simp [iterate] at h_f, subst h_f, apply le_refl }
| (steps+1) x h_f :=
begin
simp [iterate] at h_f,
have hx_ge1 : 1 ≤ f x := iterate_f_ge1 h_f,
simp [f] at hx_ge1,
by_cases h_x : 2 ∣ x,
{
  simp [h_x] at hx_ge1,
  rw [← nat.div_mul_cancel h_x],
  rw [mul_comm],
  transitivity x/2,
  apply nat.le_mul_of_pos_left (nat.zero_lt_succ 1),
  exact hx_ge1
},
{
  simp [h_x] at hx_ge1,
  cases x, { simp at h_x, contradiction },
  show 1 ≤ x+1,
  apply nat.le_add_left
}
end

lemma iter_g_inv_f : ∀ (steps k : ℕ), k ∈ finset.iterate g steps 1 ↔ iterate f steps k = 1
| 0 _ := by split ; simp [f, g, iterate, finset.iterate, gcond]
| (steps+1) k :=
begin
  split,
  {
    intro h_kg,
    simp [iterate],
    simp [finset.iterate] at h_kg,
    obtain ⟨x, h_x, h_y⟩ := h_kg,
    rw [g_inv_f _ (iterate_g_ge1 h_x) k] at h_y,
    subst h_y,
    exact (iter_g_inv_f _ _).mp h_x
  },
  {
    intro h_kg,
    simp [finset.iterate],
    simp [iterate] at h_kg,
    existsi f k,
    split,
    { exact (iter_g_inv_f _ _).mpr h_kg },
    { rw [g_inv_f _ (iterate_f_ge1 h_kg) _]}
  }
end

theorem amc8_2020_p22 :
  let s : set ℕ := {n | iterate f 6 n = 1 } in
  ∃ (fs : finset ℕ), ↑fs = s ∧ fs.sum id = 83 :=
begin
  intro s,
  simp [s], clear s,
  existsi (finset.iterate g 6 1),
  split,
  -- Restatement of our main lemma
  {
    ext,
    simp [iter_g_inv_f]
  },
  -- Now for the computation
  {
    dec_trivial
  }
end


/-
If P and Q are propositions, then
so is P ↔ Q. We call this form of
proposition a bi-implication. It
means P → Q ∧  Q → P.

Here's a somewhat silly example:
if it has been raining the ground
in the desert is wet (R → W) and
if the ground in the desert is wet
then it has been raining (W → R).
In this case, we can say that the
ground in the desert is wet "if and
only if" (iff) it has been raining.

In such a situation we say that
"it has been raining" and "the
ground in the desert is wet" are
equivalent, as the two states of
affairs invariable occur or do not
occur together.

The rules for ↔ introducing and
elimination are conceptually the same
as for ∧ applied to two implications,
one going in each direction (R to W
and W to R, respectively).

We recommend that you pronounce
P ↔ Q as "P and Q are equivalent".
Most mathematicians pronounce it
as "P if and only if Q", which
they generally abbreviate P iff
Q (note the extra f). Figuring
out why the phrase "if and only
if" actually makes sense is arguably
more trouble than it's worth. Just
know that people use this phrase
in mathematics and logic all the
time.

 /-
  *************************
  *** Introduction Rule ***
  *************************
-/

To construct a proof of P ↔ Q you
must have (or have assumed) proofs
of two propositions: a proof of
P → Q, and a proof of Q → P. The
inference rule is thus as follows:

P Q : Prop, p2q : P → Q, q2p: Q → P
-----------------------------------
        PiffQ : P ↔ Q

In informal mathematical writing, a
proof of P ↔ Q will start with the
following kind of language. "We are
to prove P ↔ Q. To prove it we must
first prove P → Q, then we must prove
P → Q. We consider the case P → Q
first. " "first we consider the implication
from P to Q, ..." Once that part
is proved, it will say "and now
we consider the implication in
the other direction." When that
part is also done, it will then
say, combing these results thus
proves P ↔ Q. QED."

Lean provides the iff.intro rule
to construct a proof of P ↔ Q
from the requisite sub-proofs.
Here's an example of its use
in a program whose type makes
clear what's required to use it.
-/

lemma bi_implication :
 ∀ { P Q : Prop },
    (P → Q) → (Q → P) → (P ↔ Q) :=
        λ P Q pfPQ pfQP,
            iff.intro pfPQ pfQP

/-
The logical way to read this is as
saying that if we assume that P and
Q are propositions, and if we assume
we're given a proof of P → Q and we
furthermore assume we're given a
proof of Q → P then we can derive a
proof of P ↔ Q by appealing to (by
applying) the iff introduction rule
of the natural deduction system of
logical reasoning.
-/

/-
Let's assume we have two propositions,
P and Q.
-/

variables P Q : Prop

/-
and that we have proofs of both P → Q
and of Q → P
-/
variable forward: P → Q
variable backward: Q → P

/-
then we can apply iff-intro to derive
a proof of P ↔ Q.
-/

def pqEquiv := iff.intro forward backward

/-
Going the other way, if we're given a
proof of P ↔ Q, then we can derive proofs
of P → Q and of Q → P using the iff.elim
left and right rules.
-/

#check  pqEquiv

/-
A proof of P ↔ Q is essentially a
proof of the conjunction (P → Q) ∧
(Q → P). iff.intro is like ∧-intro,
and the left and right iff.elim
rules are like the ∧-elim left and
right rules.
-/

/-
EXERCISE: Construct a proof, pqequiv, of
the proposition, P ∧ Q ↔ Q ∧ P. Note:
we don't need to know whether P and Q
are true, false, or unknown to provide
such a proof.
-/

theorem andcomm : P ∧ Q ↔ Q ∧ P :=
begin
apply iff.intro,
-- left to right
assume pq : P ∧ Q,
show Q ∧ P,
from and.intro (pq.right) (pq.left),
-- in other direction
assume qp: Q ∧ P,
show P ∧ Q,
from and.intro (qp.right) (qp.left),
end

/-
Note that the proposition that andcomm
proves is: ∀ P Q: Prop, P ∧ Q ↔ Q ∧ P.
The use of "variables P Q : Prop" above
basically adds a "∀ P Q : Prop" to each
of the propositions that follow.

As a result, andcomm in effect takes
any two propositions as arguments and
returns a proof that the conjunctions
are equivalent no matter the order of
the conjuncts.
-/

#check andcomm (0=0) (1=1)
#reduce andcomm (0=0) (1=1)

/-
In the following trivial example,
we can see how the bi_implication
introduction rule (run backwards)
gives us a way to split a goal of
proving P ↔ Q into two sub-goals,
one implication in each direction.
Knowing to do that split and then
to provide two proofs, one for each
direction, is the key to proving
bi-implications, whether using a
prover such as Lean or just using
paper and pencil.
-/
theorem easy_iff: 0 = 0 ↔ 1 = 1 :=
begin
apply bi_implication,
exact λ e, eq.refl 1, -- ignores argument
exact λ e, eq.refl 0, -- ignores argument
end

/-
EXERCISE:
1. Prove that A → B → C ↔ A ∧ B → C.
2. Given that you can prove this, does this
mean that A → B = A ∧ B?
-/

lemma a_imp_b_imp_c_iff_a_and_b_imp_c:
  ∀ A B C: Prop, (A → B → C) ↔ ((A ∧ B) → C) :=
  λ A B C: Prop,
begin
apply iff.intro,
-- forward
assume abc : (A → B → C),
assume ab : A ∧ B,
show C,
from
  begin
  have a : A := ab.left,
  have b : B := ab.right,
  show C,
  from abc a b,
  end,
-- backward
  assume abc : (A ∧ B → C),
  show A → B → C,
  from
    begin
    assume (a : A) (b : B),
    have ab := and.intro a b,
    show C,
    from abc ab
    end,
end

/-
  *************************
  *** Elimination Rules ***
  *************************
-/

/-
As with ∧, the elimination rules,
iff.elim_left and iff.elim_right,
take a proof of P ↔ Q and return
the constituent sub-proofs, P → Q,
and Q → P, respectively.
-/

#check iff.elim_left (andcomm P Q)
#check iff.elim_right (andcomm P Q)

theorem PIffQImpP2Q : (P ↔ Q) → P →  Q :=
begin
assume piffq p,
show Q,
from
  begin
  have p2q := iff.elim_left piffq,
  exact (p2q p)
  end
end

-- even easier is this
theorem PIffQImpP2Q' : (P ↔ Q) → P -> Q :=
begin
assume piffq,
show P → Q,
from iff.elim_left piffq
end

/-
EXERCISE: Prove P ↔ Q) → Q -> P
-/


/-
Copyright (c) 2021 Gabriel Moise. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Gabriel Moise.
-/

import algebra.big_operators.basic
import combinatorics.simple_graph.adj_matrix
import combinatorics.simple_graph.basic
import linear_algebra.matrix
import project.incidence

/-!
# Laplacian matrices

This module defines the Laplacian matrix `laplace_matrix` of an undirected graph `simple_graph` and
provides theorems and lemmas connecting graph properties to computational properties of the matrix.

## Main definitions

* `laplace_matrix` is the Laplace matrix of a `simple_graph` with coefficients in a ring R
* `degree_matrix` is the degree matrix of a `simple_graph` with coefficients in a ring R
* `signless_laplace_matrix` is the signless Laplace matrix of a `simple_graph` with coefficients in a ring R
* `edge_from_vertices` is the edge that is created by two adjacent vertices

## Main statements

1. The degree of a vertex v is equal to the sum of elements from row v of the adjacency matrix.
2. The Laplacian matrix is symmetric.
3. The sum of elements on any row of the Laplacian is zero.
4. The Laplacian matrix is equal to the difference between the degree and adjancency matrices.
5. The signless Laplacian matrix decomposition.
6. The Laplacian matrix decomposition.
7. The Laplacian is a quadratic form : xᵀ ⬝ L ⬝ x = ∑ e : G.edge_set, (x head(e) - x tail(e)) ^ 2.
-/

open_locale big_operators matrix
open finset matrix simple_graph

universes u v
variables {V : Type u} [fintype V] [decidable_eq V]
variables {R : Type v} [comm_ring R] [nontrivial R] [decidable_eq R]

lemma dot_product_helper {x y z : V → R} (H_eq : x = y) : dot_product x z = dot_product y z :=
by rw H_eq

namespace simple_graph

variables (G : simple_graph V) (R) [decidable_rel G.adj]

lemma adj_matrix_eq {i j : V} (H_eq : i = j) : G.adj_matrix R i j = 0 :=
by simp only [H_eq, irrefl, if_false, adj_matrix_apply]

lemma adj_matrix_adj {i j : V} (H_adj : G.adj i j) : G.adj_matrix R i j = 1 :=
by simp only [H_adj, adj_matrix_apply, if_true]

lemma adj_matrix_not_adj {i j : V} (H_not_adj : ¬ G.adj i j) : G.adj_matrix R i j = 0 :=
by simp only [H_not_adj, adj_matrix_apply, if_false]

-- 1. The degree of a vertex v is equal to the sum of elements from row v of the adjacency matrix.
lemma degree_eq_sum_of_adj_matrix_row {α : Type*} [semiring α] {i : V} :
  (G.degree i : α) = ∑ (j : V), G.adj_matrix α i j :=
by { rw [← mul_one (G.degree i : α)],
     simp only [← adj_matrix_mul_vec_const_apply, mul_vec, dot_product, boole_mul, adj_matrix_apply] }

-- ## Laplacian matrix L

/-- `laplace_matrix G` is the matrix `L` of an `simple graph G` with `∀ i j ∈ V` :
` | L i j = G.degree i`, if `i = j`
` | L i j = - A i j`, otherwise. -/
def laplace_matrix : matrix V V R
| i j := if i = j then G.degree i else - G.adj_matrix R i j

@[simp]
lemma laplace_matrix_apply {i j : V} :
  G.laplace_matrix R i j = if i = j then G.degree i else - G.adj_matrix R i j := rfl

lemma laplace_matrix_eq {i j : V} (H_eq : i = j) : G.laplace_matrix R i j = G.degree i :=
by { rw [laplace_matrix_apply, adj_matrix_apply], simp only [H_eq, if_true, eq_self_iff_true] }

lemma laplace_matrix_neq {i j : V} (H_neq : i ≠ j) : G.laplace_matrix R i j = - G.adj_matrix R i j :=
by simp only [laplace_matrix_apply, adj_matrix_apply, H_neq, if_false]

-- 2. The Laplacian matrix is symmetric.
@[simp]
lemma transpose_laplace_matrix : (G.laplace_matrix R)ᵀ = G.laplace_matrix R :=
begin
  ext i j,
  by_cases H : (i = j),
  { simp only [H, transpose_apply] },
  { rw [transpose_apply, G.laplace_matrix_neq R H, G.laplace_matrix_neq R (ne.symm H)],
    simp [edge_symm] }
end

lemma filter_eq_neq_empty {i : V} [decidable_eq V] : filter (eq i) (univ \ {i}) = ∅ :=
by { ext, tidy }

lemma filter_id {i : V}: filter (λ (x : V), ¬i = x) (univ \ {i}) = (univ \ {i}) :=
by { ext, tidy }

-- 3. The sum of elements on any row of the Laplacian is zero.
lemma sum_of_laplace_row_equals_zero {i : V} : ∑ (j : V), G.laplace_matrix R i j = 0 :=
begin
  rw [sum_eq_add_sum_diff_singleton (mem_univ i), laplace_matrix_eq],
  simp only [laplace_matrix_apply, sum_ite, filter_eq_neq_empty, filter_id, adj_matrix_apply],
  rw [sum_neg_distrib, sum_boole, sum_const, card_empty, zero_smul, zero_add],
  rw degree_eq_sum_of_adj_matrix_row,
  have H : filter (λ (x : V), G.adj i x) (univ \ {i}) = filter (G.adj i) univ,
  { ext,
    simp only [true_and, mem_filter, mem_sdiff, and_iff_right_iff_imp, mem_univ, mem_singleton],
    intro hyp,
    exact ne.symm (G.ne_of_adj hyp) },
  simp only [H, adj_matrix_apply, sum_boole, add_right_neg, eq_self_iff_true],
end

-- ## Degree matrix D

/-- `degree_matrix G` is the matrix `D` with `∀ i j ∈ V` :
` | D i j = 0` if `i` ≠ `j`
` | D i j = G.degree i` otherwise. -/
def degree_matrix : matrix V V R
| i j := if i = j then G.degree i else 0

@[simp]
lemma degree_matrix_apply {i j : V} :
  G.degree_matrix R i j = if i = j then G.degree i else 0 := rfl

lemma degree_matrix_eq {i j : V} (H_eq : i = j) : G.degree_matrix R i j = G.degree i :=
by { rw H_eq, simp only [degree_matrix_apply, if_true, eq_self_iff_true] }

lemma degree_matrix_neq {i j : V} (H_neq : i ≠ j) : G.degree_matrix R i j = 0 :=
by simp only [degree_matrix_apply, H_neq, if_false]

-- 4. L = D - A.
lemma laplace_eq_degree_minus_adj :
  G.laplace_matrix R = G.degree_matrix R - G.adj_matrix R :=
begin
  ext,
  by_cases H : (i = j),
  { rw [G.laplace_matrix_eq R H, dmatrix.sub_apply, G.degree_matrix_eq R H,
        G.adj_matrix_eq R H, sub_zero] },
  { rw [G.laplace_matrix_neq R H, dmatrix.sub_apply, G.degree_matrix_neq R H, zero_sub] }
end

-- ## Signless Laplace matrix Q

def signless_laplace_matrix : matrix V V R := G.degree_matrix R + G.adj_matrix R

@[simp]
lemma signless_laplace_matrix_apply {i j : V} :
  G.signless_laplace_matrix R i j = (G.degree_matrix R + G.adj_matrix R) i j := rfl

-- 5. Q = M ⬝ Mᵀ.
lemma signless_laplace_decomposition : G.signless_laplace_matrix R = G.inc_matrix R ⬝ (G.inc_matrix R)ᵀ :=
begin
  ext,
  by_cases H_ij : i = j,
  { rw [signless_laplace_matrix_apply, dmatrix.add_apply, G.adj_matrix_eq R H_ij, add_zero],
    rw [mul_apply, G.degree_matrix_eq R H_ij, H_ij, degree_equals_sum_of_incidence_row],
    simp only [transpose_apply, inc_matrix_element_power_id] },
  { rw [signless_laplace_matrix_apply, dmatrix.add_apply, G.degree_matrix_neq R H_ij, zero_add],
    rw [mul_apply],
    by_cases H_adj : G.adj i j,
    { simp only [G.adj_matrix_adj R H_adj, transpose_apply, G.adj_sum_of_prod_inc_one R H_adj] },
    { simp only [G.adj_matrix_not_adj R H_adj, transpose_apply,
                 G.inc_matrix_prod_non_adj R H_ij H_adj, sum_const_zero] } }
end

def edge_from_vertices (i j : V) (H_adj : G.adj i j) : G.edge_set := ⟨⟦(i, j)⟧, G.mem_edge_set.mpr H_adj⟩

@[simp]
lemma edge_from_vertices_iff {i j : V} {e : G.edge_set} (H_adj : G.adj i j) :
   e = G.edge_from_vertices i j H_adj ↔ e.val = ⟦(i, j)⟧ :=
begin
  split,
  { intro hyp, simp only [edge_from_vertices, hyp] },
  { intro hyp, tidy }
end

-- 6. L = N(o) ⬝ N(o)ᵀ, for any orientation o.
lemma laplace_decomposition (o : orientation G) :
  G.laplace_matrix R = G.dir_inc_matrix R o ⬝ (G.dir_inc_matrix R o)ᵀ :=
begin
  ext i j,
  by_cases H_ij : i = j,
  { rw [G.laplace_matrix_eq R H_ij, mul_apply, H_ij, G.degree_equals_sum_of_incidence_row R],
    simp only [transpose_apply, G.dir_inc_matrix_elem_squared R] },
  { rw [G.laplace_matrix_neq R H_ij, mul_apply],
    by_cases H_adj : G.adj i j,
    { simp only [G.adj_matrix_adj R H_adj, transpose_apply, G.dir_inc_matrix_prod_of_adj R H_adj],
      have key : ∀ (e : G.edge_set), ite (e.val = ⟦(i, j)⟧) (-1 : R) 0 = - ite (e.val = ⟦(i, j)⟧) 1 0,
      { intro e,
        convert (apply_ite (λ x : R, -x) (e.val = ⟦(i, j)⟧) (1 : R) (0 : R)).symm,
        rw neg_zero },
      have sum : ∑ (e : G.edge_set), ite (e.val = ⟦(i, j)⟧) (-1 : R) 0 =
                 ∑ (e : G.edge_set), - ite (e.val = ⟦(i, j)⟧) (1 : R) 0,
      { simp only [key] },
      rw [sum, sum_hom, neg_inj, sum_boole],
      have key : filter (λ (e : G.edge_set), e.val = ⟦(i, j)⟧) univ = {G.edge_from_vertices i j H_adj},
      { ext,
        simp only [true_and, mem_filter, mem_univ, mem_singleton],
        rw G.edge_from_vertices_iff H_adj },
      rw key,
      simp only [nat.cast_one, card_singleton] },
    { simp only [G.adj_matrix_not_adj R H_adj, transpose_apply,
                 G.dir_inc_matrix_prod_non_adj R H_ij H_adj, sum_const_zero, neg_zero] } }
end

-- 7. The Laplacian is a quadratic form : xᵀ ⬝ L ⬝ x = ∑ e : G.edge_set, (x head(e) - x tail(e)) ^ 2.
lemma laplace_quadratic_form {o : orientation G} (x : V → R) :
  dot_product (vec_mul x (G.laplace_matrix R)) x = ∑ e : G.edge_set, (x (o.head e) - x (o.tail e)) ^ 2 :=
by calc dot_product (vec_mul x (G.laplace_matrix R)) x
       = dot_product (vec_mul x (G.dir_inc_matrix R o ⬝ (G.dir_inc_matrix R o)ᵀ)) x :
   by { rw laplace_decomposition }                          -- xᵀ ⬝ L ⬝ x = xᵀ ⬝ (N ⬝ Nᵀ) ⬝ x
   ... = dot_product (vec_mul (vec_mul x (G.dir_inc_matrix R o)) (G.dir_inc_matrix R o)ᵀ) x :
   by { rw ← vec_mul_vec_mul }                                     -- ... = (xᵀ ⬝ N) ⬝ Nᵀ ⬝ x
   ... = dot_product (λ j, dot_product (vec_mul x (G.dir_inc_matrix R o)) (λ i, (G.dir_inc_matrix R o)ᵀ i j)) x :
   by { apply dot_product_helper, ext, unfold vec_mul }
   ... = dot_product (vec_mul x (G.dir_inc_matrix R o)) (λ (e : G.edge_set), dot_product ((G.dir_inc_matrix R o)ᵀ e) x) :
   by { rw dot_product_assoc }
   ... = dot_product (vec_mul x (G.dir_inc_matrix R o)) ((G.dir_inc_matrix R o)ᵀ.mul_vec x) :
   by { exact dot_product_helper rfl, }                            -- ... = (xᵀ ⬝ N) ⬝ (Nᵀ ⬝ x)
   ... = dot_product (vec_mul x (G.dir_inc_matrix R o)) (vec_mul x (G.dir_inc_matrix R o)) :
   by { rw mul_vec_transpose }                                     -- ... = (xᵀ ⬝ N) ⬝ (xᵀ ⬝ N)ᵀ
   ... = ∑ e : G.edge_set, (x (o.head e) - x (o.tail e)) ^ 2 :
   by { simp only [dot_product, vec_mul_dir_inc_matrix], ring_nf } -- = ∑ e, (x head(e) - x tail(e)) ^ 2

end simple_graph


/-
Copyright (c) 2021 Eric Rodriguez. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Rodriguez
-/
import data.fintype.card
import data.equiv.fin
import data.equiv.embedding

/-!
# Number of embeddings

This file establishes the cardinality of `α ↪ β` in full generality.
-/

local notation `|` x `|` := finset.card x
local notation `‖` x `‖` := fintype.card x

open_locale nat

local attribute [semireducible] function.embedding.fintype

namespace fintype

-- We need the separate `fintype α` instance as it contains data,
-- and may not match definitionally with the instance coming from `unique.fintype`.
lemma card_embedding_eq_of_unique
  {α β : Type*} [unique α] [fintype α] [fintype β] [decidable_eq α] [decidable_eq β]:
‖α ↪ β‖ = ‖β‖ := card_congr equiv.unique_embedding_equiv_result

private lemma card_embedding_aux {n : ℕ} {β} [fintype β] [decidable_eq β] (h : n ≤ ‖β‖) :
  ‖fin n ↪ β‖ = ‖β‖.desc_factorial n :=
begin
  induction n with n hn,
  { nontriviality (fin 0 ↪ β),
    rw [nat.desc_factorial_zero, fintype.card_eq_one_iff],
    refine ⟨nonempty.some nontrivial.to_nonempty, λ x, function.embedding.ext fin.elim0⟩ },

  rw [nat.succ_eq_add_one, ←card_congr (equiv.embedding_congr fin_sum_fin_equiv (equiv.refl β)),
    card_congr equiv.sum_embedding_equiv_sigma_embedding_restricted],
  -- these `rw`s create goals for instances, which it doesn't infer for some reason
  all_goals { try { apply_instance } },
  -- however, this needs to be done here instead of at the end
  -- else, a later `simp`, which depends on the `fintype` instance, won't work.

  have : ∀ (f : fin n ↪ β), ‖fin 1 ↪ ((set.range f)ᶜ : set β)‖ = ‖β‖ - n,
  { intro f,
    rw card_embedding_eq_of_unique,
    rw card_of_finset' (finset.map f finset.univ)ᶜ,
    { rw [finset.card_compl, finset.card_map, finset.card_fin] },
    { simp } },

  -- putting `card_sigma` in `simp` causes it to not fully simplify
  rw card_sigma,
  simp only [this, finset.sum_const, finset.card_univ, nsmul_eq_mul, nat.cast_id],

  replace h := (nat.lt_of_succ_le h).le,
  rw [nat.desc_factorial_succ, hn h, mul_comm]
end

/- Establishes the cardinality of the type of all injections between two finite types. -/
@[simp] theorem card_embedding_eq {α β} [fintype α] [fintype β] [decidable_eq α] [decidable_eq β] :
‖α ↪ β‖ = (‖β‖.desc_factorial ‖α‖) :=
begin
  obtain h | h := lt_or_ge (‖β‖) (‖α‖),
  { rw [card_eq_zero_iff.mpr (function.embedding.is_empty_of_card_lt h),
        nat.desc_factorial_eq_zero_iff_lt.mpr h] },
  { trunc_cases fintype.trunc_equiv_fin α with eq,
    rw fintype.card_congr (equiv.embedding_congr eq (equiv.refl β)),
    exact card_embedding_aux h }
end

/- The cardinality of embeddings from an infinite type to a finite type is zero.
This is a re-statement of the pigeonhole principle. -/
@[simp] lemma card_embedding_eq_of_infinite {α β} [infinite α] [fintype β] : ‖α ↪ β‖ = 0 :=
card_eq_zero_iff.mpr function.embedding.is_empty

end fintype


import algebra.big_operators.basic
import algebra.big_operators.nat_antidiagonal
import algebra.big_operators.ring
import data.finset.nat_antidiagonal
import data.real.basic
import tactic

namespace OSK2002_5

open_locale big_operators

-- Lemma by Eric Wieser from the Xena Project Discord
lemma pow_sub_pow {R} [ring R] {a b : R} (h : commute a b) {n : ℕ} :
  a^n.succ - b^n.succ = (a - b) * ∑ x in finset.nat.antidiagonal n, a^x.1 * b^x.2 :=
begin
  rw [sub_mul, sub_eq_sub_iff_add_eq_add, finset.mul_sum, finset.mul_sum],
  simp_rw [(h.symm.pow_right _).left_comm, ←mul_assoc a, ←pow_succ],
  transitivity ∑ x in finset.nat.antidiagonal n.succ, a^x.1 * b^x.2,
  { rw [finset.nat.sum_antidiagonal_succ', pow_zero, mul_one], },
  { rw [finset.nat.sum_antidiagonal_succ, pow_zero, one_mul, add_comm] },
end

lemma cube_sub_cube {a b : ℝ} : a^3 - b^3 = (a - b) * (a^2 + a * b + b^2) := by ring

-- Added hypothesis that a ≠ 0 that's missing from the original statement
theorem osk2002_5 {a : ℝ} (h : a ≠ 0) : a^3 - a^(-3 : ℤ) = (a - (1 / a)) * (a^2 + 1 + (1 / a^2)) :=
begin
  rw zpow_neg,
  rw ← inv_zpow,
  rw inv_eq_one_div,
  norm_cast,
  rw ← one_div_pow,
  have h1 : 1 = a * (1 / a),
  { rw mul_one_div,
    rw div_self,
    exact h,},
  nth_rewrite_rhs 1 h1,
  rw cube_sub_cube,
end

end OSK2002_5


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import number_theory.padics.padic_val

/-!
# p-adic norm

This file defines the p-adic norm on ℚ.

The p-adic valuation on ℚ is the difference of the multiplicities of `p` in the numerator and
denominator of `q`. This function obeys the standard properties of a valuation, with the appropriate
assumptions on p.

The valuation induces a norm on ℚ. This norm is a nonarchimedean absolute value.
It takes values in {0} ∪ {1/p^k | k ∈ ℤ}.

## Notations

This file uses the local notation `/.` for `rat.mk`.

## Implementation notes

Much, but not all, of this file assumes that `p` is prime. This assumption is inferred automatically
by taking `[fact (prime p)]` as a type class argument.

## References

* [F. Q. Gouvêa, *p-adic numbers*][gouvea1997]
* [R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019]
* <https://en.wikipedia.org/wiki/P-adic_number>

## Tags

p-adic, p adic, padic, norm, valuation
-/

/--
If `q ≠ 0`, the p-adic norm of a rational `q` is `p ^ (-(padic_val_rat p q))`.
If `q = 0`, the p-adic norm of `q` is 0.
-/
def padic_norm (p : ℕ) (q : ℚ) : ℚ :=
if q = 0 then 0 else (↑p : ℚ) ^ (-(padic_val_rat p q))

namespace padic_norm

section padic_norm
open padic_val_rat
variables (p : ℕ)

/-- Unfolds the definition of the p-adic norm of `q` when `q ≠ 0`. -/
@[simp] protected lemma eq_zpow_of_nonzero {q : ℚ} (hq : q ≠ 0) :
  padic_norm p q = p ^ (-(padic_val_rat p q)) :=
by simp [hq, padic_norm]

/-- The p-adic norm is nonnegative. -/
protected lemma nonneg (q : ℚ) : 0 ≤ padic_norm p q :=
if hq : q = 0 then by simp [hq, padic_norm]
else
  begin
    unfold padic_norm; split_ifs,
    apply zpow_nonneg,
    exact_mod_cast nat.zero_le _
  end

/-- The p-adic norm of 0 is 0. -/
@[simp] protected lemma zero : padic_norm p 0 = 0 := by simp [padic_norm]

/-- The p-adic norm of 1 is 1. -/
@[simp] protected lemma one : padic_norm p 1 = 1 := by simp [padic_norm]

/--
The p-adic norm of `p` is `1/p` if `p > 1`.

See also `padic_norm.padic_norm_p_of_prime` for a version that assumes `p` is prime.
-/
lemma padic_norm_p {p : ℕ} (hp : 1 < p) : padic_norm p p = 1 / p :=
by simp [padic_norm, (pos_of_gt hp).ne', padic_val_nat.self hp]

/--
The p-adic norm of `p` is `1/p` if `p` is prime.

See also `padic_norm.padic_norm_p` for a version that assumes `1 < p`.
-/
@[simp] lemma padic_norm_p_of_prime (p : ℕ) [fact p.prime] : padic_norm p p = 1 / p :=
padic_norm_p $ nat.prime.one_lt (fact.out _)

/-- The p-adic norm of `q` is `1` if `q` is prime and not equal to `p`. -/
lemma padic_norm_of_prime_of_ne {p q : ℕ} [p_prime : fact p.prime] [q_prime : fact q.prime]
  (neq : p ≠ q) : padic_norm p q = 1 :=
begin
  have p : padic_val_rat p q = 0,
  { exact_mod_cast @padic_val_nat_primes p q p_prime q_prime neq },
  simp [padic_norm, p, q_prime.1.1, q_prime.1.ne_zero],
end

/--
The p-adic norm of `p` is less than 1 if `1 < p`.

See also `padic_norm.padic_norm_p_lt_one_of_prime` for a version assuming `prime p`.
-/
lemma padic_norm_p_lt_one {p : ℕ} (hp : 1 < p) : padic_norm p p < 1 :=
begin
  rw [padic_norm_p hp, div_lt_iff, one_mul],
  { exact_mod_cast hp },
  { exact_mod_cast zero_lt_one.trans hp },
end

/--
The p-adic norm of `p` is less than 1 if `p` is prime.

See also `padic_norm.padic_norm_p_lt_one` for a version assuming `1 < p`.
-/
lemma padic_norm_p_lt_one_of_prime (p : ℕ) [fact p.prime] : padic_norm p p < 1 :=
padic_norm_p_lt_one $ nat.prime.one_lt (fact.out _)

/-- `padic_norm p q` takes discrete values `p ^ -z` for `z : ℤ`. -/
protected theorem values_discrete {q : ℚ} (hq : q ≠ 0) : ∃ z : ℤ, padic_norm p q = p ^ (-z) :=
⟨ (padic_val_rat p q), by simp [padic_norm, hq] ⟩

/-- `padic_norm p` is symmetric. -/
@[simp] protected lemma neg (q : ℚ) : padic_norm p (-q) = padic_norm p q :=
if hq : q = 0 then by simp [hq]
else by simp [padic_norm, hq]

variable [hp : fact p.prime]
include hp

/-- If `q ≠ 0`, then `padic_norm p q ≠ 0`. -/
protected lemma nonzero {q : ℚ} (hq : q ≠ 0) : padic_norm p q ≠ 0 :=
begin
  rw padic_norm.eq_zpow_of_nonzero p hq,
  apply zpow_ne_zero_of_ne_zero,
  exact_mod_cast ne_of_gt hp.1.pos
end

/-- If the p-adic norm of `q` is 0, then `q` is 0. -/
lemma zero_of_padic_norm_eq_zero {q : ℚ} (h : padic_norm p q = 0) : q = 0 :=
begin
  apply by_contradiction, intro hq,
  unfold padic_norm at h, rw if_neg hq at h,
  apply absurd h,
  apply zpow_ne_zero_of_ne_zero,
  exact_mod_cast hp.1.ne_zero
end

/-- The p-adic norm is multiplicative. -/
@[simp] protected theorem mul (q r : ℚ) : padic_norm p (q*r) = padic_norm p q * padic_norm p r :=
if hq : q = 0 then
  by simp [hq]
else if hr : r = 0 then
  by simp [hr]
else
  have q*r ≠ 0, from mul_ne_zero hq hr,
  have (↑p : ℚ) ≠ 0, by simp [hp.1.ne_zero],
  by simp [padic_norm, *, padic_val_rat.mul, zpow_add₀ this, mul_comm]

/-- The p-adic norm respects division. -/
@[simp] protected theorem div (q r : ℚ) : padic_norm p (q / r) = padic_norm p q / padic_norm p r :=
if hr : r = 0 then by simp [hr] else
eq_div_of_mul_eq (padic_norm.nonzero _ hr) (by rw [←padic_norm.mul, div_mul_cancel _ hr])

/-- The p-adic norm of an integer is at most 1. -/
protected theorem of_int (z : ℤ) : padic_norm p ↑z ≤ 1 :=
if hz : z = 0 then by simp [hz, zero_le_one] else
begin
  unfold padic_norm,
  rw [if_neg _],
  { refine zpow_le_one_of_nonpos _ _,
    { exact_mod_cast le_of_lt hp.1.one_lt, },
    { rw [padic_val_rat.of_int, neg_nonpos],
      norm_cast, simp }},
  exact_mod_cast hz,
end

private lemma nonarchimedean_aux {q r : ℚ} (h : padic_val_rat p q ≤ padic_val_rat p r) :
  padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) :=
have hnqp : padic_norm p q ≥ 0, from padic_norm.nonneg _ _,
have hnrp : padic_norm p r ≥ 0, from padic_norm.nonneg _ _,
if hq : q = 0 then
  by simp [hq, max_eq_right hnrp, le_max_right]
else if hr : r = 0 then
  by simp [hr, max_eq_left hnqp, le_max_left]
else if hqr : q + r = 0 then
  le_trans (by simpa [hqr] using hnqp) (le_max_left _ _)
else
  begin
    unfold padic_norm, split_ifs,
    apply le_max_iff.2,
    left,
    apply zpow_le_of_le,
    { exact_mod_cast le_of_lt hp.1.one_lt },
    { apply neg_le_neg,
      have : padic_val_rat p q =
              min (padic_val_rat p q) (padic_val_rat p r),
        from (min_eq_left h).symm,
      rw this,
      apply min_le_padic_val_rat_add; assumption }
  end

/--
The p-adic norm is nonarchimedean: the norm of `p + q` is at most the max of the norm of `p` and
the norm of `q`.
-/
protected theorem nonarchimedean {q r : ℚ} :
  padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) :=
begin
    wlog hle := le_total (padic_val_rat p q) (padic_val_rat p r) using [q r],
    exact nonarchimedean_aux p hle
end

/--
The p-adic norm respects the triangle inequality: the norm of `p + q` is at most the norm of `p`
plus the norm of `q`.
-/
theorem triangle_ineq (q r : ℚ) : padic_norm p (q + r) ≤ padic_norm p q + padic_norm p r :=
calc padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) : padic_norm.nonarchimedean p
                       ... ≤ padic_norm p q + padic_norm p r :
                         max_le_add_of_nonneg (padic_norm.nonneg p _) (padic_norm.nonneg p _)

/--
The p-adic norm of a difference is at most the max of each component. Restates the archimedean
property of the p-adic norm.
-/
protected theorem sub {q r : ℚ} : padic_norm p (q - r) ≤ max (padic_norm p q) (padic_norm p r) :=
by rw [sub_eq_add_neg, ←padic_norm.neg p r]; apply padic_norm.nonarchimedean

/--
If the p-adic norms of `q` and `r` are different, then the norm of `q + r` is equal to the max of
the norms of `q` and `r`.
-/
lemma add_eq_max_of_ne {q r : ℚ} (hne : padic_norm p q ≠ padic_norm p r) :
  padic_norm p (q + r) = max (padic_norm p q) (padic_norm p r) :=
begin
  wlog hle := le_total (padic_norm p r) (padic_norm p q) using [q r],
  have hlt : padic_norm p r < padic_norm p q, from lt_of_le_of_ne hle hne.symm,
  have : padic_norm p q ≤ max (padic_norm p (q + r)) (padic_norm p r), from calc
   padic_norm p q = padic_norm p (q + r - r) : by congr; ring
               ... ≤ max (padic_norm p (q + r)) (padic_norm p (-r)) : padic_norm.nonarchimedean p
               ... = max (padic_norm p (q + r)) (padic_norm p r) : by simp,
  have hnge : padic_norm p r ≤ padic_norm p (q + r),
  { apply le_of_not_gt,
    intro hgt,
    rw max_eq_right_of_lt hgt at this,
    apply not_lt_of_ge this,
    assumption },
  have : padic_norm p q ≤ padic_norm p (q + r), by rwa [max_eq_left hnge] at this,
  apply _root_.le_antisymm,
  { apply padic_norm.nonarchimedean p },
  { rw max_eq_left_of_lt hlt,
    assumption }
end

/--
The p-adic norm is an absolute value: positive-definite and multiplicative, satisfying the triangle
inequality.
-/
instance : is_absolute_value (padic_norm p) :=
{ abv_nonneg := padic_norm.nonneg p,
  abv_eq_zero :=
    begin
      intros,
      constructor; intro,
      { apply zero_of_padic_norm_eq_zero p, assumption },
      { simp [*] }
    end,
  abv_add := padic_norm.triangle_ineq p,
  abv_mul := padic_norm.mul p }

variable {p}

lemma dvd_iff_norm_le {n : ℕ} {z : ℤ} : ↑(p^n) ∣ z ↔ padic_norm p z ≤ ↑p ^ (-n : ℤ) :=
begin
  unfold padic_norm, split_ifs with hz,
  { norm_cast at hz,
    have : 0 ≤ (p^n : ℚ), {apply pow_nonneg, exact_mod_cast le_of_lt hp.1.pos },
    simp [hz, this] },
  { rw [zpow_le_iff_le, neg_le_neg_iff, padic_val_rat.of_int,
      padic_val_int.of_ne_one_ne_zero hp.1.ne_one _],
    { norm_cast,
      rw [← enat.coe_le_coe, enat.coe_get, ← multiplicity.pow_dvd_iff_le_multiplicity],
      simp },
    { exact_mod_cast hz },
    { exact_mod_cast hp.1.one_lt } }
end

end padic_norm
end padic_norm


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

! This file was ported from Lean 3 source module ring_theory.polynomial.content
! leanprover-community/mathlib commit 7a030ab8eb5d99f05a891dccc49c5b5b90c947d3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.GCDMonoid.Finset
import Mathlib.Data.Polynomial.FieldDivision
import Mathlib.Data.Polynomial.EraseLead
import Mathlib.Data.Polynomial.CancelLeads

/-!
# GCD structures on polynomials

Definitions and basic results about polynomials over GCD domains, particularly their contents
and primitive polynomials.

## Main Definitions
Let `p : R[X]`.
 - `p.content` is the `gcd` of the coefficients of `p`.
 - `p.IsPrimitive` indicates that `p.content = 1`.

## Main Results
 - `Polynomial.content_mul`:
  If `p q : R[X]`, then `(p * q).content = p.content * q.content`.
 - `Polynomial.NormalizedGcdMonoid`:
  The polynomial ring of a GCD domain is itself a GCD domain.

-/

namespace Polynomial

open Polynomial

section Primitive

variable {R : Type _} [CommSemiring R]

/-- A polynomial is primitive when the only constant polynomials dividing it are units -/
def IsPrimitive (p : R[X]) : Prop :=
  ∀ r : R, C r ∣ p → IsUnit r
#align polynomial.is_primitive Polynomial.IsPrimitive

theorem isPrimitive_iff_isUnit_of_c_dvd {p : R[X]} : p.IsPrimitive ↔ ∀ r : R, C r ∣ p → IsUnit r :=
  Iff.rfl
set_option linter.uppercaseLean3 false in
#align polynomial.is_primitive_iff_is_unit_of_C_dvd Polynomial.isPrimitive_iff_isUnit_of_c_dvd

@[simp]
theorem isPrimitive_one : IsPrimitive (1 : R[X]) := fun _ h =>
  isUnit_C.mp (isUnit_of_dvd_one h)
#align polynomial.is_primitive_one Polynomial.isPrimitive_one

theorem Monic.isPrimitive {p : R[X]} (hp : p.Monic) : p.IsPrimitive := by
  rintro r ⟨q, h⟩
  exact isUnit_of_mul_eq_one r (q.coeff p.natDegree) (by rwa [← coeff_C_mul, ← h])
#align polynomial.monic.is_primitive Polynomial.Monic.isPrimitive

theorem IsPrimitive.ne_zero [Nontrivial R] {p : R[X]} (hp : p.IsPrimitive) : p ≠ 0 := by
  rintro rfl
  exact (hp 0 (dvd_zero (C 0))).ne_zero rfl
#align polynomial.is_primitive.ne_zero Polynomial.IsPrimitive.ne_zero

theorem isPrimitive_of_dvd {p q : R[X]} (hp : IsPrimitive p) (hq : q ∣ p) : IsPrimitive q :=
  fun a ha => isPrimitive_iff_isUnit_of_c_dvd.mp hp a (dvd_trans ha hq)
#align polynomial.is_primitive_of_dvd Polynomial.isPrimitive_of_dvd

end Primitive

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

section NormalizedGCDMonoid

variable [NormalizedGCDMonoid R]

/-- `p.content` is the `gcd` of the coefficients of `p`. -/
def content (p : R[X]) : R :=
  p.support.gcd p.coeff
#align polynomial.content Polynomial.content

theorem content_dvd_coeff {p : R[X]} (n : ℕ) : p.content ∣ p.coeff n := by
  by_cases h : n ∈ p.support
  · apply Finset.gcd_dvd h
  rw [mem_support_iff, Classical.not_not] at h
  rw [h]
  apply dvd_zero
#align polynomial.content_dvd_coeff Polynomial.content_dvd_coeff

@[simp]
theorem content_C {r : R} : (C r).content = normalize r := by
  rw [content]
  by_cases h0 : r = 0
  · simp [h0]
  have h : (C r).support = {0} := support_monomial _ h0
  simp [h]
set_option linter.uppercaseLean3 false in
#align polynomial.content_C Polynomial.content_C

@[simp]
theorem content_zero : content (0 : R[X]) = 0 := by rw [← C_0, content_C, normalize_zero]
#align polynomial.content_zero Polynomial.content_zero

@[simp]
theorem content_one : content (1 : R[X]) = 1 := by rw [← C_1, content_C, normalize_one]
#align polynomial.content_one Polynomial.content_one

theorem content_X_mul {p : R[X]} : content (X * p) = content p := by
  rw [content, content, Finset.gcd_def, Finset.gcd_def]
  refine' congr rfl _
  have h : (X * p).support = p.support.map ⟨Nat.succ, Nat.succ_injective⟩ :=
    by
    ext a
    simp only [exists_prop, Finset.mem_map, Function.Embedding.coeFn_mk, Ne.def, mem_support_iff]
    cases' a with a
    · simp [coeff_X_mul_zero, Nat.succ_ne_zero]
    rw [mul_comm, coeff_mul_X]
    constructor
    · intro h
      use a
      simp [h]
    · rintro ⟨b, ⟨h1, h2⟩⟩
      rw [← Nat.succ_injective h2]
      apply h1
  rw [h]
  simp only [Finset.map_val, Function.comp_apply, Function.Embedding.coeFn_mk, Multiset.map_map]
  refine' congr (congr rfl _) rfl
  ext a
  rw [mul_comm]
  simp [coeff_mul_X]
set_option linter.uppercaseLean3 false in
#align polynomial.content_X_mul Polynomial.content_X_mul

@[simp]
theorem content_X_pow {k : ℕ} : content ((X : R[X]) ^ k) = 1 := by
  induction' k with k hi
  · simp
  rw [pow_succ, content_X_mul, hi]
set_option linter.uppercaseLean3 false in
#align polynomial.content_X_pow Polynomial.content_X_pow

@[simp]
theorem content_X : content (X : R[X]) = 1 := by rw [← mul_one X, content_X_mul, content_one]
set_option linter.uppercaseLean3 false in
#align polynomial.content_X Polynomial.content_X

theorem content_C_mul (r : R) (p : R[X]) : (C r * p).content = normalize r * p.content := by
  by_cases h0 : r = 0; · simp [h0]
  rw [content]; rw [content]; rw [← Finset.gcd_mul_left]
  refine' congr (congr rfl _) _ <;> ext <;> simp [h0, mem_support_iff]
set_option linter.uppercaseLean3 false in
#align polynomial.content_C_mul Polynomial.content_C_mul

@[simp]
theorem content_monomial {r : R} {k : ℕ} : content (monomial k r) = normalize r := by
  rw [← C_mul_X_pow_eq_monomial, content_C_mul, content_X_pow, mul_one]
#align polynomial.content_monomial Polynomial.content_monomial

theorem content_eq_zero_iff {p : R[X]} : content p = 0 ↔ p = 0 := by
  rw [content, Finset.gcd_eq_zero_iff]
  constructor <;> intro h
  · ext n
    by_cases h0 : n ∈ p.support
    · rw [h n h0, coeff_zero]
    · rw [mem_support_iff] at h0
      push_neg  at h0
      simp [h0]
  · intro x
    simp [h]
#align polynomial.content_eq_zero_iff Polynomial.content_eq_zero_iff

-- Porting note: this reduced with simp so created `normUnit_content` and put simp on it
theorem normalize_content {p : R[X]} : normalize p.content = p.content :=
  Finset.normalize_gcd
#align polynomial.normalize_content Polynomial.normalize_content

@[simp]
theorem normUnit_content {p : R[X]} : normUnit (content p) = 1 := by
  by_cases hp0 : p.content = 0
  . simp [hp0]
  . ext
    apply mul_left_cancel₀ hp0
    erw [← normalize_apply, normalize_content, mul_one]

theorem content_eq_gcd_range_of_lt (p : R[X]) (n : ℕ) (h : p.natDegree < n) :
    p.content = (Finset.range n).gcd p.coeff := by
  apply dvd_antisymm_of_normalize_eq normalize_content Finset.normalize_gcd
  · rw [Finset.dvd_gcd_iff]
    intro i _
    apply content_dvd_coeff _
  · apply Finset.gcd_mono
    intro i
    simp only [Nat.lt_succ_iff, mem_support_iff, Ne.def, Finset.mem_range]
    contrapose!
    intro h1
    apply coeff_eq_zero_of_natDegree_lt (lt_of_lt_of_le h h1)
#align polynomial.content_eq_gcd_range_of_lt Polynomial.content_eq_gcd_range_of_lt

theorem content_eq_gcd_range_succ (p : R[X]) :
    p.content = (Finset.range p.natDegree.succ).gcd p.coeff :=
  content_eq_gcd_range_of_lt _ _ (Nat.lt_succ_self _)
#align polynomial.content_eq_gcd_range_succ Polynomial.content_eq_gcd_range_succ

theorem content_eq_gcd_leadingCoeff_content_eraseLead (p : R[X]) :
    p.content = GCDMonoid.gcd p.leadingCoeff (eraseLead p).content := by
  by_cases h : p = 0
  · simp [h]
  rw [← leadingCoeff_eq_zero, leadingCoeff, ← Ne.def, ← mem_support_iff] at h
  rw [content, ← Finset.insert_erase h, Finset.gcd_insert, leadingCoeff, content,
    eraseLead_support]
  refine' congr rfl (Finset.gcd_congr rfl fun i hi => _)
  rw [Finset.mem_erase] at hi
  rw [eraseLead_coeff, if_neg hi.1]
#align polynomial.content_eq_gcd_leading_coeff_content_erase_lead Polynomial.content_eq_gcd_leadingCoeff_content_eraseLead

theorem dvd_content_iff_C_dvd {p : R[X]} {r : R} : r ∣ p.content ↔ C r ∣ p := by
  rw [C_dvd_iff_dvd_coeff]
  constructor
  · intro h i
    apply h.trans (content_dvd_coeff _)
  · intro h
    rw [content, Finset.dvd_gcd_iff]
    intro i _
    apply h i
set_option linter.uppercaseLean3 false in
#align polynomial.dvd_content_iff_C_dvd Polynomial.dvd_content_iff_C_dvd

theorem C_content_dvd (p : R[X]) : C p.content ∣ p :=
  dvd_content_iff_C_dvd.1 dvd_rfl
set_option linter.uppercaseLean3 false in
#align polynomial.C_content_dvd Polynomial.C_content_dvd

theorem isPrimitive_iff_content_eq_one {p : R[X]} : p.IsPrimitive ↔ p.content = 1 := by
  rw [← normalize_content, normalize_eq_one, IsPrimitive]
  simp_rw [← dvd_content_iff_C_dvd]
  exact ⟨fun h => h p.content (dvd_refl p.content), fun h r hdvd => isUnit_of_dvd_unit hdvd h⟩
#align polynomial.is_primitive_iff_content_eq_one Polynomial.isPrimitive_iff_content_eq_one

theorem IsPrimitive.content_eq_one {p : R[X]} (hp : p.IsPrimitive) : p.content = 1 :=
  isPrimitive_iff_content_eq_one.mp hp
#align polynomial.is_primitive.content_eq_one Polynomial.IsPrimitive.content_eq_one

open Classical

section PrimPart

/-- The primitive part of a polynomial `p` is the primitive polynomial gained by dividing `p` by
  `p.content`. If `p = 0`, then `p.primPart = 1`.  -/
noncomputable def primPart (p : R[X]) : R[X] :=
  if p = 0 then 1 else Classical.choose (C_content_dvd p)
#align polynomial.prim_part Polynomial.primPart

theorem eq_C_content_mul_primPart (p : R[X]) : p = C p.content * p.primPart := by
  by_cases h : p = 0; · simp [h]
  rw [primPart, if_neg h, ← Classical.choose_spec (C_content_dvd p)]
set_option linter.uppercaseLean3 false in
#align polynomial.eq_C_content_mul_prim_part Polynomial.eq_C_content_mul_primPart

@[simp]
theorem primPart_zero : primPart (0 : R[X]) = 1 :=
  if_pos rfl
#align polynomial.prim_part_zero Polynomial.primPart_zero

theorem isPrimitive_primPart (p : R[X]) : p.primPart.IsPrimitive := by
  by_cases h : p = 0; · simp [h]
  rw [← content_eq_zero_iff] at h
  rw [isPrimitive_iff_content_eq_one]
  apply mul_left_cancel₀ h
  conv_rhs => rw [p.eq_C_content_mul_primPart, mul_one, content_C_mul, normalize_content]
#align polynomial.is_primitive_prim_part Polynomial.isPrimitive_primPart

theorem content_primPart (p : R[X]) : p.primPart.content = 1 :=
  p.isPrimitive_primPart.content_eq_one
#align polynomial.content_prim_part Polynomial.content_primPart

theorem natDegree_primPart (p : R[X]) : p.primPart.natDegree = p.natDegree := by
  by_cases h : C p.content = 0
  · rw [C_eq_zero, content_eq_zero_iff] at h
    simp [h]
  conv_rhs =>
    rw [p.eq_C_content_mul_primPart, natDegree_mul h p.primPart_ne_zero, natDegree_C, zero_add]
#align polynomial.nat_degree_prim_part Polynomial.natDegree_primPart

@[simp]
theorem IsPrimitive.primPart_eq {p : R[X]} (hp : p.IsPrimitive) : p.primPart = p := by
  rw [← one_mul p.primPart, ← C_1, ← hp.content_eq_one, ← p.eq_C_content_mul_primPart]
#align polynomial.is_primitive.prim_part_eq Polynomial.IsPrimitive.primPart_eq

theorem isUnit_primPart_C (r : R) : IsUnit (C r).primPart := by
  by_cases h0 : r = 0
  · simp [h0]
  unfold IsUnit
  refine'
    ⟨⟨C ↑(normUnit r)⁻¹, C ↑(normUnit r), by rw [← RingHom.map_mul, Units.inv_mul, C_1], by
        rw [← RingHom.map_mul, Units.mul_inv, C_1]⟩,
      _⟩
  rw [← normalize_eq_zero, ← C_eq_zero] at h0
  apply mul_left_cancel₀ h0
  conv_rhs => rw [← content_C, ← (C r).eq_C_content_mul_primPart]
  simp only [Units.val_mk, normalize_apply, RingHom.map_mul]
  rw [mul_assoc, ← RingHom.map_mul, Units.mul_inv, C_1, mul_one]
set_option linter.uppercaseLean3 false in
#align polynomial.is_unit_prim_part_C Polynomial.isUnit_primPart_C

theorem primPart_dvd (p : R[X]) : p.primPart ∣ p :=
  Dvd.intro_left (C p.content) p.eq_C_content_mul_primPart.symm
#align polynomial.prim_part_dvd Polynomial.primPart_dvd

theorem aeval_primPart_eq_zero {S : Type _} [Ring S] [IsDomain S] [Algebra R S]
    [NoZeroSMulDivisors R S] {p : R[X]} {s : S} (hpzero : p ≠ 0) (hp : aeval s p = 0) :
    aeval s p.primPart = 0 := by
  rw [eq_C_content_mul_primPart p, map_mul, aeval_C] at hp
  have hcont : p.content ≠ 0 := fun h => hpzero (content_eq_zero_iff.1 h)
  replace hcont := Function.Injective.ne (NoZeroSMulDivisors.algebraMap_injective R S) hcont
  rw [map_zero] at hcont
  exact eq_zero_of_ne_zero_of_mul_left_eq_zero hcont hp
#align polynomial.aeval_prim_part_eq_zero Polynomial.aeval_primPart_eq_zero

theorem eval₂_primPart_eq_zero {S : Type _} [CommRing S] [IsDomain S] {f : R →+* S}
    (hinj : Function.Injective f) {p : R[X]} {s : S} (hpzero : p ≠ 0) (hp : eval₂ f s p = 0) :
    eval₂ f s p.primPart = 0 := by
  rw [eq_C_content_mul_primPart p, eval₂_mul, eval₂_C] at hp
  have hcont : p.content ≠ 0 := fun h => hpzero (content_eq_zero_iff.1 h)
  replace hcont := Function.Injective.ne hinj hcont
  rw [map_zero] at hcont
  exact eq_zero_of_ne_zero_of_mul_left_eq_zero hcont hp
#align polynomial.eval₂_prim_part_eq_zero Polynomial.eval₂_primPart_eq_zero

end PrimPart

theorem gcd_content_eq_of_dvd_sub {a : R} {p q : R[X]} (h : C a ∣ p - q) :
    GCDMonoid.gcd a p.content = GCDMonoid.gcd a q.content := by
  rw [content_eq_gcd_range_of_lt p (max p.natDegree q.natDegree).succ
      (lt_of_le_of_lt (le_max_left _ _) (Nat.lt_succ_self _))]
  rw [content_eq_gcd_range_of_lt q (max p.natDegree q.natDegree).succ
      (lt_of_le_of_lt (le_max_right _ _) (Nat.lt_succ_self _))]
  apply Finset.gcd_eq_of_dvd_sub
  intro x _
  cases' h with w hw
  use w.coeff x
  rw [← coeff_sub, hw, coeff_C_mul]
#align polynomial.gcd_content_eq_of_dvd_sub Polynomial.gcd_content_eq_of_dvd_sub

theorem content_mul_aux {p q : R[X]} :
    GCDMonoid.gcd (p * q).eraseLead.content p.leadingCoeff =
      GCDMonoid.gcd (p.eraseLead * q).content p.leadingCoeff := by
  rw [gcd_comm (content _) _, gcd_comm (content _) _]
  apply gcd_content_eq_of_dvd_sub
  rw [← self_sub_C_mul_X_pow, ← self_sub_C_mul_X_pow, sub_mul, sub_sub, add_comm, sub_add,
    sub_sub_cancel, leadingCoeff_mul, RingHom.map_mul, mul_assoc, mul_assoc]
  apply dvd_sub (Dvd.intro _ rfl) (Dvd.intro _ rfl)
#align polynomial.content_mul_aux Polynomial.content_mul_aux

@[simp]
theorem content_mul {p q : R[X]} : (p * q).content = p.content * q.content := by
  classical
    suffices h :
      ∀ (n : ℕ) (p q : R[X]), (p * q).degree < n → (p * q).content = p.content * q.content
    · apply h
      apply lt_of_le_of_lt degree_le_natDegree (WithBot.coe_lt_coe.2 (Nat.lt_succ_self _))
    intro n
    induction' n with n ih
    · intro p q hpq
      dsimp at hpq
      rw [Nat.cast_withBot, WithBot.coe_zero,
        Nat.WithBot.lt_zero_iff, degree_eq_bot, mul_eq_zero] at hpq
      rcases hpq with (rfl | rfl) <;> simp
    intro p q hpq
    by_cases p0 : p = 0
    · simp [p0]
    by_cases q0 : q = 0
    · simp [q0]
    rw [degree_eq_natDegree (mul_ne_zero p0 q0), Nat.cast_withBot,
      Nat.cast_withBot, WithBot.coe_lt_coe, Nat.lt_succ_iff_lt_or_eq, ←
      WithBot.coe_lt_coe, ←Nat.cast_withBot, ← degree_eq_natDegree (mul_ne_zero p0 q0),
      natDegree_mul p0 q0] at hpq
    rcases hpq with (hlt | heq)
    · apply ih _ _ hlt
    rw [← p.natDegree_primPart, ← q.natDegree_primPart, ← WithBot.coe_eq_coe,
      WithBot.coe_add, ← Nat.cast_withBot, ←degree_eq_natDegree p.primPart_ne_zero,
      ← Nat.cast_withBot, ← degree_eq_natDegree q.primPart_ne_zero] at heq
    rw [p.eq_C_content_mul_primPart, q.eq_C_content_mul_primPart]
    suffices h : (q.primPart * p.primPart).content = 1
    ·
      rw [mul_assoc, content_C_mul, content_C_mul, mul_comm p.primPart, mul_assoc, content_C_mul,
        content_C_mul, h, mul_one, content_primPart, content_primPart, mul_one, mul_one]
    rw [← normalize_content, normalize_eq_one, isUnit_iff_dvd_one,
      content_eq_gcd_leadingCoeff_content_eraseLead, leadingCoeff_mul, gcd_comm]
    apply (gcd_mul_dvd_mul_gcd _ _ _).trans
    rw [content_mul_aux, ih, content_primPart, mul_one, gcd_comm, ←
      content_eq_gcd_leadingCoeff_content_eraseLead, content_primPart, one_mul,
      mul_comm q.primPart, content_mul_aux, ih, content_primPart, mul_one, gcd_comm, ←
      content_eq_gcd_leadingCoeff_content_eraseLead, content_primPart]
    · rw [Nat.cast_withBot, ← heq, degree_mul, WithBot.add_lt_add_iff_right]
      · apply degree_erase_lt p.primPart_ne_zero
      · rw [Ne.def, degree_eq_bot]
        apply q.primPart_ne_zero
    · rw [mul_comm, Nat.cast_withBot, ← heq, degree_mul, WithBot.add_lt_add_iff_left]
      · apply degree_erase_lt q.primPart_ne_zero
      · rw [Ne.def, degree_eq_bot]
        apply p.primPart_ne_zero
#align polynomial.content_mul Polynomial.content_mul

theorem IsPrimitive.mul {p q : R[X]} (hp : p.IsPrimitive) (hq : q.IsPrimitive) :
    (p * q).IsPrimitive := by
  rw [isPrimitive_iff_content_eq_one, content_mul, hp.content_eq_one, hq.content_eq_one, mul_one]
#align polynomial.is_primitive.mul Polynomial.IsPrimitive.mul

@[simp]
theorem primPart_mul {p q : R[X]} (h0 : p * q ≠ 0) : (p * q).primPart = p.primPart * q.primPart :=
  by
  rw [Ne.def, ← content_eq_zero_iff, ← C_eq_zero] at h0
  apply mul_left_cancel₀ h0
  conv_lhs =>
    rw [← (p * q).eq_C_content_mul_primPart, p.eq_C_content_mul_primPart,
      q.eq_C_content_mul_primPart]
  rw [content_mul, RingHom.map_mul]
  ring
#align polynomial.prim_part_mul Polynomial.primPart_mul

theorem IsPrimitive.dvd_primPart_iff_dvd {p q : R[X]} (hp : p.IsPrimitive) (hq : q ≠ 0) :
    p ∣ q.primPart ↔ p ∣ q := by
  refine' ⟨fun h => h.trans (Dvd.intro_left _ q.eq_C_content_mul_primPart.symm), fun h => _⟩
  rcases h with ⟨r, rfl⟩
  apply Dvd.intro _
  rw [primPart_mul hq, hp.primPart_eq]
#align polynomial.is_primitive.dvd_prim_part_iff_dvd Polynomial.IsPrimitive.dvd_primPart_iff_dvd

theorem exists_primitive_lcm_of_isPrimitive {p q : R[X]} (hp : p.IsPrimitive) (hq : q.IsPrimitive) :
    ∃ r : R[X], r.IsPrimitive ∧ ∀ s : R[X], p ∣ s ∧ q ∣ s ↔ r ∣ s := by
  classical
    have h : ∃ (n : ℕ)(r : R[X]), r.natDegree = n ∧ r.IsPrimitive ∧ p ∣ r ∧ q ∣ r :=
      ⟨(p * q).natDegree, p * q, rfl, hp.mul hq, dvd_mul_right _ _, dvd_mul_left _ _⟩
    rcases Nat.find_spec h with ⟨r, rdeg, rprim, pr, qr⟩
    refine' ⟨r, rprim, fun s => ⟨_, fun rs => ⟨pr.trans rs, qr.trans rs⟩⟩⟩
    suffices hs : ∀ (n : ℕ) (s : R[X]), s.natDegree = n → p ∣ s ∧ q ∣ s → r ∣ s
    · apply hs s.natDegree s rfl
    clear s
    by_contra' con
    rcases Nat.find_spec con with ⟨s, sdeg, ⟨ps, qs⟩, rs⟩
    have s0 : s ≠ 0 := by
      contrapose! rs
      simp [rs]
    have hs :=
      Nat.find_min' h
        ⟨_, s.natDegree_primPart, s.isPrimitive_primPart, (hp.dvd_primPart_iff_dvd s0).2 ps,
          (hq.dvd_primPart_iff_dvd s0).2 qs⟩
    rw [← rdeg] at hs
    by_cases sC : s.natDegree ≤ 0
    · rw [eq_C_of_natDegree_le_zero (le_trans hs sC), isPrimitive_iff_content_eq_one, content_C,
        normalize_eq_one] at rprim
      rw [eq_C_of_natDegree_le_zero (le_trans hs sC), ← dvd_content_iff_C_dvd] at rs
      apply rs rprim.dvd
    have hcancel := natDegree_cancelLeads_lt_of_natDegree_le_natDegree hs (lt_of_not_ge sC)
    rw [sdeg] at hcancel
    apply Nat.find_min con hcancel
    refine'
      ⟨_, rfl, ⟨dvd_cancelLeads_of_dvd_of_dvd pr ps, dvd_cancelLeads_of_dvd_of_dvd qr qs⟩,
        fun rcs => rs _⟩
    rw [← rprim.dvd_primPart_iff_dvd s0]
    rw [cancelLeads, tsub_eq_zero_iff_le.mpr hs, pow_zero, mul_one] at rcs
    have h :=
      dvd_add rcs (Dvd.intro_left (C (leadingCoeff s) * X ^ (natDegree s - natDegree r)) rfl)
    have hC0 := rprim.ne_zero
    rw [Ne.def, ← leadingCoeff_eq_zero, ← C_eq_zero] at hC0
    rw [sub_add_cancel, ← rprim.dvd_primPart_iff_dvd (mul_ne_zero hC0 s0)] at h
    rcases isUnit_primPart_C r.leadingCoeff with ⟨u, hu⟩
    apply h.trans (Associated.symm ⟨u, _⟩).dvd
    rw [primPart_mul (mul_ne_zero hC0 s0), hu, mul_comm]
#align polynomial.exists_primitive_lcm_of_is_primitive Polynomial.exists_primitive_lcm_of_isPrimitive

theorem dvd_iff_content_dvd_content_and_primPart_dvd_primPart {p q : R[X]} (hq : q ≠ 0) :
    p ∣ q ↔ p.content ∣ q.content ∧ p.primPart ∣ q.primPart := by
  constructor <;> intro h
  · rcases h with ⟨r, rfl⟩
    rw [content_mul, p.isPrimitive_primPart.dvd_primPart_iff_dvd hq]
    exact ⟨Dvd.intro _ rfl, p.primPart_dvd.trans (Dvd.intro _ rfl)⟩
  · rw [p.eq_C_content_mul_primPart, q.eq_C_content_mul_primPart]
    exact mul_dvd_mul (RingHom.map_dvd C h.1) h.2
#align polynomial.dvd_iff_content_dvd_content_and_prim_part_dvd_prim_part Polynomial.dvd_iff_content_dvd_content_and_primPart_dvd_primPart

noncomputable instance (priority := 100) normalizedGcdMonoid : NormalizedGCDMonoid R[X] :=
  normalizedGCDMonoidOfExistsLCM fun p q =>
    by
    rcases exists_primitive_lcm_of_isPrimitive p.isPrimitive_primPart
        q.isPrimitive_primPart with
      ⟨r, rprim, hr⟩
    refine' ⟨C (lcm p.content q.content) * r, fun s => _⟩
    by_cases hs : s = 0
    · simp [hs]
    by_cases hpq : C (lcm p.content q.content) = 0
    · rw [C_eq_zero, lcm_eq_zero_iff, content_eq_zero_iff, content_eq_zero_iff] at hpq
      rcases hpq with (hpq | hpq) <;> simp [hpq, hs]
    iterate 3 rw [dvd_iff_content_dvd_content_and_primPart_dvd_primPart hs]
    rw [content_mul, rprim.content_eq_one, mul_one, content_C, normalize_lcm, lcm_dvd_iff,
      primPart_mul (mul_ne_zero hpq rprim.ne_zero), rprim.primPart_eq,
      IsUnit.mul_left_dvd _ _ _ (isUnit_primPart_C (lcm p.content q.content)), ← hr s.primPart]
    tauto
#align polynomial.normalized_gcd_monoid Polynomial.normalizedGcdMonoid

theorem degree_gcd_le_left {p : R[X]} (hp : p ≠ 0) (q) : (gcd p q).degree ≤ p.degree := by
  have := natDegree_le_iff_degree_le.mp (natDegree_le_of_dvd (gcd_dvd_left p q) hp)
  rwa [degree_eq_natDegree hp]
#align polynomial.degree_gcd_le_left Polynomial.degree_gcd_le_left

theorem degree_gcd_le_right (p) {q : R[X]} (hq : q ≠ 0) : (gcd p q).degree ≤ q.degree := by
  rw [gcd_comm]
  exact degree_gcd_le_left hq p
#align polynomial.degree_gcd_le_right Polynomial.degree_gcd_le_right

end NormalizedGCDMonoid

end Polynomial


/-
Copyright (c) 2021 Damiano Testa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Damiano Testa
-/
import algebraic_geometry.prime_spectrum
import ring_theory.polynomial.basic
/-!
The morphism `Spec R[x] --> Spec R` induced by the natural inclusion `R --> R[x]` is an open map.

The main result is the first part of the statement of Lemma 00FB in the Stacks Project.

https://stacks.math.columbia.edu/tag/00FB
-/

open ideal polynomial prime_spectrum set

namespace algebraic_geometry

namespace polynomial

variables {R : Type*} [comm_ring R] {f : polynomial R}

/-- Given a polynomial `f ∈ R[x]`, `image_of_Df` is the subset of `Spec R` where at least one
of the coefficients of `f` does not vanish.  Lemma `image_of_Df_eq_comap_C_compl_zero_locus`
proves that `image_of_Df` is the image of `(zero_locus {f})ᶜ` under the morphism
`comap C : Spec R[x] → Spec R`. -/
def image_of_Df (f) : set (prime_spectrum R) :=
  {p : prime_spectrum R | ∃ i : ℕ , (coeff f i) ∉ p.as_ideal}

lemma is_open_image_of_Df : is_open (image_of_Df f) :=
begin
  rw [image_of_Df, set_of_exists (λ i (x : prime_spectrum R), coeff f i ∉ x.val)],
  exact is_open_Union (λ i, is_open_basic_open),
end

/-- If a point of `Spec R[x]` is not contained in the vanishing set of `f`, then its image in
`Spec R` is contained in the open set where at least one of the coefficients of `f` is non-zero.
This lemma is a reformulation of `exists_coeff_not_mem_C_inverse`. -/
lemma comap_C_mem_image_of_Df {I : prime_spectrum (polynomial R)}
  (H : I ∈ (zero_locus {f} : set (prime_spectrum (polynomial R)))ᶜ ) :
  comap (polynomial.C : R →+* polynomial R) I ∈ image_of_Df f :=
exists_coeff_not_mem_C_inverse (mem_compl_zero_locus_iff_not_mem.mp H)

/-- The open set `image_of_Df f` coincides with the image of `basic_open f` under the
morphism `C⁺ : Spec R[x] → Spec R`. -/
lemma image_of_Df_eq_comap_C_compl_zero_locus :
  image_of_Df f = comap C '' (zero_locus {f})ᶜ :=
begin
  refine ext (λ x, ⟨λ hx, ⟨⟨map C x.val, (is_prime_map_C_of_is_prime x.property)⟩, ⟨_, _⟩⟩, _⟩),
  { rw [mem_compl_eq, mem_zero_locus, singleton_subset_iff],
    cases hx with i hi,
    exact λ a, hi (mem_map_C_iff.mp a i) },
  { refine subtype.ext (ext (λ x, ⟨λ h, _, λ h, subset_span (mem_image_of_mem C.1 h)⟩)),
    rw ← @coeff_C_zero R x _,
    exact mem_map_C_iff.mp h 0 },
  { rintro ⟨xli, complement, rfl⟩,
    exact comap_C_mem_image_of_Df complement }
end

/--  The morphism `C⁺ : Spec R[x] → Spec R` is open.
Stacks Project "Lemma 00FB", first part.

https://stacks.math.columbia.edu/tag/00FB
-/
theorem is_open_map_comap_C :
  is_open_map (comap (C : R →+* polynomial R)) :=
begin
  rintros U ⟨s, z⟩,
  rw [← compl_compl U, ← z, ← Union_of_singleton_coe s, zero_locus_Union, compl_Inter, image_Union],
  simp_rw [← image_of_Df_eq_comap_C_compl_zero_locus],
  exact is_open_Union (λ f, is_open_image_of_Df),
end

end polynomial

end algebraic_geometry


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

import tactic
import data.zmod.algebra
import number_theory.wilson

open_locale big_operators

lemma factorial_eq_prod (n : ℕ) : n.factorial = ∏ i in finset.Icc 1 n, i :=
begin
  induction n with d hd,
  { refl, },
  { rw [nat.factorial_succ, hd],
    rw finset.Icc_eq_cons_Ico (show 1 ≤ d + 1, by linarith),
    rw finset.prod_cons,
    congr', },
end

lemma wilson_theorem {p n : ℕ}
  (hp : nat.prime p)
  (hn : p = 4 * n + 1) :
     ∏ (j : ℕ) in finset.Icc 1 (4 * n), (j : zmod p) = -1 :=
begin
  have := (nat.prime_iff_fac_equiv_neg_one (_ : p ≠ 1)).1 hp,
  { rw [← this, hn],
    norm_cast,
    congr',
    simp,
    rw factorial_eq_prod,
  },
  { exact nat.prime.ne_one hp, },
end

lemma exists_sqrt_neg_one_of_one_mod_four (p : ℕ) (hp : p.prime)
  (hp2 : ∃ n, p = 4 * n + 1) : ∃ i : zmod p, i^2 = -1 :=
begin
  cases hp2 with n hn,
  set i := ∏ j in (finset.Icc 1 (2 * n)), (j : zmod p) with hi,
  have h1 : ∏ j in (finset.Icc 1 (2 * n)), (-1 : zmod p) = 1,
  { rw [finset.prod_const],
    simp only [nat.add_succ_sub_one, add_zero, nat.card_Icc],
    rw [pow_mul, neg_one_pow_two, one_pow], },
  have h2 : ∏ j in (finset.Icc 1 (2 * n)), (-j : zmod p) = i,
  { conv_lhs {
      congr, skip, funext,
      rw neg_eq_neg_one_mul,
    },
    rw [finset.prod_mul_distrib, h1, one_mul], },
  have h3 : ∏ j in (finset.Icc (2 * n + 1) (4 * n)), (j : zmod p) = i,
  { rw ←h2,
    apply finset.prod_bij' (λ j hj, p - j) _ _ (λ j hj, p - j),
    { intros,
      dsimp,
      rw finset.mem_Icc at ha,
      cases ha,
      omega, },
    { intros,
      dsimp,
      rw finset.mem_Icc at ha,
      omega, },
    { intros,
      dsimp,
      rw finset.mem_Icc at ha ⊢,
      omega, },
    { intros,
      dsimp,
      rw finset.mem_Icc at ha ⊢,
      omega, },
    { intros,
      dsimp,
      rw finset.mem_Icc at ha,
      rw eq_neg_iff_add_eq_zero,
      suffices : a + (p - a) = p,
      { norm_cast,
        simp [this], },
      omega, },
  },
  use i,
  rw pow_two,
  nth_rewrite 0 hi,
  rw ←h3,
  rw ← finset.prod_union,
  { convert_to ∏ j in finset.Icc 1 (4 * n), (j : zmod p) = -1,
    { congr',
      ext,
      rw finset.mem_union,
      simp only [finset.mem_Icc],
      omega, },
    { apply wilson_theorem hp hn, }, },
  { rw disjoint_iff_inf_le,
    rintro x (hx : x ∈ _ ∩ _),
    rw [finset.mem_inter, finset.mem_Icc, finset.mem_Icc] at hx,
    rcases hx with ⟨⟨_, _⟩, _, _⟩,
    linarith,
  },
end


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

import data.nat.interval
import data.polynomial.derivative
import tactic.linarith

/-!
# Theory of iterated derivative
We define and prove some lemmas about iterated (formal) derivative for polynomials over a semiring.
-/

noncomputable theory

open finset nat polynomial
open_locale big_operators polynomial

namespace polynomial
universes u
variable {R : Type u}

section semiring

variables [semiring R] (r : R) (f p q : R[X]) (n k : ℕ)

/-- `iterated_deriv f n` is the `n`-th formal derivative of the polynomial `f` -/
def iterated_deriv : R[X] := derivative ^[n] f

@[simp] lemma iterated_deriv_zero_right : iterated_deriv f 0 = f := rfl

lemma iterated_deriv_succ : iterated_deriv f (n + 1) = (iterated_deriv f n).derivative :=
by rw [iterated_deriv, iterated_deriv, function.iterate_succ']

@[simp] lemma iterated_deriv_zero_left : iterated_deriv (0 : R[X]) n = 0 :=
begin
  induction n with n hn,
  { exact iterated_deriv_zero_right _ },
  { rw [iterated_deriv_succ, hn, derivative_zero] },
end

@[simp] lemma iterated_deriv_add :
  iterated_deriv (p + q) n = iterated_deriv p n + iterated_deriv q n :=
begin
  induction n with n ih,
  { simp only [iterated_deriv_zero_right], },
  { simp only [iterated_deriv_succ, ih, derivative_add] }
end

@[simp] lemma iterated_deriv_smul : iterated_deriv (r • p) n = r • iterated_deriv p n :=
begin
  induction n with n ih,
  { simp only [iterated_deriv_zero_right] },
  { simp only [iterated_deriv_succ, ih, derivative_smul] }
end

@[simp] lemma iterated_deriv_X_zero : iterated_deriv (X : R[X]) 0 = X :=
by simp only [iterated_deriv_zero_right]

@[simp] lemma iterated_deriv_X_one : iterated_deriv (X : R[X]) 1 = 1 :=
by simp only [iterated_deriv, derivative_X, function.iterate_one]

@[simp] lemma iterated_deriv_X (h : 1 < n) : iterated_deriv (X : R[X]) n = 0 :=
begin
  induction n with n ih,
  { exfalso, exact nat.not_lt_zero 1 h },
  { simp only [iterated_deriv_succ],
    by_cases H : n = 1,
    { rw H, simp only [iterated_deriv_X_one, derivative_one] },
    { replace h : 1 < n := array.push_back_idx h (ne.symm H),
      rw ih h, simp only [derivative_zero] } }
end

@[simp] lemma iterated_deriv_C_zero : iterated_deriv (C r) 0 = C r :=
by simp only [iterated_deriv_zero_right]

@[simp] lemma iterated_deriv_C (h : 0 < n) : iterated_deriv (C r) n = 0 :=
begin
  induction n with n ih,
  { exfalso, exact nat.lt_asymm h h },
  { by_cases H : n = 0,
    { rw [iterated_deriv_succ, H], simp only [iterated_deriv_C_zero, derivative_C] },
    { replace h : 0 < n := nat.pos_of_ne_zero H,
      rw [iterated_deriv_succ, ih h], simp only [derivative_zero] } }
end

@[simp] lemma iterated_deriv_one_zero : iterated_deriv (1 : R[X]) 0 = 1 :=
by simp only [iterated_deriv_zero_right]

@[simp] lemma iterated_deriv_one : 0 < n → iterated_deriv (1 : R[X]) n = 0 := λ h,
begin
  have eq1 : (1 : R[X]) = C 1 := by simp only [ring_hom.map_one],
  rw eq1, exact iterated_deriv_C _ _ h,
end

end semiring

section ring
variables [ring R] (p q : R[X]) (n : ℕ)

@[simp] lemma iterated_deriv_neg : iterated_deriv (-p) n = - iterated_deriv p n :=
begin
  induction n with n ih,
  { simp only [iterated_deriv_zero_right] },
  { simp only [iterated_deriv_succ, ih, derivative_neg] }
end

@[simp] lemma iterated_deriv_sub :
  iterated_deriv (p - q) n = iterated_deriv p n - iterated_deriv q n :=
by rw [sub_eq_add_neg, iterated_deriv_add, iterated_deriv_neg, ←sub_eq_add_neg]

end ring

section comm_semiring
variable [comm_semiring R]
variables (f p q : R[X]) (n k : ℕ)

lemma coeff_iterated_deriv_as_prod_Ico :
  ∀ m : ℕ, (iterated_deriv f k).coeff m = (∏ i in Ico m.succ (m + k.succ), i) * (f.coeff (m+k)) :=
begin
  induction k with k ih,
  { simp only [add_zero, forall_const, one_mul, Ico_self, eq_self_iff_true,
      iterated_deriv_zero_right, prod_empty] },
  { intro m, rw [iterated_deriv_succ, coeff_derivative, ih (m+1), mul_right_comm],
    apply congr_arg2,
    { have set_eq : (Ico m.succ (m + k.succ.succ)) = (Ico (m + 1).succ (m + 1 + k.succ)) ∪ {m+1},
      { rw [union_comm, ←insert_eq, Ico_insert_succ_left, add_succ, add_succ, add_succ _ k,
            ←succ_eq_add_one, succ_add],
        rw succ_eq_add_one,
        linarith },
      rw [set_eq, prod_union],
      apply congr_arg2,
      { refl },
      { simp only [prod_singleton], norm_cast },
      { rw [disjoint_singleton_right, mem_Ico],
        exact λ h, (nat.lt_succ_self _).not_le h.1 } },
    { exact congr_arg _ (succ_add m k) } },
end

lemma coeff_iterated_deriv_as_prod_range :
  ∀ m : ℕ, (iterated_deriv f k).coeff m = f.coeff (m + k) * (∏ i in range k, ↑(m + k - i)) :=
begin
  induction k with k ih,
  { simp },
  intro m,
  calc (f.iterated_deriv k.succ).coeff m
      = f.coeff (m + k.succ) * (∏ i in range k, ↑(m + k.succ - i)) * (m + 1) :
    by rw [iterated_deriv_succ, coeff_derivative, ih m.succ, succ_add, add_succ]
  ... = f.coeff (m + k.succ) * (∏ i in range k, ↑(m + k.succ - i)) * ↑(m + 1) :
    by push_cast
  ... = f.coeff (m + k.succ) * (∏ i in range k.succ, ↑(m + k.succ - i)) :
    by rw [prod_range_succ, add_tsub_assoc_of_le k.le_succ, succ_sub le_rfl, tsub_self, mul_assoc]
end

lemma iterated_deriv_eq_zero_of_nat_degree_lt (h : f.nat_degree < n) : iterated_deriv f n = 0 :=
begin
  ext m,
  rw [coeff_iterated_deriv_as_prod_range, coeff_zero, coeff_eq_zero_of_nat_degree_lt, zero_mul],
  linarith
end

lemma iterated_deriv_mul :
  iterated_deriv (p * q) n =
  ∑ k in range n.succ,
    (C (n.choose k : R)) * iterated_deriv p (n - k) * iterated_deriv q k :=
begin
  induction n with n IH,
  { simp },

  calc (p * q).iterated_deriv n.succ
      = (∑ (k : ℕ) in range n.succ,
           C ↑(n.choose k) * p.iterated_deriv (n - k) * q.iterated_deriv k).derivative :
    by rw [iterated_deriv_succ, IH]
  ... = ∑ (k : ℕ) in range n.succ,
          C ↑(n.choose k) * p.iterated_deriv (n - k + 1) * q.iterated_deriv k +
        ∑ (k : ℕ) in range n.succ,
          C ↑(n.choose k) * p.iterated_deriv (n - k) * q.iterated_deriv (k + 1) :
    by simp_rw [derivative_sum, derivative_mul, derivative_C, zero_mul, zero_add,
                iterated_deriv_succ, sum_add_distrib]
  ... = (∑ (k : ℕ) in range n.succ,
            C ↑(n.choose k.succ) * p.iterated_deriv (n - k) * q.iterated_deriv (k + 1) +
          C ↑1 * p.iterated_deriv n.succ * q.iterated_deriv 0) +
        ∑ (k : ℕ) in range n.succ,
          C ↑(n.choose k) * p.iterated_deriv (n - k) * q.iterated_deriv (k + 1) : _
  ... = ∑ (k : ℕ) in range n.succ,
          C ↑(n.choose k) * p.iterated_deriv (n - k) * q.iterated_deriv (k + 1) +
        ∑ (k : ℕ) in range n.succ,
            C ↑(n.choose k.succ) * p.iterated_deriv (n - k) * q.iterated_deriv (k + 1) +
        C ↑1 * p.iterated_deriv n.succ * q.iterated_deriv 0 :
    by ring
  ... = ∑ (i : ℕ) in range n.succ,
          C ↑((n+1).choose (i+1)) * p.iterated_deriv (n + 1 - (i+1)) * q.iterated_deriv (i+1) +
        C ↑1 * p.iterated_deriv n.succ * q.iterated_deriv 0 :
    by simp_rw [choose_succ_succ, succ_sub_succ, cast_add, C.map_add, add_mul, sum_add_distrib]
  ... = ∑ (k : ℕ) in range n.succ.succ,
          C ↑(n.succ.choose k) * p.iterated_deriv (n.succ - k) * q.iterated_deriv k :
    by rw [sum_range_succ' _ n.succ, choose_zero_right, tsub_zero],

  congr,
  refine (sum_range_succ' _ _).trans (congr_arg2 (+) _ _),
  { rw [sum_range_succ, nat.choose_succ_self, cast_zero, C.map_zero, zero_mul, zero_mul, add_zero],
    refine sum_congr rfl (λ k hk, _),
    rw mem_range at hk,
    congr,
    rw [tsub_add_eq_add_tsub (nat.succ_le_of_lt hk), nat.succ_sub_succ] },
  { rw [choose_zero_right, tsub_zero] },
end

end comm_semiring

end polynomial