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

import linear_algebra.free_module.finite.basic
import linear_algebra.matrix.charpoly.coeff

/-!

# Characteristic polynomial

We define the characteristic polynomial of `f : M →ₗ[R] M`, where `M` is a finite and
free `R`-module. The proof that `f.charpoly` is the characteristic polynomial of the matrix of `f`
in any basis is in `linear_algebra/charpoly/to_matrix`.

## Main definition

* `linear_map.charpoly f` : the characteristic polynomial of `f : M →ₗ[R] M`.

-/

universes u v w

variables {R : Type u} {M : Type v} [comm_ring R] [nontrivial R]
variables [add_comm_group M] [module R M] [module.free R M] [module.finite R M] (f : M →ₗ[R] M)

open_locale classical matrix

noncomputable theory

open module.free polynomial matrix

namespace linear_map

section basic

/-- The characteristic polynomial of `f : M →ₗ[R] M`. -/
def charpoly : polynomial R :=
(to_matrix (choose_basis R M) (choose_basis R M) f).charpoly

end basic

section coeff

lemma charpoly_monic : f.charpoly.monic := charpoly_monic _

end coeff

section cayley_hamilton

/-- The Cayley-Hamilton Theorem, that the characteristic polynomial of a linear map, applied to
the linear map itself, is zero. -/
lemma aeval_self_charpoly : aeval f f.charpoly = 0 :=
begin
  apply (linear_equiv.map_eq_zero_iff (alg_equiv_matrix _).to_linear_equiv).1,
  rw [alg_equiv.to_linear_equiv_apply, ← alg_equiv.coe_alg_hom,
    ← polynomial.aeval_alg_hom_apply _ _ _, charpoly_def],
  exact aeval_self_charpoly _,
end

lemma is_integral : is_integral R f := ⟨f.charpoly, ⟨charpoly_monic f, aeval_self_charpoly f⟩⟩

lemma minpoly_dvd_charpoly {K : Type u} {M : Type v} [field K] [add_comm_group M] [module K M]
  [finite_dimensional K M] (f : M →ₗ[K] M) : minpoly K f ∣ f.charpoly :=
minpoly.dvd _ _ (aeval_self_charpoly f)

variable {f}

lemma minpoly_coeff_zero_of_injective (hf : function.injective f) : (minpoly R f).coeff 0 ≠ 0 :=
begin
  intro h,
  obtain ⟨P, hP⟩ := X_dvd_iff.2 h,
  have hdegP : P.degree < (minpoly R f).degree,
  { rw [hP, mul_comm],
    refine degree_lt_degree_mul_X (λ h, _),
    rw [h, mul_zero] at hP,
    exact minpoly.ne_zero (is_integral f) hP },
  have hPmonic : P.monic,
  { suffices : (minpoly R f).monic,
    { rwa [monic.def, hP, mul_comm, leading_coeff_mul_X, ← monic.def] at this },
    exact minpoly.monic (is_integral f) },
  have hzero : aeval f (minpoly R f) = 0 := minpoly.aeval _ _,
  simp only [hP, mul_eq_comp, ext_iff, hf, aeval_X, map_eq_zero_iff, coe_comp, alg_hom.map_mul,
    zero_apply] at hzero,
  exact not_le.2 hdegP (minpoly.min _ _ hPmonic (ext hzero)),
end

end cayley_hamilton

end linear_map


import Mathlib.Algebra.GeomSum
import Mathlib.Tactic.FieldSimp
import Mathlib.Tactic.Linarith
import Mathlib.Tactic.LibrarySearch
import Mathlib.Data.Real.Basic

/-!
# IMO 2013 Q5

Let ℚ>₀ be the set of positive rational numbers. Let f: ℚ>₀ → ℝ be a function satisfying
the conditions

  (1) f(x) * f(y) ≥ f(x * y)
  (2) f(x + y)    ≥ f(x) + f(y)

for all x,y ∈ ℚ>₀. Given that f(a) = a for some rational a > 1, prove that f(x) = x for
all x ∈ ℚ>₀.

# Solution

We provide a direct translation of the solution found in
https://www.imo-official.org/problems/IMO2013SL.pdf
-/

open BigOperators

lemma le_of_all_pow_lt_succ {x y : ℝ} (hx : 1 < x) (hy : 1 < y)
    (h : ∀ n : ℕ, 0 < n → x^n - 1 < y^n) :
    x ≤ y := by
  by_contra hxy
  push_neg at hxy
  have hxmy : 0 < x - y := sub_pos.mpr hxy
  have hn : ∀ n : ℕ, 0 < n → (x - y) * (n : ℝ) ≤ x^n - y^n := by
    intros n _
    have hterm : ∀ i : ℕ, i ∈ Finset.range n → 1 ≤ x^i * y^(n - 1 - i) := by
      intros i _
      have hx' : 1 ≤ x ^ i := one_le_pow_of_one_le hx.le i
      have hy' : 1 ≤ y ^ (n - 1 - i) := one_le_pow_of_one_le hy.le (n - 1 - i)
      calc 1 ≤ x^i             := hx'
           _ = x^i * 1         := (mul_one _).symm
           _ ≤ x^i * y^(n-1-i) := mul_le_mul_of_nonneg_left hy' (zero_le_one.trans hx')
    calc (x - y) * (n : ℝ)
        = (n : ℝ) * (x - y) := mul_comm _ _
      _ = (∑ _i in Finset.range n, (1 : ℝ)) * (x - y) :=
                                 by simp only [mul_one, Finset.sum_const, nsmul_eq_mul,
                                    Finset.card_range]
      _ ≤ (∑ i in Finset.range n, x ^ i * y ^ (n - 1 - i)) * (x-y) :=
                                  (mul_le_mul_right hxmy).mpr (Finset.sum_le_sum hterm)
      _ = x^n - y^n         := geom_sum₂_mul x y n

  -- Choose n larger than 1 / (x - y).
  obtain ⟨N, hN⟩ := exists_nat_gt (1 / (x - y))
  have hNp : 0 < N := by exact_mod_cast (one_div_pos.mpr hxmy).trans hN
  have := calc 1 = (x - y) * (1 / (x - y)) := by field_simp [ne_of_gt hxmy]
               _ < (x - y) * N             := (mul_lt_mul_left hxmy).mpr hN
               _ ≤ x^N - y^N               := hn N hNp
  linarith [h N hNp]

/--
 Like le_of_all_pow_lt_succ, but with a weaker assumption for y.
-/
lemma le_of_all_pow_lt_succ' {x y : ℝ} (hx : 1 < x) (hy : 0 < y)
    (h : ∀ n : ℕ, 0 < n → x^n - 1 < y^n) :
    x ≤ y := by
  refine le_of_all_pow_lt_succ hx ?_ h
  by_contra hy''
  push_neg at hy'' -- hy'' : y ≤ 1.

  -- Then there exists y' such that 0 < y ≤ 1 < y' < x.
  let y' := (x + 1) / 2
  have h_y'_lt_x : y' < x := by
    have hh : (x + 1) < (x * 2) := by linarith
    calc y' < (x * 2) / 2 := div_lt_div_of_lt two_pos hh
         _ = x            := by field_simp

  have h1_lt_y' : 1 < y' := by
    have hh' : 1 * 2 < (x + 1) := by linarith
    calc (1:ℝ) = 1 * 2 / 2 := by field_simp
             _ < y'        := div_lt_div_of_lt two_pos hh'

  have h_y_lt_y' : y < y' := hy''.trans_lt h1_lt_y'
  have hh : ∀ n, 0 < n → x^n - 1 < y'^n := by
    intros n hn
    calc x^n - 1 < y^n  := h n hn
         _  ≤ y'^n := pow_le_pow_of_le_left hy.le h_y_lt_y'.le n

  exact h_y'_lt_x.not_le (le_of_all_pow_lt_succ hx h1_lt_y' hh)

