import algebra.ring tactic.ext

/-!
This file includes definitions of standard
coordinate tuples represented as lists and
the usual coordinate-wise operations needed
for linear algebra. This file supports our
formalization of affine coordinate spaces.
-/

universes u v
variables {k : Type u} [ring k] [inhabited k] {α : Type v} [has_add α]
(a b : α) (al bl : list α)
(x y : k) (xl yl : list k)
(n : ℕ)

open list

namespace vecl

def ladd : list α → list α → list α := zip_with has_add.add

/-- addition is compatible with list constructor -/
@[simp] theorem add_cons_cons (a b : α) (l₁ l₂ : list α) :
  ladd (a :: l₁) (b :: l₂) = (a + b) :: ladd l₁ l₂ := rfl

/-- adding the empty list to a list gives you the empty list -/
@[simp] theorem add_nil_left (l : list α) : ladd ([] : list α) l = [] := rfl

/-- adding a list to the empty list gives you the empty list -/
@[simp] theorem add_nil_right (l : list α) : ladd l ([] : list α) = [] :=
by cases l; refl

@[simp] theorem length_sum : ∀ (l₁ : list α) (l₂ : list α),
   length (ladd l₁ l₂) = min (length l₁) (length l₂)
| []      l₂      := rfl
| l₁      []      := by simp -- TODO: figure out which simp lemmata are being used, and use "simp only"
| (a::l₁) (b::l₂) := --by simp only [length, add_cons_cons, length_sum l₁ l₂, min_succ_succ]
begin
simp only [length, add_cons_cons, length_sum l₁ l₂],
exact ((length l₁).min_succ_succ (length l₂)).symm,
end

@[simp] theorem zip_with_cons_cons {α β γ} (f : α → β → γ) (a : α) (b : β) (l₁ : list α) (l₂ : list β) :
  list.zip_with f (a :: l₁) (b :: l₂) = f a b :: list.zip_with f l₁ l₂ := rfl

/-- the empty list is of length 0 -/
@[simp] lemma len_nil : length ([] : list α) = 0 := rfl
/-- every list is one longer than its tail -/
@[simp] lemma len_cons : length (a :: al) = length al + 1 := rfl

--! IMPORTANT: NO has_add INSTANCE ANYMORE

/-- may or may not need this -/
lemma ladd_defn : ladd al bl = (zip_with has_add.add) al bl := by {intros, refl}

/-- returns list of 0 vector of given length. -/
def zero_vector (k : Type*) [ring k] : ℕ → list k
| 0 := [0]
| (nat.succ n) := 0 :: (zero_vector n)

lemma field_zero_sep : ∀ n : ℕ, n ≠ 0 → zero_vector k n = 0 :: zero_vector k (n - 1) :=
begin
intros n h,
induction n with n',
{contradiction},
{refl}
end

/-- returns a list multiplied element-wise by a scalar. -/
def scalar_mul : k → list k → list k
| x [] := []
| x (a :: l) := (x * a) :: (scalar_mul x l)

/-- definitional lemmata for scalar_mul -/
lemma scalar_nil : scalar_mul x [] = [] := rfl
lemma scalar_cons : scalar_mul y (x :: xl) = (y * x) :: (scalar_mul y xl) := rfl

/-- scaling a vector does not change its length -/
lemma scale_len : length (scalar_mul x xl) = length xl :=
begin
induction xl,
rw scalar_nil,
simp only [scalar_cons, len_cons, xl_ih],
end

/-- scaling by 1 returns the original vector -/
lemma one_smul_cons : scalar_mul 1 xl = xl :=
begin
induction xl,
refl,
rw [scalar_cons, one_mul, xl_ih],
end

/-- scaling by 0 returns the zero vector -/
lemma zero_smul_cons : xl ≠ [] → scalar_mul 0 xl = zero_vector k (xl.length - 1) :=
begin
intros,
induction xl,
contradiction,
cases xl_tl,
have h₁ : scalar_mul 0 [xl_hd] = [0*xl_hd] := rfl,
have h₂ : zero_vector k ([xl_hd].length - 1) = [0] := rfl,
rw [h₁, h₂, zero_mul],

rw [scalar_cons, field_zero_sep],
have h₄ : (xl_hd :: xl_tl_hd :: xl_tl_tl).length - 1 - 1 = (xl_tl_hd :: xl_tl_tl).length - 1 := rfl,
rw [h₄, xl_ih, zero_mul],
repeat {contradiction},
end

/-- scaling the zero vector with anything returns the zero vector -/
lemma smul_zero_cons : scalar_mul x (zero_vector k n) = zero_vector k n :=
begin
induction n with n',
have h₁ : zero_vector k 0 = [0] := rfl,
have h₂ : scalar_mul x [0] = [x*0] := rfl,
rw [h₁, h₂, mul_zero],

have h₃ : n'.succ - 1 = n' := rfl,
rw [field_zero_sep, scalar_cons, mul_zero, h₃, n_ih],
contradiction
end

/-- scaling is consistent with ring multiplication -/
lemma smul_assoc : scalar_mul (x*y) xl = scalar_mul x (scalar_mul y xl) :=
begin
induction xl,
refl,
simp only [scalar_cons],
split,
rw mul_assoc,
exact xl_ih,
end

/-- neg function for rings -/
def ring_neg : k → k := λ a, -a
/-- neg function for lists -/
def vecl_neg : list k → list k := map ring_neg

lemma neg_cons : vecl_neg (x :: xl) = (-x) :: vecl_neg xl := rfl

/-- length of -x is the same as the length of x-/
@[simp] theorem len_neg : length (vecl_neg xl) = length xl :=
begin
induction xl,
{
    dsimp only [vecl_neg, ring_neg, map, length], refl,
},
{
  have t : vecl_neg (xl_hd :: xl_tl) = (-xl_hd :: vecl_neg xl_tl) := rfl,
  simp only [t, len_cons, xl_ih],
},
end

lemma ladd_assoc : ∀ x y z : list k, ladd (ladd x y) z = ladd x (ladd y z) :=
begin
intros x y z,
induction x generalizing y z,
simp only [add_nil_left, add_nil_right],
induction y generalizing z,
simp only [add_nil_left, add_nil_right],
cases z,
simp only [add_nil_left, add_nil_right],
rw ladd at x_ih y_ih ⊢,
repeat {rw zip_with_cons_cons},
rw add_assoc,
rw x_ih,
end

lemma zero_ladd : ∀ x : list k, ladd (zero_vector k (length x - 1)) x = x :=
begin
intro x,
induction x,
{refl},
{
  have tl_len : length (x_hd :: x_tl) - 1 = length x_tl := rfl,
  rw tl_len,
  induction x_tl,
  {
    have field_zero_zero : zero_vector k 0 = [0] := rfl,
    have add_list : ladd [0] [x_hd] = [0 + x_hd] := rfl,
    rw [len_nil, field_zero_zero, add_list, zero_add]
  },
  {
    have zero_tl : zero_vector k (length (x_tl_hd :: x_tl_tl)) = 0 :: zero_vector k (length x_tl_tl) :=
      begin
      have len_x : length (x_tl_hd :: x_tl_tl) ≠ 0 :=
        begin
        intro h,
        have len_x' : length (x_tl_hd :: x_tl_tl) = length x_tl_tl + 1 := rfl,
        contradiction
        end,
      apply field_zero_sep,
      exact len_x
      end,
      have sep_head : ladd (0 :: (zero_vector k (length x_tl_tl))) (x_hd :: (x_tl_hd :: x_tl_tl)) =
        (0 + x_hd) :: ladd (zero_vector k (length x_tl_tl)) (x_tl_hd :: x_tl_tl) := rfl,
      have head_add : 0 + x_hd = x_hd := by rw zero_add,
      have len_x_tl : length x_tl_tl = length (x_tl_hd :: x_tl_tl) - 1 := rfl,
      rw [zero_tl, sep_head, head_add, len_x_tl, x_ih]
  }
}
end

lemma zero_ladd' : ∀ x : list k, ∀ n : ℕ, length x = n + 1 → ladd (zero_vector k n) x = x :=
begin
intros x n x_len,
induction x,
contradiction,
have tl_l : length (x_hd :: x_tl) - 1 = length x_tl := rfl,
have tl_len : length x_tl = n := nat.succ.inj x_len,
rw (eq.symm tl_len),
rw (eq.symm tl_l),
apply zero_ladd,
end

lemma ladd_zero : ∀ x : list k, ladd x (zero_vector k (length x - 1)) = x :=
begin
intro x,
induction x,
{refl},
{
  have tl_len : length (x_hd :: x_tl) - 1 = length x_tl := rfl,
  rw tl_len,
  induction x_tl,
  {
    have field_zero_zero : zero_vector k 0 = [0] := rfl,
    have add_list : ladd [x_hd] [0] = [x_hd + 0] := rfl,
    rw [len_nil, field_zero_zero, add_list, add_zero]
  },
  {
    have zero_tl : zero_vector k (length (x_tl_hd :: x_tl_tl)) = 0 :: zero_vector k (length (x_tl_hd :: x_tl_tl) - 1) :=
      begin
      have len_x : length (x_tl_hd :: x_tl_tl) ≠ 0 :=
        begin
        intro h,
        have len_x' : length (x_tl_hd :: x_tl_tl) = length x_tl_tl + 1 := rfl,
        contradiction
        end,
      apply field_zero_sep,
      exact len_x
      end,
    have sep_head : ladd (x_hd :: (x_tl_hd :: x_tl_tl)) (0 :: zero_vector k (length (x_tl_hd :: x_tl_tl) - 1)) =
      (x_hd + 0) :: ladd (x_tl_hd :: x_tl_tl) (zero_vector k (length (x_tl_hd :: x_tl_tl) - 1)) := rfl,
    have head_add : x_hd + 0 = x_hd := by rw add_zero,
    rw [zero_tl, sep_head, head_add, x_ih]
  }
}
end

lemma ladd_zero' : ∀ x : list k, ∀ n : ℕ, length x = n + 1 → ladd x (zero_vector k n) = x :=
begin
intros x n x_len,
induction x,
contradiction,
have tl_l : length (x_hd :: x_tl) - 1 = length x_tl := rfl,
have tl_len : length x_tl = n := nat.succ.inj x_len,
rw (eq.symm tl_len),
rw (eq.symm tl_l),
apply ladd_zero,
end

lemma ladd_left_neg : ∀ x : list k, x ≠ [] → ladd (vecl_neg x) x = zero_vector k ((length x) - 1) :=
begin
intros x x_h,
induction x,
{contradiction},
{
  induction x_tl,
  {
    have neg_x : vecl_neg [x_hd] = [-x_hd] := rfl,
    have list_sum : ladd [-x_hd] [x_hd] = [-x_hd + x_hd] := rfl,
    have x_hd_sum : -x_hd + x_hd = 0 := by apply add_left_neg,
    have zero_is : zero_vector k (length [x_hd] - 1) = [0] := rfl,
    rw [neg_x, list_sum, x_hd_sum, zero_is],
  },
  {
    have neg_x : vecl_neg (x_hd :: x_tl_hd :: x_tl_tl) = (-x_hd) :: (vecl_neg (x_tl_hd :: x_tl_tl)) := rfl,
    have list_sum : ladd (-x_hd :: (vecl_neg (x_tl_hd :: x_tl_tl))) (x_hd :: x_tl_hd :: x_tl_tl) =
      (-x_hd + x_hd) :: ladd (vecl_neg (x_tl_hd :: x_tl_tl)) (x_tl_hd :: x_tl_tl) := rfl,
    have x_hd_sum : -x_hd + x_hd = 0 := by apply add_left_neg,
    have x_tl_sum : ladd (vecl_neg (x_tl_hd :: x_tl_tl)) (x_tl_hd :: x_tl_tl) = zero_vector k (length (x_tl_hd :: x_tl_tl) - 1) :=
      begin
      apply x_ih,
      contradiction
      end,
    have zero_is : zero_vector k (length (x_hd :: x_tl_hd :: x_tl_tl) - 1) = 0 :: zero_vector k (length (x_hd :: x_tl_tl) - 1) := rfl,
    rw [neg_x, list_sum, x_hd_sum, x_tl_sum, zero_is],
    refl,
  }
}
end

lemma ladd_comm : ∀ x y : list k, ladd x y = ladd y x :=
begin
intros l l',
  induction l with hd tl hl generalizing l',

  rw [add_nil_left, add_nil_right],

  cases l' with hd' tl',
  rw [add_nil_left, add_nil_right],
  rw ladd at hl ⊢,
  rw [zip_with_cons_cons, zip_with_cons_cons, hl, add_comm]
end

lemma ladd_free : ∀ (xl yl zl : list k), zl.length = xl.length → zl.length = yl.length → zl ≠ nil → ladd xl zl = ladd yl zl → xl = yl :=
begin
intros xl yl zl x_len y_len z_cons h₀,
have h₁ : ladd (ladd xl zl) (vecl_neg zl) = ladd (ladd yl zl) (vecl_neg zl) := by rw h₀,
repeat {rw ladd_assoc at h₁},
have h₂ : ladd zl (vecl_neg zl) = ladd (vecl_neg zl) zl := by rw ladd_comm,
have h₃ : xl.length = yl.length := eq.trans (eq.symm x_len) y_len,
rw [h₂, ladd_left_neg, x_len, ladd_zero, h₃, ladd_zero] at h₁,
exact h₁,
exact z_cons
end

lemma smul_ladd : scalar_mul x (ladd xl yl) = ladd (scalar_mul x xl) (scalar_mul x yl) :=
begin
induction xl generalizing yl,
refl,

cases yl,
refl,

rw [add_cons_cons, scalar_cons, scalar_cons, scalar_cons, add_cons_cons, left_distrib, xl_ih]
end

lemma ladd_smul : scalar_mul (x + y) xl = ladd (scalar_mul x xl) (scalar_mul y xl) :=
begin
induction xl,
refl,

repeat {rw scalar_cons},
rw [add_cons_cons, right_distrib, xl_ih]
end

#check zip_with

end vecl


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

/-!
# Theory of univariate polynomials

The main results are `induction_on` and `as_sum`.
-/

noncomputable theory

open finsupp finset

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

section semiring
variables [semiring R] {p q r : polynomial R}

lemma sum_C_mul_X_eq (p : polynomial R) : p.sum (λn a, C a * X^n) = p :=
eq.trans (sum_congr rfl $ assume n hn, single_eq_C_mul_X.symm) (finsupp.sum_single _)

lemma sum_monomial_eq (p : polynomial R) : p.sum (λn a, monomial n a) = p :=
by simp only [single_eq_C_mul_X, sum_C_mul_X_eq]

@[elab_as_eliminator] protected lemma induction_on {M : polynomial R → Prop} (p : polynomial R)
  (h_C : ∀a, M (C a))
  (h_add : ∀p q, M p → M q → M (p + q))
  (h_monomial : ∀(n : ℕ) (a : R), M (C a * X^n) → M (C a * X^(n+1))) :
  M p :=
have ∀{n:ℕ} {a}, M (C a * X^n),
begin
  assume n a,
  induction n with n ih,
  { simp only [pow_zero, mul_one, h_C] },
  { exact h_monomial _ _ ih }
end,
finsupp.induction p
  (suffices M (C 0), by { convert this, exact single_zero.symm, },
    h_C 0)
  (assume n a p _ _ hp, suffices M (C a * X^n + p), by { convert this, exact single_eq_C_mul_X },
    h_add _ _ this hp)

/--
To prove something about polynomials,
it suffices to show the condition is closed under taking sums,
and it holds for monomials.
-/
@[elab_as_eliminator] protected lemma induction_on' {M : polynomial R → Prop} (p : polynomial R)
  (h_add : ∀p q, M p → M q → M (p + q))
  (h_monomial : ∀(n : ℕ) (a : R), M (monomial n a)) :
  M p :=
polynomial.induction_on p (h_monomial 0) h_add
(λ n a h, begin rw ← single_eq_C_mul_X at ⊢, exact h_monomial _ _, end)

section coeff

theorem coeff_mul_monomial (p : polynomial R) (n d : ℕ) (r : R) :
  coeff (p * monomial n r) (d + n) = coeff p d * r :=
by rw [single_eq_C_mul_X, ←X_pow_mul, ←mul_assoc, coeff_mul_C, coeff_mul_X_pow]

theorem coeff_monomial_mul (p : polynomial R) (n d : ℕ) (r : R) :
  coeff (monomial n r * p) (d + n) = r * coeff p d :=
by rw [single_eq_C_mul_X, mul_assoc, coeff_C_mul, X_pow_mul, coeff_mul_X_pow]

-- This can already be proved by `simp`.
theorem coeff_mul_monomial_zero (p : polynomial R) (d : ℕ) (r : R) :
  coeff (p * monomial 0 r) d = coeff p d * r :=
coeff_mul_monomial p 0 d r

-- This can already be proved by `simp`.
theorem coeff_monomial_zero_mul (p : polynomial R) (d : ℕ) (r : R) :
  coeff (monomial 0 r * p) d = r * coeff p d :=
coeff_monomial_mul p 0 d r

end coeff

end semiring
end polynomial


import algebra.group_power algebra.big_operators data.nat.choose
-- This appears to be a proof of the binomial theorem by Chris.
open finset nat
variable {α : Type*}

local notation f ` ∑ ` : 90 n : 90  := finset.sum (finset.range n) f

/-
theorem add_pow [comm_semiring α] (x y : α) : ∀ n : ℕ,
    (x + y)^n = (λ m, x^m * y^(n - m) * choose n m) ∑ succ n
| 0        := by simp
| (succ n) :=
have h₁ : x * (x^n * y^(n - n) * choose n n) = x^succ n * y^(succ n - succ n)
    * choose (succ n) (succ n) :=
  by simp [_root_.pow_succ, mul_assoc, mul_comm, mul_left_comm],
have  h₂ : y * (x^0 * y^(n - 0) * choose n 0) = x^0 * y^(succ n - 0) * choose (succ n) 0 :=
  by simp [_root_.pow_succ, mul_assoc, mul_comm, mul_left_comm],
have h₃ : (λ m, x * (x^m * y^(n - m) * choose n m) + y * (x^succ m * y^(n - succ m)
    * choose n (succ m))) ∑ n
    = (λ m, x^succ m * y^(succ n - succ m) * ↑(choose (succ n) (succ m))) ∑ n :=
  finset.sum_congr rfl $ λ m hm, begin
      rw finset.mem_range at hm,
      rw [← mul_assoc y, ← mul_assoc y, mul_right_comm y, ← _root_.pow_succ, add_one, ← succ_sub hm],
      simp [succ_sub_succ, _root_.pow_succ, choose_succ_succ, mul_add, mul_comm,
          mul_assoc, mul_left_comm]
    end,