lemma f_pos_of_pos {f : ℚ → ℝ} {q : ℚ} (hq : 0 < q)
    (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
    (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n) :
    0 < f q := by
  have hfqn := calc f q.num = f (q * q.den) := by rw [←Rat.mul_den_eq_num]
                    _ ≤ f q * f q.den := H1 q q.den hq (Nat.cast_pos.mpr q.pos)

  -- Now we just need to show that `f q.num` and `f q.denom` are positive.
  -- Then nlinarith will be able to close the goal.
  have num_pos : 0 < q.num := Rat.num_pos_iff_pos.mpr hq
  have hqna : (q.num.natAbs : ℤ) = q.num := Int.natAbs_of_nonneg num_pos.le

  have hqfn' := calc (q.num : ℝ)
         = ((q.num.natAbs : ℤ) : ℝ) := congr_arg Int.cast (Eq.symm hqna)
       _ ≤ f q.num.natAbs           := H4 q.num.natAbs
                                            (Int.natAbs_pos.mpr (ne_of_gt num_pos))
       _ = f q.num                   := by rw [Nat.cast_natAbs, abs_of_nonneg num_pos.le]

  have f_num_pos := calc (0 : ℝ) < q.num := Int.cast_pos.mpr num_pos
                         _ ≤ f q.num     := hqfn'

  have f_den_pos := calc (0 : ℝ) < q.den := Nat.cast_pos.mpr q.pos
                         _ ≤ f q.den     := H4 q.den q.pos

  nlinarith

lemma fx_gt_xm1 {f : ℚ → ℝ} {x : ℚ} (hx : 1 ≤ x)
    (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
    (H2 : ∀ x y, 0 < x → 0 < y → f x + f y ≤ f (x + y))
    (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n) :
    (x - 1 : ℝ) < f x := by
  have hx0 :=
    calc (x - 1 : ℝ)
          < ⌊x⌋₊   := by exact_mod_cast Nat.sub_one_lt_floor x
        _ ≤ f ⌊x⌋₊ := H4 _ (Nat.floor_pos.2 hx)

  obtain h_eq | h_lt := (Nat.floor_le $ zero_le_one.trans hx).eq_or_lt
  · rwa [h_eq] at hx0
  calc (x - 1 : ℝ) < f ⌊x⌋₊ := hx0
    _ < f (x - ⌊x⌋₊) + f ⌊x⌋₊ := lt_add_of_pos_left _ (f_pos_of_pos (sub_pos.mpr h_lt) H1 H4)
    _ ≤ f (x - ⌊x⌋₊ + ⌊x⌋₊)   := H2 _ _ (sub_pos.mpr h_lt) (Nat.cast_pos.2 (Nat.floor_pos.2 hx))
    _ = f x                   := by rw [sub_add_cancel]

lemma pow_f_le_f_pow {f : ℚ → ℝ} {n : ℕ} (hn : 0 < n) {x : ℚ} (hx : 1 < x)
    (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
    (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n) :
    f (x^n) ≤ (f x)^n := by
  induction n with
  | zero => exfalso; exact Nat.lt_asymm hn hn
  | succ pn hpn =>
    cases pn with
    | zero => simp [show Nat.succ 0 = 1 by rfl, pow_one]
    | succ pn =>
      have hpn' := hpn pn.succ_pos
      rw [pow_succ' x (pn + 1), pow_succ' (f x) (pn + 1)]
      have hxp : 0 < x := zero_lt_one.trans hx
      calc f ((x ^ (pn+1)) * x)
          ≤ f (x ^ (pn+1)) * f x := H1 (x ^ (pn+1)) x (pow_pos hxp (pn+1)) hxp
        _ ≤ (f x) ^ (pn+1) * f x := (mul_le_mul_right (f_pos_of_pos hxp H1 H4)).mpr hpn'

lemma fixed_point_of_pos_nat_pow {f : ℚ → ℝ} {n : ℕ} (hn : 0 < n)
    (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
    (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n)
    (H5 : ∀ x : ℚ, 1 < x → (x : ℝ) ≤ f x)
    {a : ℚ} (ha1 : 1 < a) (hae : f a = a) :
    f (a^n) = a^n := by
  have hh0 : (a : ℝ) ^ n ≤ f (a ^ n) := by
    exact_mod_cast H5 (a ^ n) (one_lt_pow ha1 hn.ne')

  have hh1 := calc f (a^n) ≤ (f a)^n := pow_f_le_f_pow hn ha1 H1 H4
                   _ = (a : ℝ)^n     := by rw [←hae]
  exact_mod_cast hh1.antisymm hh0

lemma fixed_point_of_gt_1 {f : ℚ → ℝ} {x : ℚ} (hx : 1 < x)
    (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
    (H2 : ∀ x y, 0 < x → 0 < y → f x + f y ≤ f (x + y))
    (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n)
    (H5 : ∀ x : ℚ, 1 < x → (x : ℝ) ≤ f x)
    {a : ℚ} (ha1 : 1 < a) (hae : f a = a) :
    f x = x := by
  -- Choose n such that 1 + x < a^n.
  obtain ⟨N, hN⟩ := pow_unbounded_of_one_lt (1 + x) ha1
  have h_big_enough : (1:ℚ) < a^N - x := lt_sub_iff_add_lt.mpr hN
  have h1 := calc (x : ℝ) + ((a^N - x) : ℚ)
                ≤ f x + ((a^N - x) : ℚ) := add_le_add_right (H5 x hx) _
              _ ≤ f x + f (a^N - x)     := add_le_add_left (H5 _ h_big_enough) _
  have hxp : 0 < x := zero_lt_one.trans hx
  have hNp : 0 < N := by
    by_contra H; push_neg at H; rw [le_zero_iff.mp H] at hN; linarith

  have h2 := calc f x + f (a^N - x)
                ≤ f (x + (a^N - x)) := H2 x (a^N - x) hxp (zero_lt_one.trans h_big_enough)
              _ = f (a^N)           := by ring_nf
              _ = (a^N : ℝ)         := fixed_point_of_pos_nat_pow hNp H1 H4 H5 ha1 hae
              _ = (x:ℝ) + ((a^N:ℝ) - (x:ℝ))     := by ring

  have heq := h1.antisymm (by exact_mod_cast h2)
  linarith [H5 x hx, H5 _ h_big_enough]

theorem imo2013_q5
    (f : ℚ → ℝ)
    (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
    (H2 : ∀ x y, 0 < x → 0 < y → f x + f y ≤ f (x + y))
    (H_fixed_point : ∃ a, 1 < a ∧ f a = a) :
    ∀ x, 0 < x → f x = x := by
  obtain ⟨a, ha1, hae⟩ := H_fixed_point
  have H3 : ∀ x : ℚ, 0 < x → ∀ n : ℕ, 0 < n → ↑n * f x ≤ f (n * x) := by
    intros x hx n hn
    cases n with
    | zero => exfalso; exact Nat.lt_asymm hn hn
    | succ n =>
      induction n with
      | zero => simp [one_mul, Nat.cast_one]
      | succ pn hpn =>
        calc  ↑(pn + 2) * f x
            = (↑pn + 1 + 1) * f x            := by norm_cast
          _ = (↑pn + 1) * f x + f x          := by ring
          _ ≤ f ((↑pn.succ) * x) + f x       := by exact_mod_cast add_le_add_right
                                                    (hpn pn.succ_pos) (f x)
          _ ≤ f ((↑pn + 1) * x + x)          := by exact_mod_cast H2 _ _
                                                    (mul_pos pn.cast_add_one_pos hx) hx
          _ = f ((↑pn + 1 + 1) * x)          := by ring_nf
          _ = f (↑(pn + 2) * x)              := by norm_cast

  have H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n := by
    intros n hn
    have hf1 : 1 ≤ f 1 := by
      have a_pos : (0 : ℝ) < a := Rat.cast_pos.mpr (zero_lt_one.trans ha1)
      suffices ↑a * 1 ≤ ↑a * f 1 by exact (mul_le_mul_left a_pos).mp this
      calc (a:ℝ) * 1 = ↑a := mul_one _
           _ = f a        := hae.symm
           _ = f (a * 1)  := by rw[mul_one]
           _ ≤ f a * f 1  := (H1 a 1) (zero_lt_one.trans ha1) zero_lt_one
           _ = ↑a * f 1   := by rw[hae]

    calc (n : ℝ) = (n : ℝ) * 1 := (mul_one _).symm
         _ ≤ (n : ℝ) * f 1     := (mul_le_mul_left (Nat.cast_pos.mpr hn)).mpr hf1
         _ ≤ f (n * 1)         := H3 1 zero_lt_one n hn
         _ = f n               := by rw [mul_one]

  have H5 : ∀ x : ℚ, 1 < x → (x : ℝ) ≤ f x := by
    intros x hx
    have hxnm1 : ∀ n : ℕ, 0 < n → (x : ℝ)^n - 1 < (f x)^n := by
      intros n hn
      calc (x : ℝ)^n - 1 < f (x^n) := by exact_mod_cast fx_gt_xm1 (one_le_pow_of_one_le hx.le n)
                                           H1 H2 H4
                       _ ≤ (f x)^n := pow_f_le_f_pow hn hx H1 H4
    have hx' : 1 < (x : ℝ) := by exact_mod_cast hx
    have hxp : 0 < x := zero_lt_one.trans hx
    exact le_of_all_pow_lt_succ' hx' (f_pos_of_pos hxp H1 H4) hxnm1

  have h_f_commutes_with_pos_nat_mul : ∀ n : ℕ, 0 < n → ∀ x : ℚ, 0 < x → f (n * x) = n * f x := by
    intros n hn x hx
    have h2 : f (n * x) ≤ n * f x := by
      cases n with
      | zero => exfalso; exact Nat.lt_asymm hn hn
      | succ n => cases n with
        | zero => simp [one_mul, Nat.cast_one]
        | succ n =>
          have hfneq : f (n.succ.succ) = n.succ.succ := by
            have := fixed_point_of_gt_1
                  (Nat.one_lt_cast.mpr (Nat.succ_lt_succ n.succ_pos)) H1 H2 H4 H5 ha1 hae
            rwa [Rat.cast_coe_nat n.succ.succ] at this
          rw [←hfneq]
          exact H1 (n.succ.succ : ℚ) x (Nat.cast_pos.mpr hn) hx
    exact h2.antisymm (H3 x hx n hn)

  -- For the final calculation, we expand x as (2*x.num) / (2*x.denom), because
  -- we need the top of the fraction to be strictly greater than 1 in order
  -- to apply fixed_point_of_gt_1.
  intros x hx
  let x2denom := 2 * x.den
  let x2num := 2 * x.num

  have hx2pos : 0 < 2 * x.den := by linarith[x.pos]
  have hxcnez   : (x.den : ℚ) ≠ (0 : ℚ) := ne_of_gt (Nat.cast_pos.mpr x.pos)
  have hx2cnezr : (x2denom : ℝ) ≠ (0 : ℝ) := Nat.cast_ne_zero.mpr (ne_of_gt hx2pos)

  have hrat_expand2 := calc x = x.num / x.den := by exact_mod_cast Rat.num_den.symm
                            _ = x2num / x2denom := by { field_simp; ring}

  have h_denom_times_fx :=
    calc (x2denom : ℝ) * f x = f (x2denom * x) := (h_f_commutes_with_pos_nat_mul
                                                   x2denom hx2pos x hx).symm
         _ = f (x2denom * (x2num / x2denom))   := by rw[hrat_expand2]
         _ = f x2num                           := by congr; field_simp; ring

  have h_fx2num_fixed : f x2num = x2num := by
    have hx2num_gt_one : (1 : ℚ) < (2 * x.num : ℤ) := by
      norm_cast; linarith [Rat.num_pos_iff_pos.mpr hx]
    have hh := fixed_point_of_gt_1 hx2num_gt_one H1 H2 H4 H5 ha1 hae
    rwa [Rat.cast_coe_int x2num] at hh

  calc f x = f x * 1                               := (mul_one (f x)).symm
       _ = f x * (x2denom / x2denom)               := by rw [←div_self hx2cnezr]
       _ = (f x * x2denom) / x2denom               := mul_div_assoc' (f x) _ _
       _ = (x2denom * f x) / x2denom               := by rw[mul_comm]
       _ = f x2num / x2denom                       := by rw[h_denom_times_fx]
       _ = x2num / x2denom                         := by rw[h_fx2num_fixed]
       _ = ((x2num:ℚ):ℝ) / ((x2denom:ℚ):ℝ)         := rfl
       _ = (((x2num : ℚ) / (x2denom : ℚ) : ℚ) : ℝ) := by norm_cast
       _ = x                                       := by rw[←hrat_expand2]


/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Kevin Buzzard, Scott Morrison, Johan Commelin, Chris Hughes,
  Johannes Hölzl, Yury Kudryashov
-/

import algebra.group_power.basic

/-!
# Instances on spaces of monoid and group morphisms

We endow the space of monoid morphisms `M →* N` with a `comm_monoid` structure when the target is
commutative, through pointwise multiplication, and with a `comm_group` structure when the target
is a commutative group. We also prove the same instances for additive situations.

Since these structures permit morphisms of morphisms, we also provide some composition-like
operations.

Finally, we provide the `ring` structure on `add_monoid.End`.
-/

universes uM uN uP uQ
variables {M : Type uM} {N : Type uN} {P : Type uP} {Q : Type uQ}

/-- `(M →* N)` is a `comm_monoid` if `N` is commutative. -/
@[to_additive "`(M →+ N)` is an `add_comm_monoid` if `N` is commutative."]
instance [mul_one_class M] [comm_monoid N] : comm_monoid (M →* N) :=
{ mul := (*),
  mul_assoc := by intros; ext; apply mul_assoc,
  one := 1,
  one_mul := by intros; ext; apply one_mul,
  mul_one := by intros; ext; apply mul_one,
  mul_comm := by intros; ext; apply mul_comm,
  npow := λ n f,
  { to_fun := λ x, (f x) ^ n,
    map_one' := by simp,
    map_mul' := λ x y, by simp [mul_pow] },
  npow_zero' := λ f, by { ext x, simp },
  npow_succ' := λ n f, by { ext x, simp [pow_succ] } }

/-- If `G` is a commutative group, then `M →* G` is a commutative group too. -/
@[to_additive "If `G` is an additive commutative group, then `M →+ G` is an additive commutative
group too."]
instance {M G} [mul_one_class M] [comm_group G] : comm_group (M →* G) :=
{ inv := has_inv.inv,
  div := has_div.div,
  div_eq_mul_inv := by { intros, ext, apply div_eq_mul_inv },
  mul_left_inv := by intros; ext; apply mul_left_inv,
  zpow := λ n f, { to_fun := λ x, (f x) ^ n,
    map_one' := by simp,
    map_mul' := λ x y, by simp [mul_zpow] },
  zpow_zero' := λ f, by { ext x, simp },
  zpow_succ' := λ n f, by { ext x, simp [zpow_of_nat, pow_succ] },
  zpow_neg'  := λ n f, by { ext x, simp },
  ..monoid_hom.comm_monoid }

instance [add_comm_monoid M] : semiring (add_monoid.End M) :=
{ zero_mul := λ x, add_monoid_hom.ext $ λ i, rfl,
  mul_zero := λ x, add_monoid_hom.ext $ λ i, add_monoid_hom.map_zero _,
  left_distrib := λ x y z, add_monoid_hom.ext $ λ i, add_monoid_hom.map_add _ _ _,
  right_distrib := λ x y z, add_monoid_hom.ext $ λ i, rfl,
  .. add_monoid.End.monoid M,
  .. add_monoid_hom.add_comm_monoid }

instance [add_comm_group M] : ring (add_monoid.End M) :=
{ .. add_monoid.End.semiring,
  .. add_monoid_hom.add_comm_group }

/-!
### Morphisms of morphisms

The structures above permit morphisms that themselves produce morphisms, provided the codomain
is commutative.
-/

namespace monoid_hom

@[to_additive]
lemma ext_iff₂ {mM : mul_one_class M} {mN : mul_one_class N} {mP : comm_monoid P}
  {f g : M →* N →* P} :
  f = g ↔ (∀ x y, f x y = g x y) :=
monoid_hom.ext_iff.trans $ forall_congr $ λ _, monoid_hom.ext_iff

/-- `flip` arguments of `f : M →* N →* P` -/
@[to_additive "`flip` arguments of `f : M →+ N →+ P`"]
def flip {mM : mul_one_class M} {mN : mul_one_class N} {mP : comm_monoid P} (f : M →* N →* P) :
  N →* M →* P :=
{ to_fun := λ y, ⟨λ x, f x y, by rw [f.map_one, one_apply], λ x₁ x₂, by rw [f.map_mul, mul_apply]⟩,
  map_one' := ext $ λ x, (f x).map_one,
  map_mul' := λ y₁ y₂, ext $ λ x, (f x).map_mul y₁ y₂ }

@[simp, to_additive] lemma flip_apply
  {mM : mul_one_class M} {mN : mul_one_class N} {mP : comm_monoid P}
  (f : M →* N →* P) (x : M) (y : N) :
  f.flip y x = f x y :=
rfl

@[to_additive]
lemma map_one₂ {mM : mul_one_class M} {mN : mul_one_class N} {mP : comm_monoid P}
  (f : M →* N →* P) (n : N) : f 1 n = 1 :=
(flip f n).map_one

@[to_additive]
lemma map_mul₂ {mM : mul_one_class M} {mN : mul_one_class N} {mP : comm_monoid P}
  (f : M →* N →* P) (m₁ m₂ : M) (n : N) : f (m₁ * m₂) n = f m₁ n * f m₂ n :=
(flip f n).map_mul _ _

@[to_additive]
lemma map_inv₂ {mM : group M} {mN : mul_one_class N} {mP : comm_group P}
  (f : M →* N →* P) (m : M) (n : N) : f m⁻¹ n = (f m n)⁻¹ :=
(flip f n).map_inv _

@[to_additive]
lemma map_div₂ {mM : group M} {mN : mul_one_class N} {mP : comm_group P}
  (f : M →* N →* P) (m₁ m₂ : M) (n : N) : f (m₁ / m₂) n = f m₁ n / f m₂ n :=
(flip f n).map_div _ _

/-- Evaluation of a `monoid_hom` at a point as a monoid homomorphism. See also `monoid_hom.apply`
for the evaluation of any function at a point. -/
@[to_additive "Evaluation of an `add_monoid_hom` at a point as an additive monoid homomorphism.
See also `add_monoid_hom.apply` for the evaluation of any function at a point.", simps]
def eval [mul_one_class M] [comm_monoid N] : M →* (M →* N) →* N := (monoid_hom.id (M →* N)).flip

/-- The expression `λ g m, g (f m)` as a `monoid_hom`.
Equivalently, `(λ g, monoid_hom.comp g f)` as a `monoid_hom`. -/
@[to_additive "The expression `λ g m, g (f m)` as a `add_monoid_hom`.
Equivalently, `(λ g, monoid_hom.comp g f)` as a `add_monoid_hom`.

This also exists in a `linear_map` version, `linear_map.lcomp`.", simps]
def comp_hom' [mul_one_class M] [mul_one_class N] [comm_monoid P] (f : M →* N) :
  (N →* P) →* M →* P :=
flip $ eval.comp f

/-- Composition of monoid morphisms (`monoid_hom.comp`) as a monoid morphism.

Note that unlike `monoid_hom.comp_hom'` this requires commutativity of `N`. -/
@[to_additive "Composition of additive monoid morphisms (`add_monoid_hom.comp`) as an additive
monoid morphism.

Note that unlike `add_monoid_hom.comp_hom'` this requires commutativity of `N`.

This also exists in a `linear_map` version, `linear_map.llcomp`.", simps]
def comp_hom [mul_one_class M] [comm_monoid N] [comm_monoid P] :
  (N →* P) →* (M →* N) →* (M →* P) :=
{ to_fun := λ g, { to_fun := g.comp, map_one' := comp_one g, map_mul' := comp_mul g },
  map_one' := by { ext1 f, exact one_comp f },
  map_mul' := λ g₁ g₂, by { ext1 f, exact mul_comp g₁ g₂ f } }

/-- Flipping arguments of monoid morphisms (`monoid_hom.flip`) as a monoid morphism. -/
@[to_additive "Flipping arguments of additive monoid morphisms (`add_monoid_hom.flip`)
as an additive monoid morphism.", simps]
def flip_hom {mM : mul_one_class M} {mN : mul_one_class N} {mP : comm_monoid P}
  : (M →* N →* P) →* (N →* M →* P) :=
{ to_fun := monoid_hom.flip, map_one' := rfl, map_mul' := λ f g, rfl }

/-- The expression `λ m q, f m (g q)` as a `monoid_hom`.

Note that the expression `λ q n, f (g q) n` is simply `monoid_hom.comp`. -/
@[to_additive "The expression `λ m q, f m (g q)` as an `add_monoid_hom`.

Note that the expression `λ q n, f (g q) n` is simply `add_monoid_hom.comp`.

This also exists as a `linear_map` version, `linear_map.compl₂`"]
def compl₂ [mul_one_class M] [mul_one_class N] [comm_monoid P] [comm_monoid Q]
  (f : M →* N →* P) (g : Q →* N) : M →* Q →* P :=
(comp_hom' g).comp f

@[simp, to_additive]
lemma compl₂_apply [mul_one_class M] [mul_one_class N] [comm_monoid P] [comm_monoid Q]
  (f : M →* N →* P) (g : Q →* N) (m : M) (q : Q) :
  (compl₂ f g) m q = f m (g q) := rfl

/-- The expression `λ m n, g (f m n)` as a `monoid_hom`. -/
@[to_additive "The expression `λ m n, g (f m n)` as an `add_monoid_hom`.

This also exists as a linear_map version, `linear_map.compr₂`"]
def compr₂ [mul_one_class M] [mul_one_class N] [comm_monoid P] [comm_monoid Q]
  (f : M →* N →* P) (g : P →* Q) : M →* N →* Q :=
(comp_hom g).comp f

@[simp, to_additive]
lemma compr₂_apply [mul_one_class M] [mul_one_class N] [comm_monoid P] [comm_monoid Q]
  (f : M →* N →* P) (g : P →* Q) (m : M) (n : N) :
  (compr₂ f g) m n = g (f m n) := rfl

end monoid_hom

/-!
### Miscellaneous definitions

Due to the fact this file imports `algebra.group_power.basic`, it is not possible to import it in
some of the lower-level files like `algebra.ring.basic`. The following lemmas should be rehomed
if the import structure permits them to be.
-/

section semiring

variables {R S : Type*} [semiring R] [semiring S]

/-- Multiplication of an element of a (semi)ring is an `add_monoid_hom` in both arguments.

This is a more-strongly bundled version of `add_monoid_hom.mul_left` and `add_monoid_hom.mul_right`.

A stronger version of this exists for algebras as `algebra.lmul`.
-/
def add_monoid_hom.mul : R →+ R →+ R :=
{ to_fun := add_monoid_hom.mul_left,
  map_zero' := add_monoid_hom.ext $ zero_mul,
  map_add' := λ a b, add_monoid_hom.ext $ add_mul a b }

lemma add_monoid_hom.mul_apply (x y : R) : add_monoid_hom.mul x y = x * y := rfl

@[simp]
lemma add_monoid_hom.coe_mul :
  ⇑(add_monoid_hom.mul : R →+ R →+ R) = add_monoid_hom.mul_left := rfl

@[simp]
lemma add_monoid_hom.coe_flip_mul :
  ⇑(add_monoid_hom.mul : R →+ R →+ R).flip = add_monoid_hom.mul_right := rfl

/-- An `add_monoid_hom` preserves multiplication if pre- and post- composition with
`add_monoid_hom.mul` are equivalent. By converting the statement into an equality of
`add_monoid_hom`s, this lemma allows various specialized `ext` lemmas about `→+` to then be applied.
-/
lemma add_monoid_hom.map_mul_iff (f : R →+ S) :
  (∀ x y, f (x * y) = f x * f y) ↔
    (add_monoid_hom.mul : R →+ R →+ R).compr₂ f = (add_monoid_hom.mul.comp f).compl₂ f :=
iff.symm add_monoid_hom.ext_iff₂

end semiring


/-
Copyright (c) 2021 Lu-Ming Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Lu-Ming Zhang
-/
import linear_algebra.matrix.symmetric

/-!
# Circulant matrices

This file contains the definition and basic results about circulant matrices.
Given a vector `v : n → α` indexed by a type that is endowed with subtraction,
`matrix.circulant v` is the matrix whose `(i, j)`th entry is `v (i - j)`.

## Main results

- `matrix.circulant`: the circulant matrix generated by a given vector `v : n → α`.
- `matrix.circulant_mul`: the product of two circulant matrices `circulant v` and `circulant w` is
                          the circulant matrix generated by `mul_vec (circulant v) w`.
- `matrix.circulant_mul_comm`: multiplication of circulant matrices commutes when the elements do.

## Implementation notes

`matrix.fin.foo` is the `fin n` version of `matrix.foo`.
Namely, the index type of the circulant matrices in discussion is `fin n`.

## Tags

circulant, matrix
-/

variables {α β m n R : Type*}

namespace matrix

open function
open_locale matrix big_operators

/-- Given the condition `[has_sub n]` and a vector `v : n → α`,
    we define `circulant v` to be the circulant matrix generated by `v` of type `matrix n n α`.
    The `(i,j)`th entry is defined to be `v (i - j)`. -/
def circulant [has_sub n] (v : n → α) : matrix n n α :=
of $ λ i j, v (i - j)

-- TODO: set as an equation lemma for `circulant`, see mathlib4#3024
@[simp]
lemma circulant_apply [has_sub n] (v : n → α) (i j) : circulant v i j = v (i - j) := rfl

lemma circulant_col_zero_eq [add_group n] (v : n → α) (i : n) : circulant v i 0 = v i :=
congr_arg v (sub_zero _)

lemma circulant_injective [add_group n] : injective (circulant : (n → α) → matrix n n α) :=
begin
  intros v w h,
  ext k,
  rw [← circulant_col_zero_eq v, ← circulant_col_zero_eq w, h]
end

lemma fin.circulant_injective : ∀ n, injective (λ v : fin n → α, circulant v)
| 0     := dec_trivial
| (n+1) := circulant_injective

@[simp] lemma circulant_inj [add_group n] {v w : n → α} :
  circulant v = circulant w ↔ v = w :=
circulant_injective.eq_iff

@[simp] lemma fin.circulant_inj {n} {v w : fin n → α} :
  circulant v = circulant w ↔ v = w :=
(fin.circulant_injective n).eq_iff

lemma transpose_circulant [add_group n] (v : n → α) :
  (circulant v)ᵀ = circulant (λ i, v (-i)) :=
by ext; simp

lemma conj_transpose_circulant [has_star α] [add_group n] (v : n → α) :
  (circulant v)ᴴ = circulant (star (λ i, v (-i))) :=
by ext; simp

lemma fin.transpose_circulant : ∀ {n} (v : fin n → α), (circulant v)ᵀ =  circulant (λ i, v (-i))
| 0     := dec_trivial
| (n+1) := transpose_circulant

lemma fin.conj_transpose_circulant [has_star α] :
  ∀ {n} (v : fin n → α), (circulant v)ᴴ = circulant (star (λ i, v (-i)))
| 0     := dec_trivial
| (n+1) := conj_transpose_circulant

lemma map_circulant [has_sub n] (v : n → α) (f : α → β) :
  (circulant v).map f = circulant (λ i, f (v i)) :=
ext $ λ _ _, rfl

lemma circulant_neg [has_neg α] [has_sub n] (v : n → α) :
  circulant (- v) = - circulant v :=
ext $ λ _ _, rfl

@[simp] lemma circulant_zero (α n) [has_zero α] [has_sub n] :
  circulant 0 = (0 : matrix n n α) :=
ext $ λ _ _, rfl

lemma circulant_add [has_add α] [has_sub n] (v w : n → α) :
  circulant (v + w) = circulant v + circulant w :=
ext $ λ _ _, rfl

lemma circulant_sub [has_sub α] [has_sub n] (v w : n → α) :
  circulant (v - w) = circulant v - circulant w :=
ext $ λ _ _, rfl

/-- The product of two circulant matrices `circulant v` and `circulant w` is
    the circulant matrix generated by `mul_vec (circulant v) w`. -/
lemma circulant_mul [semiring α] [fintype n] [add_group n] (v w : n → α) :
  circulant v ⬝ circulant w = circulant (mul_vec (circulant v) w) :=
begin
  ext i j,
  simp only [mul_apply, mul_vec, circulant_apply, dot_product],
  refine fintype.sum_equiv (equiv.sub_right j) _ _ _,
  intro x,
  simp only [equiv.sub_right_apply, sub_sub_sub_cancel_right],
end

lemma fin.circulant_mul [semiring α] :
  ∀ {n} (v w : fin n → α), circulant v ⬝ circulant w = circulant (mul_vec (circulant v) w)
| 0     := dec_trivial
| (n+1) := circulant_mul

/-- Multiplication of circulant matrices commutes when the elements do. -/
lemma circulant_mul_comm
  [comm_semigroup α] [add_comm_monoid α] [fintype n] [add_comm_group n] (v w : n → α) :
  circulant v ⬝ circulant w = circulant w ⬝ circulant v :=
begin
  ext i j,
  simp only [mul_apply, circulant_apply, mul_comm],
  refine fintype.sum_equiv ((equiv.sub_left i).trans (equiv.add_right j)) _ _ _,
  intro x,
  congr' 2,
  { simp },
  { simp only [equiv.coe_add_right, function.comp_app,
               equiv.coe_trans, equiv.sub_left_apply],
    abel }
end

lemma fin.circulant_mul_comm [comm_semigroup α] [add_comm_monoid α] :
  ∀ {n} (v w : fin n → α), circulant v ⬝ circulant w = circulant w ⬝ circulant v
| 0     := dec_trivial
| (n+1) := circulant_mul_comm

/-- `k • circulant v` is another circulant matrix `circulant (k • v)`. -/
lemma circulant_smul [has_sub n] [has_smul R α] (k : R) (v : n → α) :
  circulant (k • v) = k • circulant v :=
by ext; simp

@[simp] lemma circulant_single_one
  (α n) [has_zero α] [has_one α] [decidable_eq n] [add_group n] :
  circulant (pi.single 0 1 : n → α) = (1 : matrix n n α) :=
by { ext i j, simp [one_apply, pi.single_apply, sub_eq_zero] }

@[simp] lemma circulant_single
  (n) [semiring α] [decidable_eq n] [add_group n] [fintype n] (a : α) :
  circulant (pi.single 0 a : n → α) = scalar n a :=
begin
  ext i j,
  simp [pi.single_apply, one_apply, sub_eq_zero],
end

/-- Note we use `↑i = 0` instead of `i = 0` as `fin 0` has no `0`.
This means that we cannot state this with `pi.single` as we did with `matrix.circulant_single`. -/
lemma fin.circulant_ite (α) [has_zero α] [has_one α] :
  ∀ n, circulant (λ i, ite (↑i = 0) 1 0 : fin n → α) = 1
| 0     := dec_trivial
| (n+1) :=
begin
  rw [←circulant_single_one],
  congr' with j,
  simp only [pi.single_apply, fin.ext_iff],
  congr
end

/-- A circulant of `v` is symmetric iff `v` equals its reverse. -/
lemma circulant_is_symm_iff [add_group n] {v : n → α} :
  (circulant v).is_symm ↔ ∀ i, v (- i) = v i :=
by rw [is_symm, transpose_circulant, circulant_inj, funext_iff]

lemma fin.circulant_is_symm_iff :
  ∀ {n} {v : fin n → α}, (circulant v).is_symm ↔ ∀ i, v (- i) = v i
| 0     := λ v, by simp [is_symm.ext_iff, is_empty.forall_iff]
| (n+1) := λ v, circulant_is_symm_iff

/-- If `circulant v` is symmetric, `∀ i j : I, v (- i) = v i`. -/
lemma circulant_is_symm_apply [add_group n] {v : n → α} (h : (circulant v).is_symm) (i : n) :
  v (-i) = v i :=
circulant_is_symm_iff.1 h i

lemma fin.circulant_is_symm_apply {n} {v : fin n → α} (h : (circulant v).is_symm) (i : fin n) :
  v (-i) = v i :=
fin.circulant_is_symm_iff.1 h i

end matrix


/-
Copyright (c) 2019 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.stream.basic
import Mathlib.tactic.default
import Mathlib.data.nat.gcd
import Mathlib.PostPort

namespace Mathlib

/-!
# The Fibonacci Sequence

## Summary

Definition of the Fibonacci sequence `F₀ = 0, F₁ = 1, Fₙ₊₂ = Fₙ + Fₙ₊₁`.

## Main Definitions

- `fib` returns the stream of Fibonacci numbers.

## Main Statements

- `fib_succ_succ` : shows that `fib` indeed satisfies the Fibonacci recurrence `Fₙ₊₂ = Fₙ + Fₙ₊₁.`.
- `fib_gcd`       : `fib n` is a strong divisibility sequence.

## Implementation Notes

For efficiency purposes, the sequence is defined using `stream.iterate`.

## Tags

fib, fibonacci
-/

namespace nat

/-- Auxiliary function used in the definition of `fib_aux_stream`. -/
/-- Auxiliary stream creating Fibonacci pairs `⟨Fₙ, Fₙ₊₁⟩`. -/
/--
Implementation of the fibonacci sequence satisfying
`fib 0 = 0, fib 1 = 1, fib (n + 2) = fib n + fib (n + 1)`.

*Note:* We use a stream iterator for better performance when compared to the naive recursive
implementation.
-/
def fib (n : ℕ) : ℕ := prod.fst (fib_aux_stream n)

@[simp] theorem fib_zero : fib 0 = 0 := rfl

@[simp] theorem fib_one : fib 1 = 1 := rfl

@[simp] theorem fib_two : fib (bit0 1) = 1 := rfl

/-- Shows that `fib` indeed satisfies the Fibonacci recurrence `Fₙ₊₂ = Fₙ + Fₙ₊₁.` -/
theorem fib_succ_succ {n : ℕ} : fib (n + bit0 1) = fib n + fib (n + 1) := sorry

theorem fib_pos {n : ℕ} (n_pos : 0 < n) : 0 < fib n := sorry

theorem fib_le_fib_succ {n : ℕ} : fib n ≤ fib (n + 1) := sorry

theorem fib_mono : monotone fib := monotone_of_monotone_nat fun (_x : ℕ) => fib_le_fib_succ

theorem le_fib_self {n : ℕ} (five_le_n : bit1 (bit0 1) ≤ n) : n ≤ fib n := sorry

/-- Subsequent Fibonacci numbers are coprime,
  see https://proofwiki.org/wiki/Consecutive_Fibonacci_Numbers_are_Coprime -/
theorem fib_coprime_fib_succ (n : ℕ) : coprime (fib n) (fib (n + 1)) := sorry

/-- See https://proofwiki.org/wiki/Fibonacci_Number_in_terms_of_Smaller_Fibonacci_Numbers -/
theorem fib_add (m : ℕ) (n : ℕ) : fib m * fib n + fib (m + 1) * fib (n + 1) = fib (m + n + 1) :=
  sorry

theorem gcd_fib_add_self (m : ℕ) (n : ℕ) : gcd (fib m) (fib (n + m)) = gcd (fib m) (fib n) := sorry

theorem gcd_fib_add_mul_self (m : ℕ) (n : ℕ) (k : ℕ) :
    gcd (fib m) (fib (n + k * m)) = gcd (fib m) (fib n) :=
  sorry

/-- `fib n` is a strong divisibility sequence,
  see https://proofwiki.org/wiki/GCD_of_Fibonacci_Numbers -/
theorem fib_gcd (m : ℕ) (n : ℕ) : fib (gcd m n) = gcd (fib m) (fib n) := sorry

theorem fib_dvd (m : ℕ) (n : ℕ) (h : m ∣ n) : fib m ∣ fib n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (fib m ∣ fib n)) (propext gcd_eq_left_iff_dvd)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (gcd (fib m) (fib n) = fib m)) (Eq.symm (fib_gcd m n))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (fib (gcd m n) = fib m)) (iff.mp gcd_eq_left_iff_dvd h)))
        (Eq.refl (fib m))))

end Mathlib


import data.real.basic
import data.set.basic

open finset

-- We think of social states as type `σ` and inidividuals as type `ι`
variables {σ ι : Type*}

/-!
## Notes

* "All individuals rank" refers to the rankings of each and every individual.
* "Society ranks" refers to output of a social welfare function
  (e.g. the final result of an election process).
* <Andrew: Can you please write something describing what a social welfare function is? Thanks!>

## Important Definitions
-/

/-- A social welfare function satisfies the Weak Pareto criterion if, for any two social states
  `x` and `y`, every individual ranking `y` higher than `x` implies that society ranks `y` higher
  than `x`. -/
def weak_pareto (f : (ι → σ → ℝ) → σ → ℝ) (X : finset σ) : Prop :=
∀ (x y ∈ X) (P : ι → σ → ℝ), (∀ i, P i x < P i y) → (f P) x < (f P) y

/-- Suppose that for any two social states `x` and `y`, every individual's ranking of `x` and `y`
  remains unchanged between two rankings `P₁` and `P₂`. We say that a social welfare function is
  *independent of irrelevant alternatives* if society's ranking of `x` and `y` also remains
  unchanged between `P₁` and `P₂`. -/
def ind_of_irr_alts (f : (ι → σ → ℝ) → σ → ℝ) (X : finset σ) : Prop :=
∀ (x y ∈ X) (P₁ P₂ : ι → σ → ℝ),
  (∀ i, P₁ i x < P₁ i y ↔ P₂ i x < P₂ i y) → (f P₁ x < f P₁ y ↔ f P₂ x < f P₂ y)

/-- An individual is a *dictator* with respect to a given social welfare function if their
  ranking determines society's ranking of any two social states. -/
def is_dictator (f : (ι → σ → ℝ) → σ → ℝ) (X : finset σ) (i : ι) : Prop :=
∀ (x y ∈ X) (P : ι → σ → ℝ), P i x < P i y → f P x < f P y

/-- A social welfare function is called a *dictatorship* if there exists a dictator with respect to
 that function. -/
def is_dictatorship (f : (ι → σ → ℝ) → σ → ℝ) (X : finset σ) : Prop :=
∃ i, is_dictator f X i

/-- An individual is a dictator over all social states in a given set *except* `b`
  if they are a dictator over every pair of distinct alternatives not equal to `b`.  -/
def is_dictator_except (f : (ι → σ → ℝ) → (σ → ℝ)) (X : finset σ) (i : ι) (b : σ) : Prop :=
∀ a c ∈ X, a ≠ b → c ≠ b → ∀ P : ι → σ → ℝ, P i a < P i c → f P a < f P c

/-- A social welfare function is called a dictatorship over all social states in a given set
  *except* `b` if there exists a dictator over every pair of distinct alternatives not equal
  to `b`.  -/
def is_dictatorship_except (f : (ι → σ → ℝ) → (σ → ℝ)) (X : finset σ) (b : σ) : Prop :=
∃ i, is_dictator_except f X i b

/-- A social state `b` is *strictly worst* of a finite set of social states `X` with respect to
  a ranking `p` if `b` is ranked strictly lower than every other `a ∈ X`. -/
def is_strictly_worst (b : σ) (p : σ → ℝ) (X : finset σ) : Prop :=
∀ a ∈ X, a ≠ b → p b < p a

/-- A social state `b` is *strictly best* of a finite set of social states `X` with respect to
  a ranking `p` if `b` is ranked strictly higher than every other `a ∈ X`. -/
def is_strictly_best (b : σ) (p : σ → ℝ) (X : finset σ) : Prop :=
∀ a ∈ X, a ≠ b → p a < p b

/-- A social state `b` is *extremal* with respect to a finite set of social states `X`
  and a ranking `p` if `b` is either bottom or top of `X`. -/
def is_extremal (b : σ) (p : σ → ℝ) (X : finset σ) : Prop :=
is_strictly_worst b p X ∨ is_strictly_best b p X

/-- Social sates `s₁`, `s₂`, `s₃`, and `s₄` have the *same order* with respect to two rankings
  `p₁` and `p₂` if `s₁` and `s₂` have the same ranking in `p₁` as `s₃` and `s₄` have in `p₂`. -/
def same_order (p₁ p₂ : σ → ℝ) (s₁ s₂ s₃ s₄ : σ) : Prop :=
(p₁ s₁ < p₁ s₂ ↔ p₂ s₃ < p₂ s₄) ∧ (p₁ s₂ < p₁ s₁ ↔ p₂ s₄ < p₂ s₃)

/-- An individual `i` is *pivotal* with respect to a social welfare function and a social state `b`
  if there exist rankings `P` and `P'` such that:
  (1) all individuals except for `i` rank all social states in the same order in both rankings
  (2) all individuals place `b` in an extremal position in both rankings
  (3) `i` ranks `b` bottom of their rankings in `P`, but top of their rankings in `P'`
  (4) society ranks `b` bottom of its rankings in `P`, but top of its rankings in `P'` -/
def is_pivotal (f : (ι → σ → ℝ) → (σ → ℝ)) (X : finset σ) (i : ι) (b : σ) : Prop :=
∃ (P P' : ι → σ → ℝ),
  (∀ j : ι, j ≠ i → ∀ x y ∈ X, same_order (P j) (P' j) x y x y) ∧
    (∀ j : ι, is_extremal b (P j) X) ∧ (∀ j : ι, is_extremal b (P' j) X) ∧
      (is_strictly_worst b (P i) X) ∧ (is_strictly_best b (P' i) X) ∧
        (is_strictly_worst b (f P) X) ∧ (is_strictly_best b (f P') X)

/-- A social welfare function has a *pivot* with respect to a social state `b` if there exists an
  individual who is pivotal with respect to that function and `b`. -/
def has_pivot (f : (ι → σ → ℝ) → (σ → ℝ)) (X : finset σ) (b : σ) : Prop :=
∃ i, is_pivotal f X i b

open function

/-- Given an arbitary ranking `p`, social state `b`, and finite set of social states `X`,
  `maketop b p X` updates `p` so that `b` is now ranked at the top of `X`. -/
noncomputable def maketop [decidable_eq σ]
  (p : σ → ℝ) (b : σ) (X : finset σ) (hX : X.nonempty) : σ → ℝ :=
update p b $ ((X.image p).max' (hX.image p)) + 1

/-- Given an arbitary ranking `p`, social state `b`, and finite set of social states `X`,
  `makebot b p X` updates `p` so that `b` is now ranked at the bottom of `X`. -/
noncomputable def makebot [decidable_eq σ]
  (p : σ → ℝ) (b : σ) (X : finset σ) (hX : X.nonempty) : σ → ℝ :=
update p b $ ((X.image p).min' (hX.image p)) - 1

/-- Given an arbitary ranking `p` and social states `a`, `b`, and `c`,
  `makebetween p a b c` updates `p` so that `b` is now ranked between `a` and `c`. -/
noncomputable def makebetween [decidable_eq σ]
  (p : σ → ℝ) (a b c : σ) : σ → ℝ :=
update p b $ (p a + p c) / 2

-- ## Preliminary Lemmas

variables {a b c d : σ} {p : σ → ℝ} {P : ι → σ → ℝ} {f : (ι → σ → ℝ) → σ → ℝ} {X : finset σ}

lemma exists_second_distinct_mem (hX : 2 ≤ X.card) (a_in : a ∈ X) :
  ∃ b ∈ X, b ≠ a :=
begin
  classical,
  have hpos : 0 < (X.erase a).card,
  { rw card_erase_of_mem a_in,
    exact zero_lt_one.trans_le (nat.pred_le_pred hX) },
  cases card_pos.mp hpos with b hb,
  cases mem_erase.mp hb with hne H,
  exact ⟨b, H, hne⟩,
end

lemma exists_third_distinct_mem (hX : 2 < X.card) (a_in : a ∈ X) (b_in : b ∈ X) (h : a ≠ b) :
  ∃ c ∈ X, c ≠ a ∧ c ≠ b :=
begin
  classical,
  have hpos : 0 < ((X.erase b).erase a).card,
  { simpa only [card_erase_of_mem, mem_erase_of_ne_of_mem h a_in, b_in]
      using nat.pred_le_pred (nat.pred_le_pred hX) },
  cases card_pos.mp hpos with c hc,
  simp_rw mem_erase at hc,
  exact ⟨c, hc.2.2, hc.1, hc.2.1⟩,
end

lemma is_strictly_best.not_strictly_worst (htop : is_strictly_best b p X) (h : ∃ a ∈ X, a ≠ b) : ¬is_strictly_worst b p X :=
begin
  simp only [is_strictly_worst, not_forall, not_lt, exists_prop],
  rcases h with ⟨a, a_in, hab⟩,
  exact ⟨a, a_in, hab, (htop a a_in hab).le⟩,
end

lemma is_strictly_best.not_strictly_worst' (htop : is_strictly_best b p X) (hX : 2 ≤ X.card) (hb : b ∈ X) : ¬is_strictly_worst b p X :=
htop.not_strictly_worst $ exists_second_distinct_mem hX hb

lemma is_strictly_worst.not_strictly_best (hbot : is_strictly_worst b p X) (h : ∃ a ∈ X, a ≠ b) : ¬is_strictly_best b p X :=
begin
  simp only [is_strictly_best, not_forall, not_lt, exists_prop],
  rcases h with ⟨a, a_in, hab⟩,
  exact ⟨a, a_in, hab, (hbot a a_in hab).le⟩,
end

lemma is_strictly_worst.not_strictly_best' (hbot : is_strictly_worst b p X) (hX : 2 ≤ X.card) (hb : b ∈ X) : ¬is_strictly_best b p X :=
hbot.not_strictly_best $ exists_second_distinct_mem hX hb

lemma is_extremal.is_strictly_best (hextr : is_extremal b p X) (not_strictly_worst : ¬is_strictly_worst b p X) :
  is_strictly_best b p X :=
hextr.resolve_left not_strictly_worst

lemma is_extremal.is_strictly_worst (hextr : is_extremal b p X) (not_strictly_best : ¬is_strictly_best b p X) :
  is_strictly_worst b p X :=
hextr.resolve_right not_strictly_best

lemma is_strictly_worst.is_extremal (hbot : is_strictly_worst b p X) : is_extremal b p X :=
or.inl hbot

lemma is_strictly_best.is_extremal (hbot : is_strictly_best b p X) : is_extremal b p X :=
or.inr hbot

/-- If every individual ranks a social state `b` at the top of its rankings, then society must also
  rank `b` at the top of its rankings. -/
theorem is_strictly_best_of_forall_is_strictly_best (b_in : b ∈ X) (hwp : weak_pareto f X)
  (htop : ∀ i, is_strictly_best b (P i) X) :
  is_strictly_best b (f P) X :=
λ a a_in hab, hwp a b a_in b_in P $ λ i, htop i a a_in hab

/-- If every individual ranks a social state `b` at the bottom of its rankings, then society must
  also rank `b` at the bottom of its rankings. -/
theorem is_strictly_worst_of_forall_is_strictly_worst (b_in : b ∈ X) (hwp : weak_pareto f X)
  (hbot : ∀ i, is_strictly_worst b (P i) X) :
  is_strictly_worst b (f P) X :=
λ a a_in hab, hwp b a b_in a_in P $ λ i, hbot i a a_in hab

lemma exists_of_not_extremal (hX : 3 ≤ X.card) (hb : b ∈ X) (h : ¬ is_extremal b (f P) X):
  ∃ a c ∈ X, a ≠ b ∧ c ≠ b ∧ a ≠ c ∧ f P b ≤ f P a ∧ f P c ≤ f P b :=
begin
  unfold is_extremal is_strictly_worst is_strictly_best at h, push_neg at h,
  obtain ⟨⟨c, hc, hcb, hPc⟩, ⟨a, ha, hab, hPa⟩⟩ := h,
  obtain hac | rfl := ne_or_eq a c, { exact ⟨a, c, ha, hc, hab, hcb, hac, hPa, hPc⟩ },
  obtain ⟨d, hd, hda, hdb⟩ := exists_third_distinct_mem hX ha hb hab,
  cases lt_or_le (f P b) (f P d),
  { exact ⟨d, a, hd, hc, hdb, hcb, hda, h.le, hPc⟩ },
  { exact ⟨a, d, ha, hd, hab, hdb, hda.symm, hPa, h⟩ },
end

lemma nonempty_of_mem {s : finset σ} {a : σ} (ha : a ∈ s) : s.nonempty :=
nonempty_of_ne_empty $ ne_empty_of_mem ha

section make

variable [decidable_eq σ]

lemma maketop_noteq (p) (hab : a ≠ b) (hX : X.nonempty) :
  maketop p b X hX a = p a :=
update_noteq hab _ p

lemma makebot_noteq (p) (hab : a ≠ b) (hX : X.nonempty) :
  makebot p b X hX a = p a :=
update_noteq hab _ p

lemma makebetween_noteq (p) (hdb : d ≠ b) :
  makebetween p a b c d = p d :=
update_noteq hdb ((p a + p c) / 2) p

lemma makebetween_eq (a b c : σ) (p) :
  makebetween p a b c b = (p a + p c) / 2 :=
update_same _ _ _

lemma maketop_lt_maketop (p) (hab : a ≠ b) (ha : a ∈ X) :
  maketop p b X (nonempty_of_mem ha) a < maketop p b X (nonempty_of_mem ha) b :=
by simpa [maketop, hab] using
  ((X.image p).le_max' _ (mem_image_of_mem p ha)).trans_lt (lt_add_one _)

lemma makebot_lt_makebot (p) (hcb : c ≠ b) (hc : c ∈ X) :
  makebot p b X (nonempty_of_mem hc) b < makebot p b X (nonempty_of_mem hc) c :=
by simpa [makebot, hcb] using sub_lt_iff_lt_add'.mpr
  (((X.image p).min'_le (p c) (mem_image_of_mem p hc)).trans_lt (lt_one_add _))

lemma makebetween_lt_makebetween_top (hcb : c ≠ b) (hp : p a < p c) :
  makebetween p a b c b < makebetween p a b c c :=
begin
  simp only [makebetween, update_same, update_noteq hcb],
  linarith,
end

lemma makebetween_lt_makebetween_bot (hab : a ≠ b) (hp : p a < p c) :
  makebetween p a b c a < makebetween p a b c b :=
begin
  simp only [makebetween, update_same, update_noteq hab],
  linarith,
end

lemma top_of_maketop (b p) (hX : X.nonempty) :
  is_strictly_best b (maketop p b X hX) X :=
λ a ha hab, maketop_lt_maketop p hab ha

end make

-- ## The Proof

/-- Let `f` be a SWF satisfying WP and IoIA, `P` be a preference ordering, `X` be a finite set
  containing at least 3 social states, and `b` be one of those social states.
  If every individial ranks `b` extremally, then society also ranks `b` extremally w.r.t. `f`. -/
lemma first_step (hwp : weak_pareto f X) (hind : ind_of_irr_alts f X)
  (hX : 3 ≤ X.card) (hb : b ∈ X) (hextr : ∀ i, is_extremal b (P i) X) :
  is_extremal b (f P) X :=
begin
  classical,
  by_contra hnot,
  obtain ⟨a, c, ha, hc, hab, hcb, hac, hPa, hPc⟩ := exists_of_not_extremal hX hb hnot,
  refine ((not_lt.mp ((not_congr (hind b c hb hc P _ (λ i, ⟨λ hP, _, λ hP', _⟩))).mp
    hPc.not_lt)).trans (not_lt.mp ((not_congr (hind a b ha hb P _ (λ i, ⟨λ hP, _, λ hP', _⟩))).mp
      hPa.not_lt))).not_lt (hwp a c ha hc _ (λ i, _)),
  { exact λ j, if is_strictly_best b (P j) X then makebetween (P j) a c b else update (P j) c (P j a + 1) },
  { have h : ¬ is_strictly_best b (P i) X := λ h, asymm hP (h c hc hcb),
    convert lt_add_of_lt_of_pos ((hextr i).is_strictly_worst h a ha hab) _; simp [h, hcb.symm] },
  { by_contra hP,
    have h : is_strictly_best b (P i) X := (hextr i).is_strictly_best (λ h, hP (h c hc hcb)),
    simp only at hP', simp only [if_pos h, makebetween_noteq _ hcb.symm, makebetween_eq] at hP',
    linarith [h a ha hab] },
  { by_cases h : is_strictly_best b (P i) X; simpa [h, makebetween_noteq, hac, hcb.symm] },
  { by_contra hP,
    have h : ¬ is_strictly_best b (P i) X := λ h, hP (h a ha hab),
    simp only at hP', simp [if_neg h, hac, hcb.symm] at hP',
    exact hP hP' },
  { by_cases h : is_strictly_best b (P i) X,
    { simp [if_pos h, makebetween_lt_makebetween_bot hac (h a ha hab)] },
    { simp [if_neg h, hac] } },
end

/-- An auxiliary lemma for the second step, in which we perform induction on the finite set
  `D' := {i ∈ univ | is_strictly_worst b (P i) X}`. Its statement is formulated so strangely (involving `D'`
  and `P`) to allow for this induction.
  Essentially, what we are doing here is showing that, for a social welfare function `f` under the
  appropriate conditions, we can always a construct circumstances so that `f` has a pivot with
  respect to a given social state. -/
lemma second_step_aux [fintype ι]
  (hwp : weak_pareto f X) (hind : ind_of_irr_alts f X)
  (hX : 2 < X.card) (b_in : b ∈ X) {D' : finset ι} :
  ∀ {P : ι → σ → ℝ}, D' = {i ∈ univ | is_strictly_worst b (P i) X} →
    (∀ i, is_extremal b (P i) X) → is_strictly_worst b (f P) X → has_pivot f X b :=
begin
  classical,
  refine finset.induction_on D'
    (λ P h hextr hbot, absurd (is_strictly_best_of_forall_is_strictly_best b_in hwp (λ j, (hextr j).is_strictly_best _))
                              (hbot.not_strictly_best (exists_second_distinct_mem hX.le b_in)))
    (λ i D hi IH P h_insert hextr hbot, _),
  { simpa using eq_empty_iff_forall_not_mem.mp h.symm j },
  { have hX' := nonempty_of_mem b_in,
    have hextr' : ∀ j, is_extremal b (ite (j = i) (maketop (P j) b X hX') (P j)) X,
    { intro j,
      by_cases hji : j = i,
      { refine or.inr (λ a a_in hab, _),
        simp only [if_pos hji, maketop_lt_maketop _ hab a_in] },
      { simp only [if_neg hji, hextr j] } },
    by_cases hP' : is_strictly_best b (f (λ j, ite (j = i) (maketop (P j) b X hX') (P j))) X,
    { refine ⟨i, P, _, λ j hj x y _ _, _, hextr, hextr', _, _, hbot, hP'⟩,
      { simp [same_order, if_neg hj] },
      { have : i ∈ {j ∈ univ | is_strictly_worst b (P j) X}, { rw ← h_insert, exact mem_insert_self i D },
        simpa },
      { simp [top_of_maketop, hX'] } },
    { refine IH _ hextr' ((first_step hwp hind hX b_in hextr').is_strictly_worst hP'),
      ext j,
      simp only [true_and, sep_def, mem_filter, mem_univ],
      split; intro hj,
      { suffices : j ∈ insert i D,
        { have hji : j ≠ i, { rintro rfl, exact hi hj },
          rw h_insert at this,
          simpa [hji] },
        exact mem_insert_of_mem hj },
      { have hji : j ≠ i,
        { rintro rfl,
          obtain ⟨a, a_in, hab⟩ := exists_second_distinct_mem hX.le b_in,
          apply asymm (top_of_maketop b (P j) hX' a a_in hab),
          simpa using hj a a_in hab },
        rw [← erase_insert hi, h_insert],
        simpa [hji] using hj } } },
end

/-- Let `f` be a SWF satisfying WP and IoIA, and `X` be a finite set containing at least 3 social states.
  Then `f` has a pivot w.r.t. every social state in `X`. -/
lemma second_step [fintype ι]
  (hwp : weak_pareto f X) (hind : ind_of_irr_alts f X)
  (hX : 3 ≤ X.card) (b) (b_in : b ∈ X) :
  has_pivot f X b :=
begin
  classical,
  have hbot : is_strictly_worst b (λ x, ite (x = b) 0 1) X := λ _ _ h, by simp [h],
  exact second_step_aux hwp hind hX b_in rfl (λ i, hbot.is_extremal)
    (is_strictly_worst_of_forall_is_strictly_worst b_in hwp (λ i, hbot)),
end

/-- Let `f` be a SWF satisfying IoIA, `X` be a finite set of social states, and `b` be one of those
  social states.
  If an individual `i` is pivotal w.r.t. `f` and `b`, then `i` is a dictator over all social states
  in `X` except `b`. -/
lemma third_step (hind : ind_of_irr_alts f X)
  (hb : b ∈ X) {i : ι} (hpiv : is_pivotal f X i b) :
  is_dictator_except f X i b :=
begin
  intros a c ha hc hab hcb Q hyp,
  obtain ⟨P, P', hpiv⟩ := hpiv,
  have hX := nonempty_of_mem hb,
  classical,
  let Q' := λ j,
    if j = i
      then makebetween (Q j) a b c
    else
      if is_strictly_worst b (P j) X
        then makebot (Q j) b X hX
      else maketop (Q j) b X hX,
  refine (hind a c ha hc Q Q' (λ j, _)).mpr
    (((hind a b ha hb P' Q' (λ j, _)).mp (hpiv.2.2.2.2.2.2 a ha hab)).trans
      ((hind b c hb hc P Q' (λ j, _)).mp (hpiv.2.2.2.2.2.1 c hc hcb))),
  { suffices : ∀ d ≠ b, Q j d = Q' j d, { rw [this, this]; assumption },
    intros d hdb,
    by_cases hj : j = i; simp only [Q', if_pos, hj, dite_eq_ite],
    { exact (makebetween_noteq (Q i) hdb).symm },
    { by_cases hbot : is_strictly_worst b (P j) X; simp only [if_neg hj],
      { rw [← makebot_noteq (Q j) hdb hX, if_pos hbot] },
      { rw [← maketop_noteq (Q j) hdb hX, if_neg hbot] } } },
  { refine ⟨λ hP', _, λ hQ', _⟩; by_cases hj : j = i,
    { simpa [Q', if_pos, hj] using makebetween_lt_makebetween_bot hab hyp },
    { have hbot : ¬ is_strictly_worst b (P j) X := λ h, asymm ((hpiv.1 j hj a b ha hb).1.2 hP') (h a ha hab),
      simpa [Q', if_neg, hj, hbot] using maketop_lt_maketop (Q j) hab ha },
    { convert hpiv.2.2.2.2.1 a ha hab },
    { refine (hpiv.1 j hj a b ha hb).1.1 ((hpiv.2.1 j).is_strictly_best
        (λ hbot, asymm (makebot_lt_makebot (Q j) hab ha) _) a ha hab),
      convert hQ'; simp [Q', if_neg hj, if_pos hbot] } },
  { refine ⟨λ hP, _, λ hQ', _⟩; by_cases hj : j = i,
    { simpa [Q', if_pos, hj] using makebetween_lt_makebetween_top hcb hyp },
    { have hbot : is_strictly_worst b (P j) X,
      { unfold is_strictly_worst,
        by_contra hbot, push_neg at hbot,
        obtain ⟨d, hd, hdb, h⟩ := hbot,
        cases hpiv.2.1 j with hbot htop,
        { exact (hbot d hd hdb).not_le h },
        { exact (irrefl _) ((htop c hc hcb).trans hP) } },
      simpa [Q', if_neg hj, if_pos hbot] using makebot_lt_makebot (Q j) hcb hc },
    { convert hpiv.2.2.2.1 c hc hcb },
    { by_contra hP,
      have hbot : ¬ is_strictly_worst b (P j) X := λ h, hP (h c hc hcb),
      apply asymm (maketop_lt_maketop (Q j) hcb hc),
      convert hQ'; simp [Q', if_neg, hbot, hj] } },
end

/-- Let `f` be a SWF satisfying IoIA, and `X` be a finite set containing at least 3 social states.
  If `f` has a pivot for every social state in `X`, then `f` is a dictatorship. -/
lemma fourth_step (hind : ind_of_irr_alts f X)
  (hX : 3 ≤ X.card) (hpiv : ∀ b ∈ X, has_pivot f X b) :
  is_dictatorship f X :=
begin
  obtain ⟨b, hb⟩ := (card_pos.1 (zero_lt_two.trans hX)).bex,
  obtain ⟨i, ipiv⟩ := hpiv b hb,
  have h : ∀ a ∈ X, a ≠ b → ∀ Pᵢ : ι → σ → ℝ,
          (Pᵢ i a < Pᵢ i b → f Pᵢ a < f Pᵢ b) ∧ (Pᵢ i b < Pᵢ i a → f Pᵢ b < f Pᵢ a), -- we should have a better way of stating this that doesn't require the and (i.e. stated WLOG)
  { intros a ha hab Pᵢ,
    obtain ⟨c, hc, hca, hcb⟩ := exists_third_distinct_mem hX ha hb hab,
    obtain ⟨hac, hbc⟩ := ⟨hca.symm, hcb.symm⟩,
    obtain ⟨j, jpiv⟩ := hpiv c hc,
    obtain hdict := third_step hind hc jpiv,
    obtain rfl : j = i,
    { by_contra hji,
      obtain ⟨R, R', hso, hextr, -, -, -, hbot, htop⟩ := ipiv,
      refine asymm (htop a ha hab) (hdict b a hb ha hbc hac R' ((hso j hji a b ha hb).2.1 _)),
      by_contra hnot,
      have h := (hextr j).resolve_left,
      simp only [is_strictly_best, is_strictly_worst, and_imp, exists_imp_distrib, not_forall] at h,
      exact asymm (hbot a ha hab) (hdict a b ha hb hac hbc R (h a ha hab hnot a ha hab)) },
    split; apply hdict; assumption },
  refine ⟨i, λ x y hx hy Pᵢ hPᵢ, _⟩,
  rcases eq_or_ne b x with rfl | hbx; rcases eq_or_ne b y with rfl | hby,
  { exact ((irrefl _) hPᵢ).rec _ },
  { exact (h y hy hby.symm Pᵢ).2 hPᵢ },
  { exact (h x hx hbx.symm Pᵢ).1 hPᵢ },
  { exact third_step hind hb ipiv x y hx hy hbx.symm hby.symm Pᵢ hPᵢ },
end

/-- Arrow's Impossibility Theorem: Any social welfare function involving at least three social
  states that satisfies WP and IoIA is necessarily a dictatorship. -/
theorem arrow [fintype ι]
  (hwp : weak_pareto f X) (hind : ind_of_irr_alts f X) (hX : 3 ≤ X.card) :
  is_dictatorship f X :=
fourth_step hind hX $ second_step hwp hind hX


-- ---------------------------------------------------------------------
-- Ejercicio. Realizar las siguientes acciones
-- 1. Importar la librería tactic
-- 2. Abrir el espacio de nombres set
-- 3. Declarar u y v como variables de universos.
-- 4. Declarar α como una variable de tipos en u.
-- 5. Declarar I como una variable de tipos en v.
-- 6. Declarar A y B como variables sobre funciones de I en α.
-- 7. Declarar s como variable sobre conjuntos de elementos de α.
-- 8. Usar la lógica clásica.
-- ----------------------------------------------------------------------

import tactic                 -- 1
open set                      -- 2
universes u v                 -- 3
variable (α : Type u)         -- 4
variable (I : Type v)         -- 5
variables (A B : I → set α)   -- 6
variable  s : set α           -- 7
open_locale classical         -- 8

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    s ∪ (⋂ i, A i) = ⋂ i, (A i ∪ s)
-- ----------------------------------------------------------------------

example : s ∪ (⋂ i, A i) = ⋂ i, (A i ∪ s) :=
begin
  ext x,
  simp only [mem_union, mem_Inter],
  split,
  { rintros (xs | xI),
    { intro i,
      right,
      exact xs },
    { intro i,
      left,
      exact xI i }},
  { intro h,
    by_cases xs : x ∈ s,
    { left,
      exact xs },
    { right,
      intro i,
      cases h i,
      { assumption },
      { contradiction }}},
end

-- Prueba
-- ======

/-
α : Type u,
I : Type v,
A : I → set α,
s : set α
⊢ (s ∪ ⋂ (i : I), A i) = ⋂ (i : I), A i ∪ s
  >> ext x,
x : α
⊢ (x ∈ s ∪ ⋂ (i : I), A i) ↔ x ∈ ⋂ (i : I), A i ∪ s
  >> simp only [mem_union, mem_Inter],
⊢ (x ∈ s ∨ ∀ (i : I), x ∈ A i) ↔ ∀ (i : I), x ∈ A i ∨ x ∈ s
  >> split,
| ⊢ (x ∈ s ∨ ∀ (i : I), x ∈ A i) → ∀ (i : I), x ∈ A i ∨ x ∈ s
|   >> { rintros (xs | xI),
| | xs : x ∈ s
| | ⊢ ∀ (i : I), x ∈ A i ∨ x ∈ s
| |   >>   { intro i,
| | i : I
| | ⊢ x ∈ A i ∨ x ∈ s
| |   >>     right,
| | ⊢ x ∈ s
| |   >>     exact xs },
| ⊢ ∀ (i : I), x ∈ A i ∨ x ∈ s
|   >>   { intro i,
| i : I
| ⊢ x ∈ A i ∨ x ∈ s
|   >>     left,
| ⊢ x ∈ A i
|   >>     exact xI i }},
⊢ (∀ (i : I), x ∈ A i ∨ x ∈ s) → (x ∈ s ∨ ∀ (i : I), x ∈ A i)
  >> { intro h,
h : ∀ (i : I), x ∈ A i ∨ x ∈ s
⊢ x ∈ s ∨ ∀ (i : I), x ∈ A i
  >>   by_cases xs : x ∈ s,
| xs : x ∈ s
| ⊢ x ∈ s ∨ ∀ (i : I), x ∈ A i
|   >>   { left,
| ⊢ x ∈ s
|   >>     exact xs },
xs : x ∉ s
⊢ x ∈ s ∨ ∀ (i : I), x ∈ A i
  >>   { right,
⊢ ∀ (i : I), x ∈ A i
  >>     intro i,
i : I
⊢ x ∈ A i
  >>     cases h i,
| h_1 : x ∈ A i
| ⊢ x ∈ A i
|   >>     { assumption },
⊢ x ∈ A i
  >>     { contradiction }}},
no goals
-/


import game.sets.sets_level02 -- hide

namespace xena -- hide

open_locale classical -- hide

variable X : Type -- hide

/-
# Chapter 1 : Sets

## Level 3 : intersection (∩)
-/

/-
Now prove that for any two sets $A$ and $B$, $A ∩ B ⊆ A$.

You will need to rewrite the following term:

```
mem_inter_iff : x ∈ A ∩ B ↔ x ∈ A ∧ x ∈ B
```
-/

/- Axiom : mem_inter_iff :
x ∈ A ∩ B ↔ x ∈ A ∧ x ∈ B
-/

/- Hint : Stuck?
You need to start the same way as in the previous levels.
Try and get yourself into a situation where you have a
*hypothesis* `hAB : x ∈ A ∩ B` and then use `rw mem_inter_iff at hAB`.
-/

/- Hint: A note on `x ∈ A ∧ x ∈ B → x ∈ A`
By convention, ∧ binds more tightly than →
(i.e. `x ∈ A ∧ x ∈ B → x ∈ A` means `(x ∈ A ∧ x ∈ B) → x ∈ A`)
-/

/- Hint : Reminder about `cases`
The `cases h with hP hQ` tactic turns `h : P ∧ Q` into `hP : P` and `hQ : Q`
-/

/- Hint : The `tauto!` tactic
The `tauto!` tactic solves goals in propositional logic (i.e. problems where
the relevant hypotheses and goal just involve `∧`, `∨`, `¬` and `→` and
propositions -- for example it could easily solve this goal:

```
h : P ∧ Q
⊢ P
```
-/

/- Lemma
If $A$ and $B$ are sets of any type $X$, then
$$ A \cap B \subseteq A.$$
-/
theorem intersection_subset (A B : set X) : A ∩ B ⊆ A  :=
begin
  rw subset_iff,
  intros x hx,
  rw mem_inter_iff at hx,
  tauto!, -- or cases, assumption

end

end xena -- hide


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

! This file was ported from Lean 3 source module number_theory.padics.padic_val
! leanprover-community/mathlib commit 60fa54e778c9e85d930efae172435f42fb0d71f7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.NumberTheory.Divisors
import Mathlib.RingTheory.Int.Basic

/-!
# p-adic Valuation

This file defines the `p`-adic valuation on `ℕ`, `ℤ`, and `ℚ`.

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

The valuation induces a norm on `ℚ`. This norm is defined in padicNorm.lean.

## Notations

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

## Implementation notes

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

## References

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

## Tags

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

universe u

open Nat

open Rat

open multiplicity

/-- For `p ≠ 1`, the `p`-adic valuation of a natural `n ≠ 0` is the largest natural number `k` such
that `p^k` divides `z`. If `n = 0` or `p = 1`, then `padicValNat p q` defaults to `0`. -/
def padicValNat (p : ℕ) (n : ℕ) : ℕ :=
  if h : p ≠ 1 ∧ 0 < n then (multiplicity p n).get (multiplicity.finite_nat_iff.2 h) else 0
#align padic_val_nat padicValNat

namespace padicValNat

open multiplicity

variable {p : ℕ}

/-- `padicValNat p 0` is `0` for any `p`. -/
@[simp]
protected

/-- `padicValNat p 1` is `0` for any `p`. -/
@[simp]
protected theorem one : padicValNat p 1 = 0 := by
  unfold padicValNat
  split_ifs
  · simp
  · rfl
#align padic_val_nat.one padicValNat.one

/-- If `p ≠ 0` and `p ≠ 1`, then `padicValNat p p` is `1`. -/
@[simp]
theorem self (hp : 1 < p) : padicValNat p p = 1 := by
  have neq_one : ¬p = 1 ↔ True := iff_of_true hp.ne' trivial
  have eq_zero_false : p = 0 ↔ False := iff_false_intro (zero_lt_one.trans hp).ne'
  simp [padicValNat, neq_one, eq_zero_false]
#align padic_val_nat.self padicValNat.self

@[simp]
theorem eq_zero_iff {n : ℕ} : padicValNat p n = 0 ↔ p = 1 ∨ n = 0 ∨ ¬p ∣ n := by
  simp only [padicValNat, dite_eq_right_iff, PartENat.get_eq_iff_eq_coe, Nat.cast_zero,
    multiplicity_eq_zero, and_imp, pos_iff_ne_zero, Ne.def, ← or_iff_not_imp_left]
#align padic_val_nat.eq_zero_iff padicValNat.eq_zero_iff

theorem eq_zero_of_not_dvd {n : ℕ} (h : ¬p ∣ n) : padicValNat p n = 0 :=
  eq_zero_iff.2 <| Or.inr <| Or.inr h
#align padic_val_nat.eq_zero_of_not_dvd padicValNat.eq_zero_of_not_dvd

end padicValNat

/-- For `p ≠ 1`, the `p`-adic valuation of an integer `z ≠ 0` is the largest natural number `k` such
that `p^k` divides `z`. If `x = 0` or `p = 1`, then `padicValInt p q` defaults to `0`. -/
def padicValInt (p : ℕ) (z : ℤ) : ℕ :=
  padicValNat p z.natAbs
#align padic_val_int padicValInt

namespace padicValInt

open multiplicity

variable {p : ℕ}

theorem of_ne_one_ne_zero {z : ℤ} (hp : p ≠ 1) (hz : z ≠ 0) :
    padicValInt p z =
      (multiplicity (p : ℤ) z).get
        (by
          apply multiplicity.finite_int_iff.2
          simp [hp, hz]) := by
  rw [padicValInt, padicValNat, dif_pos (And.intro hp (Int.natAbs_pos.mpr hz))]
  simp only [multiplicity.Int.natAbs p z]
#align padic_val_int.of_ne_one_ne_zero padicValInt.of_ne_one_ne_zero

/-- `padicValInt p 0` is `0` for any `p`. -/
@[simp]
protected theorem zero : padicValInt p 0 = 0 := by simp [padicValInt]
#align padic_val_int.zero padicValInt.zero

/-- `padicValInt p 1` is `0` for any `p`. -/
@[simp]
protected theorem one : padicValInt p 1 = 0 := by simp [padicValInt]
#align padic_val_int.one padicValInt.one

/-- The `p`-adic value of a natural is its `p`-adic value as an integer. -/
@[simp]
theorem of_nat {n : ℕ} : padicValInt p n = padicValNat p n := by simp [padicValInt]
#align padic_val_int.of_nat padicValInt.of_nat

/-- If `p ≠ 0` and `p ≠ 1`, then `padicValInt p p` is `1`. -/
theorem self (hp : 1 < p) : padicValInt p p = 1 := by simp [padicValNat.self hp]
#align padic_val_int.self padicValInt.self

theorem eq_zero_of_not_dvd {z : ℤ} (h : ¬(p : ℤ) ∣ z) : padicValInt p z = 0 := by
  rw [padicValInt, padicValNat]
  split_ifs <;> simp [multiplicity.Int.natAbs, multiplicity_eq_zero.2 h]
#align padic_val_int.eq_zero_of_not_dvd padicValInt.eq_zero_of_not_dvd

end padicValInt

/-- `padicValRat` defines the valuation of a rational `q` to be the valuation of `q.num` minus the
valuation of `q.den`. If `q = 0` or `p = 1`, then `padicValRat p q` defaults to `0`. -/
def padicValRat (p : ℕ) (q : ℚ) : ℤ :=
  padicValInt p q.num - padicValNat p q.den
#align padic_val_rat padicValRat

namespace padicValRat

open multiplicity

variable {p : ℕ}

/-- `padicValRat p q` is symmetric in `q`. -/
@[simp]
protected theorem neg (q : ℚ) : padicValRat p (-q) = padicValRat p q := by
  simp [padicValRat, padicValInt]
#align padic_val_rat.neg padicValRat.neg

/-- `padicValRat p 0` is `0` for any `p`. -/
@[simp]
protected theorem zero : padicValRat p 0 = 0 := by simp [padicValRat]
#align padic_val_rat.zero padicValRat.zero

/-- `padicValRat p 1` is `0` for any `p`. -/
@[simp]
protected theorem one : padicValRat p 1 = 0 := by simp [padicValRat]
#align padic_val_rat.one padicValRat.one

/-- The `p`-adic value of an integer `z ≠ 0` is its `p`-adic_value as a rational. -/
@[simp]
theorem of_int {z : ℤ} : padicValRat p z = padicValInt p z := by simp [padicValRat]
#align padic_val_rat.of_int padicValRat.of_int

/-- The `p`-adic value of an integer `z ≠ 0` is the multiplicity of `p` in `z`. -/
theorem of_int_multiplicity {z : ℤ} (hp : p ≠ 1) (hz : z ≠ 0) :
    padicValRat p (z : ℚ) = (multiplicity (p : ℤ) z).get (finite_int_iff.2 ⟨hp, hz⟩) := by
  rw [of_int, padicValInt.of_ne_one_ne_zero hp hz]
#align padic_val_rat.of_int_multiplicity padicValRat.of_int_multiplicity

theorem multiplicity_sub_multiplicity {q : ℚ} (hp : p ≠ 1) (hq : q ≠ 0) :
    padicValRat p q =
      (multiplicity (p : ℤ) q.num).get (finite_int_iff.2 ⟨hp, Rat.num_ne_zero_of_ne_zero hq⟩) -
        (multiplicity p q.den).get
          (by
            rw [← finite_iff_dom, finite_nat_iff]
            exact ⟨hp, q.pos⟩) := by
  rw [padicValRat, padicValInt.of_ne_one_ne_zero hp, padicValNat, dif_pos]
  · exact ⟨hp, q.pos⟩
  · exact Rat.num_ne_zero_of_ne_zero hq
#align padic_val_rat.multiplicity_sub_multiplicity padicValRat.multiplicity_sub_multiplicity

/-- The `p`-adic value of an integer `z ≠ 0` is its `p`-adic value as a rational. -/
@[simp]
theorem of_nat {n : ℕ} : padicValRat p n = padicValNat p n := by simp [padicValRat]
#align padic_val_rat.of_nat padicValRat.of_nat

/-- If `p ≠ 0` and `p ≠ 1`, then `padicValRat p p` is `1`. -/
theorem self (hp : 1 < p) : padicValRat p p = 1 := by simp [hp]
#align padic_val_rat.self padicValRat.self

end padicValRat

section padicValNat

variable {p : ℕ}

theorem zero_le_padicValRat_of_nat (n : ℕ) : 0 ≤ padicValRat p n := by simp
#align zero_le_padic_val_rat_of_nat zero_le_padicValRat_of_nat

/-- `padicValRat` coincides with `padicValNat`. -/
@[norm_cast]
theorem padicValRat_of_nat (n : ℕ) : ↑(padicValNat p n) = padicValRat p n := by simp
#align padic_val_rat_of_nat padicValRat_of_nat

/-- A simplification of `padicValNat` when one input is prime, by analogy with
`padicValRat_def`. -/
theorem padicValNat_def [hp : Fact p.Prime] {n : ℕ} (hn : 0 < n) :
    padicValNat p n = (multiplicity p n).get (multiplicity.finite_nat_iff.2 ⟨hp.out.ne_one, hn⟩) :=
  dif_pos ⟨hp.out.ne_one, hn⟩
#align padic_val_nat_def padicValNat_def

theorem padicValNat_def' {n : ℕ} (hp : p ≠ 1) (hn : 0 < n) :
    ↑(padicValNat p n) = multiplicity p n := by simp [padicValNat, hp, hn]
#align padic_val_nat_def' padicValNat_def'

@[simp]
theorem padicValNat_self [Fact p.Prime] : padicValNat p p = 1 := by
  rw [padicValNat_def (@Fact.out p.Prime).pos]
  simp
#align padic_val_nat_self padicValNat_self

theorem one_le_padicValNat_of_dvd {n : ℕ} [hp : Fact p.Prime] (hn : 0 < n) (div : p ∣ n) :
    1 ≤ padicValNat p n := by
  rwa [← PartENat.coe_le_coe, padicValNat_def' hp.out.ne_one hn, ← pow_dvd_iff_le_multiplicity,
    pow_one]
#align one_le_padic_val_nat_of_dvd one_le_padicValNat_of_dvd

theorem dvd_iff_padicValNat_ne_zero {p n : ℕ} [Fact p.Prime] (hn0 : n ≠ 0) :
    p ∣ n ↔ padicValNat p n ≠ 0 :=
  ⟨fun h => one_le_iff_ne_zero.mp (one_le_padicValNat_of_dvd hn0.bot_lt h), fun h =>
    Classical.not_not.1 (mt padicValNat.eq_zero_of_not_dvd h)⟩
#align dvd_iff_padic_val_nat_ne_zero dvd_iff_padicValNat_ne_zero

end padicValNat

namespace padicValRat

open multiplicity

variable {p : ℕ} [hp : Fact p.Prime]

/-- The multiplicity of `p : ℕ` in `a : ℤ` is finite exactly when `a ≠ 0`. -/
theorem finite_int_prime_iff {a : ℤ} : Finite (p : ℤ) a ↔ a ≠ 0 := by
  simp [finite_int_iff, hp.1.ne_one]
#align padic_val_rat.finite_int_prime_iff padicValRat.finite_int_prime_iff

/-- A rewrite lemma for `padicValRat p q` when `q` is expressed in terms of `Rat.mk`. -/
protected theorem defn (p : ℕ) [hp : Fact p.Prime] {q : ℚ} {n d : ℤ} (hqz : q ≠ 0)
    (qdf : q = n /. d) :
    padicValRat p q =
      (multiplicity (p : ℤ) n).get
          (finite_int_iff.2 ⟨hp.1.ne_one, fun hn => by simp_all⟩) -
        (multiplicity (p : ℤ) d).get
          (finite_int_iff.2 ⟨hp.1.ne_one, fun hd => by simp_all⟩) := by
  have hd : d ≠ 0 := Rat.mk_denom_ne_zero_of_ne_zero hqz qdf
  let ⟨c, hc1, hc2⟩ := Rat.num_den_mk hd qdf
  rw [padicValRat.multiplicity_sub_multiplicity hp.1.ne_one hqz]
  simp only [Nat.isUnit_iff, hc1, hc2]
  rw [multiplicity.mul' (Nat.prime_iff_prime_int.1 hp.1),
    multiplicity.mul' (Nat.prime_iff_prime_int.1 hp.1)]
  rw [Nat.cast_add, Nat.cast_add]
  simp_rw [Int.coe_nat_multiplicity p q.den]
  ring
  -- Porting note: was
  -- simp only [hc1, hc2, multiplicity.mul' (Nat.prime_iff_prime_int.1 hp.1),
  --   hp.1.ne_one, hqz, pos_iff_ne_zero, Int.coe_nat_multiplicity p q.den
#align padic_val_rat.defn padicValRat.defn

/-- A rewrite lemma for `padicValRat p (q * r)` with conditions `q ≠ 0`, `r ≠ 0`. -/
protected theorem mul {q r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) :
    padicValRat p (q * r) = padicValRat p q + padicValRat p r := by
  have : q * r = q.num * r.num /. (q.den * r.den) := by rw_mod_cast [Rat.mul_num_den]
  have hq' : q.num /. q.den ≠ 0 := by rwa [Rat.num_den]
  have hr' : r.num /. r.den ≠ 0 := by rwa [Rat.num_den]
  have hp' : Prime (p : ℤ) := Nat.prime_iff_prime_int.1 hp.1
  rw [padicValRat.defn p (mul_ne_zero hq hr) this]
  conv_rhs =>
    rw [← @Rat.num_den q, padicValRat.defn p hq', ← @Rat.num_den r, padicValRat.defn p hr']
  rw [multiplicity.mul' hp', multiplicity.mul' hp', Nat.cast_add, Nat.cast_add]
  ring
  -- Porting note: was
  -- simp [add_comm, add_left_comm, sub_eq_add_neg]
#align padic_val_rat.mul padicValRat.mul

/-- A rewrite lemma for `padicValRat p (q^k)` with condition `q ≠ 0`. -/
protected theorem pow {q : ℚ} (hq : q ≠ 0) {k : ℕ} : padicValRat p (q ^ k) = k * padicValRat p q :=
  by induction k <;>
    simp [*, padicValRat.mul hq (pow_ne_zero _ hq), _root_.pow_succ, add_mul, add_comm]
#align padic_val_rat.pow padicValRat.pow

/-- A rewrite lemma for `padicValRat p (q⁻¹)` with condition `q ≠ 0`. -/
protected theorem inv (q : ℚ) : padicValRat p q⁻¹ = -padicValRat p q := by
  by_cases hq : q = 0
  · simp [hq]
  · rw [eq_neg_iff_add_eq_zero, ← padicValRat.mul (inv_ne_zero hq) hq, inv_mul_cancel hq,
      padicValRat.one]
#align padic_val_rat.inv padicValRat.inv

/-- A rewrite lemma for `padicValRat p (q / r)` with conditions `q ≠ 0`, `r ≠ 0`. -/
protected theorem div {q r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) :
    padicValRat p (q / r) = padicValRat p q - padicValRat p r := by
  rw [div_eq_mul_inv, padicValRat.mul hq (inv_ne_zero hr), padicValRat.inv r, sub_eq_add_neg]
#align padic_val_rat.div padicValRat.div

/-- A condition for `padicValRat p (n₁ / d₁) ≤ padicValRat p (n₂ / d₂)`, in terms of
divisibility by `p^n`. -/
theorem padicValRat_le_padicValRat_iff {n₁ n₂ d₁ d₂ : ℤ} (hn₁ : n₁ ≠ 0) (hn₂ : n₂ ≠ 0)
    (hd₁ : d₁ ≠ 0) (hd₂ : d₂ ≠ 0) :
    padicValRat p (n₁ /. d₁) ≤ padicValRat p (n₂ /. d₂) ↔
      ∀ n : ℕ, (p : ℤ) ^ n ∣ n₁ * d₂ → (p : ℤ) ^ n ∣ n₂ * d₁ := by
  have hf1 : Finite (p : ℤ) (n₁ * d₂) := finite_int_prime_iff.2 (mul_ne_zero hn₁ hd₂)
  have hf2 : Finite (p : ℤ) (n₂ * d₁) := finite_int_prime_iff.2 (mul_ne_zero hn₂ hd₁)
  conv =>
    lhs
    rw [padicValRat.defn p (Rat.divInt_ne_zero_of_ne_zero hn₁ hd₁) rfl,
      padicValRat.defn p (Rat.divInt_ne_zero_of_ne_zero hn₂ hd₂) rfl, sub_le_iff_le_add', ←
      add_sub_assoc, _root_.le_sub_iff_add_le]
    norm_cast
    rw [← multiplicity.mul' (Nat.prime_iff_prime_int.1 hp.1) hf1, add_comm, ←
      multiplicity.mul' (Nat.prime_iff_prime_int.1 hp.1) hf2, PartENat.get_le_get,
      multiplicity_le_multiplicity_iff]
#align padic_val_rat.padic_val_rat_le_padic_val_rat_iff padicValRat.padicValRat_le_padicValRat_iff

/-- Sufficient conditions to show that the `p`-adic valuation of `q` is less than or equal to the
`p`-adic valuation of `q + r`. -/
theorem le_padicValRat_add_of_le {q r : ℚ} (hqr : q + r ≠ 0)
    (h : padicValRat p q ≤ padicValRat p r) : padicValRat p q ≤ padicValRat p (q + r) :=
  if hq : q = 0 then by simpa [hq] using h
  else
    if hr : r = 0 then by simp [hr]
    else by
      have hqn : q.num ≠ 0 := Rat.num_ne_zero_of_ne_zero hq
      have hqd : (q.den : ℤ) ≠ 0 := by exact_mod_cast Rat.den_nz _
      have hrn : r.num ≠ 0 := Rat.num_ne_zero_of_ne_zero hr
      have hrd : (r.den : ℤ) ≠ 0 := by exact_mod_cast Rat.den_nz _
      have hqreq : q + r = (q.num * r.den + q.den * r.num) /. (q.den * r.den) := Rat.add_num_den _ _
      have hqrd : q.num * r.den + q.den * r.num ≠ 0 := Rat.mk_num_ne_zero_of_ne_zero hqr hqreq
      conv_lhs => rw [← @Rat.num_den q]
      rw [hqreq, padicValRat_le_padicValRat_iff hqn hqrd hqd (mul_ne_zero hqd hrd), ←
        multiplicity_le_multiplicity_iff, mul_left_comm,
        multiplicity.mul (Nat.prime_iff_prime_int.1 hp.1), add_mul]
      rw [← @Rat.num_den q, ← @Rat.num_den r, padicValRat_le_padicValRat_iff hqn hrn hqd hrd, ←
        multiplicity_le_multiplicity_iff] at h
      calc
        _ ≤
            min (multiplicity (↑p) (q.num * r.den * q.den))
              (multiplicity (↑p) (↑q.den * r.num * ↑q.den)) :=
          le_min
            (by rw [@multiplicity.mul _ _ _ _ (_ * _) _ (Nat.prime_iff_prime_int.1 hp.1), add_comm])
            (by
              rw [mul_assoc,
                  @multiplicity.mul _ _ _ _ (q.den : ℤ) (_ * _)
                    (Nat.prime_iff_prime_int.1 hp.1)]
              exact add_le_add_left h _)
        _ ≤ _ := min_le_multiplicity_add
#align padic_val_rat.le_padic_val_rat_add_of_le padicValRat.le_padicValRat_add_of_le

/-- The minimum of the valuations of `q` and `r` is at most the valuation of `q + r`. -/
theorem min_le_padicValRat_add {q r : ℚ} (hqr : q + r ≠ 0) :
    min (padicValRat p q) (padicValRat p r) ≤ padicValRat p (q + r) :=
  (le_total (padicValRat p q) (padicValRat p r)).elim
  (fun h => by rw [min_eq_left h]; exact le_padicValRat_add_of_le hqr h)
  (fun h => by rw [min_eq_right h, add_comm]; exact le_padicValRat_add_of_le (by rwa [add_comm]) h)
#align padic_val_rat.min_le_padic_val_rat_add padicValRat.min_le_padicValRat_add

open BigOperators

/-- A finite sum of rationals with positive `p`-adic valuation has positive `p`-adic valuation
(if the sum is non-zero). -/
theorem sum_pos_of_pos {n : ℕ} {F : ℕ → ℚ} (hF : ∀ i, i < n → 0 < padicValRat p (F i))
    (hn0 : (∑ i in Finset.range n, F i) ≠ 0) : 0 < padicValRat p (∑ i in Finset.range n, F i) := by
  induction' n with d hd
  · exact False.elim (hn0 rfl)
  · rw [Finset.sum_range_succ] at hn0⊢
    by_cases h : (∑ x : ℕ in Finset.range d, F x) = 0
    · rw [h, zero_add]
      exact hF d (lt_add_one _)
    · refine' lt_of_lt_of_le _ (min_le_padicValRat_add hn0)
      · refine' lt_min (hd (fun i hi => _) h) (hF d (lt_add_one _))
        exact hF _ (lt_trans hi (lt_add_one _))
#align padic_val_rat.sum_pos_of_pos padicValRat.sum_pos_of_pos

end padicValRat

namespace padicValNat

variable {p a b : ℕ} [hp : Fact p.Prime]

/-- A rewrite lemma for `padicValNat p (a * b)` with conditions `a ≠ 0`, `b ≠ 0`. -/
protected theorem mul : a ≠ 0 → b ≠ 0 → padicValNat p (a * b) = padicValNat p a + padicValNat p b :=
  by exact_mod_cast @padicValRat.mul p _ a b
#align padic_val_nat.mul padicValNat.mul

protected theorem div_of_dvd (h : b ∣ a) :
    padicValNat p (a / b) = padicValNat p a - padicValNat p b := by
  rcases eq_or_ne a 0 with (rfl | ha)
  · simp
  obtain ⟨k, rfl⟩ := h
  obtain ⟨hb, hk⟩ := mul_ne_zero_iff.mp ha
  rw [mul_comm, k.mul_div_cancel hb.bot_lt, padicValNat.mul hk hb, Nat.add_sub_cancel]
#align padic_val_nat.div_of_dvd padicValNat.div_of_dvd

/-- Dividing out by a prime factor reduces the `padicValNat` by `1`. -/
protected theorem div (dvd : p ∣ b) : padicValNat p (b / p) = padicValNat p b - 1 := by
  rw [padicValNat.div_of_dvd dvd, padicValNat_self]
#align padic_val_nat.div padicValNat.div

/-- A version of `padicValRat.pow` for `padicValNat`. -/
protected theorem pow (n : ℕ) (ha : a ≠ 0) : padicValNat p (a ^ n) = n * padicValNat p a := by
  simpa only [← @Nat.cast_inj ℤ, push_cast] using padicValRat.pow (Nat.cast_ne_zero.mpr ha)
#align padic_val_nat.pow padicValNat.pow

@[simp]
protected theorem prime_pow (n : ℕ) : padicValNat p (p ^ n) = n := by
  rw [padicValNat.pow _ (@Fact.out p.Prime).ne_zero, padicValNat_self, mul_one]
#align padic_val_nat.prime_pow padicValNat.prime_pow

protected theorem div_pow (dvd : p ^ a ∣ b) : padicValNat p (b / p ^ a) = padicValNat p b - a := by
  rw [padicValNat.div_of_dvd dvd, padicValNat.prime_pow]
#align padic_val_nat.div_pow padicValNat.div_pow

protected theorem div' {m : ℕ} (cpm : coprime p m) {b : ℕ} (dvd : m ∣ b) :
    padicValNat p (b / m) = padicValNat p b := by
  rw [padicValNat.div_of_dvd dvd, eq_zero_of_not_dvd (hp.out.coprime_iff_not_dvd.mp cpm),
    Nat.sub_zero]
#align padic_val_nat.div' padicValNat.div'

end padicValNat

section padicValNat

variable {p : ℕ}

theorem dvd_of_one_le_padicValNat {n : ℕ} (hp : 1 ≤ padicValNat p n) : p ∣ n := by
  by_contra h
  rw [padicValNat.eq_zero_of_not_dvd h] at hp
  exact lt_irrefl 0 (lt_of_lt_of_le zero_lt_one hp)
#align dvd_of_one_le_padic_val_nat dvd_of_one_le_padicValNat

theorem pow_padicValNat_dvd {n : ℕ} : p ^ padicValNat p n ∣ n := by
  rcases n.eq_zero_or_pos with (rfl | hn); · simp
  rcases eq_or_ne p 1 with (rfl | hp); · simp
  rw [multiplicity.pow_dvd_iff_le_multiplicity, padicValNat_def'] <;> assumption
#align pow_padic_val_nat_dvd pow_padicValNat_dvd

theorem padicValNat_dvd_iff_le [hp : Fact p.Prime] {a n : ℕ} (ha : a ≠ 0) :
    p ^ n ∣ a ↔ n ≤ padicValNat p a := by
  rw [pow_dvd_iff_le_multiplicity, ← padicValNat_def' hp.out.ne_one ha.bot_lt, PartENat.coe_le_coe]
#align padic_val_nat_dvd_iff_le padicValNat_dvd_iff_le

theorem padicValNat_dvd_iff (n : ℕ) [hp : Fact p.Prime] (a : ℕ) :
    p ^ n ∣ a ↔ a = 0 ∨ n ≤ padicValNat p a := by
  rcases eq_or_ne a 0 with (rfl | ha)
  · exact iff_of_true (dvd_zero _) (Or.inl rfl)
  · rw [padicValNat_dvd_iff_le ha, or_iff_right ha]
#align padic_val_nat_dvd_iff padicValNat_dvd_iff

theorem pow_succ_padicValNat_not_dvd {n : ℕ} [hp : Fact p.Prime] (hn : n ≠ 0) :
    ¬p ^ (padicValNat p n + 1) ∣ n := by
  rw [padicValNat_dvd_iff_le hn, not_le]
  exact Nat.lt_succ_self _
#align pow_succ_padic_val_nat_not_dvd pow_succ_padicValNat_not_dvd

theorem padicValNat_primes {q : ℕ} [hp : Fact p.Prime] [hq : Fact q.Prime] (neq : p ≠ q) :
    padicValNat p q = 0 :=
  @padicValNat.eq_zero_of_not_dvd p q <|
    (not_congr (Iff.symm (prime_dvd_prime_iff_eq hp.1 hq.1))).mp neq
#align padic_val_nat_primes padicValNat_primes

open BigOperators

theorem range_pow_padicValNat_subset_divisors {n : ℕ} (hn : n ≠ 0) :
    (Finset.range (padicValNat p n + 1)).image (p ^ ·) ⊆ n.divisors := by
  intro t ht
  simp only [exists_prop, Finset.mem_image, Finset.mem_range] at ht
  obtain ⟨k, hk, rfl⟩ := ht
  rw [Nat.mem_divisors]
  exact ⟨(pow_dvd_pow p <| by linarith).trans pow_padicValNat_dvd, hn⟩
#align range_pow_padic_val_nat_subset_divisors range_pow_padicValNat_subset_divisors

theorem range_pow_padicValNat_subset_divisors' {n : ℕ} [hp : Fact p.Prime] :
    ((Finset.range (padicValNat p n)).image fun t => p ^ (t + 1)) ⊆ n.divisors.erase 1 := by
  rcases eq_or_ne n 0 with (rfl | hn)
  · simp
  intro t ht
  simp only [exists_prop, Finset.mem_image, Finset.mem_range] at ht
  obtain ⟨k, hk, rfl⟩ := ht
  rw [Finset.mem_erase, Nat.mem_divisors]
  refine' ⟨_, (pow_dvd_pow p <| succ_le_iff.2 hk).trans pow_padicValNat_dvd, hn⟩
  exact (Nat.one_lt_pow _ _ k.succ_pos hp.out.one_lt).ne'
#align range_pow_padic_val_nat_subset_divisors' range_pow_padicValNat_subset_divisors'

end padicValNat

section padicValInt

variable {p : ℕ} [hp : Fact p.Prime]

theorem padicValInt_dvd_iff (n : ℕ) (a : ℤ) : (p : ℤ) ^ n ∣ a ↔ a = 0 ∨ n ≤ padicValInt p a := by
  rw [padicValInt, ← Int.natAbs_eq_zero, ← padicValNat_dvd_iff, ← Int.coe_nat_dvd_left,
    Int.coe_nat_pow]
#align padic_val_int_dvd_iff padicValInt_dvd_iff

theorem padicValInt_dvd (a : ℤ) : (p : ℤ) ^ padicValInt p a ∣ a := by
  rw [padicValInt_dvd_iff]
  exact Or.inr le_rfl
#align padic_val_int_dvd padicValInt_dvd

theorem padicValInt_self : padicValInt p p = 1 :=
  padicValInt.self hp.out.one_lt
#align padic_val_int_self padicValInt_self

theorem padicValInt.mul {a b : ℤ} (ha : a ≠ 0) (hb : b ≠ 0) :
    padicValInt p (a * b) = padicValInt p a + padicValInt p b := by
  simp_rw [padicValInt]
  rw [Int.natAbs_mul, padicValNat.mul] <;> rwa [Int.natAbs_ne_zero]
#align padic_val_int.mul padicValInt.mul

theorem padicValInt_mul_eq_succ (a : ℤ) (ha : a ≠ 0) :
    padicValInt p (a * p) = padicValInt p a + 1 := by
  rw [padicValInt.mul ha (Int.coe_nat_ne_zero.mpr hp.out.ne_zero)]
  simp only [eq_self_iff_true, padicValInt.of_nat, padicValNat_self]
#align padic_val_int_mul_eq_succ padicValInt_mul_eq_succ

end padicValInt


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

! This file was ported from Lean 3 source module ring_theory.mv_polynomial.basic
! leanprover-community/mathlib commit 019ead10c09bb91f49b1b7005d442960b1e0485f
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.CharP.Basic
import Mathbin.Data.Polynomial.AlgebraMap
import Mathbin.Data.MvPolynomial.Variables
import Mathbin.LinearAlgebra.FinsuppVectorSpace

/-!
# Multivariate polynomials over commutative rings

This file contains basic facts about multivariate polynomials over commutative rings, for example
that the monomials form a basis.

## Main definitions

* `restrict_total_degree σ R m`: the subspace of multivariate polynomials indexed by `σ` over the
  commutative ring `R` of total degree at most `m`.
* `restrict_degree σ R m`: the subspace of multivariate polynomials indexed by `σ` over the
  commutative ring `R` such that the degree in each individual variable is at most `m`.

## Main statements

* The multivariate polynomial ring over a commutative ring of positive characteristic has positive
  characteristic.
* `basis_monomials`: shows that the monomials form a basis of the vector space of multivariate
  polynomials.

## TODO

Generalise to noncommutative (semi)rings
-/

noncomputable section

open Classical

open Set LinearMap Submodule

open BigOperators Polynomial

universe u v

variable (σ : Type u) (R : Type v) [CommRing R] (p m : ℕ)

namespace MvPolynomial

section CharP

instance [CharP R p] : CharP (MvPolynomial σ R) p
    where cast_eq_zero_iff n := by rw [← C_eq_coe_nat, ← C_0, C_inj, CharP.cast_eq_zero_iff R p]

end CharP

section Homomorphism

theorem mapRange_eq_map {R S : Type _} [CommRing R] [CommRing S] (p : MvPolynomial σ R)
    (f : R →+* S) : Finsupp.mapRange f f.map_zero p = map f p :=
  by
  -- `finsupp.map_range_finset_sum` expects `f : R →+ S`
  change Finsupp.mapRange (f : R →+ S) (f : R →+ S).map_zero p = map f p
  rw [p.as_sum, Finsupp.mapRange_finset_sum, (map f).map_sum]
  refine' Finset.sum_congr rfl fun n _ => _
  rw [map_monomial, ← single_eq_monomial, Finsupp.mapRange_single, single_eq_monomial,
    f.coe_add_monoid_hom]
#align mv_polynomial.map_range_eq_map MvPolynomial.mapRange_eq_map

end Homomorphism

section Degree

/-- The submodule of polynomials of total degree less than or equal to `m`.-/
def restrictTotalDegree : Submodule R (MvPolynomial σ R) :=
  Finsupp.supported _ _ { n | (n.Sum fun n e => e) ≤ m }
#align mv_polynomial.restrict_total_degree MvPolynomial.restrictTotalDegree

/-- The submodule of polynomials such that the degree with respect to each individual variable is
less than or equal to `m`.-/
def restrictDegree (m : ℕ) : Submodule R (MvPolynomial σ R) :=
  Finsupp.supported _ _ { n | ∀ i, n i ≤ m }
#align mv_polynomial.restrict_degree MvPolynomial.restrictDegree

variable {R}

theorem mem_restrictTotalDegree (p : MvPolynomial σ R) :
    p ∈ restrictTotalDegree σ R m ↔ p.totalDegree ≤ m :=
  by
  rw [total_degree, Finset.sup_le_iff]
  rfl
#align mv_polynomial.mem_restrict_total_degree MvPolynomial.mem_restrictTotalDegree

theorem mem_restrictDegree (p : MvPolynomial σ R) (n : ℕ) :
    p ∈ restrictDegree σ R n ↔ ∀ s ∈ p.support, ∀ i, (s : σ →₀ ℕ) i ≤ n :=
  by
  rw [restrict_degree, Finsupp.mem_supported]
  rfl
#align mv_polynomial.mem_restrict_degree MvPolynomial.mem_restrictDegree

theorem mem_restrictDegree_iff_sup (p : MvPolynomial σ R) (n : ℕ) :
    p ∈ restrictDegree σ R n ↔ ∀ i, p.degrees.count i ≤ n :=
  by
  simp only [mem_restrict_degree, degrees, Multiset.count_finset_sup, Finsupp.count_toMultiset,
    Finset.sup_le_iff]
  exact ⟨fun h n s hs => h s hs n, fun h s hs n => h n s hs⟩
#align mv_polynomial.mem_restrict_degree_iff_sup MvPolynomial.mem_restrictDegree_iff_sup

variable (σ R)

/-- The monomials form a basis on `mv_polynomial σ R`. -/
def basisMonomials : Basis (σ →₀ ℕ) R (MvPolynomial σ R) :=
  Finsupp.basisSingleOne
#align mv_polynomial.basis_monomials MvPolynomial.basisMonomials

@[simp]
theorem coe_basisMonomials :
    (basisMonomials σ R : (σ →₀ ℕ) → MvPolynomial σ R) = fun s => monomial s 1 :=
  rfl
#align mv_polynomial.coe_basis_monomials MvPolynomial.coe_basisMonomials

theorem linearIndependent_x : LinearIndependent R (X : σ → MvPolynomial σ R) :=
  (basisMonomials σ R).LinearIndependent.comp (fun s : σ => Finsupp.single s 1)
    (Finsupp.single_left_injective one_ne_zero)
#align mv_polynomial.linear_independent_X MvPolynomial.linearIndependent_x

end Degree

end MvPolynomial

-- this is here to avoid import cycle issues
namespace Polynomial

/-- The monomials form a basis on `R[X]`. -/
noncomputable def basisMonomials : Basis ℕ R R[X] :=
  Basis.ofRepr (toFinsuppIsoAlg R).toLinearEquiv
#align polynomial.basis_monomials Polynomial.basisMonomials

@[simp]
theorem coe_basisMonomials : (basisMonomials R : ℕ → R[X]) = fun s => monomial s 1 :=
  funext fun n => ofFinsupp_single _ _
#align polynomial.coe_basis_monomials Polynomial.coe_basisMonomials

end Polynomial


-- represent propositions as (are) types
-- proofs are values of these types
-- thus proof checking turns into type checking

-- Computational domain
#check nat
#check 1

#check string
#check "hello"

#check bool
#check tt

-- "computational" types of type, Type (aka Sort 1)

-- Logical domain
#check true
#print true

def a_proof_of_nat : ℕ := 8
theorem a_proof_of_true : true := true.intro
-- theorem means a major proof, lemma means minor proof
-- conjecture is a proposition that is not yet a proof

#check false

#check (eq 1) 1   -- eq predicate applied to 1 and 2
#check (eq 1)
#check 1 = 1    -- infix notation for eq
-- proposition

#print eq

lemma pf_one_eq_one : 1 = 1 := eq.refl 1
lemma pf_one_eq_two : 1 = 2 := (eq.refl 2)
-- reflexive property of equality is why 3 = 3

#check eq.refl 3
-- value of 3 = 3
#check 1 = 1

-- values -> types -> types to which those belong

#check 3 ∈ { n : ℕ | n % 2 = 1}
-- proposition that is provable

#check ∃ (a b c : ℕ), a^2 + b^2 = c^2

-- propositions formalized as logical types: of type, Prop (Sort 0)

-- Values of computational types
#check 1
#check "hello"
#check tt
-- values of computational types are just ordinary data

-- Values of logical types (aka propositions)
#check (eq.refl 1)
-- values of logical types are accepted as proofs

-- eq defined as polymorphic *logical* type
-- takes two values, v1 and v2, of any type, α
-- yields a proposition, eq v1 v2, of type Prop
-- this type has just on constructor, called refl
-- takes argument, a : α, returns a value of type a=a
-- this value is accepted as a *proof*
#print eq

-- exercises involving proofs of equality
def pf1 : 1 = 1 := eq.refl 1
def pf2 : "hello" = "hello" := eq.refl "hello"

#reduce 2 = nat.pred 3

lemma pf3 : 2 = nat.pred 3 := eq.refl (nat.pred 3)
-- vocabulary: minor result

theorem pf4 : tt = tt := eq.refl tt -- vocabulary: major result
theorem pf5 : 1 = 0 := _                -- StUCk!!!

def sq (n : ℕ) : ℕ := n^2
#reduce (sq 3 = 9)

lemma pf6 : sq 3 = 9 := eq.refl 9           -- equality of reduced values
lemma pf7 : sq 5 = 25 := eq.refl 25

-- proof without having to worry about naming, example
example : sq 3 = 9 := eq.refl _
example : ℕ := 8

-- A logical type that has no values is false.
-- That's why the proposition, "false", in Lean is false.
-- a type with no constructors/values is said to be uninhabited
#print false
theorem pf8 : false := _

-- The proposition, "true", has one constant constructor/value/proof
#print true
theorem pf9 : true := true.intro

/-
What we've seen so far is that some propositions are
formalized as inductive types, the values of which, as
built using available constructors, are taken to be proofs.
Indeed you can represent a wide variety of propositions
and proofs this way.
-/

inductive MaryIsASoftwareEngineer : Prop
| knowsFormalMethods
| crackProgrammer

open MaryIsASoftwareEngineer

def me1 : MaryIsASoftwareEngineer := knowsFormalMethods
theorem me2 : MaryIsASoftwareEngineer := crackProgrammer

/-
Lean implements a logic in which all proofs of a given
proposition are considered to be not only equally good
but actually equal. This treatment of logical values is
fundamentally different from that of computational data
values, where values built by different constructors are
*never* equal. The principle that Lean implements here
is called the principle of "proof irrelevance." To show
that a proposition is true, you just have to exhibit *any*
proof/value of the given proposition/type.
-/

lemma m1 : me1 = me2 := eq.refl me1

theorem bad_news : 0 = 1 := _

/-
Not every logical proposition or predicate is implemented
as an inductive type. In particular, proofs of ∀, →, and ¬
propositions are not elementary data values functions.
-/

-- more to come


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

import data.polynomial.ring_division
import algebra.big_operators.nat_antidiagonal

/-!
# "Mirror" of a univariate polynomial

In this file we define `polynomial.mirror`, a variant of `polynomial.reverse`. The difference
between `reverse` and `mirror` is that `reverse` will decrease the degree if the polynomial is
divisible by `X`. We also define `polynomial.norm2`, which is the sum of the squares of the
coefficients of a polynomial. It is also a coefficient of `p * p.mirror`.

## Main definitions

- `polynomial.mirror`
- `polynomial.norm2`

## Main results

- `polynomial.mirror_mul_of_domain`: `mirror` preserves multiplication.
- `polynomial.irreducible_of_mirror`: an irreducibility criterion involving `mirror`
- `polynomial.norm2_eq_mul_reverse_coeff`: `norm2` is a coefficient of `p * p.mirror`

-/

namespace polynomial

variables {R : Type*} [semiring R] (p : polynomial R)

section mirror

/-- mirror of a polynomial: reverses the coefficients while preserving `polynomial.nat_degree` -/
noncomputable def mirror := p.reverse * X ^ p.nat_trailing_degree

lemma mirror_zero : (0 : polynomial R).mirror = 0 := rfl

lemma mirror_monomial (n : ℕ) (a : R) : (monomial n a).mirror = (monomial n a) :=
begin
  by_cases ha : a = 0,
  { rw [ha, monomial_zero_right, mirror_zero] },
  { rw [mirror, reverse, nat_degree_monomial n a ha, nat_trailing_degree_monomial ha,
        ←C_mul_X_pow_eq_monomial, reflect_C_mul_X_pow, rev_at_le (le_refl n),
        nat.sub_self, pow_zero, mul_one] },
end

lemma mirror_C (a : R) : (C a).mirror = C a :=
mirror_monomial 0 a

lemma mirror_X : X.mirror = (X : polynomial R) :=
mirror_monomial 1 (1 : R)

lemma mirror_nat_degree : p.mirror.nat_degree = p.nat_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, mirror_zero] },
  by_cases hR : nontrivial R,
  { haveI := hR,
    rw [mirror, nat_degree_mul', reverse_nat_degree, nat_degree_X_pow,
        nat.sub_add_cancel p.nat_trailing_degree_le_nat_degree],
    rwa [leading_coeff_X_pow, mul_one, reverse_leading_coeff, ne, trailing_coeff_eq_zero] },
  { haveI := not_nontrivial_iff_subsingleton.mp hR,
    exact congr_arg nat_degree (subsingleton.elim p.mirror p) },
end

lemma mirror_nat_trailing_degree : p.mirror.nat_trailing_degree = p.nat_trailing_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, mirror_zero] },
  { rw [mirror, nat_trailing_degree_mul_X_pow ((mt reverse_eq_zero.mp) hp),
        reverse_nat_trailing_degree, zero_add] },
end

lemma coeff_mirror (n : ℕ) :
  p.mirror.coeff n = p.coeff (rev_at (p.nat_degree + p.nat_trailing_degree) n) :=
begin
  by_cases h2 : p.nat_degree < n,
  { rw [coeff_eq_zero_of_nat_degree_lt (by rwa mirror_nat_degree)],
    by_cases h1 : n ≤ p.nat_degree + p.nat_trailing_degree,
    { rw [rev_at_le h1, coeff_eq_zero_of_lt_nat_trailing_degree],
      exact (nat.sub_lt_left_iff_lt_add h1).mpr (nat.add_lt_add_right h2 _) },
    { rw [←rev_at_fun_eq, rev_at_fun, if_neg h1, coeff_eq_zero_of_nat_degree_lt h2] } },
  rw not_lt at h2,
  rw [rev_at_le (h2.trans (nat.le_add_right _ _))],
  by_cases h3 : p.nat_trailing_degree ≤ n,
  { rw [←nat.sub_add_eq_add_sub h2, ←nat.sub_sub_assoc h2 h3, mirror, coeff_mul_X_pow',
        if_pos h3, coeff_reverse, rev_at_le ((nat.sub_le_self _ _).trans h2)] },
  rw not_le at h3,
  rw coeff_eq_zero_of_nat_degree_lt (nat.lt_sub_right_iff_add_lt.mpr (nat.add_lt_add_left h3 _)),
  exact coeff_eq_zero_of_lt_nat_trailing_degree (by rwa mirror_nat_trailing_degree),
end

--TODO: Extract `finset.sum_range_rev_at` lemma.

lemma mirror_mirror : p.mirror.mirror = p :=
polynomial.ext (λ n, by rw [coeff_mirror, coeff_mirror,
  mirror_nat_degree, mirror_nat_trailing_degree, rev_at_invol])

lemma mirror_eq_zero : p.mirror = 0 ↔ p = 0 :=
⟨λ h, by rw [←p.mirror_mirror, h, mirror_zero], λ h, by rw [h, mirror_zero]⟩

lemma mirror_trailing_coeff : p.mirror.trailing_coeff = p.leading_coeff :=
by rw [leading_coeff, trailing_coeff, mirror_nat_trailing_degree, coeff_mirror,
  rev_at_le (nat.le_add_left _ _), nat.add_sub_cancel]

lemma mirror_leading_coeff : p.mirror.leading_coeff = p.trailing_coeff :=
by rw [←p.mirror_mirror, mirror_trailing_coeff, p.mirror_mirror]

lemma mirror_mul_of_domain {R : Type*} [integral_domain R] (p q : polynomial R) :
  (p * q).mirror = p.mirror * q.mirror :=
begin
  by_cases hp : p = 0,
  { rw [hp, zero_mul, mirror_zero, zero_mul] },
  by_cases hq : q = 0,
  { rw [hq, mul_zero, mirror_zero, mul_zero] },
  rw [mirror, mirror, mirror, reverse_mul_of_domain, nat_trailing_degree_mul hp hq, pow_add],
  ring,
end

lemma mirror_smul {R : Type*} [integral_domain R] (p : polynomial R) (a : R) :
  (a • p).mirror = a • p.mirror :=
by rw [←C_mul', ←C_mul', mirror_mul_of_domain, mirror_C]

lemma mirror_neg {R : Type*} [ring R] (p : polynomial R) : (-p).mirror = -(p.mirror) :=
by rw [mirror, mirror, reverse_neg, nat_trailing_degree_neg, neg_mul_eq_neg_mul]

lemma irreducible_of_mirror {R : Type*} [integral_domain R] {f : polynomial R}
  (h1 : ¬ is_unit f)
  (h2 : ∀ k, f * f.mirror = k * k.mirror → k = f ∨ k = -f ∨ k = f.mirror ∨ k = -f.mirror)
  (h3 : ∀ g, g ∣ f → g ∣ f.mirror → is_unit g) : irreducible f :=
begin
  split,
  { exact h1 },
  { intros g h fgh,
    let k := g * h.mirror,
    have key : f * f.mirror = k * k.mirror,
    { rw [fgh, mirror_mul_of_domain, mirror_mul_of_domain, mirror_mirror,
          mul_assoc, mul_comm h, mul_comm g.mirror, mul_assoc, ←mul_assoc] },
    have g_dvd_f : g ∣ f,
    { rw fgh,
      exact dvd_mul_right g h },
    have h_dvd_f : h ∣ f,
    { rw fgh,
      exact dvd_mul_left h g },
    have g_dvd_k : g ∣ k,
    { exact dvd_mul_right g h.mirror },
    have h_dvd_k_rev : h ∣ k.mirror,
    { rw [mirror_mul_of_domain, mirror_mirror],
      exact dvd_mul_left h g.mirror },
    have hk := h2 k key,
    rcases hk with hk | hk | hk | hk,
    { exact or.inr (h3 h h_dvd_f (by rwa ← hk)) },
    { exact or.inr (h3 h h_dvd_f (by rwa [eq_neg_iff_eq_neg.mp hk, mirror_neg, dvd_neg])) },
    { exact or.inl (h3 g g_dvd_f (by rwa ← hk)) },
    { exact or.inl (h3 g g_dvd_f (by rwa [eq_neg_iff_eq_neg.mp hk, dvd_neg])) } },
end

end mirror

end polynomial