by rw [_root_.pow_succ, add_pow, add_mul, finset.mul_sum, finset.mul_sum, sum_range_succ, sum_range_succ',
    sum_range_succ, sum_range_succ', add_assoc, ← add_assoc (_ ∑ n), ← finset.sum_add_distrib, h₁, h₂, h₃]
-/


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

import tactic -- imports all the Lean tactics
import data.real.basic -- imports the real numbers

/-!

# Doing algebra in the real numbers

The `ring` tactic will prove algebraic identities like
(x + y) ^ 2 = x ^ 2 + 2 * x * y + y ^ 2 in rings, and Lean
knows that the real numbers are a ring. See if you can use
`ring` to prove these theorems.

## New tactics you will need

* `ring`
* `intro` (new functionality: use on a goal of type `⊢ ∀ x, ...`)

-/

example (x y : ℝ) : (x + y) ^ 2  = x ^ 2 + 2 * x * y + y ^ 2 :=
begin
  ring,
end

example : ∀ (a b : ℝ), ∃ x,
  (a + b) ^ 3 = a ^ 3 + x * a ^ 2 * b + 3 * a * b ^ 2 + b ^ 3 :=
begin
  intros a b,use 3, ring,
end

example : ∃ (x : ℝ), ∀ y, y + y = x * y :=
begin
  use 2,intro y,ring,
end

example : ∀ (x : ℝ), ∃ y, x + y = 2 :=
begin
  intro x,use 2-x,ring,
end

example : ∀ (x : ℝ), ∃ y, x + y ≠ 2 :=
begin
  intro x, use -12-x,ring_nf,norm_num,
end


import data.real.basic

open function

-- BEGIN
example {c : ℝ} : surjective (λ x, x + c) :=
begin
  intro x,
  use x - c,
  dsimp, ring
end

example {c : ℝ} (h : c ≠ 0) : surjective (λ x, c * x) :=
begin
  intro x,
  dsimp,
  use x / c,
  sorry,
end

/- Alternatively, using the field_simp tactic -/

example {c : ℝ} (h : c ≠ 0) : surjective (λ x, c * x) :=
begin
  intro x,
  dsimp,
  use x / c,
  field_simp, /- clear denominators in a useful way -/
  sorry,
end
-- END


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen, Devon Tuma

! This file was ported from Lean 3 source module ring_theory.polynomial.scale_roots
! leanprover-community/mathlib commit 40ac1b258344e0c2b4568dc37bfad937ec35a727
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.RingTheory.NonZeroDivisors
import Mathlib.Data.Polynomial.AlgebraMap

/-!
# Scaling the roots of a polynomial

This file defines `scaleRoots p s` for a polynomial `p` in one variable and a ring element `s` to
be the polynomial with root `r * s` for each root `r` of `p` and proves some basic results about it.
-/

variable {A K R S : Type _} [CommRing A] [IsDomain A] [Field K] [CommRing R] [CommRing S]

variable {M : Submonoid A}

namespace Polynomial

open BigOperators Polynomial

/-- `scaleRoots p s` is a polynomial with root `r * s` for each root `r` of `p`. -/
noncomputable def scaleRoots (p : R[X]) (s : R) : R[X] :=
  ∑ i in p.support, monomial i (p.coeff i * s ^ (p.natDegree - i))
#align polynomial.scale_roots Polynomial.scaleRoots

@[simp]
theorem coeff_scaleRoots (p : R[X]) (s : R) (i : ℕ) :
    (scaleRoots p s).coeff i = coeff p i * s ^ (p.natDegree - i) := by
  simp (config := { contextual := true }) [scaleRoots, coeff_monomial]
#align polynomial.coeff_scale_roots Polynomial.coeff_scaleRoots

theorem coeff_scaleRoots_natDegree (p : R[X]) (s : R) :
    (scaleRoots p s).coeff p.natDegree = p.leadingCoeff := by
  rw [leadingCoeff, coeff_scaleRoots, tsub_self, pow_zero, mul_one]
#align polynomial.coeff_scale_roots_nat_degree Polynomial.coeff_scaleRoots_natDegree

@[simp]
theorem zero_scaleRoots (s : R) : scaleRoots 0 s = 0 := by
  ext
  simp
#align polynomial.zero_scale_roots Polynomial.zero_scaleRoots

theorem support_scaleRoots_le (p : R[X]) (s : R) : (scaleRoots p s).support ≤ p.support := by
  intro
  simpa using left_ne_zero_of_mul
#align polynomial.support_scale_roots_le Polynomial.support_scaleRoots_le

theorem support_scaleRoots_eq (p : R[X]) {s : R} (hs : s ∈ nonZeroDivisors R) :
    (scaleRoots p s).support = p.support :=
  le_antisymm (support_scaleRoots_le p s)
    (by intro i
        simp only [coeff_scaleRoots, Polynomial.mem_support_iff]
        intro p_ne_zero ps_zero
        have := pow_mem hs (p.natDegree - i) _ ps_zero
        contradiction)
#align polynomial.support_scale_roots_eq Polynomial.support_scaleRoots_eq

@[simp]
theorem degree_scaleRoots (p : R[X]) {s : R} : degree (scaleRoots p s) = degree p := by
  haveI := Classical.propDecidable
  by_cases hp : p = 0
  · rw [hp, zero_scaleRoots]
  refine' le_antisymm (Finset.sup_mono (support_scaleRoots_le p s)) (degree_le_degree _)
  rw [coeff_scaleRoots_natDegree]
  intro h
  have := leadingCoeff_eq_zero.mp h
  contradiction
#align polynomial.degree_scale_roots Polynomial.degree_scaleRoots

@[simp]
theorem natDegree_scaleRoots (p : R[X]) (s : R) : natDegree (scaleRoots p s) = natDegree p := by
  simp only [natDegree, degree_scaleRoots]
#align polynomial.nat_degree_scale_roots Polynomial.natDegree_scaleRoots

theorem monic_scaleRoots_iff {p : R[X]} (s : R) : Monic (scaleRoots p s) ↔ Monic p := by
  simp only [Monic, leadingCoeff, natDegree_scaleRoots, coeff_scaleRoots_natDegree]
#align polynomial.monic_scale_roots_iff Polynomial.monic_scaleRoots_iff

theorem scaleRoots_eval₂_mul {p : S[X]} (f : S →+* R) (r : R) (s : S) :
    eval₂ f (f s * r) (scaleRoots p s) = f s ^ p.natDegree * eval₂ f r p :=
  calc
    _ = (scaleRoots p s).support.sum fun i =>
          f (coeff p i * s ^ (p.natDegree - i)) * (f s * r) ^ i :=
      by simp [eval₂_eq_sum, sum_def]
    _ = p.support.sum fun i => f (coeff p i * s ^ (p.natDegree - i)) * (f s * r) ^ i :=
      (Finset.sum_subset (support_scaleRoots_le p s) fun i _hi hi' =>
        by
        let this : coeff p i * s ^ (p.natDegree - i) = 0 := by simpa using hi'
        simp [this])
    _ = p.support.sum fun i : ℕ => f (p.coeff i) * f s ^ (p.natDegree - i + i) * r ^ i :=
      (Finset.sum_congr rfl fun i _hi => by
        simp_rw [f.map_mul, f.map_pow, pow_add, mul_pow, mul_assoc])
    _ = p.support.sum fun i : ℕ => f s ^ p.natDegree * (f (p.coeff i) * r ^ i) :=
      (Finset.sum_congr rfl fun i hi =>
        by
        rw [mul_assoc, mul_left_comm, tsub_add_cancel_of_le]
        exact le_natDegree_of_ne_zero (Polynomial.mem_support_iff.mp hi))
    _ = f s ^ p.natDegree * p.support.sum fun i : ℕ => f (p.coeff i) * r ^ i := Finset.mul_sum.symm
    _ = f s ^ p.natDegree * eval₂ f r p := by simp [eval₂_eq_sum, sum_def]

#align polynomial.scale_roots_eval₂_mul Polynomial.scaleRoots_eval₂_mul

theorem scaleRoots_eval₂_eq_zero {p : S[X]} (f : S →+* R) {r : R} {s : S} (hr : eval₂ f r p = 0) :
    eval₂ f (f s * r) (scaleRoots p s) = 0 := by rw [scaleRoots_eval₂_mul, hr, mul_zero]
#align polynomial.scale_roots_eval₂_eq_zero Polynomial.scaleRoots_eval₂_eq_zero

theorem scaleRoots_aeval_eq_zero [Algebra S R] {p : S[X]} {r : R} {s : S} (hr : aeval r p = 0) :
    aeval (algebraMap S R s * r) (scaleRoots p s) = 0 :=
  scaleRoots_eval₂_eq_zero (algebraMap S R) hr
#align polynomial.scale_roots_aeval_eq_zero Polynomial.scaleRoots_aeval_eq_zero

theorem scaleRoots_eval₂_eq_zero_of_eval₂_div_eq_zero {p : A[X]} {f : A →+* K}
    (hf : Function.Injective f) {r s : A} (hr : eval₂ f (f r / f s) p = 0)
    (hs : s ∈ nonZeroDivisors A) : eval₂ f (f r) (scaleRoots p s) = 0 := by
  convert @scaleRoots_eval₂_eq_zero _ _ _ _ p f _ s hr
  rw [← mul_div_assoc, mul_comm, mul_div_cancel]
  exact map_ne_zero_of_mem_nonZeroDivisors _ hf hs
#align polynomial.scale_roots_eval₂_eq_zero_of_eval₂_div_eq_zero Polynomial.scaleRoots_eval₂_eq_zero_of_eval₂_div_eq_zero

theorem scaleRoots_aeval_eq_zero_of_aeval_div_eq_zero [Algebra A K]
    (inj : Function.Injective (algebraMap A K)) {p : A[X]} {r s : A}
    (hr : aeval (algebraMap A K r / algebraMap A K s) p = 0) (hs : s ∈ nonZeroDivisors A) :
    aeval (algebraMap A K r) (scaleRoots p s) = 0 :=
  scaleRoots_eval₂_eq_zero_of_eval₂_div_eq_zero inj hr hs
#align polynomial.scale_roots_aeval_eq_zero_of_aeval_div_eq_zero Polynomial.scaleRoots_aeval_eq_zero_of_aeval_div_eq_zero

theorem map_scaleRoots (p : R[X]) (x : R) (f : R →+* S) (h : f p.leadingCoeff ≠ 0) :
    (p.scaleRoots x).map f = (p.map f).scaleRoots (f x) := by
  ext
  simp [Polynomial.natDegree_map_of_leadingCoeff_ne_zero _ h]
#align polynomial.map_scale_roots Polynomial.map_scaleRoots

end Polynomial


import data.nat.prime
import tactic.linarith

open nat

theorem infinitude_of_primes : ∀ N, ∃ p ≥ N, prime p :=
begin
  intro N,

  let M := fact N + 1,
  let p := min_fac M,

  have pp : prime p :=
  begin
    refine min_fac_prime _,
    have : fact N > 0 := fact_pos N,
    linarith,
  end,

  use p,
  split,
  { by_contradiction,
    have h₁ : p ∣ fact N + 1 := min_fac_dvd M,
    have h₂ : p ∣ fact N := (prime.dvd_fact pp).mpr (le_of_not_ge a),
    have h : p ∣ 1 := (nat.dvd_add_right h₂).mp h₁,
    exact prime.not_dvd_one pp h, },
  { exact pp, },
end

------------------------------------------------------------------------
-- § Referencia                                                       --
------------------------------------------------------------------------

-- Basado en la presentación "Infinitude of primes: a Lean theorem
-- prover demo" de Scott Morrison que se encuentra en
-- https://youtu.be/b59fpAJ8Mfs


import Mathlib.Init.Data.Nat.Basic
import Mathlib.Init.Data.Int.Basic
/-!
## Types and Terms

_Simple type theory_ (also called higher-order logic) corresponds roughly to the
[simply typed λ-calculus](../bib.md#5) extended with an equality operator (=). It is an abstract,
extremely simplified version of a programming language with a function-calling
mechanism that prefigures functional programming. It can also be viewed as a
generalization of first-order logic (also called predicate logic).

### Types

Types are either basic types such as `ℤ`, `ℚ`, and bool or total functions `σ → τ`, where
`σ` and `τ` are themselves types. Types indicate which values an expression may
evaluate to. They introduce a discipline that is followed somewhat implicitly in
mathematics. In principle, nothing prevents a mathematician from stating `1 ∈ 2`,
but a typing discipline would mark this as the error it likely is.

Semantically, types can be viewed as sets. We would normally define the types
`ℤ`, `ℚ`, and `bool` so that they faithfully capture the mathematicians’ `ℤ` and `ℚ` and
the computer scientists’ Booleans, and similarly for the function arrow (`→`). But
despite their similarities, Lean and mathematics are distinct languages. Lean’s
types may be interpreted as sets, but they are not sets.

Higher-order types are types containing left-nested `→` arrows. Values of such
types are functions that take other functions as arguments. Accordingly, the type
`(ℤ → ℤ) → ℚ`  is the type of unary functions that take a function of type `ℤ → ℤ` as
argument and that return a value of type `ℚ`.

### Terms

The _terms_, or expressions, of simple type theory consist of

- _constants_ c;
- _variables_ x;
- _applications_ t u;
- _λ-expressions_ λx => t.

Above, `t` and `u` denote arbitrary terms. We can also write `t : σ` to indicate that the
term `t` has the type `σ`.

A constant `c : σ` is a symbol of type `σ` whose meaning is fixed in the current
global context. For example, an arithmetic theory might contain constants such
as `0 : ℤ`, `1 : ℤ`, `abs : ℤ → ℕ`, `square : ℕ → ℕ`, and `prime : ℕ → Bool`. Constants
include functions (e.g., `abs`) and predicates (e.g., `prime`).

A variable `x : σ` is either bound or free. A bound variable refers back to the
input of a λ-expression `λ x : σ => t` enclosing it. In `λ x : ℤ => square (abs x)`
the second `x` is a variable that refers back to the λ binder’s input `x`. By contrast, a free
variable is declared in the local context—a concept that will be explained below.

An application `t u`, where `t : σ → τ` and `u : σ`, is a term of type `τ` denoting the
result of applying the function `t` to the argument `u`—e.g., `abs 0`. No parentheses
are needed around the argument, unless it is a complex term—e.g., `prime (abs 0)`.

Given a term `t : τ`, a λ-expression `λ x : σ => t` denotes the total function of type
`σ → τ` that maps each input value `x` of type `σ` to the function body `t`, where `t` may
contain `x`. For example, `λ x : ℤ => square (abs x)` denotes the function that maps
(the value denoted by) `0` to (the value denoted by) `square (abs 0)`, that maps `1` to
`square (abs 1)`, and so on. A more intuitive syntax might have been
`x ↦ square (abs x)`, but this is not supported by Lean.

Applications and λ-expressions mirror each other: A λ-expression “builds” a
function; an application “destructs” a function. Although our functions are unary
(i.e., they take one argument), we can build _n_-ary functions by nesting λs, using
an ingenious technique called _currying_. For example, `λ x : σ => (λ y : τ => x)` denotes
the function of type `σ → (τ → σ)` that takes two arguments and returns the first
one. Strictly speaking, `σ → (τ → σ)` takes a single argument and returns a function,
which in turn takes an argument. Applications work in the same way: If
`K := (λx : ℤ => (λ y : Z => x))`, then `K 1 = (λ y : Z => 1)` and `(K 1) 0 = 1`.
The function `K` in `K 1`, which is applied to a single argument, is said to be _partially applied_.

Currying is so useful a concept that we will omit most parentheses, writing

- `σ → τ → υ` for `σ → (τ → υ)`
- `t u v` for `(t u) v`
- `λ x : σ => λ y : τ => t` for `λ x : σ => `(λ y : τ => t)`

and also

- `λ (x : σ) (y : τ) => t` for `λ x : σ => λ y : τ => t`
- `λ x y : σ => t` for `λ (x : σ) (y : σ) => t`

In mathematics, it is customary to write binary operators in infix syntax—e.g.,
`x + y`. Such notations are also possible in Lean, as syntactic sugar for `Add.add x y`.
Partial application is possible with this syntax. For example,  `Add.add 1`
denotes the unary function that adds one to its argument. Other ways to write
this function are `λ x => Add.add 1 x` and `λ x => 1 + x`.

No we can move some of this into the Lean language, declaring some simple
typed values and functions using the `def` command as follows:
-/
-- These are defined in Mathlib:
-- notation "ℤ" => Int   -- associates the notation ℤ with Integer type.
-- notation "ℕ" => Nat   -- associates the notation ℕ with Nat type for natural numbers.

def a : ℤ := 1
def b : ℤ := 2
def f : ℤ → ℤ  := λ x => x + 1
def g : ℤ → ℤ → ℤ := λ x y => x + y

#check λ x : ℤ => g (f (g a x)) (g x b)   -- ℤ → ℤ
#check λ x => g (f (g a x)) (g x b)       -- ℤ → ℤ

/-!
The first two lines declare tow constants (a, b), both of type Integer with
the respective value of 1 and 2.  The definition for `f` defines a funciton
of type `ℤ → ℤ` implemented by a lambda expression that adds 1 to its argument.
The definition for `g` defines a function of type `ℤ → ℤ → ℤ` implemented by a
lambda expression that takes two arguments and adds them together.

The last two lines use the `#check` command to type-check some terms and
show their types. The # prefix identifies interactive commands: commands that are
useful for debugging but that we would normally not keep in a Lean program.

The `abbrev` command can be used to define a new name for an existing type:
-/
abbrev foo := Int

#check foo -- foo : Type

#check (5 : foo)    -- 5 : foo

#reduce (5 : foo)   -- Int.ofNat 5
/-!
Here we see that `foo` is a `Type` and it is synonymous for the type `Int`.

### Type Checking and Type Inference

When Lean parses a term, it checks whether the term is well typed. In the process,
it tries to infer the types of bound variables if those are omitted—e.g., the type of
`x` in `λ x => 1 + x`. Type inference lightens notations and saves some typing.

For simple type theory, type checking and type inference are decidable problems.
Advanced features such as overloading (the possibility to reuse the same
name for several constants—e.g., `0 : ℕ`  and `0 : ℝ`) can lead to [undecidability](../bib.md#30).
Lean takes a pragmatic, computer-science-oriented approach and assumes that
numerals `0, 1, 2, . . .` are of type `Nat` if several types are possible.

Lean’s type system can be expressed as a formal system. A formal system
consists of judgments and of (derivation) rules for producing judgments. A typing
judgment has the form `C ⊢ t : σ`, meaning that term `t` has type `σ` in local context `C`.
The local context gives the types of the variables in `t` that are not bound by a `λ`.
The local context is used to keep track of the variables bound by λ’s outside `t`.
For a function definition, it will consist of the function’s parameters. For example,
in Lean, the right-hand side of the last equation of fib’s above would be type-checked
in a local context consisting of `n : ℕ`.

For simple type theory, there are four typing rules, one per kind of term:

\\( \cfrac{}{C ⊢ c : σ} {\large C}{\normalsize ST} \quad \\text{if c is declared with type σ } \\)

\\( \cfrac{}{C ⊢ x : σ} {\large V}{\normalsize AR} \quad \\text{if x : σ is the last occurrence of x in C } \\)

\\( \cfrac{C ⊢ t : σ → τ \quad C ⊢ u : σ }{C ⊢ t\enspace{u} : τ} {\large A}{\normalsize PP} \\)

\\( \cfrac{C, x : σ ⊢ t : τ }{C ⊢ (λ\enspace{x} : σ => t) : σ → τ} {\large L}{\normalsize AM} \\)

Each rule has zero or more premises (above the horizontal bar), a conclusion
(below the bar), and possibly a side condition. The premises are typing judgments,
whereas the side conditions are arbitrary mathematical conditions on the mathematical
variables occurring in the rule. To discharge the premises, we need to
continue performing a derivation upward, as we will see in a moment. As for the
side conditions, we can use the entire arsenal of mathematics to show that they
are true.

The first two rules, labeled `CST` and `VAR`, have no premises, but they have side
conditions that must be satisfied for the rules to apply. The last two rules take
one or two judgments as premises and produce a new judgment. `LAM` is the only
rule that modifies the local context: As we enter the body `t` of a λ-expression, we
need to record the existence of the bound variable `x` and its type to be ready when
we meet `x` in `t`

We can use this rule system to prove that a given term is well typed by working our way backwards
(i.e., upwards) and applying the rules, building a formal derivation of a typing judgment. Like
natural trees, derivation trees are drawn with the root at the bottom. The derived judgment appears
at the root, and each branch ends with the application of a premise-less rule. Rule applications are
indicated by a horizontal bar and a label. The following typing derivation establishes that the term
`λ x : ℤ => abs x` has type `ℤ → ℕ`  in an arbitrary local context `C`:

\\( \cfrac{ \cfrac{}{C, x : ℤ ⊢ abs : ℤ → ℕ} {\large C}{\normalsize ST} \quad \cfrac{}{C, x : ℤ ⊢ x : ℤ } {\large V}{\normalsize AR}} { \cfrac{C, x : ℤ ⊢ abs\enspace{x} : ℕ}{C ⊢ (λ\enspace{x} : ℤ => abs\enspace{x}): ℤ → ℕ} {\large C}{\normalsize ST} } {\large A}{\normalsize PP}\\)

Reading the proof from the root upwards, notice how the local context is threaded
through and how it is extended by the `LAM` rule. The rule moves the variable bound
by the λ-expression to the local context, making an application of `VAR` possible
further up the tree. If the variable `x` is already declared in `C`, it becomes shadowed
by `x : ℤ` after entering the λ-expression.

The above type system only checks that terms are well typed. It does not check
that types are well formed. For example, `List ℤ`  is well formed, whereas `ℤ List`
and `List List` are ill-formed. For simple type theory, well-formedness is easy
to check: Only declared type constructors should be used, and each _n_-ary type
constructor should be passed exactly _n_ type arguments.

As a side note, type inference is a generalization of type checking where the
types on the right-hand side of the colon (`:`) in judgments may be replaced by
placeholders. Lean’s type inference is based on an algorithm due to [Hindley](../bib.md#15)
and [Milner](../bib.md#25), which also forms the basis of Haskell, OCaml, and Standard ML.
The algorithm generates type constraints involving type variables `?α, ?β, ?γ, . . .`,
and attempts to solve them using a type unification procedure. For example, when
inferring the type `?α` of `λ x => abs x`, Lean would perform the following schematic
type derivation:

\\( \cfrac{ \cfrac{}{x :\thinspace{?β} ⊢ abs :\thinspace{?β} → γ} {\large C}{\normalsize ST} \quad \cfrac{}{x :\thinspace{?β} ⊢ x :\thinspace{?β}} {\large V}{\normalsize AR}} { \cfrac{x :\thinspace{?β} ⊢ abs\enspace{x}:\thinspace{?γ}}{⊢ (λ\enspace{x} => abs\enspace{x}) :\thinspace{?α}} {\large C}{\normalsize ST} } {\large A}{\normalsize PP}\\)

In addition, Lean would generate the following constraints to ensure that all the
rule applications are legal:

1. For the application of `LAM`, the type of `λ x => abs x` must be of the form `?β → ?γ`,
for some types `?β` and `?γ`. Thus, Lean would generate the constraint `?α = ?β → ?γ`
2. For the application of `CST`, the type of `abs` must correspond to the declaration as `ℤ → ℕ`.
Thus, Lean would generate the constraint `?β → ?γ = ℤ → ℕ`

Solving the two constraints yields `?α := ℤ → ℕ`, which is indeed the type that Lean
infers for `λ x => abs x`.

### Type Inhabitation

Given a type `σ`, the type inhabitation problem consists of finding an “inhabitant”
of that type—a term of type `σ`—within the empty local context. It may seem like a
pointless exercise, but as we will see in Chapter 3, this problem is closely related
to that of finding a proof of a proposition. Seemingly silly exercises of the form
“find a term of type `σ`” are good practice towards mastery of theorem proving.

To create a term of a given type, start with the placeholder _ and recursively
apply a combination of the following two steps:

1. If the type is of the form `σ → τ`, a possible inhabitant is an anonymous function,
of the form `λ x : σ => _`, where `_` is a placeholder for a missing term of
type `τ`. Lean will mark `_` as an error; if you hover over it in Visual Studio
Code, a tooltip will show the missing term’s type as well as any variables
declared in the local context.

2. Given a type `σ` (which may be a function type), you can use any constant `c`
or variable `x : τ₁ → · · · → τₙ → σ` to build a term of that type. For each
argument, you need to put a placeholder, yielding `c _ . . . _` or `x _ . . . _`

The placeholders can be eliminated recursively using the same procedure.
As an example, we will apply the procedure to find a term of type
`(α → β → γ) → ((β → α) → β) → α → γ`.

Initially, only step 1 is applicable, with `σ := α → β → γ` and `τ := ((β → α) → β) → α → γ`.
(Recall that `→` is right-associative: `σ → τ → υ` stands for `σ → (τ → υ)`.)
This results in the term `λ f => _`, which has the right type but has a placeholder left.
Since the argument `f` has type `σ`, a function type, it makes sense to use the name
`f` for it. Then we continue recursively with the placeholder, of type `τ`. Again, only
step 1 is possible, so we end up with the term `λ f => λ g => _`, where `g` has type
`(β → α) → β` and the placeholder has type `α → γ`. A third application of step 1 yields
`λ f => λ g => λ a => _`, where `a` has type `α` and the placeholder has type `γ`.

At this point, step 1 is no longer possible. Let us see if step 2 is applicable. The
context surrounding the placeholder contains the following variables:
```lean
f : α → β → γ
g : (β → α) → β
a : α
```

Recall that we are trying to build a term of type `γ`. The only variable we can use
to achieve this is `f`: It takes two arguments and returns a value of type `γ`. So
we replace the placeholder with the term `f _ _`, where the two new placeholders
stand for the two missing arguments. Putting everything together, we now have
the term `λ f => λ g => λ a => f _ _`.

Following f’s type, the placeholders are of type `α` and `β`, respectively. The first
placeholder is easy to fill, using step 2 again, by simply supplying `a`, of type `α`, with
no arguments. For the second placeholder, we apply step 2 with the variable `g`,
which is the only source of βs. Since `g` takes an argument, we must supply a
placeholder. This means our current term is `λ f => λ g => λ a => f a (g _)`.

We are almost done. The only placeholder left has type `β → α`, which is g’s
argument type. Applying step 1, we replace the placeholder with `λ b => _`, where `_`
has type `α`. Here, we can simply supply `a`. Our final term is
`λ f => λ g => λ a => f a (g (λ b => a))`—i.e., `λ f g a => f a (g (λ b => a))`.

The above derivation was tedious but deterministic: At each point, either step
1 or 2 was applicable, but not both. In general, this will not always be the case.
For some other types, we might encounter dead ends and need to backtrack. We
might also fail altogether, with nowhere to backtrack to. Notably, with an empty
local context, it is impossible to supply a witness for `α`.

The key idea is that the term should be syntactically correct at all times. The
only red underlining we should see in Visual Studio Code should appear under the
placeholders. In general, a good principle for software development is to start
with a program that compiles, perform the smallest change possible to obtain a
new compiling program, and repeat until the program is complete.
-/


/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov

Some proofs and docs came from `algebra/commute` (c) Neil Strickland

! This file was ported from Lean 3 source module algebra.group.semiconj
! leanprover-community/mathlib commit a148d797a1094ab554ad4183a4ad6f130358ef64
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Group.Units

/-!
# Semiconjugate elements of a semigroup

## Main definitions

We say that `x` is semiconjugate to `y` by `a` (`SemiconjBy a x y`), if `a * x = y * a`.
In this file we provide operations on `SemiconjBy _ _ _`.

In the names of these operations, we treat `a` as the “left” argument, and both `x` and `y` as
“right” arguments. This way most names in this file agree with the names of the corresponding lemmas
for `Commute a b = SemiconjBy a b b`. As a side effect, some lemmas have only `_right` version.

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

This file provides only basic operations (`mul_left`, `mul_right`, `inv_right` etc). Other
operations (`pow_right`, field inverse etc) are in the files that define corresponding notions.
-/

/-- `x` is semiconjugate to `y` by `a`, if `a * x = y * a`. -/
@[to_additive AddSemiconjBy "`x` is additive semiconjugate to `y` by `a` if `a + x = y + a`"]
def SemiconjBy [Mul M] (a x y : M) : Prop :=
  a * x = y * a
#align semiconj_by SemiconjBy
#align add_semiconj_by AddSemiconjBy

namespace SemiconjBy

/-- Equality behind `SemiconjBy a x y`; useful for rewriting. -/
@[to_additive "Equality behind `AddSemiconjBy a x y`; useful for rewriting."]
protected theorem eq [Mul S] {a x y : S} (h : SemiconjBy a x y) : a * x = y * a :=
  h
#align semiconj_by.eq SemiconjBy.eq
#align add_semiconj_by.eq AddSemiconjBy.eq

section Semigroup

variable [Semigroup S] {a b x y z x' y' : S}

/-- If `a` semiconjugates `x` to `y` and `x'` to `y'`,
then it semiconjugates `x * x'` to `y * y'`. -/
@[to_additive (attr := simp) "If `a` semiconjugates `x` to `y` and `x'` to `y'`,
then it semiconjugates `x + x'` to `y + y'`."]
theorem mul_right (h : SemiconjBy a x y) (h' : SemiconjBy a x' y') :
    SemiconjBy a (x * x') (y * y') := by
  unfold SemiconjBy
  -- TODO this could be done using `assoc_rw` if/when this is ported to mathlib4
  rw [←mul_assoc, h.eq, mul_assoc, h'.eq, ←mul_assoc]
#align semiconj_by.mul_right SemiconjBy.mul_right
#align add_semiconj_by.add_right AddSemiconjBy.add_right

/-- If `b` semiconjugates `x` to `y` and `a` semiconjugates `y` to `z`, then `a * b`
semiconjugates `x` to `z`. -/
@[to_additive "If `b` semiconjugates `x` to `y` and `a` semiconjugates `y` to `z`, then `a + b`
semiconjugates `x` to `z`."]
theorem mul_left (ha : SemiconjBy a y z) (hb : SemiconjBy b x y) : SemiconjBy (a * b) x z := by
  unfold SemiconjBy
  rw [mul_assoc, hb.eq, ←mul_assoc, ha.eq, mul_assoc]
#align semiconj_by.mul_left SemiconjBy.mul_left
#align add_semiconj_by.add_left AddSemiconjBy.add_left

/-- The relation “there exists an element that semiconjugates `a` to `b`” on a semigroup
is transitive. -/
@[to_additive "The relation “there exists an element that semiconjugates `a` to `b`” on an additive
semigroup is transitive."]
protected theorem transitive : Transitive fun a b : S ↦ ∃ c, SemiconjBy c a b
  | _, _, _, ⟨x, hx⟩, ⟨y, hy⟩ => ⟨y * x, hy.mul_left hx⟩
#align semiconj_by.transitive SemiconjBy.transitive
#align add_semiconj_by.transitive SemiconjBy.transitive

end Semigroup

section MulOneClass

variable [MulOneClass M]

/-- Any element semiconjugates `1` to `1`. -/
@[to_additive (attr := simp) "Any element semiconjugates `0` to `0`."]
theorem one_right (a : M) : SemiconjBy a 1 1 := by rw [SemiconjBy, mul_one, one_mul]
#align semiconj_by.one_right SemiconjBy.one_right
#align add_semiconj_by.zero_right AddSemiconjBy.zero_right

/-- One semiconjugates any element to itself. -/
@[to_additive (attr := simp) "Zero semiconjugates any element to itself."]
theorem one_left (x : M) : SemiconjBy 1 x x :=
  Eq.symm <| one_right x
#align semiconj_by.one_left SemiconjBy.one_left
#align add_semiconj_by.zero_left AddSemiconjBy.zero_left

/-- The relation “there exists an element that semiconjugates `a` to `b`” on a monoid (or, more
generally, on `MulOneClass` type) is reflexive. -/
@[to_additive "The relation “there exists an element that semiconjugates `a` to `b`” on an additive
monoid (or, more generally, on a `AddZeroClass` type) is reflexive."]
protected theorem reflexive : Reflexive fun a b : M ↦ ∃ c, SemiconjBy c a b
  | a => ⟨1, one_left a⟩
#align semiconj_by.reflexive SemiconjBy.reflexive
#align add_semiconj_by.reflexive AddSemiconjBy.reflexive

end MulOneClass

section Monoid

variable [Monoid M]

/-- If `a` semiconjugates a unit `x` to a unit `y`, then it semiconjugates `x⁻¹` to `y⁻¹`. -/
@[to_additive "If `a` semiconjugates an additive unit `x` to an additive unit `y`, then it
semiconjugates `-x` to `-y`."]
theorem units_inv_right {a : M} {x y : Mˣ} (h : SemiconjBy a x y) : SemiconjBy a ↑x⁻¹ ↑y⁻¹ :=
  calc
    a * ↑x⁻¹ = ↑y⁻¹ * (y * a) * ↑x⁻¹ := by rw [Units.inv_mul_cancel_left]
    _        = ↑y⁻¹ * a              := by rw [← h.eq, mul_assoc, Units.mul_inv_cancel_right]
#align semiconj_by.units_inv_right SemiconjBy.units_inv_right
#align add_semiconj_by.add_units_neg_right AddSemiconjBy.addUnits_neg_right

@[to_additive (attr := simp)]
theorem units_inv_right_iff {a : M} {x y : Mˣ} : SemiconjBy a ↑x⁻¹ ↑y⁻¹ ↔ SemiconjBy a x y :=
  ⟨units_inv_right, units_inv_right⟩
#align semiconj_by.units_inv_right_iff SemiconjBy.units_inv_right_iff
#align add_semiconj_by.add_units_neg_right_iff AddSemiconjBy.addUnits_neg_right_iff

/-- If a unit `a` semiconjugates `x` to `y`, then `a⁻¹` semiconjugates `y` to `x`. -/
@[to_additive "If an additive unit `a` semiconjugates `x` to `y`, then `-a` semiconjugates `y` to
`x`."]
theorem units_inv_symm_left {a : Mˣ} {x y : M} (h : SemiconjBy (↑a) x y) : SemiconjBy (↑a⁻¹) y x :=
  calc
    ↑a⁻¹ * y = ↑a⁻¹ * (y * a * ↑a⁻¹) := by rw [Units.mul_inv_cancel_right]
    _ = x * ↑a⁻¹ := by rw [← h.eq, ← mul_assoc, Units.inv_mul_cancel_left]
#align semiconj_by.units_inv_symm_left SemiconjBy.units_inv_symm_left
#align add_semiconj_by.add_units_neg_symm_left AddSemiconjBy.addUnits_neg_symm_left

@[to_additive (attr := simp)]
theorem units_inv_symm_left_iff {a : Mˣ} {x y : M} : SemiconjBy (↑a⁻¹) y x ↔ SemiconjBy (↑a) x y :=
  ⟨units_inv_symm_left, units_inv_symm_left⟩
#align semiconj_by.units_inv_symm_left_iff SemiconjBy.units_inv_symm_left_iff
#align add_semiconj_by.add_units_neg_symm_left_iff AddSemiconjBy.addUnits_neg_symm_left_iff

@[to_additive]
theorem units_val {a x y : Mˣ} (h : SemiconjBy a x y) : SemiconjBy (a : M) x y :=
  congr_arg Units.val h
#align semiconj_by.units_coe SemiconjBy.units_val
#align add_semiconj_by.add_units_coe AddSemiconjBy.addUnits_val

@[to_additive]
theorem units_of_val {a x y : Mˣ} (h : SemiconjBy (a : M) x y) : SemiconjBy a x y :=
  Units.ext h
#align semiconj_by.units_of_coe SemiconjBy.units_of_val
#align add_semiconj_by.add_units_of_coe AddSemiconjBy.addUnits_of_val

@[to_additive (attr := simp)]
theorem units_val_iff {a x y : Mˣ} : SemiconjBy (a : M) x y ↔ SemiconjBy a x y :=
  ⟨units_of_val, units_val⟩
#align semiconj_by.units_coe_iff SemiconjBy.units_val_iff
#align add_semiconj_by.add_units_coe_iff AddSemiconjBy.addUnits_val_iff

@[to_additive (attr := simp)]
theorem pow_right {a x y : M} (h : SemiconjBy a x y) (n : ℕ) : SemiconjBy a (x ^ n) (y ^ n) := by
  induction' n with n ih
  · rw [pow_zero, pow_zero]
    exact SemiconjBy.one_right _
  · rw [pow_succ, pow_succ]
    exact h.mul_right ih
#align semiconj_by.pow_right SemiconjBy.pow_right
#align add_semiconj_by.nsmul_right AddSemiconjBy.nsmul_right

end Monoid

section DivisionMonoid

variable [DivisionMonoid G] {a x y : G}

@[to_additive (attr := simp)]
theorem inv_inv_symm_iff : SemiconjBy a⁻¹ x⁻¹ y⁻¹ ↔ SemiconjBy a y x :=
  inv_involutive.injective.eq_iff.symm.trans <| by
    rw [mul_inv_rev, mul_inv_rev, inv_inv, inv_inv, inv_inv, eq_comm, SemiconjBy]
#align semiconj_by.inv_inv_symm_iff SemiconjBy.inv_inv_symm_iff
#align add_semiconj_by.neg_neg_symm_iff AddSemiconjBy.neg_neg_symm_iff

@[to_additive]

end DivisionMonoid

section Group

variable [Group G] {a x y : G}

@[to_additive (attr := simp)]
theorem inv_right_iff : SemiconjBy a x⁻¹ y⁻¹ ↔ SemiconjBy a x y :=
  @units_inv_right_iff G _ a ⟨x, x⁻¹, mul_inv_self x, inv_mul_self x⟩
    ⟨y, y⁻¹, mul_inv_self y, inv_mul_self y⟩
#align semiconj_by.inv_right_iff SemiconjBy.inv_right_iff
#align add_semiconj_by.neg_right_iff AddSemiconjBy.neg_right_iff

@[to_additive]
theorem inv_right : SemiconjBy a x y → SemiconjBy a x⁻¹ y⁻¹ :=
  inv_right_iff.2
#align semiconj_by.inv_right SemiconjBy.inv_right
#align add_semiconj_by.neg_right AddSemiconjBy.neg_right

@[to_additive (attr := simp)]
theorem inv_symm_left_iff : SemiconjBy a⁻¹ y x ↔ SemiconjBy a x y :=
  @units_inv_symm_left_iff G _ ⟨a, a⁻¹, mul_inv_self a, inv_mul_self a⟩ _ _
#align semiconj_by.inv_symm_left_iff SemiconjBy.inv_symm_left_iff
#align add_semiconj_by.neg_symm_left_iff AddSemiconjBy.neg_symm_left_iff

@[to_additive]
theorem inv_symm_left : SemiconjBy a x y → SemiconjBy a⁻¹ y x :=
  inv_symm_left_iff.2
#align semiconj_by.inv_symm_left SemiconjBy.inv_symm_left
#align add_semiconj_by.neg_symm_left AddSemiconjBy.neg_symm_left

/-- `a` semiconjugates `x` to `a * x * a⁻¹`. -/
@[to_additive "`a` semiconjugates `x` to `a + x + -a`."]
theorem conj_mk (a x : G) : SemiconjBy a x (a * x * a⁻¹) := by
  unfold SemiconjBy; rw [mul_assoc, inv_mul_self, mul_one]
#align semiconj_by.conj_mk SemiconjBy.conj_mk
#align add_semiconj_by.conj_mk AddSemiconjBy.conj_mk

end Group

end SemiconjBy

@[to_additive (attr := simp) addSemiconjBy_iff_eq]
theorem semiconjBy_iff_eq [CancelCommMonoid M] {a x y : M} : SemiconjBy a x y ↔ x = y :=
  ⟨fun h => mul_left_cancel (h.trans (mul_comm _ _)), fun h => by rw [h, SemiconjBy, mul_comm]⟩
#align semiconj_by_iff_eq semiconjBy_iff_eq
#align add_semiconj_by_iff_eq addSemiconjBy_iff_eq

/-- `a` semiconjugates `x` to `a * x * a⁻¹`. -/
@[to_additive AddUnits.mk_addSemiconjBy "`a` semiconjugates `x` to `a + x + -a`."]
theorem Units.mk_semiconjBy [Monoid M] (u : Mˣ) (x : M) : SemiconjBy (↑u) x (u * x * ↑u⁻¹) := by
  unfold SemiconjBy; rw [Units.inv_mul_cancel_right]
#align units.mk_semiconj_by Units.mk_semiconjBy
#align add_units.mk_semiconj_by AddUnits.mk_addSemiconjBy


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

! This file was ported from Lean 3 source module linear_algebra.affine_space.pointwise
! leanprover-community/mathlib commit e96bdfbd1e8c98a09ff75f7ac6204d142debc840
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.LinearAlgebra.AffineSpace.AffineSubspace

/-! # Pointwise instances on `AffineSubspace`s

This file provides the additive action `AffineSubspace.pointwiseAddAction` in the
`Pointwise` locale.

-/

open Affine Pointwise

open Set

namespace AffineSubspace

variable {k : Type _} [Ring k]

variable {V P V₁ P₁ V₂ P₂ : Type _}

variable [AddCommGroup V] [Module k V] [AffineSpace V P]

variable [AddCommGroup V₁] [Module k V₁] [AddTorsor V₁ P₁]

variable [AddCommGroup V₂] [Module k V₂] [AddTorsor V₂ P₂]

/-- The additive action on an affine subspace corresponding to applying the action to every element.

This is available as an instance in the `Pointwise` locale. -/
protected def pointwiseAddAction : AddAction V (AffineSubspace k P) where
  vadd x S := S.map (AffineEquiv.constVAdd k P x)
  zero_vadd p := ((congr_arg fun f => p.map f) <| AffineMap.ext <| zero_vadd _).trans p.map_id
  add_vadd _ _ p :=
    ((congr_arg fun f => p.map f) <| AffineMap.ext <| add_vadd _ _).trans (p.map_map _ _).symm
#align affine_subspace.pointwise_add_action AffineSubspace.pointwiseAddAction

scoped[Pointwise] attribute [instance] AffineSubspace.pointwiseAddAction

open Pointwise

--Porting note: new theorem
theorem pointwise_vadd_eq_map (v : V) (s : AffineSubspace k P) :
    v +ᵥ s = s.map (AffineEquiv.constVAdd k P v) :=
  rfl

@[simp]
theorem coe_pointwise_vadd (v : V) (s : AffineSubspace k P) :
    ((v +ᵥ s : AffineSubspace k P) : Set P) = v +ᵥ (s : Set P) :=
  rfl
#align affine_subspace.coe_pointwise_vadd AffineSubspace.coe_pointwise_vadd

theorem vadd_mem_pointwise_vadd_iff {v : V} {s : AffineSubspace k P} {p : P} :
    v +ᵥ p ∈ v +ᵥ s ↔ p ∈ s :=
  vadd_mem_vadd_set_iff
#align affine_subspace.vadd_mem_pointwise_vadd_iff AffineSubspace.vadd_mem_pointwise_vadd_iff

theorem pointwise_vadd_bot (v : V) : v +ᵥ (⊥ : AffineSubspace k P) = ⊥ := by
  ext; simp [pointwise_vadd_eq_map, map_bot]
#align affine_subspace.pointwise_vadd_bot AffineSubspace.pointwise_vadd_bot

theorem pointwise_vadd_direction (v : V) (s : AffineSubspace k P) :
    (v +ᵥ s).direction = s.direction := by
  rw [pointwise_vadd_eq_map, map_direction]
  exact Submodule.map_id _
#align affine_subspace.pointwise_vadd_direction AffineSubspace.pointwise_vadd_direction

theorem pointwise_vadd_span (v : V) (s : Set P) : v +ᵥ affineSpan k s = affineSpan k (v +ᵥ s) :=
  map_span _ s
#align affine_subspace.pointwise_vadd_span AffineSubspace.pointwise_vadd_span

theorem map_pointwise_vadd (f : P₁ →ᵃ[k] P₂) (v : V₁) (s : AffineSubspace k P₁) :
    (v +ᵥ s).map f = f.linear v +ᵥ s.map f := by
  erw [pointwise_vadd_eq_map, pointwise_vadd_eq_map, map_map, map_map]
  congr 1
  ext
  exact f.map_vadd _ _
#align affine_subspace.map_pointwise_vadd AffineSubspace.map_pointwise_vadd

end AffineSubspace


import number_theory.padics.padic_norm
import basic
import order.filter.basic
import analysis.special_functions.log.base
import analysis.normed.ring.seminorm
import data.nat.digits
import mul_ring_norm_rat

open_locale big_operators

/-!
# Ostrowski's theorem for ℚ

This file states some basic lemmas when the norm is nonarchimedean.

-/

noncomputable theory

variable {f : mul_ring_norm ℚ}

-- If the norm is nonarchimedean, then it's less than one for all naturals.
-- (Done)
lemma nat_norm_le_one (n : ℕ) (harc : is_nonarchimedean f) : f n ≤ 1 :=
begin
  induction n with c hc,
  { simp only [nat.cast_zero, map_zero, zero_le_one], },
  { rw nat.succ_eq_add_one,
    specialize harc c 1,
    rw map_one at harc,
    simp only [nat.cast_add, nat.cast_one],
    exact le_trans harc (max_le hc rfl.ge), },
end

-- If the norm is nonarchimedean, then it's less than one for all integers.
-- (Done)
lemma int_norm_le_one (z : ℤ) (harc : is_nonarchimedean f) : f z ≤ 1 :=
int_norm_bound_iff_nat_norm_bound.mp (λ n, nat_norm_le_one n harc) z

-- If the norm is nonarchimedean, then nontrivial on ℚ implies nontrivial on ℕ.
-- (Not sure whether should be in mathlib or not)
lemma nat_nontriv_of_rat_nontriv (harc : is_nonarchimedean f) (hf : f ≠ 1):
  ∃ n : ℕ, n ≠ 0 ∧ f n < 1 :=
begin
  revert hf,
  contrapose!,
  intro hfnge1,
  have hfnateq1 : ∀ n : ℕ, n ≠ 0 → f n = 1,
  { intros n hnneq0,
    specialize hfnge1 n hnneq0,
    have := nat_norm_le_one n harc,
    linarith },
  ext,
  by_cases h : x = 0,
  { simp only [h, map_zero]},
  { simp,
    rw ← rat.num_div_denom x,
    have hdenomnon0 : (x.denom : ℚ) ≠ 0,
    { norm_cast,
      linarith [x.pos] }, --probably rw on x.pos
    rw ring_norm.div_eq (x.num : ℚ) hdenomnon0,
    have H₁ : f x.num = 1,
    { have pos_num_f_eq_1 : ∀ a : ℚ , (a.num > 0 → f a.num = 1),
      { intros a num_pos,
        have coe_eq : (a.num : ℚ) = (a.num.to_nat : ℚ),
      { norm_cast,
        exact (int.to_nat_of_nonneg (by linarith)).symm, },
      rw coe_eq,
      have a_num_nat_nonzero : a.num.to_nat ≠ 0,
      { intro H,
        rw int.to_nat_eq_zero at H,
        linarith },
      exact hfnateq1 _ a_num_nat_nonzero },
      by_cases hsign : x.num ≥ 0,
      { apply pos_num_f_eq_1,
        rw [rat.zero_iff_num_zero, ←ne.def] at h,
        exact lt_of_le_of_ne hsign h.symm },
      { push_neg at hsign,
        rw ←f.to_fun_eq_coe,
        rw ←f.neg' x.num,
        rw f.to_fun_eq_coe,
        norm_cast,
        rw ←rat.num_neg_eq_neg_num,
        apply pos_num_f_eq_1,
        rw rat.num_neg_eq_neg_num,
        exact neg_pos.mpr hsign} },
    simp [h],
    rw H₁,
    rw [hfnateq1 x.denom (by linarith [x.pos])],
    norm_num,
  }
end

-- I couldn't find this lemma in mathlib. A similar version in mathlib is `one_le_prod_of_one_le`.
lemma real.one_le_prod_of_one_le {l : list ℝ} (hl : ∀ x : ℝ, x ∈ l → 1 ≤ x) : 1 ≤ l.prod :=
begin
  induction l with a l ih,
  { simp only [list.prod_nil], },
  { simp only [list.prod_cons],
    have goal := (ih $ λ a ha, hl a $ list.mem_cons_of_mem _ ha),
    have goal1 := (hl _ $ list.mem_cons_self _ _),
    nlinarith, },
end

-- Show that there is a prime with norm < 1
-- (Not sure whether should be in mathlib or not)
lemma ex_prime_norm_lt_one (harc : is_nonarchimedean f)
  (h : f ≠ 1) : ∃ (p : ℕ) [hp : fact (nat.prime p)], f p < 1 :=
begin
  by_contra',
  obtain ⟨n, hn1, hn2⟩ := nat_nontriv_of_rat_nontriv harc h,
  rw ← nat.prod_factors hn1 at hn2,
  have exp : ∀ q : ℕ, q ∈ nat.factors n → 1 ≤ f q,
  { intros q hq,
    letI : fact (nat.prime q) := {out := nat.prime_of_mem_factors hq},
    specialize this q,
    exact this, },
  simp only [nat.cast_list_prod] at hn2,
  let g : monoid_hom ℚ ℝ :=
  { to_fun   := f,
    map_one' := f.map_one',
    map_mul' := f.map_mul' },
  have hf_mh: f.to_fun = g.to_fun := rfl,
  rw [← f.to_fun_eq_coe, hf_mh, g.to_fun_eq_coe, map_list_prod] at hn2,
  simp only [list.map_map] at hn2,
  have h : ∀ (x ∈ (list.map (g ∘ (coe : ℕ → ℚ)) n.factors)), 1 ≤ x,
  { intros x hx,
    simp only [list.mem_map, function.comp_app] at hx,
    rcases hx with ⟨a, ha1, ha2⟩,
    letI : fact (nat.prime a) := {out := nat.prime_of_mem_factors ha1},
    specialize exp a ha1,
    rw ← ha2,
    convert exp, },
  suffices goal : (1 : ℝ) ≤ (list.map (g ∘ (coe : ℕ → ℚ)) n.factors).prod,
  { linarith },
  { exact real.one_le_prod_of_one_le h },
end

-- (Not sure whether should be in mathlib or not)
lemma prime_triv_nat_triv (harc : is_nonarchimedean f) (H : ∀ p : ℕ , p.prime → f p = 1)
  (n : ℕ) (n_pos : n ≠ 0) : f n = 1 :=
begin
  induction n using nat.strong_induction_on with n hn,
  by_cases nge2 : n < 2,
  { interval_cases n,
    { exfalso, apply n_pos, refl },
    { exact f.map_one' } },
  { push_neg at hn,
    have : n ≠ 1,
    { intro H,
      rw H at nge2,
      apply nge2,
      norm_num },
    obtain ⟨p, p_prime, p_div⟩ := nat.exists_prime_and_dvd this,
    obtain ⟨k, hk⟩ := p_div,
    rw hk,
    rw nat.cast_mul,
    rw f_mul_eq,
    rw H p p_prime,
    rw one_mul,
    have k_pos : k ≠ 0,
    { intro k_zero, apply n_pos, rw hk, rw k_zero, rw mul_zero },
    have kltn : k < n,
    { have := nat.prime.two_le p_prime,
      rw hk,
      have ineq1 : 2*k ≤ p*k,
      { exact mul_le_mul_right' this k },
      have ineq2 : k < 2 * k,
      { nth_rewrite 0 ←one_mul k,
        have : 0 < k,
        { exact zero_lt_iff.mpr k_pos },
        apply (mul_lt_mul_right this).mpr,
        norm_num, },
      exact lt_of_lt_of_le ineq2 ineq1 },
    exact hn k kltn k_pos }
end


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Jens Wagemaker, Aaron Anderson
-/
import ring_theory.coprime.basic
import ring_theory.principal_ideal_domain

/-!
# Divisibility over ℕ and ℤ

This file collects results for the integers and natural numbers that use abstract algebra in
their proofs or cases of ℕ and ℤ being examples of structures in abstract algebra.

## Main statements

* `nat.factors_eq`: the multiset of elements of `nat.factors` is equal to the factors
   given by the `unique_factorization_monoid` instance
* ℤ is a `normalization_monoid`
* ℤ is a `gcd_monoid`

## Tags

prime, irreducible, natural numbers, integers, normalization monoid, gcd monoid,
greatest common divisor, prime factorization, prime factors, unique factorization,
unique factors
-/

namespace nat

instance : wf_dvd_monoid ℕ :=
⟨begin
  refine rel_hom_class.well_founded
    (⟨λ (x : ℕ), if x = 0 then (⊤ : with_top ℕ) else x, _⟩ : dvd_not_unit →r (<))
    (with_top.well_founded_lt nat.lt_wf),
  intros a b h,
  cases a,
  { exfalso, revert h, simp [dvd_not_unit] },
  cases b,
  { simp [succ_ne_zero, with_top.coe_lt_top] },
  cases dvd_and_not_dvd_iff.2 h with h1 h2,
  simp only [succ_ne_zero, with_top.coe_lt_coe, if_false],
  apply lt_of_le_of_ne (nat.le_of_dvd (nat.succ_pos _) h1) (λ con, h2 _),
  rw con,
end⟩

instance : unique_factorization_monoid ℕ :=
⟨λ _, nat.irreducible_iff_prime⟩

end nat

/-- `ℕ` is a gcd_monoid. -/
instance : gcd_monoid ℕ :=
{ gcd := nat.gcd,
  lcm := nat.lcm,
  gcd_dvd_left := nat.gcd_dvd_left ,
  gcd_dvd_right := nat.gcd_dvd_right,
  dvd_gcd := λ a b c, nat.dvd_gcd,
  gcd_mul_lcm := λ a b, by rw [nat.gcd_mul_lcm],
  lcm_zero_left := nat.lcm_zero_left,
  lcm_zero_right := nat.lcm_zero_right }

instance : normalized_gcd_monoid ℕ :=
{ normalize_gcd := λ a b, normalize_eq _,
  normalize_lcm := λ a b, normalize_eq _,
  .. (infer_instance : gcd_monoid ℕ),
  .. (infer_instance : normalization_monoid ℕ) }

lemma gcd_eq_nat_gcd (m n : ℕ) : gcd m n = nat.gcd m n := rfl

lemma lcm_eq_nat_lcm (m n : ℕ) : lcm m n = nat.lcm m n := rfl

namespace int

section normalization_monoid

instance : normalization_monoid ℤ :=
{ norm_unit      := λa:ℤ, if 0 ≤ a then 1 else -1,
  norm_unit_zero := if_pos le_rfl,
  norm_unit_mul  := assume a b hna hnb,
  begin
    cases hna.lt_or_lt with ha ha; cases hnb.lt_or_lt with hb hb;
      simp [mul_nonneg_iff, ha.le, ha.not_le, hb.le, hb.not_le]
  end,
  norm_unit_coe_units := assume u, (units_eq_one_or u).elim
    (assume eq, eq.symm ▸ if_pos zero_le_one)
    (assume eq, eq.symm ▸ if_neg (not_le_of_gt $ show (-1:ℤ) < 0, by dec_trivial)), }

lemma normalize_of_nonneg {z : ℤ} (h : 0 ≤ z) : normalize z = z :=
show z * ↑(ite _ _ _) = z, by rw [if_pos h, units.coe_one, mul_one]

lemma normalize_of_neg {z : ℤ} (h : z < 0) : normalize z = -z :=
show z * ↑(ite _ _ _) = -z,
by rw [if_neg (not_le_of_gt h), units.coe_neg, units.coe_one, mul_neg_one]

lemma normalize_coe_nat (n : ℕ) : normalize (n : ℤ) = n :=
normalize_of_nonneg (coe_nat_le_coe_nat_of_le $ nat.zero_le n)

theorem coe_nat_abs_eq_normalize (z : ℤ) : (z.nat_abs : ℤ) = normalize z :=
begin
  by_cases 0 ≤ z,
  { simp [nat_abs_of_nonneg h, normalize_of_nonneg h] },
  { simp [of_nat_nat_abs_of_nonpos (le_of_not_ge h), normalize_of_neg (lt_of_not_ge h)] }
end

lemma nonneg_of_normalize_eq_self {z : ℤ} (hz : normalize z = z) : 0 ≤ z :=
calc 0 ≤ (z.nat_abs : ℤ) : coe_zero_le _
... = normalize z : coe_nat_abs_eq_normalize _
... = z : hz

lemma nonneg_iff_normalize_eq_self (z : ℤ) : normalize z = z ↔ 0 ≤ z :=
⟨nonneg_of_normalize_eq_self, normalize_of_nonneg⟩

lemma eq_of_associated_of_nonneg {a b : ℤ} (h : associated a b) (ha : 0 ≤ a) (hb : 0 ≤ b) : a = b :=
dvd_antisymm_of_normalize_eq (normalize_of_nonneg ha) (normalize_of_nonneg hb) h.dvd h.symm.dvd

end normalization_monoid

section gcd_monoid

instance : gcd_monoid ℤ :=
{ gcd            := λa b, int.gcd a b,
  lcm            := λa b, int.lcm a b,
  gcd_dvd_left   := assume a b, int.gcd_dvd_left _ _,
  gcd_dvd_right  := assume a b, int.gcd_dvd_right _ _,
  dvd_gcd        := assume a b c, dvd_gcd,
  gcd_mul_lcm    := λ a b, by
  { rw [← int.coe_nat_mul, gcd_mul_lcm, coe_nat_abs_eq_normalize],
    exact normalize_associated (a * b) },
  lcm_zero_left  := assume a, coe_nat_eq_zero.2 $ nat.lcm_zero_left _,
  lcm_zero_right := assume a, coe_nat_eq_zero.2 $ nat.lcm_zero_right _}

instance : normalized_gcd_monoid ℤ :=
{ normalize_gcd  := λ a b, normalize_coe_nat _,
  normalize_lcm  := λ a b, normalize_coe_nat _,
  .. int.normalization_monoid,
  .. (infer_instance : gcd_monoid ℤ) }

lemma coe_gcd (i j : ℤ) : ↑(int.gcd i j) = gcd_monoid.gcd i j := rfl
lemma coe_lcm (i j : ℤ) : ↑(int.lcm i j) = gcd_monoid.lcm i j := rfl

lemma nat_abs_gcd (i j : ℤ) : nat_abs (gcd_monoid.gcd i j) = int.gcd i j := rfl
lemma nat_abs_lcm (i j : ℤ) : nat_abs (gcd_monoid.lcm i j) = int.lcm i j := rfl

end gcd_monoid

lemma exists_unit_of_abs (a : ℤ) : ∃ (u : ℤ) (h : is_unit u), (int.nat_abs a : ℤ) = u * a :=
begin
  cases (nat_abs_eq a) with h,
  { use [1, is_unit_one], rw [← h, one_mul], },
  { use [-1, is_unit_one.neg], rw [ ← neg_eq_iff_neg_eq.mp (eq.symm h)],
    simp only [neg_mul_eq_neg_mul_symm, one_mul] }
end

lemma gcd_eq_nat_abs {a b : ℤ} : int.gcd a b = nat.gcd a.nat_abs b.nat_abs := rfl

lemma gcd_eq_one_iff_coprime {a b : ℤ} : int.gcd a b = 1 ↔ is_coprime a b :=
begin
  split,
  { intro hg,
    obtain ⟨ua, hua, ha⟩ := exists_unit_of_abs a,
    obtain ⟨ub, hub, hb⟩ := exists_unit_of_abs b,
    use [(nat.gcd_a (int.nat_abs a) (int.nat_abs b)) * ua,
        (nat.gcd_b (int.nat_abs a) (int.nat_abs b)) * ub],
    rw [mul_assoc, ← ha, mul_assoc, ← hb, mul_comm, mul_comm _ (int.nat_abs b : ℤ),
      ← nat.gcd_eq_gcd_ab, ←gcd_eq_nat_abs, hg, int.coe_nat_one] },
  { rintro ⟨r, s, h⟩,
    by_contradiction hg,
    obtain ⟨p, ⟨hp, ha, hb⟩⟩ := nat.prime.not_coprime_iff_dvd.mp hg,
    apply nat.prime.not_dvd_one hp,
    rw [←coe_nat_dvd, int.coe_nat_one, ← h],
    exact dvd_add ((coe_nat_dvd_left.mpr ha).mul_left _)
      ((coe_nat_dvd_left.mpr hb).mul_left _) }
end

lemma coprime_iff_nat_coprime {a b : ℤ} : is_coprime a b ↔ nat.coprime a.nat_abs b.nat_abs :=
by rw [←gcd_eq_one_iff_coprime, nat.coprime_iff_gcd_eq_one, gcd_eq_nat_abs]

lemma sq_of_gcd_eq_one {a b c : ℤ} (h : int.gcd a b = 1) (heq : a * b = c ^ 2) :
  ∃ (a0 : ℤ), a = a0 ^ 2 ∨ a = - (a0 ^ 2) :=
begin
  have h' : is_unit (gcd_monoid.gcd a b), { rw [← coe_gcd, h, int.coe_nat_one], exact is_unit_one },
  obtain ⟨d, ⟨u, hu⟩⟩ := exists_associated_pow_of_mul_eq_pow h' heq,
  use d,
  rw ← hu,
  cases int.units_eq_one_or u with hu' hu'; { rw hu', simp }
end

lemma sq_of_coprime {a b c : ℤ} (h : is_coprime a b) (heq : a * b = c ^ 2) :
  ∃ (a0 : ℤ), a = a0 ^ 2 ∨ a = - (a0 ^ 2) := sq_of_gcd_eq_one (gcd_eq_one_iff_coprime.mpr h) heq

lemma nat_abs_euclidean_domain_gcd (a b : ℤ) :
  int.nat_abs (euclidean_domain.gcd a b) = int.gcd a b :=
begin
  apply nat.dvd_antisymm; rw ← int.coe_nat_dvd,
  { rw int.nat_abs_dvd,
    exact int.dvd_gcd (euclidean_domain.gcd_dvd_left _ _) (euclidean_domain.gcd_dvd_right _ _) },
  { rw int.dvd_nat_abs,
    exact euclidean_domain.dvd_gcd (int.gcd_dvd_left _ _) (int.gcd_dvd_right _ _) }
end

end int

lemma nat.prime_iff_prime_int {p : ℕ} : p.prime ↔ _root_.prime (p : ℤ) :=
⟨λ hp, ⟨int.coe_nat_ne_zero_iff_pos.2 hp.pos, mt int.is_unit_iff_nat_abs_eq.1 hp.ne_one,
  λ a b h, by rw [← int.dvd_nat_abs, int.coe_nat_dvd, int.nat_abs_mul, hp.dvd_mul] at h;
    rwa [← int.dvd_nat_abs, int.coe_nat_dvd, ← int.dvd_nat_abs, int.coe_nat_dvd]⟩,
  λ hp, nat.prime_iff.2 ⟨int.coe_nat_ne_zero.1 hp.1,
      mt nat.is_unit_iff.1 $ λ h, by simpa [h, not_prime_one] using hp,
    λ a b, by simpa only [int.coe_nat_dvd, (int.coe_nat_mul _ _).symm] using hp.2.2 a b⟩⟩

/-- Maps an associate class of integers consisting of `-n, n` to `n : ℕ` -/
def associates_int_equiv_nat : associates ℤ ≃ ℕ :=
begin
  refine ⟨λz, z.out.nat_abs, λn, associates.mk n, _, _⟩,
  { refine (assume a, quotient.induction_on' a $ assume a,
      associates.mk_eq_mk_iff_associated.2 $ associated.symm $ ⟨norm_unit a, _⟩),
    show normalize a = int.nat_abs (normalize a),
    rw [int.coe_nat_abs_eq_normalize, normalize_idem] },
  { intro n,
    dsimp,
    rw [←normalize_apply, ← int.coe_nat_abs_eq_normalize, int.nat_abs_of_nat, int.nat_abs_of_nat] }
end

lemma int.prime.dvd_mul {m n : ℤ} {p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ m * n) : p ∣ m.nat_abs ∨ p ∣ n.nat_abs :=
begin
  apply (nat.prime.dvd_mul hp).mp,
  rw ← int.nat_abs_mul,
  exact int.coe_nat_dvd_left.mp h
end

lemma int.prime.dvd_mul' {m n : ℤ} {p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ m * n) : (p : ℤ) ∣ m ∨ (p : ℤ) ∣ n :=
begin
  rw [int.coe_nat_dvd_left, int.coe_nat_dvd_left],
  exact int.prime.dvd_mul hp h
end

lemma int.prime.dvd_pow {n : ℤ} {k p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ n ^ k) : p  ∣ n.nat_abs :=
begin
  apply @nat.prime.dvd_of_dvd_pow _ _ k hp,
  rw ← int.nat_abs_pow,
  exact int.coe_nat_dvd_left.mp h
end

lemma int.prime.dvd_pow' {n : ℤ} {k p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ n ^ k) : (p : ℤ)  ∣ n :=
begin
  rw int.coe_nat_dvd_left,
  exact int.prime.dvd_pow hp h
end

lemma prime_two_or_dvd_of_dvd_two_mul_pow_self_two {m : ℤ} {p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ 2 * m ^ 2) : p = 2 ∨ p ∣ int.nat_abs m :=
begin
  cases int.prime.dvd_mul hp h with hp2 hpp,
  { apply or.intro_left,
    exact le_antisymm (nat.le_of_dvd zero_lt_two hp2) (nat.prime.two_le hp) },
  { apply or.intro_right,
    rw [sq, int.nat_abs_mul] at hpp,
    exact (or_self _).mp ((nat.prime.dvd_mul hp).mp hpp)}
end

lemma int.exists_prime_and_dvd {n : ℤ} (n2 : 2 ≤ n.nat_abs) : ∃ p, prime p ∧ p ∣ n :=
begin
  obtain ⟨p, pp, pd⟩ := nat.exists_prime_and_dvd n2,
  exact ⟨p, nat.prime_iff_prime_int.mp pp, int.coe_nat_dvd_left.mpr pd⟩,
end

open unique_factorization_monoid

theorem nat.factors_eq {n : ℕ} : normalized_factors n = n.factors :=
begin
  cases n, { simp },
  rw [← multiset.rel_eq, ← associated_eq_eq],
  apply factors_unique (irreducible_of_normalized_factor) _,
  { rw [multiset.coe_prod, nat.prod_factors (nat.succ_pos _)],
    apply normalized_factors_prod (nat.succ_ne_zero _) },
  { apply_instance },
  { intros x hx,
    rw [nat.irreducible_iff_prime, ← nat.prime_iff],
    exact nat.prime_of_mem_factors hx }
end

lemma nat.factors_multiset_prod_of_irreducible
  {s : multiset ℕ} (h : ∀ (x : ℕ), x ∈ s → irreducible x) :
  normalized_factors (s.prod) = s :=
begin
  rw [← multiset.rel_eq, ← associated_eq_eq],
  apply unique_factorization_monoid.factors_unique irreducible_of_normalized_factor h
    (normalized_factors_prod _),
  rw [ne.def, multiset.prod_eq_zero_iff],
  intro con,
  exact not_irreducible_zero (h 0 con),
end

namespace multiplicity

lemma finite_int_iff_nat_abs_finite {a b : ℤ} : finite a b ↔ finite a.nat_abs b.nat_abs :=
by simp only [finite_def, ← int.nat_abs_dvd_iff_dvd, int.nat_abs_pow]

lemma finite_int_iff {a b : ℤ} : finite a b ↔ (a.nat_abs ≠ 1 ∧ b ≠ 0) :=
by rw [finite_int_iff_nat_abs_finite, finite_nat_iff, pos_iff_ne_zero, int.nat_abs_ne_zero]

instance decidable_nat : decidable_rel (λ a b : ℕ, (multiplicity a b).dom) :=
λ a b, decidable_of_iff _ finite_nat_iff.symm

instance decidable_int : decidable_rel (λ a b : ℤ, (multiplicity a b).dom) :=
λ a b, decidable_of_iff _ finite_int_iff.symm

end multiplicity

lemma induction_on_primes {P : ℕ → Prop} (h₀ : P 0) (h₁ : P 1)
  (h : ∀ p a : ℕ, p.prime → P a → P (p * a)) (n : ℕ) : P n :=
begin
  apply unique_factorization_monoid.induction_on_prime,
  exact h₀,
  { intros n h,
    rw nat.is_unit_iff.1 h,
    exact h₁, },
  { intros a p _ hp ha,
    exact h p a (nat.prime_iff.2 hp) ha, },
end

lemma int.associated_nat_abs (k : ℤ) : associated k k.nat_abs :=
associated_of_dvd_dvd (int.coe_nat_dvd_right.mpr dvd_rfl) (int.nat_abs_dvd.mpr dvd_rfl)

lemma int.prime_iff_nat_abs_prime {k : ℤ} : prime k ↔ nat.prime k.nat_abs :=
(int.associated_nat_abs k).prime_iff.trans nat.prime_iff_prime_int.symm

theorem int.associated_iff_nat_abs {a b : ℤ} : associated a b ↔ a.nat_abs = b.nat_abs :=
begin
  rw [←dvd_dvd_iff_associated, ←int.nat_abs_dvd_iff_dvd,
      ←int.nat_abs_dvd_iff_dvd, dvd_dvd_iff_associated],
  exact associated_iff_eq,
end

lemma int.associated_iff {a b : ℤ} : associated a b ↔ (a = b ∨ a = -b) :=
begin
  rw int.associated_iff_nat_abs,
  exact int.nat_abs_eq_nat_abs_iff,
end

namespace int

lemma zmultiples_nat_abs (a : ℤ) :
  add_subgroup.zmultiples (a.nat_abs : ℤ) = add_subgroup.zmultiples a :=
le_antisymm
  (add_subgroup.zmultiples_subset (mem_zmultiples_iff.mpr (dvd_nat_abs.mpr (dvd_refl a))))
  (add_subgroup.zmultiples_subset (mem_zmultiples_iff.mpr (nat_abs_dvd.mpr (dvd_refl a))))

lemma span_nat_abs (a : ℤ) : ideal.span ({a.nat_abs} : set ℤ) = ideal.span {a} :=
by { rw ideal.span_singleton_eq_span_singleton, exact (associated_nat_abs _).symm }

theorem eq_pow_of_mul_eq_pow_bit1_left {a b c : ℤ}
  (hab : is_coprime a b) {k : ℕ} (h : a * b = c ^ (bit1 k)) : ∃ d, a = d ^ (bit1 k) :=
begin
  obtain ⟨d, hd⟩ := exists_associated_pow_of_mul_eq_pow' hab h,
  replace hd := hd.symm,
  rw [associated_iff_nat_abs, nat_abs_eq_nat_abs_iff, ←neg_pow_bit1] at hd,
  obtain rfl|rfl := hd; exact ⟨_, rfl⟩,
end

theorem eq_pow_of_mul_eq_pow_bit1_right {a b c : ℤ}
  (hab : is_coprime a b) {k : ℕ} (h : a * b = c ^ (bit1 k)) : ∃ d, b = d ^ (bit1 k) :=
eq_pow_of_mul_eq_pow_bit1_left hab.symm (by rwa mul_comm at h)

theorem eq_pow_of_mul_eq_pow_bit1 {a b c : ℤ}
  (hab : is_coprime a b) {k : ℕ} (h : a * b = c ^ (bit1 k)) :
  (∃ d, a = d ^ (bit1 k)) ∧ (∃ e, b = e ^ (bit1 k)) :=
⟨eq_pow_of_mul_eq_pow_bit1_left hab h, eq_pow_of_mul_eq_pow_bit1_right hab h⟩

end int


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

! This file was ported from Lean 3 source module data.int.basic
! leanprover-community/mathlib commit 728baa2f54e6062c5879a3e397ac6bac323e506f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Tactic.Convert
import Mathlib.Init.Data.Int.Order
import Mathlib.Data.Int.Cast.Basic
import Mathlib.Algebra.Ring.Basic
import Mathlib.Order.Monotone.Basic
import Mathlib.Logic.Nontrivial

/-!
# Basic operations on the integers

This file contains:
* instances on `ℤ`. The stronger one is `Int.linearOrderedCommRing`.
* some basic lemmas about integers
-/

open Nat

namespace Int

instance : Nontrivial ℤ := ⟨⟨0, 1, Int.zero_ne_one⟩⟩

instance : CommRing ℤ where
  zero_mul := Int.zero_mul
  mul_zero := Int.mul_zero
  mul_comm := Int.mul_comm
  left_distrib := Int.mul_add
  right_distrib := Int.add_mul
  mul_one := Int.mul_one
  one_mul := Int.one_mul
  npow n x := x ^ n
  npow_zero _ := rfl
  npow_succ _ _ := by rw [Int.mul_comm]; rfl
  mul_assoc := Int.mul_assoc
  add_comm := Int.add_comm
  add_assoc := Int.add_assoc
  add_zero := Int.add_zero
  zero_add := Int.zero_add
  add_left_neg := Int.add_left_neg
  nsmul := (·*·)
  nsmul_zero := Int.zero_mul
  nsmul_succ n x :=
    show (n + 1 : ℤ) * x = x + n * x
    by rw [Int.add_mul, Int.add_comm, Int.one_mul]
  zsmul := (·*·)
  zsmul_zero' := Int.zero_mul
  zsmul_succ' m n := by
    simp only [ofNat_eq_coe, ofNat_succ, Int.add_mul, Int.add_comm, Int.one_mul]
  zsmul_neg' m n := by simp only [negSucc_coe, ofNat_succ, Int.neg_mul]
  sub_eq_add_neg _ _ := Int.sub_eq_add_neg
  natCast := (·)
  natCast_zero := rfl
  natCast_succ _ := rfl
  intCast := (·)
  intCast_ofNat _ := rfl
  intCast_negSucc _ := rfl

@[simp, norm_cast] lemma cast_id : Int.cast n = n := rfl

@[simp] lemma ofNat_eq_cast : Int.ofNat n = n := rfl

lemma cast_Nat_cast [AddGroupWithOne R] : (Int.cast (Nat.cast n) : R) = Nat.cast n :=
  Int.cast_ofNat _

@[norm_cast]
lemma cast_eq_cast_iff_Nat (m n : ℕ) : (m : ℤ) = (n : ℤ) ↔ m = n := ofNat_inj

@[simp, norm_cast]
lemma natAbs_cast (n : ℕ) : natAbs ↑n = n := rfl

@[norm_cast]
protected lemma coe_nat_sub {n m : ℕ} : n ≤ m → (↑(m - n) : ℤ) = ↑m - ↑n := ofNat_sub

@[to_additive (attr := simp, norm_cast) coe_nat_zsmul]
theorem _root_.zpow_coe_nat [DivInvMonoid G] (a : G) (n : ℕ) : a ^ (Nat.cast n : ℤ) = a ^ n :=
zpow_ofNat ..
#align coe_nat_zsmul coe_nat_zsmul

/-! ### Extra instances to short-circuit type class resolution

These also prevent non-computable instances like `Int.normedCommRing` being used to construct
these instances non-computably.
-/
instance : AddCommMonoid ℤ    := by infer_instance
instance : AddMonoid ℤ        := by infer_instance
instance : Monoid ℤ           := by infer_instance
instance : CommMonoid ℤ       := by infer_instance
instance : CommSemigroup ℤ    := by infer_instance
instance : Semigroup ℤ        := by infer_instance
instance : AddCommGroup ℤ     := by infer_instance
instance : AddGroup ℤ         := by infer_instance
instance : AddCommSemigroup ℤ := by infer_instance
instance : AddSemigroup ℤ     := by infer_instance
instance : CommSemiring ℤ     := by infer_instance
instance : Semiring ℤ         := by infer_instance
instance : Ring ℤ             := by infer_instance
instance : Distrib ℤ          := by infer_instance

#align int.neg_succ_not_nonneg Int.negSucc_not_nonneg
#align int.neg_succ_not_pos Int.negSucc_not_pos
#align int.neg_succ_sub_one Int.negSucc_sub_one
#align int.coe_nat_mul_neg_succ Int.ofNat_mul_negSucc
#align int.neg_succ_mul_coe_nat Int.negSucc_mul_ofNat
#align int.neg_succ_mul_neg_succ Int.negSucc_mul_negSucc

#align int.coe_nat_le Int.ofNat_le
#align int.coe_nat_lt Int.ofNat_lt

theorem coe_nat_inj' {m n : ℕ} : (↑m : ℤ) = ↑n ↔ m = n := Int.ofNat_inj
#align int.coe_nat_inj' Int.coe_nat_inj'

theorem coe_nat_strictMono : StrictMono (· : ℕ → ℤ) := fun _ _ ↦ Int.ofNat_lt.2
#align int.coe_nat_strict_mono Int.coe_nat_strictMono

theorem coe_nat_nonneg (n : ℕ) : 0 ≤ (n : ℤ) := ofNat_le.2 (Nat.zero_le _)
#align int.coe_nat_nonneg Int.coe_nat_nonneg

#align int.neg_of_nat_ne_zero Int.negSucc_ne_zero
#align int.zero_ne_neg_of_nat Int.zero_ne_negSucc

@[simp]
theorem sign_coe_add_one (n : ℕ) : Int.sign (n + 1) = 1 :=
  rfl
#align int.sign_coe_add_one Int.sign_coe_add_one

@[simp]
theorem sign_negSucc (n : ℕ) : Int.sign -[n+1] = -1 :=
  rfl
#align int.sign_neg_succ_of_nat Int.sign_negSucc

/-! ### succ and pred -/

/-- Immediate successor of an integer: `succ n = n + 1` -/
def succ (a : ℤ) := a + 1
#align int.succ Int.succ

/-- Immediate predecessor of an integer: `pred n = n - 1` -/
def pred (a : ℤ) := a - 1
#align int.pred Int.pred

theorem nat_succ_eq_int_succ (n : ℕ) : (Nat.succ n : ℤ) = Int.succ n := rfl
#align int.nat_succ_eq_int_succ Int.nat_succ_eq_int_succ

theorem pred_succ (a : ℤ) : pred (succ a) = a := add_sub_cancel _ _
#align int.pred_succ Int.pred_succ

theorem succ_pred (a : ℤ) : succ (pred a) = a := sub_add_cancel _ _
#align int.succ_pred Int.succ_pred

theorem neg_succ (a : ℤ) : -succ a = pred (-a) := neg_add _ _
#align int.neg_succ Int.neg_succ

theorem succ_neg_succ (a : ℤ) : succ (-succ a) = -a := by rw [neg_succ, succ_pred]
#align int.succ_neg_succ Int.succ_neg_succ

theorem neg_pred (a : ℤ) : -pred a = succ (-a) := by
  rw [neg_eq_iff_eq_neg.mp (neg_succ (-a)), neg_neg]
#align int.neg_pred Int.neg_pred

theorem pred_neg_pred (a : ℤ) : pred (-pred a) = -a := by rw [neg_pred, pred_succ]
#align int.pred_neg_pred Int.pred_neg_pred

theorem pred_nat_succ (n : ℕ) : pred (Nat.succ n) = n := pred_succ n
#align int.pred_nat_succ Int.pred_nat_succ

theorem neg_nat_succ (n : ℕ) : -(Nat.succ n : ℤ) = pred (-n) := neg_succ n
#align int.neg_nat_succ Int.neg_nat_succ

@[norm_cast] theorem coe_pred_of_pos {n : ℕ} (h : 0 < n) : ((n - 1 : ℕ) : ℤ) = (n : ℤ) - 1 := by
  cases n; cases h; simp
#align int.coe_pred_of_pos Int.coe_pred_of_pos

@[elab_as_elim] protected theorem induction_on {p : ℤ → Prop} (i : ℤ)
    (hz : p 0) (hp : ∀ i : ℕ, p i → p (i + 1)) (hn : ∀ i : ℕ, p (-i) → p (-i - 1)) : p i := by
  induction i with
  | ofNat i =>
    induction i with
    | zero => exact hz
    | succ i ih => exact hp _ ih
  | negSucc i =>
    suffices ∀ n : ℕ, p (-n) from this (i + 1)
    intro n; induction n with
    | zero => simp [hz, Nat.cast_zero]
    | succ n ih => convert hn _ ih using 1; simp [sub_eq_neg_add]
#align int.induction_on Int.induction_on

/-! ### nat abs -/

#align int.nat_abs_add_le Int.natAbs_add_le
#align int.nat_abs_sub_le Int.natAbs_sub_le
#align int.nat_abs_neg_of_nat Int.natAbs_negOfNat
#align int.nat_abs_mul Int.natAbs_mul
#align int.nat_abs_mul_nat_abs_eq Int.natAbs_mul_natAbs_eq
#align int.nat_abs_mul_self' Int.natAbs_mul_self'
#align int.neg_succ_of_nat_eq' Int.negSucc_eq'

@[deprecated natAbs_ne_zero]
theorem natAbs_ne_zero_of_ne_zero : ∀ {a : ℤ}, a ≠ 0 → natAbs a ≠ 0 := natAbs_ne_zero.2
#align int.nat_abs_ne_zero_of_ne_zero Int.natAbs_ne_zero_of_ne_zero

#align int.nat_abs_eq_zero Int.natAbs_eq_zero
#align int.nat_abs_ne_zero Int.natAbs_ne_zero
#align int.nat_abs_lt_nat_abs_of_nonneg_of_lt Int.natAbs_lt_natAbs_of_nonneg_of_lt
#align int.nat_abs_eq_nat_abs_iff Int.natAbs_eq_natAbs_iff
#align int.nat_abs_eq_iff Int.natAbs_eq_iff

/-! ### `/`  -/

-- Porting note: Many of the theorems in this section are dubious alignments because the default
-- division on `Int` has changed from the E-rounding convention to the T-rounding convention
-- (see `Int.ediv`). We have attempted to align the theorems to continue to use the `/` symbol
-- where possible, but some theorems fail to hold on T-rounding division and have been aligned to
-- `Int.ediv` instead.

#align int.of_nat_div Int.ofNat_div

@[simp, norm_cast] theorem coe_nat_div (m n : ℕ) : ((m / n : ℕ) : ℤ) = m / n := rfl
#align int.coe_nat_div Int.coe_nat_div

theorem coe_nat_ediv (m n : ℕ) : ((m / n : ℕ) : ℤ) = ediv m n := rfl

#align int.neg_succ_of_nat_div Int.negSucc_ediv

#align int.div_neg Int.div_negₓ -- int div alignment

theorem ediv_of_neg_of_pos {a b : ℤ} (Ha : a < 0) (Hb : 0 < b) : ediv a b = -((-a - 1) / b + 1) :=
  match a, b, eq_negSucc_of_lt_zero Ha, eq_succ_of_zero_lt Hb with
  | _, _, ⟨m, rfl⟩, ⟨n, rfl⟩ => by
    rw [show (- -[m+1] : ℤ) = (m + 1 : ℤ) by rfl]; rw [add_sub_cancel]; rfl
#align int.div_of_neg_of_pos Int.ediv_of_neg_of_pos

#align int.div_nonneg Int.div_nonnegₓ -- int div alignment
#align int.div_neg' Int.ediv_neg'
#align int.div_one Int.div_oneₓ -- int div alignment
#align int.div_eq_zero_of_lt Int.div_eq_zero_of_ltₓ -- int div alignment

/-! ### mod -/

#align int.of_nat_mod Int.ofNat_mod_ofNat

@[simp, norm_cast] theorem coe_nat_mod (m n : ℕ) : (↑(m % n) : ℤ) = ↑m % ↑n := rfl
#align int.coe_nat_mod Int.coe_nat_mod

#align int.neg_succ_of_nat_mod Int.negSucc_emod
#align int.mod_neg Int.mod_negₓ -- int div alignment
#align int.zero_mod Int.zero_modₓ -- int div alignment
#align int.mod_zero Int.mod_zeroₓ -- int div alignment
#align int.mod_one Int.mod_oneₓ -- int div alignment
#align int.mod_eq_of_lt Int.emod_eq_of_lt -- int div alignment
#align int.mod_add_div Int.emod_add_ediv -- int div alignment
#align int.div_add_mod Int.div_add_modₓ -- int div alignment
#align int.mod_add_div' Int.mod_add_div'ₓ -- int div alignment
#align int.div_add_mod' Int.div_add_mod'ₓ -- int div alignment
#align int.mod_def Int.mod_defₓ -- int div alignment

/-! ### properties of `/` and `%` -/

#align int.mul_div_mul_of_pos Int.mul_ediv_mul_of_pos
#align int.mul_div_mul_of_pos_left Int.mul_ediv_mul_of_pos_left
#align int.mul_mod_mul_of_pos Int.mul_emod_mul_of_pos
#align int.mul_div_cancel_of_mod_eq_zero Int.mul_div_cancel_of_mod_eq_zeroₓ -- int div alignment
#align int.div_mul_cancel_of_mod_eq_zero Int.div_mul_cancel_of_mod_eq_zeroₓ -- int div alignment

#align int.nat_abs_sign Int.natAbs_sign
#align int.nat_abs_sign_of_nonzero Int.natAbs_sign_of_nonzero

theorem sign_coe_nat_of_nonzero {n : ℕ} (hn : n ≠ 0) : Int.sign n = 1 := sign_ofNat_of_nonzero hn
#align int.sign_coe_nat_of_nonzero Int.sign_coe_nat_of_nonzero

#align int.div_sign Int.div_sign -- int div alignment
#align int.of_nat_add_neg_succ_of_nat_of_lt Int.ofNat_add_negSucc_of_lt
#align int.neg_add_neg Int.negSucc_add_negSucc

/-! ### toNat -/

#align int.to_nat_eq_max Int.toNat_eq_max
#align int.to_nat_zero Int.toNat_zero
#align int.to_nat_one Int.toNat_one
#align int.to_nat_of_nonneg Int.toNat_of_nonneg

@[simp] theorem toNat_coe_nat (n : ℕ) : toNat ↑n = n := rfl
#align int.to_nat_coe_nat Int.toNat_coe_nat

@[simp] theorem toNat_coe_nat_add_one {n : ℕ} : ((n : ℤ) + 1).toNat = n + 1 := rfl
#align int.to_nat_coe_nat_add_one Int.toNat_coe_nat_add_one

#align int.le_to_nat Int.self_le_toNat
#align int.le_to_nat_iff Int.le_toNat
#align int.to_nat_add Int.toNat_add
#align int.to_nat_add_nat Int.toNat_add_nat
#align int.pred_to_nat Int.pred_toNat
#align int.to_nat_sub_to_nat_neg Int.toNat_sub_toNat_neg
#align int.to_nat_add_to_nat_neg_eq_nat_abs Int.toNat_add_toNat_neg_eq_natAbs
#align int.mem_to_nat' Int.mem_toNat'
#align int.to_nat_neg_nat Int.toNat_neg_nat


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import data.equiv.list
import data.set.finite

/-!
# Countable sets
-/
noncomputable theory

open function set encodable

open classical (hiding some)
open_locale classical
universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}

namespace set

/-- A set is countable if there exists an encoding of the set into the natural numbers.
An encoding is an injection with a partial inverse, which can be viewed as a
constructive analogue of countability. (For the most part, theorems about
`countable` will be classical and `encodable` will be constructive.)
-/
def countable (s : set α) : Prop := nonempty (encodable s)

lemma countable_iff_exists_injective {s : set α} :
  countable s ↔ ∃f:s → ℕ, injective f :=
⟨λ ⟨h⟩, by exactI ⟨encode, encode_injective⟩,
 λ ⟨f, h⟩, ⟨⟨f, partial_inv f, partial_inv_left h⟩⟩⟩

/-- A set `s : set α` is countable if and only if there exists a function `α → ℕ` injective
on `s`. -/
lemma countable_iff_exists_inj_on {s : set α} :
  countable s ↔ ∃ f : α → ℕ, inj_on f s :=
countable_iff_exists_injective.trans
⟨λ ⟨f, hf⟩, ⟨λ a, if h : a ∈ s then f ⟨a, h⟩ else 0,
   λ a as b bs h, congr_arg subtype.val $
     hf $ by simpa [as, bs] using h⟩,
 λ ⟨f, hf⟩, ⟨_, inj_on_iff_injective.1 hf⟩⟩

lemma countable_iff_exists_surjective [ne : nonempty α] {s : set α} :
  countable s ↔ ∃f:ℕ → α, s ⊆ range f :=
⟨λ ⟨h⟩, by inhabit α; exactI ⟨λ n, ((decode s n).map subtype.val).iget,
  λ a as, ⟨encode (⟨a, as⟩ : s), by simp [encodek]⟩⟩,
 λ ⟨f, hf⟩, ⟨⟨
  λ x, inv_fun f x.1,
  λ n, if h : f n ∈ s then some ⟨f n, h⟩ else none,
  λ ⟨x, hx⟩, begin
    have := inv_fun_eq (hf hx), dsimp at this ⊢,
    simp [this, hx]
  end⟩⟩⟩

/--
A non-empty set is countable iff there exists a surjection from the
natural numbers onto the subtype induced by the set.
-/
lemma countable_iff_exists_surjective_to_subtype {s : set α} (hs : s.nonempty) :
  countable s ↔ ∃ f : ℕ → s, surjective f :=
have inhabited s, from ⟨classical.choice hs.to_subtype⟩,
have countable s → ∃ f : ℕ → s, surjective f, from assume ⟨h⟩,
  by exactI ⟨λ n, (decode s n).iget, λ a, ⟨encode a, by simp [encodek]⟩⟩,
have (∃ f : ℕ → s, surjective f) → countable s, from assume ⟨f, fsurj⟩,
  ⟨⟨inv_fun f, option.some ∘ f,
    by intro h; simp [(inv_fun_eq (fsurj h) : f (inv_fun f h) = h)]⟩⟩,
by split; assumption

/-- Convert `countable s` to `encodable s` (noncomputable). -/
def countable.to_encodable {s : set α} : countable s → encodable s :=
classical.choice

lemma countable_encodable' (s : set α) [H : encodable s] : countable s :=
⟨H⟩

lemma countable_encodable [encodable α] (s : set α) : countable s :=
⟨by apply_instance⟩

/-- If `s : set α` is a nonempty countable set, then there exists a map
`f : ℕ → α` such that `s = range f`. -/
lemma countable.exists_surjective {s : set α} (hc : countable s) (hs : s.nonempty) :
  ∃f:ℕ → α, s = range f :=
begin
  letI : encodable s := countable.to_encodable hc,
  letI : nonempty s := hs.to_subtype,
  have : countable (univ : set s) := countable_encodable _,
  rcases countable_iff_exists_surjective.1 this with ⟨g, hg⟩,
  have : range g = univ := univ_subset_iff.1 hg,
  use coe ∘ g,
  simp only [range_comp, this, image_univ, subtype.range_coe]
end

@[simp]

@[simp] lemma countable_singleton (a : α) : countable ({a} : set α) :=
⟨of_equiv _ (equiv.set.singleton a)⟩

lemma countable.mono {s₁ s₂ : set α} (h : s₁ ⊆ s₂) : countable s₂ → countable s₁
| ⟨H⟩ := ⟨@of_inj _ _ H _ (embedding_of_subset _ _ h).2⟩

lemma countable.image {s : set α} (hs : countable s) (f : α → β) : countable (f '' s) :=
let f' : s → f '' s := λ⟨a, ha⟩, ⟨f a, mem_image_of_mem f ha⟩ in
have hf' : surjective f', from assume ⟨b, a, ha, hab⟩, ⟨⟨a, ha⟩, subtype.eq hab⟩,
⟨@encodable.of_inj _ _ hs.to_encodable (surj_inv hf') (injective_surj_inv hf')⟩

lemma countable_range [encodable α] (f : α → β) : countable (range f) :=
by rw ← image_univ; exact (countable_encodable _).image _

lemma exists_seq_supr_eq_top_iff_countable [complete_lattice α] {p : α → Prop} (h : ∃ x, p x) :
  (∃ s : ℕ → α, (∀ n, p (s n)) ∧ (⨆ n, s n) = ⊤) ↔
    ∃ S : set α, countable S ∧ (∀ s ∈ S, p s) ∧ Sup S = ⊤ :=
begin
  split,
  { rintro ⟨s, hps, hs⟩,
    refine ⟨range s, countable_range s, forall_range_iff.2 hps, _⟩, rwa Sup_range },
  { rintro ⟨S, hSc, hps, hS⟩,
    rcases eq_empty_or_nonempty S with rfl|hne,
    { rw [Sup_empty] at hS, haveI := subsingleton_of_bot_eq_top hS,
      rcases h with ⟨x, hx⟩, exact ⟨λ n, x, λ n, hx, subsingleton.elim _ _⟩ },
    { rcases (countable_iff_exists_surjective_to_subtype hne).1 hSc with ⟨s, hs⟩,
      refine ⟨λ n, s n, λ n, hps _ (s n).coe_prop, _⟩,
      rwa [hs.supr_comp, ← Sup_eq_supr'] } }
end

lemma exists_seq_cover_iff_countable {p : set α → Prop} (h : ∃ s, p s) :
  (∃ s : ℕ → set α, (∀ n, p (s n)) ∧ (⋃ n, s n) = univ) ↔
    ∃ S : set (set α), countable S ∧ (∀ s ∈ S, p s) ∧ ⋃₀ S = univ :=
exists_seq_supr_eq_top_iff_countable h

lemma countable_of_injective_of_countable_image {s : set α} {f : α → β}
  (hf : inj_on f s) (hs : countable (f '' s)) : countable s :=
let ⟨g, hg⟩ := countable_iff_exists_inj_on.1 hs in
countable_iff_exists_inj_on.2 ⟨g ∘ f, hg.comp hf (maps_to_image _ _)⟩

lemma countable_Union {t : α → set β} [encodable α] (ht : ∀a, countable (t a)) :
  countable (⋃a, t a) :=
by haveI := (λ a, (ht a).to_encodable);
   rw Union_eq_range_sigma; apply countable_range

lemma countable.bUnion
  {s : set α} {t : Π x ∈ s, set β} (hs : countable s) (ht : ∀a∈s, countable (t a ‹_›)) :
  countable (⋃a∈s, t a ‹_›) :=
begin
  rw bUnion_eq_Union,
  haveI := hs.to_encodable,
  exact countable_Union (by simpa using ht)
end

lemma countable.sUnion {s : set (set α)} (hs : countable s) (h : ∀a∈s, countable a) :
  countable (⋃₀ s) :=
by rw sUnion_eq_bUnion; exact hs.bUnion h

lemma countable_Union_Prop {p : Prop} {t : p → set β} (ht : ∀h:p, countable (t h)) :
  countable (⋃h:p, t h) :=
by by_cases p; simp [h, ht]

lemma countable.union
  {s₁ s₂ : set α} (h₁ : countable s₁) (h₂ : countable s₂) : countable (s₁ ∪ s₂) :=
by rw union_eq_Union; exact
countable_Union (bool.forall_bool.2 ⟨h₂, h₁⟩)

lemma countable.insert {s : set α} (a : α) (h : countable s) : countable (insert a s) :=
by { rw [set.insert_eq], exact (countable_singleton _).union h }

lemma finite.countable {s : set α} : finite s → countable s
| ⟨h⟩ := trunc.nonempty (by exactI trunc_encodable_of_fintype s)

/-- The set of finite subsets of a countable set is countable. -/
lemma countable_set_of_finite_subset {s : set α} : countable s →
  countable {t | finite t ∧ t ⊆ s} | ⟨h⟩ :=
begin
  resetI,
  refine countable.mono _ (countable_range
    (λ t : finset s, {a | ∃ h:a ∈ s, subtype.mk a h ∈ t})),
  rintro t ⟨⟨ht⟩, ts⟩, resetI,
  refine ⟨finset.univ.map (embedding_of_subset _ _ ts),
    set.ext $ λ a, _⟩,
  suffices : a ∈ s ∧ a ∈ t ↔ a ∈ t, by simpa,
  exact ⟨and.right, λ h, ⟨ts h, h⟩⟩
end

lemma countable_pi {π : α → Type*} [fintype α] {s : Πa, set (π a)} (hs : ∀a, countable (s a)) :
  countable {f : Πa, π a | ∀a, f a ∈ s a} :=
countable.mono
  (show {f : Πa, π a | ∀a, f a ∈ s a} ⊆ range (λf : Πa, s a, λa, (f a).1), from
    assume f hf, ⟨λa, ⟨f a, hf a⟩, funext $ assume a, rfl⟩) $
have trunc (encodable (Π (a : α), s a)), from
  @encodable.fintype_pi α _ _ _ (assume a, (hs a).to_encodable),
trunc.induction_on this $ assume h,
@countable_range _ _ h _

protected lemma countable.prod {s : set α} {t : set β} (hs : countable s) (ht : countable t) :
  countable (set.prod s t) :=
begin
  haveI : encodable s := hs.to_encodable,
  haveI : encodable t := ht.to_encodable,
  haveI : encodable (s × t) := by apply_instance,
  have : range (prod.map coe coe : s × t → α × β) = set.prod s t,
    by rw [range_prod_map, subtype.range_coe, subtype.range_coe],
  rw ← this,
  exact countable_range _
end

lemma countable.image2 {s : set α} {t : set β} (hs : countable s) (ht : countable t)
  (f : α → β → γ) : countable (image2 f s t) :=
by { rw ← image_prod, exact (hs.prod ht).image _ }

section enumerate

/-- Enumerate elements in a countable set.-/
def enumerate_countable {s : set α} (h : countable s) (default : α) : ℕ → α :=
assume n, match @encodable.decode s (h.to_encodable) n with
        | (some y) := y
        | (none)   := default
        end

lemma subset_range_enumerate {s : set α} (h : countable s) (default : α) :
   s ⊆ range (enumerate_countable h default) :=
assume x hx,
⟨@encodable.encode s h.to_encodable ⟨x, hx⟩,
by simp [enumerate_countable, encodable.encodek]⟩

end enumerate

end set

lemma finset.countable_to_set (s : finset α) : set.countable (↑s : set α) :=
s.finite_to_set.countable


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

import analysis.special_functions.sqrt

/-!
# IMO 2006 Q3

Determine the least real number $M$ such that
$$
\left| ab(a^2 - b^2) + bc(b^2 - c^2) + ca(c^2 - a^2) \right|
≤ M (a^2 + b^2 + c^2)^2
$$
for all real numbers $a$, $b$, $c$.

## Solution

The answer is $M = \frac{9 \sqrt 2}{32}$.

This is essentially a translation of the solution in
https://web.evanchen.cc/exams/IMO-2006-notes.pdf.

It involves making the substitution
`x = a - b`, `y = b - c`, `z = c - a`, `s = a + b + c`.
-/

open real

/-- Replacing `x` and `y` with their average increases the left side. -/
lemma lhs_ineq {x y : ℝ} (hxy : 0 ≤ x * y) :
  16 * x ^ 2 * y ^ 2 * (x + y) ^ 2 ≤ ((x + y) ^ 2) ^ 3 :=
begin
  conv_rhs { rw pow_succ' },
  refine mul_le_mul_of_nonneg_right _ (sq_nonneg _),
  apply le_of_sub_nonneg,
  calc  ((x + y) ^ 2) ^ 2 - 16 * x ^ 2 * y ^ 2
      = (x - y) ^ 2 * ((x + y) ^ 2 + 4 * (x * y))
          : by ring
  ... ≥ 0 : mul_nonneg (sq_nonneg _) $ add_nonneg (sq_nonneg _) $
              mul_nonneg zero_lt_four.le hxy
end

lemma four_pow_four_pos : (0 : ℝ) < 4 ^ 4 := pow_pos zero_lt_four _

lemma mid_ineq {s t : ℝ} :
  s * t ^ 3 ≤ (3 * t + s) ^ 4 / 4 ^ 4 :=
(le_div_iff four_pow_four_pos).mpr $ le_of_sub_nonneg $
  calc  (3 * t + s) ^ 4 - s * t ^ 3 * 4 ^ 4
      = (s - t) ^ 2 * ((s + 7 * t) ^ 2 + 2 * (4 * t) ^ 2)
          : by ring
  ... ≥ 0 : mul_nonneg (sq_nonneg _) $ add_nonneg (sq_nonneg _) $
              mul_nonneg zero_le_two (sq_nonneg _)

/-- Replacing `x` and `y` with their average decreases the right side. -/
lemma rhs_ineq {x y : ℝ} :
  3 * (x + y) ^ 2 ≤ 2 * (x ^ 2 + y ^ 2 + (x + y) ^ 2) :=
le_of_sub_nonneg $
  calc _ = (x - y) ^ 2 : by ring
     ... ≥ 0           : sq_nonneg _

lemma zero_lt_32 : (0 : ℝ) < 32 := by norm_num

theorem subst_wlog {x y z s : ℝ} (hxy : 0 ≤ x * y) (hxyz : x + y + z = 0) :
  32 * |x * y * z * s| ≤ sqrt 2 * (x^2 + y^2 + z^2 + s^2)^2 :=
have hz : (x + y)^2 = z^2 := neg_eq_of_add_eq_zero_right hxyz ▸ (neg_sq _).symm,
have hs : 0 ≤ 2 * s ^ 2 := mul_nonneg zero_le_two (sq_nonneg s),
have this : _ :=
  calc  (2 * s^2) * (16 * x^2 * y^2 * (x + y)^2)
      ≤ (3 * (x + y)^2 + 2 * s^2)^4 / 4^4 :
          le_trans (mul_le_mul_of_nonneg_left (lhs_ineq hxy) hs) mid_ineq
  ... ≤ (2 * (x^2 + y^2 + (x + y)^2) + 2 * s^2)^4 / 4^4 :
          div_le_div_of_le four_pow_four_pos.le $ pow_le_pow_of_le_left
            (add_nonneg (mul_nonneg zero_lt_three.le (sq_nonneg _)) hs)
            (add_le_add_right rhs_ineq _) _,
le_of_pow_le_pow _ (mul_nonneg (sqrt_nonneg _) (sq_nonneg _)) nat.succ_pos' $
  calc  (32 * |x * y * z * s|) ^ 2
      = 32 * ((2 * s^2) * (16 * x^2 * y^2 * (x + y)^2)) :
          by rw [mul_pow, sq_abs, hz]; ring
  ... ≤ 32 * ((2 * (x^2 + y^2 + (x + y)^2) + 2 * s^2)^4 / 4^4) :
          mul_le_mul_of_nonneg_left this zero_lt_32.le
  ... = (sqrt 2 * (x^2 + y^2 + z^2 + s^2)^2)^2 :
          by rw [mul_pow, sq_sqrt zero_le_two, hz, ←pow_mul, ←mul_add, mul_pow, ←mul_comm_div,
            ←mul_assoc, show 32 / 4 ^ 4 * 2 ^ 4 = (2 : ℝ), by norm_num, show 2 * 2 = 4, by refl]

/-- Proof that `M = 9 * sqrt 2 / 32` works with the substitution. -/
theorem subst_proof₁ (x y z s : ℝ) (hxyz : x + y + z = 0) :
  |x * y * z * s| ≤ sqrt 2 / 32 * (x^2 + y^2 + z^2 + s^2)^2 :=
begin
  wlog h' : 0 ≤ x * y generalizing x y z, swap,
  { rw [div_mul_eq_mul_div, le_div_iff' zero_lt_32],
    exact subst_wlog h' hxyz },
  cases (mul_nonneg_of_three x y z).resolve_left h' with h h,
  { specialize this y z x _ h,
    { rw ← hxyz, ring, },
    { convert this using 2; ring } },
  { specialize this z x y _ h,
    { rw ← hxyz, ring, },
    { convert this using 2; ring } },
end

lemma lhs_identity (a b c : ℝ) :
  a * b * (a^2 - b^2) + b * c * (b^2 - c^2) + c * a * (c^2 - a^2)
  = (a - b) * (b - c) * (c - a) * -(a + b + c) :=
by ring

theorem proof₁ {a b c : ℝ} :
  |a * b * (a^2 - b^2) + b * c * (b^2 - c^2) + c * a * (c^2 - a^2)| ≤
  9 * sqrt 2 / 32 * (a^2 + b^2 + c^2)^2 :=
calc _ = _ : congr_arg _ $ lhs_identity a b c
   ... ≤ _ : subst_proof₁ (a - b) (b - c) (c - a) (-(a + b + c)) (by ring)
   ... = _ : by ring

theorem proof₂ (M : ℝ)
  (h : ∀ a b c : ℝ,
    |a * b * (a^2 - b^2) + b * c * (b^2 - c^2) + c * a * (c^2 - a^2)| ≤
    M * (a^2 + b^2 + c^2)^2) :
  9 * sqrt 2 / 32 ≤ M :=
begin
  have h₁ : ∀ x : ℝ,
    (2 - 3 * x - 2) * (2 - (2 + 3 * x)) * (2 + 3 * x - (2 - 3 * x)) *
    -(2 - 3 * x + 2 + (2 + 3 * x)) = -(18 ^ 2 * x ^ 2 * x),
  { intro, ring },
  have h₂ : ∀ x : ℝ, (2 - 3 * x) ^ 2 + 2 ^ 2 + (2 + 3 * x) ^ 2 = 18 * x ^ 2 + 12,
  { intro, ring },
  have := h (2 - 3 * sqrt 2) 2 (2 + 3 * sqrt 2),
  rw [lhs_identity, h₁, h₂, sq_sqrt zero_le_two,
    abs_neg, abs_eq_self.mpr, ← div_le_iff] at this,
  { convert this using 1, ring },
  { apply pow_pos, norm_num },
  { exact mul_nonneg (mul_nonneg (sq_nonneg _) zero_le_two) (sqrt_nonneg _) }
end

theorem imo2006_q3 (M : ℝ) :
  (∀ a b c : ℝ,
    |a * b * (a^2 - b^2) + b * c * (b^2 - c^2) + c * a * (c^2 - a^2)| ≤
    M * (a^2 + b^2 + c^2)^2) ↔
  9 * sqrt 2 / 32 ≤ M :=
⟨proof₂ M, λ h _ _ _, le_trans proof₁ $ mul_le_mul_of_nonneg_right h $ sq_nonneg _⟩